101 lines
2.9 KiB
OCaml
101 lines
2.9 KiB
OCaml
|
open Brr
|
||
|
|
|
||
|
|
type datalist =
|
||
|
|
{ datalist_id : string
|
||
|
|
; datalist_el : El.t
|
||
|
|
}
|
||
|
|
|
||
|
|
type slider =
|
||
|
|
{ slider_id : string
|
||
|
|
; slider_el : El.t
|
||
|
|
}
|
||
|
|
|
||
|
|
(* Any is for continuous slider *)
|
||
|
|
type step_kind =
|
||
|
|
| Any
|
||
|
|
| Step_value of float
|
||
|
|
|
||
|
|
let step_to_string step =
|
||
|
|
match step with Any -> "any" | Step_value f -> Float.to_string f
|
||
|
|
|
||
|
|
let mk_datalist : Jstr.t list -> string -> datalist =
|
||
|
|
fun l id ->
|
||
|
|
let option_el_l =
|
||
|
|
List.map (fun s -> El.option ~d:G.document ~at:[ At.value s ] []) l
|
||
|
|
in
|
||
|
|
let datalist =
|
||
|
|
El.datalist ~d:G.document ~at:[ At.id (Jstr.v id) ] option_el_l
|
||
|
|
in
|
||
|
|
{ datalist_id = id; datalist_el = datalist }
|
||
|
|
|
||
|
|
(* make a div of class slippery-slidy-container containing a
|
||
|
|
slider of class slippery-slidy-slider *)
|
||
|
|
let mk_slider :
|
||
|
|
min:float
|
||
|
|
-> max:float
|
||
|
|
-> step:step_kind
|
||
|
|
-> value:float
|
||
|
|
-> id:string
|
||
|
|
-> label:string
|
||
|
|
-> datalist_id:string option
|
||
|
|
-> slider =
|
||
|
|
fun ~min ~max ~step ~value ~id ~label ~datalist_id ->
|
||
|
|
(* some checks *)
|
||
|
|
let b = min <= max && value <= max && value >= min in
|
||
|
|
if not b then
|
||
|
|
raise (Invalid_argument "mk_slider: parameters did not pass validation")
|
||
|
|
else
|
||
|
|
let datalist =
|
||
|
|
match datalist_id with
|
||
|
|
| None -> []
|
||
|
|
| Some datalist_id -> [ At.v (Jstr.v "list") (Jstr.v datalist_id) ]
|
||
|
|
in
|
||
|
|
let input_el =
|
||
|
|
El.input ~d:G.document
|
||
|
|
~at:
|
||
|
|
( datalist
|
||
|
|
@ [ At.type' (Jstr.v "range")
|
||
|
|
; At.float (Jstr.v "min") min
|
||
|
|
; At.float (Jstr.v "max") max
|
||
|
|
; At.v (Jstr.v "step") (Jstr.v (step_to_string step))
|
||
|
|
; At.value (Jstr.of_float value)
|
||
|
|
; At.id (Jstr.v id)
|
||
|
|
; At.class' (Jstr.v "slippery-slidy-slider")
|
||
|
|
] )
|
||
|
|
()
|
||
|
|
in
|
||
|
|
let label =
|
||
|
|
El.label ~d:G.document
|
||
|
|
~at:[ At.for' (Jstr.v id) ]
|
||
|
|
[ El.txt' ~d:G.document label ]
|
||
|
|
in
|
||
|
|
let slider_container_el =
|
||
|
|
El.div ~d:G.document
|
||
|
|
~at:[ At.class' (Jstr.v "slippery-slidy-container") ]
|
||
|
|
[ label; input_el ]
|
||
|
|
in
|
||
|
|
{ slider_id = id; slider_el = slider_container_el }
|
||
|
|
|
||
|
|
let add_slider_input_listener slider f =
|
||
|
|
(* we do not use Ev.input because it makes a Ev.Input.t but:
|
||
|
|
"For <textarea> and <input> elements that accept
|
||
|
|
text input (type=text, type=tel, etc.), the interface is InputEvent;
|
||
|
|
for others, the interface is Event."
|
||
|
|
|
||
|
|
passing the El.t to the handler to avoid using Obj.magic to get "evt.target"
|
||
|
|
and directly doing "el.value" in the handler does not work for some reason
|
||
|
|
(we get a value="") *)
|
||
|
|
let handler evt =
|
||
|
|
(* here evt is a "Event" not a "EventInput"
|
||
|
|
no need to take Ev.as_type *)
|
||
|
|
let evt : Jv.t = Obj.magic evt in
|
||
|
|
let target : Jv.t = Jv.get evt "target" in
|
||
|
|
let value : Jv.t = Jv.get target "value" in
|
||
|
|
let x = float_of_string (Jv.to_string value) in
|
||
|
|
f x
|
||
|
|
in
|
||
|
|
let target = El.as_target slider.slider_el in
|
||
|
|
let input_ev = Ev.Type.create (Jstr.v "input") in
|
||
|
|
let _ : Ev.listener = Ev.listen input_ev handler target in
|
||
|
|
()
|