diff options
Diffstat (limited to 'script.it/state/state.ml')
| -rwxr-xr-x | script.it/state/state.ml | 147 |
1 files changed, 3 insertions, 144 deletions
diff --git a/script.it/state/state.ml b/script.it/state/state.ml index d7cb13e..4cf6992 100755 --- a/script.it/state/state.ml +++ b/script.it/state/state.ml @@ -7,14 +7,6 @@ type mode = | Out (** Events *) -type canva_events = - [ `MouseDown of float * float - ] - -type button_events = - [ `Delete - | `Export - ] type render_event = [ `Rendering of Layer.Paths.printer @@ -47,8 +39,7 @@ end type t = E : 'a * (module Handler with type t = 'a) -> t type events = - [ canva_events - | button_events + [ `Export | render_event | worker_event | `Point of float * (float * float) @@ -98,30 +89,6 @@ let select_segment _ (_, selected, p0, p1) state dist = ; angle ; width } -(** Delete the selected element *) -let delete state worker = - match state.mode with - | Selection (Path id) -> - let paths = List.filter - state.paths - ~f:(fun p -> - p.Outline.id != id - ) in - { state with paths ; mode = Out} - - | Selection (Point (id, point)) -> - List.iter - state.paths - ~f:(fun p -> - let id' = p.Outline.id in - match id' = id with - | false -> () - | true -> post worker (`DeletePoint (point, p)) - ); - { state with mode = Selection (Path id) } - | _ -> - state - (** Tick event Tick only occurs when drawing a new path @@ -180,119 +147,15 @@ let angle worker angle state = | _ -> { state with angle } -(** Short click on any element, just do nothing (each element is on MouseDown - event) *) -let click state = function - | _ -> state - -(** Long click, move the selected element if any *) -let longClick mouse_coord state worker = function - | Selection t -> - let mouse_v2 = Gg.V2.of_tuple mouse_coord in - begin match Selection.find_selection t state.paths with - | None -> state - | Some (Point (path, point)) -> - let point' = Path.Point.copy point mouse_v2 in - 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.mouse_down_position) in - post worker (`TranslatePath (path, delta)); - state - end - (* TODO Long click in out mode should translate the slate *) - | _ -> state - let do_action - : Brr_webworkers.Worker.t -> Elements.Timer.t -> (events, state) Application.t - = fun worker timer event state -> + : Brr_webworkers.Worker.t -> (events, state) Application.t + = fun worker event state -> match event, state.mode with | `Generic (E (t, (module Handler))), _ -> Handler.apply t state | `Point (delay, point), _ -> tick (delay, point) state - (* Click anywhere while in Out mode, we switch in edition *) - | `MouseDown ((x, y) as p), Out -> - Elements.Timer.start timer 0.3; - - let width = state.width - and angle = state.angle in - - let stamp = 0. in - let point = - match Selection.get_from_paths p 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 current = Path.Path_Builder.add_point - point - state.current in - { state with - current - ; mode = Edit - ; mouse_down_position = Gg.V2.of_tuple (x, y)} - - (* Click anywhere while in selection mode, we either select another path, - or switch to Out mode*) - | `MouseDown position, (Selection (Path id)) - | `MouseDown position, (Selection (Point (id, _))) -> - - let get_any () = - begin match Selection.get_from_paths position state.paths with - | _, None -> - { 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 - 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 - | None -> get_any () - | Some outline -> - begin 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 - - | `Delete, _ -> - delete state worker | `Export, _ -> let my_host = Uri.host @@ Window.location @@ G.window in @@ -342,10 +205,6 @@ let do_action { state with paths } - (* Some non possible cases *) - | `MouseDown _, Edit - -> state - let init = { paths = [] ; current = Path.Path_Builder.empty |