From 6191999af9502aae3ee8ab689335f44a20b4575b Mon Sep 17 00:00:00 2001 From: =?utf8?q?Am=C3=A9lia=20Coutard-Sander?= Date: Sat, 4 Jan 2025 01:06:00 +0100 Subject: [PATCH] =?utf8?q?Commandes=20pour=20quitter=20et=20pour=20revenir?= =?utf8?q?=20=C3=A0=20la=20s=C3=A9lection?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit --- bin/modes.ml | 152 ++++++++++++++++++++++++++++----------------------- 1 file changed, 85 insertions(+), 67 deletions(-) diff --git a/bin/modes.ml b/bin/modes.ml index 13a6860..d7414f9 100644 --- a/bin/modes.ml +++ b/bin/modes.ml @@ -32,7 +32,7 @@ end = module type Mode = ModeAux.S -module Command = struct +module rec Command : (Mode with type initer = ModeAux.mode_and_state) = struct type state = { cmd: string; old: ModeAux.mode_and_state } type initer = ModeAux.mode_and_state @@ -47,8 +47,14 @@ module Command = struct Graphics.draw_string (":" ^ cmd) let run_cmd { cmd; old } = - Printf.fprintf stderr "Cmd: `%s'\n%!" cmd; - Either.right old + match cmd with + | "quit" -> + Graphics.close_graph (); + Either.right old + | "select" -> Either.right (ModeAux.ModeAndState (AutoSelector.initial (), (module AutoSelector))) + | _ -> + Printf.fprintf stderr "Unknown cmd: `%s'\n%!" cmd; + Either.right old let update ({ cmd; old } as st) = function | '\b' -> Either.left { st with cmd = String.sub cmd 0 (max (String.length cmd - 1) 0) } @@ -57,72 +63,84 @@ module Command = struct | c -> Either.left { st with cmd = cmd ^ String.make 1 c } end -module Normal (M : Automata.Automaton) = struct - module rec Impl : (Mode with type initer = unit) = struct - type state = { board: M.t Automata.board; n: int option; pos: int * int; current: M.t; size : int } - - type initer = unit - - let initial () = { board = Automata.initial (module M); n = None; pos = (0, 0); current = M.default; size = 16 } - - let render { board; current; pos = px, py; size; _ } = - let w = (Graphics.size_x () / size) + 1 - and h = (Graphics.size_y () / size) + 1 in - let wx = px - (w / 2) - and wy = py - (h / 2) in - for x = wx to wx + w do - for y = wy to wy + h do - let r, g, b = M.color (Automata.get x y board) in - let r, g, b = (int_of_char r, int_of_char g, int_of_char b) in - Graphics.set_color (Graphics.rgb r g b); - Graphics.fill_rect ((x - wx) * size) ((y - wy) * size) size size; - Graphics.set_color (Graphics.rgb 127 127 127); - Graphics.draw_rect ((x - wx) * size) ((y - wy) * size) size size - done - done; - let r, g, b = M.color current in - let r, g, b = (int_of_char r, int_of_char g, int_of_char b) in - Graphics.set_color (Graphics.rgb r g b); - Graphics.fill_rect (((px - wx) * size) + 5) (((py - wy) * size) + 5) (max (size - 10) 1) (max (size - 10) 1); - Graphics.set_color (Graphics.rgb 127 127 127); - Graphics.draw_rect (((px - wx) * size) + 5) (((py - wy) * size) + 5) (max (size - 10) 1) (max (size - 10) 1) - - let update st = - let set_current ({ board; pos = x, y; current; _ } as st) = - { st with board = Automata.set x y current board } - in - let chpos dx dy ({ pos = x, y; _ } as st) = { st with pos = (x + dx, y + dy) } in - let chsize ds ({ size; _ } as st) = { st with size = max (size + ds) 1 } in - let chcur f st = { st with current = f st.current } in - let chnum d st = { st with n = Some ((Option.value st.n ~default:0 * 10) + d) } in - let rec ntimes f st = - match Option.value st.n ~default:1 with - | 0 -> { st with n = None } - | n -> f (ntimes f { st with n = Some (n - 1) }) - in - function - | ':' -> - Either.right - (ModeAux.ModeAndState - (Command.initial (ModeAux.ModeAndState (st, (module Impl))), (module Command))) - | c when '0' <= c && c <= '9' -> Either.left (chnum (int_of_char c - int_of_char '0') st) - | 's' -> Either.left (set_current st) - | 'q' -> Either.left (ntimes (chcur M.prev) st) - | 'd' -> Either.left (ntimes (chcur M.next) st) - | 'f' -> Either.left (ntimes (fun st -> { st with board = Automata.update (module M) st.board }) st) - | 'k' -> Either.left (ntimes (chpos 0 1) st) - | 'h' -> Either.left (ntimes (chpos (-1) 0) st) - | 'j' -> Either.left (ntimes (chpos 0 (-1)) st) - | 'l' -> Either.left (ntimes (chpos 1 0) st) - | 'i' -> Either.left (ntimes (chsize 1) st) - | 'o' -> Either.left (ntimes (chsize (-1)) st) - | _ -> Either.left st +and Normal : functor (M : Automata.Automaton) -> Mode with type initer = unit = +functor + (M : Automata.Automaton) + -> + struct + module rec Impl : (Mode with type initer = unit) = struct + type state = { board: M.t Automata.board; n: int option; pos: int * int; current: M.t; size: int } + + type initer = unit + + let initial () = { board = Automata.initial (module M); n = None; pos = (0, 0); current = M.default; size = 16 } + + let render { board; current; pos = px, py; size; _ } = + let w = (Graphics.size_x () / size) + 1 + and h = (Graphics.size_y () / size) + 1 in + let wx = px - (w / 2) + and wy = py - (h / 2) in + for x = wx to wx + w do + for y = wy to wy + h do + let r, g, b = M.color (Automata.get x y board) in + let r, g, b = (int_of_char r, int_of_char g, int_of_char b) in + Graphics.set_color (Graphics.rgb r g b); + Graphics.fill_rect ((x - wx) * size) ((y - wy) * size) size size; + Graphics.set_color (Graphics.rgb 127 127 127); + Graphics.draw_rect ((x - wx) * size) ((y - wy) * size) size size + done + done; + let r, g, b = M.color current in + let r, g, b = (int_of_char r, int_of_char g, int_of_char b) in + Graphics.set_color (Graphics.rgb r g b); + Graphics.fill_rect + (((px - wx) * size) + 5) + (((py - wy) * size) + 5) + (max (size - 10) 1) + (max (size - 10) 1); + Graphics.set_color (Graphics.rgb 127 127 127); + Graphics.draw_rect + (((px - wx) * size) + 5) + (((py - wy) * size) + 5) + (max (size - 10) 1) + (max (size - 10) 1) + + let update st = + let set_current ({ board; pos = x, y; current; _ } as st) = + { st with board = Automata.set x y current board } + in + let chpos dx dy ({ pos = x, y; _ } as st) = { st with pos = (x + dx, y + dy) } in + let chsize ds ({ size; _ } as st) = { st with size = max (size + ds) 1 } in + let chcur f st = { st with current = f st.current } in + let chnum d st = { st with n = Some ((Option.value st.n ~default:0 * 10) + d) } in + let rec ntimes f st = + match Option.value st.n ~default:1 with + | 0 -> { st with n = None } + | n -> f (ntimes f { st with n = Some (n - 1) }) + in + function + | ':' -> + Either.right + (ModeAux.ModeAndState + (Command.initial (ModeAux.ModeAndState (st, (module Impl))), (module Command))) + | c when '0' <= c && c <= '9' -> Either.left (chnum (int_of_char c - int_of_char '0') st) + | 's' -> Either.left (set_current st) + | 'q' -> Either.left (ntimes (chcur M.prev) st) + | 'd' -> Either.left (ntimes (chcur M.next) st) + | 'f' -> Either.left (ntimes (fun st -> { st with board = Automata.update (module M) st.board }) st) + | 'k' -> Either.left (ntimes (chpos 0 1) st) + | 'h' -> Either.left (ntimes (chpos (-1) 0) st) + | 'j' -> Either.left (ntimes (chpos 0 (-1)) st) + | 'l' -> Either.left (ntimes (chpos 1 0) st) + | 'i' -> Either.left (ntimes (chsize 1) st) + | 'o' -> Either.left (ntimes (chsize (-1)) st) + | _ -> Either.left st + end + + include Impl end - include Impl -end - -module AutoSelector = struct +and AutoSelector : (Mode with type initer = unit) = struct type state = (module Automata.Automaton) list * (module Automata.Automaton) * (module Automata.Automaton) list type initer = unit -- 2.46.0