Responsive sliders

7 files changed, 101 insertions, 60 deletions

diff --git a/elements/prop.ml b/elements/prop.ml
index 715adec..054864c 100755
--- a/elements/prop.ml
+++ b/elements/prop.ml
@@ -13,3 +13,8 @@ let offsetHeight
 let outerHTML
   : Jstr.t t
   = El.Prop.jstr (Jstr.v "outerHTML")
+
+
+let value
+  : Jstr.t t
+  = El.Prop.jstr (Jstr.v "value")
diff --git a/path/fixed.ml b/path/fixed.ml
index d20c897..7ee0705 100755
--- a/path/fixed.ml
+++ b/path/fixed.ml
@@ -141,7 +141,7 @@ module Make(Point:P) = struct
   (** Return the distance between a given point and the curve. May return
       None if the point is out of the curve *)
   let distance
-    : Gg.v2 -> t -> (Gg.v2 * float) option
+    : Gg.v2 -> t -> (Gg.v2 * float * Point.t * Point.t) option
     = fun point beziers ->
 
       Array.fold_left beziers.path
@@ -171,8 +171,8 @@ module Make(Point:P) = struct
                   let _, point' = Shapes.Bezier.get_closest_point point bezier' in
                   let distance = Gg.V2.( norm (point - point') ) in
                   match res with
-                  | None -> Some (point', distance)
-                  | Some (_, d) -> if d < distance then res else (Some (point', distance))
+                  | None -> Some (point', distance, bezier.p0, bezier.p1)
+                  | Some (_, d, _, _) -> if d < distance then res else (Some (point', distance, bezier.p0, bezier.p1))
               end
           )
 
diff --git a/path/fixed.mli b/path/fixed.mli
index c84b51d..c6af84d 100755
--- a/path/fixed.mli
+++ b/path/fixed.mli
@@ -38,7 +38,7 @@ module Make(Point:P) : sig
   (** Return the distance between a given point and the curve. May return
       None if the point is out of the curve *)
   val distance
-    : Gg.v2 -> t -> (Gg.v2 * float) option 
+    : Gg.v2 -> t -> (Gg.v2 * float * Point.t * Point.t) option
 
   val map_point
     : t -> (Point.t -> Point.t) -> t
diff --git a/path/point.ml b/path/point.ml
index 031e1e0..046c2e7 100755
--- a/path/point.ml
+++ b/path/point.ml
@@ -25,9 +25,13 @@ let copy point p =
 let set_angle p angle =
   { p with angle = Gg.Float.rad_of_deg (180. -. angle) }
 
+let get_angle { angle; _} = 180. -. (Gg.Float.deg_of_rad angle)
+
 let set_width p size =
   { p with size }
 
+let get_width { size; _} = size
+
 let (+) p1 p2 =
   { p1 with p = Gg.V2.(+) p1.p p2 }
 
diff --git a/path/point.mli b/path/point.mli
index db87a71..c897195 100755
--- a/path/point.mli
+++ b/path/point.mli
@@ -14,7 +14,11 @@ val copy : t -> Gg.v2 -> t
 
 val set_angle : t -> float -> t
 
+val get_angle : t -> float
+
 val set_width: t -> float -> t
 
+val get_width: t -> float
+
 val get_coord'
   : t -> Gg.v2
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 ->