summaryrefslogtreecommitdiff
path: root/draw
diff options
context:
space:
mode:
Diffstat (limited to 'draw')
-rwxr-xr-xdraw/draw.ml233
-rwxr-xr-xdraw/dune8
-rwxr-xr-xdraw/point.ml78
-rwxr-xr-xdraw/point.mli13
4 files changed, 332 insertions, 0 deletions
diff --git a/draw/draw.ml b/draw/draw.ml
new file mode 100755
index 0000000..12a1abc
--- /dev/null
+++ b/draw/draw.ml
@@ -0,0 +1,233 @@
+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 = Curves.Bezier.three_points_quadratic p0 p1 p2
+ |> Curves.Bezier.quadratic_to_cubic in
+ let cx, cy = translate_point ~area bezier.Curves.Bezier.ctrl0
+ and cx', cy' = translate_point ~area bezier.Curves.Bezier.ctrl1
+ and x, y = translate_point ~area bezier.Curves.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 = Curves.Bspline.to_bezier ?connexion1:connexion points in
+ Array.iter beziers
+ ~f:(fun bezier ->
+ let cx, cy = translate_point ~area bezier.Curves.Bezier.ctrl0
+ and cx', cy' = translate_point ~area bezier.Curves.Bezier.ctrl1
+ and x, y = translate_point ~area bezier.Curves.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 Curves.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.Curves.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.Curves.Bezier.ctrl0
+ and cx', cy' = translate_point ~area bezier.Curves.Bezier.ctrl1
+ and x, y = translate_point ~area bezier.Curves.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.Curves.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.Curves.Bezier.ctrl1
+ and cx', cy' = translate_point' vect ~area bezier.Curves.Bezier.ctrl0
+ and x, y = translate_point' vect ~area bezier.Curves.Bezier.p0 in
+
+ Path.ccurve_to canvaPath
+ ~cx ~cy
+ ~cx' ~cy'
+ ~x ~y
+ done;
+ let x, y =
+ (Array.get beziers 0).Curves.Bezier.p0
+ |> translate_point' vect ~area in
+ Path.line_to canvaPath ~x ~y;
+
+ | _ -> ()
+
+type quick_path = Point.t list * Curves.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 = Curves.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.Curves.Bezier.p1
+ | _ -> None in
+
+ let* beziers' = Curves.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}
diff --git a/draw/dune b/draw/dune
new file mode 100755
index 0000000..1791604
--- /dev/null
+++ b/draw/dune
@@ -0,0 +1,8 @@
+(library
+ (name draw)
+ (libraries
+ gg
+ brr
+ curves
+ )
+ )
diff --git a/draw/point.ml b/draw/point.ml
new file mode 100755
index 0000000..150bc8e
--- /dev/null
+++ b/draw/point.ml
@@ -0,0 +1,78 @@
+open StdLabels
+
+type t =
+ { p: Gg.v2
+ ; size : float
+ ; angle: float
+ }
+
+let create x y =
+ { p = Gg.V2.v x y
+ ; size = 0.1
+ ; angle = Gg.Float.pi_div_4
+ }
+
+let (+) p1 p2 =
+ { p1 with p = Gg.V2.(+) p1.p p2 }
+
+let get_coord { p; _ } = p
+
+let get_coord'
+ : t -> Gg.v2
+ = fun t ->
+ let open Gg.V2 in
+ let trans = of_polar @@ v t.size t.angle in
+ t.p + trans
+
+let return_segment
+ : Curves.Bezier.t -> Curves.Bezier.t list -> Curves.Bezier.t list
+ = fun bezier beziers ->
+ (* We gave the points in reverse order, so we have to revert the
+ curve *)
+ let bezier' = Curves.Bezier.reverse bezier in
+ bezier'::beziers
+
+
+let get_new_segment connexion0 p5 p4 p3 p2 p1 =
+ let p5' = get_coord p5
+ and p4' = get_coord p4
+ and p3' = get_coord p3
+ and p2' = get_coord p2
+ and p1' = get_coord p1 in
+
+ let points_to_link =
+ [ p1'
+ ; p2'
+ ; p3'
+ ; p4'
+ ; p5' ] in
+ Curves.Bspline.to_bezier ?connexion0 points_to_link
+
+let add_point_in_path
+ : float -> float -> t list -> Curves.Bezier.t list -> t list * Curves.Bezier.t list
+ = fun x y path beziers ->
+ let lastClick = create x y in
+ let (let*) v f =
+ match v with
+ | Ok bezier ->
+ if Array.length bezier > 0 then
+ f (Array.get bezier 0)
+ else
+ lastClick::path, beziers
+ | _ ->
+ lastClick::path, beziers
+ in
+
+ let connexion0 = match beziers with
+ | hd::_ -> Some hd.Curves.Bezier.p1
+ | _ -> None in
+
+ match path with
+ | p4::p3::p2::p1::_ ->
+ let* bezier = get_new_segment connexion0
+ lastClick p4 p3 p2 p1 in
+ (* We remove the last point and add the bezier curve in the list*)
+ let firsts = lastClick::p4::p3::p2::[] in
+ firsts, return_segment bezier beziers
+ | _ ->
+ lastClick::path, beziers
diff --git a/draw/point.mli b/draw/point.mli
new file mode 100755
index 0000000..8e3f5aa
--- /dev/null
+++ b/draw/point.mli
@@ -0,0 +1,13 @@
+type t
+
+val (+): t -> Gg.v2 -> t
+
+val get_coord : t -> Gg.v2
+
+val create: float -> float -> t
+
+val add_point_in_path
+ : float -> float -> t list -> Curves.Bezier.t list -> t list * Curves.Bezier.t list
+
+val get_coord'
+ : t -> Gg.v2
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-23 08:36:41 +0000