Update

9 files changed, 115 insertions, 37 deletions

diff --git a/layer/ductusPrinter.ml b/layer/ductusPrinter.ml
index 2ee96e4..8383a9c 100755
--- a/layer/ductusPrinter.ml
+++ b/layer/ductusPrinter.ml
@@ -46,9 +46,9 @@ module Make(Repr: Repr.PRINTER) = struct
          recent point  *)
       let delay =
         ((Path.Point.get_stamp p0) -. (Path.Point.get_stamp p1))
-        *. 20.
+        *. 30.
       in
-      for i = 0 to ((Int.of_float delay) -1) do
+      for i = 0 to ((Int.of_float delay) ) do
         let ratio = (Float.of_int i) /. delay in
         let bezier', _ = Shapes.Bezier.slice ratio bezier in
 
diff --git a/layer/fillPrinter.ml b/layer/fillPrinter.ml
index 2297d15..3093ada 100755
--- a/layer/fillPrinter.ml
+++ b/layer/fillPrinter.ml
@@ -1,6 +1,47 @@
 module Point = Path.Point
+
+
+
 module Make(Repr: Repr.PRINTER) = struct
 
+  (* Divide a curve in subelements *)
+  let rec divide level p0 ctrl0 ctrl1 p1 path =
+
+    let bezier =
+      { Shapes.Bezier.p0 = Path.Point.get_coord p0
+      ; ctrl0
+      ; ctrl1
+      ; p1 = Path.Point.get_coord p1
+      } in
+
+    let ratio = 0.5 in
+    let bezier0, bezier1 = Shapes.Bezier.slice ratio bezier in
+    let point = Path.Point.mix ratio bezier0.Shapes.Bezier.p1 p0 p1 in
+
+    let ctrl0_0 = Point.copy p0 bezier0.Shapes.Bezier.ctrl0
+    and ctrl0_1 = Point.copy point bezier0.Shapes.Bezier.ctrl1
+
+    and ctrl1_0 = Point.copy point bezier1.Shapes.Bezier.ctrl0
+    and ctrl1_1 = Point.copy p1 bezier1.Shapes.Bezier.ctrl1 in
+
+
+    match level with
+    | 0 ->
+      path :=
+        Repr.quadratic_to
+          (Point.get_coord' @@ ctrl1_1)
+          (Point.get_coord' @@ ctrl1_0)
+          (Point.get_coord' point) !path;
+
+      path :=
+        Repr.quadratic_to
+          (Point.get_coord' @@ ctrl0_1)
+          (Point.get_coord' @@ ctrl0_0)
+          (Point.get_coord' p0) !path;
+    | n ->
+      divide (n-1) point (Point.get_coord ctrl1_0) (Point.get_coord ctrl1_1) p1 path;
+      divide (n-1) p0 (Point.get_coord ctrl0_0) (Point.get_coord ctrl0_1) point path;
+
   type t = Point.t
 
   type repr =
@@ -44,19 +85,24 @@ module Make(Repr: Repr.PRINTER) = struct
       let ctrl0' = Point.copy p1 ctrl0
       and ctrl1' = Point.copy p1 ctrl1 in
 
-      let path =
-        Repr.move_to (Point.get_coord p1) t.path
-        |> Repr.line_to (Point.get_coord' p1)
-        |> Repr.quadratic_to
-          (Point.get_coord' ctrl1')
-          (Point.get_coord' ctrl0')
-          (Point.get_coord' p0)
-        |> Repr.line_to (Point.get_coord p0)
-        |> Repr.quadratic_to
+      let path = Repr.move_to (Point.get_coord p1) t.path
+                 |> Repr.line_to (Point.get_coord' p1) in
+      let path = ref path in
+
+      (* Backward *)
+      divide 3 p0 ctrl0 ctrl1 p1 path ;
+      path := Repr.line_to (Point.get_coord p0) !path;
+
+      (* Forward *)
+      path := Repr.quadratic_to
           (Point.get_coord ctrl0')
           (Point.get_coord ctrl1')
-          (Point.get_coord p1)
-        |> Repr.close in
+          (Point.get_coord p1) !path;
+
+      let path = !path in
+
+      let path = Repr.close path in
+
       let path = t.close path in
       { t with path}
 
diff --git a/layer/paths.ml b/layer/paths.ml
index 59215df..927a5f9 100755
--- a/layer/paths.ml
+++ b/layer/paths.ml
@@ -85,9 +85,9 @@ let to_svg
     | `Ductus ->
       let svg_path = R.repr
           path
-          (module WireSVGRepr)
-          (WireSVGRepr.create_path (fun _ -> ()))
-                     |> WireSVGRepr.get in
+          (module DuctusSVGRepr)
+          (DuctusSVGRepr.create_path (fun _ -> ()))
+                     |> DuctusSVGRepr.get in
       Svg.path
         ~at:Brr.At.[
             v (Jstr.v "fill")  color
diff --git a/path/fixed.ml b/path/fixed.ml
index 2d42566..176d818 100755
--- a/path/fixed.ml
+++ b/path/fixed.ml
@@ -76,6 +76,9 @@ module Make(Point:P) = struct
       : int * path list -> path array
       = fun (n, t) ->
 
+        (* The array is initialized with a magic number, and just after
+           filled with the values from the list in reverse. All the elements are set.
+        *)
         let res = Obj.magic (Array.make n 0) in
         List.iteri t
           ~f:(fun i elem -> Array.set res (n - i - 1) elem );
@@ -125,10 +128,18 @@ module Make(Point:P) = struct
             ) in
       Repr.stop repr
 
+
+  type approx =
+    { distance : float
+    ; closest_point : Gg.v2
+    ; ratio : float
+    ; p0 : Point.t
+    ; p1 : Point.t }
+
   (** 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 * Point.t * Point.t) option
+    : Gg.v2 -> t -> approx option
     = fun point beziers ->
 
       Array.fold_left beziers.path
@@ -151,12 +162,16 @@ module Make(Point:P) = struct
                   ; ctrl0 = bezier.ctrl0
                   ; ctrl1 = bezier.ctrl1 }
                 ) in
-              let _, point' = Shapes.Bezier.get_closest_point point bezier' in
-              let distance = Gg.V2.( norm (point - point') ) in
+              let ratio, point' = Shapes.Bezier.get_closest_point point bezier' in
+              let distance' = Gg.V2.( norm (point - point') ) in
               match res with
-              | None -> Some (point', distance, bezier.p0, bezier.p1)
-              | Some (_, d, _, _) when d < distance -> res
-              | _ -> (Some (point', distance, bezier.p0, bezier.p1))
+              | Some {distance; _} when distance < distance' -> res
+              | _ -> Some
+                       { closest_point = point'
+                       ; distance = distance'
+                       ; p0 = bezier.p0
+                       ; p1 = bezier.p1
+                       ; ratio }
           )
 
   let map_point
diff --git a/path/fixed.mli b/path/fixed.mli
index 1f12006..06b3539 100755
--- a/path/fixed.mli
+++ b/path/fixed.mli
@@ -32,10 +32,17 @@ module Make(Point:P) : sig
   val repr
     : t -> (module Repr.M with type t = Point.t and type repr = 's) -> 's -> 's
 
+  type approx =
+    { distance : float
+    ; closest_point : Gg.v2
+    ; ratio : float
+    ; p0 : Point.t
+    ; p1 : Point.t }
+
   (** 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 * Point.t * Point.t) option
+    : Gg.v2 -> t -> approx option
 
   val iter
     : t -> f:(Point.t -> unit) -> unit
diff --git a/path/point.ml b/path/point.ml
index 4c34899..ec6f8ad 100755
--- a/path/point.ml
+++ b/path/point.ml
@@ -58,7 +58,6 @@ let get_coord'
 let mix
   : float -> Gg.v2 -> t -> t -> t
   = fun f point p0 p1 ->
-    incr internal_id;
     let angle0 = p0.angle
     and angle1 = p1.angle
     and width0 = get_width p0
diff --git a/script.it/script.ml b/script.it/script.ml
index fc64d1e..ede47be 100755
--- a/script.it/script.ml
+++ b/script.it/script.ml
@@ -281,11 +281,13 @@ let on_change canva mouse_position timer state =
         ~h:10.
         context;
 
+(*
       Cd2d.stroke_text
         context
         (Jstr.of_float @@ Path.Point.get_stamp point)
         ~x:(x +. 15.)
         ~y;
+*)
 
     | _ -> ()
   in
diff --git a/script.it/selection.ml b/script.it/selection.ml
index c0360fb..591ea38 100755
--- a/script.it/selection.ml
+++ b/script.it/selection.ml
@@ -15,8 +15,8 @@ let get_from_paths
       ~init:(threshold, None)
       ~f:(fun (dist, selection) path ->
           match Path.Fixed.distance point path with
-          | Some (point', p, p0, p1) when p < dist ->
-            dist, Some (point', path, p0, p1)
+          | Some { closest_point ; distance; p0; p1 ; ratio} when distance < dist ->
+            ratio, Some (closest_point, path, p0, p1)
           | _ -> dist, selection
         )
 
diff --git a/script.it/state.ml b/script.it/state.ml
index 585ca32..185be4f 100755
--- a/script.it/state.ml
+++ b/script.it/state.ml
@@ -111,8 +111,8 @@ let select_segment _ (_, selected, p0, p1) state dist =
 
   let point' = Path.Point.mix dist (Path.Point.get_coord p0) p0 p1 in
 
-  let angle = Path.Point.get_angle point'
-  and width = Path.Point.get_width point' in
+  let angle = (Float.round @@ 10. *. Path.Point.get_angle point') /. 10.
+  and width = (Float.round @@ 10. *. Path.Point.get_width point') /. 10. in
 
   let id = Selection.select_path selected in
   { state with
@@ -175,8 +175,9 @@ let angle angle state =
     {state with paths }
   (* Change angle localy *)
   | Selection (Point (s, point)) ->
-    update_point_selection state s point
-      (fun p -> Path.Point.set_angle p angle)
+    let state = update_point_selection state s point
+        (fun p -> Path.Point.set_angle p angle) in
+    { state with angle }
   | _ ->
     { state with angle}
 
@@ -187,8 +188,9 @@ let width width state =
     let paths = update_path_selection s state.paths (fun p -> Path.Point.set_width p width) in
     {state with paths }
   | Selection (Point (s, point)) ->
-    update_point_selection state s point
-      (fun p -> Path.Point.set_width p width)
+    let state = update_point_selection state s point
+        (fun p -> Path.Point.set_width p width) in
+    { state with width }
   | _ ->
     { state with width }
 
@@ -239,10 +241,17 @@ let do_action
           else
             (* On the same segment, check for a point *)
             let selection = Selection.select_point path (Gg.V2.of_tuple position) in
-
-            (* In order to handle the point move, start the timer *)
-            Elements.Timer.start timer 0.3;
-            {state with mode= Selection selection}
+            match selection with
+            | Path _ ->
+              { state with mode = Selection selection }
+            | Point (_, pt) ->
+              (* In order to handle the point move, start the timer *)
+              Elements.Timer.start timer 0.3;
+              { state with
+                mode = Selection selection
+              ; angle = Path.Point.get_angle pt
+              ; width = Path.Point.get_width pt
+              }
       end
 
     | `Out point, Edit ->
@@ -344,7 +353,7 @@ let do_action
               match id = id' with
               | false -> path
               | true ->
-                Path.Fixed.update path paths
+                (Path.Fixed.update path paths)
             ) in
       { state with paths }