aboutsummaryrefslogtreecommitdiff
path: root/script.it/layer/ductusEngine.ml
diff options
context:
space:
mode:
Diffstat (limited to 'script.it/layer/ductusEngine.ml')
-rwxr-xr-xscript.it/layer/ductusEngine.ml82
1 files changed, 82 insertions, 0 deletions
diff --git a/script.it/layer/ductusEngine.ml b/script.it/layer/ductusEngine.ml
new file mode 100755
index 0000000..b943467
--- /dev/null
+++ b/script.it/layer/ductusEngine.ml
@@ -0,0 +1,82 @@
+module Make(Layer: Repr.PRINTER) = struct
+
+ type point = Path.Point.t
+
+ type t =
+ { path: (Layer.t)
+ }
+
+ type repr = Layer.t
+
+ let create_path
+ : 'b -> t
+ = fun _ ->
+ { path = Layer.create ()
+ }
+
+ let start
+ : point -> point -> t -> t
+ = fun p1 p2 { path } ->
+ let path =
+ 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 = Layer.move_to (Path.Point.get_coord p1) path in
+ let path = Layer.line_to (Path.Point.get_coord p1') path in
+ { path
+ }
+
+ 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') {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
+ recent point *)
+ let delay =
+ ((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
+ and bezier', _ = Shapes.Bezier.slice ratio bezier' 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 := Layer.move_to (Path.Point.get_coord point) !path;
+ path := Layer.line_to (Path.Point.get_coord point') !path;
+ done;
+
+ { path = !path }
+
+ let stop
+ : t -> t
+ = fun path -> path
+
+
+ let get
+ : t -> Layer.t
+ = fun {path; _} ->
+ path
+end