From 1260b102c2a757d3f1a96545e06063a8f5f7d2a9 Mon Sep 17 00:00:00 2001 From: Idir Lankri Date: Thu, 12 Apr 2018 11:51:01 +0200 Subject: [PATCH 1/6] Import the code for color picker from the ocsigen-widgets project --- src/widgets/ot_color_picker.eliom | 191 +++++++++++++++++++++++++++++ src/widgets/ot_color_picker.eliomi | 29 +++++ 2 files changed, 220 insertions(+) create mode 100644 src/widgets/ot_color_picker.eliom create mode 100644 src/widgets/ot_color_picker.eliomi diff --git a/src/widgets/ot_color_picker.eliom b/src/widgets/ot_color_picker.eliom new file mode 100644 index 00000000..d85e64de --- /dev/null +++ b/src/widgets/ot_color_picker.eliom @@ -0,0 +1,191 @@ +(* Ocsigen-widgets + * http://www.ocsigen.org/ocsigen-widgets + * + * Copyright (C) 2014 Université Paris Diderot + * Enguerrand Decorne + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, with linking exception; + * either version 2.1 of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + *) + +[%%client + type t = { hue_canvas : Dom_html.canvasElement Js.t; + hue_cover : Dom_html.canvasElement Js.t; + sv_canvas : Dom_html.canvasElement Js.t; + sv_cover : Dom_html.canvasElement Js.t; + width : int; + mutable rgb : int * int * int } + + let set_point rgbdata x y w (r, g, b) = + let line_offset = (int_of_float y) * w in + let offset = ((int_of_float x) + line_offset) * 4 in + Dom_html.pixel_set rgbdata (offset + 0) (int_of_float r); + Dom_html.pixel_set rgbdata (offset + 1) (int_of_float g); + Dom_html.pixel_set rgbdata (offset + 2) (int_of_float b); + Dom_html.pixel_set rgbdata (offset + 3) 255 + + let hsv_to_rgb h s v = + let c = v *. s in + let h1 = h /. 60. in + let x = c *. (1. -. (abs_float ((mod_float h1 2.) -. 1.))) in + let m = v -. c in + let r, g, b = + match h1 with + | _ when h1 < 1. -> c, x, 0. + | _ when h1 < 2. -> x, c, 0. + | _ when h1 < 3. -> 0., c, x + | _ when h1 < 4. -> 0., x, c + | _ when h1 < 5. -> x, 0., c + | _ when h1 <= 6. -> c, 0., x + | _ -> 0., 0., 0. in + 255. *. (r +. m), + 255. *. (g +. m), + 255. *. (b +. m) + + let get_ctx canvas = canvas##(getContext (Dom_html._2d_)) + + let draw_hue_cover colorp x = + let ctx = get_ctx colorp.hue_cover in + colorp.hue_cover##.width := 360; + ctx##.strokeStyle := Js.string "rgba(255, 255, 255, 192)"; + ctx##(strokeRect x (0.) (1.) (20.)) + + let draw_sv_cover colorp x y = + let ctx = get_ctx colorp.sv_cover in + let pi = 4.0 *. atan 1.0 in + colorp.sv_cover##.width := colorp.width; + ctx##.strokeStyle := Js.string "rgba(255, 255, 255, 192)"; + ctx##beginPath; + ctx##(arc x y (5.) (0.) ((2. *. pi)) (Js._false)); + ctx##stroke + + let draw_hue ctx width = + let image = ctx##(createImageData (360) (20)) in + let rgbdata = image##.data in + let w = 360. in + let inc = 360. /. 360. in + let rec aux i = + if i >= w then () else + begin + let rgb = hsv_to_rgb i 1. 1. in + for y=0 to 20 do + set_point rgbdata i (float_of_int y) 360 rgb; + done; + aux (i +. inc) + end + in aux 0.; + ctx##(putImageData image (0.) (0.)) + + let draw_sv ctx hue x y (size : int) = + let size' = float_of_int size in + let image = ctx##(createImageData size size) in + let rgbdata = image##.data in + let cur_inc i = (1. /. size') *. i in + let rec inner_aux s v = + if s >= size' then () else + begin + let rgb = hsv_to_rgb hue (cur_inc v) (cur_inc s) in + set_point rgbdata (x +. s) (y +. v) size rgb; + inner_aux (s +. 1.) v + end + in let rec aux v = + if v >= size' then () else + begin + inner_aux 0. v; + aux (v +. 1.) + end in aux 0.; + ctx##(putImageData image (0.) (0.)) + + let init_handler colorp = + let get_rgb pixel = + let r = Dom_html.pixel_get pixel 0 in + let g = Dom_html.pixel_get pixel 1 in + let b = Dom_html.pixel_get pixel 2 in + r, g, b + in + let get_coord ev canvas = + let x, y = Dom_html.elementClientPosition canvas in + ev##.clientX - x, + ev##.clientY - y + in + Lwt_js_events.async + (fun () -> + Lwt_js_events.clicks colorp.sv_cover (fun ev _ -> + let x, y = get_coord ev colorp.sv_canvas in + let x', y' = float_of_int x, float_of_int y in + let ctx = get_ctx colorp.sv_canvas in + let rgbdata = ctx##(getImageData x' y' (1.) (1.))##.data in + let r, g, b = get_rgb rgbdata in + colorp.rgb <- r, g, b; + draw_sv_cover colorp x' y'; + Lwt.return () + )); + Lwt_js_events.async + (fun () -> + Lwt_js_events.clicks colorp.hue_cover (fun ev _ -> + let x, y = get_coord ev colorp.hue_canvas in + let x', y' = float_of_int x, float_of_int y in + let ctx_sv = get_ctx colorp.sv_canvas in + draw_sv ctx_sv x' 0. 0. colorp.width; + let ctx_hue = get_ctx colorp.hue_canvas in + let rgbdata = ctx_hue##(getImageData x' y' (1.) (1.))##.data in + let r, g, b = get_rgb rgbdata in + colorp.rgb <- r, g, b; + draw_hue_cover colorp x'; + let cwidth' = float_of_int colorp.width in + draw_sv_cover colorp cwidth' cwidth'; + Lwt.return () + )) + + let append_at elt colorp = + let div = Dom_html.createDiv Dom_html.document in + let div_hue = Dom_html.createDiv Dom_html.document in + let div_sv = Dom_html.createDiv Dom_html.document in + div_hue##.className := Js.string "ojw_colorpicker_sv"; + div_sv##.className := Js.string "ojw_colorpicker_hue"; + div##.className := Js.string "ojw_colorpicker"; + colorp.sv_canvas##.style##.position := Js.string "absolute"; + colorp.sv_canvas##.style##.zIndex := Js.string "-1"; + colorp.hue_canvas##.style##.position := Js.string "absolute"; + colorp.hue_canvas##.style##.zIndex := Js.string "-1"; + Dom.appendChild elt div; + Dom.appendChild div div_hue; + Dom.appendChild div div_sv; + Dom.appendChild div_hue colorp.hue_canvas; + Dom.appendChild div_hue colorp.hue_cover; + Dom.appendChild div_sv colorp.sv_canvas; + Dom.appendChild div_sv colorp.sv_cover + + let get_rgb colorp = + colorp.rgb + + let create ?(width = 100) _ = + let hue = Dom_html.createCanvas Dom_html.document in + let sv = Dom_html.createCanvas Dom_html.document in + let hue_cover = Dom_html.createCanvas Dom_html.document in + let sv_cover = Dom_html.createCanvas Dom_html.document in + let color = 0, 0, 0 in + hue##.width := 360; + hue_cover##.width := 360; + sv##.width := width; + sv_cover##.width := width; + hue##.height := 20; + hue_cover##.height := 20; + sv##.height := width; + sv_cover##.height := width; + draw_hue (get_ctx hue) width; + draw_sv (get_ctx sv) 0. 0. 0. width; + {hue_canvas = hue; hue_cover = hue_cover; sv_canvas = sv; + sv_cover = sv_cover; width = width; rgb = color } +] diff --git a/src/widgets/ot_color_picker.eliomi b/src/widgets/ot_color_picker.eliomi new file mode 100644 index 00000000..d445fdb2 --- /dev/null +++ b/src/widgets/ot_color_picker.eliomi @@ -0,0 +1,29 @@ +(* Ocsigen-widgets + * http://www.ocsigen.org/ocsigen-widgets + * + * Copyright (C) 2014 Université Paris Diderot + * Enguerrand Decorne + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, with linking exception; + * either version 2.1 of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + *) + +[%%client.start] + type t + + val create : ?width:int -> unit -> t + val append_at : Dom_html.element Js.t -> t -> unit + val init_handler : t -> unit + val get_rgb : t -> int * int * int + From 732f09edbdb3d7e05605add7bc186cf8ebf7980a Mon Sep 17 00:00:00 2001 From: Idir Lankri Date: Thu, 12 Apr 2018 11:55:45 +0200 Subject: [PATCH 2/6] Ot_color_picker: Rename function create to make This is to be consistent with other widgets of the toolkit. --- src/widgets/ot_color_picker.eliom | 2 +- src/widgets/ot_color_picker.eliomi | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/widgets/ot_color_picker.eliom b/src/widgets/ot_color_picker.eliom index d85e64de..bccda3ef 100644 --- a/src/widgets/ot_color_picker.eliom +++ b/src/widgets/ot_color_picker.eliom @@ -170,7 +170,7 @@ let get_rgb colorp = colorp.rgb - let create ?(width = 100) _ = + let make ?(width = 100) _ = let hue = Dom_html.createCanvas Dom_html.document in let sv = Dom_html.createCanvas Dom_html.document in let hue_cover = Dom_html.createCanvas Dom_html.document in diff --git a/src/widgets/ot_color_picker.eliomi b/src/widgets/ot_color_picker.eliomi index d445fdb2..1ab1bed4 100644 --- a/src/widgets/ot_color_picker.eliomi +++ b/src/widgets/ot_color_picker.eliomi @@ -22,7 +22,7 @@ [%%client.start] type t - val create : ?width:int -> unit -> t + val make : ?width:int -> unit -> t val append_at : Dom_html.element Js.t -> t -> unit val init_handler : t -> unit val get_rgb : t -> int * int * int From d4dfb9e5b38255660cec7f1e68445c5ac3ad6245 Mon Sep 17 00:00:00 2001 From: Idir Lankri Date: Thu, 12 Apr 2018 12:08:12 +0200 Subject: [PATCH 3/6] Ot_color_picker: Reformat the code --- src/widgets/ot_color_picker.eliom | 38 +++++++++++++++--------------- src/widgets/ot_color_picker.eliomi | 11 ++++----- 2 files changed, 24 insertions(+), 25 deletions(-) diff --git a/src/widgets/ot_color_picker.eliom b/src/widgets/ot_color_picker.eliom index bccda3ef..3fa08587 100644 --- a/src/widgets/ot_color_picker.eliom +++ b/src/widgets/ot_color_picker.eliom @@ -76,14 +76,14 @@ let w = 360. in let inc = 360. /. 360. in let rec aux i = - if i >= w then () else - begin - let rgb = hsv_to_rgb i 1. 1. in - for y=0 to 20 do - set_point rgbdata i (float_of_int y) 360 rgb; - done; - aux (i +. inc) - end + if i >= w then () else + begin + let rgb = hsv_to_rgb i 1. 1. in + for y=0 to 20 do + set_point rgbdata i (float_of_int y) 360 rgb; + done; + aux (i +. inc) + end in aux 0.; ctx##(putImageData image (0.) (0.)) @@ -100,11 +100,11 @@ inner_aux (s +. 1.) v end in let rec aux v = - if v >= size' then () else - begin - inner_aux 0. v; - aux (v +. 1.) - end in aux 0.; + if v >= size' then () else + begin + inner_aux 0. v; + aux (v +. 1.) + end in aux 0.; ctx##(putImageData image (0.) (0.)) let init_handler colorp = @@ -120,8 +120,8 @@ ev##.clientY - y in Lwt_js_events.async - (fun () -> - Lwt_js_events.clicks colorp.sv_cover (fun ev _ -> + (fun () -> + Lwt_js_events.clicks colorp.sv_cover (fun ev _ -> let x, y = get_coord ev colorp.sv_canvas in let x', y' = float_of_int x, float_of_int y in let ctx = get_ctx colorp.sv_canvas in @@ -130,10 +130,10 @@ colorp.rgb <- r, g, b; draw_sv_cover colorp x' y'; Lwt.return () - )); + )); Lwt_js_events.async - (fun () -> - Lwt_js_events.clicks colorp.hue_cover (fun ev _ -> + (fun () -> + Lwt_js_events.clicks colorp.hue_cover (fun ev _ -> let x, y = get_coord ev colorp.hue_canvas in let x', y' = float_of_int x, float_of_int y in let ctx_sv = get_ctx colorp.sv_canvas in @@ -146,7 +146,7 @@ let cwidth' = float_of_int colorp.width in draw_sv_cover colorp cwidth' cwidth'; Lwt.return () - )) + )) let append_at elt colorp = let div = Dom_html.createDiv Dom_html.document in diff --git a/src/widgets/ot_color_picker.eliomi b/src/widgets/ot_color_picker.eliomi index 1ab1bed4..6780e1ce 100644 --- a/src/widgets/ot_color_picker.eliomi +++ b/src/widgets/ot_color_picker.eliomi @@ -20,10 +20,9 @@ *) [%%client.start] - type t - - val make : ?width:int -> unit -> t - val append_at : Dom_html.element Js.t -> t -> unit - val init_handler : t -> unit - val get_rgb : t -> int * int * int +type t +val make : ?width:int -> unit -> t +val append_at : Dom_html.element Js.t -> t -> unit +val init_handler : t -> unit +val get_rgb : t -> int * int * int From fbb32e3c0d9df73bc27abe0993873591ae63e07b Mon Sep 17 00:00:00 2001 From: Idir Lankri Date: Thu, 12 Apr 2018 13:42:35 +0200 Subject: [PATCH 4/6] Ot_color_picker: Document the module interface --- src/widgets/ot_color_picker.eliomi | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/src/widgets/ot_color_picker.eliomi b/src/widgets/ot_color_picker.eliomi index 6780e1ce..0492fc97 100644 --- a/src/widgets/ot_color_picker.eliomi +++ b/src/widgets/ot_color_picker.eliomi @@ -20,9 +20,24 @@ *) [%%client.start] + +(** This module implements a color picker. *) + type t +(** Abstract type of color pickers. *) val make : ?width:int -> unit -> t +(** [make ?width ()] produces a color picker. [width] is the width of + the different canvases of the picker; its default value is + [100]. *) + val append_at : Dom_html.element Js.t -> t -> unit +(** [append_at elt colorp] appends the color picker [colorp] to the DOM + element [elt]. *) + val init_handler : t -> unit +(** Initializes a handler for the given color picker. *) + val get_rgb : t -> int * int * int +(** Returns the active color in the RGB format for the given color + picker. *) From 019794b94139928fdaf04ea9d15aae73d6251af3 Mon Sep 17 00:00:00 2001 From: Idir Lankri Date: Thu, 12 Apr 2018 13:54:11 +0200 Subject: [PATCH 5/6] Add the CSS skeleton for the color picker widget --- css/ot_color_picker.css | 8 ++++++++ src/widgets/ot_color_picker.eliom | 6 +++--- 2 files changed, 11 insertions(+), 3 deletions(-) create mode 100644 css/ot_color_picker.css diff --git a/css/ot_color_picker.css b/css/ot_color_picker.css new file mode 100644 index 00000000..c148c15d --- /dev/null +++ b/css/ot_color_picker.css @@ -0,0 +1,8 @@ +.ot-color-picker { +} + +.ot-color-picker-hue { +} + +.ot-color-picker-sv { +} diff --git a/src/widgets/ot_color_picker.eliom b/src/widgets/ot_color_picker.eliom index 3fa08587..b273b039 100644 --- a/src/widgets/ot_color_picker.eliom +++ b/src/widgets/ot_color_picker.eliom @@ -152,9 +152,9 @@ let div = Dom_html.createDiv Dom_html.document in let div_hue = Dom_html.createDiv Dom_html.document in let div_sv = Dom_html.createDiv Dom_html.document in - div_hue##.className := Js.string "ojw_colorpicker_sv"; - div_sv##.className := Js.string "ojw_colorpicker_hue"; - div##.className := Js.string "ojw_colorpicker"; + div_hue##.className := Js.string "ot-color-picker-hue"; + div_sv##.className := Js.string "ot-color-picker-sv"; + div##.className := Js.string "ot-color-picker"; colorp.sv_canvas##.style##.position := Js.string "absolute"; colorp.sv_canvas##.style##.zIndex := Js.string "-1"; colorp.hue_canvas##.style##.position := Js.string "absolute"; From ab7f473145a3528f7d50be5153ac4763a687efd4 Mon Sep 17 00:00:00 2001 From: Idir Lankri Date: Thu, 12 Apr 2018 14:40:37 +0200 Subject: [PATCH 6/6] Reference Ot_color_picker in the documentation --- doc/indexdoc.client | 1 + doc/manual-wiki/intro.wiki | 2 ++ 2 files changed, 3 insertions(+) diff --git a/doc/indexdoc.client b/doc/indexdoc.client index 2cf01d9b..4dc66ae2 100644 --- a/doc/indexdoc.client +++ b/doc/indexdoc.client @@ -16,6 +16,7 @@ Ot_picture_uploader Ot_nodeready Ot_noderesize + Ot_color_picker } {1 Index} diff --git a/doc/manual-wiki/intro.wiki b/doc/manual-wiki/intro.wiki index bc71208b..975ffbb5 100644 --- a/doc/manual-wiki/intro.wiki +++ b/doc/manual-wiki/intro.wiki @@ -83,6 +83,8 @@ Of course, you are free to modify the style to suit the desired look. clock-like widget that allows the user to pick a time * <>: binary toggle widget +* <>: + color picker widget === Non-widget utilities