pb color

TikzEditor/TikzGraph.ml

@@ -37,7 +37,7 @@ let draw_state (s,at) p =
     let draw = ref false 
     and shape = ref (`Rectangle (p,0.75,7.0,0.0)) 
     and color = ref (0,0,0)
-    and fill = ref (0,0,0) in           
+    and fill = ref (255,255,255) in           
     List.iter (function
           "draw" -> draw := true
         | "circle" -> shape := `Circle (p,10.0)
@@ -48,9 +48,10 @@ let draw_state (s,at) p =
       ) at;
     if not !draw then shape := `Circle (p,1.2);
     (*`RoundedRectangle (p,10.0,0.75,5.0);*)
-    [ !shape;
+    [ `Colors (!color,!fill);
+      !shape;
       (*`Circle (p,10.0);*)
-    `Colors (!color,!fill);
+    
     `Text(p,s);
     `Colors ((0,0,0),(255,255,255));
   ]
@@ -179,10 +180,19 @@ let get_new_arc_attr atlist (p1,p2) =
     ("Node", fun (at,cp) ->  (at , cp @ [`Text (0.5,"node")]),C (List.length cp) )
   ]
 
+let print_single_attr f a=
+  let open DrawingGeom.Color in
+  match is_prefix a "fill=" with
+  | Some x -> Format.fprintf f "fill=%s" (to_tikz_string @@ parse x)
+  | None -> (match is_prefix a "color=" with
+             | Some x -> Format.fprintf f "color=%s" (to_tikz_string @@ parse x)
+             | None -> Format.fprintf f "%s" a
+              )
+              
 let rec print_string_attr a = function
     [] -> ()
-  | t::[] -> Format.fprintf a "%s" t
-  | t::q -> Format.fprintf a "%s,%a" t print_string_attr q
+  | t::[] -> Format.fprintf a "%a" print_single_attr t
+  | t::q -> Format.fprintf a "%a,%a" print_single_attr t print_string_attr q
 
 let to_tikz (x,y) =
   (x/.50.),(100.0 -. y/.50.)

editor/DrawingGeom.ml

@@ -70,7 +70,9 @@ module Color = struct
                                |_ ->'0' in
       Printf.sprintf "#%c%c%c%c%c%c" (loi (r/16)) (loi (r mod 16))
         (loi (g/16)) (loi (g mod 16)) (loi (b/16)) (loi (b mod 16))
-      
+
+  let to_tikz_string (r,g,b) =
+    Printf.sprintf "rgb,255:red,%i;green,%i;yellow,%i" r g b 
 
 end
             
@@ -515,13 +517,16 @@ module Circle =
    | `Bezier2 (pos1,pos2,pos3) -> mult 0.33 (pos1 +.. pos2 +.. pos3)
    | _ -> (0.0,0.0)
 
- let rec center_shapes = function
-     [] -> (0.0,0.0)
-   | `Circle (pos,_)::_ -> pos
-   | `Rectangle (pos,_,_,_)::_ -> pos
-   | `RoundedRectangle (pos,_,_,_)::_ -> pos
-   | `Text (pos,_)::_ -> pos
-   | _::q -> center_shapes q
+
+ let rec tangible = function
+     [] -> `Empty
+   | `Circle c::_ -> `Circle c 
+   | `Rectangle r::_ -> `Rectangle r
+   | `RoundedRectangle r::_ -> `RoundedRectangle r
+   | `Text t::_ -> `Text t
+   | _::q -> tangible q
+     
+ let rec center_shapes sl = center_shape @@ tangible sl    
         
  let projection_shape origin = function
      `Circle c -> Circle.projection c origin

editor/graphDrawing.ml

@@ -62,9 +62,7 @@ module GraphEditor (G: GRAPH ) = struct
     }
 
   let center_of_node s node =
-    match G.shapes_of_node s.graph node with
-      t::_ -> center_shape t
-    | [] -> 0.0, 0.0
+    DrawingGeom.center_shapes @@ G.shapes_of_node s.graph node 
 
   let node_in_rect s rect =
     let nlist = ref [] in
@@ -131,9 +129,9 @@ module GraphEditor (G: GRAPH ) = struct
   let shapes_of_arc s obj =
     let (source,target) = G.nodes_of_arc s.graph obj in
     let source_sh = G.shapes_of_node s.graph source
-                    |> (function t::_ -> t | _ -> `Empty)
+                    |> DrawingGeom.tangible
     and target_sh = G.shapes_of_node s.graph target
-                    |> (function t::_ -> t | _ -> `Empty) in
+                    |> DrawingGeom.tangible in
     let shapes = G.shapes_of_arc s.graph source_sh target_sh obj in
     shapes
 
@@ -591,7 +589,7 @@ let rec html_of_attr s attr nattr cb =
                            set_style s.ctx true false;
                            let pos1 = from_screen s mouse_pos2 in
                            let shape = G.shapes_of_node s.graph node1
-                                       |> (function t::_ ->t | _ -> `Empty) in
+                                       |> DrawingGeom.tangible in
                            let pos2 = projection_shape pos1 shape in
                            draw_shapes (to_screen s) s.ctx ~thick:2.0
                              [ `Line (pos2,pos1); `Arrow (pos1,pos2)];