diff options
| -rwxr-xr-x | script.it/dune | 11 | ||||
| -rwxr-xr-x | script.it/outline/dune | 9 | ||||
| -rwxr-xr-x | script.it/outline/outline.ml (renamed from script.it/outline.ml) | 0 | ||||
| -rwxr-xr-x | script.it/script.ml | 97 | ||||
| -rwxr-xr-x | script.it/state/dune | 13 | ||||
| -rwxr-xr-x | script.it/state/selection.ml (renamed from script.it/selection.ml) | 0 | ||||
| -rwxr-xr-x | script.it/state/selection.mli (renamed from script.it/selection.mli) | 0 | ||||
| -rwxr-xr-x | script.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 |