aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSébastien Dailly <sebastien@chimrod.com>2021-01-10 14:45:24 +0100
committerSébastien Dailly <sebastien@chimrod.com>2021-01-11 13:55:42 +0100
commit143994822a98df2afe14431f879b90d5e3a7922c (patch)
treeaa4d3f5ad0a3aa4ccde067db041f5fa79ea84ae5
parent329b774e315b41bc0d5b7daf8737222768c8d1f3 (diff)
Update Fixed internal
-rwxr-xr-xpath/fixed.ml254
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