Commit 41cb64ef authored by Benoit Barbot's avatar Benoit Barbot
Browse files

improve color

parent 4f48bb2c
Pipeline #888 failed with stage
in 11 seconds
......@@ -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)) ;
]
......
......@@ -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
......
......@@ -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"
......
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