1 (* Copyright (C) 2006, HELM Team.
3 * This file is part of HELM, an Hypertextual, Electronic
4 * Library of Mathematics, developed at the Computer Science
5 * Department, University of Bologna, Italy.
7 * HELM is free software; you can redistribute it and/or
8 * modify it under the terms of the GNU General Public License
9 * as published by the Free Software Foundation; either version 2
10 * of the License, or (at your option) any later version.
12 * HELM is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 * GNU General Public License for more details.
17 * You should have received a copy of the GNU General Public License
18 * along with HELM; if not, write to the Free Software
19 * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
22 * For details, see the HELM World-Wide-Web page,
23 * http://helm.cs.unibo.it/
30 let png_flags = "-Tpng"
31 let map_flags = "-Tcmapx"
33 let tempfile () = Filename.temp_file "matita_" ""
35 class type graphviz_widget =
37 method load_graph_from_file: string -> unit
39 (GdkEvent.Button.t -> (string * string) list -> unit) -> unit
40 method as_image: GMisc.image
41 method as_viewport: GBin.viewport
44 class graphviz_impl ?packing gviz_cmd =
45 let viewport = GBin.viewport ?packing () in
47 GMisc.image ~packing:viewport#add ~xalign:0. ~yalign:0. ~xpad:0 ~ypad:0 ()
50 val mutable href_cb = fun _ _ -> ()
54 ignore (viewport#event#connect#button_press (fun button ->
55 (*eprintf "x: %f; y: %f;\n%!" (GdkEvent.Button.x button +. viewport#hadjustment#value) (GdkEvent.Button.y button +. viewport#vadjustment#value);*)
56 (* compute coordinates relative to image origin *)
57 let x = GdkEvent.Button.x button +. viewport#hadjustment#value in
58 let y = GdkEvent.Button.y button +. viewport#vadjustment#value in
60 href_cb button (self#find_href x y)
61 with Not_found -> ());
64 method load_graph_from_file fname =
65 let tmp_png = tempfile () in
66 ignore (Sys.command (sprintf "%s %s %s > %s"
67 gviz_cmd png_flags fname tmp_png));
68 image#set_file tmp_png;
69 let tmp_map = tempfile () in
70 ignore (Sys.command (sprintf "%s %s %s > %s"
71 gviz_cmd map_flags fname tmp_map));
72 self#load_map tmp_map;
73 HExtlib.safe_remove tmp_png
75 method private load_map fname =
78 XmlPushParser.create_parser
79 { XmlPushParser.default_callbacks with
80 XmlPushParser.start_element =
81 Some (fun elt attrs ->
83 | "area" -> areas := attrs :: !areas
85 XmlPushParser.parse p (`File fname);
88 method private find_href x y =
90 match List.map float_of_string (HExtlib.split ~sep:',' s) with
91 | [x1; y1; x2; y2 ] -> x1, y1, x2, y2
92 | _ -> assert false in
95 let x1, y1, x2, y2 = parse_coords (List.assoc "coords" attrs) in
96 x1 <= x && x <= x2 && y1 <= y && y <= y2)
100 (cb: GdkEvent.Button.t -> (string * string) list -> unit)
104 method as_image = image
105 method as_viewport = viewport
109 let factory cmd ?packing () =
110 (new graphviz_impl ?packing cmd :> graphviz_widget)
112 let gDot = factory "dot"
113 let gNeato = factory "neato"
114 let gTwopi = factory "twopi"
115 let gCirco = factory "circo"
116 let gFdp = factory "fdp"