diff options
Diffstat (limited to 'path')
| -rwxr-xr-x | path/fixed.ml | 188 | ||||
| -rwxr-xr-x | path/fixed.mli | 4 |
2 files changed, 84 insertions, 108 deletions
diff --git a/path/fixed.ml b/path/fixed.ml index 2eda3c1..d61bb0a 100755 --- a/path/fixed.ml +++ b/path/fixed.ml @@ -37,14 +37,7 @@ module Make(Point:P) = struct ; move : path } - type t = - { id: int - ; path : step array - } - - let id - : t -> int - = fun {id; _} -> id + type t = step array module ToFixed = struct type point = Point.t @@ -93,20 +86,15 @@ module Make(Point:P) = struct res end - let internal_id = ref 0 - let to_fixed : (module BUILDER with type t = 'a) -> 'a -> t = fun (type s) (module Builder: BUILDER with type t = s) t -> - incr internal_id; - { id = !internal_id - ; path = Builder.repr t (module ToFixed) (ToFixed.create_path ()) - |> ToFixed.get - } + Builder.repr t (module ToFixed) (ToFixed.create_path ()) + |> ToFixed.get let repr : t -> (module Repr.M with type point = Point.t and type t = 's) -> 's -> 's - = fun (type s) {path; _} (module Repr : Repr.M with type point = Point.t and type t = s) repr -> + = fun (type s) t (module Repr : Repr.M with type point = Point.t and type t = s) repr -> let repr_bezier p p0 bezier = Repr.quadratic_to ( p0 @@ -115,7 +103,7 @@ module Make(Point:P) = struct , bezier.p1 ) p in - let _, repr = Array.fold_left path + let _, repr = Array.fold_left t ~init:(true, repr) ~f:(fun (first, path) element -> let path = if first then @@ -143,9 +131,9 @@ module Make(Point:P) = struct None if the point is out of the curve *) let distance : Gg.v2 -> t -> approx option - = fun point path -> + = fun point t -> - Array.fold_left path.path + Array.fold_left t ~init:None ~f:(fun res step -> match step.move with @@ -180,25 +168,24 @@ module Make(Point:P) = struct let map : t -> (Point.t -> Point.t) -> t - = fun {id; path} f -> - let path = Array.map path - ~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} + = fun t f -> + Array.map t + ~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} } + ) let iter : t -> f:(Point.t -> unit) -> unit - = fun {path; _} ~f -> - Array.iter path + = fun t ~f -> + Array.iter t ~f:(fun step -> match step.move with | Line p2 -> f step.point; f p2 @@ -230,7 +217,7 @@ module Make(Point:P) = struct } - let build_from_three_points id p0 p1 p2 = + let build_from_three_points p0 p1 p2 = let bezier = Shapes.Bezier.quadratic_to_cubic @@ Shapes.Bezier.three_points_quadratic @@ -249,52 +236,48 @@ module Make(Point:P) = struct and p1' = Point.copy p1 b0.Shapes.Bezier.p1 and p2' = Point.copy p2 b1.Shapes.Bezier.p1 in - { id - ; path = - [| { 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' } - } |] - } + [| { 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 *) let rebuild : t -> t option - = fun {id ; path} -> + = fun t -> - match Array.length path with + match Array.length t with | 0 -> None | 1 -> - let step = Array.get path 0 in + let step = Array.get t 0 in begin match step.move with | Curve {p1; _} | Line p1 -> Some - { id - ; path= [| - { point = step.point - ; move = Line p1 } |]} + [| + { point = step.point + ; move = Line p1 } |] end | 2 -> - let p0 = (Array.get path 0).point - and p1 = (Array.get path 1).point - and p2 = get_point' @@ Array.get path 1 in - Some (build_from_three_points id p0 p1 p2) + let p0 = (Array.get t 0).point + and p1 = (Array.get t 1).point + and p2 = get_point' @@ Array.get t 1 in + Some (build_from_three_points 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 @@ (Array.get path 0).point in + ~len:((Array.length t) ) + ~f:(fun i -> Point.get_coord @@ get_point' (Array.get t i)) in + let p0 = Point.get_coord @@ (Array.get t 0).point in let points = p0::points in @@ -305,8 +288,8 @@ module Make(Point:P) = struct (* 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} + let rebuilded = Array.map2 beziers t ~f:assoc_point in + Some rebuilded end let find_pt_index @@ -338,44 +321,43 @@ module Make(Point:P) = struct let remove_point : t -> Point.t -> t option - = fun {id; path} point -> + = fun t point -> - match Array.length path with + match Array.length t with | 0 | 1 -> None | 2 -> (* Two segment, we get the points and transform this into a single line *) - let p0 = (Array.get path 0).point - and p1 = (Array.get path 1).point - and p2 = get_point' @@ Array.get path 1 in + let p0 = (Array.get t 0).point + and p1 = (Array.get t 1).point + and p2 = get_point' @@ Array.get t 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 = [| { point = p0 - ; move = Line p1 }|]} + [| { point = p0 + ; move = Line p1 }|] | _ -> None end | l -> - match find_pt_index point path with - | None -> Some {id; path} + match find_pt_index point t with + | None -> Some t | 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) -> + ~f:( fun i -> Array.get t (i+1)) in + Some path + | Some n when n = (Array.length t) -> (* Remove the last point *) let path = Array.init (l-1) - ~f:( fun i -> Array.get path i) in - Some { id ; path } + ~f:( fun i -> Array.get t i) in + Some path | Some n -> let path' = Array.init (l-1) ~f:(fun i -> if i < (n-1) then - Array.get path (i) + Array.get t (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 @@ -383,9 +365,9 @@ module Make(Point:P) = struct We have to rebuild the point and set that point_(-1).id = point_(+1).id *) - let p0 = (Array.get path i).point in + let p0 = (Array.get t i).point in - match (Array.get path (i+1)).move with + match (Array.get t (i+1)).move with | Line p1 -> { point = p0 ; move = Line p1 } @@ -394,11 +376,9 @@ module Make(Point:P) = struct ; move = Curve c } else - Array.get path (i+1) + Array.get t (i+1) ) in - rebuild - { id - ; path=path'} + rebuild path' let first_point : step -> Point.t @@ -406,46 +386,46 @@ module Make(Point:P) = struct let replace_point : t -> Point.t -> t option - = fun {id; path } p -> + = fun t p -> let add_path paths idx f points = if 0 <= idx && idx < Array.length paths then - let path = Array.get path idx in + let path = Array.get t idx in Point.get_coord (f path) :: points else points in - match Array.length path with + match Array.length t with | 0 -> None | 1 -> (* Only one point, easy ? *) - let step = Array.get path 0 in + let step = Array.get t 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=[| - { point = p0 - ; move = Line p1 } - |]} + Some [| + { point = p0 + ; move = Line p1 } + |] end | 2 -> - let p0 = (Array.get path 0).point - and p1 = (Array.get path 1).point - and p2 = get_point' @@ Array.get path 1 in + let p0 = (Array.get t 0).point + and p1 = (Array.get t 1).point + and p2 = get_point' @@ Array.get t 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) + Some (build_from_three_points p0 p1 p2) (* More than two segmend, it is ok for a partial reevaluation *) | _ -> - match find_pt_index p path with + match find_pt_index p t with | None -> None | Some n -> - let path = Array.copy path in + let path = Array.copy t in let p0, p1 = @@ -480,7 +460,7 @@ module Make(Point:P) = struct 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} + Some path | Error _ -> let bezier', _ = Shapes.Bezier.three_points_quadratic (Point.get_coord p) @@ -497,6 +477,6 @@ module Make(Point:P) = struct ; p1 }) }; - Some {id; path} + Some path end end diff --git a/path/fixed.mli b/path/fixed.mli index 862409b..111187c 100755 --- a/path/fixed.mli +++ b/path/fixed.mli @@ -22,10 +22,6 @@ module Make(Point:P) : sig type t - (** Return the identifier for this path *) - val id - : t -> int - (** Create a path from a builder *) val to_fixed : (module BUILDER with type t = 'a) -> 'a -> t |