module Point = Path.Point module Make(Repr: Repr.PRINTER) = struct (* Divide a curve in subelements *) let rec divide level p0 ctrl0 ctrl1 p1 path = let bezier = { Shapes.Bezier.p0 = Path.Point.get_coord p0 ; ctrl0 ; ctrl1 ; p1 = Path.Point.get_coord p1 } in let ratio = 0.5 in let bezier0, bezier1 = Shapes.Bezier.slice ratio bezier in let point = Path.Point.mix ratio bezier0.Shapes.Bezier.p1 p0 p1 in let ctrl0_0 = Point.copy p0 bezier0.Shapes.Bezier.ctrl0 and ctrl0_1 = Point.copy point bezier0.Shapes.Bezier.ctrl1 and ctrl1_0 = Point.copy point bezier1.Shapes.Bezier.ctrl0 and ctrl1_1 = Point.copy p1 bezier1.Shapes.Bezier.ctrl1 in match level with | 0 -> path := Repr.quadratic_to (Point.get_coord' @@ ctrl1_1) (Point.get_coord' @@ ctrl1_0) (Point.get_coord' point) !path; path := Repr.quadratic_to (Point.get_coord' @@ ctrl0_1) (Point.get_coord' @@ ctrl0_0) (Point.get_coord' p0) !path; | n -> divide (n-1) point (Point.get_coord ctrl1_0) (Point.get_coord ctrl1_1) p1 path; divide (n-1) p0 (Point.get_coord ctrl0_0) (Point.get_coord ctrl0_1) point path; type t = Point.t type repr = { path: Repr.t ; close : Repr.t -> Repr.t } let create_path : (Repr.t -> Repr.t) -> repr = fun f -> { close = f ; path = Repr.create () } (* Start a new path. *) let start : Path.Point.t -> repr -> repr = fun t {close ; path } -> let path = Repr.move_to (Point.get_coord t) path in { close ; path } let line_to : Point.t -> Point.t -> repr -> repr = fun p0 p1 t -> let path = Repr.move_to (Point.get_coord p1) t.path |> Repr.line_to (Point.get_coord' p1) |> Repr.line_to (Point.get_coord' p0) |> Repr.line_to (Point.get_coord p0) |> Repr.line_to (Point.get_coord p1) |> Repr.close in let path = t.close path in { t with path} let quadratic_to : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> repr -> repr = fun p0 ctrl0 ctrl1 p1 t -> let ctrl0' = Point.copy p1 ctrl0 and ctrl1' = Point.copy p1 ctrl1 in let path = Repr.move_to (Point.get_coord p1) t.path |> Repr.line_to (Point.get_coord' p1) in let path = ref path in (* Backward *) divide 3 p0 ctrl0 ctrl1 p1 path ; path := Repr.line_to (Point.get_coord p0) !path; (* Forward *) path := Repr.quadratic_to (Point.get_coord ctrl0') (Point.get_coord ctrl1') (Point.get_coord p1) !path; let path = !path in let path = Repr.close path in let path = t.close path in { t with path} let stop : repr -> repr = fun t -> t let get : repr -> Repr.t = fun t -> t.path end