Update

13 files changed, 149 insertions, 356 deletions

diff --git a/dune b/dune
index 314dc63..f3149ef 100755
--- a/dune
+++ b/dune
@@ -9,7 +9,7 @@
    messages 
    messages_json
    worker
-   draw
+   path
    shapes
    tools
    events
diff --git a/path/canvaPrinter.ml b/layer/canvaPrinter.ml
index e696d10..e696d10 100755
--- a/path/canvaPrinter.ml
+++ b/layer/canvaPrinter.ml
diff --git a/path/canvaPrinter.mli b/layer/canvaPrinter.mli
index e273054..e273054 100755
--- a/path/canvaPrinter.mli
+++ b/layer/canvaPrinter.mli
diff --git a/layer/dune b/layer/dune
new file mode 100755
index 0000000..f0b1b13
--- /dev/null
+++ b/layer/dune
@@ -0,0 +1,8 @@
+(library
+ (name layer)
+ (libraries 
+   gg
+   brr
+   shapes
+   )
+ )
diff --git a/path/repr.ml b/layer/repr.ml
index b91442b..b91442b 100755
--- a/path/repr.ml
+++ b/layer/repr.ml
diff --git a/path/builder.ml b/path/builder.ml
index 2774cae..01dda87 100755
--- a/path/builder.ml
+++ b/path/builder.ml
@@ -25,7 +25,7 @@ module type REPR = sig
     : t -> 'a repr -> 'a repr
 
   val line_to
-    : t -> 'a repr -> 'a repr
+    : t -> t -> 'a repr -> 'a repr
 
   val quadratic_to
     : t -> Gg.v2 -> Gg.v2 -> t -> 'a repr -> 'a repr
@@ -193,7 +193,7 @@ module Make(Point:P) = struct
           | p1::p2::[] ->
             let path =
               Repr.start p1 path
-              |> Repr.line_to p2 in
+              |> Repr.line_to p1 p2 in
             ( path )
           | p0::p1::p2::[] ->
             let path = Repr.start p0 path in
@@ -274,4 +274,106 @@ module Make(Point:P) = struct
               Repr.quadratic_to p0' ctrl0 ctrl1 p1' path
             )
   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
+
+    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 id = ref 0
+  module FixedBuilder = Draw(ToFixed)
+  let to_fixed
+    : t -> fixedPath
+    = fun t ->
+      incr id;
+      { id = !id
+      ; path = FixedBuilder.draw t
+               |> 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
+      : fixedPath -> 'a Repr.repr
+      = fun {path; _} ->
+
+        let repr = Repr.create_path () in
+        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
+
 end
diff --git a/path/builder.mli b/path/builder.mli
index 17c1a2a..f5adef1 100755
--- a/path/builder.mli
+++ b/path/builder.mli
@@ -24,7 +24,7 @@ module type REPR = sig
     : t -> 'a repr -> 'a repr
 
   val line_to
-    : t -> 'a repr -> 'a repr
+    : t -> t -> 'a repr -> 'a repr
 
   val quadratic_to
     : t -> Gg.v2 -> Gg.v2 -> t -> 'a repr -> 'a repr
@@ -74,4 +74,13 @@ module Make(P:P) : sig
       : t -> '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
+  end
+
 end
diff --git a/path/draw.ml b/path/draw.ml
deleted file mode 100755
index e628dbc..0000000
--- a/path/draw.ml
+++ /dev/null
@@ -1,245 +0,0 @@
-open StdLabels
-module Path = Brr_canvas.C2d.Path
-
-module Point = Point
-module Path_Builder = Builder.Make(Point)
-module Builder = Builder
-module WireFrame = WireFramePrinter
-
-(*
-(** 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)
-  = fun ~area vect point ->
-    let open Gg.V2 in
-    translate_point ~area
-      (point + vect)
-
-(* Draw a straight line between two points *)
-let line
-  : Gg.v2 -> p1:Point.t -> Path.t -> unit
-  = fun area ~p1 path ->
-    let x, y = translate_point ~area (Point.get_coord p1) in
-    Path.line_to path ~x ~y
-
-(* Draw a simple bezier curve from the three given points *)
-let three_points
-  : Gg.v2 -> p0:Point.t -> p1:Point.t -> p2:Point.t -> Path.t -> unit
-  = fun area ~p0 ~p1 ~p2 path ->
-    let p0 = Point.get_coord p0
-    and p1 = Point.get_coord p1
-    and p2 = Point.get_coord p2 in
-    let bezier = Shapes.Bezier.three_points_quadratic p0 p1 p2
-                 |> Shapes.Bezier.quadratic_to_cubic in
-    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
-
-    Path.ccurve_to path
-      ~cx ~cy
-      ~cx' ~cy'
-      ~x ~y
-
-let multi_points
-  : ?connexion:Gg.v2 -> Gg.v2 -> Point.t list -> Path.t -> unit
-  = fun ?connexion area points path ->
-
-    let (let*) v f =
-      match v with
-      | Ok beziers -> f beziers
-      | _ -> () in
-
-    let points = List.map ~f:Point.get_coord points in
-
-    let* beziers = Shapes.Bspline.to_bezier ?connexion1:connexion points in
-    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
-
-          Path.ccurve_to path
-            ~cx ~cy
-            ~cx' ~cy'
-            ~x ~y
-        )
-
-let circle
-  : Gg.v2 -> center:Gg.v2 -> float -> Path.t -> Path.t
-  = fun area ~center r path ->
-
-    let cx, cy = translate_point ~area center in
-    Path.arc
-      path
-      ~cx ~cy
-      ~r
-      ~start:0.
-      ~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 bezier array
-
-type t =
-  { id : int
-  ; path : path }
-
-let move_to
-  : area:Gg.v2 -> Brr_canvas.C2d.Path.t -> path -> unit
-  = fun ~area canvaPath path ->
-
-    match path with
-    | Empty -> ()
-    | Line (p0, _)
-    | Three_point (p0, _, _) ->
-      let x, y = translate_point ~area (Point.get_coord p0) in
-      Path.move_to canvaPath ~x ~y
-    | Curve beziers ->
-      try
-        let bezier = Array.get beziers 0 in
-        let x, y = translate_point ~area (Point.get_coord bezier.p0) in
-        Path.move_to canvaPath ~x ~y
-      with _ -> ()
-
-let draw
-  : ?connexion:Point.t -> area:Gg.v2 -> Brr_canvas.C2d.Path.t -> path -> unit
-  = fun ?connexion ~area canvaPath path ->
-    match connexion, path with
-
-    | _, Empty -> ()
-    | None, Line (_, p1) ->
-      ignore @@ line area ~p1 canvaPath
-
-    | Some p0, Line (p1, p2)
-    | None, Three_point (p0, p1, p2)
-    | Some _, Three_point (p0, p1, p2) ->
-      ignore @@ three_points area ~p0 ~p1 ~p2 canvaPath
-
-    | _, Curve beziers ->
-      Array.iter beziers
-        ~f:(fun bezier ->
-
-            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
-              ~cx' ~cy'
-              ~x ~y
-          )
-
-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
-        20.
-        (Float.neg Gg.Float.pi_div_4)
-    in
-    match connexion, path with
-    | _, Empty -> ()
-    | _, Three_point (p0, p1, p2) ->
-      let open Point in
-      let p0' = p0 + vect
-      and p1' = p1 + vect
-      and p2' = p2 + vect in
-
-      let x, y = translate_point' ~area vect @@ Point.get_coord p2 in
-      Path.line_to canvaPath ~x ~y;
-      ignore @@ three_points area ~p0:p2' ~p1:p1' ~p2:p0' canvaPath
-    | _, Curve beziers ->
-      let last = Array.get beziers ((Array.length beziers) -1) in
-
-      let x, y =
-        (Point.get_coord last.p1)
-        |> translate_point' vect ~area in
-
-      Path.line_to canvaPath ~x ~y;
-
-      for i = 1 to Array.length beziers do
-
-        let i = (Array.length beziers) - i in
-        let bezier = Array.get beziers i 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
-          ~cx' ~cy'
-          ~x ~y
-      done;
-
-    | _ -> ()
-
-type quick_path = Point.t list * bezier list
-
-let id = ref 0
-
-let to_path
-  : quick_path -> t
-  = fun (points, beziers) ->
-
-    incr id;
-    let id = !id in
-    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}
-    | beziers, _ ->
-      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 (Point.get_coord hd.p1)
-        | _ -> None in
-
-      let* beziers' = Shapes.Bspline.to_bezier
-          ?connexion1:connexion
-          (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
-          curves
-          (Array.of_list beziers)
-      in
-
-      {id; path = Curve t}
diff --git a/path/dune b/path/dune
index c9eff46..42965db 100755
--- a/path/dune
+++ b/path/dune
@@ -1,8 +1,9 @@
 (library
- (name draw)
+ (name path)
  (libraries 
    gg
    brr
+   layer
    shapes
    )
  )
diff --git a/path/point.ml b/path/point.ml
index 83cb168..808310c 100755
--- a/path/point.ml
+++ b/path/point.ml
@@ -12,7 +12,7 @@ let empty =
 
 let create x y =
   { p = Gg.V2.v x y
-  ; size = 20.
+  ; size = 10.
   ; angle = Float.neg Gg.Float.pi_div_4
   }
 
diff --git a/path/wireFramePrinter.ml b/path/wireFramePrinter.ml
index a0f52d6..fc27c62 100755
--- a/path/wireFramePrinter.ml
+++ b/path/wireFramePrinter.ml
@@ -1,4 +1,4 @@
-module Repr = CanvaPrinter
+module Repr = Layer.CanvaPrinter
 
 type t = Point.t
 
@@ -28,8 +28,8 @@ let start
     }
 
 let line_to
-  : Point.t -> 'a repr -> 'a repr
-  = fun t {back; path; _} ->
+  : Point.t -> Point.t -> 'a repr -> 'a repr
+  = fun _ t {back; path; _} ->
     let line' = Repr.line_to (Point.get_coord' t) in
     { back = (fun t -> back @@ line' t)
     ; path = Repr.line_to (Point.get_coord t) path
diff --git a/path/wireFramePrinter.mli b/path/wireFramePrinter.mli
index 26974f5..72bb5b7 100755
--- a/path/wireFramePrinter.mli
+++ b/path/wireFramePrinter.mli
@@ -10,7 +10,7 @@ val start
   : Point.t -> 'a repr -> 'a repr
 
 val line_to
-  : Point.t -> 'a repr -> 'a repr
+  : Point.t -> Point.t -> 'a repr -> 'a repr
 
 val quadratic_to
   : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> 'a repr -> 'a repr
@@ -19,5 +19,5 @@ val stop
   : 'a repr -> 'a repr
 
 val get 
-  : 'a repr -> 'a CanvaPrinter.t
+  : 'a repr -> 'a Layer.CanvaPrinter.t
 
diff --git a/script.ml b/script.ml
index 198453f..351433e 100755
--- a/script.ml
+++ b/script.ml
@@ -4,11 +4,9 @@ open Brr
 
 module Timer = Events.Timer
 
-module Point = Draw.Point
-module Path = Draw
-
-module Path_Builder = Path.Builder.Make(Point)
-module Path_Printer = Path_Builder.Draw(Path.WireFrame)
+module Path_Builder = Path.Builder.Make(Path.Point)
+module Path_Printer = Path_Builder.Draw(Path.WireFramePrinter)
+module Fixed_Printer = Path_Builder.DrawFixed(Path.WireFramePrinter)
 
 type mode =
   | Edit
@@ -18,7 +16,7 @@ type current = Path_Builder.t
 
 type state =
   { mode : mode
-  ; paths : Draw.t list (* All the previous paths *)
+  ; paths : Path_Builder.fixedPath list
   ; current : current
   ; timer : Timer.t
   }
@@ -33,7 +31,7 @@ type events =
   [ canva_events
   | `Point of float * (float * float) ]
 
-type canva_signal = Point.t
+type canva_signal = Path.Point.t
 
 module Mouse = Brr_note_kit.Mouse
 
@@ -69,7 +67,7 @@ let canva
     E.select [click; up], pos, c
 
 let insert_or_replace ((x, y) as p) path =
-  let point = Point.create x y in
+  let point = Path.Point.create x y in
   match Path_Builder.peek path with
   | None ->
     Path_Builder.add_point
@@ -78,7 +76,7 @@ let insert_or_replace ((x, y) as p) path =
   | Some p1 ->
     let open Gg.V2 in
 
-    let p1' = Point.get_coord p1 in
+    let p1' = Path.Point.get_coord p1 in
 
     let dist = (norm (p1' - (of_tuple p))) in
     if dist < 0.05 then (
@@ -96,7 +94,7 @@ let do_action
     | `Point (_delay, (x, y)), Edit ->
       (* Add the point in the list *)
       let current= Path_Builder.add_point
-          (Point.create x y)
+          (Path.Point.create x y)
           state.current in
       { state with current }
 
@@ -106,8 +104,11 @@ let do_action
     | `Out point, Edit ->
       Timer.stop state.timer;
       let current = insert_or_replace point state.current in
-      let beziers = Draw.to_path @@ Path_Builder.get current in
+      (*
+      let beziers = Path.Draw.to_path @@ Path_Builder.get current in
       let paths = beziers::state.paths
+      *)
+      let paths = Path_Builder.to_fixed current::state.paths
       and current = Path_Builder.empty in
       { state with mode = Out; paths; current }
     | _ -> state
@@ -117,61 +118,12 @@ let white = Jstr.v "#eceff4"
 let green = Jstr.v "#a3be8c"
 let nord8 = Jstr.v "#81a1c1"
 
-let draw
-  : ?connexion:Gg.v2 -> area:Gg.v2 -> Point.t list -> Brr_canvas.C2d.Path.t
-  = fun ?connexion ~area points ->
-
-    let open Brr_canvas.C2d in
-    let path = Path.create () in
-
-
-    let () = match points with
-      | [] -> ()
-      | hd::_ ->
-        let vect = Draw.Line (hd, Point.create 0. 0.) in
-        Draw.move_to ~area path vect in
-
-    let _ = match points with
-      | []
-      | _::[] -> ()
-      | _::p1::[] ->
-        Draw.line area ~p1 path
-      | p0::p1::p2::[] ->
-        Draw.three_points area ~p0 ~p1 ~p2 path
-      | _ ->
-        Draw.multi_points ?connexion area points path
-    in path
-
-let draw_path area points beziers =
-  let open Brr_canvas.C2d in
-  let connexion = match beziers with
-    | [] -> None
-    | hd ::_ -> Some hd.Shapes.Bezier.p1 in
-  (* Firt draw all the points most recent points *)
-  let path = draw ?connexion ~area points in
-
-  (* Then add the fixed ones *)
-  let path = List.fold_left beziers
-      ~init:path
-      ~f:(fun path bezier ->
-
-          let cx, cy = Draw.translate_point ~area bezier.Shapes.Bezier.ctrl0
-          and cx', cy' = Draw.translate_point ~area bezier.Shapes.Bezier.ctrl1
-          and x, y = Draw.translate_point ~area bezier.Shapes.Bezier.p1 in
-
-          Path.ccurve_to path
-            ~cx ~cy
-            ~cx' ~cy'
-            ~x ~y;
-          path
-        ) in
-  path
-
 let on_change canva mouse_position state =
+  let module Path' = Path in
   let open Brr_canvas.C2d in
 
   let w, h = Brr_canvas.Canvas.(float_of_int @@ w canva, float_of_int @@ h canva) in
-  let area = Gg.V2.v w h in
+  let _area = Gg.V2.v w h in
 
   let context = create canva in
 
@@ -195,52 +147,18 @@ let on_change canva mouse_position state =
   let current =
     match state.mode, pos with
     | Edit, Some (x, y) ->
-      Path_Builder.add_point (Point.create x y) state.current
+      Path_Builder.add_point (Path'.Point.create x y) state.current
     | _ ->
       state.current
   in
 
-  let path = Draw.WireFrame.get @@ Path_Printer.draw current  in
-  stroke context path;
-
-(*
-  let points, beziers = Path_Builder.get current in
-
-  let path = draw_path area (points) beziers in
+  let path = Path'.WireFramePrinter.get @@ Path_Printer.draw current  in
   stroke context path;
 
-*)
   List.iter state.paths
     ~f:(fun path ->
-
-        (* This is ugly, and probably non efficient, but is an appropriate solution for
-           the cases of overlapping path *)
-        match path.Draw.path with
-        | Draw.Curve beziers ->
-
-          Array.iter beziers
-            ~f:(fun bezier ->
-
-                let b = Draw.Curve [|bezier|] in
-                let p = Path.create () in
-                Draw.move_to ~area p b;
-                Draw.draw ~area p b;
-                Draw.go_back ~area p b;
-                Path.close p;
-                fill context p;
-                stroke context p
-
-              )
-
-        | _ ->
-
-          let p = Path.create () in
-          Draw.move_to ~area p path.Draw.path;
-          Draw.draw ~area p path.Draw.path;
-          Draw.go_back ~area p path.Draw.path;
-          Path.close p;
-          fill context p;
-          stroke context p
+        let path = Path'.WireFramePrinter.get @@ Fixed_Printer.draw path in
+        stroke context path
       );
   ()