aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rwxr-xr-xlayer/ductusPrinter.ml4
-rwxr-xr-xlayer/fillPrinter.ml4
-rwxr-xr-xlayer/linePrinter.ml4
-rwxr-xr-xpath/builder.ml35
-rwxr-xr-xpath/fixed.ml24
-rwxr-xr-xpath/repr.ml2
-rwxr-xr-xscript.it/dune2
-rwxr-xr-xscript.it/script.ml21
-rwxr-xr-xscript.it/state.ml14
-rwxr-xr-xscript.it/worker.ml13
-rwxr-xr-xscript.it/worker_messages/dune6
-rwxr-xr-xscript.it/worker_messages/worker_messages.ml11
12 files changed, 72 insertions, 68 deletions
diff --git a/layer/ductusPrinter.ml b/layer/ductusPrinter.ml
index 8383a9c..8f796b4 100755
--- a/layer/ductusPrinter.ml
+++ b/layer/ductusPrinter.ml
@@ -30,8 +30,8 @@ module Make(Repr: Repr.PRINTER) = struct
}
let quadratic_to
- : Path.Point.t -> Gg.v2 -> Gg.v2 -> Path.Point.t -> repr -> repr
- = fun p0 ctrl0 ctrl1 p1 { path } ->
+ : (t * Gg.v2 * Gg.v2 * t) -> repr -> repr
+ = fun (p0, ctrl0, ctrl1, p1) { path } ->
let path = ref path in
diff --git a/layer/fillPrinter.ml b/layer/fillPrinter.ml
index 3093ada..19f0ac4 100755
--- a/layer/fillPrinter.ml
+++ b/layer/fillPrinter.ml
@@ -79,8 +79,8 @@ module Make(Repr: Repr.PRINTER) = struct
{ t with path}
let quadratic_to
- : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> repr -> repr
- = fun p0 ctrl0 ctrl1 p1 t ->
+ : (t * Gg.v2 * Gg.v2 * t) -> repr -> repr
+ = fun (p0, ctrl0, ctrl1, p1) t ->
let ctrl0' = Point.copy p1 ctrl0
and ctrl1' = Point.copy p1 ctrl1 in
diff --git a/layer/linePrinter.ml b/layer/linePrinter.ml
index 38dae5c..45ee801 100755
--- a/layer/linePrinter.ml
+++ b/layer/linePrinter.ml
@@ -45,8 +45,8 @@ module Make(Repr: Repr.PRINTER) = struct
}
let quadratic_to
- : Path.Point.t -> Gg.v2 -> Gg.v2 -> Path.Point.t -> repr -> repr
- = fun p0 ctrl0 ctrl1 p1 { path } ->
+ : (t * Gg.v2 * Gg.v2 * t) -> repr -> repr
+ = 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)
diff --git a/path/builder.ml b/path/builder.ml
index fd772ea..7901e78 100755
--- a/path/builder.ml
+++ b/path/builder.ml
@@ -133,15 +133,15 @@ module Make(Point:P) = struct
Repr.start p0 path
|> Repr.quadratic_to
- p0'
- b0.Shapes.Bezier.ctrl0
- b0.Shapes.Bezier.ctrl1
- p1'
+ ( p0'
+ , b0.Shapes.Bezier.ctrl0
+ , b0.Shapes.Bezier.ctrl1
+ , p1' )
|> Repr.quadratic_to
- p1'
- b1.Shapes.Bezier.ctrl0
- b1.Shapes.Bezier.ctrl1
- p2'
+ ( p1'
+ , b1.Shapes.Bezier.ctrl0
+ , b1.Shapes.Bezier.ctrl1
+ , p2' )
| (p0::_ as points) ->
let (let*) v f =
@@ -179,10 +179,10 @@ module Make(Point:P) = struct
let bezier = Array.get beziers (i - 1) in
path := Repr.quadratic_to
- !point
- bezier.Shapes.Bezier.ctrl0
- bezier.Shapes.Bezier.ctrl1
- pt
+ ( !point
+ , bezier.Shapes.Bezier.ctrl0
+ , bezier.Shapes.Bezier.ctrl1
+ , pt )
(!path);
point := pt;
)
@@ -195,11 +195,12 @@ module Make(Point:P) = struct
Repr.stop @@ List.fold_left beziers
~init:path
~f:(fun path bezier ->
- let p0' = bezier.p0
- and ctrl0 = bezier.ctrl0
- and ctrl1 = bezier.ctrl1
- and p1' = bezier.p1 in
- Repr.quadratic_to p0' ctrl0 ctrl1 p1' path
+ Repr.quadratic_to
+ ( bezier.p0
+ , bezier.ctrl0
+ , bezier.ctrl1
+ , bezier.p1 )
+ path
)
end
diff --git a/path/fixed.ml b/path/fixed.ml
index 812dd3b..d9abcb5 100755
--- a/path/fixed.ml
+++ b/path/fixed.ml
@@ -14,6 +14,12 @@ end
module Make(Point:P) = struct
+ type bezier =
+ { p0:Point.t (* The starting point *)
+ ; p1:Point.t (* The end point *)
+ ; ctrl0:Gg.v2 (* The control point *)
+ ; ctrl1:Gg.v2 } (* The control point *)
+
module type BUILDER = sig
type t
@@ -21,12 +27,6 @@ module Make(Point:P) = struct
: t -> (module Repr.M with type t = Point.t and type repr = 's) -> 's -> 's
end
- type bezier =
- { p0:Point.t (* The starting point *)
- ; p1:Point.t (* The end point *)
- ; ctrl0:Gg.v2 (* The control point *)
- ; ctrl1:Gg.v2 } (* The control point *)
-
type path =
| Line of Point.t * Point.t
| Curve of bezier
@@ -58,8 +58,8 @@ module Make(Point:P) = struct
, Line (p1, p2)::t)
let quadratic_to
- : t -> Gg.v2 -> Gg.v2 -> t -> repr -> repr
- = fun p0 ctrl0 ctrl1 p1 (i, t) ->
+ : (t * Gg.v2 * Gg.v2 * t) -> repr -> repr
+ = fun (p0, ctrl0, ctrl1, p1) (i, t) ->
let curve = Curve
{ p0
; ctrl0
@@ -99,10 +99,10 @@ module Make(Point:P) = struct
= fun (type s) {path; _} (module Repr : Repr.M with type t = Point.t and type repr = s) repr ->
let repr_bezier p bezier =
Repr.quadratic_to
- bezier.p0
- bezier.ctrl0
- bezier.ctrl1
- bezier.p1
+ ( bezier.p0
+ , bezier.ctrl0
+ , bezier.ctrl1
+ , bezier.p1 )
p in
let _, repr = Array.fold_left path
diff --git a/path/repr.ml b/path/repr.ml
index 63e7ba0..55a2920 100755
--- a/path/repr.ml
+++ b/path/repr.ml
@@ -11,7 +11,7 @@ module type M = sig
: t -> t -> repr -> repr
val quadratic_to
- : t -> Gg.v2 -> Gg.v2 -> t -> repr -> repr
+ : (t * Gg.v2 * Gg.v2 * t) -> repr -> repr
val stop
: repr -> repr
diff --git a/script.it/dune b/script.it/dune
index 84b91f6..c51c43b 100755
--- a/script.it/dune
+++ b/script.it/dune
@@ -7,6 +7,7 @@
elements
blog
layer
+ worker_messages
)
(modes js)
(modules script state selection)
@@ -27,6 +28,7 @@
js_of_ocaml
shapes
path
+ worker_messages
)
(modes js)
(preprocess (pps ppx_hash js_of_ocaml-ppx))
diff --git a/script.it/script.ml b/script.it/script.ml
index ca831ba..3133269 100755
--- a/script.it/script.ml
+++ b/script.it/script.ml
@@ -4,14 +4,6 @@ open Brr
open Brr_note
-module Mouse = Brr_note_kit.Mouse
-
-let get_height el =
- match El.at (Jstr.v "height") el with
- | None -> 0
- | Some att ->
- Option.value ~default:0 (Jstr.to_int att)
-
(** Create the element in the page, and the event handler *)
let canva
: Brr.El.t -> [> State.canva_events] Note.E.t * (float * float) option Note.S.t * Brr_canvas.Canvas.t
@@ -60,14 +52,14 @@ let canva
Brr_note_kit.Mouse.left_up mouse
|> E.map (fun c -> `Out c) in
- let position = Mouse.pos mouse in
+ let position = Brr_note_kit.Mouse.pos mouse in
let pos = S.l2 (fun b pos ->
if b then
Some pos
else
None
- ) (Mouse.left mouse) position in
+ ) (Brr_note_kit.Mouse.left mouse) position in
E.select [click; up], pos, c
@@ -293,15 +285,6 @@ let on_change canva mouse_position timer state =
~w:10.
~h:10.
context;
-
-(*
- Cd2d.stroke_text
- context
- (Jstr.of_float @@ Path.Point.get_stamp point)
- ~x:(x +. 15.)
- ~y;
-*)
-
| _ -> ()
in
diff --git a/script.it/state.ml b/script.it/state.ml
index da97b13..cc199d1 100755
--- a/script.it/state.ml
+++ b/script.it/state.ml
@@ -1,8 +1,6 @@
open StdLabels
open Brr
-let backgroundColor = Blog.Nord.nord0
-
type mode =
| Edit
| Selection of Selection.t
@@ -51,6 +49,10 @@ type state =
; rendering : Layer.Paths.printer
}
+let post
+ : Brr_webworkers.Worker.t -> Worker_messages.to_worker -> unit
+ = Brr_webworkers.Worker.post
+
let insert_or_replace state ((x, y) as p) stamp path =
let width = state.width
and angle = state.angle in
@@ -140,7 +142,7 @@ let delete state worker =
| false -> ()
| true ->
(* Send the job to the worker *)
- Brr_webworkers.Worker.post worker (`DeletePoint (point, p))
+ post worker (`DeletePoint (point, p))
);
{ state with mode = Selection (Path id) }
| _ ->
@@ -266,7 +268,7 @@ let do_action
current
in
- let () = Brr_webworkers.Worker.post worker (`Complete last) in
+ let () = post worker (`Complete last) in
last::state.paths
and current = Path.Path_Builder.empty in
@@ -302,7 +304,7 @@ let do_action
| false -> ()
| true ->
Option.iter
- (fun p -> Brr_webworkers.Worker.post worker (`Complete p))
+ (fun p -> post worker (`Complete p))
(Path.Fixed.replace_point path point')
);
@@ -322,7 +324,7 @@ let do_action
~f:(fun path ->
Layer.Paths.to_svg
- ~color:backgroundColor
+ ~color:Blog.Nord.nord0
(module Path.Fixed)
path
state.rendering
diff --git a/script.it/worker.ml b/script.it/worker.ml
index 4ea9220..00e4595 100755
--- a/script.it/worker.ml
+++ b/script.it/worker.ml
@@ -1,11 +1,10 @@
open Js_of_ocaml
-type message = [
- | `Complete of Path.Fixed.t
- | `DeletePoint of (Path.Point.t * Path.Fixed.t)
-]
+let post_message
+ : Worker_messages.from_worker -> unit
+ = Worker.post_message
-let execute (command: [> message]) =
+let execute (command: [> Worker_messages.to_worker]) =
match command with
| `Complete path ->
begin match Path.Fixed.rebuild path with
@@ -17,8 +16,8 @@ let execute (command: [> message]) =
| Some path -> Worker.post_message (`Complete path)
| None -> ()
end
- | any ->
- Worker.post_message (`Other any)
+ | _ ->
+ post_message (`Other (Js.string "Unknown message received"))
let () =
Worker.set_onmessage execute
diff --git a/script.it/worker_messages/dune b/script.it/worker_messages/dune
new file mode 100755
index 0000000..d1511a6
--- /dev/null
+++ b/script.it/worker_messages/dune
@@ -0,0 +1,6 @@
+(library
+ (name worker_messages)
+ (libraries
+ js_of_ocaml
+ path)
+ )
diff --git a/script.it/worker_messages/worker_messages.ml b/script.it/worker_messages/worker_messages.ml
new file mode 100755
index 0000000..992ec29
--- /dev/null
+++ b/script.it/worker_messages/worker_messages.ml
@@ -0,0 +1,11 @@
+open Js_of_ocaml
+
+type to_worker = [
+ | `Complete of Path.Fixed.t
+ | `DeletePoint of (Path.Point.t * Path.Fixed.t)
+]
+
+type from_worker = [
+ | `Complete of Path.Fixed.t
+ | `Other of Js.js_string Js.t
+]
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-23 01:18:26 +0000