Simplification: l'état de la grille est maintenant en dehors du mode

diff --git a/bin/main.ml b/bin/main.ml
index 5c84bfebf731ac222a896c9898a7b28e8a6e6f8f..c0f9c3fe0d5d934e2f5014d28f5c293176c5bf2a 100644 (file)
--- a/bin/main.ml
+++ b/bin/main.ml
@@ -14,20 +14,20 @@
  *)
 
 let run (type state initer) (m : (module Modes.Mode with type state = state and type initer = initer)) (init : initer) =
-        let rec aux : type state. (module Modes.Mode with type state = state) -> state -> unit =
-               fun m state ->
+        let rec aux : type state. Modes.editor_state -> (module Modes.Mode with type state = state) -> state -> unit =
+               fun estate m state ->
                 let module M = (val m) in
-                M.render state;
+                M.render estate state;
                 Graphics.synchronize ();
                 if Graphics.key_pressed ()
                 then
-                  match M.update state (Graphics.read_key ()) with
-                  | Either.Left state -> aux m state
-                  | Either.Right (ModeAndState (m, st)) -> aux m st
-                else aux m state
+                  match M.update estate state (Graphics.read_key ()) with
+                  | estate, Either.Left state -> aux estate m state
+                  | estate, Either.Right (ModeAndState (m, state)) -> aux estate m state
+                else aux estate m state
         in
         let module M = (val m) in
-        aux (module M) (M.initial init)
+        aux Modes.default_state (module M) (M.initial init)
 
 let () =
         Graphics.open_graph "";

diff --git a/bin/modes.ml b/bin/modes.ml
index 4ce1aa2b0a9a9a511f7da681b9f056e1567006e5..74d1330bd39f533922af790499a6c7cd3670af42 100644 (file)
--- a/bin/modes.ml
+++ b/bin/modes.ml
@@ -13,6 +13,19 @@
  * with this program. If not, see <https://www.gnu.org/licenses/>.
  *)
 
+type 'c editor_state_aux = { board: 'c Automata.board; pos: int * int; current: 'c; size: int }
+
+type editor_state = EditorState : (module Automata.Automaton with type t = 'c) * 'c editor_state_aux -> editor_state
+
+let default_state =
+        match Automata.automata with
+        | auto :: _ ->
+                let module Auto = (val auto) in
+                EditorState
+                  ( (module Auto),
+                    { board = Automata.initial (module Auto); pos = (0, 0); current = Auto.default; size = 16 } )
+        | [] -> assert false
+
 module rec ModeAux : sig
   type mode_and_state = ModeAndState : (module ModeAux.S with type state = 'a) * 'a -> mode_and_state
 
@@ -23,129 +36,123 @@ module rec ModeAux : sig
 
     val initial : initer -> state
 
-    val render : state -> unit
+    val render : editor_state -> state -> unit
 
-    val update : state -> char -> (state, mode_and_state) Either.t
+    val update : editor_state -> state -> char -> editor_state * (state, mode_and_state) Either.t
   end
 end =
   ModeAux
 
 module type Mode = ModeAux.S
 
-module rec Command : (Mode with type initer = ModeAux.mode_and_state) = struct
-  type state = { cmd: string; old: ModeAux.mode_and_state }
+module rec Command : (Mode with type initer = string) = struct
+  type state = string
 
-  type initer = ModeAux.mode_and_state
+  type initer = string
 
-  let initial old = { cmd = ""; old }
+  let initial s = s
 
-  let render { cmd; _ } =
+  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 } =
+  let run_cmd estate cmd =
           match cmd with
           | "quit" ->
                   Graphics.close_graph ();
-                  Either.right old
-          | "select" -> Either.right (ModeAux.ModeAndState ((module AutoSelector), AutoSelector.initial ()))
+                  (estate, Either.right (ModeAux.ModeAndState ((module Normal), Normal.initial ())))
+          | "select" -> (estate, Either.right (ModeAux.ModeAndState ((module AutoSelector), AutoSelector.initial ())))
           | _ ->
                   Printf.fprintf stderr "Unknown cmd: `%s'\n%!" cmd;
-                  Either.right old
+                  (estate, Either.right (ModeAux.ModeAndState ((module Normal), Normal.initial ())))
 
-  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 }
+  let update estate cmd = function
+          | '\b' -> (estate, Either.left (String.sub cmd 0 (max (String.length cmd - 1) 0)))
+          | '\e' -> (estate, Either.right (ModeAux.ModeAndState ((module Normal), Normal.initial ())))
+          | '\r' -> run_cmd estate cmd
+          | c -> (estate, Either.left (cmd ^ String.make 1 c))
 end
 
-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
-                           ((module Command), Command.initial (ModeAux.ModeAndState ((module Impl), st))))
-              | 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)
-              | 'w' ->
-                      Out_channel.with_open_text "test.auto" (Automata.serialise (module M) st.board);
-                      Either.left st
-              | 'r' ->
-                      Either.left
-                        { st with board = In_channel.with_open_text "test.auto" (Automata.deserialise (module M)) }
-              | _ -> Either.left st
-    end
-
-    include Impl
+and Normal : (Mode with type initer = unit) = struct
+  module rec Impl : (Mode with type initer = unit) = struct
+    type state = { n: int option }
+
+    type initer = unit
+
+    let initial () = { n = None }
+
+    let render (EditorState (m, { board; current; pos = px, py; size })) _ =
+            let module M = (val m) in
+            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 (EditorState (m, st)) n =
+            let module M = (val m) in
+            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 { n } = { n = Some ((Option.value n ~default:0 * 10) + d) } in
+            let ntimes { n } =
+                    let rec iter_n n f v =
+                            match n with
+                            | 0 -> v
+                            | n -> iter_n (n - 1) f (f v)
+                    in
+                    iter_n (Option.value n ~default:1)
+            in
+            function
+            | ':' -> (EditorState (m, st), Either.right (ModeAux.ModeAndState ((module Command), Command.initial "")))
+            | c when '0' <= c && c <= '9' ->
+                    (EditorState (m, st), Either.left (chnum (int_of_char c - int_of_char '0') n))
+            | 's' -> (EditorState (m, set_current st), Either.left { n = None })
+            | 'q' -> (EditorState (m, ntimes n (chcur M.prev) st), Either.left { n = None })
+            | 'd' -> (EditorState (m, ntimes n (chcur M.next) st), Either.left { n = None })
+            | 'f' ->
+                    ( EditorState (m, ntimes n (fun st -> { st with board = Automata.update (module M) st.board }) st),
+                      Either.left { n = None } )
+            | 'k' -> (EditorState (m, ntimes n (chpos 0 1) st), Either.left { n = None })
+            | 'h' -> (EditorState (m, ntimes n (chpos (-1) 0) st), Either.left { n = None })
+            | 'j' -> (EditorState (m, ntimes n (chpos 0 (-1)) st), Either.left { n = None })
+            | 'l' -> (EditorState (m, ntimes n (chpos 1 0) st), Either.left { n = None })
+            | 'i' -> (EditorState (m, ntimes n (chsize 1) st), Either.left { n = None })
+            | 'o' -> (EditorState (m, ntimes n (chsize (-1)) st), Either.left { n = None })
+            | 'w' ->
+                    Out_channel.with_open_text "test.auto" (Automata.serialise (module M) st.board);
+                    (EditorState (m, st), Either.left { n = None })
+            | 'r' ->
+                    ( EditorState
+                        (m, { st with board = In_channel.with_open_text "test.auto" (Automata.deserialise (module M)) }),
+                      Either.left { n = None } )
+            | _ -> (EditorState (m, st), Either.left { n = None })
   end
 
+  include Impl
+end
+
 and AutoSelector : (Mode with type initer = unit) = struct
   type state = (module Automata.Automaton) list * (module Automata.Automaton) * (module Automata.Automaton) list
 
@@ -156,7 +163,7 @@ and AutoSelector : (Mode with type initer = unit) = struct
           | au :: aus -> ([], au, aus)
           | [] -> assert false
 
-  let render (above, curr, below) =
+  let render _ (above, curr, below) =
           let auto_name (m : (module Automata.Automaton)) =
                   let module M = (val m) in
                   M.name
@@ -173,21 +180,22 @@ and AutoSelector : (Mode with type initer = unit) = struct
           Graphics.draw_rect (x - 5) (y - 5) 200 20;
           List.iteri (fun i -> draw_text (-i - 1)) (List.map auto_name below)
 
-  let update (above, curr, below) = function
+  let update estate (above, curr, below) = function
           | 'k' -> (
                   match above with
-                  | [] -> Either.left ([], curr, below)
-                  | c :: cs -> Either.left (cs, c, curr :: below))
+                  | [] -> (estate, Either.left ([], curr, below))
+                  | c :: cs -> (estate, Either.left (cs, c, curr :: below)))
           | 'j' -> (
                   match below with
-                  | [] -> Either.left (above, curr, [])
-                  | c :: cs -> Either.left (curr :: above, c, cs))
+                  | [] -> (estate, Either.left (above, curr, []))
+                  | c :: cs -> (estate, Either.left (curr :: above, c, cs)))
           | 's' ->
                   let module M = (val curr : Automata.Automaton) in
-                  let module NormalM = Normal (M) in
-                  Either.right (ModeAux.ModeAndState ((module NormalM), NormalM.initial ()))
+                  ( EditorState
+                      ((module M), { board = Automata.initial (module M); pos = (0, 0); current = M.default; size = 16 }),
+                    Either.right (ModeAux.ModeAndState ((module Normal), Normal.initial ())) )
           | 'q' ->
                   Graphics.close_graph ();
-                  Either.left (above, curr, below)
-          | _ -> Either.left (above, curr, below)
+                  (estate, Either.left (above, curr, below))
+          | _ -> (estate, Either.left (above, curr, below))
 end

diff --git a/bin/modes.mli b/bin/modes.mli
index d291e63b4bc9069a8d4285c41c481a67c6d55ed6..b0427ef1ba2266978c607a80cbe011988dac8c95 100644 (file)
--- a/bin/modes.mli
+++ b/bin/modes.mli
@@ -13,6 +13,10 @@
  * with this program. If not, see <https://www.gnu.org/licenses/>.
  *)
 
+type editor_state
+
+val default_state : editor_state
+
 module rec ModeAux : sig
   type mode_and_state = ModeAndState : (module ModeAux.S with type state = 'a) * 'a -> mode_and_state
 
@@ -23,9 +27,9 @@ module rec ModeAux : sig
 
     val initial : initer -> state
 
-    val render : state -> unit
+    val render : editor_state -> state -> unit
 
-    val update : state -> char -> (state, mode_and_state) Either.t
+    val update : editor_state -> state -> char -> editor_state * (state, mode_and_state) Either.t
   end
 end
 
@@ -33,6 +37,6 @@ module type Mode = ModeAux.S
 
 module Command : Mode
 
-module Normal (_ : Automata.Automaton) : Mode
+module Normal : Mode
 
 module AutoSelector : Mode with type initer = unit