Refactor

1 files changed, 216 insertions, 0 deletions

diff --git a/path/fixed.ml b/path/fixed.ml
new file mode 100755
index 0000000..e339afc
--- /dev/null
+++ b/path/fixed.ml
@@ -0,0 +1,216 @@
+open StdLabels
+
+(** Signature for points *)
+module type P = sig
+  type t
+
+  val empty : t
+
+  val get_coord : t -> Gg.v2
+
+  (** Copy a point and all thoses properties to the given location *)
+  val copy : t -> Gg.v2 -> t
+
+end
+
+module type REPR = sig
+  type t
+
+  type 'a repr
+
+  (* Start a new path. *)
+  val start
+    : t -> 'a repr -> 'a repr
+
+  val line_to
+    : t -> t -> 'a repr -> 'a repr
+
+  val quadratic_to
+    : t -> Gg.v2 -> Gg.v2 -> t -> 'a repr -> 'a repr
+
+  val stop
+    : 'a repr -> 'a repr
+end
+
+
+module Make(Point:P) = struct
+
+  module type BUILDER = sig
+    type t
+
+    module Draw(Repr:REPR with type t = Point.t) : sig
+
+      (** Represent the the current path *)
+      val draw
+        : t -> 'a Repr.repr -> 'a Repr.repr
+    end
+  end
+
+  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 *)
+
+  type path =
+    | Empty
+    | Line of Point.t * Point.t
+    | Curve of bezier
+
+  type t =
+    { id: int
+    ; path : path array }
+
+  let id
+    : t -> int
+    = fun {id; _} -> id
+
+  module ToFixed = struct
+    type t = Point.t
+
+    type 'a repr = int * path list
+
+    let create_path () = 0, []
+
+    (* Start a new path. *)
+    let start point t =
+      let _ = point in
+      t
+
+    let line_to
+      : t -> t -> 'a repr -> 'a repr
+      = fun p1 p2 (i, t) ->
+        ( i + 1
+        , Line (p1, p2)::t)
+
+    let quadratic_to
+      : t -> Gg.v2 -> Gg.v2 -> t -> 'a repr -> 'a repr
+      = fun p0 ctrl0 ctrl1 p1 (i, t) ->
+        let curve = Curve
+            { p0
+            ; ctrl0
+            ; ctrl1
+            ; p1} in
+        ( i + 1
+        , curve::t)
+
+
+    let stop t = t
+
+    let get
+      : int * path list -> path array
+      = fun (n, t) ->
+        let res = Array.make n Empty in
+        List.iteri t
+          ~f:(fun i elem -> Array.set res (n - i - 1) elem );
+        res
+  end
+
+  let internal_id = ref 0
+
+  let to_fixed
+    : (module BUILDER with type t = 'a) -> 'a -> t
+    = fun (type s) (module Builder: BUILDER with type t = s) t ->
+      incr internal_id;
+      let module FixedBuilder = Builder.Draw(ToFixed) in
+      { id = !internal_id
+      ; path = FixedBuilder.draw t (ToFixed.create_path ())
+               |> ToFixed.get
+      }
+
+  module DrawFixed(Repr:REPR with type t = Point.t) = struct
+
+    let repr_bezier p bezier =
+      Repr.quadratic_to
+        bezier.p0
+        bezier.ctrl0
+        bezier.ctrl1
+        bezier.p1
+        p
+
+    let draw
+      : t -> 'a Repr.repr -> 'a Repr.repr
+      = fun {path; _} repr ->
+
+        let _, repr = Array.fold_left path
+            ~init:(true, repr)
+            ~f:(fun (first, path) element ->
+                match element with
+                | Empty -> (true, path)
+                | Line (p0, p1) ->
+
+                  let path =  if first then
+                      Repr.start p0 path
+                    else path in
+
+                  ( false
+                  , Repr.line_to p0 p1 path )
+                | Curve bezier ->
+                  let path =  if first then
+                      Repr.start bezier.p0 path
+                    else path in
+                  ( false
+                  , repr_bezier path bezier )
+              ) in
+        Repr.stop repr
+  end
+
+  let box
+    : bezier -> Gg.box2
+    = fun bezier ->
+      Gg.Box2.of_pts
+        (Point.get_coord bezier.p0)
+        (Point.get_coord bezier.p1)
+      |> (fun b -> Gg.Box2.add_pt b bezier.ctrl0)
+      |> (fun b -> Gg.Box2.add_pt b bezier.ctrl1)
+
+  (** 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 -> float option =
+    fun point beziers ->
+
+    Array.fold_left beziers.path
+      ~init:None
+      ~f:(fun res -> function
+          | Empty -> None
+          | Line (p0, p1) ->
+            let box = Gg.Box2.of_pts (Point.get_coord p0) (Point.get_coord p1) in
+            begin match Gg.Box2.mem point box with
+              | false -> res
+              | true ->
+                (* TODO Evaluate the normal *)
+                res
+            end
+          | Curve bezier ->
+            begin match Gg.Box2.mem point (box bezier) with
+              | false -> res
+              | true ->
+
+                let bezier' = Shapes.Bezier.(
+
+                    { p0 = Point.get_coord bezier.p0
+                    ; p1 = Point.get_coord bezier.p1
+                    ; 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
+                match res with
+                | None -> Some distance
+                | Some d -> if d < distance then res else (Some distance)
+            end
+        )
+
+  let map_point
+    : t -> (Point.t -> Point.t) -> t
+    = fun {id; path} f ->
+      let path = Array.map path
+          ~f:(function
+              | Empty -> Empty
+              | Line (p1, p2) -> Line (f p1, f p2)
+              | Curve bezier -> Curve {bezier with p0 = f bezier.p0 ; p1 = f bezier.p1}
+            ) in
+      {id; path}
+
+end