Allow point movement

3 files changed, 325 insertions, 103 deletions

diff --git a/path/builder.ml b/path/builder.ml
index 182fc13..fd772ea 100755
--- a/path/builder.ml
+++ b/path/builder.ml
@@ -119,24 +119,29 @@ module Make(Point:P) = struct
             |> Repr.line_to p1 p2 in
           ( path )
         | p0::p1::p2::[] ->
-          let path = Repr.start p0 path in
 
-          let b = Shapes.Bezier.quadratic_to_cubic
+          let b0, b1 = Shapes.Bezier.quadratic_to_cubic
             @@ Shapes.Bezier.three_points_quadratic
               (Point.get_coord p0)
               (Point.get_coord p1)
               (Point.get_coord p2)
+                       |> Shapes.Bezier.slice 0.5
           in
-
-          let p0' = Point.copy p0 b.Shapes.Bezier.p0
-          and p2' = Point.copy p1 b.Shapes.Bezier.p1 in
-
-          ( Repr.quadratic_to
-              p0'
-              b.Shapes.Bezier.ctrl0
-              b.Shapes.Bezier.ctrl1
-              p2'
-              path )
+          let p0' = Point.copy p0 b0.Shapes.Bezier.p0
+          and p1' = Point.copy p1 b0.Shapes.Bezier.p1
+          and p2' = Point.copy p2 b1.Shapes.Bezier.p1 in
+
+          Repr.start p0 path
+          |> Repr.quadratic_to
+            p0'
+            b0.Shapes.Bezier.ctrl0
+            b0.Shapes.Bezier.ctrl1
+            p1'
+          |> Repr.quadratic_to
+            p1'
+            b1.Shapes.Bezier.ctrl0
+            b1.Shapes.Bezier.ctrl1
+            p2'
         | (p0::_ as points) ->
 
           let (let*) v f =
diff --git a/path/fixed.ml b/path/fixed.ml
index 176d818..812dd3b 100755
--- a/path/fixed.ml
+++ b/path/fixed.ml
@@ -8,6 +8,8 @@ module type P = sig
 
   val id : t -> int
 
+  val copy : t -> Gg.v2 -> t
+
 end
 
 module Make(Point:P) = struct
@@ -37,10 +39,6 @@ module Make(Point:P) = struct
     : t -> int
     = fun {id; _} -> id
 
-  let path
-    : t -> path array
-    = fun {path; _} -> path
-
   module ToFixed = struct
     type t = Point.t
 
@@ -174,7 +172,7 @@ module Make(Point:P) = struct
                        ; ratio }
           )
 
-  let map_point
+  let map
     : t -> (Point.t -> Point.t) -> t
     = fun {id; path} f ->
       let path = Array.map path
@@ -193,82 +191,286 @@ module Make(Point:P) = struct
             | Curve bezier -> f bezier.p0 ; f bezier.p1
           )
 
+  let get_point'
+    : path -> Point.t
+    = function
+      | Line (_, p1) -> p1
+      | Curve bezier -> bezier.p1
+
+  let first_point'
+    : path -> Point.t
+    = function
+      | Line (p0, _) -> p0
+      | Curve bezier -> bezier.p0
+
+  (** Associate the return from the bezier point to an existing path *)
+  let assoc_point
+    : Shapes.Bezier.t -> path -> path
+    = fun bezier -> function
+      | Line (p0, p1)
+      | Curve {p0; p1; _} ->
+        let p0' = Point.copy p0 bezier.Shapes.Bezier.p0
+        and p1' = Point.copy p1 bezier.Shapes.Bezier.p1 in
+        Curve
+          { p0 = p0'
+          ; p1 = p1'
+          ; ctrl0 = bezier.Shapes.Bezier.ctrl0
+          ; ctrl1 = bezier.Shapes.Bezier.ctrl1
+          }
+
+
+  let build_from_three_points id p0 p1 p2 =
+    let bezier =
+      Shapes.Bezier.quadratic_to_cubic
+      @@ Shapes.Bezier.three_points_quadratic
+        (Point.get_coord p0)
+        (Point.get_coord p1)
+        (Point.get_coord p2) in
+
+    (* The middle point is not exactly at the middle anymore (it can have been
+       moved), we have the reevaluate it's position *)
+    let ratio, _ = Shapes.Bezier.get_closest_point
+        (Point.get_coord p1)
+        bezier in
+
+    let b0, b1 = Shapes.Bezier.slice ratio bezier in
+    let p0' = Point.copy p0 b0.Shapes.Bezier.p0
+    and p1' = Point.copy p1 b0.Shapes.Bezier.p1
+    and p2' = Point.copy p2 b1.Shapes.Bezier.p1 in
+
+    { id
+    ; path =
+        [| Curve { p0 = p0'
+                 ; ctrl0 = b0.Shapes.Bezier.ctrl0
+                 ; ctrl1 = b0.Shapes.Bezier.ctrl1
+                 ; p1 = p1' }
+         ; Curve { p0 = p1'
+                 ; ctrl0 = b1.Shapes.Bezier.ctrl0
+                 ; ctrl1 = b1.Shapes.Bezier.ctrl1
+                 ; p1 = p2' } |]
+    }
+
+  (** Rebuild the whole curve by evaluating all the points *)
+  let rebuild
+    : t -> t option
+    = fun {id ; path} ->
+
+      match Array.length path with
+      | 0 -> None
+      | 1 ->
+        begin match Array.get path 0 with
+          | Curve {p0; p1; _}
+          | Line (p0, p1) ->
+            Some {id; path=[|Line (p0, p1)|]}
+        end
+      | 2 ->
+        let p0 = first_point' @@ Array.get path 0
+        and p1 = first_point' @@ Array.get path 1
+        and p2 = get_point' @@ Array.get path 1 in
+        Some (build_from_three_points id p0 p1 p2)
+
+      | _ ->
+
+        (* Convert all the points in list *)
+        let points = List.init
+            ~len:((Array.length path) )
+            ~f:(fun i -> Point.get_coord @@ get_point' (Array.get path i)) in
+        let p0 = Point.get_coord @@ first_point' (Array.get path 0)in
+
+        let points = p0::points in
+
+        (* We process the whole curve in a single block *)
+        begin match Shapes.Bspline.to_bezier points with
+          | Error `InvalidPath -> None
+          | Ok beziers ->
+
+            (* Now for each point, reassociate the same point information,
+               We should have as many points as before *)
+            let rebuilded = Array.map2 beziers path ~f:assoc_point in
+            Some {id; path = rebuilded}
+        end
+
+  let find_pt_index point path =
+    (* First search the element to remove. The counter mark the position of
+       the point to remove, not the segment itself. *)
+    let idx = ref None
+    and counter = ref 0  in
+
+    let _ = Array.exists
+        path
+        ~f:(fun element ->
+
+            let res = match element with
+              | Line (p0, p1)
+              | Curve {p0;p1;_} ->
+                if (Point.id p0) = (Point.id point) then (
+                  idx := Some (!counter) ;
+                  true
+                ) else if (Point.id p1) = (Point.id point) then (
+                  idx := Some (!counter+1) ;
+                  true
+                ) else
+                  false
+            in
+            incr counter;
+            res) in
+    !idx
+
   let remove_point
-    : t -> Point.t -> t
+    : t -> Point.t -> t option
     = fun {id; path} point ->
 
-      (* First search the element to remove *)
-      let idx = ref None
-      and counter = ref 0  in
-
-      let _ = Array.exists
-          path
-          ~f:(fun element ->
-
-              let res = match element with
-                | Line (p0, p1)
-                | Curve {p0;p1;_} ->
-                  if (Point.id p0) = (Point.id point) then (
-                    idx := Some (!counter) ;
-                    true
-                  ) else if (Point.id p1) = (Point.id point) then (
-                    idx := Some (!counter+1) ;
-                    true
-                  ) else
-                    false
+      match Array.length path with
+      | 0
+      | 1 -> None
+      | 2 ->
+        (* Two segment, we get the points and transform this into a single line *)
+        let p0 = first_point' @@ Array.get path 0
+        and p1 = first_point' @@ Array.get path 1
+        and p2 = get_point' @@ Array.get path 1 in
+        let elms = List.filter [p0; p1; p2]
+            ~f:(fun pt -> Point.id pt != Point.id point) in
+        begin match elms with
+          | p0::p1::[] ->
+            Some
+              { id
+              ; path=[|Line (p0, p1)|]}
+          | _ -> None
+        end
+      | l ->
+        match find_pt_index point path with
+        | None -> Some {id; path}
+        | Some 0 ->
+          (* Remove the first point *)
+          let path = Array.init (l-1)
+              ~f:( fun i -> Array.get path (i+1)) in
+          Some { id ; path }
+        | Some n when n = (Array.length path) ->
+          (* Remove the last point *)
+          let path = Array.init (l-1)
+              ~f:( fun i -> Array.get path i) in
+          Some { id ; path }
+        | Some n ->
+          let path' = Array.init (l-1)
+              ~f:(fun i ->
+                  if i < (n-1) then
+                    Array.get path (i)
+                  else if i = (n-1) then
+                    (* We know that the point is not the first nor the last one.
+                       So it is safe to call n-1 or n + 1 point
+
+                       We have to rebuild the point and set that
+                       point_(-1).id = point_(+1).id
+                    *)
+                    let p0 =
+                      match Array.get path i with
+                      | Line (p0, _) -> p0
+                      | Curve c -> c.p0
+                    in
+
+                    match Array.get path (i+1) with
+                    | Line (_, p1) -> Line (p0, p1)
+                    | Curve c -> Curve {c with p0}
+
+                  else
+                    Array.get path (i+1)
+                ) in
+          rebuild
+            { id
+            ; path=path'}
+
+  let replace_point
+    : t -> Point.t -> t option
+    = fun {id; path } p ->
+
+      let add_path paths idx f points =
+        if 0 <= idx && idx < Array.length paths then
+          let path = Array.get path idx in
+          Point.get_coord (f path)
+          :: points
+        else points in
+
+      match Array.length path with
+      | 0 -> None
+      | 1 -> (* Only one point, easy ? *)
+        begin match Array.get path 0 with
+          | Curve {p0; p1; _}
+          | Line (p0, p1) ->
+            let p0 = if (Point.id p0 = Point.id p) then p else p0
+            and p1 = if (Point.id p1 = Point.id p) then p else p1 in
+            Some {id; path=[|Line (p0, p1)|]}
+        end
+
+      | 2 ->
+        let p0 = first_point' @@ Array.get path 0
+        and p1 = first_point' @@ Array.get path 1
+        and p2 = get_point' @@ Array.get path 1 in
+
+        let p0 = if (Point.id p0 = Point.id p) then p else p0
+        and p1 = if (Point.id p1 = Point.id p) then p else p1
+        and p2 = if (Point.id p2 = Point.id p) then p else p2 in
+        Some (build_from_three_points id p0 p1 p2)
+
+      (* More than two segmend, it is ok for a partial reevaluation *)
+      | _ ->
+        match find_pt_index p path with
+        | None -> None
+        | Some n ->
+          let path = Array.copy path in
+
+          let p0, p1 =
+
+            if n < Array.length path then
+              match (Array.get path n) with
+              | Line (_, p1) -> p, p1
+              | Curve bezier -> p, bezier.p1
+            else
+              match (Array.get path (n-1)) with
+              | Line (p0, _) -> p0, p
+              | Curve bezier -> bezier.p0, p
+          in
+
+          let min_idx = max (n-3) 0 in
+
+          let points =
+            add_path path (n-3) first_point'
+            @@ add_path path (n-2) first_point'
+            @@ add_path path (n-1) first_point'
+            @@ (fun tl -> (Point.get_coord p)::tl)
+            @@ add_path path n get_point'
+            @@ add_path path (n+1) get_point'
+            @@ add_path path (n+2) get_point'
+            @@ [] in
+
+          (* It is impressive how fast it is to evaluate the curve ! Maybe is the
+             worker not required at all…
+          *)
+          let bezier_opt = Shapes.Bspline.to_bezier points in
+          begin match bezier_opt with
+            | Ok paths ->
+              Array.iteri paths
+                ~f:(fun i bezier ->
+                    (* Only take two points before, and two after  *)
+                    let idx = min_idx + i in
+                    if (n-2 < idx) && (idx < n +2) && idx < Array.length path then
+                      Array.set path idx (assoc_point bezier (Array.get path idx))
+                  );
+              Some {id; path}
+            | Error _ ->
+              let bezier', _ = Shapes.Bezier.three_points_quadratic
+                  (Point.get_coord p)
+                  (Point.get_coord @@ get_point' (Array.get path 0))
+                  (Point.get_coord @@ get_point' (Array.get path 1))
+                               |> Shapes.Bezier.quadratic_to_cubic
+                               |> Shapes.Bezier.slice 0.5
               in
-              incr counter;
-              res) in
-
-      match !idx with
-      | None -> {id; path}
-      | Some 0 ->
-        (* Remove the first point *)
-        let path' = Array.init
-            ((Array.length path)-1)
-            ~f:( fun i -> Array.get path (i+1)) in
-        { id
-        ; path = path'
-        }
-      | Some n when n = (Array.length path) ->
-        (* Remove the last point *)
-        let path' = Array.init
-            ((Array.length path)-1)
-            ~f:( fun i -> Array.get path i) in
-        { id
-        ; path=path'
-        }
-      | Some n ->
-        let path' = Array.init
-            ((Array.length path)-1)
-            ~f:(fun i ->
-                if i < (n-1) then
-                  Array.get path (i)
-                else if i = (n-1) then
-                  (* We know that the point is not the first nor the last one.
-                     So it is safe to call n-1 or n + 1 point
-
-                     We have to rebuild the point and set that
-                     point_(-1).id = point_(+1).id
-                  *)
-                  let previous_p1 =
-                    match Array.get path (i-1) with
-                    | Line (_, p1) -> p1
-                    | Curve c -> c.p1
-                  in
-
-                  match Array.get path (i+1) with
-                  | Line (_, p1) -> Line (previous_p1, p1)
-                  | Curve c -> Curve {c with p0 = previous_p1}
-
-                else
-                  Array.get path (i+1)
-              ) in
-        { id
-        ; path=path'}
-
-  let update
-    : t -> path array -> t
-    = fun {id; _} path -> {id; path}
-
+              Array.set path 0
+                (Curve
+                   { p0 = p0
+                   ; ctrl0 = bezier'.Shapes.Bezier.ctrl0
+                   ; ctrl1 = bezier'.Shapes.Bezier.ctrl1
+                   ; p1
+                   });
+              Some {id; path}
+          end
 end
diff --git a/path/fixed.mli b/path/fixed.mli
index 06b3539..2daadb4 100755
--- a/path/fixed.mli
+++ b/path/fixed.mli
@@ -6,6 +6,8 @@ module type P = sig
 
   val id : t -> int
 
+  val copy : t -> Gg.v2 -> t
+
 end
 
 module Make(Point:P) : sig
@@ -32,6 +34,8 @@ module Make(Point:P) : sig
   val repr
     : t -> (module Repr.M with type t = Point.t and type repr = 's) -> 's -> 's
 
+  (** Structure to represent all the required information for evaluating the
+      distance between a point and a path *)
   type approx =
     { distance : float
     ; closest_point : Gg.v2
@@ -44,27 +48,38 @@ module Make(Point:P) : sig
   val distance
     : Gg.v2 -> t -> approx option
 
+  (** Iterate over a path *)
   val iter
     : t -> f:(Point.t -> unit) -> unit
 
-  val map_point
+  (** Map all the points in the path *)
+  val map
     : t -> (Point.t -> Point.t) -> t
 
+  (** Reevaluate all the control points on the path in order to get a smooth
+      curve *)
+  val rebuild 
+    : t -> t option
+
+  (** Delete a point in the path. 
+
+      Reconnect the path without the point removed, and reevaluate all the
+      control points from the nodes
+
+      return None if the point is not present in the curve
+  *)
   val remove_point 
-    : t -> Point.t -> t
+    : t -> Point.t -> t option
 
-  type bezier =
-    { p0:Point.t    (* The starting point *)
-    ; p1:Point.t    (* The end point *)
-    ; ctrl0:Gg.v2   (* The control point *)
-    ; ctrl1:Gg.v2 } (* The control point *)
+  (** Replace a point by the given one. 
 
-  type path =
-    | Line of Point.t * Point.t
-    | Curve of bezier
+      An existing point with the same id shall be present in the path. 
 
-  val path : t -> path array
+      The path is not fully evaluated, and rebuild shall be runned in order to
+      get the path completely smooth.
 
-  val update : t -> path array -> t
+  *)
+  val replace_point 
+    : t -> Point.t -> t option
 
 end