aboutsummaryrefslogtreecommitdiff
path: root/script.it/script.ml
diff options
context:
space:
mode:
Diffstat (limited to 'script.it/script.ml')
-rwxr-xr-xscript.it/script.ml97
1 files changed, 96 insertions, 1 deletions
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