Mode commande (:) qui ne fait rien pour l'instant

diff --git a/bin/main.ml b/bin/main.ml
index 60247ae5d2a1491a77086d6c012525d4addd71de..a33f3bd4e591116476bb08700a34cc7ea2a8f944 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/>.
  *)
 
-let run (type state) (m : (module Modes.Mode with type state = state)) =
+let run (type state initer) (m : (module Modes.Mode with type state = state and type initer = initer)) (init : initer) =
         let rec aux : type state. state -> (module Modes.Mode with type state = state) -> unit =
                fun state m ->
                 let module M = (val m) in
@@ -23,16 +23,14 @@ let run (type state) (m : (module Modes.Mode with type state = state)) =
                 then
                   match M.update state (Graphics.read_key ()) with
                   | Either.Left state -> aux state m
-                  | Either.Right m ->
-                          let module M = (val m) in
-                          aux M.initial (module M)
+                  | Either.Right (ModeAndState (st, m)) -> aux st m
                 else aux state m
         in
         let module M = (val m) in
-        aux M.initial m
+        aux (M.initial init) (module M)
 
 let () =
         Graphics.open_graph "";
         Graphics.set_window_title "Automaton";
         Graphics.auto_synchronize false;
-        try run (module Modes.AutoSelector) with Graphics.Graphic_failure _ -> ()
+        try run (module Modes.AutoSelector) () with Graphics.Graphic_failure _ -> ()

diff --git a/bin/modes.ml b/bin/modes.ml
index 5400d5b0f6c5549b412e494fd0eb985abe53ef4d..c957f975ec9ebbf01362827a15f023a096deab3f 100644 (file)
--- a/bin/modes.ml
+++ b/bin/modes.ml
@@ -14,72 +14,113 @@
  *)
 
 module rec ModeAux : sig
+  type mode_and_state = ModeAndState : 'a * (module ModeAux.S with type state = 'a) -> mode_and_state
+
   module type S = sig
     type state
 
-    val initial : state
+    type initer
+
+    val initial : initer -> state
 
     val render : state -> unit
 
-    val update : state -> char -> (state, (module ModeAux.S)) Either.t
+    val update : state -> char -> (state, mode_and_state) Either.t
   end
 end =
   ModeAux
 
 module type Mode = ModeAux.S
 
+module Command = struct
+  type state = { cmd: string; old: ModeAux.mode_and_state }
+
+  type initer = ModeAux.mode_and_state
+
+  let initial old = { cmd = ""; old }
+
+  let render { cmd; _ } =
+          Graphics.set_color Graphics.white;
+          Graphics.fill_rect 0 0 (Graphics.size_x ()) 25;
+          Graphics.set_color Graphics.black;
+          Graphics.moveto 10 8;
+          Graphics.draw_string (":" ^ cmd)
+
+  let run_cmd { cmd; old } =
+          Printf.fprintf stderr "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) }
+          | '\e' -> Either.right old
+          | '\r' -> run_cmd st
+          | c -> Either.left { st with cmd = cmd ^ String.make 1 c }
+end
+
 module Normal (M : Automata.Automaton) = struct
-  type state = { board: M.t Automata.board; n: int option; pos: int * int; current: M.t }
-
-  let initial = { board = Automata.initial (module M); n = None; pos = (0, 0); current = M.default }
-
-  let render { board; current; pos = px, py; _ } =
-          for x = 0 to (Graphics.size_x () / 16) + 1 do
-            for y = 0 to (Graphics.size_y () / 16) + 1 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 * 16) (y * 16) 16 16;
-              Graphics.set_color (Graphics.rgb 127 127 127);
-              Graphics.draw_rect (x * 16) (y * 16) 16 16
-            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 * 16) + 5) ((py * 16) + 5) 6 6;
-          Graphics.set_color (Graphics.rgb 127 127 127);
-          Graphics.draw_rect ((px * 16) + 5) ((py * 16) + 5) 6 6
-
-  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 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
-          | 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)
-          | _ -> Either.left st
+  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 }
+
+    type initer = unit
+
+    let initial () = { board = Automata.initial (module M); n = None; pos = (0, 0); current = M.default }
+
+    let render { board; current; pos = px, py; _ } =
+            for x = 0 to (Graphics.size_x () / 16) + 1 do
+              for y = 0 to (Graphics.size_y () / 16) + 1 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 * 16) (y * 16) 16 16;
+                Graphics.set_color (Graphics.rgb 127 127 127);
+                Graphics.draw_rect (x * 16) (y * 16) 16 16
+              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 * 16) + 5) ((py * 16) + 5) 6 6;
+            Graphics.set_color (Graphics.rgb 127 127 127);
+            Graphics.draw_rect ((px * 16) + 5) ((py * 16) + 5) 6 6
+
+    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 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)
+            | _ -> Either.left st
+  end
+
+  include Impl
 end
 
 module AutoSelector = struct
   type state = (module Automata.Automaton) list * (module Automata.Automaton) * (module Automata.Automaton) list
 
-  let initial =
+  type initer = unit
+
+  let initial () =
           match Automata.automata with
           | au :: aus -> ([], au, aus)
           | [] -> assert false
@@ -112,6 +153,10 @@ module AutoSelector = struct
                   | c :: cs -> Either.left (curr :: above, c, cs))
           | 's' ->
                   let module M = (val curr : Automata.Automaton) in
-                  Either.right (module Normal (M) : Mode)
+                  let module NormalM = Normal (M) in
+                  Either.right (ModeAux.ModeAndState (NormalM.initial (), (module NormalM)))
+          | 'q' ->
+                  Graphics.close_graph ();
+                  Either.left (above, curr, below)
           | _ -> Either.left (above, curr, below)
 end

diff --git a/bin/modes.mli b/bin/modes.mli
index 2a5ba588a70dd0dcdfc6f81b76195bc853e2299d..73656291b63f6734a0fe0d449bebfb7a27489079 100644 (file)
--- a/bin/modes.mli
+++ b/bin/modes.mli
@@ -14,19 +14,25 @@
  *)
 
 module rec ModeAux : sig
+  type mode_and_state = ModeAndState : 'a * (module ModeAux.S with type state = 'a) -> mode_and_state
+
   module type S = sig
     type state
 
-    val initial : state
+    type initer
+
+    val initial : initer -> state
 
     val render : state -> unit
 
-    val update : state -> char -> (state, (module ModeAux.S)) Either.t
+    val update : state -> char -> (state, mode_and_state) Either.t
   end
 end
 
 module type Mode = ModeAux.S
 
+module Command : Mode
+
 module Normal (_ : Automata.Automaton) : Mode
 
-module AutoSelector : Mode
+module AutoSelector : Mode with type initer = unit