aboutsummaryrefslogtreecommitdiff
path: root/path/fixed.ml
diff options
context:
space:
mode:
authorSébastien Dailly <sebastien@chimrod.com>2021-01-11 11:33:32 +0100
committerSébastien Dailly <sebastien@chimrod.com>2021-01-11 13:55:43 +0100
commit42c3c122c4f53dd68bcdd89411835887c3ae0af9 (patch)
tree856a54955c4bf1648e7f5f1cea809e5601b60c7d /path/fixed.ml
parent979be5f588a1ffd6e1d060cd794e87526d517b7a (diff)
Outline module
Diffstat (limited to 'path/fixed.ml')
-rwxr-xr-xpath/fixed.ml188
1 files changed, 84 insertions, 104 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