Allow point movement

1 files changed, 281 insertions, 79 deletions

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