summaryrefslogtreecommitdiff
path: root/path
diff options
context:
space:
mode:
authorSébastien Dailly <sebastien@chimrod.com>2021-01-07 21:54:46 +0100
committerSébastien Dailly <sebastien@chimrod.com>2021-01-09 06:27:18 +0100
commit32618a5ce8e2b306af102e4c16711b090c36b840 (patch)
tree1c22b5bcf9f29e9ff0118cfa9aedd6fb05c9ab0f /path
parent6e5c6bf7beadc72e64e5d929e301b473b01c9303 (diff)
Allow point movement
Diffstat (limited to 'path')
-rwxr-xr-xpath/builder.ml29
-rwxr-xr-xpath/fixed.ml360
-rwxr-xr-xpath/fixed.mli39
3 files changed, 325 insertions, 103 deletions
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