From 42c3c122c4f53dd68bcdd89411835887c3ae0af9 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Mon, 11 Jan 2021 11:33:32 +0100 Subject: Outline module --- layer/paths.ml | 131 ++++++++++++++++++++++++++++++++------------------------- 1 file changed, 73 insertions(+), 58 deletions(-) (limited to 'layer/paths.ml') diff --git a/layer/paths.ml b/layer/paths.ml index 6d0157e..3a8bfe8 100755 --- a/layer/paths.ml +++ b/layer/paths.ml @@ -1,12 +1,16 @@ open StdLabels (** Common module for ensuring that the function is evaluated only once *) -module type REPRESENTABLE = sig +(** This represent a single path, which can be transformed throug a [repr] + function. *) +module type PATH = sig type t (** Represent the path *) val repr - : t -> (module Path.Repr.M with type point = Path.Point.t and type t = 's) -> 's -> 's + : t -> (module Path.Repr.M + with type point = Path.Point.t + and type t = 's) -> 's -> 's end type printer = @@ -28,7 +32,10 @@ module type P = sig end -module MakePrinter(M:Repr.LAYER) : P with type point = M.point and type t = M.t and type repr = M.repr = struct +module MakePrinter(M:Repr.ENGINE) : P + with type point = M.point + and type t = M.t + and type repr = M.repr = struct type t = M.t @@ -76,22 +83,76 @@ module MakePrinter(M:Repr.LAYER) : P with type point = M.point and type t = M.t let stop = M.stop end +(** Transform the two path, into a single one. *) +module ReprSingle(T:PATH) = struct + + type t = T.t * T.t + + module R = struct + type point = Path.Point.t + + type repr' = + | Move of (point) + | Line_to of (point * point) + | Quadratic of (point * Gg.v2 * Gg.v2 * point) + + type t = repr' list + + let start t actions = + (Move t)::actions + + let line_to p0 p1 actions = + Line_to (p0, p1)::actions + + let quadratic_to + : (point * Gg.v2 * Gg.v2 * point) -> t -> t + = fun q actions -> + (Quadratic q)::actions + + let stop + : t -> t + = fun v -> List.rev v + + end + + let repr + : t -> (module Path.Repr.M with type point = Path.Point.t and type t = 's) -> 's -> 's + = fun (type s) (path, _) (module Repr:Path.Repr.M with type point = Path.Point.t and type t = s) state -> + let elems = T.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 + +module ReprFixed = ReprSingle(Path.Fixed) +module ReprBuild = ReprSingle(Path.Path_Builder) + (* Canva representation *) -module FillCanvaRepr = MakePrinter(FillPrinter.Make(CanvaPrinter)) -module DuctusCanvaRepr = MakePrinter(DuctusPrinter.Make(CanvaPrinter)) -module LineCanvaRepr = MakePrinter(LinePrinter.Make(CanvaPrinter)) +module FillCanva = FillEngine.Make(CanvaPrinter) +module LineCanva = LineEngine.Make(CanvaPrinter) +module DuctusCanva = FillEngine.Make(CanvaPrinter) + +module FillCanvaRepr = MakePrinter(FillCanva) +module DuctusCanvaRepr = MakePrinter(DuctusCanva) +module LineCanvaRepr = MakePrinter(LineCanva) (* SVG representation *) -module FillSVGRepr = MakePrinter(FillPrinter.Make(Svg)) -module DuctusSVGRepr = MakePrinter(DuctusPrinter.Make(Svg)) +module FillSVGRepr = MakePrinter(FillEngine.Make(Svg)) +module DuctusSVGRepr = MakePrinter(DuctusEngine.Make(Svg)) (** Draw a path to a canva *) let to_canva - : (module REPRESENTABLE with type t = 's) -> 's -> Brr_canvas.C2d.t -> printer -> unit - = fun (type s) (module R:REPRESENTABLE with type t = s) path ctx -> function + : (module PATH with type t = 's) -> 's -> Brr_canvas.C2d.t -> printer -> unit + = fun (type s) (module R:PATH with type t = s) path ctx -> function | `Fill -> R.repr path @@ -117,8 +178,8 @@ let to_canva (** Draw a path and represent it as SVG *) let to_svg - : (module REPRESENTABLE with type t = 's) -> color:Jstr.t -> 's -> printer -> Brr.El.t - = fun (type s) (module R:REPRESENTABLE with type t = s) ~color path -> function + : (module PATH with type t = 's) -> color:Jstr.t -> 's -> printer -> Brr.El.t + = fun (type s) (module R:PATH with type t = s) ~color path -> function | `Fill -> (* In order to deal with over crossing path, I cut the path in as @@ -158,49 +219,3 @@ 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 point = Path.Point.t - - type repr' = - | Move of (point) - | Line_to of (point * point) - | Quadratic of (point * Gg.v2 * Gg.v2 * point) - - type t = repr' list - - let start t actions = - (Move t)::actions - - let line_to p0 p1 actions = - Line_to (p0, p1)::actions - - let quadratic_to - : (point * Gg.v2 * Gg.v2 * point) -> t -> t - = fun q actions -> - (Quadratic q)::actions - - let stop - : t -> t - = fun v -> List.rev v - - end - - let repr - : t -> (module Path.Repr.M with type point = Path.Point.t and type t = 's) -> 's -> 's - = fun (type s) (path, _) (module Repr:Path.Repr.M with type point = Path.Point.t and type t = 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