From ec812521b31471ce9ac3d9bdf1288b1569defbc8 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Wed, 23 Dec 2020 19:11:31 +0100 Subject: Add svg output --- path/fillPrinter.ml | 121 ++++++++++++++++++++++++++-------------------------- 1 file changed, 61 insertions(+), 60 deletions(-) (limited to 'path/fillPrinter.ml') diff --git a/path/fillPrinter.ml b/path/fillPrinter.ml index d95030c..b506f9b 100755 --- a/path/fillPrinter.ml +++ b/path/fillPrinter.ml @@ -1,71 +1,72 @@ -module Repr = Layer.CanvaPrinter +module Make(Repr: Layer.Repr.PRINTER) = struct -type t = Point.t + type t = Point.t -type 'a repr = - { path: ('a Repr.t) - ; close : 'a Repr.t -> unit - } - -let create_path - : 'b -> 'a repr - = fun f -> - { close = f - ; path = Repr.create () + type 'a repr = + { path: ('a Repr.t) + ; close : 'a Repr.t -> unit } -(* Start a new path. *) -let start - : Point.t -> 'a repr -> 'a repr - = fun t {close ; path } -> - let path = Repr.move_to (Point.get_coord t) path in - { close - ; path - } + let create_path + : 'b -> 'a repr + = fun f -> + { close = f + ; path = Repr.create () + } + + (* Start a new path. *) + let start + : Point.t -> 'a repr -> 'a 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 -> 'a repr -> 'a 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 - t.close path; - { t with path} + let line_to + : Point.t -> Point.t -> 'a repr -> 'a 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 + t.close path; + { t with path} -let quadratic_to - : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> 'a repr -> 'a repr - = fun p0 ctrl0 ctrl1 p1 t -> + let quadratic_to + : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> 'a repr -> 'a repr + = fun p0 ctrl0 ctrl1 p1 t -> - let ctrl0' = Point.copy p1 ctrl0 - and ctrl1' = Point.copy p1 ctrl1 in + 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) - |> Repr.quadratic_to - (Point.get_coord' ctrl1') - (Point.get_coord' ctrl0') - (Point.get_coord' p0) - |> Repr.line_to (Point.get_coord p0) - |> Repr.quadratic_to - (Point.get_coord ctrl0') - (Point.get_coord ctrl1') - (Point.get_coord p1) - |> Repr.close in - t.close path; - { t with path} + let path = + Repr.move_to (Point.get_coord p1) t.path + |> Repr.line_to (Point.get_coord' p1) + |> Repr.quadratic_to + (Point.get_coord' ctrl1') + (Point.get_coord' ctrl0') + (Point.get_coord' p0) + |> Repr.line_to (Point.get_coord p0) + |> Repr.quadratic_to + (Point.get_coord ctrl0') + (Point.get_coord ctrl1') + (Point.get_coord p1) + |> Repr.close in + t.close path; + { t with path} -let stop - : 'a repr -> 'a repr - = fun t -> - t + let stop + : 'a repr -> 'a repr + = fun t -> + t -let get - : 'a repr -> 'a Repr.t - = fun t -> - t.path + let get + : 'a repr -> 'a Repr.t + = fun t -> + t.path +end -- cgit v1.2.3