From a63662059215a26db627c4b76147a3c9338f5b74 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Wed, 6 Jan 2021 22:09:53 +0100 Subject: Point suppression --- layer/ductusPrinter.ml | 69 ++++++++++++++++++++++++++++++++++++++++++++++++++ layer/linePrinter.ml | 48 ++++++++++++++++------------------- layer/paths.ml | 23 +++++------------ 3 files changed, 98 insertions(+), 42 deletions(-) create mode 100755 layer/ductusPrinter.ml (limited to 'layer') diff --git a/layer/ductusPrinter.ml b/layer/ductusPrinter.ml new file mode 100755 index 0000000..3ed1c3c --- /dev/null +++ b/layer/ductusPrinter.ml @@ -0,0 +1,69 @@ +module Make(Repr: Repr.PRINTER) = struct + + type t = Path.Point.t + + type repr = + { path: (Repr.t) + } + + let create_path + : 'b -> repr + = fun _ -> + { path = Repr.create () + } + + (* Start a new path. *) + let start + : Path.Point.t -> repr -> repr + = fun t {path} -> + let path = Repr.move_to (Path.Point.get_coord t) path in + let path = Repr.line_to (Path.Point.get_coord' t) path in + { path + } + + let line_to + : Path.Point.t -> Path.Point.t -> repr -> repr + = fun _ t {path} -> + let path = Repr.move_to (Path.Point.get_coord t) path in + let path = Repr.line_to (Path.Point.get_coord' t) path in + { path + } + + let quadratic_to + : Path.Point.t -> Gg.v2 -> Gg.v2 -> Path.Point.t -> repr -> repr + = fun p0 ctrl0 ctrl1 p1 { path } -> + + let path = ref path in + + let bezier = + { Shapes.Bezier.p0 = Path.Point.get_coord p0 + ; ctrl0 + ; ctrl1 + ; p1 = Path.Point.get_coord p1 + } in + + (* Mark each point on the bezier curve. The first point is the most + recent point *) + let delay = + ((Path.Point.get_stamp p0) -. (Path.Point.get_stamp p1)) + *. 100. /. 3. + in + for i = 0 to (Int.of_float delay) do + let bezier', _ = Shapes.Bezier.slice (0.1 *. (Float.of_int i)) bezier in + let point = Path.Point.copy p1 bezier'.Shapes.Bezier.p1 in + path := Repr.move_to (Path.Point.get_coord point) !path; + path := Repr.line_to (Path.Point.get_coord' point) !path; + done; + + { path = !path } + + let stop + : repr -> repr + = fun path -> path + + + let get + : repr -> Repr.t + = fun {path; _} -> + path +end diff --git a/layer/linePrinter.ml b/layer/linePrinter.ml index 3ed1c3c..c15bcc9 100755 --- a/layer/linePrinter.ml +++ b/layer/linePrinter.ml @@ -2,6 +2,21 @@ module Make(Repr: Repr.PRINTER) = struct type t = Path.Point.t + let mark point path = + let open Gg.V2 in + let point = Path.Point.get_coord point in + + let dist = 5. + and dist' = -5. in + + let path = Repr.move_to (point - (of_tuple (dist, dist))) path + |> Repr.line_to ( point + (of_tuple (dist, dist))) + |> Repr.move_to (point + (of_tuple (dist', dist))) + |> Repr.line_to ( point + (of_tuple (dist, dist'))) + in + path + + type repr = { path: (Repr.t) } @@ -16,16 +31,15 @@ module Make(Repr: Repr.PRINTER) = struct let start : Path.Point.t -> repr -> repr = fun t {path} -> - let path = Repr.move_to (Path.Point.get_coord t) path in - let path = Repr.line_to (Path.Point.get_coord' t) path in + let path = mark t path in { path } let line_to : Path.Point.t -> Path.Point.t -> repr -> repr = fun _ t {path} -> - let path = Repr.move_to (Path.Point.get_coord t) path in - let path = Repr.line_to (Path.Point.get_coord' t) path in + let path = Repr.line_to (Path.Point.get_coord t) path + |> mark t in { path } @@ -33,29 +47,11 @@ module Make(Repr: Repr.PRINTER) = struct : Path.Point.t -> Gg.v2 -> Gg.v2 -> Path.Point.t -> repr -> repr = fun p0 ctrl0 ctrl1 p1 { path } -> - let path = ref path in - - let bezier = - { Shapes.Bezier.p0 = Path.Point.get_coord p0 - ; ctrl0 - ; ctrl1 - ; p1 = Path.Point.get_coord p1 - } in - - (* Mark each point on the bezier curve. The first point is the most - recent point *) - let delay = - ((Path.Point.get_stamp p0) -. (Path.Point.get_stamp p1)) - *. 100. /. 3. - in - for i = 0 to (Int.of_float delay) do - let bezier', _ = Shapes.Bezier.slice (0.1 *. (Float.of_int i)) bezier in - let point = Path.Point.copy p1 bezier'.Shapes.Bezier.p1 in - path := Repr.move_to (Path.Point.get_coord point) !path; - path := Repr.line_to (Path.Point.get_coord' point) !path; - done; + let path = Repr.move_to (Path.Point.get_coord p0) path + |> Repr.quadratic_to ctrl0 ctrl1 (Path.Point.get_coord p1) + |> mark p1 in - { path = !path } + { path = path } let stop : repr -> repr diff --git a/layer/paths.ml b/layer/paths.ml index 3cedd6d..59215df 100755 --- a/layer/paths.ml +++ b/layer/paths.ml @@ -11,13 +11,14 @@ end (* Canva representation *) module FillCanvaRepr = FillPrinter.Make(CanvaPrinter) +module DuctusCanvaRepr = DuctusPrinter.Make(CanvaPrinter) module LineCanvaRepr = LinePrinter.Make(CanvaPrinter) module WireCanvaRepr = WireFramePrinter.Make(CanvaPrinter) (* SVG representation *) module FillSVGRepr = FillPrinter.Make(Svg) -module LineSVGRepr = LinePrinter.Make(Svg) +module DuctusSVGRepr = DuctusPrinter.Make(Svg) module WireSVGRepr = WireFramePrinter.Make(Svg) @@ -47,9 +48,9 @@ let to_canva | `Ductus -> R.repr path - (module WireCanvaRepr) - (WireCanvaRepr.create_path (fun p -> Brr_canvas.C2d.fill ctx p; p)) - |> WireCanvaRepr.get + (module DuctusCanvaRepr) + (DuctusCanvaRepr.create_path (fun p -> Brr_canvas.C2d.fill ctx p; p)) + |> DuctusCanvaRepr.get |> Brr_canvas.C2d.stroke ctx @@ -81,18 +82,6 @@ let to_svg ; v (Jstr.v "stroke") color] !paths - | `Line -> - let svg_path = R.repr - path - (module LineSVGRepr) - (LineSVGRepr.create_path (fun _ -> ())) - |> LineSVGRepr.get in - Svg.path - ~at:Brr.At.[ - v (Jstr.v "fill") color - ; v (Jstr.v "stroke") color - ; v (Jstr.v "d") svg_path ] - [] | `Ductus -> let svg_path = R.repr path @@ -105,3 +94,5 @@ let to_svg ; v (Jstr.v "stroke") color ; v (Jstr.v "d") svg_path ] [] + | `Line -> + raise Not_found -- cgit v1.2.3