improve color

TikzEditor/TikzGraph.ml

@@ -25,6 +25,13 @@ 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 replace_list id v l =
+  let _,listat = List.fold_left (fun (i,l) at ->
+                     if id = i then
+                       (i+1, match v with Some v -> v::l | None -> l)
+                     else (i+1, at::l)) (0,[]) l in
+  List.rev listat
   
 let draw_state (s,at) p = 
     let draw = ref false 
@@ -50,30 +57,38 @@ let draw_state (s,at) p =
                        
 let get_state_attr (s, at) =
   "Node", ((A,"content",`String s) ::
-             (List.mapi (fun i sv -> (B i),"Attribute", (`String sv )) at))
+             (List.mapi (fun i sv ->
+                  (match is_prefix sv "color=" with
+                     Some x -> B i,"color",`Color x
+                   | None -> (match is_prefix sv "fill=" with
+                               | Some x -> C i, "fill", `Color x
+                               | None ->
+                                  (B i),"Attribute", (`String sv )))) at))
+          
 let update_state_attr (s,at) attr_id = function
   | None -> begin match attr_id with
               A -> Some ("",at)
-            | B id ->
-               let _,listat = List.fold_left (fun (i,l) at ->
-                                  if id = i then
-                                    (i+1, l) else (i+1, at::l)) (0,[]) at in
-               Some (s,List.rev listat)
-            | C _ -> None;
+            | B id -> Some (s,replace_list id None at)
+            | C _ -> None
             end
   | Some (`String newv) -> begin
       match attr_id with 
         A -> Some (newv,at)
-      | B id -> let _,listat = List.fold_left (fun (i,l) at ->
-                                   if id = i then
-                                     (i+1, newv::l) else (i+1, at::l)) (0,[]) at in
-                Some (s,List.rev listat)
+      | B id -> Some (s,replace_list id (Some newv) at)
       | C _ -> None
     end
+  | Some (`Color newv) -> begin
+      match attr_id with 
+        A -> Some (newv,at)
+      | B id -> Some (s,replace_list id (Some ("color="^newv)) at)
+      | C id -> Some (s,replace_list id (Some ("fill="^newv)) at)
+    end
   | _ -> None
   
 let get_new_state_attr (s,at) _ = [
-    "Attribute", fun (s,at) -> (s, at@[""]), B (List.length at) 
+    "Attribute", (fun (s,at) -> (s, at@[""]), B (List.length at)) ;
+    "color", (fun (s,at) -> (s, at@["color=black"]), B (List.length at)) ;
+    "fill", (fun (s,at) -> (s, at@["fill=black"]), B (List.length at)) ;
   ]
 
 

editor/DrawingGeom.ml

@@ -43,6 +43,14 @@ module Color = struct
     | "green" -> (0,255,0)
     | "blue" -> (0,0,255)
     | "white" -> (255,255,255)
+    | "brown" -> (165,42,42)
+    | "orange" -> (255,165,0)
+    | "cyan" -> (0,255,255)
+    | "fuchsia" -> (255,0,255)
+    | "yellow" -> (255,255,0)
+    | "darkgray" -> (169,169,169)
+    | "gray" -> (128,128,128)
+    | "lightgray" -> (211,211,211)
     | x when x.[0]='#' -> begin try
        let int_of_l = function '0'->0|'1'->1|'2'->2|'3'->3
                                |'4'->4|'5'->5|'6'->6|'7'->7
@@ -53,6 +61,15 @@ module Color = struct
        (ios x.[1] x.[2],ios x.[3] x.[4],ios x.[5] x.[6])
        with _ -> (0,0,0) end
     | _ -> (0,0,0)
+
+  let to_string (r,g,b) =
+      let loi = function 0->'0'  |1->'1'|2->'2'|3->'3'
+                               |4->'4'|5->'5'|6->'6'|7->'7'
+                               |8->'8'|9->'9'|10->'a'|11->'b'
+                               |12->'c'|13->'d'|14->'e'|15->'f'
+                               |_ ->'0' in
+      Printf.sprintf "#%c%c%c%c%c%c" (loi (r/16)) (loi (r mod 16))
+        (loi (g/16)) (loi (g mod 16)) (loi (b/16)) (loi (b mod 16))
       
 
 end

editor/utilsWeb.ml

@@ -27,9 +27,10 @@ let choice_input ?(class_ = "") ?(on_change = fun _ -> ()) ?(init_value=None) op
   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;
+  input##.value := Js.string (DrawingGeom.Color.to_string (DrawingGeom.Color.parse value));
   let on_input _ =
     let res = on_change (Js.to_string input##.value) in
     if res then input##.style##.color := Js.string "green"