Commit 2dc66985 authored by Benoît Barbot's avatar Benoît Barbot
Browse files

progressé

parent 69a96f9f
......@@ -20,6 +20,11 @@ let is_prefix s t =
if String.sub s 0 n = t then Some (String.sub s n (String.length s-n))
else None
else None
let get_attribute t l =
List.fold_left (fun v at ->
(match is_prefix at t with Some x -> Some x | _ ->v);
) None l
let draw_state (s,at) p =
let draw = ref false
......@@ -72,19 +77,29 @@ let get_new_state_attr (s,at) _ = [
]
let init_arc n1 n2 = Some (["->"],[])
let init_arc n1 n2 =
if n1 <> n2 then Some (["->"],[])
else Some (["->";"loop"],[])
let draw_arc (_,cn) (source_sh,target_sh) =
let draw_arc (at,cn) (source_sh,target_sh) =
let open DrawingGeom in
let text = "" in
let pos1 = center_shape source_sh
and pos2 = center_shape target_sh in
let text = "" in
let middle = mult 0.5 (pos1 +.. pos2) in
let rho = angle (pos1 -..pos2) in
let textvect = middle +.. rot rho (0.0,8.0) in
let shape_list = shapes_of_path source_sh cn ~arrow2:(Some (fun x y -> `Arrow (x,y))) target_sh in
shape_list @ [`Colors ("black","black") ; `Text(textvect, text); `Colors ("black","white")]
if source_sh<>target_sh || cn<>[] then begin
let middle = mult 0.5 (pos1 +.. pos2) in
let rho = angle (pos1 -..pos2) in
let textvect = middle +.. rot rho (0.0,8.0) in
let shape_list = shapes_of_path source_sh cn ~arrow2:(Some (fun x y -> `Arrow (x,y))) target_sh in
shape_list @ [`Colors ("black","black") ; `Text(textvect, text); `Colors ("black","white")]
end else begin
let p1 = pos1 +.. (-.25.0, 40.0)
and p2 = pos2 +.. (25.0, 40.0) in
let textvect = pos1 +.. (120.0,0.0) in
let shape_list = shapes_of_path source_sh [`ControlPoint p1; `ControlPoint p2] ~arrow2:(Some (fun x y -> `Arrow (x,y))) target_sh in
shape_list @ [`Colors ("black","black") ; `Text(textvect, text); `Colors ("black","white")]
end
(* let _,bline = List.fold_left (fun (pi,l) pip -> (pip, `Bezier2 (pi,(0.0,0.0),pip) :: l))
(pos1,[`Arrow (pos2,List.hd (List.rev point_list)) ;`Colors ("black","black") ; `Text(textvect, text); `Colors ("black","white")] )
......
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