From 21c386fee208adb7b494d2677d9f49ed49a1c1ce Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Thu, 7 Jan 2021 14:20:54 +0100 Subject: Local point configuration --- path/fixed.ml | 57 ++++++++++++++++++++++++++++++++++++++------------------- path/fixed.mli | 3 ++- path/point.ml | 18 ++++++++++++++++-- path/point.mli | 11 +++++++++++ 4 files changed, 67 insertions(+), 22 deletions(-) (limited to 'path') diff --git a/path/fixed.ml b/path/fixed.ml index cb2c27f..2d42566 100755 --- a/path/fixed.ml +++ b/path/fixed.ml @@ -6,6 +6,8 @@ module type P = sig val get_coord : t -> Gg.v2 + val id : t -> int + end module Make(Point:P) = struct @@ -24,7 +26,6 @@ module Make(Point:P) = struct ; ctrl1:Gg.v2 } (* The control point *) type path = - | Empty | Line of Point.t * Point.t | Curve of bezier @@ -74,7 +75,8 @@ module Make(Point:P) = struct let get : int * path list -> path array = fun (n, t) -> - let res = Array.make n Empty in + + let res = Obj.magic (Array.make n 0) in List.iteri t ~f:(fun i elem -> Array.set res (n - i - 1) elem ); res @@ -106,7 +108,6 @@ module Make(Point:P) = struct ~init:(true, repr) ~f:(fun (first, path) element -> match element with - | Empty -> (true, path) | Line (p0, p1) -> let path = if first then @@ -133,7 +134,6 @@ module Make(Point:P) = struct 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 @@ -164,7 +164,6 @@ module Make(Point:P) = struct = 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 @@ -175,7 +174,6 @@ module Make(Point:P) = struct = fun {path; _} ~f -> Array.iter path ~f:(function - | Empty -> () | Line (p1, p2) -> f p1; f p2 | Curve bezier -> f bezier.p0 ; f bezier.p1 ) @@ -193,14 +191,13 @@ module Make(Point:P) = struct ~f:(fun element -> let res = match element with - | Empty -> false | Line (p0, p1) | Curve {p0;p1;_} -> - if p0 = point then ( + if (Point.id p0) = (Point.id point) then ( idx := Some (!counter) ; true - ) else if p1 = point then ( - idx := Some (!counter +1) ; + ) else if (Point.id p1) = (Point.id point) then ( + idx := Some (!counter+1) ; true ) else false @@ -213,25 +210,47 @@ module Make(Point:P) = struct | Some 0 -> (* Remove the first point *) let path' = Array.init - ((Array.length path) -1) - ~f:( fun i -> Array.get path (i + 1)) in - {id; path=path'} + ((Array.length path)-1) + ~f:( fun i -> Array.get path (i+1)) in + { id + ; path = path' + } | Some n when n = (Array.length path) -> (* Remove the last point *) let path' = Array.init - ((Array.length path) -1) + ((Array.length path)-1) ~f:( fun i -> Array.get path i) in - {id; path=path'} + { id + ; path=path' + } | Some n -> let path' = Array.init - ((Array.length path) -1) + ((Array.length path)-1) ~f:(fun i -> - if i < (n -1) then + if i < (n-1) then Array.get path (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 + + We have to rebuild the point and set that + point_(-1).id = point_(+1).id + *) + let previous_p1 = + match Array.get path (i-1) with + | Line (_, p1) -> p1 + | Curve c -> c.p1 + in + + match Array.get path (i+1) with + | Line (_, p1) -> Line (previous_p1, p1) + | Curve c -> Curve {c with p0 = previous_p1} + else - Array.get path (i +1) + Array.get path (i+1) ) in - {id; path=path'} + { id + ; path=path'} let update : t -> path array -> t diff --git a/path/fixed.mli b/path/fixed.mli index f91ffc6..1f12006 100755 --- a/path/fixed.mli +++ b/path/fixed.mli @@ -4,6 +4,8 @@ module type P = sig val get_coord : t -> Gg.v2 + val id : t -> int + end module Make(Point:P) : sig @@ -51,7 +53,6 @@ module Make(Point:P) : sig ; ctrl1:Gg.v2 } (* The control point *) type path = - | Empty | Line of Point.t * Point.t | Curve of bezier diff --git a/path/point.ml b/path/point.ml index d49d655..4c34899 100755 --- a/path/point.ml +++ b/path/point.ml @@ -1,8 +1,11 @@ +let internal_id = ref 0 + type t = { p: Gg.v2 ; size : float ; angle: float ; stamp : float + ; id : int } let empty = @@ -10,17 +13,23 @@ let empty = ; size = 0. ; angle = 0. ; stamp = 0. + ; id = 0 } let create ~angle ~width ~stamp ~x ~y = + + incr internal_id; { p = Gg.V2.v x y ; size = width ; angle = Gg.Float.rad_of_deg (180. -. angle ) ; stamp + ; id = !internal_id } let copy point p = - { point with p } + { point with + p + } let set_angle p angle = { p with angle = Gg.Float.rad_of_deg (180. -. angle) } @@ -49,6 +58,7 @@ let get_coord' let mix : float -> Gg.v2 -> t -> t -> t = fun f point p0 p1 -> + incr internal_id; let angle0 = p0.angle and angle1 = p1.angle and width0 = get_width p0 @@ -61,4 +71,8 @@ let mix { p = point ; size = width ; angle - ; stamp } + ; stamp + ; id = !internal_id + } + +let id { id; _} = id diff --git a/path/point.mli b/path/point.mli index fab42d2..fe4cb45 100755 --- a/path/point.mli +++ b/path/point.mli @@ -1,5 +1,9 @@ type t +(** Return the point id. Each id is unique *) +val id + : t -> int + val empty : t val (+): t -> Gg.v2 -> t @@ -10,6 +14,12 @@ val get_stamp : t -> float val create: angle:float -> width:float -> stamp:float -> x:float -> y:float -> t +(** Return a copy of the point at given posistion + + This is a true copy, the id will be the same for the two points + TODO : Should this be renamed set_position ? + +*) val copy : t -> Gg.v2 -> t val set_angle : t -> float -> t @@ -27,3 +37,4 @@ val get_coord' characteristics from p0 and p1 *) val mix : float -> Gg.v2 -> t -> t -> t + -- cgit v1.2.3