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 --- path/builder.ml | 29 +++-- path/fixed.ml | 360 +++++++++++++++++++++++++++++++++++++++++++------------- path/fixed.mli | 39 ++++-- 3 files changed, 325 insertions(+), 103 deletions(-) (limited to '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 -- cgit v1.2.3