summaryrefslogtreecommitdiff
path: root/path
diff options
context:
space:
mode:
Diffstat (limited to 'path')
-rwxr-xr-xpath/fillPrinter.ml121
-rwxr-xr-xpath/wireFramePrinter.ml132
-rwxr-xr-xpath/wireFramePrinter.mli33
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-23 08:30:08 +0000