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 --- layer/linePrinter.ml | 7 +- path/builder.ml | 29 ++-- path/fixed.ml | 360 +++++++++++++++++++++++++++++++++++++----------- path/fixed.mli | 39 ++++-- script.it/script.ml | 15 +- script.it/selection.mli | 2 + script.it/state.ml | 46 ++++--- script.it/worker.ml | 67 ++------- 8 files changed, 387 insertions(+), 178 deletions(-) diff --git a/layer/linePrinter.ml b/layer/linePrinter.ml index c15bcc9..38dae5c 100755 --- a/layer/linePrinter.ml +++ b/layer/linePrinter.ml @@ -37,9 +37,10 @@ module Make(Repr: Repr.PRINTER) = struct let line_to : Path.Point.t -> Path.Point.t -> repr -> repr - = fun _ t {path} -> - let path = Repr.line_to (Path.Point.get_coord t) path - |> mark t in + = fun p0 p1 {path} -> + let path = Repr.move_to (Path.Point.get_coord p0) path + |> Repr.line_to (Path.Point.get_coord p1) + |> mark p1 in { path } diff --git a/path/builder.ml b/path/builder.ml index 182fc13..fd772ea 100755 --- a/path/builder.ml +++ b/path/builder.ml @@ -119,24 +119,29 @@ module Make(Point:P) = struct |> Repr.line_to p1 p2 in ( path ) | p0::p1::p2::[] -> - let path = Repr.start p0 path in - let b = Shapes.Bezier.quadratic_to_cubic + let b0, b1 = Shapes.Bezier.quadratic_to_cubic @@ Shapes.Bezier.three_points_quadratic (Point.get_coord p0) (Point.get_coord p1) (Point.get_coord p2) + |> Shapes.Bezier.slice 0.5 in - - let p0' = Point.copy p0 b.Shapes.Bezier.p0 - and p2' = Point.copy p1 b.Shapes.Bezier.p1 in - - ( Repr.quadratic_to - p0' - b.Shapes.Bezier.ctrl0 - b.Shapes.Bezier.ctrl1 - p2' - path ) + let p0' = Point.copy p0 b0.Shapes.Bezier.p0 + and p1' = Point.copy p1 b0.Shapes.Bezier.p1 + and p2' = Point.copy p2 b1.Shapes.Bezier.p1 in + + Repr.start p0 path + |> Repr.quadratic_to + p0' + b0.Shapes.Bezier.ctrl0 + b0.Shapes.Bezier.ctrl1 + p1' + |> Repr.quadratic_to + p1' + b1.Shapes.Bezier.ctrl0 + b1.Shapes.Bezier.ctrl1 + p2' | (p0::_ as points) -> let (let*) v f = diff --git a/path/fixed.ml b/path/fixed.ml index 176d818..812dd3b 100755 --- a/path/fixed.ml +++ b/path/fixed.ml @@ -8,6 +8,8 @@ module type P = sig val id : t -> int + val copy : t -> Gg.v2 -> t + end module Make(Point:P) = struct @@ -37,10 +39,6 @@ module Make(Point:P) = struct : t -> int = fun {id; _} -> id - let path - : t -> path array - = fun {path; _} -> path - module ToFixed = struct type t = Point.t @@ -174,7 +172,7 @@ module Make(Point:P) = struct ; ratio } ) - let map_point + let map : t -> (Point.t -> Point.t) -> t = fun {id; path} f -> let path = Array.map path @@ -193,82 +191,286 @@ module Make(Point:P) = struct | Curve bezier -> f bezier.p0 ; f bezier.p1 ) + let get_point' + : path -> Point.t + = function + | Line (_, p1) -> p1 + | Curve bezier -> bezier.p1 + + let first_point' + : path -> Point.t + = function + | Line (p0, _) -> p0 + | Curve bezier -> bezier.p0 + + (** Associate the return from the bezier point to an existing path *) + let assoc_point + : Shapes.Bezier.t -> path -> path + = fun bezier -> function + | Line (p0, p1) + | Curve {p0; p1; _} -> + let p0' = Point.copy p0 bezier.Shapes.Bezier.p0 + and p1' = Point.copy p1 bezier.Shapes.Bezier.p1 in + Curve + { p0 = p0' + ; p1 = p1' + ; ctrl0 = bezier.Shapes.Bezier.ctrl0 + ; ctrl1 = bezier.Shapes.Bezier.ctrl1 + } + + + let build_from_three_points id p0 p1 p2 = + let bezier = + Shapes.Bezier.quadratic_to_cubic + @@ Shapes.Bezier.three_points_quadratic + (Point.get_coord p0) + (Point.get_coord p1) + (Point.get_coord p2) in + + (* The middle point is not exactly at the middle anymore (it can have been + moved), we have the reevaluate it's position *) + let ratio, _ = Shapes.Bezier.get_closest_point + (Point.get_coord p1) + bezier in + + let b0, b1 = Shapes.Bezier.slice ratio bezier in + let p0' = Point.copy p0 b0.Shapes.Bezier.p0 + and p1' = Point.copy p1 b0.Shapes.Bezier.p1 + and p2' = Point.copy p2 b1.Shapes.Bezier.p1 in + + { id + ; path = + [| Curve { p0 = p0' + ; ctrl0 = b0.Shapes.Bezier.ctrl0 + ; ctrl1 = b0.Shapes.Bezier.ctrl1 + ; p1 = p1' } + ; Curve { p0 = p1' + ; ctrl0 = b1.Shapes.Bezier.ctrl0 + ; ctrl1 = b1.Shapes.Bezier.ctrl1 + ; p1 = p2' } |] + } + + (** Rebuild the whole curve by evaluating all the points *) + let rebuild + : t -> t option + = fun {id ; path} -> + + match Array.length path with + | 0 -> None + | 1 -> + begin match Array.get path 0 with + | Curve {p0; p1; _} + | Line (p0, p1) -> + Some {id; path=[|Line (p0, p1)|]} + end + | 2 -> + let p0 = first_point' @@ Array.get path 0 + and p1 = first_point' @@ Array.get path 1 + and p2 = get_point' @@ Array.get path 1 in + Some (build_from_three_points id p0 p1 p2) + + | _ -> + + (* Convert all the points in list *) + let points = List.init + ~len:((Array.length path) ) + ~f:(fun i -> Point.get_coord @@ get_point' (Array.get path i)) in + let p0 = Point.get_coord @@ first_point' (Array.get path 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 -> None + | Ok beziers -> + + (* Now for each point, reassociate the same point information, + We should have as many points as before *) + let rebuilded = Array.map2 beziers path ~f:assoc_point in + Some {id; path = rebuilded} + end + + let find_pt_index point path = + (* First search the element to remove. The counter mark the position of + the point to remove, not the segment itself. *) + let idx = ref None + and counter = ref 0 in + + let _ = Array.exists + path + ~f:(fun element -> + + let res = match element with + | Line (p0, p1) + | Curve {p0;p1;_} -> + if (Point.id p0) = (Point.id point) then ( + idx := Some (!counter) ; + true + ) else if (Point.id p1) = (Point.id point) then ( + idx := Some (!counter+1) ; + true + ) else + false + in + incr counter; + res) in + !idx + let remove_point - : t -> Point.t -> t + : t -> Point.t -> t option = fun {id; path} point -> - (* First search the element to remove *) - let idx = ref None - and counter = ref 0 in - - let _ = Array.exists - path - ~f:(fun element -> - - let res = match element with - | Line (p0, p1) - | Curve {p0;p1;_} -> - if (Point.id p0) = (Point.id point) then ( - idx := Some (!counter) ; - true - ) else if (Point.id p1) = (Point.id point) then ( - idx := Some (!counter+1) ; - true - ) else - false + match Array.length path with + | 0 + | 1 -> None + | 2 -> + (* Two segment, we get the points and transform this into a single line *) + let p0 = first_point' @@ Array.get path 0 + and p1 = first_point' @@ Array.get path 1 + and p2 = get_point' @@ Array.get path 1 in + let elms = List.filter [p0; p1; p2] + ~f:(fun pt -> Point.id pt != Point.id point) in + begin match elms with + | p0::p1::[] -> + Some + { id + ; path=[|Line (p0, p1)|]} + | _ -> None + end + | l -> + match find_pt_index point path with + | None -> Some {id; path} + | Some 0 -> + (* Remove the first point *) + let path = Array.init (l-1) + ~f:( fun i -> Array.get path (i+1)) in + Some { id ; path } + | Some n when n = (Array.length path) -> + (* Remove the last point *) + let path = Array.init (l-1) + ~f:( fun i -> Array.get path i) in + Some { id ; path } + | Some n -> + let path' = Array.init (l-1) + ~f:(fun i -> + if i < (n-1) then + Array.get path (i) + else if i = (n-1) then + (* We know that the point is not the first nor the last one. + So it is safe to call n-1 or n + 1 point + + We have to rebuild the point and set that + point_(-1).id = point_(+1).id + *) + let p0 = + match Array.get path i with + | Line (p0, _) -> p0 + | Curve c -> c.p0 + in + + match Array.get path (i+1) with + | Line (_, p1) -> Line (p0, p1) + | Curve c -> Curve {c with p0} + + else + Array.get path (i+1) + ) in + rebuild + { id + ; path=path'} + + let replace_point + : t -> Point.t -> t option + = fun {id; path } p -> + + let add_path paths idx f points = + if 0 <= idx && idx < Array.length paths then + let path = Array.get path idx in + Point.get_coord (f path) + :: points + else points in + + match Array.length path with + | 0 -> None + | 1 -> (* Only one point, easy ? *) + begin match Array.get path 0 with + | Curve {p0; p1; _} + | Line (p0, p1) -> + let p0 = if (Point.id p0 = Point.id p) then p else p0 + and p1 = if (Point.id p1 = Point.id p) then p else p1 in + Some {id; path=[|Line (p0, p1)|]} + end + + | 2 -> + let p0 = first_point' @@ Array.get path 0 + and p1 = first_point' @@ Array.get path 1 + and p2 = get_point' @@ Array.get path 1 in + + let p0 = if (Point.id p0 = Point.id p) then p else p0 + and p1 = if (Point.id p1 = Point.id p) then p else p1 + and p2 = if (Point.id p2 = Point.id p) then p else p2 in + Some (build_from_three_points id p0 p1 p2) + + (* More than two segmend, it is ok for a partial reevaluation *) + | _ -> + match find_pt_index p path with + | None -> None + | Some n -> + let path = Array.copy path in + + let p0, p1 = + + if n < Array.length path then + match (Array.get path n) with + | Line (_, p1) -> p, p1 + | Curve bezier -> p, bezier.p1 + else + match (Array.get path (n-1)) with + | Line (p0, _) -> p0, p + | Curve bezier -> bezier.p0, p + in + + let min_idx = max (n-3) 0 in + + let points = + add_path path (n-3) first_point' + @@ add_path path (n-2) first_point' + @@ add_path path (n-1) first_point' + @@ (fun tl -> (Point.get_coord p)::tl) + @@ add_path path n get_point' + @@ add_path path (n+1) get_point' + @@ add_path path (n+2) get_point' + @@ [] in + + (* It is impressive how fast it is to evaluate the curve ! Maybe is the + worker not required at all… + *) + let bezier_opt = Shapes.Bspline.to_bezier points in + begin match bezier_opt with + | Ok paths -> + Array.iteri paths + ~f:(fun i bezier -> + (* Only take two points before, and two after *) + let idx = min_idx + i in + if (n-2 < idx) && (idx < n +2) && idx < Array.length path then + Array.set path idx (assoc_point bezier (Array.get path idx)) + ); + Some {id; path} + | Error _ -> + let bezier', _ = Shapes.Bezier.three_points_quadratic + (Point.get_coord p) + (Point.get_coord @@ get_point' (Array.get path 0)) + (Point.get_coord @@ get_point' (Array.get path 1)) + |> Shapes.Bezier.quadratic_to_cubic + |> Shapes.Bezier.slice 0.5 in - incr counter; - res) in - - match !idx with - | None -> {id; path} - | Some 0 -> - (* Remove the first point *) - let path' = Array.init - ((Array.length path)-1) - ~f:( fun i -> Array.get path (i+1)) in - { id - ; path = path' - } - | Some n when n = (Array.length path) -> - (* Remove the last point *) - let path' = Array.init - ((Array.length path)-1) - ~f:( fun i -> Array.get path i) in - { id - ; path=path' - } - | Some n -> - let path' = Array.init - ((Array.length path)-1) - ~f:(fun i -> - if i < (n-1) then - Array.get path (i) - else if i = (n-1) then - (* We know that the point is not the first nor the last one. - So it is safe to call n-1 or n + 1 point - - We have to rebuild the point and set that - point_(-1).id = point_(+1).id - *) - let previous_p1 = - match Array.get path (i-1) with - | Line (_, p1) -> p1 - | Curve c -> c.p1 - in - - match Array.get path (i+1) with - | Line (_, p1) -> Line (previous_p1, p1) - | Curve c -> Curve {c with p0 = previous_p1} - - else - Array.get path (i+1) - ) in - { id - ; path=path'} - - let update - : t -> path array -> t - = fun {id; _} path -> {id; path} - + Array.set path 0 + (Curve + { p0 = p0 + ; ctrl0 = bezier'.Shapes.Bezier.ctrl0 + ; ctrl1 = bezier'.Shapes.Bezier.ctrl1 + ; p1 + }); + Some {id; path} + end end diff --git a/path/fixed.mli b/path/fixed.mli index 06b3539..2daadb4 100755 --- a/path/fixed.mli +++ b/path/fixed.mli @@ -6,6 +6,8 @@ module type P = sig val id : t -> int + val copy : t -> Gg.v2 -> t + end module Make(Point:P) : sig @@ -32,6 +34,8 @@ module Make(Point:P) : sig val repr : t -> (module Repr.M with type t = Point.t and type repr = 's) -> 's -> 's + (** Structure to represent all the required information for evaluating the + distance between a point and a path *) type approx = { distance : float ; closest_point : Gg.v2 @@ -44,27 +48,38 @@ module Make(Point:P) : sig val distance : Gg.v2 -> t -> approx option + (** Iterate over a path *) val iter : t -> f:(Point.t -> unit) -> unit - val map_point + (** Map all the points in the path *) + val map : t -> (Point.t -> Point.t) -> t + (** Reevaluate all the control points on the path in order to get a smooth + curve *) + val rebuild + : t -> t option + + (** Delete a point in the path. + + Reconnect the path without the point removed, and reevaluate all the + control points from the nodes + + return None if the point is not present in the curve + *) val remove_point - : t -> Point.t -> t + : t -> Point.t -> t option - type bezier = - { p0:Point.t (* The starting point *) - ; p1:Point.t (* The end point *) - ; ctrl0:Gg.v2 (* The control point *) - ; ctrl1:Gg.v2 } (* The control point *) + (** Replace a point by the given one. - type path = - | Line of Point.t * Point.t - | Curve of bezier + An existing point with the same id shall be present in the path. - val path : t -> path array + The path is not fully evaluated, and rebuild shall be runned in order to + get the path completely smooth. - val update : t -> path array -> t + *) + val replace_point + : t -> Point.t -> t option end 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