diff options
Diffstat (limited to 'script.it/state')
| -rwxr-xr-x | script.it/state/dune | 2 | ||||
| -rwxr-xr-x | script.it/state/selection.ml | 85 | ||||
| -rwxr-xr-x | script.it/state/selection.mli | 18 | ||||
| -rwxr-xr-x | script.it/state/state.ml | 41 |
4 files changed, 68 insertions, 78 deletions
diff --git a/script.it/state/dune b/script.it/state/dune index 7d4ef3f..d838c04 100755 --- a/script.it/state/dune +++ b/script.it/state/dune @@ -8,6 +8,6 @@ worker_messages outline layer - path + script_path ) ) diff --git a/script.it/state/selection.ml b/script.it/state/selection.ml index f5f135a..3590a98 100755 --- a/script.it/state/selection.ml +++ b/script.it/state/selection.ml @@ -1,4 +1,5 @@ open StdLabels +module Path = Script_path type 'a selection = | Path of 'a @@ -6,59 +7,55 @@ type 'a selection = type t = int selection -let find_selection - : int selection -> Outline.t list -> Outline.t selection option - = fun selection paths -> - match selection with - | Path id -> Option.map (fun p -> Path p) (Outline.find paths id) - | Point (id, pt) -> Option.map (fun p -> Point (p, pt)) (Outline.find paths id) +let find_selection : + int selection -> Outline.t list -> Outline.t selection option = + fun selection paths -> + match selection with + | Path id -> Option.map (fun p -> Path p) (Outline.find paths id) + | Point (id, pt) -> + Option.map (fun p -> Point (p, pt)) (Outline.find paths id) + let threshold = 20. -let get_from_paths - : (float * float) -> Outline.t list -> float * (Gg.v2 * Outline.t * Path.Point.t * Path.Point.t) option - = fun position outlines -> - let point = Gg.V2.of_tuple position in - (* If the user click on a curve, select it *) - List.fold_left outlines - ~init:(threshold, None) - ~f:(fun (dist, selection) outline -> - match Path.Fixed.distance point outline.Outline.path with - | Some { closest_point ; distance; p0; p1 ; ratio} when distance < dist -> - ratio, Some (closest_point, outline, p0, p1) - | _ -> dist, selection - ) +let get_from_paths : + float * float + -> Outline.t list + -> float * (Gg.v2 * Outline.t * Path.Point.t * Path.Point.t) option = + fun position outlines -> + let point = Gg.V2.of_tuple position in + (* If the user click on a curve, select it *) + List.fold_left + outlines + ~init:(threshold, None) + ~f:(fun (dist, selection) outline -> + match Path.Fixed.distance point outline.Outline.path with + | Some { closest_point; distance; p0; p1; ratio } when distance < dist -> + (ratio, Some (closest_point, outline, p0, p1)) + | _ -> (dist, selection) ) -let select_path - : Outline.t -> t - = fun outline -> Path outline.Outline.id -let select_point - : Outline.t -> Gg.v2 -> t - = fun outline v2_point -> +let select_path : Outline.t -> t = fun outline -> Path outline.Outline.id - let point' = ref None in - let dist = ref threshold in +let select_point : Outline.t -> Gg.v2 -> t = + fun outline v2_point -> + let point' = ref None in + let dist = ref threshold in - Path.Fixed.iter - outline.Outline.path - ~f:(fun p -> - let open Gg.V2 in - let new_dist = norm ((Path.Point.get_coord p) - v2_point) in - match (new_dist < !dist) with - | false -> () - | true -> - dist:= new_dist; - point' := Some p - ); + Path.Fixed.iter outline.Outline.path ~f:(fun p -> + let open Gg.V2 in + let new_dist = norm (Path.Point.get_coord p - v2_point) in + match new_dist < !dist with + | false -> () + | true -> + dist := new_dist; + point' := Some p ); - match !point' with - | Some point -> - Point (outline.Outline.id, point) - | None -> - Path (outline.Outline.id) + match !point' with + | Some point -> Point (outline.Outline.id, point) + | None -> Path outline.Outline.id - (* +(* (* 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 diff --git a/script.it/state/selection.mli b/script.it/state/selection.mli index 9792a2d..2020dab 100755 --- a/script.it/state/selection.mli +++ b/script.it/state/selection.mli @@ -1,3 +1,5 @@ +module Path = Script_path + type 'a selection = | Path of 'a | Point of ('a * Path.Point.t) @@ -6,6 +8,10 @@ type t = int selection val threshold : float +val get_from_paths : + float * float + -> Outline.t list + -> float * (Gg.v2 * Outline.t * Path.Point.t * Path.Point.t) option (** Return the closest path from the list to a given point. The path is returned with all thoses informations : @@ -15,19 +21,15 @@ val threshold : float - The end point in the path *) -val get_from_paths - : (float * float) -> Outline.t list -> float * (Gg.v2 * Outline.t * Path.Point.t * Path.Point.t) option -val select_path - : Outline.t -> t +val select_path : Outline.t -> t +val select_point : Outline.t -> Gg.v2 -> t (** Check for selecting a point on the given outline. If no point is available, select the path. *) -val select_point - : Outline.t -> Gg.v2 -> t -val find_selection - : int selection -> Outline.t list -> Outline.t selection option +val find_selection : + int selection -> Outline.t list -> Outline.t selection option diff --git a/script.it/state/state.ml b/script.it/state/state.ml index f3be91d..6c48979 100755 --- a/script.it/state/state.ml +++ b/script.it/state/state.ml @@ -1,3 +1,5 @@ +module Path = Script_path + type mode = | Edit | Selection of Selection.t @@ -19,48 +21,37 @@ type state = ; mouse_down_position : Gg.v2 } -include Application.Make(struct type t = state end) +include Application.Make (struct + type t = state +end) + +let post : Brr_webworkers.Worker.t -> Worker_messages.to_worker -> unit = + Brr_webworkers.Worker.post -let post - : Brr_webworkers.Worker.t -> Worker_messages.to_worker -> unit - = Brr_webworkers.Worker.post let insert_or_replace state ((x, y) as p) stamp path = let width = state.width and angle = state.angle in let point = Path.Point.create ~x ~y ~angle ~width ~stamp in match Path.Path_Builder.peek path with - | None -> - Path.Path_Builder.add_point - point - path + | None -> Path.Path_Builder.add_point point path | Some p1 -> - let open Gg.V2 in + let open Gg.V2 in + let p1' = Path.Point.get_coord p1 in - let p1' = Path.Point.get_coord p1 in + let dist = norm (p1' - of_tuple p) in + if dist < 5. then path else Path.Path_Builder.add_point point path - let dist = (norm (p1' - (of_tuple p))) in - if dist < 5. then ( - path - ) else ( - Path.Path_Builder.add_point - point - path - ) (** Select the given segment, and modify angle and width accordingly *) let select_segment _ (_, selected, p0, p1) state dist = - let point' = Path.Point.mix dist (Path.Point.get_coord p0) p0 p1 in - let angle = (Float.round @@ 10. *. Path.Point.get_angle point') /. 10. - and width = (Float.round @@ 10. *. Path.Point.get_width point') /. 10. in + let angle = (Float.round @@ (10. *. Path.Point.get_angle point')) /. 10. + and width = (Float.round @@ (10. *. Path.Point.get_width point')) /. 10. in let id = Selection.select_path selected in - { state with - mode = (Selection id) - ; angle - ; width } + { state with mode = Selection id; angle; width } let init = |