summaryrefslogtreecommitdiff
path: root/script.it/script_event
diff options
context:
space:
mode:
authorSébastien Dailly <sebastien@chimrod.com>2021-05-25 11:08:00 +0200
committerSébastien Dailly <sebastien@dailly.me>2022-02-07 16:22:43 +0100
commit6a75fb043ed30389fff1ce97fe20ee56b1c95066 (patch)
tree20e0c2cb39dffcf85449e0b810d773909c405a0e /script.it/script_event
parent90f1f73f08b2d9231b2ee029b9e39dd570e36f36 (diff)
Update script.it project
Diffstat (limited to 'script.it/script_event')
-rwxr-xr-xscript.it/script_event/click.ml (renamed from script.it/script_event/out.ml)13
-rwxr-xr-xscript.it/script_event/complete_path.ml14
-rwxr-xr-xscript.it/script_event/delete.ml2
-rwxr-xr-xscript.it/script_event/export.ml30
-rwxr-xr-xscript.it/script_event/mouse_down.ml2
-rwxr-xr-xscript.it/script_event/property.ml52
-rwxr-xr-xscript.it/script_event/tick.ml20
7 files changed, 126 insertions, 7 deletions
diff --git a/script.it/script_event/out.ml b/script.it/script_event/click.ml
index b8b8599..591887b 100755
--- a/script.it/script_event/out.ml
+++ b/script.it/script_event/click.ml
@@ -8,8 +8,11 @@ type t = { point : float * float
; worker : Brr_webworkers.Worker.t
}
-(** Long click, move the selected element if any *)
-let longClick mouse_coord state worker = function
+(** 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
@@ -24,10 +27,10 @@ let longClick mouse_coord state worker = function
State.post worker (`TranslatePath (path, delta));
state
end
- (* TODO Long click in out mode should translate the slate *)
+ (* TODO Long click in out mode should translate the whole slate *)
| _ -> state
-let apply {point; timer ; worker} state =
+let update {point; timer ; worker} state =
match state.State.mode with
| Edit ->
@@ -84,5 +87,5 @@ let apply {point; timer ; worker} state =
state
| _ ->
- longClick point state worker state.mode
+ 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/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