X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fmatita%2FlablGraphviz.ml;h=d67584c8c99d4f700d99f39afa625c654a0c311b;hb=8049c166a37789d7a1b1ca1c3a1174712bbf87ba;hp=27e7d4b9a28ed2caafb8477f7b54d898e0615884;hpb=abd2098b6c4a40b36bb4b950c607eb4b4a7852bc;p=helm.git

diff --git a/helm/software/matita/lablGraphviz.ml b/helm/software/matita/lablGraphviz.ml
index 27e7d4b9a..d67584c8c 100644
--- a/helm/software/matita/lablGraphviz.ml
+++ b/helm/software/matita/lablGraphviz.ml
@@ -53,7 +53,9 @@ class graphviz_impl ?packing () =
     GMisc.image ~packing:viewport#add ~xalign:0. ~yalign:0. ~xpad:0 ~ypad:0 ()
   in
   let parse_coords s =
-    match List.map float_of_string (HExtlib.split ~sep:',' s) with
+    let xys = HExtlib.split ~sep:' ' s in
+    let xys = List.flatten (List.map (HExtlib.split ~sep:',') xys) in
+    match List.map float_of_string xys with
     | [x1; y1; x2; y2 ] -> x1, y1, x2, y2
     | _ -> assert false in
   object (self)
@@ -86,13 +88,40 @@ class graphviz_impl ?packing () =
 
     method private load_map fname =
       let areas = ref [] in
+      let is_rect l = 
+        try List.assoc "shape" l = "rect" with Not_found -> false
+      in
+      let is_poly l = 
+        try List.assoc "shape" l = "poly" with Not_found -> false
+      in
+      let rectify l = 
+        List.map (
+         function "coords",c -> 
+          let xys = HExtlib.split ~sep:' ' c in
+          let xys = 
+            List.map 
+              (fun s -> 
+                 match HExtlib.split ~sep:',' s with 
+                 | [x; y] -> int_of_string x, int_of_string y 
+                 | _ -> assert false)
+              xys
+          in
+          let xs, ys = List.split xys in
+          let max_x = string_of_int (List.fold_left max 0 xs) in
+          let max_y = string_of_int (List.fold_left max 0 ys) in
+          let min_x = string_of_int (List.fold_left min max_int xs) in
+          let min_y = string_of_int (List.fold_left min max_int ys) in
+          "coords", min_x^","^min_y^" "^max_x^","^max_y
+         | x -> x) l
+      in
       let p =
         XmlPushParser.create_parser
           { XmlPushParser.default_callbacks with
             XmlPushParser.start_element =
               Some (fun elt attrs ->
                 match elt with
-                | "area" -> areas := attrs :: !areas
+                | "area" when is_rect attrs -> areas := attrs :: !areas
+                | "area" when is_poly attrs -> areas := rectify attrs :: !areas
                 | _ -> ()) } in
       XmlPushParser.parse p (`File fname);
       map <- !areas
@@ -111,12 +140,13 @@ class graphviz_impl ?packing () =
 
     method center_on_href href =
       (*eprintf "Centering viewport on uri %s\n%!" href;*)
-      let attrs = 
-        List.find
-          (fun attrs ->
-            try List.assoc "href" attrs = href with Not_found -> false)
-          map in
       try
+        let attrs = 
+          List.find
+            (fun attrs ->
+              try List.assoc "href" attrs = href with Not_found -> false)
+          map 
+        in
         let x1, y1, x2, y2 = parse_coords (List.assoc "coords" attrs) in
         viewport#hadjustment#clamp_page ~lower:x1 ~upper:x2;
         viewport#vadjustment#clamp_page ~lower:y1 ~upper:y2;