aboutsummaryrefslogtreecommitdiff
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, 0 insertions, 332 deletions
diff --git a/draw/draw.ml b/draw/draw.ml
deleted file mode 100755
index 12a1abc..0000000
--- a/draw/draw.ml
+++ /dev/null
@@ -1,233 +0,0 @@
-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
deleted file mode 100755
index 1791604..0000000
--- a/draw/dune
+++ /dev/null
@@ -1,8 +0,0 @@
-(library
- (name draw)
- (libraries
- gg
- brr
- curves
- )
- )
diff --git a/draw/point.ml b/draw/point.ml
deleted file mode 100755
index 150bc8e..0000000
--- a/draw/point.ml
+++ /dev/null
@@ -1,78 +0,0 @@
-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
deleted file mode 100755
index 8e3f5aa..0000000
--- a/draw/point.mli
+++ /dev/null
@@ -1,13 +0,0 @@
-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-09-28 04:21:00 +0000