Correction in the bezier drawing

7 files changed, 199 insertions, 80 deletions

diff --git a/layer/ductusPrinter.mli b/layer/ductusPrinter.mli
new file mode 100755
index 0000000..cd849ef
--- /dev/null
+++ b/layer/ductusPrinter.mli
@@ -0,0 +1,28 @@
+module Make(Repr:Repr.PRINTER): sig
+
+  type repr 
+
+  type t = Path.Point.t
+
+  val create_path
+    : 'b -> repr
+
+  (* Start a new path. *)
+  val start
+    : Path.Point.t -> repr -> repr
+
+  val line_to
+    : Path.Point.t -> Path.Point.t -> repr -> repr
+
+  val quadratic_to
+    : (Path.Point.t * Gg.v2 * Gg.v2 * Path.Point.t) -> repr -> repr
+
+  val stop
+    : repr -> repr
+
+  val get 
+    : repr -> Repr.t
+
+end
+
+
diff --git a/layer/fillPrinter.ml b/layer/fillPrinter.ml
index 19f0ac4..9b6546c 100755
--- a/layer/fillPrinter.ml
+++ b/layer/fillPrinter.ml
@@ -1,47 +1,7 @@
 module Point = Path.Point
 
-
-
 module Make(Repr: Repr.PRINTER) = struct
 
-  (* Divide a curve in subelements *)
-  let rec divide level p0 ctrl0 ctrl1 p1 path =
-
-    let bezier =
-      { Shapes.Bezier.p0 = Path.Point.get_coord p0
-      ; ctrl0
-      ; ctrl1
-      ; p1 = Path.Point.get_coord p1
-      } in
-
-    let ratio = 0.5 in
-    let bezier0, bezier1 = Shapes.Bezier.slice ratio bezier in
-    let point = Path.Point.mix ratio bezier0.Shapes.Bezier.p1 p0 p1 in
-
-    let ctrl0_0 = Point.copy p0 bezier0.Shapes.Bezier.ctrl0
-    and ctrl0_1 = Point.copy point bezier0.Shapes.Bezier.ctrl1
-
-    and ctrl1_0 = Point.copy point bezier1.Shapes.Bezier.ctrl0
-    and ctrl1_1 = Point.copy p1 bezier1.Shapes.Bezier.ctrl1 in
-
-
-    match level with
-    | 0 ->
-      path :=
-        Repr.quadratic_to
-          (Point.get_coord' @@ ctrl1_1)
-          (Point.get_coord' @@ ctrl1_0)
-          (Point.get_coord' point) !path;
-
-      path :=
-        Repr.quadratic_to
-          (Point.get_coord' @@ ctrl0_1)
-          (Point.get_coord' @@ ctrl0_0)
-          (Point.get_coord' p0) !path;
-    | n ->
-      divide (n-1) point (Point.get_coord ctrl1_0) (Point.get_coord ctrl1_1) p1 path;
-      divide (n-1) p0 (Point.get_coord ctrl0_0) (Point.get_coord ctrl0_1) point path;
-
   type t = Point.t
 
   type repr =
@@ -57,55 +17,83 @@ module Make(Repr: Repr.PRINTER) = struct
       }
 
   (* Start a new path. *)
-  let start
-    : Path.Point.t -> repr -> repr
-    = fun t {close ; path } ->
-      let path = Repr.move_to (Point.get_coord t) path in
+
+  let start'
+    : Gg.v2 -> Gg.v2 -> repr -> repr
+    = fun p1 _ {close ; path } ->
+      let path = Repr.move_to p1 path in
       { close
       ; path
       }
 
-  let line_to
-    : Point.t -> Point.t -> repr -> repr
-    = fun p0 p1 t ->
+  let start
+    : Path.Point.t -> repr -> repr
+    = fun pt t ->
+      let p = (Point.get_coord pt) in
+      start' p p t
+
+  let line_to'
+    : (Gg.v2 * Gg.v2) -> (Gg.v2 * Gg.v2) -> repr -> repr
+    = fun (p0, p1) (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.move_to p1 t.path
+        |> Repr.line_to p1'
+        |> Repr.line_to p0'
+        |> Repr.line_to p0
+        |> Repr.line_to p1
         |> Repr.close in
       let path = t.close path in
       { t with path}
 
-  let quadratic_to
-    : (t * Gg.v2 * Gg.v2 * t) -> repr -> repr
-    = fun (p0,  ctrl0, ctrl1, p1) t ->
+  let line_to
+    : Point.t -> Point.t -> repr -> repr
+    = fun p0 p1 t ->
 
-      let ctrl0' = Point.copy p1 ctrl0
-      and ctrl1' = Point.copy p1 ctrl1 in
+      line_to'
+        (  Point.get_coord p0
+        , Point.get_coord p1 )
+        ( Point.get_coord' p0
+        , Point.get_coord' p1 )
+        t
 
-      let path = Repr.move_to (Point.get_coord p1) t.path
-                 |> Repr.line_to (Point.get_coord' p1) in
-      let path = ref path in
+  let quadratic_to'
+    : (Gg.v2 * Gg.v2 * Gg.v2 * Gg.v2) -> (Gg.v2 * Gg.v2 * Gg.v2 * Gg.v2) -> repr -> repr
+    = fun (p0,  ctrl0, ctrl1, p1) (p0',  ctrl0', ctrl1', p1') t ->
 
-      (* Backward *)
-      divide 3 p0 ctrl0 ctrl1 p1 path ;
-      path := Repr.line_to (Point.get_coord p0) !path;
 
-      (* Forward *)
-      path := Repr.quadratic_to
-          (Point.get_coord ctrl0')
-          (Point.get_coord ctrl1')
-          (Point.get_coord p1) !path;
+      let path =
+        Repr.move_to p1 t.path
+        |> Repr.line_to p1'
 
-      let path = !path in
+        (* Backward *)
+        |> Repr.quadratic_to
+          ctrl1'
+          ctrl0'
+          p0'
+        |> Repr.line_to p0
 
-      let path = Repr.close path in
+        (* Forward *)
+        |> Repr.quadratic_to
+          ctrl0
+          ctrl1
+          p1
+        |> Repr.close
+        |> t.close in
+
+
+      { t with path }
+
+  let quadratic_to
+    : (t * Gg.v2 * Gg.v2 * t) -> repr -> repr
+    = fun (p0,  ctrl0, ctrl1, p1) t ->
 
-      let path = t.close path in
-      { t with path}
 
+      let ctrl0' = Point.get_coord' @@ Point.copy p0 ctrl0
+      and ctrl1' = Point.get_coord' @@ Point.copy p1 ctrl1 in
+      quadratic_to'
+        (Point.get_coord p0, ctrl0, ctrl1, Point.get_coord p1)
+        (Point.get_coord' p0, ctrl0', ctrl1', Point.get_coord' p1)
+        t
 
   let stop
     : repr -> repr
diff --git a/layer/fillPrinter.mli b/layer/fillPrinter.mli
new file mode 100755
index 0000000..c1bb30e
--- /dev/null
+++ b/layer/fillPrinter.mli
@@ -0,0 +1,27 @@
+module Make(Repr:Repr.PRINTER): sig
+
+  type repr 
+
+  type t = Path.Point.t
+
+  val create_path
+    : (Repr.t -> Repr.t) -> repr
+
+  (* Start a new path. *)
+  val start
+    : Path.Point.t -> repr -> repr
+
+  val line_to
+    : Path.Point.t -> Path.Point.t -> repr -> repr
+
+  val quadratic_to
+    : (Path.Point.t * Gg.v2 * Gg.v2 * Path.Point.t) -> repr -> repr
+
+  val stop
+    : repr -> repr
+
+  val get 
+    : repr -> Repr.t
+
+end
+
diff --git a/layer/linePrinter.mli b/layer/linePrinter.mli
new file mode 100755
index 0000000..b6e9603
--- /dev/null
+++ b/layer/linePrinter.mli
@@ -0,0 +1,29 @@
+module Make(Repr:Repr.PRINTER): sig
+
+  type repr 
+
+  type t = Path.Point.t
+
+  val create_path
+    : 'b -> repr
+
+  (* Start a new path. *)
+  val start
+    : Path.Point.t -> repr -> repr
+
+  val line_to
+    : Path.Point.t -> Path.Point.t -> repr -> repr
+
+  val quadratic_to
+    : (Path.Point.t * Gg.v2 * Gg.v2 * Path.Point.t) -> repr -> repr
+
+  val stop
+    : repr -> repr
+
+  val get 
+    : repr -> Repr.t
+
+end
+
+
+
diff --git a/layer/paths.ml b/layer/paths.ml
index 927a5f9..e170767 100755
--- a/layer/paths.ml
+++ b/layer/paths.ml
@@ -1,3 +1,4 @@
+open StdLabels
 (** Common  module for ensuring that the function is evaluated only once *)
 
 module type REPRESENTABLE = sig
@@ -13,7 +14,6 @@ end
 module FillCanvaRepr = FillPrinter.Make(CanvaPrinter)
 module DuctusCanvaRepr = DuctusPrinter.Make(CanvaPrinter)
 module LineCanvaRepr = LinePrinter.Make(CanvaPrinter)
-module WireCanvaRepr = WireFramePrinter.Make(CanvaPrinter)
 
 (* SVG representation *)
 
@@ -21,7 +21,6 @@ module FillSVGRepr = FillPrinter.Make(Svg)
 module DuctusSVGRepr = DuctusPrinter.Make(Svg)
 module WireSVGRepr = WireFramePrinter.Make(Svg)
 
-
 type printer =
   [ `Fill
   | `Line
@@ -96,3 +95,50 @@ let to_svg
         []
     | `Line ->
       raise Not_found
+
+(** Transform the two fixed path, into a single one. *)
+module ReprFixed = struct
+
+  type t = Path.Fixed.t * Path.Fixed.t
+
+  module R = struct
+    type t = Path.Point.t
+
+    type repr' =
+      | Move of (Path.Point.t)
+      | Line_to of (Path.Point.t * Path.Point.t)
+      | Quadratic of (t * Gg.v2 * Gg.v2 * t)
+
+    type repr = repr' list
+
+    let start t actions =
+      (Move t)::actions
+
+    let line_to p0 p1 actions =
+      Line_to (p0, p1)::actions
+
+    let quadratic_to
+      : (t * Gg.v2 * Gg.v2 * t) -> repr -> repr
+      = fun q actions ->
+        (Quadratic q)::actions
+
+    let stop
+      : repr -> repr
+      = fun v -> List.rev v
+
+  end
+
+  let repr
+    : t -> (module Path.Repr.M with type t = Path.Point.t and type repr = 's) -> 's -> 's
+    = fun (type s) (path, _) (module Repr:Path.Repr.M with type t = Path.Point.t and type repr = s) state ->
+      let elems = Path.Fixed.repr path (module R) [] in
+
+      let state = List.fold_left elems
+          ~init:state
+          ~f:(fun state -> function
+              | R.Move pt -> Repr.start pt state
+              | R.Line_to (p0, p1) -> Repr.line_to p0 p1 state
+              | R.Quadratic t -> Repr.quadratic_to t state
+            )
+      in Repr.stop state
+end
diff --git a/script.it/script.ml b/script.it/script.ml
index ffdff9a..05bec1b 100755
--- a/script.it/script.ml
+++ b/script.it/script.ml
@@ -4,6 +4,7 @@ open Brr
 open Brr_note
 
 
+
 (** Create the element in the page, and the event handler *)
 let canva
   : Brr.El.t -> [> State.canva_events] Note.E.t * (float * float) option Note.S.t * Brr_canvas.Canvas.t
@@ -223,6 +224,7 @@ let on_change canva mouse_position timer state =
     end
   in
 
+
   Layer.Paths.to_canva (module Path.Path_Builder) current context state.rendering;
 
   List.iter state.paths
@@ -243,7 +245,7 @@ let on_change canva mouse_position timer state =
           | _ -> ()
         in
 
-        Layer.Paths.to_canva (module Path.Fixed) path context state.rendering
+        Layer.Paths.to_canva (module Layer.Paths.ReprFixed) (path, path) context state.rendering
       );
 
   let () = match state.mode with
@@ -253,7 +255,7 @@ let on_change canva mouse_position timer state =
         state.paths
         ~f:(fun path ->
             if id = Path.Fixed.id path then
-              Layer.Paths.to_canva (module Path.Fixed) path context `Line
+              Layer.Paths.to_canva (module Layer.Paths.ReprFixed) (path, path) context `Line
           )
     | Selection (Point (id, point)) ->
       (* As before, mark the selected path *)
@@ -276,7 +278,7 @@ let on_change canva mouse_position timer state =
                       | Some p -> p
                     end
                 | None -> path end in
-              Layer.Paths.to_canva (module Path.Fixed) path context `Line
+              Layer.Paths.to_canva (module Layer.Paths.ReprFixed) (path, path) context `Line
           );
 
       (* Now draw the selected point *)
@@ -389,7 +391,6 @@ let page_main id =
                        |> Option.iter Logr.hold in
 
 
-
         (* Ajust the angle slide according to the state *)
         let angle_signal = S.map (fun s -> Jstr.of_float s.State.angle) state in
         let _ =
diff --git a/script.it/state.ml b/script.it/state.ml
index cc199d1..107a72b 100755
--- a/script.it/state.ml
+++ b/script.it/state.ml
@@ -325,8 +325,8 @@ let do_action
 
                    Layer.Paths.to_svg
                      ~color:Blog.Nord.nord0
-                     (module Path.Fixed)
-                     path
+                     (module Layer.Paths.ReprFixed)
+                     (path, path)
                      state.rendering
 
                  )) in