Commit 238c6b02 authored by Benoit Barbot's avatar Benoit Barbot
Browse files

add check

parent 342c511c
Pipeline #1742 failed with stage
in 26 seconds
......@@ -6,6 +6,7 @@
type arc = string * guard * string list
type attribute_id = int
type attribute = [ `Choice of string list
| `Check of bool
| `ControlPoint of DrawingGeom.point
| `String of string
| `Color of string ]
......@@ -13,10 +14,6 @@
let string_of_reset r =
Printf.sprintf "{%s}" (List.fold_left (fun x s -> if x="" then s else x^","^s) "" r)
let list_of_bool b =
if b then ["true"; "false"]
else ["false"; "true"]
let init_def () = []
let init_arc _ _ = Some ("a","true",[])
......@@ -50,8 +47,8 @@
let get_state_attr (s,inv,init,final) =
"State", [(0,"content",`String s) ;
(1,"invariant", `String inv) ;
(2, "initial", `Choice (list_of_bool init)) ;
(3, "final", `Choice (list_of_bool final))
(2, "initial", `Check init) ;
(3, "final", `Check final)
]
let update_state_attr (s,inv,init,final) attr_id = function
......@@ -64,10 +61,10 @@
Some (newv,inv,init,final)
| Some (`String newinv) when attr_id = 1 ->
Some (s,newinv,init,final)
| Some (`Choice (v::_)) when attr_id =2 ->
Some (s,inv,v="true",final)
| Some (`Choice (v::_)) when attr_id =3 ->
Some (s,inv,init,v="true")
| Some (`Check b) when attr_id =2 ->
Some (s,inv,b,final)
| Some (`Check b) when attr_id =3 ->
Some (s,inv,init,b)
| _ -> None
let get_new_state_attr (s,inv,init,final) _ = []
......@@ -93,6 +90,7 @@
| `StringExpr s -> s
| `Choice (t::_) -> t
| `Choice [] -> ""
| `Check b -> string_of_bool b
| `ControlPoint _ -> ""
let print =
......
......@@ -6,6 +6,7 @@ module type PREGRAPH =
type attribute_id
type attribute = [ `String of string
| `Choice of string list
| `Check of bool
| `ControlPoint of DrawingGeom.point
| `Color of string]
......
......@@ -207,6 +207,8 @@ let buff_attribute b = function
| `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
......@@ -218,6 +220,8 @@ let attribute_buff b pos = match b.[pos] with
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))
| 'B' when b.[pos+1]='f' -> (pos+2,(`Check false))
| _ -> failwith "bad serialization"
......
......@@ -8,6 +8,7 @@ module type GRAPH = sig
type attribute_id
type attribute = [ `String of string
| `Choice of string list
| `Check of bool
| `ControlPoint of DrawingGeom.point
| `Color of string
]
......@@ -390,7 +391,8 @@ let rec html_of_attr s attr nattr cb =
`ControlPoint pt -> `ControlPoint pt
| `Choice _ -> `Choice [newv]
| `Color _ -> `Color newv
| `String _ -> `String newv in
| `String _ -> `String newv
| `Check _ -> `Check (bool_of_string newv) in
let v = match s.selected_obj with
Node node -> let v2= G.update_node_attribute s.graph node id (Some nva) in
if v2 then
......@@ -425,6 +427,11 @@ let rec html_of_attr s attr nattr cb =
txt (Printf.sprintf ": (%g,%g)" x y); ];
td [ ];
td [delbutton] ]
| `Check b ->
tr [ td [txt n ;
txt ": "; ];
td [ check_input ~on_change:(callback id v) b ];
td [delbutton]]
| `Choice ((str::_) as l) ->
tr [ td [txt n ;
txt ": "; ];
......
......@@ -89,6 +89,17 @@ let choice_input ?(class_ = "") ?(init_value=None) ?(on_change = fun _ -> ()) sl
sel##.className := Js.string class_;
(sel :> t)
let check_input ?(class_ = "") ?(on_change = fun _ -> true) value =
let input = Dom_html.(createInput ~_type: (Js.string "checkbox") document) in
input##.checked := Js.bool value;
let on_input _ =
let b = string_of_bool (Js.to_bool input##.checked) in
let _ = on_change b in
Js._true in
input##.oninput := Dom.handler on_input;
input##.className := Js.string class_;
(input :> t)
let text_input ?(class_ = "") ?(on_change = fun _ -> true) ?(_type="text") value =
(*let input2 = input ~a:[a_input_type `Text] () in
......
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