First commit

8 files changed, 450 insertions, 48 deletions

diff --git a/path/builder.ml b/path/builder.ml
index f52fb9e..4fe8951 100755
--- a/path/builder.ml
+++ b/path/builder.ml
@@ -1,21 +1,52 @@
+open StdLabels
+
 (** Signature for points *)
 module type P = sig
   type t
 
+  val empty : t
+
   val get_coord : t -> Gg.v2
 
+  val copy : t -> Gg.v2 -> t
+
+  type 'a repr
+
+  val create_path
+    : unit -> 'a repr
+
+  (* Start a new path. *)
+  val start
+    : t -> 'a repr -> 'a repr
+
+  val line_to
+    : t -> 'a repr -> 'a repr
+
+  val quadratic_to
+    : t -> t -> t -> t -> 'a repr -> 'a repr
+
+  val stop
+    : 'a repr -> 'a repr
 end
 
-module Make(P:P) = struct
+module Make(Point:P) = struct
+
+  (** Point creation  **)
 
-  type t = P.t list * Shapes.Bezier.t list
+  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 t = Point.t list * bezier list
 
   let get_new_segment connexion0 p5 p4 p3 p2 p1 =
-    let p5' = P.get_coord p5
-    and p4' = P.get_coord p4
-    and p3' = P.get_coord p3
-    and p2' = P.get_coord p2
-    and p1' = P.get_coord p1 in
+    let p5' = Point.get_coord p5
+    and p4' = Point.get_coord p4
+    and p3' = Point.get_coord p3
+    and p2' = Point.get_coord p2
+    and p1' = Point.get_coord p1 in
 
     let points_to_link =
       [ p1'
@@ -28,7 +59,7 @@ module Make(P:P) = struct
   let empty = ([], [])
 
   let add_point
-    : P.t -> t -> t
+    : Point.t -> t -> t
     = fun lastPoint (path, beziers) ->
       let (let*) v f =
         match v with
@@ -42,21 +73,30 @@ module Make(P:P) = struct
       in
 
       let connexion0 = match beziers with
-        | hd::_ -> Some hd.Shapes.Bezier.p1
+        | hd::_ -> Some (Point.get_coord hd.p1)
         | _ -> None in
 
       match path with
       | p4::p3::p2::p1::_ ->
         let* bezier = get_new_segment connexion0
             lastPoint p4 p3 p2 p1 in
+
+        let bezier_point =
+          { p0 = lastPoint
+          ; p1 = p4
+          ; ctrl0 = bezier.Shapes.Bezier.ctrl0
+          ; ctrl1 = bezier.Shapes.Bezier.ctrl1
+          } in
+
         (* 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, (Shapes.Bezier.reverse bezier)::beziers*)
+        firsts, bezier_point::beziers
       | _ ->
         lastPoint::path, beziers
 
   let replace_last
-    : P.t -> t -> t
+    : Point.t -> t -> t
     = fun lastPoint ((path, beziers) as t) ->
       match path, beziers with
       | _::(tl), beziers ->
@@ -66,14 +106,14 @@ module Make(P:P) = struct
         add_point lastPoint t
 
   let peek2
-    : t -> (P.t * P.t) option
+    : t -> (Point.t * Point.t) option
     = fun (path, _) ->
       match path with
       | h1::h2::_ -> Some (h1, h2)
       | _ -> None
 
   let peek
-    : t -> P.t option
+    : t -> Point.t option
     = fun (path, _) ->
       match path with
       | [] -> None
@@ -83,4 +123,147 @@ module Make(P:P) = struct
     : 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:(true, first_point, 0)
+            ~f:(fun (first, prev_point, i) point ->
+                if first then (false, prev_point, i)
+                else
+
+                  let bezier_curve = Array.get beziers i in
+
+                  Array.set curves i
+                    { p0 = prev_point
+                    ; ctrl0 = bezier_curve.Shapes.Bezier.ctrl1
+                    ; ctrl1 = bezier_curve.Shapes.Bezier.ctrl0
+                    ; p1 = point };
+
+
+                  (false, point, i + 1)
+              ) in
+        curves
+
+
+  (** Drawing path **)
+
+  let draw
+    : t -> 'a Point.repr
+    = fun (points, beziers) ->
+
+      let path = Point.create_path () in
+      let path, last = match points with
+        | [] ->
+          ( path
+          , None )
+        | p1::[] ->
+          ( Point.start p1 path
+          , Some p1 )
+        | p1::p2::[] ->
+          let path =
+            Point.start p1 path
+            |> Point.line_to p2 in
+          ( path
+          , Some p2 )
+        | p0::p1::p2::[] ->
+          let path = Point.start p0 path in
+
+          let b = Shapes.Bezier.three_points_quadratic
+              (Point.get_coord p0)
+              (Point.get_coord p1)
+              (Point.get_coord p2)
+                  |> Shapes.Bezier.quadratic_to_cubic in
+
+          let p0' = Point.copy p0 b.Shapes.Bezier.p0
+          and ctrl0 = Point.copy p0 b.Shapes.Bezier.ctrl0
+          and ctrl1 = Point.copy p1 b.Shapes.Bezier.ctrl1
+          and p2' = Point.copy p1 b.Shapes.Bezier.p1 in
+
+          ( Point.quadratic_to p0' ctrl0 ctrl1 p2' path
+          , Some p2 )
+        | (p0::_ as points) ->
+
+          let (let*) v f =
+            match v with
+            | Ok beziers -> f beziers
+            | _ -> path, None in
+
+          let points' = List.map ~f:Point.get_coord points in
+          let connexion = match beziers with
+            | [] -> None
+            | hd ::_ -> Some (Point.get_coord hd.p1) in
+
+          let* beziers = Shapes.Bspline.to_bezier ?connexion1:connexion points' in
+
+          (* Stdlib does not provide fold_left_i function and we need to map
+             each bezier point with the associated point in the curve.
+
+             So I use references here for keeping each result element
+
+          *)
+          let path = ref path in
+          let point = ref p0 in
+
+          List.iteri points
+            ~f:(fun i pt ->
+
+                if i < Array.length beziers then (
+
+                  let bezier = Array.get beziers i in
+
+                  let p0' = Point.copy pt bezier.Shapes.Bezier.p0
+                  and ctrl0 = Point.copy (!point) bezier.Shapes.Bezier.ctrl0
+                  and ctrl1 = Point.copy pt bezier.Shapes.Bezier.ctrl1
+                  and p1' = Point.copy pt bezier.Shapes.Bezier.p1 in
+
+                  path := Point.quadratic_to p0' ctrl0 ctrl1 p1' (!path);
+
+                  let () = if i > 0 then
+                      point := pt in
+                  ()
+                )
+              );
+          ( !path
+          , Some !point )
+      in
+
+      let path = match last with
+        | None -> path
+        | Some pt ->
+
+          (* TODO : instead of copying the last point, keeep a track for each
+             point as declared in the type P.t *)
+
+          List.fold_left beziers
+            ~init:path
+            ~f:(fun path bezier ->
+                let p0' = bezier.p0
+                and ctrl0 = Point.copy pt bezier.ctrl0
+                and ctrl1 = Point.copy pt bezier.ctrl1
+                and p1' = bezier.p1 in
+                Point.quadratic_to p0' ctrl0 ctrl1 p1' path
+              )
+      in Point.stop path
 end
diff --git a/path/builder.mli b/path/builder.mli
index d99e0b2..64617fa 100755
--- a/path/builder.mli
+++ b/path/builder.mli
@@ -2,12 +2,40 @@
 module type P = sig
   type t
 
+  val empty : t
+
   val get_coord : t -> Gg.v2
+
+  val copy : t -> Gg.v2 -> t
+
+  type 'a repr 
+
+  val create_path
+    : unit -> 'a repr
+
+  (* Start a new path. *)
+  val start
+    : t -> 'a repr -> 'a repr
+
+  val line_to
+    : t -> 'a repr -> 'a repr
+
+  val quadratic_to
+    : t -> t -> t -> t -> 'a repr -> 'a repr
+
+  val stop
+    : 'a repr -> 'a repr
 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 t
 
   (** Create an empty path *)
@@ -29,5 +57,11 @@ module Make(P:P) : sig
     : t -> (P.t * P.t) option
 
   val get
-    : t -> P.t list * Shapes.Bezier.t list
+    : t -> P.t list * bezier list
+
+  val points_to_beziers
+    : P.t list -> Shapes.Bezier.t array -> bezier array
+
+  val draw
+    : t -> 'a P.repr
 end
diff --git a/path/canvaPrinter.ml b/path/canvaPrinter.ml
new file mode 100755
index 0000000..e696d10
--- /dev/null
+++ b/path/canvaPrinter.ml
@@ -0,0 +1,42 @@
+module Path = Brr_canvas.C2d.Path
+module V2 = Gg.V2
+
+type 'a t = Path.t
+
+let create
+  : unit -> 'a t
+  = Path.create
+
+(* Start a new path. *)
+let move_to
+  : Gg.v2 -> 'a t -> 'a t
+  = fun point path ->
+    let x, y = V2.to_tuple point in
+    Path.move_to ~x ~y path;
+    path
+
+let line_to
+  : Gg.v2 -> 'a t -> 'a t
+  = fun  point path ->
+    let x, y = V2.to_tuple point in
+    Path.line_to ~x ~y path;
+    path
+
+let quadratic_to
+  : Gg.v2 -> Gg.v2 -> Gg.v2 -> 'a t -> 'a t
+  = fun  ctrl0 ctrl1 p1 path ->
+    let cx, cy = V2.to_tuple ctrl0
+    and cx', cy' = V2.to_tuple ctrl1
+    and x, y = V2.to_tuple p1 in
+    Path.ccurve_to
+      ~cx ~cy
+      ~cx' ~cy'
+      ~x ~y
+      path;
+    path
+
+let close
+  : 'a t -> 'a t
+  = fun path ->
+    Path.close path;
+    path
diff --git a/path/canvaPrinter.mli b/path/canvaPrinter.mli
new file mode 100755
index 0000000..e273054
--- /dev/null
+++ b/path/canvaPrinter.mli
@@ -0,0 +1,2 @@
+include Repr.PRINTER 
+  with type 'a t = Brr_canvas.C2d.Path.t
diff --git a/path/draw.ml b/path/draw.ml
index ba5272a..5e05e01 100755
--- a/path/draw.ml
+++ b/path/draw.ml
@@ -2,14 +2,25 @@ open StdLabels
 module Path = Brr_canvas.C2d.Path
 
 module Point = Point
+module Path_Builder = Builder.Make(Point)
 module Builder = Builder
 
+(*
 (** Translate the point in the canva area *)
 let translate_point
   : area:Gg.v2 -> Gg.v2 -> (float * float)
   = fun ~area point ->
     let x, y = Gg.V2.(to_tuple @@ mul area point) in
     x, ((Gg.V2.y area) -. y)
+*)
+
+let translate_point
+  : area:Gg.v2 -> Gg.v2 -> (float * float)
+  = fun ~area point ->
+    let _ = area in
+
+    let x, y = Gg.V2.(to_tuple @@ point) in
+    x, y
 
 let translate_point'
   : area:Gg.v2 -> Gg.v2 -> Gg.v2 -> (float * float)
@@ -80,11 +91,13 @@ let circle
       ~stop:Gg.Float.two_pi;
     path
 
+type bezier = Path_Builder.bezier
+
 type path =
   | Empty
   | Line of Point.t * Point.t
   | Three_point of Point.t * Point.t * Point.t
-  | Curve of Shapes.Bezier.t array
+  | Curve of bezier array
 
 type t =
   { id : int
@@ -93,6 +106,7 @@ type t =
 let move_to
   : area:Gg.v2 -> Brr_canvas.C2d.Path.t -> path -> unit
   = fun ~area canvaPath path ->
+
     match path with
     | Empty -> ()
     | Line (p0, _)
@@ -102,7 +116,7 @@ let move_to
     | Curve beziers ->
       try
         let bezier = Array.get beziers 0 in
-        let x, y = translate_point ~area bezier.Shapes.Bezier.p0 in
+        let x, y = translate_point ~area (Point.get_coord bezier.p0) in
         Path.move_to canvaPath ~x ~y
       with _ -> ()
 
@@ -124,9 +138,9 @@ let draw
       Array.iter beziers
         ~f:(fun bezier ->
 
-            let cx, cy = translate_point ~area bezier.Shapes.Bezier.ctrl0
-            and cx', cy' = translate_point ~area bezier.Shapes.Bezier.ctrl1
-            and x, y = translate_point ~area bezier.Shapes.Bezier.p1 in
+            let cx, cy = translate_point ~area bezier.Path_Builder.ctrl0
+            and cx', cy' = translate_point ~area bezier.Path_Builder.ctrl1
+            and x, y = translate_point ~area (Point.get_coord bezier.Path_Builder.p1) in
 
             Path.ccurve_to canvaPath
               ~cx ~cy
@@ -138,8 +152,8 @@ let go_back
   : ?connexion:Point.t -> area:Gg.v2 -> Brr_canvas.C2d.Path.t -> path -> unit
   = fun ?connexion ~area canvaPath path ->
     let vect = Gg.V2.of_polar @@ Gg.V2.v
-        0.01
-        Gg.Float.pi_div_4
+        20.
+        (Float.neg Gg.Float.pi_div_4)
     in
     match connexion, path with
     | _, Empty -> ()
@@ -156,7 +170,7 @@ let go_back
       let last = Array.get beziers ((Array.length beziers) -1) in
 
       let x, y =
-        last.Shapes.Bezier.p1
+        (Point.get_coord last.p1)
         |> translate_point' vect ~area in
 
       Path.line_to canvaPath ~x ~y;
@@ -166,9 +180,9 @@ let go_back
         let i = (Array.length beziers) - i in
         let bezier = Array.get beziers i in
 
-        let cx, cy = translate_point' vect ~area bezier.Shapes.Bezier.ctrl1
-        and cx', cy' = translate_point' vect ~area bezier.Shapes.Bezier.ctrl0
-        and x, y = translate_point' vect ~area bezier.Shapes.Bezier.p0 in
+        let cx, cy = translate_point' vect ~area bezier.ctrl1
+        and cx', cy' = translate_point' vect ~area bezier.ctrl0
+        and x, y = translate_point' vect ~area (Point.get_coord bezier.p0) in
 
         Path.ccurve_to canvaPath
           ~cx ~cy
@@ -178,7 +192,7 @@ let go_back
 
     | _ -> ()
 
-type quick_path = Point.t list * Shapes.Bezier.t list
+type quick_path = Point.t list * bezier list
 
 let id = ref 0
 
@@ -188,31 +202,29 @@ let to_path
 
     incr id;
     let id = !id in
-    match beziers with
-    | [] ->
-      begin match points with
-        | p0::p1::[] -> {id; path=Line (p0, p1)}
-        | p0::p1::p2::[] -> {id; path=Three_point (p0, p1, p2)}
-        | points ->
-
-          let (let*) v f =
-            match v with
-            | Ok beziers -> f beziers
-            | _ -> {id; path=Empty} in
-
-          let points' = List.map ~f:Point.get_coord points in
-
-          let* beziers = Shapes.Bspline.to_bezier points' in
-          {id; path=Curve beziers}
-      end
-    | _ ->
+    match beziers, points with
+    | [], [] -> {id; path = Empty}
+    | [], p0::p1::[] -> {id; path=Line (p0, p1)}
+    | [], p0::p1::p2::[] -> {id; path=Three_point (p0, p1, p2)}
+    | [], points ->
+
+      let (let*) v f =
+        match v with
+        | Ok beziers -> f beziers
+        | _ -> {id; path=Empty} in
+
+      let points' = List.map ~f:Point.get_coord points in
+      let* beziers = Shapes.Bspline.to_bezier points' in
+      let curves = Path_Builder.points_to_beziers points beziers in
+      {id; path=Curve curves}
+    | _, _ ->
       let (let*) v f =
         match v with
         | Ok beziers -> f beziers
         | _ -> {id; path=Curve (Array.of_list beziers)} in
 
       let connexion = match beziers with
-        | hd::_ -> Some hd.Shapes.Bezier.p1
+        | hd::_ -> Some (Point.get_coord hd.p1)
         | _ -> None in
 
       let* beziers' = Shapes.Bspline.to_bezier
@@ -220,9 +232,12 @@ let to_path
           (List.map points ~f:Point.get_coord) in
 
 
+      let curves = Path_Builder.points_to_beziers points beziers' in
+
+
       (* Create a new array with both lenght *)
       let t = Array.append
-          beziers'
+          curves
           (Array.of_list beziers)
       in
 
diff --git a/path/point.ml b/path/point.ml
index 9e10200..7a32ae1 100755
--- a/path/point.ml
+++ b/path/point.ml
@@ -4,12 +4,21 @@ type t =
   ; angle: float
   }
 
+let empty =
+  { p = Gg.V2.of_tuple (0., 0.)
+  ; size = 0.
+  ; angle = 0.
+  }
+
 let create x y =
   { p = Gg.V2.v x y
-  ; size = 0.1
-  ; angle = Gg.Float.pi_div_4
+  ; size = 20.
+  ; angle = Float.neg Gg.Float.pi_div_4
   }
 
+let copy point p =
+  { point with p }
+
 let (+) p1 p2 =
   { p1 with p = Gg.V2.(+) p1.p p2 }
 
@@ -22,3 +31,76 @@ let get_coord'
     let trans = of_polar @@ v t.size t.angle in
     t.p + trans
 
+module Repr = CanvaPrinter
+
+type 'a repr =
+  { back: ('a Repr.t -> 'a Repr.t)
+  ; path: ('a Repr.t)
+  ; last_point : t option
+  }
+
+let create_path
+  : unit -> 'a repr
+  = fun () ->
+    { back = Repr.close
+    ; path = Repr.create ()
+    ; last_point = None
+    }
+
+(* Start a new path. *)
+let start
+  : t -> 'a repr -> 'a repr
+  = fun t {back; path; _} ->
+    let path = Repr.move_to (get_coord t) path in
+    let line' = Repr.line_to (get_coord' t) in
+    { back = (fun p -> back @@ line' p)
+    ; path
+    ; last_point = Some t
+    }
+
+let line_to
+  : t -> 'a repr -> 'a repr
+  = fun t {back; path; _} ->
+    let line' = Repr.line_to (get_coord' t) in
+    { back = (fun t -> back @@ line' t)
+    ; path = Repr.line_to t.p path
+    ; last_point = Some t
+    }
+
+let quadratic_to
+  : t -> t -> t -> t -> 'a repr -> 'a repr
+  = fun p0 ctrl0 ctrl1 p1 t ->
+
+    let line' path =
+      Repr.quadratic_to
+        (get_coord' ctrl1)
+        (get_coord' ctrl0)
+        (get_coord' p0) path in
+
+    let path = Repr.quadratic_to
+        (get_coord ctrl0)
+        (get_coord ctrl1)
+        (get_coord p1)
+        t.path in
+    { back = (fun p -> t.back @@ line' p)
+    ; path
+    ; last_point = Some p1
+    }
+
+let stop
+  : 'a repr -> 'a repr
+  = fun {back; path; last_point} ->
+
+    let path =
+      match last_point with
+      | Some point -> Repr.line_to (get_coord' point) path
+      | None -> path in
+
+    { back = (fun x -> x)
+    ; path = back path
+    ; last_point = None }
+
+let get
+  : 'a repr -> 'a Repr.t
+  = fun {back; path; _} ->
+    back path
diff --git a/path/point.mli b/path/point.mli
index 4b75c3c..6418de4 100755
--- a/path/point.mli
+++ b/path/point.mli
@@ -1,10 +1,35 @@
 type t
 
+val empty : t
+
 val (+): t -> Gg.v2 -> t
 
 val get_coord : t -> Gg.v2
 
 val create: float -> float -> t
 
+val copy : t -> Gg.v2 -> t
+
 val get_coord'
   : t -> Gg.v2
+
+type 'a repr 
+
+val create_path
+  : unit -> 'a repr
+
+(* Start a new path. *)
+val start
+  : t -> 'a repr -> 'a repr
+
+val line_to
+  : t -> 'a repr -> 'a repr
+
+val quadratic_to
+  : t -> t -> t -> t -> 'a repr -> 'a repr
+
+val stop
+  : 'a repr -> 'a repr
+
+val get 
+  : 'a repr -> 'a CanvaPrinter.t
diff --git a/path/repr.ml b/path/repr.ml
new file mode 100755
index 0000000..b91442b
--- /dev/null
+++ b/path/repr.ml
@@ -0,0 +1,19 @@
+module type PRINTER = sig
+
+  type 'a t
+
+  val create: unit -> 'a t
+
+  (* Start a new path. *)
+  val move_to: Gg.v2 -> 'a t -> 'a t
+
+  val line_to: Gg.v2 -> 'a t -> 'a t
+
+  (** [quadratic_to ctrl0 ctrl1 p1] ctreate a quadratic curve from the current
+      point to [p1], with control points [ctrl0] and [ctrl1] *)
+  val quadratic_to: Gg.v2 -> Gg.v2 -> Gg.v2 -> 'a t -> 'a t
+
+  (** Request for the path to be closed *)
+  val close: 'a t -> 'a t
+
+end