aboutsummaryrefslogtreecommitdiff
path: root/script.it/selection.ml
diff options
context:
space:
mode:
Diffstat (limited to 'script.it/selection.ml')
-rwxr-xr-xscript.it/selection.ml72
1 files changed, 72 insertions, 0 deletions
diff --git a/script.it/selection.ml b/script.it/selection.ml
new file mode 100755
index 0000000..e05839b
--- /dev/null
+++ b/script.it/selection.ml
@@ -0,0 +1,72 @@
+open StdLabels
+
+type t =
+ | Path of int
+ | Point of (int * Path.Point.t)
+
+let threshold = 20.
+
+let get_from_paths
+ : (float * float) -> Path.Fixed.t list -> float * (Gg.v2 * Path.Fixed.t * Path.Point.t * Path.Point.t) option
+ = fun position paths ->
+ let point = Gg.V2.of_tuple position in
+ (* If the user click on a curve, select it *)
+ List.fold_left paths
+ ~init:(threshold, None)
+ ~f:(fun (dist, selection) path ->
+ match Path.Fixed.distance point path with
+ | Some (point', p, p0, p1) when p < dist ->
+ dist, Some (point', path, p0, p1)
+ | _ -> dist, selection
+ )
+
+let select_path
+ : Path.Fixed.t -> t
+ = fun path -> Path (Path.Fixed.id path)
+
+let select_point
+ : Path.Fixed.t -> Gg.v2 -> t
+ = fun path v2_point ->
+
+ let point' = ref None in
+
+ Path.Fixed.iter
+ path
+ ~f:(fun p ->
+ let open Gg.V2 in
+ match (norm ((Path.Point.get_coord p) - v2_point) < threshold) with
+ | false -> ()
+ | true -> point' := Some p
+ );
+
+ match !point' with
+ | Some point ->
+ Point (Path.Fixed.id path, point)
+ | None ->
+ (* If the point does not exists, find the exact point on the curve *)
+ let coord = Gg.V2.to_tuple v2_point in
+ begin match get_from_paths coord [path] with
+ | _, None -> Path (Path.Fixed.id path)
+ | f, Some (point, path, p0, p1) ->
+
+ let angle0 = Path.Point.get_angle p0
+ and angle1 = Path.Point.get_angle p1
+ and width0 = Path.Point.get_width p0
+ and width1 = Path.Point.get_width p1
+ and stamp0 = Path.Point.get_stamp p0
+ and stamp1 = Path.Point.get_stamp p1 in
+ let angle = angle0 +. f *. ( angle1 -. angle0 ) in
+ let width = width0 +. f *. ( width1 -. width0 ) in
+ let stamp = stamp0 +. f *. ( stamp1 -. stamp0 ) in
+
+ let x, y = Gg.V2.to_tuple point in
+
+ let point' = Path.Point.create
+ ~angle
+ ~width
+ ~stamp
+ ~x
+ ~y
+ in
+ Point (Path.Fixed.id path, point')
+ end