Commit e8d844c4 authored by Benoit Barbot's avatar Benoit Barbot
Browse files

progress

parent a06579ec
......@@ -73,7 +73,7 @@ let update_state_attr (s,at) attr_id = function
| _ -> None
let get_new_state_attr (s,at) _ = [
"node attribute", fun (s,at) -> s, "" :: at
"node attribute", fun (s,at) -> (s, at@[""]), B (List.length at)
]
......@@ -158,10 +158,10 @@ let update_arc_attr (at,cn) attr_id = function
let get_new_arc_attr atlist (p1,p2) =
let open DrawingGeom in
[
("Attribute", fun (at,cp) -> ("" :: at , cp) ) ;
("Point", fun (at,cp) -> (at , cp @ [`Point (mult 0.5 (p1+..p2))]) );
("Control", fun (at,cp) -> (at , cp @ [`ControlPoint (mult 0.5 (p1+..p2))]) );
("Node", fun (at,cp) -> (at , cp @ [`Text (0.5,"node")]) )
("Attribute", fun (at,cp) -> (at@[""] , cp),B (List.length at) ) ;
("Point", fun (at,cp) -> (at , cp @ [`Point (mult 0.5 (p1+..p2))]),C (List.length cp) );
("Control", fun (at,cp) -> (at , cp @ [`ControlPoint (mult 0.5 (p1+..p2))]),C (List.length cp) );
("Node", fun (at,cp) -> (at , cp @ [`Text (0.5,"node")]),C (List.length cp) )
]
let rec print_string_attr a = function
......
......@@ -15,10 +15,10 @@ module type PREGRAPH =
val draw_state: state -> DrawingGeom.point -> DrawingGeom.shape list
val draw_arc : arc -> (DrawingGeom.shape*DrawingGeom.shape) -> DrawingGeom.shape list
val get_state_attr: state -> string*( (attribute_id*string * attribute) list)
val get_new_state_attr: state -> DrawingGeom.point -> (string * (state -> state)) list
val get_new_state_attr: state -> DrawingGeom.point -> (string * (state -> state*attribute_id)) list
val update_state_attr: state -> attribute_id -> attribute option -> state option
(* val update_state_attr: state -> string -> string -> bool*)
val get_new_arc_attr: arc -> (DrawingGeom.point*DrawingGeom.point) -> (string * (arc -> arc)) list
val get_new_arc_attr: arc -> (DrawingGeom.point*DrawingGeom.point) -> (string * (arc -> arc*attribute_id)) list
val get_arc_attr: arc -> string*( (attribute_id * string * attribute) list)
val update_arc_attr: arc -> attribute_id -> attribute option -> arc option
......@@ -97,7 +97,7 @@ module S (P:PREGRAPH) =
let _,(_,p1) = Data.acca graph.state n1
and _,(_,p2) = Data.acca graph.state n2 in
let l = P.get_new_arc_attr !a (!p1,!p2) in
List.map (fun (an,f) -> an,(fun () -> a := (f !a))) l
List.map (fun (an,f) -> an,(fun () -> let na,id = f !a in a := na; id)) l
let new_arc graph n1 n2 = match n1,n2 with
`State (n1i),`State (n2i) -> begin
......@@ -128,7 +128,7 @@ module S (P:PREGRAPH) =
| `State n ->
let _,(s,p) = Data.acca graph.state n in
let l = P.get_new_state_attr !s !p in
List.map (fun (an,f) -> an,(fun () -> s := (f !s))) l
List.map (fun (an,f) -> an,(fun () -> let ns,id = f !s in s := ns;id)) l
let get_node_attribute graph = function
`Empty -> "",[]
......@@ -155,7 +155,7 @@ module S (P:PREGRAPH) =
let s = Data.addk ((),(ref (P.init_state ()), ref pos )) graph.state in
`State (s)
let get_new_node_choice graph =
[ (fun pos -> sop pos) ]
[ (fun pos -> sop pos),0 ]
let shapes_of_node graph = function
`Empty -> []
......@@ -164,7 +164,7 @@ module S (P:PREGRAPH) =
P.draw_state !s !p
let iter_node graph f =
Data.iteri (fun k _ -> f (`State k)) graph.state
Data.iteri (fun k _ -> f (`State k) 0) graph.state
let download_file_name _ = P.download_file_name
......
type node_type = int
module type GRAPH = sig
type graph
type node = private [> `Empty]
......@@ -9,13 +10,13 @@ module type GRAPH = sig
| `Color of string
]
val iter_node : graph -> (node -> unit) -> unit
val iter_node : graph -> (node -> node_type -> unit) -> unit
val shapes_of_node : graph -> node -> DrawingGeom.shape list
val get_new_node_choice : graph -> ((float*float) -> DrawingGeom.shape) list
val new_node : graph -> int -> (float*float) -> node
val get_new_node_choice : graph -> (((float*float) -> DrawingGeom.shape)*node_type) list
val new_node : graph -> node_type -> (float*float) -> node
val move_node : graph -> (float*float) -> node -> unit
val update_node_attribute : graph -> node -> attribute_id -> attribute option -> bool
val get_new_node_attribute : graph -> node -> (string * (unit -> unit)) list
val get_new_node_attribute : graph -> node -> (string * (unit -> attribute_id)) list
val get_node_attribute : graph -> node -> string*( (attribute_id*string *attribute) list)
val remove_node : graph -> node -> unit
......@@ -24,7 +25,7 @@ module type GRAPH = sig
(DrawingGeom.shape list)
val new_arc : graph -> node -> node -> bool
val update_arc_attribute : graph -> arc -> attribute_id -> attribute option -> bool
val get_new_arc_attribute : graph -> arc -> (string * (unit -> unit)) list
val get_new_arc_attribute : graph -> arc -> (string * (unit -> attribute_id)) list
val get_arc_attribute : graph -> arc -> string*( (attribute_id*string *attribute) list)
val remove_arc : graph -> arc -> unit
val nodes_of_arc : graph -> arc -> node*node
......@@ -67,7 +68,7 @@ module GraphEditor (G: GRAPH ) = struct
let node_in_rect s rect =
let nlist = ref [] in
G.iter_node s.graph (fun node -> nlist := node:: !nlist);
G.iter_node s.graph (fun node _ -> nlist := node:: !nlist);
!nlist
|> List.map (fun node -> (center_of_node s node),node)
|> Rectangle.contains rect
......@@ -143,7 +144,7 @@ module GraphEditor (G: GRAPH ) = struct
let layout_graph s =
let nodes = Hashtbl.create 10 in
let cmp = ref 0 in
G.iter_node s.graph (fun node ->
G.iter_node s.graph (fun node _ ->
let center = DrawingGeom.center_shape (List.hd @@ G.shapes_of_node s.graph node) in
Hashtbl.add nodes node (!cmp, center);
incr cmp);
......@@ -161,7 +162,7 @@ module GraphEditor (G: GRAPH ) = struct
let draw s mouse_pos =
clean s;
let found_node = ref false in
G.iter_node s.graph (fun obj ->
G.iter_node s.graph (fun obj _ ->
let shapes = G.shapes_of_node s.graph obj in
let over_node = is_over_shapes (to_screen s) mouse_pos shapes in
found_node := !found_node || over_node;
......@@ -188,6 +189,58 @@ module GraphEditor (G: GRAPH ) = struct
)
let b64_of_ui i =
char_of_int (i+65)
let ui_of_b64 c =
int_of_char c - 65
let buff_int b i =
let open Buffer in
let ui = (i + (1 lsl 17)) mod (1 lsl 18) in
let i1 = ui / (1 lsl 12)
and i2 = (ui / (1 lsl 6)) mod (1 lsl 6)
and i3 = ui mod (1 lsl 6) in
add_char b (b64_of_ui i1);
add_char b (b64_of_ui i2);
add_char b (b64_of_ui i3)
let int_buff s pos =
let i1 = ui_of_b64 s.[pos]
and i2 = ui_of_b64 s.[pos+1]
and i3 = ui_of_b64 s.[pos+2] in
let ui = i1*(1 lsl 12) + i2*(1 lsl 6) +i3 in
ui - (1 lsl 17)
let buff_float b f =
let i = int_of_float (f *. 10.0) in
buff_int b i
let float_buff b pos =
let f = int_buff b pos in
(float_of_int f) /. 10.
let get_exchange_string graph =
let buff = Buffer.create 20 in
Buffer.add_string buff "GEX";
let map = Hashtbl.create 10 in
let i =ref 0 in
G.iter_node graph (fun node node_type ->
Hashtbl.add map node !i;
incr i;
Buffer.add_char buff 'N';
Buffer.add_char buff (b64_of_ui node_type);
let f1,f2 = DrawingGeom.center_shape (List.hd (G.shapes_of_node graph node)) in
buff_float buff f1;
buff_float buff f2;
buff_int buff 0;
);
G.iter_arc graph (fun arc ->
let n1,n2 = G.nodes_of_arc graph arc in
Buffer.add_char buff 'A';
Buffer.add_char buff (b64_of_ui (Hashtbl.find map n1));
Buffer.add_char buff (b64_of_ui (Hashtbl.find map n2));
);
Bytes.to_string @@ Buffer.to_bytes buff
let save_load_html s =
let loadfile st =
......@@ -198,7 +251,8 @@ module GraphEditor (G: GRAPH ) = struct
input ~a:[a_id "filein"; a_input_type `File; a_onchange (change_file loadfile)] ();
button ~a:[a_onclick (fun _ ->
let string_value = Format.asprintf "%a" G.print_graph s.graph in
(*let string_value = Format.asprintf "%a" G.print_graph s.graph in*)
let string_value = get_exchange_string s.graph in
download string_value (G.download_file_name s.graph) "data:application/xml") ]
[pcdata "Download"];
button ~a:[a_onclick (fun _ -> layout_graph s; draw s (0.0,0.0))] [pcdata "Layout Graph"];
......@@ -238,7 +292,7 @@ module GraphEditor (G: GRAPH ) = struct
| 2 -> 20.0
| 3 -> 26.0
| _ -> 30.0 in
List.iteri (fun i fd ->
List.iteri (fun i (fd,_) ->
let x2,y2 = (x,y) +.. (rot ((float i)/.(float n)*.2.0*.pi) (rad,0.0)) in
let pos3 = (x,y) +.. (rot ((0.5+.float i)/.(float n)*.2.0*.pi) (rad,0.0)) in
s.ctx##.strokeStyle := (Js.string color);
......@@ -250,12 +304,13 @@ module GraphEditor (G: GRAPH ) = struct
let shape = fd (from_screen s pos3) in
draw_shape (to_screen s) s.ctx shape
) l;
n
List.map (fun (_,id) -> id) l
let which_choice n pos =
let which_choice clist pos =
let n = List.length clist in
let rho = mod_float (1.0 *. pi +. (angle pos)) (2.0 *. pi) in
let base = 2.0 *. pi /. (float n) in
int_of_float (rho /. base)
List.nth clist (int_of_float (rho /. base))
let get_coord ?exact:(exact=false) s ev =
let x0,y0 = Dom_html.elementClientPosition s.canvas in
......@@ -264,7 +319,7 @@ module GraphEditor (G: GRAPH ) = struct
let is_over_object s mouse_pos =
let obj = ref Empty in
G.iter_node s.graph (fun o ->
G.iter_node s.graph (fun o _ ->
let shapes = G.shapes_of_node s.graph o in
if is_over_shapes (to_screen s) mouse_pos shapes then obj:= Node o );
if !obj = Empty then
......
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