diff options
author | Sébastien Dailly <sebastien@chimrod.com> | 2021-01-03 05:42:35 +0100 |
---|---|---|
committer | Sébastien Dailly <sebastien@chimrod.com> | 2021-01-03 20:19:14 +0100 |
commit | a8f37f041dce3f16917b6659d3ca97492f178f4d (patch) | |
tree | 35223969024c9ebaed7309b5a6299f8de5f18d1f /layer/wireFramePrinter.ml | |
parent | 20addbe8fd0ac4c79c8a69a4f888ec320a9ca4c3 (diff) |
Communication with webworker
Diffstat (limited to 'layer/wireFramePrinter.ml')
-rwxr-xr-x | layer/wireFramePrinter.ml | 80 |
1 files changed, 80 insertions, 0 deletions
diff --git a/layer/wireFramePrinter.ml b/layer/wireFramePrinter.ml new file mode 100755 index 0000000..81ab271 --- /dev/null +++ b/layer/wireFramePrinter.ml @@ -0,0 +1,80 @@ +module Point = Path.Point + +module Make(Repr: Repr.PRINTER) = struct + type t = Point.t + + type repr = + { back: (Repr.t -> Repr.t) + ; path: (Repr.t) + ; last_point : Point.t option + } + + let create_path + : 'b -> repr + = fun _ -> + { back = Repr.close + ; path = Repr.create () + ; last_point = None + } + + (* Start a new path. *) + let start + : Point.t -> repr -> 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 line_to + : Point.t -> Point.t -> repr -> 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 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 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 + : repr -> 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 + + { back = (fun x -> x) + ; path = back path + ; last_point = None } + + let get + : repr -> Repr.t + = fun {back; path; _} -> + back path +end |