From 1f1f13a3f02e7f5f5da5926a402d53f2ccbfe536 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Sun, 20 Dec 2020 20:58:31 +0100 Subject: Update du soir --- script.ml | 151 +++++++++++++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 119 insertions(+), 32 deletions(-) (limited to 'script.ml') 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*) -- cgit v1.2.3