diff options
Diffstat (limited to 'script.it/script_event')
| -rwxr-xr-x | script.it/script_event/click.ml | 106 | ||||
| -rwxr-xr-x | script.it/script_event/export.ml | 34 | ||||
| -rwxr-xr-x | script.it/script_event/mouse_down.ml | 142 | ||||
| -rwxr-xr-x | script.it/script_event/property.ml | 76 |
4 files changed, 176 insertions, 182 deletions
diff --git a/script.it/script_event/click.ml b/script.it/script_event/click.ml index b7ffcb6..d1fd2e2 100755 --- a/script.it/script_event/click.ml +++ b/script.it/script_event/click.ml @@ -1,12 +1,14 @@ module State = Script_state.State module Selection = Script_state.Selection +module Path = Script_path (** Handle a click outside of the selection *) -type t = { point : float * float - ; timer : Elements.Timer.t - ; worker : Brr_webworkers.Worker.t - } +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. @@ -14,78 +16,62 @@ type t = { point : float * float 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 + let mouse_v2 = Gg.V2.of_tuple mouse_coord in + ( 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')) } + 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 + let delta = Gg.V2.(mouse_v2 - state.State.mouse_down_position) in + State.post worker (`TranslatePath (path, delta)); + state ) (* TODO Long click in out mode should translate the whole slate *) | _ -> state -let process {point; timer ; worker} state = - match state.State.mode with +let process { 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 + let stamp = Elements.Timer.delay timer in + Elements.Timer.stop timer; + ( 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 - 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 + (* 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 + 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 + (* 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 -> + let state = { state with mode = Out - ; current + ; 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 + ( 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 - + State.select_segment point selection { state with current } dist + ) ) + | _ when Elements.Timer.delay timer < 0.3 -> state + | _ -> drag point state worker state.mode diff --git a/script.it/script_event/export.ml b/script.it/script_event/export.ml index 10dd937..db2f89c 100755 --- a/script.it/script_event/export.ml +++ b/script.it/script_event/export.ml @@ -1,30 +1,32 @@ open StdLabels open Brr module State = Script_state.State +module Path = Script_path type t = unit let process () state = let my_host = Uri.host @@ Window.location @@ G.window in - if (Hashtbl.hash my_host) = Blog.Hash_host.expected_host then ( + ( 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 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); + content ); state diff --git a/script.it/script_event/mouse_down.ml b/script.it/script_event/mouse_down.ml index 1c25a7d..88fefb4 100755 --- a/script.it/script_event/mouse_down.ml +++ b/script.it/script_event/mouse_down.ml @@ -1,84 +1,90 @@ module State = Script_state.State module Selection = Script_state.Selection +module Path = Script_path -type t = { position : float * float - ; timer : Elements.Timer.t } +type t = + { position : float * float + ; timer : Elements.Timer.t + } let process { position; timer } state = match state.State.mode with - | Out -> - let x, y = position in - Elements.Timer.start timer 0.3; - - let width = state.width - and angle = state.angle in + let x, y = position in + Elements.Timer.start timer 0.3; - let stamp = 0. in - let point = - match Selection.get_from_paths position state.paths with - | _, None -> - (* Start a new path with the point clicked *) - Path.Point.create ~x ~y ~angle ~width ~stamp - | _, Some (p, _, _, _) -> - (* If the point is close to an existing path, we use the closest - point in the path instead *) - let x, y = Gg.V2.to_tuple p in - Path.Point.create ~x ~y ~angle ~width ~stamp - in + let width = state.width + and angle = state.angle in - let current = Path.Path_Builder.add_point - point - state.current in - { state with - current - ; mode = Edit - ; mouse_down_position = Gg.V2.of_tuple (x, y)} - - | (Selection (Path id)) - | (Selection (Point (id, _))) -> + let stamp = 0. in + let point = + match Selection.get_from_paths position state.paths with + | _, None -> + (* Start a new path with the point clicked *) + Path.Point.create ~x ~y ~angle ~width ~stamp + | _, Some (p, _, _, _) -> + (* If the point is close to an existing path, we use the closest + point in the path instead *) + let x, y = Gg.V2.to_tuple p in + Path.Point.create ~x ~y ~angle ~width ~stamp + in - let get_any () = - begin match Selection.get_from_paths position state.paths with + let current = Path.Path_Builder.add_point point state.current in + { state with + current + ; mode = Edit + ; mouse_down_position = Gg.V2.of_tuple (x, y) + } + | Selection (Path id) | Selection (Point (id, _)) -> + let get_any () = + match Selection.get_from_paths position state.paths with | _, None -> - { state with - mode = Out - ; mouse_down_position = Gg.V2.of_tuple position } + { state with + mode = Out + ; mouse_down_position = Gg.V2.of_tuple position + } | dist, Some selection -> - let _, outline, _, _ = selection in - if outline.Outline.id != id then ( - let mouse_down_position = Gg.V2.of_tuple position in - State.select_segment position selection { state with mouse_down_position } dist - ) else - (* On the same segment, check for a point *) - let selection = Selection.select_point outline (Gg.V2.of_tuple position) in - match selection with - | Path _ -> - { state with - mode = Selection selection - ; mouse_down_position = Gg.V2.of_tuple position } - | Point (_, pt) -> - (* In order to handle the point move, start the timer *) - Elements.Timer.start timer 0.3; - { state with - mode = Selection selection - ; angle = Path.Point.get_angle pt - ; width = Path.Point.get_width pt - ; mouse_down_position = Gg.V2.of_tuple position } - end - in - (* First, check for a point in the selected path. If any of them in - found, check anything to select in all the elements *) - begin match Outline.find state.paths id with + let _, outline, _, _ = selection in + if outline.Outline.id != id + then + let mouse_down_position = Gg.V2.of_tuple position in + State.select_segment + position + selection + { state with mouse_down_position } + dist + else + (* On the same segment, check for a point *) + let selection = + Selection.select_point outline (Gg.V2.of_tuple position) + in + ( match selection with + | Path _ -> + { state with + mode = Selection selection + ; mouse_down_position = Gg.V2.of_tuple position + } + | Point (_, pt) -> + (* In order to handle the point move, start the timer *) + Elements.Timer.start timer 0.3; + { state with + mode = Selection selection + ; angle = Path.Point.get_angle pt + ; width = Path.Point.get_width pt + ; mouse_down_position = Gg.V2.of_tuple position + } ) + in + (* First, check for a point in the selected path. If any of them in + found, check anything to select in all the elements *) + ( match Outline.find state.paths id with | None -> get_any () | Some outline -> - begin match Selection.select_point outline (Gg.V2.of_tuple position) with - | Path _ -> get_any () - | other -> + ( match Selection.select_point outline (Gg.V2.of_tuple position) with + | Path _ -> get_any () + | other -> Elements.Timer.start timer 0.3; - {state with - mode = Selection other - ; mouse_down_position = Gg.V2.of_tuple position } - end - end + { state with + mode = Selection other + ; mouse_down_position = Gg.V2.of_tuple position + } ) ) | Edit -> state diff --git a/script.it/script_event/property.ml b/script.it/script_event/property.ml index dbdc1de..b41d3f8 100755 --- a/script.it/script_event/property.ml +++ b/script.it/script_event/property.ml @@ -1,52 +1,52 @@ module State = Script_state.State module Selection = Script_state.Selection +module Path = Script_path 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 + (* 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 + 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 process { prop; value ; worker } state = +type t = + { prop : [ `Angle | `Width ] + ; value : float + ; worker : Brr_webworkers.Worker.t + } + +let process { prop; value; worker } state = match prop with | `Angle -> - let angle = value in - begin match state.State.mode with - + let angle = value in + ( 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 + let state = { state with angle } in + Selection.find_selection t state.paths + |> update_property worker state angle Path.Point.set_angle + | _ -> { state with angle } ) | `Width -> - let width = value in - begin match state.State.mode with - + let width = value in + ( 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 + let state = { state with width } in + Selection.find_selection t state.paths + |> update_property worker state width Path.Point.set_width + | _ -> { state with width } ) |