From 561d0f0155f4906d90eb7e73a3ff9cb28909126f Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Fri, 5 Feb 2021 09:08:39 +0100
Subject: Update project structure

---
 script.it/path/fixed.ml | 487 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 487 insertions(+)
 create mode 100755 script.it/path/fixed.ml

(limited to 'script.it/path/fixed.ml')

diff --git a/script.it/path/fixed.ml b/script.it/path/fixed.ml
new file mode 100755
index 0000000..1362ad3
--- /dev/null
+++ b/script.it/path/fixed.ml
@@ -0,0 +1,487 @@
+open StdLabels
+
+(** Signature for points *)
+module type P = sig
+  type t
+
+  val get_coord : t -> Gg.v2
+
+  val id : t -> int
+
+  val copy : t -> Gg.v2 -> t
+
+end
+
+module Make(Point:P) = struct
+
+  type bezier =
+    { ctrl0:Gg.v2   (* The control point *)
+    ; ctrl1:Gg.v2   (* The control point *)
+    ; p1:Point.t    (* The end point *)
+    }
+
+  module type BUILDER = sig
+    type t
+
+    val repr
+      : t -> (module Repr.M with type point = Point.t and type t = 's) -> 's -> 's
+  end
+
+  type path =
+    | Line of Point.t
+    | Curve of bezier
+
+
+  type step =
+    { point : Point.t
+    ; move : path
+    }
+
+  type t = step array
+
+  module ToFixed = struct
+    type point = Point.t
+
+    type t = int * step list
+
+    let create_path () = 0, []
+
+    (* Start a new path. *)
+    let start point t =
+      let _ = point in
+      t
+
+    let line_to
+      : point -> point -> t -> t
+      = fun p1 p2 (i, t) ->
+        ( i + 1
+        , { point = p1
+          ; move = Line p2
+          }:: t )
+
+    let quadratic_to
+      : (point * Gg.v2 * Gg.v2 * point) -> t -> t
+      = fun (p0,  ctrl0, ctrl1, p1) (i, t) ->
+        let curve = Curve
+            { ctrl0
+            ; ctrl1
+            ; p1} in
+        ( i + 1
+        , { point = p0
+          ; move = curve
+          } ::t)
+
+    let stop t = t
+
+    let get
+      : int * step list -> step 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 );
+        res
+  end
+
+  let to_fixed
+    : (module BUILDER with type t = 'a) -> 'a -> t
+    = fun (type s) (module Builder: BUILDER with type t = s) t ->
+      Builder.repr t (module ToFixed) (ToFixed.create_path ())
+      |> ToFixed.get
+
+  let repr
+    : t -> (module Repr.M with type point = Point.t and type t = 's) -> 's -> 's
+    = fun (type s) t (module Repr : Repr.M with type point = Point.t and type t = s) repr ->
+      let repr_bezier p p0 bezier =
+        Repr.quadratic_to
+          ( p0
+          , bezier.ctrl0
+          , bezier.ctrl1
+          , bezier.p1 )
+          p in
+
+      let _, repr = Array.fold_left t
+          ~init:(true, repr)
+          ~f:(fun (first, path) element ->
+              let path =  if first then
+                  Repr.start element.point path
+                else path in
+              match element.move with
+              | Line p1 ->
+                ( false
+                , Repr.line_to element.point p1 path )
+              | Curve bezier ->
+                ( false
+                , repr_bezier path element.point bezier )
+            ) 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 -> approx option
+    = fun point t ->
+
+      Array.fold_left t
+        ~init:None
+        ~f:(fun res step ->
+            match step.move with
+            | Line p1 ->
+              let box = Gg.Box2.of_pts (Point.get_coord step.point) (Point.get_coord p1) in
+              begin match Gg.Box2.mem point box with
+                | false -> res
+                | true ->
+                  (* TODO Evaluate the normal *)
+                  res
+              end
+            | Curve bezier ->
+
+              let bezier' = Shapes.Bezier.(
+
+                  { p0 = Point.get_coord step.point
+                  ; p1 = Point.get_coord bezier.p1
+                  ; ctrl0 = bezier.ctrl0
+                  ; ctrl1 = bezier.ctrl1 }
+                ) in
+              let ratio, point' = Shapes.Bezier.get_closest_point point bezier' in
+              let distance' = Gg.V2.( norm (point - point') ) in
+              match res with
+              | Some {distance; _} when distance < distance' -> res
+              | _ -> Some
+                       { closest_point = point'
+                       ; distance = distance'
+                       ; p0 = step.point
+                       ; p1 = bezier.p1
+                       ; ratio }
+          )
+
+  let map
+    : t -> (Point.t -> Point.t) -> t
+    = fun t f ->
+      Array.map t
+        ~f:(fun step ->
+            match step.move with
+            | Line p2 ->
+              { point = f step.point
+              ; move = Line (f p2)
+              }
+            | Curve bezier ->
+              let point = f step.point in
+              { point
+              ; move = Curve
+                    { p1 = f bezier.p1
+                    ; ctrl0 = Point.get_coord (f (Point.copy step.point bezier.ctrl0))
+                    ; ctrl1 = Point.get_coord (f (Point.copy bezier.p1 bezier.ctrl1))
+                    }
+              }
+          )
+
+  let iter
+    : t -> f:(Point.t -> unit) -> unit
+    = fun t ~f ->
+      Array.iter t
+        ~f:(fun step ->
+            match step.move with
+            | Line p2 -> f step.point; f p2
+            | Curve bezier -> f step.point ; f bezier.p1
+          )
+
+  let get_point'
+    : step -> Point.t
+    = fun { move ; _} ->
+      match move with
+      | Line p1 -> p1
+      | Curve bezier -> bezier.p1
+
+  (** Associate the return from the bezier point to an existing path *)
+  let assoc_point
+    : Shapes.Bezier.t -> step -> step
+    = fun bezier step ->
+      match step.move with
+      | Line p1
+      | Curve {p1; _} ->
+        let p0' = Point.copy step.point bezier.Shapes.Bezier.p0
+        and p1' = Point.copy p1 bezier.Shapes.Bezier.p1 in
+        { point = p0'
+        ; move = Curve
+              { p1 = p1'
+              ; ctrl0 = bezier.Shapes.Bezier.ctrl0
+              ; ctrl1 = bezier.Shapes.Bezier.ctrl1
+              }
+        }
+
+
+  let build_from_three_points 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
+
+    [| { point = p0'
+       ; move =
+           Curve { ctrl0 = b0.Shapes.Bezier.ctrl0
+                 ; ctrl1 = b0.Shapes.Bezier.ctrl1
+                 ; p1 = p1'
+                 } }
+     ; { point = p1'
+       ; move = Curve { 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 t ->
+
+      match Array.length t with
+      | 0 -> None
+      | 1 ->
+        let step = Array.get t 0 in
+        begin match step.move with
+          | Curve {p1; _}
+          | Line p1 ->
+            Some
+              [|
+                { point = step.point
+                ; move = Line p1 } |]
+        end
+      | 2 ->
+        let p0 = (Array.get t 0).point
+        and p1 = (Array.get t 1).point
+        and p2 = get_point' @@ Array.get t 1 in
+        Some (build_from_three_points p0 p1 p2)
+
+      | _ ->
+
+        (* Convert all the points in list *)
+        let points = List.init
+            ~len:((Array.length t) )
+            ~f:(fun i -> Point.get_coord @@ get_point' (Array.get t i)) in
+        let p0 = Point.get_coord @@ (Array.get t 0).point 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 t ~f:assoc_point in
+            Some rebuilded
+        end
+
+  let find_pt_index
+    : Point.t -> step array -> int option
+    = fun 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 =
+                if (Point.id element.point) = (Point.id point) then (
+                  idx := Some (!counter) ;
+                  true
+                ) else match element.move with
+                  | Line p1
+                  | Curve {p1;_} when (Point.id p1) = (Point.id point) ->
+                    idx := Some (!counter+1) ;
+                    true
+                  | _ ->
+                    false
+              in
+              incr counter;
+              res) in
+      !idx
+
+  let remove_point
+    : t -> Point.t -> t option
+    = fun t point ->
+
+      match Array.length t with
+      | 0
+      | 1 -> None
+      | 2 ->
+        (* Two segment, we get the points and transform this into a single line *)
+        let p0 = (Array.get t 0).point
+        and p1 = (Array.get t 1).point
+        and p2 = get_point' @@ Array.get t 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
+              [| { point = p0
+                 ; move = Line p1 }|]
+          | _ -> None
+        end
+      | l ->
+        match find_pt_index point t with
+        | None -> Some t
+        | Some 0 ->
+          (* Remove the first point *)
+          let path = Array.init (l-1)
+              ~f:( fun i -> Array.get t (i+1)) in
+          Some path
+        | Some n when n = (Array.length t) ->
+          (* Remove the last point *)
+          let path = Array.init (l-1)
+              ~f:( fun i -> Array.get t i) in
+          Some path
+        | Some n ->
+          let path' = Array.init (l-1)
+              ~f:(fun i ->
+                  if i < (n-1) then
+                    Array.get t (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 = (Array.get t i).point in
+
+                    match (Array.get t (i+1)).move with
+                    | Line p1 ->
+                      { point = p0
+                      ; move = Line p1 }
+                    | Curve c ->
+                      { point = p0
+                      ; move = Curve c }
+
+                  else
+                    Array.get t (i+1)
+                ) in
+          rebuild path'
+
+  let first_point
+    : step -> Point.t
+    = fun {point; _} -> point
+
+  let replace_point
+    : t -> Point.t -> t option
+    = fun t p ->
+
+      let add_path paths idx f points =
+        if 0 <= idx && idx < Array.length paths then
+          let path = Array.get t idx in
+          Point.get_coord (f path)
+          :: points
+        else points in
+
+      match Array.length t with
+      | 0 -> None
+      | 1 -> (* Only one point, easy ? *)
+        let step = Array.get t 0 in
+        begin match step.move with
+          | Curve {p1; _}
+          | Line p1 ->
+            let p0 = if (Point.id step.point = Point.id p) then p else step.point
+            and p1 = if (Point.id p1 = Point.id p) then p else p1 in
+            Some [|
+              { point = p0
+              ; move = Line p1 }
+            |]
+        end
+
+      | 2 ->
+        let p0 = (Array.get t 0).point
+        and p1 = (Array.get t 1).point
+        and p2 = get_point' @@ Array.get t 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 p0 p1 p2)
+
+      (* More than two segmend, it is ok for a partial reevaluation *)
+      | _ ->
+        match find_pt_index p t with
+        | None -> None
+        | Some n ->
+          let path = Array.copy t in
+
+          let p0, p1 =
+
+            if n < Array.length path then
+              p, get_point' (Array.get path n)
+            else
+              (Array.get path (n -1)).point, 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 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
+              Array.set path 0
+                { point = p0
+                ; move = (Curve
+                            { ctrl0 = bezier'.Shapes.Bezier.ctrl0
+                            ; ctrl1 = bezier'.Shapes.Bezier.ctrl1
+                            ; p1
+                            })
+                };
+              Some path
+          end
+end
-- 
cgit v1.2.3