aboutsummaryrefslogtreecommitdiff
path: root/path/builder.ml
diff options
context:
space:
mode:
Diffstat (limited to 'path/builder.ml')
-rwxr-xr-xpath/builder.ml106
1 files changed, 104 insertions, 2 deletions
diff --git a/path/builder.ml b/path/builder.ml
index 2774cae..01dda87 100755
--- a/path/builder.ml
+++ b/path/builder.ml
@@ -25,7 +25,7 @@ module type REPR = sig
: t -> 'a repr -> 'a repr
val line_to
- : t -> 'a repr -> 'a repr
+ : t -> t -> 'a repr -> 'a repr
val quadratic_to
: t -> Gg.v2 -> Gg.v2 -> t -> 'a repr -> 'a repr
@@ -193,7 +193,7 @@ module Make(Point:P) = struct
| p1::p2::[] ->
let path =
Repr.start p1 path
- |> Repr.line_to p2 in
+ |> Repr.line_to p1 p2 in
( path )
| p0::p1::p2::[] ->
let path = Repr.start p0 path in
@@ -274,4 +274,106 @@ module Make(Point:P) = struct
Repr.quadratic_to p0' ctrl0 ctrl1 p1' path
)
end
+
+ type path =
+ | Empty
+ | Line of Point.t * Point.t
+ | Curve of bezier
+
+ type fixedPath =
+ { id: int
+ ; path : path array }
+
+ module ToFixed = struct
+ type t = Point.t
+
+ type 'a repr = int * path list
+
+ let create_path () = 0, []
+
+ (* Start a new path. *)
+ let start point t =
+ let _ = point in
+ t
+
+ let line_to
+ : t -> t -> 'a repr -> 'a repr
+ = fun p1 p2 (i, t) ->
+ ( i + 1
+ , Line (p1, p2)::t)
+
+
+ let quadratic_to
+ : t -> Gg.v2 -> Gg.v2 -> t -> 'a repr -> 'a repr
+ = fun p0 ctrl0 ctrl1 p1 (i, t) ->
+ let curve = Curve
+ { p0
+ ; ctrl0
+ ; ctrl1
+ ; p1} in
+ ( i + 1
+ , curve::t)
+
+
+ let stop t = t
+
+ let get
+ : int * path list -> path array
+ = fun (n, t) ->
+ let res = Array.make n Empty in
+ List.iteri t
+ ~f:(fun i elem -> Array.set res (n - i - 1) elem );
+ res
+ end
+
+ let id = ref 0
+ module FixedBuilder = Draw(ToFixed)
+ let to_fixed
+ : t -> fixedPath
+ = fun t ->
+ incr id;
+ { id = !id
+ ; path = FixedBuilder.draw t
+ |> ToFixed.get
+ }
+
+ module DrawFixed(Repr:REPR with type t = Point.t) = struct
+
+
+ let repr_bezier p bezier =
+ Repr.quadratic_to
+ bezier.p0
+ bezier.ctrl0
+ bezier.ctrl1
+ bezier.p1
+ p
+
+ let draw
+ : fixedPath -> 'a Repr.repr
+ = fun {path; _} ->
+
+ let repr = Repr.create_path () in
+ let _, repr = Array.fold_left path
+ ~init:(true, repr)
+ ~f:(fun (first, path) element ->
+ match element with
+ | Empty -> (true, path)
+ | Line (p0, p1) ->
+
+ let path = if first then
+ Repr.start p0 path
+ else path in
+
+ ( false
+ , Repr.line_to p0 p1 path )
+ | Curve bezier ->
+ let path = if first then
+ Repr.start bezier.p0 path
+ else path in
+ ( false
+ , repr_bezier path bezier )
+ ) in
+ Repr.stop repr
+ end
+
end