diff options
author | Sébastien Dailly <sebastien@chimrod.com> | 2021-01-10 14:45:24 +0100 |
---|---|---|
committer | Sébastien Dailly <sebastien@chimrod.com> | 2021-01-11 13:55:42 +0100 |
commit | 143994822a98df2afe14431f879b90d5e3a7922c (patch) | |
tree | aa4d3f5ad0a3aa4ccde067db041f5fa79ea84ae5 /path | |
parent | 329b774e315b41bc0d5b7daf8737222768c8d1f3 (diff) |
Update Fixed internal
Diffstat (limited to 'path')
-rwxr-xr-x | path/fixed.ml | 254 |
1 files changed, 142 insertions, 112 deletions
diff --git a/path/fixed.ml b/path/fixed.ml index d9abcb5..0a9eace 100755 --- a/path/fixed.ml +++ b/path/fixed.ml @@ -15,8 +15,7 @@ end module Make(Point:P) = struct type bezier = - { p0:Point.t (* The starting point *) - ; p1:Point.t (* The end point *) + { p1:Point.t (* The end point *) ; ctrl0:Gg.v2 (* The control point *) ; ctrl1:Gg.v2 } (* The control point *) @@ -28,12 +27,18 @@ module Make(Point:P) = struct end type path = - | Line of Point.t * Point.t + | Line of Point.t | Curve of bezier + + type step = + { point : Point.t + ; move : path + } + type t = { id: int - ; path : path array } + ; path : step array } let id : t -> int @@ -42,7 +47,7 @@ module Make(Point:P) = struct module ToFixed = struct type t = Point.t - type repr = int * path list + type repr = int * step list let create_path () = 0, [] @@ -55,23 +60,26 @@ module Make(Point:P) = struct : t -> t -> repr -> repr = fun p1 p2 (i, t) -> ( i + 1 - , Line (p1, p2)::t) + , { point = p1 + ; move = Line p2 + }:: t ) let quadratic_to : (t * Gg.v2 * Gg.v2 * t) -> repr -> repr = fun (p0, ctrl0, ctrl1, p1) (i, t) -> let curve = Curve - { p0 - ; ctrl0 + { ctrl0 ; ctrl1 ; p1} in ( i + 1 - , curve::t) + , { point = p0 + ; move = curve + } ::t) let stop t = t let get - : int * path list -> path array + : int * step list -> step array = fun (n, t) -> (* The array is initialized with a magic number, and just after @@ -97,9 +105,9 @@ module Make(Point:P) = struct let repr : t -> (module Repr.M with type t = Point.t and type repr = 's) -> 's -> 's = fun (type s) {path; _} (module Repr : Repr.M with type t = Point.t and type repr = s) repr -> - let repr_bezier p bezier = + let repr_bezier p p0 bezier = Repr.quadratic_to - ( bezier.p0 + ( p0 , bezier.ctrl0 , bezier.ctrl1 , bezier.p1 ) @@ -108,21 +116,21 @@ module Make(Point:P) = struct let _, repr = Array.fold_left path ~init:(true, repr) ~f:(fun (first, path) element -> - match element with - | Line (p0, p1) -> + match element.move with + | Line p1 -> let path = if first then - Repr.start p0 path + Repr.start element.point path else path in ( false - , Repr.line_to p0 p1 path ) + , Repr.line_to element.point p1 path ) | Curve bezier -> let path = if first then - Repr.start bezier.p0 path + Repr.start element.point path else path in ( false - , repr_bezier path bezier ) + , repr_bezier path element.point bezier ) ) in Repr.stop repr @@ -138,13 +146,14 @@ module Make(Point:P) = struct None if the point is out of the curve *) let distance : Gg.v2 -> t -> approx option - = fun point beziers -> + = fun point path -> - Array.fold_left beziers.path + Array.fold_left path.path ~init:None - ~f:(fun res -> function - | Line (p0, p1) -> - let box = Gg.Box2.of_pts (Point.get_coord p0) (Point.get_coord p1) in + ~f:(fun res step -> + match step.move with + | Line p1 -> + let box = Gg.Box2.of_pts (Point.get_coord step.point) (Point.get_coord p1) in begin match Gg.Box2.mem point box with | false -> res | true -> @@ -155,7 +164,7 @@ module Make(Point:P) = struct let bezier' = Shapes.Bezier.( - { p0 = Point.get_coord bezier.p0 + { p0 = Point.get_coord step.point ; p1 = Point.get_coord bezier.p1 ; ctrl0 = bezier.ctrl0 ; ctrl1 = bezier.ctrl1 } @@ -167,7 +176,7 @@ module Make(Point:P) = struct | _ -> Some { closest_point = point' ; distance = distance' - ; p0 = bezier.p0 + ; p0 = step.point ; p1 = bezier.p1 ; ratio } ) @@ -176,9 +185,16 @@ module Make(Point:P) = struct : t -> (Point.t -> Point.t) -> t = fun {id; path} f -> let path = Array.map path - ~f:(function - | Line (p1, p2) -> Line (f p1, f p2) - | Curve bezier -> Curve {bezier with p0 = f bezier.p0 ; p1 = f bezier.p1} + ~f:(fun step -> + match step.move with + | Line p2 -> + { point = f step.point + ; move = Line (f p2) + } + | Curve bezier -> + let point = f step.point in + { point + ; move = Curve {bezier with p1 = f bezier.p1} } ) in {id; path} @@ -186,37 +202,39 @@ module Make(Point:P) = struct : t -> f:(Point.t -> unit) -> unit = fun {path; _} ~f -> Array.iter path - ~f:(function - | Line (p1, p2) -> f p1; f p2 - | Curve bezier -> f bezier.p0 ; f bezier.p1 + ~f:(fun step -> + match step.move with + | Line p2 -> f step.point; f p2 + | Curve bezier -> f step.point ; f bezier.p1 ) let get_point' - : path -> Point.t - = function - | Line (_, p1) -> p1 + : step -> Point.t + = fun { move ; _} -> + match move with + | Line p1 -> p1 | Curve bezier -> bezier.p1 let first_point' - : path -> Point.t - = function - | Line (p0, _) -> p0 - | Curve bezier -> bezier.p0 + : step -> Point.t + = fun {point; _} -> point (** 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 + : Shapes.Bezier.t -> step -> step + = fun bezier step -> + match step.move with + | Line p1 + | Curve {p1; _} -> + let p0' = Point.copy step.point 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 - } + { point = p0' + ; move = Curve + { p1 = p1' + ; ctrl0 = bezier.Shapes.Bezier.ctrl0 + ; ctrl1 = bezier.Shapes.Bezier.ctrl1 + } + } let build_from_three_points id p0 p1 p2 = @@ -240,14 +258,17 @@ module Make(Point:P) = struct { 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' } |] + [| { point = p0' + ; move = + Curve { ctrl0 = b0.Shapes.Bezier.ctrl0 + ; ctrl1 = b0.Shapes.Bezier.ctrl1 + ; p1 = p1' + } } + ; { point = p1' + ; move = Curve { ctrl0 = b1.Shapes.Bezier.ctrl0 + ; ctrl1 = b1.Shapes.Bezier.ctrl1 + ; p1 = p2' } + } |] } (** Rebuild the whole curve by evaluating all the points *) @@ -258,10 +279,15 @@ module Make(Point:P) = struct 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)|]} + let step = Array.get path 0 in + begin match step.move with + | Curve {p1; _} + | Line p1 -> + Some + { id + ; path= [| + { point = step.point + ; move = Line p1 } |]} end | 2 -> let p0 = first_point' @@ Array.get path 0 @@ -290,31 +316,33 @@ module Make(Point:P) = struct 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 find_pt_index + : Point.t -> step array -> int option + = fun 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.move with + | Line p1 + | Curve {p1;_} -> + if (Point.id element.point) = (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 option @@ -334,7 +362,8 @@ module Make(Point:P) = struct | p0::p1::[] -> Some { id - ; path=[|Line (p0, p1)|]} + ; path = [| { point = p0 + ; move = Line p1 }|]} | _ -> None end | l -> @@ -362,15 +391,15 @@ module Make(Point:P) = struct 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 + let p0 = first_point' (Array.get path i) in - match Array.get path (i+1) with - | Line (_, p1) -> Line (p0, p1) - | Curve c -> Curve {c with p0} + match (Array.get path (i+1)).move with + | Line p1 -> + { point = p0 + ; move = Line p1 } + | Curve c -> + { point = p0 + ; move = Curve c } else Array.get path (i+1) @@ -393,12 +422,16 @@ module Make(Point:P) = struct 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 + let step = Array.get path 0 in + begin match step.move with + | Curve {p1; _} + | Line p1 -> + let p0 = if (Point.id step.point = Point.id p) then p else step.point and p1 = if (Point.id p1 = Point.id p) then p else p1 in - Some {id; path=[|Line (p0, p1)|]} + Some {id; path=[| + { point = p0 + ; move = Line p1 } + |]} end | 2 -> @@ -421,13 +454,9 @@ module Make(Point:P) = struct let p0, p1 = if n < Array.length path then - match (Array.get path n) with - | Line (_, p1) -> p, p1 - | Curve bezier -> p, bezier.p1 + p, get_point' (Array.get path n) else - match (Array.get path (n-1)) with - | Line (p0, _) -> p0, p - | Curve bezier -> bezier.p0, p + first_point' (Array.get path (n -1)), p in let min_idx = max (n-3) 0 in @@ -465,12 +494,13 @@ module Make(Point:P) = struct |> Shapes.Bezier.slice 0.5 in Array.set path 0 - (Curve - { p0 = p0 - ; ctrl0 = bezier'.Shapes.Bezier.ctrl0 - ; ctrl1 = bezier'.Shapes.Bezier.ctrl1 - ; p1 - }); + { point = p0 + ; move = (Curve + { ctrl0 = bezier'.Shapes.Bezier.ctrl0 + ; ctrl1 = bezier'.Shapes.Bezier.ctrl1 + ; p1 + }) + }; Some {id; path} end end |