Responsive sliders

2 files changed, 84 insertions, 56 deletions

diff --git a/script.it/script.ml b/script.it/script.ml
index 131ea39..95272fb 100755
--- a/script.it/script.ml
+++ b/script.it/script.ml
@@ -77,9 +77,6 @@ let click_event el =
     Evr.unit
     el
 
-let show_value input =
-  El.txt (Jstr.of_float input)
-
 type 'a param_events =
   { width : float S.t
   ; angle : float S.t
@@ -88,8 +85,12 @@ type 'a param_events =
   ; rendering : ([> State.render_event] as 'a) E.t
   }
 
+type slider =
+  { input : El.t
+  ; legend : El.t }
+
 let set_sidebar
-  : El.t -> State.state -> _ param_events
+  : El.t -> State.state -> _ param_events * slider * slider
   = fun element state ->
 
     let open El in
@@ -122,14 +123,9 @@ let set_sidebar
                ] in
 
     let width = El.div [] in
-    Elr.def_children
-      width
-      (nib_size_event
-       |> S.map (fun v ->
-           [ txt' "Width : "
-           ; show_value v ]
-         )
-      );
+    let width_slider =
+      { input = nib_size
+      ; legend = width } in
 
     let input_angle, angle_event =
       Elements.Input.slider
@@ -140,15 +136,9 @@ let set_sidebar
                ] in
 
     let angle = El.div [] in
-    Elr.def_children
-      angle
-      (angle_event
-       |> S.map (fun v ->
-           [ txt' "Angle : "
-           ; show_value v
-           ; txt' "°" ]
-         )
-      );
+    let angle_slider =
+      { input = input_angle
+      ; legend = angle } in
 
     let render =
       El.select
@@ -156,10 +146,6 @@ let set_sidebar
             [ txt' "Fill"]
         ; El.option ~at:At.[value (Jstr.v "2")]
             [ txt' "Ductus"]
-(*
-        ; El.option ~at:At.[value (Jstr.v "3")]
-            [ txt' "Line"]
-*)
         ] in
 
     let rendering' = El.div
@@ -196,12 +182,14 @@ let set_sidebar
 
         ]
     in
-    { delete = delete_event
-    ; angle = angle_event
-    ; width = nib_size_event
-    ; export = export_event
-    ; rendering = render_event
-    }
+    ( { delete = delete_event
+      ; angle = angle_event
+      ; width = nib_size_event
+      ; export = export_event
+      ; rendering = render_event }
+    , angle_slider
+    , width_slider
+    )
 
 let backgroundColor = Blog.Nord.nord0
 let white = Jstr.v "#eceff4"
@@ -275,7 +263,7 @@ let page_main id =
 
   let timer, tick = Elements.Timer.create () in
 
-  let parameters =
+  let parameters, angle_element, width_slider =
     begin match Blog.Sidebar.get () with
       | None ->
         Jv.throw (Jstr.v "No sidebar")
@@ -284,6 +272,8 @@ let page_main id =
         Blog.Sidebar.clean el;
         set_sidebar el State.init
     end in
+
+
   let delete_event = E.map (fun () -> `Delete) parameters.delete
   and export_event = E.map (fun () -> `Export) parameters.export
   and angle_event = S.changes parameters.angle
@@ -359,6 +349,40 @@ let page_main id =
                        |> Option.iter Logr.hold in
 
 
+
+        (* Ajust the angle slide according to the state *)
+        let angle_signal = S.map (fun s -> Jstr.of_float s.State.angle) state in
+        let _ =
+          Elr.def_prop
+            Elements.Prop.value
+            angle_signal
+            angle_element.input
+
+        and _ = Elr.def_children
+            angle_element.legend
+            (S.map
+               (fun v ->
+                  [ El.txt' "Angle : "
+                  ; El.txt v
+                  ; El.txt' "°" ] )
+               angle_signal) in
+
+        let width_signal = S.map (fun s -> Jstr.of_float s.State.width) state in
+        let _ =
+          Elr.def_prop
+            Elements.Prop.value
+            width_signal
+            width_slider.input
+
+        and _ = Elr.def_children
+            width_slider.legend
+            (S.map (fun v ->
+                 [ El.txt' "Width : "
+                 ; El.txt v ]
+               )
+                width_signal
+            ) in
+
         (* Draw the canva for first time *)
         on_change canva mouse_position timer State.init;
 
diff --git a/script.it/state.ml b/script.it/state.ml
index cfde0b0..53cc861 100755
--- a/script.it/state.ml
+++ b/script.it/state.ml
@@ -77,7 +77,7 @@ let insert_or_replace state ((x, y) as p) stamp path =
 let threshold = 20.
 
 let check_selection
-  : (float * float) -> Path.Fixed.t list -> (Gg.v2 * Path.Fixed.t) option
+  : (float * float) -> Path.Fixed.t list -> (Gg.v2 * Path.Fixed.t * Path.Point.t * Path.Point.t) option
   = fun position paths ->
     let point = Gg.V2.of_tuple position in
     (* If the user click on a curve, select it *)
@@ -85,8 +85,8 @@ let check_selection
         ~init:(threshold, None)
         ~f:(fun (dist, selection) path ->
             match Path.Fixed.distance point path with
-            | Some (point', p) when p < dist ->
-              dist, Some (point', path)
+            | Some (point', p, p0, p1) when p < dist ->
+              dist, Some (point', path, p0, p1)
             | _ -> dist, selection
           ) in
     res
@@ -104,6 +104,24 @@ let update_selection id state f =
         ) in
   { state with paths }
 
+
+let select_segment point (p, selected, p0, p1) state =
+  let angle0 = Path.Point.get_angle p0
+  and angle1 = Path.Point.get_angle p1 in
+  let width0 = Path.Point.get_width p0
+  and width1 = Path.Point.get_width p1 in
+
+  let dist = Gg.V2.(norm ( p - (Gg.V2.of_tuple point))) in
+
+  let angle = angle0 +. dist *. ( angle1 -. angle0 ) in
+  let width = width0 +. dist *. ( width1 -. width0 ) in
+
+  let id = Path.Fixed.id selected in
+  { state with
+    mode = (Selection id)
+  ; angle
+  ; width }
+
 let do_action
   : Brr_webworkers.Worker.t -> Elements.Timer.t -> events -> state -> state
   = fun worker timer event state ->
@@ -130,7 +148,7 @@ let do_action
         | None ->
           (* Start a new path with the point clicked *)
           Path.Point.create ~x ~y ~angle ~width ~stamp
-        | Some (p, _) ->
+        | Some (p, _, _, _) ->
           (* If the point is close to an existing path, we use the closest
              point in the path instead *)
           let x, y = Gg.V2.to_tuple p in
@@ -149,14 +167,8 @@ let do_action
         | None ->
           { state with
             mode = Out }
-        | Some (_, selected) ->
-
-          (* Start the timer in order to handle the mouse moves *)
-
-          let id = Path.Fixed.id selected in
-          Elements.Timer.start timer 0.3;
-          { state with
-            mode = (Selection id)}
+        | Some selection ->
+          select_segment position selection state
       end
 
     | `Out point, Edit ->
@@ -167,12 +179,6 @@ let do_action
             creation. And we add the new point in the current path *)
         | Some _ ->
 
-(*
-          let point = match check_selection point state.paths with
-            | None -> point
-            | Some (p, _) -> Gg.V2.to_tuple p in
-*)
-
           let current = insert_or_replace state point stamp state.current in
           let paths =
             let last = Path.Fixed.to_fixed
@@ -191,7 +197,7 @@ let do_action
             mode = Out
           ; paths; current }
 
-        (* Else, check if there is a curve undre the cursor, and remove it *)
+        (* Else, check if there is a curve under the cursor, and remove it *)
         | None ->
           let current = Path.Path_Builder.empty in
           begin match check_selection point state.paths with
@@ -200,11 +206,9 @@ let do_action
                 mode = Out
               ; current
               }
-            | Some (_, selected) ->
-              let id = Path.Fixed.id selected in
-              { state with
-                mode = (Selection id)
-              ; current }
+            | Some selection ->
+              select_segment point selection { state with current }
+
           end
       end
     | `Delete, Selection id ->