diff options
| -rwxr-xr-x | path/fixed.ml | 6 | ||||
| -rwxr-xr-x | path/fixed.mli | 5 | ||||
| -rwxr-xr-x | path/point.ml | 17 | ||||
| -rwxr-xr-x | path/point.mli | 5 | ||||
| -rwxr-xr-x | script.it/selection.ml | 32 | ||||
| -rwxr-xr-x | script.it/state.ml | 16 | ||||
| -rwxr-xr-x | script.it/worker.ml | 1 |
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) |