aboutsummaryrefslogtreecommitdiff
path: root/script.ml
diff options
context:
space:
mode:
Diffstat (limited to 'script.ml')
-rwxr-xr-xscript.ml151
1 files changed, 119 insertions, 32 deletions
diff --git a/script.ml b/script.ml
index 351433e..02492d6 100755
--- a/script.ml
+++ b/script.ml
@@ -4,21 +4,29 @@ open Brr
module Timer = Events.Timer
+module Repr = Path.FillPrinter
+
module Path_Builder = Path.Builder.Make(Path.Point)
-module Path_Printer = Path_Builder.Draw(Path.WireFramePrinter)
-module Fixed_Printer = Path_Builder.DrawFixed(Path.WireFramePrinter)
+module Path_Printer = Path_Builder.Draw(Repr)
+module Fixed_Printer = Path_Builder.DrawFixed(Repr)
type mode =
| Edit
+ | Selection of Path_Builder.fixedPath
| Out
+let timer, tick = Timer.create ()
+
type current = Path_Builder.t
+(*
+ The state cannt hold functionnal values, and thus cannot be used to store
+ elements like timer
+ *)
type state =
{ mode : mode
; paths : Path_Builder.fixedPath list
; current : current
- ; timer : Timer.t
}
(** Events *)
@@ -79,38 +87,97 @@ let insert_or_replace ((x, y) as p) path =
let p1' = Path.Point.get_coord p1 in
let dist = (norm (p1' - (of_tuple p))) in
- if dist < 0.05 then (
- path
+ if dist < 5. then (
+ path, None
) else (
Path_Builder.add_point
point
path
)
+let check_selection 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 Path_Builder.distance point path with
+ | Some p when p < 20. ->
+ Some path
+ | _ -> None
+ end
+ )
+
let do_action
: events -> state -> state
= fun event state ->
match event, state.mode with
- | `Point (_delay, (x, y)), Edit ->
+ | `Point (_delay, point), Edit ->
(* Add the point in the list *)
- let current= Path_Builder.add_point
- (Path.Point.create x y)
+ let current, fixed_path = insert_or_replace
+ point
state.current in
- { state with current }
+ let paths = match fixed_path with
+ | None -> state.paths
+ | Some p -> p::state.paths in
+ { state with current; paths }
+ (* Click anywhere while in Out mode, we switch in edition *)
| `Click _, Out ->
- Timer.start state.timer 0.3;
+ Timer.start timer 0.3;
{ state with mode = Edit }
+
+ (* Click anywhere while in selection mode, we either select another path,
+ or switch to Out mode*)
+ | `Click position, (Selection _) ->
+ begin match check_selection position state.paths with
+ | None ->
+ { state with
+ mode = Out }
+ | Some selected ->
+
+ (* Start the timer in order to handle the mouse moves *)
+ Timer.start timer 0.3;
+ { state with
+ mode = (Selection selected)}
+ end
+
| `Out point, Edit ->
- Timer.stop state.timer;
- let current = insert_or_replace point state.current in
- (*
- let beziers = Path.Draw.to_path @@ Path_Builder.get current in
- let paths = beziers::state.paths
- *)
- let paths = Path_Builder.to_fixed current::state.paths
- and current = Path_Builder.empty in
- { state with mode = Out; paths; current }
+ Timer.stop timer;
+ begin match Path_Builder.peek2 state.current with
+ (** If there is at last two points selected, handle this as a curve
+ creation *)
+ | Some _ ->
+ let current, fixed_path = insert_or_replace point state.current in
+ let paths = match fixed_path with
+ | None -> Path_Builder.to_fixed current::state.paths
+ | Some p -> p::state.paths
+ and current = Path_Builder.empty in
+ { mode = Out
+ ; paths; current }
+
+ (** Else, check if there is a curve undre the cursor, and remove it *)
+ | None ->
+ let current = Path_Builder.empty in
+ begin match check_selection point state.paths with
+ | None ->
+ { state with
+ mode = Out
+ ; current
+ }
+ | Some selected ->
+ { state with
+ mode = (Selection selected)
+ ; current }
+ end
+ end
+
+
| _ -> state
let backgroundColor = Jstr.v "#2e3440"
@@ -144,34 +211,54 @@ let on_change canva mouse_position state =
*)
let pos = S.rough_value mouse_position in
- let current =
- match state.mode, pos with
- | Edit, Some (x, y) ->
- Path_Builder.add_point (Path'.Point.create x y) state.current
- | _ ->
- state.current
+ let current, paths =
+ begin match state.mode, pos with
+ | Edit, Some point ->
+ begin match insert_or_replace point state.current with
+ | current, None -> current, state.paths
+ | current, Some p -> current, p::state.paths
+ end
+ | _ ->
+ state.current, state.paths
+ end
in
- let path = Path'.WireFramePrinter.get @@ Path_Printer.draw current in
+ let path = Repr.get
+ @@ Path_Printer.draw
+ current
+ (Repr.create_path (fun p -> fill context p)) in
stroke context path;
- List.iter state.paths
+ List.iter paths
~f:(fun path ->
- let path = Path'.WireFramePrinter.get @@ Fixed_Printer.draw path in
- stroke context path
+ let path = Repr.get
+ @@ Fixed_Printer.draw
+ path
+ (Repr.create_path (fun p -> fill context p)) in
+ stroke context path;
);
+
+
+ (* If there is a selection draw it *)
+ let () = match state.mode with
+ | Selection path ->
+ set_fill_style context (color nord8);
+ set_stroke_style context (color nord8);
+ let path = Repr.get
+ @@ Fixed_Printer.draw
+ path
+ (Repr.create_path (fun p -> fill context p)) in
+ stroke context path;
+ | _ -> () in
()
let page_main id =
- let timer, tick = Timer.create () in
-
let init =
{ paths = []
; current = Path_Builder.empty
; mode = Out
- ; timer
} in
(*begin match Document.find_el_by_id G.document id with*)