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.ml | 401 ----------------------------------------------------- 1 file changed, 401 deletions(-) delete mode 100755 script.it/state.ml (limited to 'script.it/state.ml') diff --git a/script.it/state.ml b/script.it/state.ml deleted file mode 100755 index 77a24a3..0000000 --- a/script.it/state.ml +++ /dev/null @@ -1,401 +0,0 @@ -open StdLabels -open Brr - -type mode = - | Edit - | Selection of Selection.t - | Out - -(** Events *) -type canva_events = - [ `MouseDown of float * float - | `Out of float * float - ] - -type button_events = - [ `Delete - | `Export - ] -type render_event = - [ - `Rendering of Layer.Paths.printer - ] - -type worker_event = Worker_messages.from_worker - -type events = - [ canva_events - | button_events - | render_event - | worker_event - | `Point of float * (float * float) - | `Width of float - | `Angle of float - ] - -(* - 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 - } - -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 - | `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 - - | `Out point, 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 = 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 () = 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 -> - select_segment point selection { state with current } dist - - end - end - - | `Out _, mode when Elements.Timer.delay timer < 0.3 -> - click state mode - - | `Out mouse_coord, mode -> - longClick mouse_coord state worker mode - - | `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