Refactor

1 files changed, 229 insertions, 0 deletions

diff --git a/path/draw.ml b/path/draw.ml
new file mode 100755
index 0000000..757c778
--- /dev/null
+++ b/path/draw.ml
@@ -0,0 +1,229 @@
+open StdLabels
+module Path = Brr_canvas.C2d.Path
+
+module Point = Point
+
+(** 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 -> 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 path =
+  | Empty
+  | Line of Point.t * Point.t
+  | Three_point of Point.t * Point.t * Point.t
+  | Curve of Shapes.Bezier.t 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 bezier.Shapes.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.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 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
+        0.02
+        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 =
+        last.Shapes.Bezier.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.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
+
+        Path.ccurve_to canvaPath
+          ~cx ~cy
+          ~cx' ~cy'
+          ~x ~y
+      done;
+
+    | _ -> ()
+
+type quick_path = Point.t list * Shapes.Bezier.t list
+
+let id = ref 0
+
+let to_path
+  : quick_path -> t
+  = fun (points, beziers) ->
+
+    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
+    | _ ->
+      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
+        | _ -> None in
+
+      let* beziers' = Shapes.Bspline.to_bezier
+          ?connexion1:connexion
+          (List.map points ~f:Point.get_coord) in
+
+
+      (* Create a new array with both lenght *)
+      let t = Array.append
+          beziers'
+          (Array.of_list beziers)
+      in
+
+      {id; path = Curve t}