Commandes pour quitter et pour revenir à la sélection

diff --git a/bin/modes.ml b/bin/modes.ml
index 13a68604b1810f6252aa7ac5e1e2ceb7df735932..d7414f9a4b05c018f3ebc0263051a33a12be9307 100644 (file)
--- 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