aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xpath/fixed.ml6
-rwxr-xr-xpath/fixed.mli5
-rwxr-xr-xpath/point.ml17
-rwxr-xr-xpath/point.mli5
-rwxr-xr-xscript.it/selection.ml32
-rwxr-xr-xscript.it/state.ml16
-rwxr-xr-xscript.it/worker.ml1
7 files changed, 42 insertions, 40 deletions
diff --git a/path/fixed.ml b/path/fixed.ml
index 95a42d5..cb2c27f 100755
--- a/path/fixed.ml
+++ b/path/fixed.ml
@@ -4,13 +4,8 @@ open StdLabels
module type P = sig
type t
- val empty : t
-
val get_coord : t -> Gg.v2
- (** Copy a point and all thoses properties to the given location *)
- val copy : t -> Gg.v2 -> t
-
end
module Make(Point:P) = struct
@@ -185,7 +180,6 @@ module Make(Point:P) = struct
| Curve bezier -> f bezier.p0 ; f bezier.p1
)
-
let remove_point
: t -> Point.t -> t
= fun {id; path} point ->
diff --git a/path/fixed.mli b/path/fixed.mli
index 32f6012..f91ffc6 100755
--- a/path/fixed.mli
+++ b/path/fixed.mli
@@ -2,13 +2,8 @@
module type P = sig
type t
- val empty : t
-
val get_coord : t -> Gg.v2
- (** Copy a point and all thoses properties to the given location *)
- val copy : t -> Gg.v2 -> t
-
end
module Make(Point:P) : sig
diff --git a/path/point.ml b/path/point.ml
index 046c2e7..d49d655 100755
--- a/path/point.ml
+++ b/path/point.ml
@@ -45,3 +45,20 @@ let get_coord'
let open Gg.V2 in
let trans = of_polar @@ v t.size t.angle in
t.p + trans
+
+let mix
+ : float -> Gg.v2 -> t -> t -> t
+ = fun f point p0 p1 ->
+ let angle0 = p0.angle
+ and angle1 = p1.angle
+ and width0 = get_width p0
+ and width1 = get_width p1
+ and stamp0 = get_stamp p0
+ and stamp1 = 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
+ { p = point
+ ; size = width
+ ; angle
+ ; stamp }
diff --git a/path/point.mli b/path/point.mli
index c897195..fab42d2 100755
--- a/path/point.mli
+++ b/path/point.mli
@@ -22,3 +22,8 @@ val get_width: t -> float
val get_coord'
: t -> Gg.v2
+
+(** [mix f point p0 p1] create a new point at the position point, with the
+ characteristics from p0 and p1 *)
+val mix
+ : float -> Gg.v2 -> t -> t -> t
diff --git a/script.it/selection.ml b/script.it/selection.ml
index e05839b..c0360fb 100755
--- a/script.it/selection.ml
+++ b/script.it/selection.ml
@@ -29,44 +29,34 @@ let select_point
= fun path v2_point ->
let point' = ref None in
+ let dist = ref threshold in
Path.Fixed.iter
path
~f:(fun p ->
let open Gg.V2 in
- match (norm ((Path.Point.get_coord p) - v2_point) < threshold) with
+ let new_dist = norm ((Path.Point.get_coord p) - v2_point) in
+ match (new_dist < !dist) with
| false -> ()
- | true -> point' := Some p
+ | true ->
+ dist:= new_dist;
+ point' := Some p
);
match !point' with
| Some point ->
Point (Path.Fixed.id path, point)
| None ->
+ Path (Path.Fixed.id path)
+
+ (*
(* 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
+ let point' = Path.Point.mix f point p0 p1 in
Point (Path.Fixed.id path, point')
end
+ *)
diff --git a/script.it/state.ml b/script.it/state.ml
index f08c3a1..b91c614 100755
--- a/script.it/state.ml
+++ b/script.it/state.ml
@@ -92,13 +92,11 @@ let update_selection id state f =
(** Select the given segment, and modify angle and width accordingly *)
let select_segment _ (_, selected, p0, p1) state dist =
- let angle0 = Path.Point.get_angle p0
- and angle1 = Path.Point.get_angle p1 in
- let width0 = Path.Point.get_width p0
- and width1 = Path.Point.get_width p1 in
- let angle = angle0 +. dist *. ( angle1 -. angle0 ) in
- let width = width0 +. dist *. ( width1 -. width0 ) in
+ let point' = Path.Point.mix dist (Path.Point.get_coord p0) p0 p1 in
+
+ let angle = Path.Point.get_angle point'
+ and width = Path.Point.get_width point' in
let id = Selection.select_path selected in
{ state with
@@ -159,6 +157,9 @@ let do_action
else
(* On the same segment, check for a point *)
let selection = Selection.select_point path (Gg.V2.of_tuple position) in
+
+ (* In order to handle the point move, start the timer *)
+ Elements.Timer.start timer 0.3;
{state with mode= Selection selection}
end
@@ -221,10 +222,9 @@ let do_action
(* Send the job to the worker *)
Brr_webworkers.Worker.post worker (`DeletePoint (id, point, p))
);
- state
+ { state with mode = Selection (Path id) }
| `Export, _ ->
-
let my_host = Uri.host @@ Window.location @@ G.window in
if (Hashtbl.hash my_host) = Blog.Hash_host.expected_host then (
(* Convert the path into an sVG element *)
diff --git a/script.it/worker.ml b/script.it/worker.ml
index e2408b7..e68705a 100755
--- a/script.it/worker.ml
+++ b/script.it/worker.ml
@@ -63,6 +63,7 @@ let execute (command: [> message]) =
rebuild (id, paths)
| `DeletePoint (id, point, path) ->
let path = Path.Fixed.remove_point path point in
+ (* TODO Handle when there are less than 4 points *)
rebuild (id, Path.Fixed.path path)
| any ->
Worker.post_message (`Other any)