Mode insertion, au lieu de s, q, et d

diff --git a/README.txt b/README.txt
index 4bffdceec97a4f25abe102dab518ac5ea90122a1..35611f145faea01d8cf943404a4a9ccbbd8abdd6 100644 (file)
--- a/README.txt
+++ b/README.txt
@@ -14,14 +14,13 @@ modes.
 L'éditeur démarre en mode normal. Les commandes sont les suivantes:
        : -> passer en mode commande
        0 -> revenir aux coordonnées 0:0
-       s -> mets la case pointée à la valeur actuelle
-       q, d -> mets la valeur actuelle à la précédente, ou la suivante
        f -> effectue une étape de simulation
+       i -> passe en mode insertion
        h, j, k, l -> se déplace d'une case à gauche, en bas, en haut,
                ou à droite.
-       i, o -> zoome, ou dézoome
+       o, p -> zoome, ou dézoome
 
-Toute commande (sauf s, :, et 0) peut être précédée d'un nombre (en
+Toute commande (sauf i, :, et 0) peut être précédée d'un nombre (en
 décimal, ne commençant pas par 0) qui indique le nombre de fois que l'on
 souhaite l'exécuter.
 
@@ -41,5 +40,13 @@ On peut exécuter la commande en faisant entrée.
 On peut activer l'autocomplétion en faisant une tabulation.
 Toutes les autres touches servent simplement à écrire la commande.
 
+En mode insertion, que l'on active en faisant i, on peut définir la
+valeur des différentes cases:
+       \n -> Reviens à la première colonne, à la ligne d'en dessous.
+       ESC -> Reviens en mode normal.
+       Tout autre caractère est converti en un type de case, et écrit
+               dans la case actuelle avant de passer à la case de
+               droite.
+
 J'accepterai avec plaisir les contributions utiles envoyées par mail
 (via git send-mail) à mon adresse personelle (indiquée sur mon site).

diff --git a/automata/automata.ml b/automata/automata.ml
index 2d4dcb9102261393df92a00d00449376288c89ff..ca931d14031e31d1d296918c065a479bb0284f8e 100644 (file)
--- a/automata/automata.ml
+++ b/automata/automata.ml
@@ -30,17 +30,13 @@ module type Automaton = sig
 
   val transition : t neighbours -> t
 
-  val default : t
-
-  val prev : t -> t
-
-  val next : t -> t
-
   val color : t -> char * char * char
 
-  val of_string : string -> t
+  val default : t
+
+  val of_char : char -> t option
 
-  val to_string : t -> string
+  val to_char : t -> char
 end
 
 module Coord = struct
@@ -127,7 +123,7 @@ let update (type t) (m : (module Automaton with type t = t)) (d, board) =
 
 let deserialise (type t) (m : (module Automaton with type t = t)) channel =
         let module M = (val m) in
-        let d = Option.get (In_channel.input_line channel) |> M.of_string in
+        let d = (Option.get (In_channel.input_line channel)).[0] |> M.of_char |> Option.get in
         let board =
                 let rec aux board =
                         match In_channel.input_line channel with
@@ -138,7 +134,9 @@ let deserialise (type t) (m : (module Automaton with type t = t)) channel =
                                 let chunk =
                                         Array.init chunk_size (fun _ ->
                                             Array.init chunk_size (fun _ ->
-                                                In_channel.input_line channel |> Option.get |> M.of_string))
+                                                (In_channel.input_line channel |> Option.get).[0]
+                                                |> M.of_char
+                                                |> Option.get))
                                 in
                                 aux (CoordMap.add (x, y) chunk board)
                 in
@@ -148,11 +146,11 @@ let deserialise (type t) (m : (module Automaton with type t = t)) channel =
 
 let serialise (type t) (m : (module Automaton with type t = t)) (d, board) channel =
         let module M = (val m) in
-        Printf.fprintf channel "%s\n" (M.to_string d);
+        Printf.fprintf channel "%c\n" (M.to_char d);
         CoordMap.iter
           (fun (x, y) chunk ->
             Printf.fprintf channel "%d\n%d\n" x y;
-            Array.iter (Array.iter (fun c -> Printf.fprintf channel "%s\n" (M.to_string c))) chunk)
+            Array.iter (Array.iter (fun c -> Printf.fprintf channel "%c\n" (M.to_char c))) chunk)
           board
 
 let automata =

diff --git a/automata/automata.mli b/automata/automata.mli
index 3f871ebcca5cb2fe4402b7ea06c8f0c297dc9309..5f78a3f609e838e863196b0d80daba4576493b23 100644 (file)
--- a/automata/automata.mli
+++ b/automata/automata.mli
@@ -30,17 +30,13 @@ module type Automaton = sig
 
   val transition : t neighbours -> t
 
-  val default : t
-
-  val prev : t -> t
-
-  val next : t -> t
-
   val color : t -> char * char * char
 
-  val of_string : string -> t
+  val default : t
+
+  val of_char : char -> t option
 
-  val to_string : t -> string
+  val to_char : t -> char
 end
 
 type 't board

diff --git a/automata/automata/brain.ml b/automata/automata/brain.ml
index 5de9e9dddf897ccdcf08279ffa4ab0852b1185ff..10e0d44571e3ca2f95b89205f125d700b2fa9abd 100644 (file)
--- a/automata/automata/brain.ml
+++ b/automata/automata/brain.ml
@@ -37,30 +37,20 @@ let transition (c, cs) =
         | On -> Dying
         | Dying -> Off
 
-let default = Off
-
-let prev = function
-        | Off -> Dying
-        | On -> Off
-        | Dying -> On
-
-let next = function
-        | Off -> On
-        | On -> Dying
-        | Dying -> Off
-
 let color = function
         | Off -> ('\x00', '\x00', '\x1F')
         | On -> ('\xFF', '\xFF', '\xFF')
         | Dying -> ('\x00', '\x00', '\xFF')
 
-let of_string = function
-        | "D" -> Off
-        | "A" -> On
-        | "Y" -> Dying
-        | _ -> failwith "Unparseable"
+let default = Off
+
+let of_char = function
+        | 'D' -> Some Off
+        | 'A' -> Some On
+        | 'Y' -> Some Dying
+        | _ -> None
 
-let to_string = function
-        | Off -> "D"
-        | On -> "A"
-        | Dying -> "Y"
+let to_char = function
+        | Off -> 'D'
+        | On -> 'A'
+        | Dying -> 'Y'

diff --git a/automata/automata/life.ml b/automata/automata/life.ml
index 16f9c1b9b9df05ae1da560982ec48e25c7c130c9..85d64519d5c1bab580d3daf29326ca87c6e28948 100644 (file)
--- a/automata/automata/life.ml
+++ b/automata/automata/life.ml
@@ -33,25 +33,17 @@ let transition (c, cs) =
         let n = List.length (List.filter (( = ) Alive) cs) in
         if n < 2 || n > 3 then Dead else if n == 3 then Alive else c
 
-let default = Dead
-
-let prev = function
-        | Dead -> Alive
-        | Alive -> Dead
-
-let next = function
-        | Dead -> Alive
-        | Alive -> Dead
-
 let color = function
         | Dead -> ('\x00', '\x00', '\x1F')
         | Alive -> ('\xFF', '\xFF', '\xFF')
 
-let of_string = function
-        | "D" -> Dead
-        | "A" -> Alive
-        | _ -> failwith "Unparseable"
+let default = Dead
+
+let of_char = function
+        | 'D' -> Some Dead
+        | 'A' -> Some Alive
+        | _ -> None
 
-let to_string = function
-        | Dead -> "D"
-        | Alive -> "A"
+let to_char = function
+        | Dead -> 'D'
+        | Alive -> 'A'

diff --git a/automata/automata/maze.ml b/automata/automata/maze.ml
index 1181c4c75189cfb5c3d555041b8b9e6cc86b3091..69f2af1308a7cd5bd71869fe4c5036327b6e1d11 100644 (file)
--- a/automata/automata/maze.ml
+++ b/automata/automata/maze.ml
@@ -33,25 +33,17 @@ let transition (c, cs) =
         let n = List.length (List.filter (( = ) Mur) cs) in
         if n < 1 || n > 5 then Sol else if n == 3 then Mur else c
 
-let default = Sol
-
-let prev = function
-        | Sol -> Mur
-        | Mur -> Sol
-
-let next = function
-        | Sol -> Mur
-        | Mur -> Sol
-
 let color = function
         | Sol -> ('\x00', '\x00', '\x1F')
         | Mur -> ('\xFF', '\xFF', '\xFF')
 
-let of_string = function
-        | "S" -> Sol
-        | "M" -> Mur
-        | _ -> failwith "Unparseable"
+let default = Sol
+
+let of_char = function
+        | 'S' -> Some Sol
+        | 'M' -> Some Mur
+        | _ -> None
 
-let to_string = function
-        | Sol -> "S"
-        | Mur -> "M"
+let to_char = function
+        | Sol -> 'S'
+        | Mur -> 'M'

diff --git a/automata/automata/wireworld.ml b/automata/automata/wireworld.ml
index a040a03f3d182cb81d7aa385b016230c9df70687..fdd5f70c630ecd5d862970ede20ade252046f74a 100644 (file)
--- a/automata/automata/wireworld.ml
+++ b/automata/automata/wireworld.ml
@@ -38,35 +38,23 @@ let transition (c, cs) =
         | Head -> Tail
         | Tail -> Conductor
 
-let default = Empty
-
-let prev = function
-        | Empty -> Tail
-        | Conductor -> Empty
-        | Head -> Conductor
-        | Tail -> Head
-
-let next = function
-        | Empty -> Conductor
-        | Conductor -> Head
-        | Head -> Tail
-        | Tail -> Empty
-
 let color = function
         | Empty -> ('\x00', '\x00', '\x1F')
         | Conductor -> ('\xBF', '\xBF', '\x00')
         | Head -> ('\xBF', '\x00', '\x00')
         | Tail -> ('\x00', '\x00', '\xBF')
 
-let of_string = function
-        | "0" -> Empty
-        | "C" -> Conductor
-        | "H" -> Head
-        | "T" -> Tail
-        | _ -> failwith "Unparseable"
+let default = Empty
 
-let to_string = function
-        | Empty -> "0"
-        | Conductor -> "C"
-        | Head -> "H"
-        | Tail -> "T"
+let of_char = function
+        | '0' -> Some Empty
+        | 'C' -> Some Conductor
+        | 'H' -> Some Head
+        | 'T' -> Some Tail
+        | _ -> None
+
+let to_char = function
+        | Empty -> '0'
+        | Conductor -> 'C'
+        | Head -> 'H'
+        | Tail -> 'T'

diff --git a/bin/modes.ml b/bin/modes.ml
index d52df7f5764774ef26d5567c6df2bcadad21e8d6..dede8665f18814191ac7b2074d3ddf71e0c151fb 100644 (file)
--- a/bin/modes.ml
+++ b/bin/modes.ml
@@ -13,7 +13,7 @@
  * 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 'c editor_state_aux = { board: 'c Automata.board; pos: int * int; size: int }
 
 type editor_state = EditorState : (module Automata.Automaton with type t = 'c) * 'c editor_state_aux -> editor_state
 
@@ -21,9 +21,7 @@ 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 } )
+                EditorState ((module Auto), { board = Automata.initial (module Auto); pos = (0, 0); size = 16 })
         | [] -> assert false
 
 module rec ModeAux : sig
@@ -49,7 +47,7 @@ let get_name (m : (module Automata.Automaton)) =
         let module M = (val m) in
         M.name
 
-let render_world (EditorState (m, { board; current; pos = px, py; size })) =
+let render_world (EditorState (m, { board; 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
@@ -65,12 +63,8 @@ let render_world (EditorState (m, { board; current; pos = px, py; size })) =
             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)
+        Graphics.draw_rect (((px - wx) * size) + 1) (((py - wy) * size) + 1) (size - 2) (size - 2)
 
 module rec Command : (Mode with type initer = string) = struct
   type state = string * string list
@@ -171,10 +165,7 @@ module rec Command : (Mode with type initer = string) = struct
                     match List.find_opt (fun m -> get_name m = auto) Automata.automata with
                     | Some auto ->
                             let module M = (val auto) in
-                            ( EditorState
-                                ( (module M),
-                                  { board = Automata.initial (module M); pos = (0, 0); current = M.default; size = 16 }
-                                ),
+                            ( EditorState ((module M), { board = Automata.initial (module M); pos = (0, 0); size = 16 }),
                               Either.right (ModeAux.ModeAndState ((module Normal), Normal.initial ())) )
                     | None ->
                             Printf.fprintf stderr "Automate inconnu: `%s' !\n%!" auto;
@@ -193,13 +184,7 @@ module rec Command : (Mode with type initer = string) = struct
                           let auto = List.find (fun m -> get_name m = name) Automata.automata in
                           let module M = (val auto) in
                           ( EditorState
-                              ( (module M),
-                                {
-                                  board = Automata.deserialise (module M) f;
-                                  pos = st.pos;
-                                  current = M.default;
-                                  size = st.size;
-                                } ),
+                              ((module M), { board = Automata.deserialise (module M) f; pos = st.pos; size = st.size }),
                             Either.right (ModeAux.ModeAndState ((module Normal), Normal.initial ())) ))
                     with Sys_error _ ->
                       Printf.fprintf stderr "Failed to write file `%s' !\n%!" f;
@@ -220,51 +205,66 @@ module rec Command : (Mode with type initer = string) = struct
 end
 
 and Normal : (Mode with type initer = unit) = struct
-  module rec Impl : (Mode with type initer = unit) = struct
-    type state = { n: int option }
+  type state = { n: int option }
 
-    type initer = unit
+  type initer = unit
 
-    let initial () = { n = None }
+  let initial () = { n = None }
 
-    let render st _ = render_world st
+  let render st _ = render_world st
 
-    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 "")))
-            | '0' when n.n = None -> (EditorState (m, { st with pos = (0, 0) }), Either.left n)
-            | 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 })
-            | _ -> (EditorState (m, st), Either.left { n = None })
-  end
+  let update (EditorState (m, st)) n =
+          let module M = (val m) 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 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 "")))
+          | '0' when n.n = None -> (EditorState (m, { st with pos = (0, 0) }), Either.left n)
+          | c when '0' <= c && c <= '9' -> (EditorState (m, st), Either.left (chnum (int_of_char c - int_of_char '0') n))
+          | 'f' ->
+                  ( EditorState (m, ntimes n (fun st -> { st with board = Automata.update (module M) st.board }) st),
+                    Either.left { n = None } )
+          | 'i' ->
+                  ( EditorState (m, st),
+                    Either.right (ModeAux.ModeAndState ((module Insert), Insert.initial (fst st.pos))) )
+          | '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 })
+          | 'o' -> (EditorState (m, ntimes n (chsize 1) st), Either.left { n = None })
+          | 'p' -> (EditorState (m, ntimes n (chsize (-1)) st), Either.left { n = None })
+          | _ -> (EditorState (m, st), Either.left { n = None })
+end
 
-  include Impl
+and Insert : (Mode with type initer = int) = struct
+  type state = { col: int }
+
+  type initer = int
+
+  let initial col = { col }
+
+  let render st _ = render_world st
+
+  let update (EditorState (m, st)) { col } =
+          let module M = (val m) in
+          let set_current ({ board; pos = x, y; _ } as st) c =
+                  { st with board = Automata.set x y c board; pos = (x + 1, y) }
+          in
+          let next_line ({ pos = _, y; _ } as st) = { st with pos = (col, y - 1) } in
+          function
+          | '\e' -> (EditorState (m, st), Either.right (ModeAux.ModeAndState ((module Normal), Normal.initial ())))
+          | '\r' -> (EditorState (m, next_line st), Either.left { col })
+          | c -> (
+                  match M.of_char c with
+                  | Some c -> (EditorState (m, set_current st c), Either.left { col })
+                  | None -> (EditorState (m, st), Either.left { col }))
 end

diff --git a/bin/modes.mli b/bin/modes.mli
index a067d7413b7c43484afa03624b5e3107ae25ea87..d6dfe0d7389499eab46feeda939a5cbe8a892fe5 100644 (file)
--- a/bin/modes.mli
+++ b/bin/modes.mli
@@ -38,3 +38,5 @@ module type Mode = ModeAux.S
 module Command : Mode
 
 module Normal : Mode with type initer = unit
+
+module Insert : Mode