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 type attribute = string * string (* <key, value> pair *)
32 let png_flags = "-Tpng"
33 let map_flags = "-Tcmapx"
35 let tempfile () = Filename.temp_file "matita_" ""
37 class type graphviz_widget =
39 method load_graph_from_file: string -> unit
41 (GdkEvent.Button.t -> (string * string) list -> unit) -> unit
42 method as_image: GMisc.image
43 method as_viewport: GBin.viewport
46 class graphviz_impl ?packing gviz_cmd =
47 let viewport = GBin.viewport ?packing () in
49 GMisc.image ~packing:viewport#add ~xalign:0. ~yalign:0. ~xpad:0 ~ypad:0 ()
52 val mutable href_cb = fun _ _ -> ()
56 ignore (viewport#event#connect#button_press (fun button ->
57 (*eprintf "x: %f; y: %f;\n%!" (GdkEvent.Button.x button +. viewport#hadjustment#value) (GdkEvent.Button.y button +. viewport#vadjustment#value);*)
58 (* compute coordinates relative to image origin *)
59 let x = GdkEvent.Button.x button +. viewport#hadjustment#value in
60 let y = GdkEvent.Button.y button +. viewport#vadjustment#value in
62 href_cb button (self#find_href x y)
63 with Not_found -> ());
66 method load_graph_from_file fname =
67 let tmp_png = tempfile () in
68 ignore (Sys.command (sprintf "%s %s %s > %s"
69 gviz_cmd png_flags fname tmp_png));
70 image#set_file tmp_png;
71 HExtlib.safe_remove tmp_png;
72 let tmp_map = tempfile () in
73 ignore (Sys.command (sprintf "%s %s %s > %s"
74 gviz_cmd map_flags fname tmp_map));
75 self#load_map tmp_map;
76 HExtlib.safe_remove tmp_map
78 method private load_map fname =
81 XmlPushParser.create_parser
82 { XmlPushParser.default_callbacks with
83 XmlPushParser.start_element =
84 Some (fun elt attrs ->
86 | "area" -> areas := attrs :: !areas
88 XmlPushParser.parse p (`File fname);
91 method private find_href x y =
93 match List.map float_of_string (HExtlib.split ~sep:',' s) with
94 | [x1; y1; x2; y2 ] -> x1, y1, x2, y2
95 | _ -> assert false in
98 let x1, y1, x2, y2 = parse_coords (List.assoc "coords" attrs) in
99 x1 <= x && x <= x2 && y1 <= y && y <= y2)
103 (cb: GdkEvent.Button.t -> (string * string) list -> unit)
107 method as_image = image
108 method as_viewport = viewport
112 let factory cmd ?packing () =
113 (new graphviz_impl ?packing cmd :> graphviz_widget)
115 let gDot = factory "dot"
116 let gNeato = factory "neato"
117 let gTwopi = factory "twopi"
118 let gCirco = factory "circo"
119 let gFdp = factory "fdp"