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

pb update def

parent c6f42eb1
Pipeline #1745 failed with stage
in 26 seconds
......@@ -14,7 +14,7 @@
let string_of_reset r =
Printf.sprintf "{%s}" (List.fold_left (fun x s -> if x="" then s else x^","^s) "" r)
let init_def () = []
let init_def () = ["x";"y"]
let init_arc _ _ = Some ("a","true",[])
let state_id = ref 0
......@@ -43,6 +43,27 @@
shapes_of_path source_sh [`ControlPoint p1; `Text (0.5,text);`ControlPoint p2] ~arrow2:(Some (fun x y -> `Arrow (x,y))) target_sh
end
let get_def_attr def =
"Clocks", (List.mapi (fun i c -> i,"clock "^(string_of_int i),`String c) def)
let get_new_def_attr def =
let n = List.length def in
["clock "^(string_of_int n),
(fun d2 -> d2 @ [ ("clock_"^(string_of_int n))],n) ]
let update_def_attr def attr_id = function
| Some (`String st) ->
let _,listat = List.fold_left (fun (i,l) at ->
if i=attr_id then
(i+1, st::l) else (i+1, at::l)) (0,[]) def in
Some (List.rev listat)
| None ->
let _,listat = List.fold_left (fun (i,l) nat ->
match attr_id with
j when i=j -> i+1,l
| _ -> (i+1, nat::l)) (0,[]) def in
Some (List.rev listat)
| Some _ -> None
let get_state_attr (s,inv,init,final) =
"State", [(0,"content",`String s) ;
......
......@@ -23,6 +23,11 @@ module type PREGRAPH =
val get_arc_attr: arc -> string*( (attribute_id * string * attribute) list)
val update_arc_attr: arc -> attribute_id -> attribute option -> arc option
val get_def_attr: def -> string*(( attribute_id*string* attribute) list)
val update_def_attr: def -> attribute_id -> attribute option -> def option
val get_new_def_attr: def -> (string * (def -> def*attribute_id)) list
val parse_file : string -> (state -> DrawingGeom.point -> 'nodeid) -> (arc -> 'nodeid -> 'nodeid -> unit) -> unit
val print: (string * (Format.formatter ->
(( int -> state -> (float*float) -> unit) -> unit) ->
......@@ -70,52 +75,6 @@ module S (P:PREGRAPH) =
let new_graph () = { def= P.init_def (); state= Data.create (); arc=Data.create ()}
let shapes_of_arc graph pos1 pos2 = function
| `Empty -> []
| `Arc a -> P.draw_arc (arc_from_key graph a) (pos1,pos2)
let remove_arc graph = function
`Empty -> ()
| `Arc (n) -> Data.remove graph.arc n
let get_arc_attribute graph = function
`Empty -> "",[]
| `Arc k -> P.get_arc_attr (arc_from_key graph k)
let update_arc_attribute graph arct attr_id attr_value =
match arct with
`Empty -> true
| `Arc k ->
let (),(arc,_,_) = Data.acca graph.arc k in
match P.update_arc_attr !arc attr_id attr_value with
None -> false
| Some newarc -> arc := newarc; true
let get_new_arc_attribute graph = function
`Empty -> []
| `Arc k ->
let _,(a,n1,n2) = Data.acca graph.arc k in
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 () -> 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
let _,(n1,_) = Data.acca graph.state n1i
and _,(n2,_) = Data.acca graph.state n2i in
match P.init_arc !n1 !n2 with
Some a -> Some (`Arc (Data.addk ((),(ref a,n1i,n2i)) graph.arc))
| None -> None end
| _ -> None
let nodes_of_arc graph = function
`Empty -> (`Empty,`Empty)
| `Arc (k) ->
let _,(_,n1,n2) = Data.acca graph.arc k in
(`State n1, `State n2)
let iter_arc graph f =
Data.iteri (fun k _ -> f (`Arc k)) graph.arc
let remove_node graph = function
`Empty -> ()
| `State (p) ->
......@@ -124,21 +83,24 @@ module S (P:PREGRAPH) =
Data.remove graph.state p
let get_new_node_attribute graph = function
`Empty -> []
`Empty -> let l = P.get_new_def_attr graph.def in
List.map (fun (an,f) -> an,(fun () -> let ns,id = f graph.def in graph.def <- ns;id)) l
| `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 () -> let ns,id = f !s in s := ns;id)) l
let get_node_attribute graph = function
`Empty -> "",[]
`Empty -> P.get_def_attr graph.def
| `State n ->
let _,(s,_) = Data.acca graph.state n in
P.get_state_attr !s
let update_node_attribute graph node attr_id newv =
match node with
`Empty -> false
`Empty -> (match P.update_def_attr graph.def attr_id newv with
| None -> false
| Some d2 -> graph.def <- d2; true)
| `State n ->
let _,(s,_) = Data.acca graph.state n in
match P.update_state_attr !s attr_id newv with
......@@ -166,6 +128,53 @@ module S (P:PREGRAPH) =
let iter_node graph f =
Data.iteri (fun k _ -> f (`State k) 0) graph.state
let shapes_of_arc graph pos1 pos2 = function
| `Empty -> []
| `Arc a -> P.draw_arc (arc_from_key graph a) (pos1,pos2)
let remove_arc graph = function
`Empty -> ()
| `Arc (n) -> Data.remove graph.arc n
let get_arc_attribute graph = function
`Empty -> P.get_def_attr graph.def
| `Arc k -> P.get_arc_attr (arc_from_key graph k)
let update_arc_attribute graph arct attr_id attr_value =
match arct with
`Empty -> true
| `Arc k ->
let (),(arc,_,_) = Data.acca graph.arc k in
match P.update_arc_attr !arc attr_id attr_value with
None -> false
| Some newarc -> arc := newarc; true
let get_new_arc_attribute graph = function
`Empty -> get_new_node_attribute graph `Empty
| `Arc k ->
let _,(a,n1,n2) = Data.acca graph.arc k in
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 () -> 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
let _,(n1,_) = Data.acca graph.state n1i
and _,(n2,_) = Data.acca graph.state n2i in
match P.init_arc !n1 !n2 with
Some a -> Some (`Arc (Data.addk ((),(ref a,n1i,n2i)) graph.arc))
| None -> None end
| _ -> None
let nodes_of_arc graph = function
`Empty -> (`Empty,`Empty)
| `Arc (k) ->
let _,(_,n1,n2) = Data.acca graph.arc k in
(`State n1, `State n2)
let iter_arc graph f =
Data.iteri (fun k _ -> f (`Arc k)) graph.arc
let print_graph =
List.map (fun (name, pfun , file_name) ->
name, (fun out graph ->
......
......@@ -83,7 +83,7 @@ let option ?(def=false) value =
let choice_input ?(class_ = "") ?(init_value=None) ?(on_change = fun _ -> ()) sl =
let sel = Dom_html.(createSelect document) in
List.iter (fun s -> append_node sel (option ~def:(match init_value with None -> false | Some x -> x=s) s)) sl;
List.iter (fun s -> append_node sel (option ~def:(match init_value with None -> false | Some x -> x=s) s)) (">"::sl) ;
let on_input _ = on_change (Js.to_string sel##.value); Js._true in
sel##.oninput := Dom.handler on_input;
sel##.className := Js.string class_;
......
Markdown is supported
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