From 8dad032530c4bf9db47b69e427794596eb35bae7 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Am=C3=A9lia=20Coutard-Sander?= Date: Tue, 17 Dec 2024 12:43:30 +0100 Subject: [PATCH] =?utf8?q?Contr=C3=B4les=20dans=20le=20style=20de=20vi?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit --- bin/main.ml | 50 +++++++++++++++++++++++++++++--------------------- 1 file changed, 29 insertions(+), 21 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index 1ee164a..1e9a7b9 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -13,7 +13,7 @@ * with this program. If not, see . *) -type 't interface_state = { x: int; y: int; current: 't } +type 't interface_state = { n: int option; pos: int * int; current: 't } let render (type t) @@ -34,34 +34,42 @@ let render let r, g, b = M.color inter.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 ((inter.x * 16) + 5) ((inter.y * 16) + 5) 6 6; + Graphics.fill_rect ((fst inter.pos * 16) + 5) ((snd inter.pos * 16) + 5) 6 6; Graphics.set_color (Graphics.rgb 127 127 127); - Graphics.draw_rect ((inter.x * 16) + 5) ((inter.y * 16) + 5) 6 6 + Graphics.draw_rect ((fst inter.pos * 16) + 5) ((snd inter.pos * 16) + 5) 6 6 let inputs (type t) (m : (module Automata.Automaton with type t = t)) (board : t Automata.board) (inter : t interface_state) = - let set_current inter = Automata.set inter.x inter.y inter.current in - let chpos dx dy ({ x; y; _ } as inter) = { inter with x = x + dx; y = y + dy } in + let set_current inter = Automata.set (fst inter.pos) (snd inter.pos) inter.current in + let chpos dx dy ({ pos = x, y; _ } as inter) = { inter with pos = (x + dx, y + dy) } in let chcur f ({ current; _ } as inter) = { inter with current = f current } in + let chnum d ({ n; _ } as inter) = { inter with n = Some ((Option.value n ~default:0 * 10) + d) } in + let rec ntimes f ({ n; _ } as inter) = + match Option.value n ~default:1 with + | 0 -> { inter with n = None } + | n -> f (ntimes f { inter with n = Some (n - 1) }) + in + let rec ntimesb f (board, ({ n; _ } as inter)) = + match Option.value n ~default:1 with + | 0 -> (board, { inter with n = None }) + | n -> f (ntimesb f (board, { inter with n = Some (n - 1) })) + in let module M = (val m) in if Graphics.key_pressed () then match Graphics.read_key () with - | ' ' -> (Automata.set inter.x inter.y inter.current board, inter) - | 'a' -> (board, chcur M.prev inter) - | 'e' -> (board, chcur M.next inter) - | 'z' -> (board, chpos 0 1 inter) - | 'q' -> (board, chpos (-1) 0 inter) - | 's' -> (board, chpos 0 (-1) inter) - | 'd' -> (board, chpos 1 0 inter) - | 'Z' -> (set_current inter board, chpos 0 1 inter) - | 'Q' -> (set_current inter board, chpos (-1) 0 inter) - | 'S' -> (set_current inter board, chpos 0 (-1) inter) - | 'D' -> (set_current inter board, chpos 1 0 inter) - | '\t' -> (Automata.update m board, inter) + | c when '0' <= c && c <= '9' -> (board, chnum (int_of_char c - int_of_char '0') inter) + | 's' -> (set_current inter board, inter) + | 'q' -> (board, ntimes (chcur M.prev) inter) + | 'd' -> (board, ntimes (chcur M.next) inter) + | 'f' -> ntimesb (fun (b, i) -> (Automata.update m b, i)) (board, inter) + | 'k' -> (board, ntimes (chpos 0 1) inter) + | 'h' -> (board, ntimes (chpos (-1) 0) inter) + | 'j' -> (board, ntimes (chpos 0 (-1)) inter) + | 'l' -> (board, ntimes (chpos 1 0) inter) | _ -> (board, inter) else (board, inter) @@ -73,7 +81,7 @@ let run (type t) (m : (module Automata.Automaton with type t = t)) = let board, inter = inputs m board inter in aux board inter in - aux (Automata.initial m) { x = 0; y = 0; current = M.default } + aux (Automata.initial m) { n = None; pos = (0, 0); current = M.default } let pick f cs = let rec aux above curr below = @@ -92,15 +100,15 @@ let pick f cs = if Graphics.key_pressed () then match Graphics.read_key () with - | 'z' -> ( + | 'k' -> ( match above with | [] -> aux [] curr below | c :: cs -> aux cs c (curr :: below)) - | 's' -> ( + | 'j' -> ( match below with | [] -> aux above curr [] | c :: cs -> aux (curr :: above) c cs) - | ' ' -> curr + | 's' -> curr | _ -> aux above curr below else aux above curr below in -- 2.46.0