diff options
| -rwxr-xr-x | layer/ductusPrinter.ml | 52 | ||||
| -rwxr-xr-x | layer/ductusPrinter.mli | 30 | ||||
| -rwxr-xr-x | layer/fillPrinter.ml | 70 | ||||
| -rwxr-xr-x | layer/fillPrinter.mli | 29 | ||||
| -rwxr-xr-x | layer/linePrinter.ml | 28 | ||||
| -rwxr-xr-x | layer/linePrinter.mli | 31 | ||||
| -rwxr-xr-x | layer/paths.ml | 104 | ||||
| -rwxr-xr-x | layer/repr.ml | 32 | ||||
| -rwxr-xr-x | path/builder.ml | 4 | ||||
| -rwxr-xr-x | path/builder.mli | 2 | ||||
| -rwxr-xr-x | path/fixed.ml | 14 | ||||
| -rwxr-xr-x | path/fixed.mli | 4 | ||||
| -rwxr-xr-x | path/repr.ml | 13 |
13 files changed, 211 insertions, 202 deletions
diff --git a/layer/ductusPrinter.ml b/layer/ductusPrinter.ml index 8f796b4..db34481 100755 --- a/layer/ductusPrinter.ml +++ b/layer/ductusPrinter.ml @@ -1,45 +1,52 @@ module Make(Repr: Repr.PRINTER) = struct - type t = Path.Point.t + type point = Path.Point.t - type repr = + type t = { path: (Repr.t) } + type repr = Repr.t + let create_path - : 'b -> repr + : 'b -> t = 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 + : 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 { 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 + : (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 { path } let quadratic_to - : (t * Gg.v2 * Gg.v2 * t) -> repr -> repr - = fun (p0, ctrl0, ctrl1, p1) { path } -> - - let path = ref path in + : (point * Gg.v2 * Gg.v2 * point) -> (point * Gg.v2 * Gg.v2 * point) -> t -> t + = fun (p0, ctrl0, ctrl1, p1) (p0', ctrl0', ctrl1', p1') {path} -> let bezier = { Shapes.Bezier.p0 = Path.Point.get_coord p0 ; ctrl0 ; ctrl1 ; p1 = Path.Point.get_coord p1 + } + + and bezier' = + { Shapes.Bezier.p0 = Path.Point.get_coord p0' + ; ctrl0 = ctrl0' + ; ctrl1 = ctrl1' + ; p1 = Path.Point.get_coord p1' } in (* Mark each point on the bezier curve. The first point is the most @@ -48,25 +55,28 @@ module Make(Repr: Repr.PRINTER) = struct ((Path.Point.get_stamp p0) -. (Path.Point.get_stamp p1)) *. 30. in + let path = ref path in for i = 0 to ((Int.of_float delay) ) do let ratio = (Float.of_int i) /. delay in - let bezier', _ = Shapes.Bezier.slice ratio bezier in + let bezier, _ = Shapes.Bezier.slice ratio bezier + and bezier', _ = Shapes.Bezier.slice ratio bezier' in - let point = Path.Point.mix ratio bezier'.Shapes.Bezier.p1 p0 p1 in + 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 := Repr.line_to (Path.Point.get_coord point') !path; done; { path = !path } let stop - : repr -> repr + : t -> t = fun path -> path let get - : repr -> Repr.t + : t -> Repr.t = fun {path; _} -> path end diff --git a/layer/ductusPrinter.mli b/layer/ductusPrinter.mli index cd849ef..cdcaa7c 100755 --- a/layer/ductusPrinter.mli +++ b/layer/ductusPrinter.mli @@ -1,28 +1,2 @@ -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 - - +module Make(R:Repr.PRINTER): + Repr.LAYER with type repr = R.t diff --git a/layer/fillPrinter.ml b/layer/fillPrinter.ml index 9b6546c..f3717c2 100755 --- a/layer/fillPrinter.ml +++ b/layer/fillPrinter.ml @@ -1,16 +1,16 @@ -module Point = Path.Point - module Make(Repr: Repr.PRINTER) = struct - type t = Point.t + type point = Path.Point.t + + type repr = Repr.t - type repr = + type t = { path: Repr.t ; close : Repr.t -> Repr.t } let create_path - : (Repr.t -> Repr.t) -> repr + : (Repr.t -> Repr.t) -> t = fun f -> { close = f ; path = Repr.create () @@ -18,23 +18,23 @@ module Make(Repr: Repr.PRINTER) = struct (* Start a new path. *) - let start' - : Gg.v2 -> Gg.v2 -> repr -> repr + let start + : point -> point -> t -> t = fun p1 _ {close ; path } -> - let path = Repr.move_to p1 path in + let path = Repr.move_to (Path.Point.get_coord p1) path in { close ; path } - 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 + let line_to + : (point * point) -> (point * point) -> t -> t = fun (p0, p1) (p0', p1') t -> + + let p0 = Path.Point.get_coord p0 + and p1 = Path.Point.get_coord p1 + and p0' = Path.Point.get_coord p0' + and p1' = Path.Point.get_coord p1' in + let path = Repr.move_to p1 t.path |> Repr.line_to p1' @@ -45,21 +45,15 @@ module Make(Repr: Repr.PRINTER) = struct let path = t.close path in { t with path} - let line_to - : Point.t -> Point.t -> repr -> repr - = fun p0 p1 t -> - - line_to' - ( Point.get_coord p0 - , Point.get_coord p1 ) - ( Point.get_coord' p0 - , Point.get_coord' p1 ) - t - - 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 -> + let quadratic_to + : (point * Gg.v2 * Gg.v2 * point) -> (point * Gg.v2 * Gg.v2 * point) -> t -> t + = fun (p0, ctrl0, ctrl1, p1) (p0', ctrl0', ctrl1', p1') t -> + let p0 = Path.Point.get_coord p0 + and p1 = Path.Point.get_coord p1 + and p0' = Path.Point.get_coord p0' + and p1' = Path.Point.get_coord p1' + in let path = Repr.move_to p1 t.path @@ -83,25 +77,13 @@ module Make(Repr: Repr.PRINTER) = struct { t with path } - let quadratic_to - : (t * Gg.v2 * Gg.v2 * t) -> repr -> repr - = fun (p0, ctrl0, ctrl1, p1) t -> - - - 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 + : t -> t = fun t -> t let get - : repr -> Repr.t + : t -> Repr.t = fun t -> t.path end diff --git a/layer/fillPrinter.mli b/layer/fillPrinter.mli index c1bb30e..cdcaa7c 100755 --- a/layer/fillPrinter.mli +++ b/layer/fillPrinter.mli @@ -1,27 +1,2 @@ -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 - +module Make(R:Repr.PRINTER): + Repr.LAYER with type repr = R.t diff --git a/layer/linePrinter.ml b/layer/linePrinter.ml index 45ee801..d223760 100755 --- a/layer/linePrinter.ml +++ b/layer/linePrinter.ml @@ -1,6 +1,6 @@ module Make(Repr: Repr.PRINTER) = struct - type t = Path.Point.t + type point = Path.Point.t let mark point path = let open Gg.V2 in @@ -17,27 +17,28 @@ module Make(Repr: Repr.PRINTER) = struct path - type repr = + type t = { path: (Repr.t) } + type repr = Repr.t + let create_path - : 'b -> repr + : 'b -> t = fun _ -> { path = Repr.create () } - (* Start a new path. *) let start - : Path.Point.t -> repr -> repr - = fun t {path} -> - let path = mark t path in + : point -> point -> t -> t + = fun p1 _ { path } -> + let path = mark p1 path in { path } let line_to - : Path.Point.t -> Path.Point.t -> repr -> repr - = fun p0 p1 {path} -> + : (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) |> mark p1 in @@ -45,8 +46,8 @@ module Make(Repr: Repr.PRINTER) = struct } let quadratic_to - : (t * Gg.v2 * Gg.v2 * t) -> repr -> repr - = fun (p0, ctrl0, ctrl1, p1) { path } -> + : (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) @@ -55,12 +56,13 @@ module Make(Repr: Repr.PRINTER) = struct { path = path } let stop - : repr -> repr + : t -> t = fun path -> path let get - : repr -> Repr.t + : t -> Repr.t = fun {path; _} -> path + end diff --git a/layer/linePrinter.mli b/layer/linePrinter.mli index b6e9603..191830a 100755 --- a/layer/linePrinter.mli +++ b/layer/linePrinter.mli @@ -1,29 +1,2 @@ -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 - - - +module Make(R:Repr.PRINTER): + Repr.LAYER with type repr = R.t diff --git a/layer/paths.ml b/layer/paths.ml index e170767..6d0157e 100755 --- a/layer/paths.ml +++ b/layer/paths.ml @@ -6,25 +6,87 @@ module type REPRESENTABLE = sig (** Represent the path *) val repr - : t -> (module Path.Repr.M with type t = Path.Point.t and type repr = 's) -> 's -> 's + : t -> (module Path.Repr.M with type point = Path.Point.t and type t = 's) -> 's -> 's +end + +type printer = + [ `Fill + | `Line + | `Ductus ] + + +module type P = sig + include Path.Repr.M + + type repr + + val create_path + : (repr -> repr) -> t + + val get + : t -> repr +end + + +module MakePrinter(M:Repr.LAYER) : P with type point = M.point and type t = M.t and type repr = M.repr = struct + + type t = M.t + + type point = M.point + + type repr = M.repr + + let get + : t -> repr + = M.get + + let create_path + : (repr -> repr) -> t + = M.create_path + + let start + : Path.Point.t -> t -> t + = fun pt t -> + M.start pt pt t + + let line_to + : Path.Point.t -> Path.Point.t -> t -> t + = fun p0 p1 t -> + + M.line_to + ( p0 + , p1 ) + ( Path.Point.copy p0 @@ Path.Point.get_coord' p0 + , Path.Point.copy p1 @@ Path.Point.get_coord' p1 ) + t + + let quadratic_to + : (Path.Point.t * Gg.v2 * Gg.v2 * Path.Point.t) -> t -> t + = fun (p0, ctrl0, ctrl1, p1) t -> + + + let ctrl0' = Path.Point.get_coord' @@ Path.Point.copy p0 ctrl0 + and ctrl1' = Path.Point.get_coord' @@ Path.Point.copy p1 ctrl1 in + M.quadratic_to + (p0, ctrl0, ctrl1, p1) + (Path.Point.copy p0 @@ Path.Point.get_coord' p0, ctrl0', ctrl1', Path.Point.copy p1 @@ Path.Point.get_coord' p1) + + t + + let stop = M.stop end (* Canva representation *) -module FillCanvaRepr = FillPrinter.Make(CanvaPrinter) -module DuctusCanvaRepr = DuctusPrinter.Make(CanvaPrinter) -module LineCanvaRepr = LinePrinter.Make(CanvaPrinter) +module FillCanvaRepr = MakePrinter(FillPrinter.Make(CanvaPrinter)) +module DuctusCanvaRepr = MakePrinter(DuctusPrinter.Make(CanvaPrinter)) +module LineCanvaRepr = MakePrinter(LinePrinter.Make(CanvaPrinter)) (* SVG representation *) -module FillSVGRepr = FillPrinter.Make(Svg) -module DuctusSVGRepr = DuctusPrinter.Make(Svg) -module WireSVGRepr = WireFramePrinter.Make(Svg) +module FillSVGRepr = MakePrinter(FillPrinter.Make(Svg)) +module DuctusSVGRepr = MakePrinter(DuctusPrinter.Make(Svg)) -type printer = - [ `Fill - | `Line - | `Ductus ] (** Draw a path to a canva *) let to_canva @@ -85,7 +147,7 @@ let to_svg let svg_path = R.repr path (module DuctusSVGRepr) - (DuctusSVGRepr.create_path (fun _ -> ())) + (DuctusSVGRepr.create_path (fun _ -> Jstr.empty)) |> DuctusSVGRepr.get in Svg.path ~at:Brr.At.[ @@ -102,14 +164,14 @@ module ReprFixed = struct type t = Path.Fixed.t * Path.Fixed.t module R = struct - type t = Path.Point.t + type point = 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) + | Move of (point) + | Line_to of (point * point) + | Quadratic of (point * Gg.v2 * Gg.v2 * point) - type repr = repr' list + type t = repr' list let start t actions = (Move t)::actions @@ -118,19 +180,19 @@ module ReprFixed = struct Line_to (p0, p1)::actions let quadratic_to - : (t * Gg.v2 * Gg.v2 * t) -> repr -> repr + : (point * Gg.v2 * Gg.v2 * point) -> t -> t = fun q actions -> (Quadratic q)::actions let stop - : repr -> repr + : t -> t = 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 -> + : 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 diff --git a/layer/repr.ml b/layer/repr.ml index f2d114c..85b0f3b 100755 --- a/layer/repr.ml +++ b/layer/repr.ml @@ -9,7 +9,7 @@ module type PRINTER = sig val line_to: Gg.v2 -> t -> t - (** [quadratic_to ctrl0 ctrl1 p1] ctreate a quadratic curve from the current + (** [quadratic_to ctrl0 ctrl1 p1] create a quadratic curve from the current point to [p1], with control points [ctrl0] and [ctrl1] *) val quadratic_to: Gg.v2 -> Gg.v2 -> Gg.v2 -> t -> t @@ -17,3 +17,33 @@ module type PRINTER = sig val close: t -> t end + +module type LAYER = sig + type t + + type point = Path.Point.t + + type repr + + val get + : t -> repr + + val create_path + : (repr -> repr) -> t + + val start + : point -> point -> t -> t + + val line_to + : (point * point) -> (point * point) -> t -> t + + val quadratic_to + : (point * Gg.v2 * Gg.v2 * point) + -> (point * Gg.v2 * Gg.v2 * point) + -> t + -> t + + val stop + : t -> t + +end diff --git a/path/builder.ml b/path/builder.ml index 7901e78..166c073 100755 --- a/path/builder.ml +++ b/path/builder.ml @@ -104,8 +104,8 @@ module Make(Point:P) = struct | hd::_ -> Some hd let repr - : t -> (module Repr.M with type t = Point.t and type repr = 's) -> 's -> 's - = fun (type s) (points, beziers) (module Repr : Repr.M with type t = Point.t and type repr = s) path -> + : t -> (module Repr.M with type point = Point.t and type t = 's) -> 's -> 's + = fun (type s) (points, beziers) (module Repr : Repr.M with type point = Point.t and type t = s) path -> (* Represent the last points *) let path = match points with diff --git a/path/builder.mli b/path/builder.mli index 78bb778..ff66bcb 100755 --- a/path/builder.mli +++ b/path/builder.mli @@ -35,6 +35,6 @@ module Make(Point:P) : sig (** Represent the path *) val repr - : t -> (module Repr.M with type t = Point.t and type repr = 's) -> 's -> 's + : t -> (module Repr.M with type point = Point.t and type t = 's) -> 's -> 's end diff --git a/path/fixed.ml b/path/fixed.ml index 08b9c2b..2eda3c1 100755 --- a/path/fixed.ml +++ b/path/fixed.ml @@ -24,7 +24,7 @@ module Make(Point:P) = struct type t val repr - : t -> (module Repr.M with type t = Point.t and type repr = 's) -> 's -> 's + : t -> (module Repr.M with type point = Point.t and type t = 's) -> 's -> 's end type path = @@ -47,9 +47,9 @@ module Make(Point:P) = struct = fun {id; _} -> id module ToFixed = struct - type t = Point.t + type point = Point.t - type repr = int * step list + type t = int * step list let create_path () = 0, [] @@ -59,7 +59,7 @@ module Make(Point:P) = struct t let line_to - : t -> t -> repr -> repr + : point -> point -> t -> t = fun p1 p2 (i, t) -> ( i + 1 , { point = p1 @@ -67,7 +67,7 @@ module Make(Point:P) = struct }:: t ) let quadratic_to - : (t * Gg.v2 * Gg.v2 * t) -> repr -> repr + : (point * Gg.v2 * Gg.v2 * point) -> t -> t = fun (p0, ctrl0, ctrl1, p1) (i, t) -> let curve = Curve { ctrl0 @@ -105,8 +105,8 @@ module Make(Point:P) = struct } let repr - : t -> (module Repr.M with type t = Point.t and type repr = 's) -> 's -> 's - = fun (type s) {path; _} (module Repr : Repr.M with type t = Point.t and type repr = s) repr -> + : t -> (module Repr.M with type point = Point.t and type t = 's) -> 's -> 's + = fun (type s) {path; _} (module Repr : Repr.M with type point = Point.t and type t = s) repr -> let repr_bezier p p0 bezier = Repr.quadratic_to ( p0 diff --git a/path/fixed.mli b/path/fixed.mli index 2daadb4..862409b 100755 --- a/path/fixed.mli +++ b/path/fixed.mli @@ -16,7 +16,7 @@ module Make(Point:P) : sig type t val repr - : t -> (module Repr.M with type t = Point.t and type repr = 's) -> 's -> 's + : t -> (module Repr.M with type point = Point.t and type t = 's) -> 's -> 's end @@ -32,7 +32,7 @@ module Make(Point:P) : sig (** Represent the path *) val repr - : t -> (module Repr.M with type t = Point.t and type repr = 's) -> 's -> 's + : t -> (module Repr.M with type point = Point.t and type t = 's) -> 's -> 's (** Structure to represent all the required information for evaluating the distance between a point and a path *) diff --git a/path/repr.ml b/path/repr.ml index 55a2920..17fd914 100755 --- a/path/repr.ml +++ b/path/repr.ml @@ -1,18 +1,19 @@ module type M = sig - type t - type repr + type point + + type t (* Start a new path. *) val start - : t -> repr -> repr + : point -> t -> t val line_to - : t -> t -> repr -> repr + : point -> point -> t -> t val quadratic_to - : (t * Gg.v2 * Gg.v2 * t) -> repr -> repr + : (point * Gg.v2 * Gg.v2 * point) -> t -> t val stop - : repr -> repr + : t -> t end |