From 38cf58ac5e1adb38a1b99ea7cdda19ef7b5e12bf Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Mon, 24 May 2021 22:13:19 +0200 Subject: Refactor --- script.it/state/state.ml | 357 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 357 insertions(+) create mode 100755 script.it/state/state.ml (limited to 'script.it/state/state.ml') diff --git a/script.it/state/state.ml b/script.it/state/state.ml new file mode 100755 index 0000000..d7cb13e --- /dev/null +++ b/script.it/state/state.ml @@ -0,0 +1,357 @@ +open StdLabels +open Brr + +type mode = + | Edit + | Selection of Selection.t + | Out + +(** Events *) +type canva_events = + [ `MouseDown of float * float + ] + +type button_events = + [ `Delete + | `Export + ] +type render_event = + [ + `Rendering of Layer.Paths.printer + ] + +type worker_event = Worker_messages.from_worker + +(* + The state cant hold functionnal values, and thus cannot be used to store + elements like timer + *) +type state = + { mode : mode + ; paths : Outline.t list + ; current : Path.Path_Builder.t + ; width : float + ; angle : float + ; rendering : Layer.Paths.printer + ; 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 + +let insert_or_replace state ((x, y) as p) stamp path = + let width = state.width + and angle = state.angle in + let point = Path.Point.create ~x ~y ~angle ~width ~stamp in + match Path.Path_Builder.peek path with + | None -> + Path.Path_Builder.add_point + point + path + | Some p1 -> + let open Gg.V2 in + + let p1' = Path.Point.get_coord p1 in + + let dist = (norm (p1' - (of_tuple p))) in + if dist < 5. then ( + path + ) else ( + Path.Path_Builder.add_point + point + path + ) + +(** Select the given segment, and modify angle and width accordingly *) +let select_segment _ (_, selected, p0, p1) state dist = + + let point' = Path.Point.mix dist (Path.Point.get_coord p0) p0 p1 in + + let angle = (Float.round @@ 10. *. Path.Point.get_angle point') /. 10. + and width = (Float.round @@ 10. *. Path.Point.get_width point') /. 10. in + + let id = Selection.select_path selected in + { state with + mode = (Selection id) + ; 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 + +*) +let tick (delay, point) state = + match state.mode with + | Edit -> + (* Add the point in the list *) + let current = insert_or_replace + state + point + delay + state.current in + { state with current } + | _ -> state + +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 + 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 + post worker (`Back outline); + state + +let width worker width state = + match 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 } + +let angle worker angle state = + match 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 } + + +(** 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 -> + 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 + 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.paths + ~f:(fun path -> + + Layer.Paths.to_svg + ~color:Blog.Nord.nord0 + (module Path.Fixed) + Outline.(path.path, path.back) + 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 + + | `Angle value , _ -> + angle worker value state + | `Width value, _ -> + width worker value state + + + | `Rendering rendering, _ -> + { state with rendering} + + | `Other t, _ -> + Console.(log [t]); + state + + | `Complete newPath, _ -> + let paths = List.map + state.paths + ~f:(fun line -> + match Outline.(newPath.id = line.id) with + | true -> newPath + | false -> line) in + { state with paths } + + + (* Some non possible cases *) + | `MouseDown _, Edit + -> state + +let init = + { paths = [] + ; current = Path.Path_Builder.empty + ; mode = Out + ; angle = 30. + ; width = 10. + ; rendering = `Fill + ; mouse_down_position = Gg.V2.ox + } -- cgit v1.2.3