Commit 2789156a authored by Benoit Barbot's avatar Benoit Barbot
Browse files

add offset

parent 6ecf231b
Pipeline #1969 passed with stage
in 34 seconds
......@@ -39,11 +39,11 @@
let text = Printf.sprintf "[%s],%s,%s" label inv (string_of_reset reset) in
if source_sh<>target_sh then begin
shapes_of_path source_sh [`Text (0.5,text)] ~arrow2:(Some (fun x y -> `Arrow (x,y))) target_sh
shapes_of_path source_sh [`Text (0.5,8.0,text)] ~arrow2:(Some (fun x y -> `Arrow (x,y))) target_sh
end else begin
let p1 = pos1 +.. (40.0 , -.25.0)
and p2 = pos2 +.. (40.0 , 25.0) in
shapes_of_path source_sh [`ControlPoint p1; `Text (0.5,text);`ControlPoint p2] ~arrow2:(Some (fun x y -> `Arrow (x,y))) target_sh
shapes_of_path source_sh [`ControlPoint p1; `Text (0.5,8.0,text);`ControlPoint p2] ~arrow2:(Some (fun x y -> `Arrow (x,y))) target_sh
end
let get_def_attr def =
......
......@@ -29,11 +29,11 @@
let text = string_of_float arc in
if source_sh<>target_sh then begin
shapes_of_path source_sh [`Text (0.5,text)] ~arrow2:(Some (fun x y -> `Arrow (x,y))) target_sh
shapes_of_path source_sh [`Text (0.5,8.0,text)] ~arrow2:(Some (fun x y -> `Arrow (x,y))) target_sh
end else begin
let p1 = pos1 +.. (40.0 , -.25.0)
and p2 = pos2 +.. (40.0 , 25.0) in
shapes_of_path source_sh [`ControlPoint p1; `Text (0.5,text);`ControlPoint p2] ~arrow2:(Some (fun x y -> `Arrow (x,y))) target_sh
shapes_of_path source_sh [`ControlPoint p1; `Text (0.5,8.0,text);`ControlPoint p2] ~arrow2:(Some (fun x y -> `Arrow (x,y))) target_sh
end
......@@ -76,7 +76,7 @@
end
| _ -> None
let get_new_arc_attr atlist _ = []
let get_new_arc_attr _ _ = []
let get_new_def_attr _ = []
let update_def_attr _ _ _ = None
......
......@@ -130,7 +130,7 @@ let get_arc_attr (atlist,controllist) =
Some x -> D i,"Color",`Color x
| None -> (B i),"Attribute", (`String sv ))) atlist)
@ (List.mapi (fun i sv -> (match sv with
`Text (_,s) -> C i,"Node",
`Text (_,_,s) -> C i,"Node",
(`String s)
| `Point p -> C i,"Point",
(`ControlPoint p)
......@@ -149,7 +149,7 @@ let update_arc_attr (at,cn) attr_id = function
Some (List.rev listat,cn)
| C id ->
let _,listcn = List.fold_left (fun (i,l) at ->
if i=id then (i+1, (`Text (0.5,newv))::l)
if i=id then (i+1, (`Text (0.5,8.0,newv))::l)
else (i+1, at::l))
(0,[]) cn in
Some (at,(List.rev listcn))
......@@ -189,7 +189,7 @@ let get_new_arc_attr atlist (p1,p2) =
("Color", fun (at,cp) -> (at@["color=black"],cp), D (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) )
("Node", fun (at,cp) -> (at , cp @ [`Text (0.5,8.0,"node")]),C (List.length cp) )
]
let get_new_def_attr _ = []
......@@ -242,16 +242,16 @@ let rec print_path link prev last a = function
| (`ControlPoint p1)::(`Point p2)::q ->
Format.fprintf a " %a %a" (format_quad prev p1) p2
(print_path false p1 last) ((`Point p2)::q)
| (`ControlPoint p1)::(`Text (_,s))::(`Point p2)::q ->
| (`ControlPoint p1)::(`Text (_,_,s))::(`Point p2)::q ->
Format.fprintf a " %a node {%s} %a" (format_quad prev p1) p2 s
(print_path false p1 last) ((`Point p2)::q)
| (`ControlPoint p1)::[] ->
Format.fprintf a " %a " (format_quad prev p1) last
| (`ControlPoint p1)::`Text (_,s)::[] ->
| (`ControlPoint p1)::`Text (_,_,s)::[] ->
Format.fprintf a " %a node {%s} " (format_quad prev p1) last s
| (`Text t)::(`ControlPoint p)::q when link ->
print_path link prev last a ((`ControlPoint p)::`Text t::q)
| `Text (_,s)::q ->
| `Text (_,_,s)::q ->
Format.fprintf a " %s node {%s}%a" (if link then "--" else "") s (print_path false prev last) q
let print =
......
......@@ -59,12 +59,12 @@ PATHDELIM LPAR FLOAT COMMA FLOAT RPAR pathlist
`ControlPoint ($4,$6)::`ControlPoint ($10,$12)::l,f }
| PATHDELIM LPAR IDENTIFIER RPAR { [],$3 }
| NODE TEXCONTENT pathlist {
let l,f = $3 in (`Text (0.5,$2)::l,f) }
let l,f = $3 in (`Text (0.5,8.0,$2)::l,f) }
pathlist2:
LPAR FLOAT COMMA FLOAT RPAR pathlist { let l,f = $6 in (`Point ($2,$4)::l,f) }
| NODE TEXCONTENT pathlist2 {
let l,f = $3 in (`Text (0.5,$2)::l,f) }
let l,f = $3 in (`Text (0.5,8.0,$2)::l,f) }
| LPAR IDENTIFIER RPAR { [],$2 }
attribute_list:
......
exception Empty
exception Destroyed
type ('a,'b, 'k) t = {
mutable table:('a * 'b) option array;
mutable hash: ('a,int) Hashtbl.t;
mutable size:int
}
type 'k key= int
type ('a, 'b, 'k) t = {
mutable table : ('a * 'b) option array;
mutable hash : ('a, int) Hashtbl.t;
mutable size : int;
}
type 'k key = int
let fod = function Some a -> a | None -> raise Destroyed
let create () = {table = [||]; hash = Hashtbl.create 10; size=0}
let acca t i = if Array.length t.table =0 then raise Empty
else fod t.table.(i)
let create () = { table = [||]; hash = Hashtbl.create 10; size = 0 }
let acca t i = if Array.length t.table = 0 then raise Empty else fod t.table.(i)
let index t s = Hashtbl.find t.hash s
let acc t s =
index t s
|> acca t
|> snd
let acc t s = index t s |> acca t |> snd
let updatea i v t =
if Array.length t.table =0 then raise Empty
if Array.length t.table = 0 then raise Empty
else
let a,_ = fod t.table.(i) in
t.table.(i) <- Some (a,v)
let a, _ = fod t.table.(i) in
t.table.(i) <- Some (a, v)
let remove t i =
if Array.length t.table =0 then raise Empty
else match t.table.(i) with
Some (a,_) -> (t.table.(i) <- None;
Hashtbl.remove t.hash a)
| None -> ()
let rec addk (a,b) t = match Array.length t.table with
0 -> t.table <- Array.make 10 (Some (a,b));
t.size <- 1;
Hashtbl.add t.hash a 0; 0
if Array.length t.table = 0 then raise Empty
else
match t.table.(i) with
| Some (a, _) ->
t.table.(i) <- None;
Hashtbl.remove t.hash a
| None -> ()
let rec addk (a, b) t =
match Array.length t.table with
| 0 ->
t.table <- Array.make 10 (Some (a, b));
t.size <- 1;
Hashtbl.add t.hash a 0;
0
| s when s > t.size ->
t.table.(t.size) <- Some (a,b);
Hashtbl.add t.hash a t.size;
t.size <- t.size +1;
t.size-1
t.table.(t.size) <- Some (a, b);
Hashtbl.add t.hash a t.size;
t.size <- t.size + 1;
t.size - 1
| _ ->
let t2 = Array.make (2*t.size) t.table.(0) in
Array.blit t.table 0 t2 0 t.size;
t.table <- t2;
addk (a,b) t
let t2 = Array.make (2 * t.size) t.table.(0) in
Array.blit t.table 0 t2 0 t.size;
t.table <- t2;
addk (a, b) t
let add a t = ignore (addk a t)
let foldi f e t = match Array.length t.table with
0 -> e
| _ -> let buff = ref e in
for i = 0 to t.size-1 do
match t.table.(i) with
Some v -> buff := f !buff i v;
| None -> ()
done;
!buff
let reduce f t = match Array.length t.table with
0 -> None
let foldi f e t =
match Array.length t.table with
| 0 -> e
| _ ->
let buff = ref e in
for i = 0 to t.size - 1 do
match t.table.(i) with Some v -> buff := f !buff i v | None -> ()
done;
!buff
let reduce f t =
match Array.length t.table with
| 0 -> None
| _ ->
if t.size =0 then None
else let j = ref 0 in
while !j< t.size && t.table.(!j)=None do incr j; done;
let buff = ref (fod t.table.(!j)) in
for i = (!j+1) to t.size-1 do
(* Here we cannot used t.(i) in case f reschedules the table*)
buff := f !buff (acca t i);
done;
Some (!buff)
if t.size = 0 then None
else
let j = ref 0 in
while !j < t.size && t.table.(!j) = None do
incr j
done;
let buff = ref (fod t.table.(!j)) in
for i = !j + 1 to t.size - 1 do
(* Here we cannot used t.(i) in case f reschedules the table*)
buff := f !buff (acca t i)
done;
Some !buff
let fold f e t = foldi (fun b _ a -> f b a) e t
let iteri f t = foldi (fun _ i a -> f i a) () t
let iter f t = foldi (fun _ _ a -> f a) () t
let adds t1 t2 =
iter (fun x -> add x t1) t2
let adds t1 t2 = iter (fun x -> add x t1) t2
let map f t1 =
let t2 = create () in
iter (fun (x,y) -> add (f x y) t2) t1;
iter (fun (x, y) -> add (f x y) t2) t1;
t2
let filter p t1 =
let t2 = create () in
iter (fun (x,y) -> if p x y then add (x,y) t2) t1;
iter (fun (x, y) -> if p x y then add (x, y) t2) t1;
t2
let copy t1 = map (fun x y -> x,y) t1
let copy t1 = map (fun x y -> (x, y)) t1
let size t = t.size
let sample d =
if Array.length d.table >0 then fod d.table.(0)
else raise Empty
let sample d = if Array.length d.table > 0 then fod d.table.(0) else raise Empty
let unsafe x =
assert(x>=0);
assert (x >= 0);
x
let unsafe_rev x = x
This diff is collapsed.
......@@ -118,7 +118,7 @@ module S (P:PREGRAPH) =
Printf.printf "new node: %f; %f\n" a b;
let s = Data.addk ((),(ref (P.init_state ()), ref pos )) graph.state in
`State (s)
let get_new_node_choice graph =
let get_new_node_choice _ =
[ (fun pos -> sop pos),0 ]
let shapes_of_node graph = function
......
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 '+'
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
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 print_buff s =
String.iter (fun c -> let i = ui_of_b64 c in
Printf.printf "[%i]" i
) s
String.iter
(fun c ->
let i = ui_of_b64 c in
Printf.printf "[%i]" i)
s
;;
(1 lsl 10);;
1 lsl 10
let buff_int b i =
if i>=0 && i< 32 then add_char b (b64_of_ui i)
else if i>=0 && i< (1 lsl 10) then (
let i1 = i/32 + 32
and i2 = i mod 32 in
if i >= 0 && i < 32 then add_char b (b64_of_ui i)
else if i >= 0 && i < 1 lsl 10 then (
let i1 = (i / 32) + 32 and i2 = i mod 32 in
add_char b (b64_of_ui i1);
add_char b (b64_of_ui i2);
) else
let r = max 2 ((int_of_float ((log @@ float @@ abs @@ i) /. log 2.0)+1) / 5) in
add_char b (b64_of_ui i2) )
else
let r =
max 2 ((int_of_float ((log @@ float @@ abs @@ i) /. log 2.0) + 1) / 5)
in
(*Printf.printf "r:%i " r;*)
add_char b (b64_of_ui (32 + (if i<0 then 16 else 0) + ((abs i) lsr (r*5))));
let j = ref ((abs i) mod (1 lsl (5*r))) in
let r2 = ref (r*5) in
add_char b
(b64_of_ui (32 + (if i < 0 then 16 else 0) + (abs i lsr (r * 5))));
let j = ref (abs i mod (1 lsl (5 * r))) in
let r2 = ref (r * 5) in
while !r2 > 0 do
(* print_string ((string_of_int !r2)^":");
print_endline (string_of_int !j);*)
r2:= !r2-5;
add_char b (b64_of_ui ((if !r2>0 then 32 else 0) + (!j lsr !r2)));
j:= !j mod (1 lsl !r2);
(* print_string ((string_of_int !r2)^":");
print_endline (string_of_int !j);*)
r2 := !r2 - 5;
add_char b (b64_of_ui ((if !r2 > 0 then 32 else 0) + (!j lsr !r2)));
j := !j mod (1 lsl !r2)
done
let int_buff s pos =
let r = ref 0 in
while ui_of_b64 s.[pos+ !r] >= 32 do incr r done;
while ui_of_b64 s.[pos + !r] >= 32 do
incr r
done;
let i1 = ui_of_b64 s.[pos] in
if !r =0 then pos+1,i1
else if !r =1 then
let i2 = ui_of_b64 s.[pos+1] in
pos+2, (i1 mod (1 lsl 5))*(1 lsl 5) + i2
if !r = 0 then (pos + 1, i1)
else if !r = 1 then
let i2 = ui_of_b64 s.[pos + 1] in
(pos + 2, (i1 mod (1 lsl 5) * (1 lsl 5)) + i2)
else
let j = ref (i1 mod 16) in
let r2 = ref 1 in
while !r2 <= !r do
let i2 = ui_of_b64 s.[pos+ !r2] in
j := (!j lsl 5) + ( i2 mod 32);
incr r2;
let i2 = ui_of_b64 s.[pos + !r2] in
j := (!j lsl 5) + (i2 mod 32);
incr r2
done;
if (i1 mod 32) >=16 then pos+ !r2, (- !j)
else pos+ !r2, !j
if i1 mod 32 >= 16 then (pos + !r2, - !j) else (pos + !r2, !j)
(*let buff_int b i =
let ui = (i + (1 lsl 17)) mod (1 lsl 18) in
......@@ -82,9 +86,10 @@ let int_buff s pos =
let buff_float b f =
let i = int_of_float (f *. 100.0) in
buff_int b i
let float_buff b pos =
let p,f = int_buff b pos in
p, ((float_of_int f) /. 100.)
let p, f = int_buff b pos in
(p, float_of_int f /. 100.)
(*
let check i =
......@@ -133,58 +138,55 @@ let _ =
let buff_string b str =
let n = String.length str in
buff_int b (((n+2)/3)*4);
buff_int b ((n + 2) / 3 * 4);
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
pi (v1 / 4);
( 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 '=' );
pos := !pos + 3
done
let string_buff b pin =
let p,n = int_buff b pin in
let p, n = int_buff b pin in
let pos = ref p in
let pos2 = ref 0 in
let str = Bytes.create ((n/4)*3) in
while !pos < n+p do
let str = Bytes.create (n / 4 * 3) in
while !pos < n + p do
let v1 = ui_of_b64 b.[!pos] in
let v2 = ui_of_b64 b.[!pos+1] in
Bytes.set str !pos2 @@ char_of_int (v1*4 + v2/16);
if b.[!pos+2] <> '=' then
let v3 = ui_of_b64 b.[!pos+2] in
if b.[!pos+3] <> '=' then
let v4 = ui_of_b64 b.[!pos+3] in
Bytes.set str (!pos2+1) @@ char_of_int ((v2 mod 16)*16 + v3/4);
Bytes.set str (!pos2+2) @@ char_of_int ((v3 mod 4)*64 + v4);
pos2:= !pos2+3;
else begin
Bytes.set str (!pos2+1) @@ char_of_int ((v2 mod 16)*16 + v3/4);
pos2:= !pos2+2;
end;
else pos2:= !pos2+1;
pos:= !pos+4;
let v2 = ui_of_b64 b.[!pos + 1] in
Bytes.set str !pos2 @@ char_of_int ((v1 * 4) + (v2 / 16));
if b.[!pos + 2] <> '=' then
let v3 = ui_of_b64 b.[!pos + 2] in
if b.[!pos + 3] <> '=' then (
let v4 = ui_of_b64 b.[!pos + 3] in
Bytes.set str (!pos2 + 1) @@ char_of_int ((v2 mod 16 * 16) + (v3 / 4));
Bytes.set str (!pos2 + 2) @@ char_of_int ((v3 mod 4 * 64) + v4);
pos2 := !pos2 + 3 )
else (
Bytes.set str (!pos2 + 1) @@ char_of_int ((v2 mod 16 * 16) + (v3 / 4));
pos2 := !pos2 + 2 )
else pos2 := !pos2 + 1;
pos := !pos + 4
done;
!pos,Bytes.sub_string str 0 !pos2;;
(!pos, Bytes.sub_string str 0 !pos2)
(*let t = Buffer.create 1000 in
buff_int t (-5024);
......@@ -197,55 +199,71 @@ let string_buff b pin =
string_buff str p*)
let buff_list b f l =
List.iter (fun x -> Buffer.add_char b 'l'; f b x) l
List.iter
(fun x ->
Buffer.add_char b 'l';
f b x)
l
let rec list_buff b f pos =
if pos < String.length b && b.[pos] = 'l' then
let p,le = f b (pos+1) in
let p2,lq = list_buff b f p in
p2,le::lq
else pos,[]
let p, le = f b (pos + 1) in
let p2, lq = list_buff b f p in
(p2, le :: lq)
else (pos, [])
let id l =
let id l =
let t = Buffer.create 10 in
buff_list t buff_int l;
let s = Bytes.to_string @@ Buffer.to_bytes t in
let l2 = snd @@ list_buff s int_buff 0 in
l =l2;;
l = l2
let buff_attribute b = function
`Color c -> Buffer.add_char b 'c'; buff_string b c
| `ControlPoint (f1,f2)-> Buffer.add_char b 'P'; buff_float b f1; buff_float b f2
| `String s -> Buffer.add_char b 'S'; buff_string b s
| `Color c ->
Buffer.add_char b 'c';
buff_string b c
| `ControlPoint (f1, f2) ->
Buffer.add_char b 'P';
buff_float b f1;
buff_float b f2
| `String s ->
Buffer.add_char b 'S';
buff_string b s
| `Choice sl -> buff_list b buff_string sl
| `Check true -> Buffer.add_char b 'B';Buffer.add_char b 't'
| `Check false -> Buffer.add_char b 'B';Buffer.add_char b 'f'
let attribute_buff b pos = match b.[pos] with
'c' -> let p,s = string_buff b (pos+1) in
p,(`Color s)
| 'P' -> let p1,f1 = float_buff b (pos+1) in
let p2,f2 = float_buff b p1 in p2,`ControlPoint (f1,f2)
| 'S' -> let p,s = string_buff b (pos+1) in
p,(`String s)
| 'd' -> let p,s = list_buff b string_buff (pos+1) in
p,(`Choice s)
| 'B' when b.[pos+1]='t' -> (pos+2,(`Check true))