From 5ee27e786a3f1ed3eecc1e5c36f6e1e551388451 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Sun, 10 Jan 2021 21:28:35 +0100 Subject: Correction in the bezier drawing --- layer/ductusPrinter.mli | 28 ++++++++++ layer/fillPrinter.ml | 132 ++++++++++++++++++++++-------------------------- layer/fillPrinter.mli | 27 ++++++++++ layer/linePrinter.mli | 29 +++++++++++ layer/paths.ml | 50 +++++++++++++++++- 5 files changed, 192 insertions(+), 74 deletions(-) create mode 100755 layer/ductusPrinter.mli create mode 100755 layer/fillPrinter.mli create mode 100755 layer/linePrinter.mli (limited to 'layer') diff --git a/layer/ductusPrinter.mli b/layer/ductusPrinter.mli new file mode 100755 index 0000000..cd849ef --- /dev/null +++ b/layer/ductusPrinter.mli @@ -0,0 +1,28 @@ +module Make(Repr:Repr.PRINTER): sig + + type repr + + type t = Path.Point.t + + val create_path + : 'b -> repr + + (* Start a new path. *) + val start + : Path.Point.t -> repr -> repr + + val line_to + : Path.Point.t -> Path.Point.t -> repr -> repr + + val quadratic_to + : (Path.Point.t * Gg.v2 * Gg.v2 * Path.Point.t) -> repr -> repr + + val stop + : repr -> repr + + val get + : repr -> Repr.t + +end + + diff --git a/layer/fillPrinter.ml b/layer/fillPrinter.ml index 19f0ac4..9b6546c 100755 --- a/layer/fillPrinter.ml +++ b/layer/fillPrinter.ml @@ -1,47 +1,7 @@ module Point = Path.Point - - module Make(Repr: Repr.PRINTER) = struct - (* Divide a curve in subelements *) - let rec divide level p0 ctrl0 ctrl1 p1 path = - - let bezier = - { Shapes.Bezier.p0 = Path.Point.get_coord p0 - ; ctrl0 - ; ctrl1 - ; p1 = Path.Point.get_coord p1 - } in - - let ratio = 0.5 in - let bezier0, bezier1 = Shapes.Bezier.slice ratio bezier in - let point = Path.Point.mix ratio bezier0.Shapes.Bezier.p1 p0 p1 in - - let ctrl0_0 = Point.copy p0 bezier0.Shapes.Bezier.ctrl0 - and ctrl0_1 = Point.copy point bezier0.Shapes.Bezier.ctrl1 - - and ctrl1_0 = Point.copy point bezier1.Shapes.Bezier.ctrl0 - and ctrl1_1 = Point.copy p1 bezier1.Shapes.Bezier.ctrl1 in - - - match level with - | 0 -> - path := - Repr.quadratic_to - (Point.get_coord' @@ ctrl1_1) - (Point.get_coord' @@ ctrl1_0) - (Point.get_coord' point) !path; - - path := - Repr.quadratic_to - (Point.get_coord' @@ ctrl0_1) - (Point.get_coord' @@ ctrl0_0) - (Point.get_coord' p0) !path; - | n -> - divide (n-1) point (Point.get_coord ctrl1_0) (Point.get_coord ctrl1_1) p1 path; - divide (n-1) p0 (Point.get_coord ctrl0_0) (Point.get_coord ctrl0_1) point path; - type t = Point.t type repr = @@ -57,55 +17,83 @@ module Make(Repr: Repr.PRINTER) = struct } (* Start a new path. *) - let start - : Path.Point.t -> repr -> repr - = fun t {close ; path } -> - let path = Repr.move_to (Point.get_coord t) path in + + let start' + : Gg.v2 -> Gg.v2 -> repr -> repr + = fun p1 _ {close ; path } -> + let path = Repr.move_to p1 path in { close ; path } - let line_to - : Point.t -> Point.t -> repr -> repr - = fun p0 p1 t -> + let start + : Path.Point.t -> repr -> repr + = fun pt t -> + let p = (Point.get_coord pt) in + start' p p t + + let line_to' + : (Gg.v2 * Gg.v2) -> (Gg.v2 * Gg.v2) -> repr -> repr + = fun (p0, p1) (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.move_to p1 t.path + |> Repr.line_to p1' + |> Repr.line_to p0' + |> Repr.line_to p0 + |> Repr.line_to p1 |> Repr.close in let path = t.close path in { t with path} - let quadratic_to - : (t * Gg.v2 * Gg.v2 * t) -> repr -> repr - = fun (p0, ctrl0, ctrl1, p1) t -> + let line_to + : Point.t -> Point.t -> repr -> repr + = fun p0 p1 t -> - let ctrl0' = Point.copy p1 ctrl0 - and ctrl1' = Point.copy p1 ctrl1 in + line_to' + ( Point.get_coord p0 + , Point.get_coord p1 ) + ( Point.get_coord' p0 + , Point.get_coord' p1 ) + t - let path = Repr.move_to (Point.get_coord p1) t.path - |> Repr.line_to (Point.get_coord' p1) in - let path = ref path in + let quadratic_to' + : (Gg.v2 * Gg.v2 * Gg.v2 * Gg.v2) -> (Gg.v2 * Gg.v2 * Gg.v2 * Gg.v2) -> repr -> repr + = fun (p0, ctrl0, ctrl1, p1) (p0', ctrl0', ctrl1', p1') t -> - (* Backward *) - divide 3 p0 ctrl0 ctrl1 p1 path ; - path := Repr.line_to (Point.get_coord p0) !path; - (* Forward *) - path := Repr.quadratic_to - (Point.get_coord ctrl0') - (Point.get_coord ctrl1') - (Point.get_coord p1) !path; + let path = + Repr.move_to p1 t.path + |> Repr.line_to p1' - let path = !path in + (* Backward *) + |> Repr.quadratic_to + ctrl1' + ctrl0' + p0' + |> Repr.line_to p0 - let path = Repr.close path in + (* Forward *) + |> Repr.quadratic_to + ctrl0 + ctrl1 + p1 + |> Repr.close + |> t.close in + + + { t with path } + + let quadratic_to + : (t * Gg.v2 * Gg.v2 * t) -> repr -> repr + = fun (p0, ctrl0, ctrl1, p1) t -> - let path = t.close path in - { t with path} + let ctrl0' = Point.get_coord' @@ Point.copy p0 ctrl0 + and ctrl1' = Point.get_coord' @@ Point.copy p1 ctrl1 in + quadratic_to' + (Point.get_coord p0, ctrl0, ctrl1, Point.get_coord p1) + (Point.get_coord' p0, ctrl0', ctrl1', Point.get_coord' p1) + t let stop : repr -> repr diff --git a/layer/fillPrinter.mli b/layer/fillPrinter.mli new file mode 100755 index 0000000..c1bb30e --- /dev/null +++ b/layer/fillPrinter.mli @@ -0,0 +1,27 @@ +module Make(Repr:Repr.PRINTER): sig + + type repr + + type t = Path.Point.t + + val create_path + : (Repr.t -> Repr.t) -> repr + + (* Start a new path. *) + val start + : Path.Point.t -> repr -> repr + + val line_to + : Path.Point.t -> Path.Point.t -> repr -> repr + + val quadratic_to + : (Path.Point.t * Gg.v2 * Gg.v2 * Path.Point.t) -> repr -> repr + + val stop + : repr -> repr + + val get + : repr -> Repr.t + +end + diff --git a/layer/linePrinter.mli b/layer/linePrinter.mli new file mode 100755 index 0000000..b6e9603 --- /dev/null +++ b/layer/linePrinter.mli @@ -0,0 +1,29 @@ +module Make(Repr:Repr.PRINTER): sig + + type repr + + type t = Path.Point.t + + val create_path + : 'b -> repr + + (* Start a new path. *) + val start + : Path.Point.t -> repr -> repr + + val line_to + : Path.Point.t -> Path.Point.t -> repr -> repr + + val quadratic_to + : (Path.Point.t * Gg.v2 * Gg.v2 * Path.Point.t) -> repr -> repr + + val stop + : repr -> repr + + val get + : repr -> Repr.t + +end + + + diff --git a/layer/paths.ml b/layer/paths.ml index 927a5f9..e170767 100755 --- a/layer/paths.ml +++ b/layer/paths.ml @@ -1,3 +1,4 @@ +open StdLabels (** Common module for ensuring that the function is evaluated only once *) module type REPRESENTABLE = sig @@ -13,7 +14,6 @@ end module FillCanvaRepr = FillPrinter.Make(CanvaPrinter) module DuctusCanvaRepr = DuctusPrinter.Make(CanvaPrinter) module LineCanvaRepr = LinePrinter.Make(CanvaPrinter) -module WireCanvaRepr = WireFramePrinter.Make(CanvaPrinter) (* SVG representation *) @@ -21,7 +21,6 @@ module FillSVGRepr = FillPrinter.Make(Svg) module DuctusSVGRepr = DuctusPrinter.Make(Svg) module WireSVGRepr = WireFramePrinter.Make(Svg) - type printer = [ `Fill | `Line @@ -96,3 +95,50 @@ let to_svg [] | `Line -> raise Not_found + +(** Transform the two fixed path, into a single one. *) +module ReprFixed = struct + + type t = Path.Fixed.t * Path.Fixed.t + + module R = struct + type t = Path.Point.t + + type repr' = + | Move of (Path.Point.t) + | Line_to of (Path.Point.t * Path.Point.t) + | Quadratic of (t * Gg.v2 * Gg.v2 * t) + + type repr = repr' list + + let start t actions = + (Move t)::actions + + let line_to p0 p1 actions = + Line_to (p0, p1)::actions + + let quadratic_to + : (t * Gg.v2 * Gg.v2 * t) -> repr -> repr + = fun q actions -> + (Quadratic q)::actions + + let stop + : repr -> repr + = fun v -> List.rev v + + end + + let repr + : t -> (module Path.Repr.M with type t = Path.Point.t and type repr = 's) -> 's -> 's + = fun (type s) (path, _) (module Repr:Path.Repr.M with type t = Path.Point.t and type repr = s) state -> + let elems = Path.Fixed.repr path (module R) [] in + + let state = List.fold_left elems + ~init:state + ~f:(fun state -> function + | R.Move pt -> Repr.start pt state + | R.Line_to (p0, p1) -> Repr.line_to p0 p1 state + | R.Quadratic t -> Repr.quadratic_to t state + ) + in Repr.stop state +end -- cgit v1.2.3