From a63662059215a26db627c4b76147a3c9338f5b74 Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Wed, 6 Jan 2021 22:09:53 +0100
Subject: Point suppression

---
 script.it/selection.ml | 72 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 72 insertions(+)
 create mode 100755 script.it/selection.ml

(limited to 'script.it/selection.ml')

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
-- 
cgit v1.2.3