init

lib/slippery_slidy.ml

@@ -0,0 +1,100 @@
+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
+  ()