aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xscript.it/dune11
-rwxr-xr-xscript.it/outline/dune9
-rwxr-xr-xscript.it/outline/outline.ml (renamed from script.it/outline.ml)0
-rwxr-xr-xscript.it/script.ml97
-rwxr-xr-xscript.it/state/dune13
-rwxr-xr-xscript.it/state/selection.ml (renamed from script.it/selection.ml)0
-rwxr-xr-xscript.it/state/selection.mli (renamed from script.it/selection.mli)0
-rwxr-xr-xscript.it/state/state.ml (renamed from script.it/state.ml)90
8 files changed, 143 insertions, 77 deletions
diff --git a/script.it/dune b/script.it/dune
index ceae76c..dd1f7d2 100755
--- a/script.it/dune
+++ b/script.it/dune
@@ -1,16 +1,9 @@
-(library
- (name outline)
- (libraries
- path)
- (modules outline)
- (preprocess (pps ppx_hash js_of_ocaml-ppx))
- )
-
(executable
(name script)
(libraries
brr
brr.note
+ script_state
shapes
elements
blog
@@ -20,7 +13,7 @@
outline
)
(modes js)
- (modules script state selection)
+ (modules script)
(preprocess (pps ppx_hash js_of_ocaml-ppx))
(link_flags (:standard -no-check-prims))
)
diff --git a/script.it/outline/dune b/script.it/outline/dune
new file mode 100755
index 0000000..db080a3
--- /dev/null
+++ b/script.it/outline/dune
@@ -0,0 +1,9 @@
+(library
+ (name outline)
+ (libraries
+ path)
+ (modules outline)
+ (preprocess (pps ppx_hash js_of_ocaml-ppx))
+ )
+
+
diff --git a/script.it/outline.ml b/script.it/outline/outline.ml
index 1df7588..1df7588 100755
--- a/script.it/outline.ml
+++ b/script.it/outline/outline.ml
diff --git a/script.it/script.ml b/script.it/script.ml
index ba6b828..bc79a22 100755
--- a/script.it/script.ml
+++ b/script.it/script.ml
@@ -3,13 +3,88 @@ open Note
open Brr
open Brr_note
+module State = Script_state.State
+module Selection = Script_state.Selection
+
+module Out = struct
+ type t = { point : float * float
+ ; timer : Elements.Timer.t
+ ; worker : Brr_webworkers.Worker.t
+ }
+
+ let apply {point; timer ; worker} state =
+ match state.State.mode with
+
+ | Edit ->
+ let stamp = Elements.Timer.delay timer in
+ Elements.Timer.stop timer;
+ begin match Path.Path_Builder.peek2 state.current with
+ (* If there is at last two points selected, handle this as a curve
+ creation. And we add the new point in the current path *)
+ | Some _ ->
+
+ let current = State.insert_or_replace state point stamp state.current in
+ let path = Path.Fixed.to_fixed
+ (module Path.Path_Builder)
+ current in
+
+ (* Create a copy from the path with all the interior points *)
+ let back = Path.Fixed.map
+ path
+ (fun pt -> Path.Point.copy pt @@ Path.Point.get_coord' pt) in
+
+ let last =
+ Outline.{ path
+ ; back
+ ; id = Outline.get_id ()
+ }
+ in
+
+ (* Send to the worker for a full review *)
+ let () = State.post worker (`Complete last) in
+
+ let state =
+ { state with
+ mode = Out
+ ; paths = last::state.paths
+ ; current = Path.Path_Builder.empty } in
+ state
+
+ (* Else, check if there is a curve under the cursor, and remove it *)
+ | None ->
+ let current = Path.Path_Builder.empty in
+ begin match Selection.get_from_paths point state.paths with
+ | _, None ->
+ { state with
+ mode = Out
+ ; current
+ }
+ | dist, Some selection ->
+ State.select_segment point selection { state with current } dist
+
+ end
+ end
+
+ | mode when Elements.Timer.delay timer < 0.3 ->
+ State.click state mode
+
+ | _ ->
+ State.longClick point state worker state.mode
+
+end
+
let post
: Brr_webworkers.Worker.t -> Worker_messages.to_worker -> unit
= Brr_webworkers.Worker.post
+type canva_events =
+ [ `MouseDown of float * float
+ | `Out of float * float
+ ]
+
(** 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
+ : Brr.El.t -> canva_events Note.E.t * (float * float) option Note.S.t * Brr_canvas.Canvas.t
= fun element ->
(* Adapt the width to the window *)
@@ -384,6 +459,26 @@ let page_main id =
let canva_events, mouse_position, canva = canva (Jv.Id.of_jv id) in
+ let canva_events = Note.E.map
+ (function
+ | `MouseDown c -> `MouseDown c
+ | `Out c ->
+
+ `Generic (
+ State.E
+ ( Out.{ point = c
+ ; worker
+ ; timer
+ }
+ , (module Out: State.Handler with type t = Out.t)
+
+
+ )
+
+ )
+
+ ) canva_events in
+
let tick_event =
S.sample_filter mouse_position
~on:tick
diff --git a/script.it/state/dune b/script.it/state/dune
new file mode 100755
index 0000000..7d4ef3f
--- /dev/null
+++ b/script.it/state/dune
@@ -0,0 +1,13 @@
+(library
+ (name script_state)
+ (libraries
+ brr
+ brr.note
+ blog
+ application
+ worker_messages
+ outline
+ layer
+ path
+ )
+ )
diff --git a/script.it/selection.ml b/script.it/state/selection.ml
index f5f135a..f5f135a 100755
--- a/script.it/selection.ml
+++ b/script.it/state/selection.ml
diff --git a/script.it/selection.mli b/script.it/state/selection.mli
index 9792a2d..9792a2d 100755
--- a/script.it/selection.mli
+++ b/script.it/state/selection.mli
diff --git a/script.it/state.ml b/script.it/state/state.ml
index 77a24a3..d7cb13e 100755
--- a/script.it/state.ml
+++ b/script.it/state/state.ml
@@ -9,7 +9,6 @@ type mode =
(** Events *)
type canva_events =
[ `MouseDown of float * float
- | `Out of float * float
]
type button_events =
@@ -23,16 +22,6 @@ type render_event =
type worker_event = Worker_messages.from_worker
-type events =
- [ canva_events
- | button_events
- | render_event
- | worker_event
- | `Point of float * (float * float)
- | `Width of float
- | `Angle of float
- ]
-
(*
The state cant hold functionnal values, and thus cannot be used to store
elements like timer
@@ -47,6 +36,27 @@ type state =
; mouse_down_position : Gg.v2
}
+module type Handler = sig
+
+ type t
+
+ val apply: t -> state -> state
+
+end
+
+type t = E : 'a * (module Handler with type t = 'a) -> t
+
+type events =
+ [ canva_events
+ | button_events
+ | render_event
+ | worker_event
+ | `Point of float * (float * float)
+ | `Width of float
+ | `Angle of float
+ | `Generic of t
+ ]
+
let post
: Brr_webworkers.Worker.t -> Worker_messages.to_worker -> unit
= Brr_webworkers.Worker.post
@@ -198,6 +208,8 @@ let do_action
: Brr_webworkers.Worker.t -> Elements.Timer.t -> (events, state) Application.t
= fun worker timer event state ->
match event, state.mode with
+ | `Generic (E (t, (module Handler))), _ ->
+ Handler.apply t state
| `Point (delay, point), _ ->
tick (delay, point) state
@@ -279,62 +291,6 @@ let do_action
end
end
- | `Out point, Edit ->
- let stamp = Elements.Timer.delay timer in
- Elements.Timer.stop timer;
- begin match Path.Path_Builder.peek2 state.current with
- (* If there is at last two points selected, handle this as a curve
- creation. And we add the new point in the current path *)
- | Some _ ->
-
- let current = insert_or_replace state point stamp state.current in
- let path = Path.Fixed.to_fixed
- (module Path.Path_Builder)
- current in
-
- (* Create a copy from the path with all the interior points *)
- let back = Path.Fixed.map
- path
- (fun pt -> Path.Point.copy pt @@ Path.Point.get_coord' pt) in
-
- let last =
- Outline.{ path
- ; back
- ; id = Outline.get_id ()
- }
- in
-
- (* Send to the worker for a full review *)
- let () = post worker (`Complete last) in
-
- let state =
- { state with
- mode = Out
- ; paths = last::state.paths
- ; current = Path.Path_Builder.empty } in
- state
-
- (* Else, check if there is a curve under the cursor, and remove it *)
- | None ->
- let current = Path.Path_Builder.empty in
- begin match Selection.get_from_paths point state.paths with
- | _, None ->
- { state with
- mode = Out
- ; current
- }
- | dist, Some selection ->
- select_segment point selection { state with current } dist
-
- end
- end
-
- | `Out _, mode when Elements.Timer.delay timer < 0.3 ->
- click state mode
-
- | `Out mouse_coord, mode ->
- longClick mouse_coord state worker mode
-
| `Delete, _ ->
delete state worker