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: ?gviz_cmd:string -> string -> unit
41 (GdkEvent.Button.t -> (string * string) list -> unit) -> unit
42 method center_on_href: string -> unit
43 method as_image: GMisc.image
44 method as_viewport: GBin.viewport
47 class graphviz_impl ?packing () =
48 let viewport = GBin.viewport ?packing () in
49 let mk_gviz_cmd gviz_cmd flags src_fname dest_fname =
50 sprintf "cat %s | %s %s > %s" src_fname gviz_cmd flags
53 GMisc.image ~packing:viewport#add ~xalign:0. ~yalign:0. ~xpad:0 ~ypad:0 ()
56 let xys = HExtlib.split ~sep:' ' s in
57 let xys = List.flatten (List.map (HExtlib.split ~sep:',') xys) in
58 match List.map float_of_string xys with
59 | [x1; y1; x2; y2 ] -> x1, y1, x2, y2
60 | _ -> assert false in
62 val mutable href_cb = fun _ _ -> ()
63 val mutable map = [] (* list of associative list attr name -> attr value *)
66 ignore (viewport#event#connect#button_press (fun button ->
67 (*eprintf "x: %f; y: %f;\n%!" (GdkEvent.Button.x button +. viewport#hadjustment#value) (GdkEvent.Button.y button +. viewport#vadjustment#value);*)
68 (* compute coordinates relative to image origin *)
69 let x = GdkEvent.Button.x button +. viewport#hadjustment#value in
70 let y = GdkEvent.Button.y button +. viewport#vadjustment#value in
71 (try href_cb button (self#find_href x y) with Not_found -> ());
74 method load_graph_from_file ?(gviz_cmd = "dot") fname =
75 let tmp_png = tempfile () in
76 let rc = Sys.command (mk_gviz_cmd gviz_cmd png_flags fname tmp_png) in
77 if rc <> 0 || (Unix.stat tmp_png).st_size = 0 then begin
79 ("Graphviz command failed (exit code: %d) on the following graph:\n"
81 rc (HExtlib.input_file fname);
82 (* CSC: it would be better to show something explaining that the
86 image#set_file tmp_png;
87 HExtlib.safe_remove tmp_png;
88 let tmp_map = tempfile () in
89 ignore (Sys.command (mk_gviz_cmd gviz_cmd map_flags fname tmp_map));
90 self#load_map tmp_map;
91 HExtlib.safe_remove tmp_map
94 method private load_map fname =
97 try List.assoc "shape" l = "rect" with Not_found -> false
100 try List.assoc "shape" l = "poly" with Not_found -> false
104 function "coords",c ->
105 let xys = HExtlib.split ~sep:' ' c in
109 match HExtlib.split ~sep:',' s with
110 | [x; y] -> int_of_string x, int_of_string y
114 let xs, ys = List.split xys in
115 let max_x = string_of_int (List.fold_left max 0 xs) in
116 let max_y = string_of_int (List.fold_left max 0 ys) in
117 let min_x = string_of_int (List.fold_left min max_int xs) in
118 let min_y = string_of_int (List.fold_left min max_int ys) in
119 "coords", min_x^","^min_y^" "^max_x^","^max_y
124 XmlPushParser.create_parser
125 { XmlPushParser.default_callbacks with
126 XmlPushParser.start_element =
127 Some (fun elt attrs ->
129 | "area" when is_rect attrs -> areas := attrs :: !areas
130 | "area" when is_poly attrs -> areas := rectify attrs :: !areas
132 XmlPushParser.parse p (`File fname);
134 with XmlPushParser.Parse_error _ -> ()
136 method private find_href x y =
139 let x1, y1, x2, y2 = parse_coords (List.assoc "coords" attrs) in
140 x1 <= x && x <= x2 && y1 <= y && y <= y2)
144 (cb: GdkEvent.Button.t -> (string * string) list -> unit)
148 method center_on_href href =
149 (*eprintf "Centering viewport on uri %s\n%!" href;*)
154 try List.assoc "href" attrs = href with Not_found -> false)
157 let x1, y1, x2, y2 = parse_coords (List.assoc "coords" attrs) in
158 viewport#hadjustment#clamp_page ~lower:x1 ~upper:x2;
159 viewport#vadjustment#clamp_page ~lower:y1 ~upper:y2;
162 method as_image = image
163 method as_viewport = viewport
167 let graphviz ?packing () =
168 (new graphviz_impl ?packing () :> graphviz_widget)