diff options
author | Sébastien Dailly <sebastien@chimrod.com> | 2021-01-11 11:33:32 +0100 |
---|---|---|
committer | Sébastien Dailly <sebastien@chimrod.com> | 2021-01-11 13:55:43 +0100 |
commit | 42c3c122c4f53dd68bcdd89411835887c3ae0af9 (patch) | |
tree | 856a54955c4bf1648e7f5f1cea809e5601b60c7d /layer | |
parent | 979be5f588a1ffd6e1d060cd794e87526d517b7a (diff) |
Outline module
Diffstat (limited to 'layer')
-rwxr-xr-x | layer/ductusEngine.ml (renamed from layer/ductusPrinter.ml) | 22 | ||||
-rwxr-xr-x | layer/ductusEngine.mli | 2 | ||||
-rwxr-xr-x | layer/ductusPrinter.mli | 2 | ||||
-rwxr-xr-x | layer/fillEngine.ml (renamed from layer/fillPrinter.ml) | 40 | ||||
-rwxr-xr-x | layer/fillEngine.mli | 2 | ||||
-rwxr-xr-x | layer/fillPrinter.mli | 2 | ||||
-rwxr-xr-x | layer/lineEngine.ml (renamed from layer/linePrinter.ml) | 26 | ||||
-rwxr-xr-x | layer/lineEngine.mli | 2 | ||||
-rwxr-xr-x | layer/linePrinter.mli | 2 | ||||
-rwxr-xr-x | layer/paths.ml | 131 | ||||
-rwxr-xr-x | layer/repr.ml | 2 |
11 files changed, 124 insertions, 109 deletions
diff --git a/layer/ductusPrinter.ml b/layer/ductusEngine.ml index db34481..b943467 100755 --- a/layer/ductusPrinter.ml +++ b/layer/ductusEngine.ml @@ -1,33 +1,33 @@ -module Make(Repr: Repr.PRINTER) = struct +module Make(Layer: Repr.PRINTER) = struct type point = Path.Point.t type t = - { path: (Repr.t) + { path: (Layer.t) } - type repr = Repr.t + type repr = Layer.t let create_path : 'b -> t = fun _ -> - { path = Repr.create () + { path = Layer.create () } let start : point -> point -> t -> t = fun p1 p2 { path } -> let path = - Repr.move_to (Path.Point.get_coord p1) path - |> Repr.line_to (Path.Point.get_coord p2) in + Layer.move_to (Path.Point.get_coord p1) path + |> Layer.line_to (Path.Point.get_coord p2) in { path } let line_to : (point * point) -> (point * point) -> t -> t = fun (_, p1) (_, p1') {path} -> - let path = Repr.move_to (Path.Point.get_coord p1) path in - let path = Repr.line_to (Path.Point.get_coord p1') path in + let path = Layer.move_to (Path.Point.get_coord p1) path in + let path = Layer.line_to (Path.Point.get_coord p1') path in { path } @@ -64,8 +64,8 @@ module Make(Repr: Repr.PRINTER) = struct let point = Path.Point.mix ratio bezier.Shapes.Bezier.p1 p0 p1 and point' = Path.Point.mix ratio bezier'.Shapes.Bezier.p1 p0' p1' in - path := Repr.move_to (Path.Point.get_coord point) !path; - path := Repr.line_to (Path.Point.get_coord point') !path; + path := Layer.move_to (Path.Point.get_coord point) !path; + path := Layer.line_to (Path.Point.get_coord point') !path; done; { path = !path } @@ -76,7 +76,7 @@ module Make(Repr: Repr.PRINTER) = struct let get - : t -> Repr.t + : t -> Layer.t = fun {path; _} -> path end diff --git a/layer/ductusEngine.mli b/layer/ductusEngine.mli new file mode 100755 index 0000000..e1660f4 --- /dev/null +++ b/layer/ductusEngine.mli @@ -0,0 +1,2 @@ +module Make(R:Repr.PRINTER): + Repr.ENGINE with type repr = R.t diff --git a/layer/ductusPrinter.mli b/layer/ductusPrinter.mli deleted file mode 100755 index cdcaa7c..0000000 --- a/layer/ductusPrinter.mli +++ /dev/null @@ -1,2 +0,0 @@ -module Make(R:Repr.PRINTER): - Repr.LAYER with type repr = R.t diff --git a/layer/fillPrinter.ml b/layer/fillEngine.ml index f3717c2..9a3fe7e 100755 --- a/layer/fillPrinter.ml +++ b/layer/fillEngine.ml @@ -1,19 +1,19 @@ -module Make(Repr: Repr.PRINTER) = struct +module Make(Layer: Repr.PRINTER) = struct type point = Path.Point.t - type repr = Repr.t + type repr = Layer.t type t = - { path: Repr.t - ; close : Repr.t -> Repr.t + { path: Layer.t + ; close : Layer.t -> Layer.t } let create_path - : (Repr.t -> Repr.t) -> t + : (Layer.t -> Layer.t) -> t = fun f -> { close = f - ; path = Repr.create () + ; path = Layer.create () } (* Start a new path. *) @@ -21,7 +21,7 @@ module Make(Repr: Repr.PRINTER) = struct let start : point -> point -> t -> t = fun p1 _ {close ; path } -> - let path = Repr.move_to (Path.Point.get_coord p1) path in + let path = Layer.move_to (Path.Point.get_coord p1) path in { close ; path } @@ -36,12 +36,12 @@ module Make(Repr: Repr.PRINTER) = struct and p1' = Path.Point.get_coord p1' in let path = - 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 + Layer.move_to p1 t.path + |> Layer.line_to p1' + |> Layer.line_to p0' + |> Layer.line_to p0 + |> Layer.line_to p1 + |> Layer.close in let path = t.close path in { t with path} @@ -56,22 +56,22 @@ module Make(Repr: Repr.PRINTER) = struct in let path = - Repr.move_to p1 t.path - |> Repr.line_to p1' + Layer.move_to p1 t.path + |> Layer.line_to p1' (* Backward *) - |> Repr.quadratic_to + |> Layer.quadratic_to ctrl1' ctrl0' p0' - |> Repr.line_to p0 + |> Layer.line_to p0 (* Forward *) - |> Repr.quadratic_to + |> Layer.quadratic_to ctrl0 ctrl1 p1 - |> Repr.close + |> Layer.close |> t.close in @@ -83,7 +83,7 @@ module Make(Repr: Repr.PRINTER) = struct t let get - : t -> Repr.t + : t -> Layer.t = fun t -> t.path end diff --git a/layer/fillEngine.mli b/layer/fillEngine.mli new file mode 100755 index 0000000..e1660f4 --- /dev/null +++ b/layer/fillEngine.mli @@ -0,0 +1,2 @@ +module Make(R:Repr.PRINTER): + Repr.ENGINE with type repr = R.t diff --git a/layer/fillPrinter.mli b/layer/fillPrinter.mli deleted file mode 100755 index cdcaa7c..0000000 --- a/layer/fillPrinter.mli +++ /dev/null @@ -1,2 +0,0 @@ -module Make(R:Repr.PRINTER): - Repr.LAYER with type repr = R.t diff --git a/layer/linePrinter.ml b/layer/lineEngine.ml index d223760..3d15d9c 100755 --- a/layer/linePrinter.ml +++ b/layer/lineEngine.ml @@ -1,4 +1,4 @@ -module Make(Repr: Repr.PRINTER) = struct +module Make(Layer: Repr.PRINTER) = struct type point = Path.Point.t @@ -9,24 +9,24 @@ module Make(Repr: Repr.PRINTER) = struct 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'))) + let path = Layer.move_to (point - (of_tuple (dist, dist))) path + |> Layer.line_to ( point + (of_tuple (dist, dist))) + |> Layer.move_to (point + (of_tuple (dist', dist))) + |> Layer.line_to ( point + (of_tuple (dist, dist'))) in path type t = - { path: (Repr.t) + { path: (Layer.t) } - type repr = Repr.t + type repr = Layer.t let create_path : 'b -> t = fun _ -> - { path = Repr.create () + { path = Layer.create () } let start @@ -39,8 +39,8 @@ module Make(Repr: Repr.PRINTER) = struct let line_to : (point * point) -> (point * point) -> t -> t = fun (p0, p1) _ {path} -> - let path = Repr.move_to (Path.Point.get_coord p0) path - |> Repr.line_to (Path.Point.get_coord p1) + let path = Layer.move_to (Path.Point.get_coord p0) path + |> Layer.line_to (Path.Point.get_coord p1) |> mark p1 in { path } @@ -49,8 +49,8 @@ module Make(Repr: Repr.PRINTER) = struct : (point * Gg.v2 * Gg.v2 * point) -> (point * Gg.v2 * Gg.v2 * point) -> t -> t = fun (p0, ctrl0, ctrl1, p1) _ {path} -> - let path = Repr.move_to (Path.Point.get_coord p0) path - |> Repr.quadratic_to ctrl0 ctrl1 (Path.Point.get_coord p1) + let path = Layer.move_to (Path.Point.get_coord p0) path + |> Layer.quadratic_to ctrl0 ctrl1 (Path.Point.get_coord p1) |> mark p1 in { path = path } @@ -61,7 +61,7 @@ module Make(Repr: Repr.PRINTER) = struct let get - : t -> Repr.t + : t -> Layer.t = fun {path; _} -> path diff --git a/layer/lineEngine.mli b/layer/lineEngine.mli new file mode 100755 index 0000000..86ef5fb --- /dev/null +++ b/layer/lineEngine.mli @@ -0,0 +1,2 @@ +module Make(R:Repr.PRINTER): + Repr.ENGINE with type repr = R.t diff --git a/layer/linePrinter.mli b/layer/linePrinter.mli deleted file mode 100755 index 191830a..0000000 --- a/layer/linePrinter.mli +++ /dev/null @@ -1,2 +0,0 @@ -module Make(R:Repr.PRINTER): - Repr.LAYER with type repr = R.t 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 diff --git a/layer/repr.ml b/layer/repr.ml index 85b0f3b..552e2b7 100755 --- a/layer/repr.ml +++ b/layer/repr.ml @@ -18,7 +18,7 @@ module type PRINTER = sig end -module type LAYER = sig +module type ENGINE = sig type t type point = Path.Point.t |