From 6a75fb043ed30389fff1ce97fe20ee56b1c95066 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Tue, 25 May 2021 11:08:00 +0200 Subject: Update script.it project --- script.it/script_event/click.ml | 91 +++++++++++++++++++++++++++++++++ script.it/script_event/complete_path.ml | 14 +++++ script.it/script_event/delete.ml | 2 +- script.it/script_event/export.ml | 30 +++++++++++ script.it/script_event/mouse_down.ml | 2 +- script.it/script_event/out.ml | 88 ------------------------------- script.it/script_event/property.ml | 52 +++++++++++++++++++ script.it/script_event/tick.ml | 20 ++++++++ 8 files changed, 209 insertions(+), 90 deletions(-) create mode 100755 script.it/script_event/click.ml create mode 100755 script.it/script_event/complete_path.ml create mode 100755 script.it/script_event/export.ml delete mode 100755 script.it/script_event/out.ml create mode 100755 script.it/script_event/property.ml create mode 100755 script.it/script_event/tick.ml (limited to 'script.it/script_event') diff --git a/script.it/script_event/click.ml b/script.it/script_event/click.ml new file mode 100755 index 0000000..591887b --- /dev/null +++ b/script.it/script_event/click.ml @@ -0,0 +1,91 @@ +module State = Script_state.State +module Selection = Script_state.Selection + +(** Handle a click outside of the selection *) + +type t = { point : float * float + ; timer : Elements.Timer.t + ; worker : Brr_webworkers.Worker.t + } + +(** The drag function is incorrectly named, as we dont't care if we are + selecting an element or not. + + But, in the case we are (point, path…), we effectively move the element with the mouse. *) +let drag mouse_coord state worker = function + | State.Selection t -> + let mouse_v2 = Gg.V2.of_tuple mouse_coord in + begin match Selection.find_selection t state.State.paths with + | None -> state + | Some (Point (path, point)) -> + let point' = Path.Point.copy point mouse_v2 in + State.post worker (`TranslatePoint (point', path)); + (* Just replace the position of the selected point *) + { state with mode = Selection (Point (path.id, point')) } + | Some (Path path) -> + let delta = Gg.V2.(mouse_v2 - state.State.mouse_down_position) in + State.post worker (`TranslatePath (path, delta)); + state + end + (* TODO Long click in out mode should translate the whole slate *) + | _ -> state + +let update {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 + + | _ when Elements.Timer.delay timer < 0.3 -> + state + + | _ -> + drag point state worker state.mode + diff --git a/script.it/script_event/complete_path.ml b/script.it/script_event/complete_path.ml new file mode 100755 index 0000000..99dd6ae --- /dev/null +++ b/script.it/script_event/complete_path.ml @@ -0,0 +1,14 @@ +open StdLabels +module State = Script_state.State + +type t = Outline.t + +let update newPath state = + let paths = List.map + state.State.paths + ~f:(fun line -> + match Outline.(newPath.id = line.id) with + | true -> newPath + | false -> line) in + { state with paths } + diff --git a/script.it/script_event/delete.ml b/script.it/script_event/delete.ml index edd5d23..6aac5d2 100755 --- a/script.it/script_event/delete.ml +++ b/script.it/script_event/delete.ml @@ -7,7 +7,7 @@ module Selection = Script_state.Selection type t = { worker : Brr_webworkers.Worker.t } (* Click anywhere while in Out mode, we switch in edition *) -let apply { worker } state = +let update { worker } state = match state.State.mode with | Selection (Path id) -> let paths = List.filter diff --git a/script.it/script_event/export.ml b/script.it/script_event/export.ml new file mode 100755 index 0000000..9e900c7 --- /dev/null +++ b/script.it/script_event/export.ml @@ -0,0 +1,30 @@ +open StdLabels +open Brr +module State = Script_state.State + +type t = unit + +let update () state = + let my_host = Uri.host @@ Window.location @@ G.window in + if (Hashtbl.hash my_host) = Blog.Hash_host.expected_host then ( + (* Convert the path into an sVG element *) + let svg = Layer.Svg.svg + ~at:Brr.At.[ + v (Jstr.v "xmlns") (Jstr.v "http://www.w3.org/2000/svg") + ; v (Jstr.v "xmlns:xlink") (Jstr.v "http://www.w3.org/1999/xlink") ] + (List.map state.State.paths + ~f:(fun path -> + + Layer.Paths.to_svg + ~color:Blog.Nord.nord0 + (module Path.Fixed) + Outline.(path.path, path.back) + state.State.rendering + + )) in + let content = El.prop Elements.Prop.outerHTML svg in + Elements.Transfert.send + ~mime_type:(Jstr.v "image/svg+xml") + ~filename:(Jstr.v "out.svg") + content); + state diff --git a/script.it/script_event/mouse_down.ml b/script.it/script_event/mouse_down.ml index 04ea2fd..98e866a 100755 --- a/script.it/script_event/mouse_down.ml +++ b/script.it/script_event/mouse_down.ml @@ -4,7 +4,7 @@ module Selection = Script_state.Selection type t = { position : float * float ; timer : Elements.Timer.t } -let apply { position; timer } state = +let update { position; timer } state = match state.State.mode with | Out -> diff --git a/script.it/script_event/out.ml b/script.it/script_event/out.ml deleted file mode 100755 index b8b8599..0000000 --- a/script.it/script_event/out.ml +++ /dev/null @@ -1,88 +0,0 @@ -module State = Script_state.State -module Selection = Script_state.Selection - -(** Handle a click outside of the selection *) - -type t = { point : float * float - ; timer : Elements.Timer.t - ; worker : Brr_webworkers.Worker.t - } - -(** Long click, move the selected element if any *) -let longClick mouse_coord state worker = function - | State.Selection t -> - let mouse_v2 = Gg.V2.of_tuple mouse_coord in - begin match Selection.find_selection t state.State.paths with - | None -> state - | Some (Point (path, point)) -> - let point' = Path.Point.copy point mouse_v2 in - State.post worker (`TranslatePoint (point', path)); - (* Just replace the position of the selected point *) - { state with mode = Selection (Point (path.id, point')) } - | Some (Path path) -> - let delta = Gg.V2.(mouse_v2 - state.State.mouse_down_position) in - State.post worker (`TranslatePath (path, delta)); - state - end - (* TODO Long click in out mode should translate the slate *) - | _ -> state - -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 - - | _ when Elements.Timer.delay timer < 0.3 -> - state - - | _ -> - longClick point state worker state.mode - diff --git a/script.it/script_event/property.ml b/script.it/script_event/property.ml new file mode 100755 index 0000000..e637ab7 --- /dev/null +++ b/script.it/script_event/property.ml @@ -0,0 +1,52 @@ +module State = Script_state.State +module Selection = Script_state.Selection + +let update_property worker state value f = function + | None -> state + | Some (Selection.Path outline) -> + (* Change width for the whole path *) + let outline = { outline with + Outline.path = Path.Fixed.map outline.Outline.path (fun p -> + f p value) + } in + State.post worker (`Back outline); + state + | Some (Point (outline, point)) -> + let path = Path.Fixed.map + outline.path + (fun pt -> + match Path.Point.id pt = Path.Point.id point with + | false -> pt + | true -> f pt value) + in + let outline = {outline with path} in + State.post worker (`Back outline); + state + +type t = { prop : [`Angle | `Width ] + ; value : float + ; worker : Brr_webworkers.Worker.t + } + +let update { prop; value ; worker } state = + match prop with + | `Angle -> + let angle = value in + begin match state.State.mode with + + | Selection t -> + let state = { state with angle } in + Selection.find_selection t state.paths + |> update_property worker state angle Path.Point.set_angle + | _ -> { state with angle } + end + | `Width -> + let width = value in + begin match state.State.mode with + + | Selection t -> + let state = { state with width } in + Selection.find_selection t state.paths + |> update_property worker state width Path.Point.set_width + | _ -> { state with width } + end diff --git a/script.it/script_event/tick.ml b/script.it/script_event/tick.ml new file mode 100755 index 0000000..c927a2a --- /dev/null +++ b/script.it/script_event/tick.ml @@ -0,0 +1,20 @@ +module State = Script_state.State + +type t = float * (float * float) + +(** Tick event + + Tick only occurs when drawing a new path + +*) +let update (delay, point) state = + match state.State.mode with + | Edit -> + (* Add the point in the list *) + let current = State.insert_or_replace + state + point + delay + state.current in + { state with current } + | _ -> state -- cgit v1.2.3