From 20d10a93e5becb41d1145f9d35136782365b0ba4 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Thu, 17 Dec 2020 13:56:00 +0100 Subject: Refactor --- path/draw.ml | 229 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 229 insertions(+) create mode 100755 path/draw.ml (limited to 'path/draw.ml') 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} -- cgit v1.2.3