aboutsummaryrefslogtreecommitdiff
path: root/state.ml
diff options
context:
space:
mode:
authorSébastien Dailly <sebastien@chimrod.com>2021-01-01 11:08:38 +0100
committerSébastien Dailly <sebastien@chimrod.com>2021-01-01 11:08:38 +0100
commitaf88c8895bba85fe5340b34aafb3dce7650bd01f (patch)
treeee0c9d1bd463242c681c6202a9a57c8110d58f59 /state.ml
parente25b7797708c19cbaef68c14ebef8738de44c2d9 (diff)
Use first type module instead of functors
Diffstat (limited to 'state.ml')
-rwxr-xr-xstate.ml89
1 files changed, 58 insertions, 31 deletions
diff --git a/state.ml b/state.ml
index 35fc2ed..52933f8 100755
--- a/state.ml
+++ b/state.ml
@@ -9,7 +9,7 @@ let timer, tick = Elements.Timer.create ()
type mode =
| Edit
- | Selection of Paths.Fixed.t
+ | Selection of int
| Out
type current = Paths.Path_Builder.t
@@ -69,40 +69,35 @@ let insert_or_replace state ((x, y) as p) path =
path
)
+let threshold = 20.
+
let check_selection
- : (float * float) -> Paths.Fixed.t list -> Paths.Fixed.t option
+ : (float * float) -> Paths.Fixed.t list -> (Gg.v2 * Paths.Fixed.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:None
- ~f:(fun selection path ->
-
- match selection with
- | Some p -> Some p
- | None ->
- (* TODO : Add a method in the point module *)
- begin match Paths.Fixed.distance point path with
- | Some p when p < 20. ->
- Some path
- | _ -> None
- end
- )
+ let _, res = List.fold_left paths
+ ~init:(threshold, None)
+ ~f:(fun (dist, selection) path ->
+ match Paths.Fixed.distance point path with
+ | Some (point', p) when p < dist ->
+ dist, Some (point', path)
+ | _ -> dist, selection
+ ) in
+ res
(** Update the path in the selection with the given function applied to
every point *)
-let update_selection s state f =
- let s = Paths.Fixed.map_point s f
- and id = Paths.Fixed.id s in
+let update_selection id state f =
let paths = List.map state.paths
~f:(fun path ->
let id' = Paths.Fixed.id path in
match id = id' with
| false -> path
- | true -> s
+ | true -> Paths.Fixed.map_point path f
) in
- { state with mode = Selection s ; paths}
+ { state with paths}
let do_action
: events -> state -> state
@@ -117,9 +112,28 @@ let do_action
{ state with current }
(* Click anywhere while in Out mode, we switch in edition *)
- | `Click _, Out ->
+ | `Click ((x, y) as p), Out ->
Elements.Timer.start timer 0.3;
- { state with mode = Edit }
+
+ let width = state.width
+ and angle = state.angle in
+
+ let point =
+ match check_selection p state.paths with
+ | None ->
+ (* Start a new path with the point clicked *)
+ Path.Point.create ~x ~y ~angle ~width
+ | Some (p, _) ->
+ (* If the point is close to an existing path, we use the closest
+ point in the path instead *)
+ let x, y = Gg.V2.to_tuple p in
+ Path.Point.create ~x ~y ~angle ~width
+ in
+
+ let current = Paths.Path_Builder.add_point
+ point
+ state.current in
+ { state with current; mode = Edit }
(* Click anywhere while in selection mode, we either select another path,
or switch to Out mode*)
@@ -128,20 +142,29 @@ let do_action
| None ->
{ state with
mode = Out }
- | Some selected ->
+ | Some (_, selected) ->
(* Start the timer in order to handle the mouse moves *)
+
+ let id = Paths.Fixed.id selected in
Elements.Timer.start timer 0.3;
{ state with
- mode = (Selection selected)}
+ mode = (Selection id)}
end
| `Out point, Edit ->
Elements.Timer.stop timer;
begin match Paths.Path_Builder.peek2 state.current with
(* If there is at last two points selected, handle this as a curve
- creation *)
+ creation. And we add the new point in the current path *)
| Some _ ->
+
+(*
+ let point = match check_selection point state.paths with
+ | None -> point
+ | Some (p, _) -> Gg.V2.to_tuple p in
+*)
+
let current = insert_or_replace state point state.current in
let paths =
let last = Paths.Fixed.to_fixed
@@ -163,14 +186,14 @@ let do_action
mode = Out
; current
}
- | Some selected ->
+ | Some (_, selected) ->
+ let id = Paths.Fixed.id selected in
{ state with
- mode = (Selection selected)
+ mode = (Selection id)
; current }
end
end
- | `Delete, Selection s ->
- let id = Paths.Fixed.id s in
+ | `Delete, Selection id ->
let paths = List.filter state.paths ~f:(fun p -> Paths.Fixed.id p != id) in
{ state with paths ; mode = Out}
@@ -188,7 +211,11 @@ let do_action
(List.map state.paths
~f:(fun path ->
let repr = Paths.SVGRepr.create_path (fun _ -> ()) in
- let path = Paths.SVGRepr.get @@ Paths.SVG_Printer.draw path repr in
+ let path = Paths.SVGRepr.get @@
+ Paths.Fixed.repr
+ path
+ (module Paths.SVGRepr)
+ repr in
Layer.Svg.path
~at:Brr.At.[