diff options
author | Sébastien Dailly <sebastien@chimrod.com> | 2020-12-23 19:11:31 +0100 |
---|---|---|
committer | Sébastien Dailly <sebastien@chimrod.com> | 2020-12-23 19:11:31 +0100 |
commit | ec812521b31471ce9ac3d9bdf1288b1569defbc8 (patch) | |
tree | d384c959b9e9bb2a04141ab56077026fe6e7c7f3 /path | |
parent | 6354358caa1dfbf2fe1d481f6ac5fba3775938fc (diff) |
Add svg output
Diffstat (limited to 'path')
-rwxr-xr-x | path/fillPrinter.ml | 121 | ||||
-rwxr-xr-x | path/wireFramePrinter.ml | 132 | ||||
-rwxr-xr-x | path/wireFramePrinter.mli | 33 |
3 files changed, 145 insertions, 141 deletions
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 diff --git a/path/wireFramePrinter.ml b/path/wireFramePrinter.ml index 13d90ad..47eb9d4 100755 --- a/path/wireFramePrinter.ml +++ b/path/wireFramePrinter.ml @@ -1,78 +1,78 @@ -module Repr = Layer.CanvaPrinter +module Make(Repr: Layer.Repr.PRINTER) = struct + type t = Point.t -type t = Point.t - -type 'a repr = - { back: ('a Repr.t -> 'a Repr.t) - ; path: ('a Repr.t) - ; last_point : Point.t option - } - -let create_path - : 'b -> 'a repr - = fun _ -> - { back = Repr.close - ; path = Repr.create () - ; last_point = None + type 'a repr = + { back: ('a Repr.t -> 'a Repr.t) + ; path: ('a Repr.t) + ; last_point : Point.t option } -(* Start a new path. *) -let start - : Point.t -> 'a repr -> 'a repr - = fun t {back; path; _} -> - let path = Repr.move_to (Point.get_coord t) path in - let line' = Repr.line_to (Point.get_coord' t) in - { back = (fun p -> back @@ line' p) - ; path - ; last_point = Some t - } + let create_path + : 'b -> 'a repr + = fun _ -> + { back = Repr.close + ; path = Repr.create () + ; last_point = None + } -let line_to - : Point.t -> Point.t -> 'a repr -> 'a repr - = fun _ t {back; path; _} -> - let line' = Repr.line_to (Point.get_coord' t) in - { back = (fun t -> back @@ line' t) - ; path = Repr.line_to (Point.get_coord t) path - ; last_point = Some t - } + (* Start a new path. *) + let start + : Point.t -> 'a repr -> 'a repr + = fun t {back; path; _} -> + let path = Repr.move_to (Point.get_coord t) path in + let line' = Repr.line_to (Point.get_coord' t) in + { back = (fun p -> back @@ line' p) + ; path + ; last_point = Some t + } -let quadratic_to - : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> 'a repr -> 'a repr - = fun p0 ctrl0 ctrl1 p1 t -> + let line_to + : Point.t -> Point.t -> 'a repr -> 'a repr + = fun _ t {back; path; _} -> + let line' = Repr.line_to (Point.get_coord' t) in + { back = (fun t -> back @@ line' t) + ; path = Repr.line_to (Point.get_coord t) path + ; last_point = Some t + } - let ctrl0' = Point.copy p1 ctrl0 - and ctrl1' = Point.copy p1 ctrl1 in + let quadratic_to + : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> 'a repr -> 'a repr + = fun p0 ctrl0 ctrl1 p1 t -> - let line' path = - Repr.quadratic_to - (Point.get_coord' @@ ctrl1') - (Point.get_coord' ctrl0') - (Point.get_coord' p0) path in + let ctrl0' = Point.copy p1 ctrl0 + and ctrl1' = Point.copy p1 ctrl1 in - let path = Repr.quadratic_to - (Point.get_coord ctrl0') - (Point.get_coord ctrl1') - (Point.get_coord p1) - t.path in - { back = (fun p -> t.back @@ line' p) - ; path - ; last_point = Some p1 - } + let line' path = + Repr.quadratic_to + (Point.get_coord' @@ ctrl1') + (Point.get_coord' ctrl0') + (Point.get_coord' p0) path in + + let path = Repr.quadratic_to + (Point.get_coord ctrl0') + (Point.get_coord ctrl1') + (Point.get_coord p1) + t.path in + { back = (fun p -> t.back @@ line' p) + ; path + ; last_point = Some p1 + } -let stop - : 'a repr -> 'a repr - = fun {back; path; last_point} -> + let stop + : 'a repr -> 'a repr + = fun {back; path; last_point} -> - let path = - match last_point with - | Some point -> Repr.line_to (Point.get_coord' point) path - | None -> path in + let path = + match last_point with + | Some point -> Repr.line_to (Point.get_coord' point) path + | None -> path in - { back = (fun x -> x) - ; path = back path - ; last_point = None } + { back = (fun x -> x) + ; path = back path + ; last_point = None } -let get - : 'a repr -> 'a Repr.t - = fun {back; path; _} -> - back path + let get + : 'a repr -> 'a Repr.t + = fun {back; path; _} -> + back path +end diff --git a/path/wireFramePrinter.mli b/path/wireFramePrinter.mli index c6b7a98..d6f346e 100755 --- a/path/wireFramePrinter.mli +++ b/path/wireFramePrinter.mli @@ -1,23 +1,26 @@ -type 'a repr +module Make(Repr:Layer.Repr.PRINTER): sig -type t = Point.t + type 'a repr -val create_path - : 'b -> 'a repr + type t = Point.t -(* Start a new path. *) -val start - : Point.t -> 'a repr -> 'a repr + val create_path + : 'b -> 'a repr -val line_to - : Point.t -> Point.t -> 'a repr -> 'a repr + (* Start a new path. *) + val start + : Point.t -> 'a repr -> 'a repr -val quadratic_to - : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> 'a repr -> 'a repr + val line_to + : Point.t -> Point.t -> 'a repr -> 'a repr -val stop - : 'a repr -> 'a repr + val quadratic_to + : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> 'a repr -> 'a repr -val get - : 'a repr -> 'a Layer.CanvaPrinter.t + val stop + : 'a repr -> 'a repr + val get + : 'a repr -> 'a Repr.t + +end |