aboutsummaryrefslogtreecommitdiff
path: root/path/draw.ml
diff options
context:
space:
mode:
Diffstat (limited to 'path/draw.ml')
-rwxr-xr-xpath/draw.ml79
1 files changed, 47 insertions, 32 deletions
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