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

prog

parent 9c2f1932
......@@ -5,7 +5,8 @@
type attribute_id = int
type attribute = [ `Choice of string list
| `ControlPoint of DrawingGeom.point
| `String of string]
| `String of string
| `Color of string ]
let init_def () = ()
......
......@@ -3,9 +3,10 @@ type def = unit
type state = string * (string list)
type arc = string list * DrawingGeom.path_elem list
type attribute_id = A | B of int | C of int
type attribute = [ `Choice of string list |
`ControlPoint of DrawingGeom.point
| `String of string ]
type attribute = [ `Choice of string list
| `ControlPoint of DrawingGeom.point
| `String of string
| `Color of string ]
let init_def () = ()
......@@ -81,7 +82,7 @@ let get_arc_attr (atlist,controllist) =
)
let update_arc_attr (at,cn) attr_id = function
Some (`String newv) ->
| Some (`String newv) ->
let _,listat = List.fold_left (fun (i,l) at ->
if attr_id = B i then
(i+1, newv::l) else (i+1, at::l)) (0,[]) at in
......@@ -95,6 +96,7 @@ let update_arc_attr (at,cn) attr_id = function
end) (0,[]) cn in
Some (at,(List.rev listcn))
| Some (`Choice _) -> None
| Some (`Color c) -> print_endline c;None
| None ->
let _,listat = List.fold_left (fun (i,l) at ->
if attr_id = B i then
......@@ -112,13 +114,6 @@ let get_new_arc_attr atlist (p1,p2) =
("Control", fun (at,cp) -> (at , cp @ [`ControlPoint (mult 0.5 (p1+..p2))]) )
]
let string_of_attribute = function
| `StringExpr s -> s
| `Choice (t::_) -> t
| `Choice [] -> ""
| `ControlPoint _ -> ""
let rec print_string_attr a = function
[] -> ()
| t::[] -> Format.fprintf a "%s" t
......
......@@ -6,7 +6,8 @@ module type PREGRAPH =
type attribute_id
type attribute = [ `String of string
| `Choice of string list
| `ControlPoint of DrawingGeom.point ]
| `ControlPoint of DrawingGeom.point
| `Color of string]
val init_def: unit -> def
val init_arc: state -> state -> arc option
......
......@@ -5,7 +5,9 @@ module type GRAPH = sig
type attribute_id
type attribute = [ `String of string
| `Choice of string list
| `ControlPoint of DrawingGeom.point ]
| `ControlPoint of DrawingGeom.point
| `Color of string
]
val iter_node : graph -> (node -> unit) -> unit
val shapes_of_node : graph -> node -> DrawingGeom.shape list
......@@ -102,23 +104,6 @@ module GraphEditor (G: GRAPH ) = struct
let color = CSS.Color.string_of_t (CSS.Color.rgb 200 200 200) in
ctx##.fillStyle := (Js.string color);
ctx##(fillRect 0.0 0.0 (float width) (float height));
(*let colors = CSS.Color.string_of_t (CSS.Color.rgb 0 0 0) in
ctx##.strokeStyle := (Js.string colors);
for i = 1 to width/100 -1 do
let x,_ = to_screen s (float (i*100),0.0) in
ctx##beginPath;
ctx##moveTo x 0.0;
ctx##lineTo x (float height);
ctx##stroke;
done;
for j = 1 to height/100 -1 do
let _,y = to_screen s (0.0,float (j*100)) in
ctx##beginPath;
ctx##moveTo 0.0 y;
ctx##lineTo (float width) y;
ctx##stroke;
done;*)
let colors = CSS.Color.string_of_t (CSS.Color.rgb 0 0 0) in
ctx##.strokeStyle := (Js.string colors)
......@@ -279,10 +264,20 @@ let rec html_of_attr s attr nattr cb =
let nva = match oldv with
`ControlPoint pt -> `ControlPoint pt
| `Choice _ -> `Choice [newv]
| `Color _ -> `Color newv
| `String _ -> `String newv in
let v = match s.selected_obj with
Node node -> G.update_node_attribute s.graph node id (Some nva)
| Arc arc -> G.update_arc_attribute s.graph arc id (Some nva)
Node node -> let v2= G.update_node_attribute s.graph node id (Some nva) in
if v2 then
begin try ignore @@ G.get_node_attribute s.graph node with
_ -> s.selected_obj <- Area [];
update_attr s; end; v2
| Arc arc -> let v2= G.update_arc_attribute s.graph arc id (Some nva) in
if v2 then
begin try ignore @@ G.get_arc_attribute s.graph arc with
_ -> s.selected_obj <- Area [];
update_attr s;end; v2
| Area [] -> G.update_arc_attribute s.graph `Empty id (Some nva)
| Area _ -> false in
draw s (0.0,0.0); v in
......@@ -299,7 +294,7 @@ let rec html_of_attr s attr nattr cb =
let delbutton =
(button ~a:[ a_onclick (callback_supr id)] [
(*span ~a:[a_class ["glyphicon";"glyphicon-remove"]] [];*) pcdata "X"]) in
match v with
match v with
| `ControlPoint (x,y) ->
tr [ td [pcdata n ;
pcdata (Printf.sprintf ": (%g,%g)" x y); ];
......@@ -316,6 +311,11 @@ let rec html_of_attr s attr nattr cb =
pcdata ": "; ];
td [ text_input ~on_change:(callback id v) str ];
td [delbutton]]
| `Color str ->
tr [ td [pcdata n ;
pcdata ": "; ];
td [ color_input ~on_change:(callback id v) str ];
td [delbutton]]
) attr in
let new_attr = tr [td [choice_input ~init_value:(Some "New Attribute") ~on_change:(fun x ->cb x) nattr]; td [] ] in
(attr_tr @ (if nattr<>[] then [new_attr] else []))
......
......@@ -25,3 +25,16 @@ let choice_input ?(class_ = "") ?(on_change = fun _ -> ()) ?(init_value=None) op
input##.oninput := Dom.handler on_input;
input##.className := Js.string class_;
input2
let color_input ?(class_ = "") ?(on_change = fun _ -> true) value =
let input2 = input ~a:[a_input_type `Color] () in
let input = Eliom_content.Html.To_dom.of_input input2 in
input##.value := Js.string value;
let on_input _ =
let res = on_change (Js.to_string input##.value) in
if res then input##.style##.color := Js.string "green"
else input##.style##.color := Js.string "red";
Js._true in
input##.oninput := Dom.handler on_input;
input##.className := Js.string class_;
input2
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