aboutsummaryrefslogtreecommitdiff
path: root/path/builder.ml
diff options
context:
space:
mode:
authorSébastien Dailly <sebastien@chimrod.com>2020-12-30 11:41:01 +0100
committerSébastien Dailly <sebastien@chimrod.com>2020-12-30 11:41:01 +0100
commite25b7797708c19cbaef68c14ebef8738de44c2d9 (patch)
tree6d778a7bca390c496ee95cfb337f2f26fe0aa5c3 /path/builder.ml
parentfae31bdb659b4b14322136e045ea565d38bbd04f (diff)
Refactor
Diffstat (limited to 'path/builder.ml')
-rwxr-xr-xpath/builder.ml185
1 files changed, 9 insertions, 176 deletions
diff --git a/path/builder.ml b/path/builder.ml
index 39ff75e..bcad493 100755
--- a/path/builder.ml
+++ b/path/builder.ml
@@ -43,15 +43,6 @@ module Make(Point:P) = struct
type t = Point.t list * bezier list
- type path =
- | Empty
- | Line of Point.t * Point.t
- | Curve of bezier
-
- type fixedPath =
- { id: int
- ; path : path array }
-
let get_new_segment connexion0 p5 p4 p3 p2 p1 =
let p5' = Point.get_coord p5
and p4' = Point.get_coord p4
@@ -70,7 +61,7 @@ module Make(Point:P) = struct
let empty = ([], [])
let add_point
- : Point.t -> t -> t * fixedPath option
+ : Point.t -> t -> t
= fun lastPoint (path, beziers) ->
let (let*) v f =
match v with
@@ -78,11 +69,9 @@ module Make(Point:P) = struct
if Array.length bezier > 0 then
f (Array.get bezier 0)
else
- ( (lastPoint::path, beziers)
- , None )
+ (lastPoint::path, beziers)
| _ ->
- ( (lastPoint::path, beziers)
- , None )
+ (lastPoint::path, beziers)
in
let connexion0 = match beziers with
@@ -103,22 +92,19 @@ module Make(Point:P) = struct
(* We remove the last point and add the bezier curve in the list*)
let firsts = lastPoint::p4::p3::p2::[] in
- ( (firsts, bezier_point::beziers)
- , None )
+ (firsts, bezier_point::beziers)
| _ ->
- ( ( lastPoint::path
- , beziers)
- , None )
+ ( lastPoint::path
+ , beziers)
let replace_last
- : Point.t -> t -> t * fixedPath option
+ : Point.t -> t -> t
= fun lastPoint ((path, beziers) as t) ->
match path, beziers with
| _::(tl), beziers ->
- ( ( lastPoint::tl
- , beziers )
- , None )
+ ( lastPoint::tl
+ , beziers )
| _ ->
add_point lastPoint t
@@ -237,157 +223,4 @@ module Make(Point:P) = struct
)
end
- module ToFixed = struct
- type t = Point.t
-
- type 'a repr = int * path list
-
- let create_path () = 0, []
-
- (* Start a new path. *)
- let start point t =
- let _ = point in
- t
-
- let line_to
- : t -> t -> 'a repr -> 'a repr
- = fun p1 p2 (i, t) ->
- ( i + 1
- , Line (p1, p2)::t)
-
-
- let quadratic_to
- : t -> Gg.v2 -> Gg.v2 -> t -> 'a repr -> 'a repr
- = fun p0 ctrl0 ctrl1 p1 (i, t) ->
- let curve = Curve
- { p0
- ; ctrl0
- ; ctrl1
- ; p1} in
- ( i + 1
- , curve::t)
-
-
- let stop t = t
-
- let get
- : int * path list -> path array
- = fun (n, t) ->
- let res = Array.make n Empty in
- List.iteri t
- ~f:(fun i elem -> Array.set res (n - i - 1) elem );
- res
- end
-
- let id = ref 0
- module FixedBuilder = Draw(ToFixed)
- let to_fixed
- : t -> fixedPath
- = fun t ->
- incr id;
- { id = !id
- ; path = FixedBuilder.draw t (ToFixed.create_path ())
- |> ToFixed.get
- }
-
- module DrawFixed(Repr:REPR with type t = Point.t) = struct
-
-
- let repr_bezier p bezier =
- Repr.quadratic_to
- bezier.p0
- bezier.ctrl0
- bezier.ctrl1
- bezier.p1
- p
-
- let draw
- : fixedPath -> 'a Repr.repr -> 'a Repr.repr
- = fun {path; _} repr ->
-
- let _, repr = Array.fold_left path
- ~init:(true, repr)
- ~f:(fun (first, path) element ->
- match element with
- | Empty -> (true, path)
- | Line (p0, p1) ->
-
- let path = if first then
- Repr.start p0 path
- else path in
-
- ( false
- , Repr.line_to p0 p1 path )
- | Curve bezier ->
- let path = if first then
- Repr.start bezier.p0 path
- else path in
- ( false
- , repr_bezier path bezier )
- ) in
- Repr.stop repr
- end
-
- let box
- : bezier -> Gg.box2
- = fun bezier ->
- Gg.Box2.of_pts
- (Point.get_coord bezier.p0)
- (Point.get_coord bezier.p1)
- |> (fun b -> Gg.Box2.add_pt b bezier.ctrl0)
- |> (fun b -> Gg.Box2.add_pt b bezier.ctrl1)
-
- (** Return the distance between a given point and the curve. May return
- None if the point is out of the curve *)
- let distance
- : Gg.v2 -> fixedPath -> float option =
- fun point beziers ->
-
- Array.fold_left beziers.path
- ~init:None
- ~f:(fun res -> function
- | Empty -> None
- | Line (p0, p1) ->
- let box = Gg.Box2.of_pts (Point.get_coord p0) (Point.get_coord p1) in
- begin match Gg.Box2.mem point box with
- | false -> res
- | true ->
- (* TODO Evaluate the normal *)
- res
- end
- | Curve bezier ->
- begin match Gg.Box2.mem point (box bezier) with
- | false -> res
- | true ->
-
- let bezier' = Shapes.Bezier.(
-
- { p0 = Point.get_coord bezier.p0
- ; p1 = Point.get_coord bezier.p1
- ; ctrl0 = bezier.ctrl0
- ; ctrl1 = bezier.ctrl1 }
- ) in
- let _, point' = Shapes.Bezier.get_closest_point point bezier' in
- let distance = Gg.V2.( norm (point - point') ) in
- match res with
- | None -> Some distance
- | Some d -> if d < distance then res else (Some distance)
- end
- )
-
- let id
- : fixedPath -> int
- = fun {id; _} -> id
-
- let map_point
- : fixedPath -> (Point.t -> Point.t) -> fixedPath
- = fun {id; path} f ->
- let path = Array.map path
- ~f:(function
- | Empty -> Empty
- | Line (p1, p2) -> Line (f p1, f p2)
- | Curve bezier -> Curve {bezier with p0 = f bezier.p0 ; p1 = f bezier.p1}
- ) in
- {id; path}
-
end