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

add generic

parent e8d844c4
......@@ -9,7 +9,7 @@ PROJECT_NAME := cosmosweb
SERVER_FILES := $(wildcard *.eliomi *.eliom)
# Source files for the client
CLIENT_FILES := $(wildcard *.eliomi *.eliom) graphDrawing.ml utilsWeb.ml SimpleGraph.ml Data.ml TikzGraph.ml MarkovChain.ml layout.ml tikzLexer.ml tikzParser.ml DrawingGeom.ml
CLIENT_FILES := $(wildcard *.eliomi *.eliom) graphDrawing.ml utilsWeb.ml SimpleGraph.ml Data.ml TikzGraph.ml MarkovChain.ml layout.ml genericSerializer.ml tikzLexer.ml tikzParser.ml DrawingGeom.ml
# OCamlfind packages for the server
SERVER_PACKAGES := lwt.ppx js_of_ocaml-ppx.deriving xml-light
......
......@@ -498,7 +498,14 @@ 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 projection_shape origin = function
`Circle c -> Circle.projection c origin
| `Rectangle r -> Rectangle.projection r origin
......
open Buffer
let b64_of_ui i =
if i<26 then char_of_int (i+65)
else if i < 52 then char_of_int (i-26+97)
else if i < 62 then char_of_int (i-52+48)
else if i=62 then '+'
else '/'
let ui_of_b64 c =
let i = int_of_char c in
if i>=65 && i<91 then i -65
else if i>= 97 && i<123 then i-97+26
else if i>= 48 && i<58 then i-48+52
else if i=43 then 62
else 63
let buff_int b i =
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 buff_string b str =
let n = String.length str in
let pos = ref 0 in
let pi i = add_char b (b64_of_ui i) in
while !pos < n do
let v1 = int_of_char str.[!pos] in
pi (v1/4);
begin if !pos+1 < n then
let v2 = 256*(v1 mod 4) + int_of_char str.[!pos+1] in
pi (v2/16);
if !pos+2 < n then
let v3 = 256*(v2 mod 16) + int_of_char str.[!pos+2] in
pi (v3/64);
pi (v3 mod 64)
else
let vp3 = 256*(v2 mod 16) + 0 in
pi (vp3/64);
add_char b '='
else
let vp2 = 256*(v1 mod 4) + 0 in
pi (vp2/16);
add_char b '=';
add_char b '='
end;
pos := !pos+3
done;;
let t = Buffer.create 10 in
buff_string t "M";
Buffer.to_bytes t;;
let write_attribute b (_,s,a) =
add_char b 'T'
......@@ -145,7 +145,7 @@ module GraphEditor (G: GRAPH ) = struct
let nodes = Hashtbl.create 10 in
let cmp = ref 0 in
G.iter_node s.graph (fun node _ ->
let center = DrawingGeom.center_shape (List.hd @@ G.shapes_of_node s.graph node) in
let center = DrawingGeom.center_shapes @@ G.shapes_of_node s.graph node in
Hashtbl.add nodes node (!cmp, center);
incr cmp);
let arcs = ref [] in
......@@ -189,36 +189,8 @@ 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 open GenericSerializer in
let buff = Buffer.create 20 in
Buffer.add_string buff "GEX";
let map = Hashtbl.create 10 in
......@@ -228,23 +200,50 @@ module GraphEditor (G: GRAPH ) = struct
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
let f1,f2 = DrawingGeom.center_shapes (G.shapes_of_node graph node) in
buff_float buff f1;
buff_float buff f2;
buff_int buff 0;
let attr = snd @@ G.get_node_attribute graph node in
List.iter (write_attribute buff) attr
);
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));
buff_int buff (Hashtbl.find map n1);
buff_int buff (Hashtbl.find map n2);
);
Bytes.to_string @@ Buffer.to_bytes buff
let parse_exchange_string str =
let open GenericSerializer in
let graph = G.new_graph () in
let length = String.length str in
assert (String.sub str 0 3 = "GEX");
let pos = ref 3 in
let map = Hashtbl.create 10 in
let i =ref 0 in
while !pos+8 <= length && str.[!pos] = 'N' do
let node_type = ui_of_b64 str.[!pos+1] in
let f1 = float_buff str (!pos+2) in
let f2 = float_buff str (!pos+5) in
let node = G.new_node graph node_type (f1,f2) in
Hashtbl.add map !i node;
incr i;
pos := !pos+8;
done;
while !pos+7 <= length && str.[!pos] = 'A' do
let n1 = Hashtbl.find map (int_buff str (!pos+1)) in
let n2 = Hashtbl.find map (int_buff str (!pos+4)) in
let arc = G.new_arc graph n1 n2 in
pos := !pos+7;
done;
graph
let save_load_html s =
let loadfile st =
s.graph <- G.read_graph st;
(*s.graph <- G.read_graph st;*)
s.graph <- parse_exchange_string st;
draw s (0.0,0.0) in
div [p [pcdata "Load file: ";
......
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