From 0faaa5fda396f0eca6bebf69f3624a344278fa6e Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Sat, 19 Dec 2020 19:59:17 +0100
Subject: First commit

---
 path/draw.ml | 79 ++++++++++++++++++++++++++++++++++++------------------------
 1 file changed, 47 insertions(+), 32 deletions(-)

(limited to 'path/draw.ml')

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
 
-- 
cgit v1.2.3