aboutsummaryrefslogtreecommitdiff
path: root/path/fillPrinter.ml
diff options
context:
space:
mode:
authorSébastien Dailly <sebastien@chimrod.com>2020-12-20 20:58:31 +0100
committerSébastien Dailly <sebastien@chimrod.com>2020-12-20 20:58:31 +0100
commit1f1f13a3f02e7f5f5da5926a402d53f2ccbfe536 (patch)
treed704a69ccf10b42cbe2ddba8a2291ee3d7d39091 /path/fillPrinter.ml
parenta86ede2f3d29d6de6ef7c1eab577f00d4c583660 (diff)
Update du soir
Diffstat (limited to 'path/fillPrinter.ml')
-rwxr-xr-xpath/fillPrinter.ml71
1 files changed, 71 insertions, 0 deletions
diff --git a/path/fillPrinter.ml b/path/fillPrinter.ml
new file mode 100755
index 0000000..d95030c
--- /dev/null
+++ b/path/fillPrinter.ml
@@ -0,0 +1,71 @@
+module Repr = Layer.CanvaPrinter
+
+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 ()
+ }
+
+(* 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 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 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 get
+ : 'a repr -> 'a Repr.t
+ = fun t ->
+ t.path