Update du soir

6 files changed, 219 insertions, 101 deletions

diff --git a/path/builder.ml b/path/builder.ml
index 01dda87..b77c60a 100755
--- a/path/builder.ml
+++ b/path/builder.ml
@@ -17,9 +17,6 @@ module type REPR = sig
 
   type 'a repr
 
-  val create_path
-    : unit -> 'a repr
-
   (* Start a new path. *)
   val start
     : t -> 'a repr -> 'a repr
@@ -46,6 +43,15 @@ module Make(Point:P) = struct
 
   type t = Point.t list * bezier list
 
+  type path =
+    | Empty
+    | Line of Point.t * Point.t
+    | Curve of bezier
+
+  type fixedPath =
+    { id: int
+    ; path : path array }
+
   let get_new_segment connexion0 p5 p4 p3 p2 p1 =
     let p5' = Point.get_coord p5
     and p4' = Point.get_coord p4
@@ -64,7 +70,7 @@ module Make(Point:P) = struct
   let empty = ([], [])
 
   let add_point
-    : Point.t -> t -> t
+    : Point.t -> t -> t * fixedPath option
     = fun lastPoint (path, beziers) ->
       let (let*) v f =
         match v with
@@ -72,9 +78,11 @@ module Make(Point:P) = struct
           if Array.length bezier > 0 then
             f (Array.get bezier 0)
           else
-            lastPoint::path, beziers
+            ( (lastPoint::path, beziers)
+            , None )
         | _ ->
-          lastPoint::path, beziers
+          ( (lastPoint::path, beziers)
+          , None )
       in
 
       let connexion0 = match beziers with
@@ -95,18 +103,22 @@ module Make(Point:P) = struct
 
         (* We remove the last point and add the bezier curve in the list*)
         let firsts = lastPoint::p4::p3::p2::[] in
-        (*firsts, (Shapes.Bezier.reverse bezier)::beziers*)
-        firsts, bezier_point::beziers
+        ( (firsts, bezier_point::beziers)
+        , None )
       | _ ->
-        lastPoint::path, beziers
+        ( ( lastPoint::path
+          , beziers)
+        , None )
 
   let replace_last
-    : Point.t -> t -> t
+    : Point.t -> t -> t * fixedPath option
     = fun lastPoint ((path, beziers) as t) ->
       match path, beziers with
       | _::(tl), beziers ->
-        lastPoint::tl
-      , beziers
+
+        ( ( lastPoint::tl
+          , beziers )
+        , None )
       | _ ->
         add_point lastPoint t
 
@@ -124,65 +136,15 @@ module Make(Point:P) = struct
       | [] -> None
       | hd::_ -> Some hd
 
-  let get
-    : t -> t
-    = fun t -> t
-
-
   (**  Complete path **)
 
-  (* Transform the result by replacing each start and end point by the
-     version given in the list
-
-     This allow to keep the informations like angle or nib width inside the
-     bezier curve
-
-  *)
-  let points_to_beziers
-    : Point.t list -> Shapes.Bezier.t array -> bezier array
-    = fun points beziers ->
-      match points with
-      (* If there is no point to draw, just return empty array *)
-      | [] -> [||]
-      | first_point::_ ->
-        let curves = Array.make
-            ( (List.length points) -1)
-            { p0 = Point.empty
-            ; ctrl0 = Gg.V2.of_tuple (0., 0.)
-            ; ctrl1 = Gg.V2.of_tuple (0., 0.)
-            ; p1 = Point.empty } in
-
-        let _ = List.fold_left points
-            ~init:(first_point, -1)
-            ~f:(fun (prev_point, i) point ->
-                (* In the first step, prev_point = point *)
-                if i < 0 then
-                  ( prev_point
-                  , 0)
-                else
-
-                  let bezier_curve = Array.get beziers i in
-                  Array.set curves i
-                    { p0 = Point.copy prev_point bezier_curve.Shapes.Bezier.p0
-                    ; ctrl0 = bezier_curve.Shapes.Bezier.ctrl0
-                    ; ctrl1 = bezier_curve.Shapes.Bezier.ctrl1
-                    ; p1 = Point.copy point bezier_curve.Shapes.Bezier.p1 };
-
-                  ( point
-                  , i + 1)
-              ) in
-        curves
-
-
   module Draw(Repr:REPR with type t = Point.t) = struct
 
     (** Drawing path **)
 
     let draw
-      : t -> 'a Repr.repr
-      = fun (points, beziers) ->
-
-        let path = Repr.create_path () in
+      : t -> 'a Repr.repr -> 'a Repr.repr
+      = fun (points, beziers) path ->
 
         (* Represent the last points *)
         let path = match points with
@@ -275,15 +237,6 @@ module Make(Point:P) = struct
             )
   end
 
-  type path =
-    | Empty
-    | Line of Point.t * Point.t
-    | Curve of bezier
-
-  type fixedPath =
-    { id: int
-    ; path : path array }
-
   module ToFixed = struct
     type t = Point.t
 
@@ -333,7 +286,7 @@ module Make(Point:P) = struct
     = fun t ->
       incr id;
       { id = !id
-      ; path = FixedBuilder.draw t
+      ; path = FixedBuilder.draw t (ToFixed.create_path ())
                |> ToFixed.get
       }
 
@@ -349,10 +302,9 @@ module Make(Point:P) = struct
         p
 
     let draw
-      : fixedPath -> 'a Repr.repr
-      = fun {path; _} ->
+      : fixedPath -> 'a Repr.repr -> 'a Repr.repr
+      = fun {path; _} repr ->
 
-        let repr = Repr.create_path () in
         let _, repr = Array.fold_left path
             ~init:(true, repr)
             ~f:(fun (first, path) element ->
@@ -376,4 +328,57 @@ module Make(Point:P) = struct
         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)
+
+
+  let distance
+    : Gg.v2 -> fixedPath -> float option =
+    fun point beziers ->
+
+    Array.fold_left beziers.path
+      ~init:None
+      ~f:(fun res path ->
+          match path with
+          | 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 ->
+                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
+
+
+        )
+
+
+
+
+
 end
diff --git a/path/builder.mli b/path/builder.mli
index f5adef1..42f433e 100755
--- a/path/builder.mli
+++ b/path/builder.mli
@@ -16,9 +16,6 @@ module type REPR = sig
 
   type 'a repr
 
-  val create_path
-    : unit -> 'a repr
-
   (* Start a new path. *)
   val start
     : t -> 'a repr -> 'a repr
@@ -35,23 +32,20 @@ end
 
 module Make(P:P) : sig
 
-  type bezier =
-    { p0:P.t        (* The starting point *)
-    ; p1:P.t        (* The end point *)
-    ; ctrl0:Gg.v2   (* The control point *)
-    ; ctrl1:Gg.v2 } (* The control point *)
-
+  type bezier 
   type t
 
+  type fixedPath
+
   (** Create an empty path *)
   val empty: t
 
   val add_point
-    : P.t -> t -> t
+    : P.t -> t -> t * fixedPath option
 
   (** Replace the last alement in the path by the one given in parameter *)
   val replace_last
-    : P.t -> t -> t
+    : P.t -> t -> t * fixedPath option
 
   (** Retrieve the last element, if any *)
   val peek 
@@ -61,26 +55,21 @@ module Make(P:P) : sig
   val peek2
     : t -> (P.t * P.t) option
 
-  val get
-    : t -> P.t list * bezier list
-
-  val points_to_beziers
-    : P.t list -> Shapes.Bezier.t array -> bezier array
-
   module Draw(Repr:REPR with type t = P.t) : sig
 
     (** Represent the the current path *)
     val draw
-      : t -> 'a Repr.repr
+      : t -> 'a Repr.repr -> 'a Repr.repr
   end
 
-  type fixedPath
-
   val to_fixed : t -> fixedPath
 
   module DrawFixed(Repr:REPR with type t = P.t) : sig 
     val draw
-      : fixedPath -> 'a Repr.repr
+      : fixedPath -> 'a Repr.repr -> 'a Repr.repr
   end
 
+  (** Return the shortest distance between the mouse and a point *)
+  val distance
+    : Gg.v2 -> fixedPath -> float option 
 end
diff --git a/path/fillPrinter.ml b/path/fillPrinter.ml
new file mode 100755
index 0000000..d95030c
--- /dev/null
+++ b/path/fillPrinter.ml
@@ -0,0 +1,71 @@
+module Repr = Layer.CanvaPrinter
+
+type t = Point.t
+
+type 'a repr =
+  { path: ('a Repr.t)
+  ; close : 'a Repr.t -> unit
+  }
+
+let create_path
+  : 'b -> 'a repr
+  = fun f ->
+    { close = f
+    ; path = Repr.create ()
+    }
+
+(* Start a new path. *)
+let start
+  : Point.t -> 'a repr -> 'a repr
+  = fun t {close ; path } ->
+    let path = Repr.move_to (Point.get_coord t) path in
+    { close
+    ; path
+    }
+
+let line_to
+  : Point.t -> Point.t -> 'a repr -> 'a repr
+  = fun p0 p1 t ->
+    let path =
+      Repr.move_to (Point.get_coord p1) t.path
+      |> Repr.line_to (Point.get_coord' p1)
+      |> Repr.line_to (Point.get_coord' p0)
+      |> Repr.line_to (Point.get_coord p0)
+      |> Repr.line_to (Point.get_coord p1)
+      |> Repr.close in
+    t.close path;
+    { t with path}
+
+let quadratic_to
+  : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> 'a repr -> 'a repr
+  = fun p0 ctrl0 ctrl1 p1 t ->
+
+    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
+        (Point.get_coord ctrl0')
+        (Point.get_coord ctrl1')
+        (Point.get_coord p1)
+      |> Repr.close in
+    t.close path;
+    { t with path}
+
+
+let stop
+  : 'a repr -> 'a repr
+  = fun t ->
+    t
+
+let get
+  : 'a repr -> 'a Repr.t
+  = fun t ->
+    t.path
diff --git a/path/linePrinter.ml b/path/linePrinter.ml
new file mode 100755
index 0000000..247d554
--- /dev/null
+++ b/path/linePrinter.ml
@@ -0,0 +1,53 @@
+module Repr = Layer.CanvaPrinter
+
+type t = Point.t
+
+type 'a repr =
+  { path: ('a Repr.t)
+  }
+
+let create_path
+  : 'b -> 'a repr
+  = fun _ ->
+    { path = Repr.create ()
+    }
+
+(* Start a new path. *)
+let start
+  : Point.t -> 'a repr -> 'a repr
+  = fun t {path} ->
+    let path = Repr.move_to (Point.get_coord t) path in
+    let path = Repr.line_to (Point.get_coord' t) path in
+    { path
+    }
+
+let line_to
+  : Point.t -> Point.t -> 'a repr -> 'a repr
+  = fun _ t {path} ->
+    let path = Repr.move_to (Point.get_coord t) path in
+    let path = Repr.line_to (Point.get_coord' t) path in
+    { path
+    }
+
+let quadratic_to
+  : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> 'a repr -> 'a repr
+  = fun _p0 _ctrl0 _ctrl1 p1 {path} ->
+
+    let path = Repr.move_to (Point.get_coord p1) path in
+    let path = Repr.line_to (Point.get_coord' p1) path in
+
+    { path
+    }
+
+let stop
+  : 'a repr -> 'a repr
+  = fun {path} ->
+
+
+    { path
+    }
+
+let get
+  : 'a repr -> 'a Repr.t
+  = fun {path; _} ->
+    path
diff --git a/path/wireFramePrinter.ml b/path/wireFramePrinter.ml
index fc27c62..13d90ad 100755
--- a/path/wireFramePrinter.ml
+++ b/path/wireFramePrinter.ml
@@ -9,8 +9,8 @@ type 'a repr =
   }
 
 let create_path
-  : unit -> 'a repr
-  = fun () ->
+  : 'b -> 'a repr
+  = fun _ ->
     { back = Repr.close
     ; path = Repr.create ()
     ; last_point = None
diff --git a/path/wireFramePrinter.mli b/path/wireFramePrinter.mli
index 72bb5b7..c6b7a98 100755
--- a/path/wireFramePrinter.mli
+++ b/path/wireFramePrinter.mli
@@ -3,7 +3,7 @@ type 'a repr
 type t = Point.t
 
 val create_path
-  : unit -> 'a repr
+  : 'b -> 'a repr
 
 (* Start a new path. *)
 val start