Contrôles dans le style de vi

diff --git a/bin/main.ml b/bin/main.ml
index 1ee164ab3a1bed940ca1f57859f392b7cf5ad369..1e9a7b9bc5be46ea57d9bad97010399a46a7c6c5 100644 (file)
--- a/bin/main.ml
+++ b/bin/main.ml
@@ -13,7 +13,7 @@
  * with this program. If not, see <https://www.gnu.org/licenses/>.
  *)
 
-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