From 32618a5ce8e2b306af102e4c16711b090c36b840 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Thu, 7 Jan 2021 21:54:46 +0100 Subject: Allow point movement --- script.it/script.ml | 15 ++++++++++- script.it/selection.mli | 2 ++ script.it/state.ml | 46 +++++++++++++++++++++------------ script.it/worker.ml | 67 +++++++++---------------------------------------- 4 files changed, 58 insertions(+), 72 deletions(-) (limited to 'script.it') diff --git a/script.it/script.ml b/script.it/script.ml index ede47be..ca831ba 100755 --- a/script.it/script.ml +++ b/script.it/script.ml @@ -264,15 +264,28 @@ let on_change canva mouse_position timer state = | Selection (Point (id, point)) -> (* As before, mark the selected path *) Cd2d.set_stroke_style context (Cd2d.color white); + List.iter state.paths ~f:(fun path -> if id = Path.Fixed.id path then + let path = begin match pos with + | Some pos -> + + let pos_v2 = Gg.V2.of_tuple pos in + if Elements.Timer.delay timer < 0.3 then + path + else + let point' = Path.Point.copy point pos_v2 in + begin match Path.Fixed.replace_point path point' with + | None -> path + | Some p -> p + end + | None -> path end in Layer.Paths.to_canva (module Path.Fixed) path context `Line ); (* Now draw the selected point *) - let x, y = Gg.V2.to_tuple @@ Path.Point.get_coord point in Cd2d.stroke_rect ~x:(x -. 5.) diff --git a/script.it/selection.mli b/script.it/selection.mli index 01f12dc..a405edc 100755 --- a/script.it/selection.mli +++ b/script.it/selection.mli @@ -2,6 +2,8 @@ type t = | Path of int | Point of (int * Path.Point.t) +val threshold : float + (** Return the closest path from the list to a given point. The path is returned with all thoses informations : diff --git a/script.it/state.ml b/script.it/state.ml index 185be4f..da97b13 100755 --- a/script.it/state.ml +++ b/script.it/state.ml @@ -25,7 +25,7 @@ type render_event = type worker_event = [ `Basic of Jv.t - | `Complete of (int * (Path.Fixed.path array)) + | `Complete of Path.Fixed.t ] type events = @@ -74,18 +74,15 @@ let insert_or_replace state ((x, y) as p) stamp path = path ) -let threshold = 20. - (** Update the path in the selection with the given function applied to every point *) let update_path_selection id paths f = - List.map paths ~f:(fun path -> let id' = Path.Fixed.id path in match id = id' with | false -> path - | true -> Path.Fixed.map_point path f + | true -> Path.Fixed.map path f ) let update_point_selection state path_id point f = @@ -94,7 +91,7 @@ let update_point_selection state path_id point f = match Path.Fixed.id p = path_id with | false -> p | true -> - Path.Fixed.map_point + Path.Fixed.map p (fun p -> if (Path.Point.id p = Path.Point.id point) then @@ -143,7 +140,7 @@ let delete state worker = | false -> () | true -> (* Send the job to the worker *) - Brr_webworkers.Worker.post worker (`DeletePoint (id, point, p)) + Brr_webworkers.Worker.post worker (`DeletePoint (point, p)) ); { state with mode = Selection (Path id) } | _ -> @@ -269,13 +266,10 @@ let do_action current in - let id = Path.Fixed.id last - and path = Path.Fixed.path last in - let () = Brr_webworkers.Worker.post worker (`Complete (id, path)) in + let () = Brr_webworkers.Worker.post worker (`Complete last) in last::state.paths and current = Path.Path_Builder.empty in - { state with mode = Out ; paths; current } @@ -294,6 +288,25 @@ let do_action end end + + | `Out mouse_coord, Selection (Point (id, point)) -> + let mouse_v2 = Gg.V2.of_tuple mouse_coord in + if Elements.Timer.delay timer < 0.3 then + state + else + let point' = Path.Point.copy point mouse_v2 in + List.iter state.paths + ~f:(fun path -> + let id' = Path.Fixed.id path in + match id = id' with + | false -> () + | true -> + Option.iter + (fun p -> Brr_webworkers.Worker.post worker (`Complete p)) + (Path.Fixed.replace_point path point') + ); + + { state with mode = Selection (Path id) } | `Delete, _ -> delete state worker @@ -346,14 +359,15 @@ let do_action Console.(log [t]); state - | `Complete (id, paths), _ -> + | `Complete path, _ -> + let id = Path.Fixed.id path in let paths = List.map state.paths - ~f:(fun path -> - let id' = Path.Fixed.id path in + ~f:(fun path' -> + let id' = Path.Fixed.id path' in match id = id' with - | false -> path + | false -> path' | true -> - (Path.Fixed.update path paths) + path ) in { state with paths } diff --git a/script.it/worker.ml b/script.it/worker.ml index 6f425cd..4ea9220 100755 --- a/script.it/worker.ml +++ b/script.it/worker.ml @@ -1,65 +1,22 @@ -open StdLabels open Js_of_ocaml type message = [ - | `Complete of (int * (Path.Fixed.path array)) - | `DeletePoint of (int * Path.Point.t * Path.Fixed.t) + | `Complete of Path.Fixed.t + | `DeletePoint of (Path.Point.t * Path.Fixed.t) ] -let get_point - : Path.Fixed.path -> Gg.v2 - = function - | Line (_, p1) -> Path.Point.get_coord p1 - | Curve bezier -> Path.Point.get_coord bezier.Path.Fixed.p1 - -let first_point - : Path.Fixed.path -> Gg.v2 - = function - | Line (p0, _) -> Path.Point.get_coord p0 - | Curve bezier -> Path.Point.get_coord bezier.Path.Fixed.p0 - -let assoc_point - : Shapes.Bezier.t -> Path.Fixed.path -> Path.Fixed.path - = fun bezier -> function - | Line (p0, p1) - | Curve {p0; p1; _} -> - let p0' = Path.Point.copy p0 bezier.Shapes.Bezier.p0 - and p1' = Path.Point.copy p1 bezier.Shapes.Bezier.p1 in - Curve - { Path.Fixed.p0 = p0' - ; Path.Fixed.p1 = p1' - ; Path.Fixed.ctrl0 = bezier.Shapes.Bezier.ctrl0 - ; Path.Fixed.ctrl1 = bezier.Shapes.Bezier.ctrl1 - } - -let rebuild (id, paths) = - (* Convert all the points in list *) - let points = List.init - ~len:((Array.length paths) ) - ~f:(fun i -> get_point (Array.get paths i)) in - let p0 = first_point (Array.get paths 0)in - - let points = p0::points in - - (* We process the whole curve in a single block *) - begin match Shapes.Bspline.to_bezier points with - | Error `InvalidPath -> () - | Ok beziers -> - - (* Now for each point, reassociate the same point information, - We should have as many points as before *) - let rebuilded = Array.map2 beziers paths ~f:assoc_point in - Worker.post_message (`Complete (id, rebuilded)) - end - let execute (command: [> message]) = match command with - | `Complete (id, paths) -> - rebuild (id, paths) - | `DeletePoint (id, point, path) -> - let path = Path.Fixed.remove_point path point in - (* TODO Handle when there are less than 4 points *) - rebuild (id, Path.Fixed.path path) + | `Complete path -> + begin match Path.Fixed.rebuild path with + | Some path -> Worker.post_message (`Complete path) + | None -> () + end + | `DeletePoint (point, path) -> + begin match Path.Fixed.remove_point path point with + | Some path -> Worker.post_message (`Complete path) + | None -> () + end | any -> Worker.post_message (`Other any) -- cgit v1.2.3