Commit 014557af authored by Benoit Barbot's avatar Benoit Barbot
Browse files

pb color

parent c746c017
Pipeline #897 passed with stage
in 55 seconds
......@@ -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.)
......
......@@ -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
......
......@@ -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)];
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment