From 561d0f0155f4906d90eb7e73a3ff9cb28909126f Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Fri, 5 Feb 2021 09:08:39 +0100 Subject: Update project structure --- script.it/layer/wireFramePrinter.ml | 80 +++++++++++++++++++++++++++++++++++++ 1 file changed, 80 insertions(+) create mode 100755 script.it/layer/wireFramePrinter.ml (limited to 'script.it/layer/wireFramePrinter.ml') diff --git a/script.it/layer/wireFramePrinter.ml b/script.it/layer/wireFramePrinter.ml new file mode 100755 index 0000000..81ab271 --- /dev/null +++ b/script.it/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 -- cgit v1.2.3