diff --git a/examples/slider.ml b/examples/slider.ml index 831f8c2..ea5b849 100644 --- a/examples/slider.ml +++ b/examples/slider.ml @@ -22,11 +22,12 @@ let () = ~id:"my-slider" ~label:"Important slider, slide carefully" ~datalist_id:(Some datalist.datalist_id) in - append_el_to_main slider.slider_el; + append_el_to_main slider.el; (* don't forget to add datalist to document too! *) append_el_to_main datalist.datalist_el; (* add listener on slider change *) Slippery_slidy.add_slider_input_listener slider (fun x -> Printf.printf "slider value: %f !!@." x ); + Slippery_slidy.mk_dragable slider; () diff --git a/examples/style.css b/examples/style.css new file mode 100644 index 0000000..a1dd884 --- /dev/null +++ b/examples/style.css @@ -0,0 +1,12 @@ +.slippery-slidy-container { + display: flex; + flex-direction: column; + position: fixed; + top: 5vh; + left: 5vw; + background-color: black; + color: white; + opacity: 0.7; + padding-block: 2vh; + padding-inline: 1vw; +} diff --git a/lib/slippery_slidy.ml b/lib/slippery_slidy.ml index 39c72d3..3a42549 100644 --- a/lib/slippery_slidy.ml +++ b/lib/slippery_slidy.ml @@ -6,8 +6,9 @@ type datalist = } type slider = - { slider_id : string - ; slider_el : El.t + { id : string + ; el : El.t + ; actual_slider_el : El.t } (* Any is for continuous slider *) @@ -15,6 +16,10 @@ type step_kind = | Any | Step_value of float +let container_class = "slippery-slidy-container" + +let slider_class = "slippery-slidy-slider" + let step_to_string step = match step with Any -> "any" | Step_value f -> Float.to_string f @@ -60,7 +65,7 @@ let mk_slider : ; 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") + ; At.class' (Jstr.v slider_class) ] ) () in @@ -71,10 +76,10 @@ let mk_slider : in let slider_container_el = El.div ~d:G.document - ~at:[ At.class' (Jstr.v "slippery-slidy-container") ] + ~at:[ At.class' (Jstr.v container_class) ] [ label; input_el ] in - { slider_id = id; slider_el = slider_container_el } + { id; el = slider_container_el; actual_slider_el = input_el } let add_slider_input_listener slider f = (* we do not use Ev.input because it makes a Ev.Input.t but: @@ -94,7 +99,67 @@ let add_slider_input_listener slider f = let x = float_of_string (Jv.to_string value) in f x in - let target = El.as_target slider.slider_el in + let target = El.as_target slider.el in let input_ev = Ev.Type.create (Jstr.v "input") in let _ : Ev.listener = Ev.listen input_ev handler target in () + +let mk_dragable slider = + let el = slider.el in + let body = Document.body G.document in + let drag_state = ref None in + + let slider_on_mousedown evt = + let evt = Ev.as_type evt in + let offset_x = El.bound_x el -. Ev.Mouse.client_x evt in + let offset_y = El.bound_y el -. Ev.Mouse.client_y evt in + drag_state := Some (offset_x, offset_y); + (* add css so nothing get highlighted *) + El.set_inline_style (Jstr.v "user-select") (Jstr.v "none") body; + El.set_inline_style (Jstr.v "pointer-events") (Jstr.v "none") body; + El.set_inline_style (Jstr.v "pointer-events") (Jstr.v "auto") el; + () + in + + let slider_on_mouseup _evt = + drag_state := None; + (* rm css *) + El.set_inline_style (Jstr.v "user-select") (Jstr.v "") body; + El.set_inline_style (Jstr.v "pointer-events") (Jstr.v "") body; + El.set_inline_style (Jstr.v "pointer-events") (Jstr.v "") el; + () + in + + let slider_on_mousemove evt = + match !drag_state with + | None -> () + | Some (offset_x, offset_y) -> + let evt = Ev.as_type evt in + let x = Ev.Mouse.client_x evt in + let y = Ev.Mouse.client_y evt in + El.set_inline_style El.Style.left + (Jstr.v (Format.sprintf "%fpx" (x +. offset_x))) + el; + El.set_inline_style El.Style.top + (Jstr.v (Format.sprintf "%fpx" (y +. offset_y))) + el; + () + in + + let slider_target = El.as_target el in + let _ : Ev.listener = + Ev.listen Ev.mousedown slider_on_mousedown slider_target + in + let _ : Ev.listener = Ev.listen Ev.mouseup slider_on_mouseup slider_target in + let window_target = Window.as_target G.window in + let _ : Ev.listener = + Ev.listen Ev.mousemove slider_on_mousemove window_target + in + + (* ignore dragging on actual slider *) + let stop_on_mousedown evt = Ev.stop_propagation evt in + let actual_slider_target = El.as_target slider.actual_slider_el in + let _ : Ev.listener = + Ev.listen Ev.mousedown stop_on_mousedown actual_slider_target + in + () diff --git a/lib/slippery_slidy.mli b/lib/slippery_slidy.mli index 7cab8a9..760707a 100644 --- a/lib/slippery_slidy.mli +++ b/lib/slippery_slidy.mli @@ -5,9 +5,13 @@ type datalist = ; datalist_el : El.t } +(** - [id] is the id of the actual_slider_el element + - [el] is the slider container element + - [actual_slider_el] is the input slider *) type slider = - { slider_id : string - ; slider_el : El.t + { id : string + ; el : El.t + ; actual_slider_el : El.t } (** Any is for continuous slider *) @@ -34,3 +38,6 @@ val mk_slider : -> slider val add_slider_input_listener : slider -> (float -> unit) -> unit + +(** setup listener to drag and move slider with mouse *) +val mk_dragable : slider -> unit