Grille immutable

diff --git a/automata/automata.ml b/automata/automata.ml
index 968298aa7d972ffe96be779c75aab5eba9754b80..e8a665f57b609bc9c600e226e3fba4d9ce43f530 100644 (file)
--- a/automata/automata.ml
+++ b/automata/automata.ml
@@ -40,7 +40,13 @@ let initial (type t) (m : (module Automaton with type t = t)) =
 
 let get x y (d, board) = if x < 0 || 63 < x || y < 0 || 63 < y then d else board.(x).(y)
 
-let set x y c (_, board) = if x < 0 || 63 < x || y < 0 || 63 < y then () else board.(x).(y) <- c
+let set x y c ((d, cells) as board) =
+        if x < 0 || 63 < x || y < 0 || 63 < y
+        then board
+        else
+          let res = Array.init 64 (fun x -> Array.init 64 (fun y -> cells.(x).(y))) in
+          res.(x).(y) <- c;
+          (d, res)
 
 let update (type t) (m : (module Automaton with type t = t)) ((d, cells) as board) =
         let module M = (val m) in

diff --git a/automata/automata.mli b/automata/automata.mli
index 2e1d96a91cb8a514afa8fe32aeae3798796beb6f..7d3aa7be6dc87a7c0f8ae73a7086c5a60af2df19 100644 (file)
--- a/automata/automata.mli
+++ b/automata/automata.mli
@@ -37,7 +37,7 @@ val initial : (module Automaton with type t = 't) -> 't board
 
 val get : int -> int -> 't board -> 't
 
-val set : int -> int -> 't -> 't board -> unit
+val set : int -> int -> 't -> 't board -> 't board
 
 val update : (module Automaton with type t = 't) -> 't board -> 't board
 

diff --git a/bin/main.ml b/bin/main.ml
index 0c2c005da7b8d425dbb6f59d4e3860b92fc4899c..3b86105db4ae8836ec47f6ea7d9534225e5b21f2 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; running: bool }
+type 't interface_state = { x: int; y: int; current: 't }
 
 let render
     (type t)
@@ -43,44 +43,37 @@ let inputs
     (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 chcur f ({ current; _ } as inter) = { inter with current = f current } 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' -> { inter with current = M.prev inter.current }
-          | 'e' -> { inter with current = M.next inter.current }
-          | 'z' -> { inter with y = inter.y + 1 }
-          | 'q' -> { inter with x = inter.x - 1 }
-          | 's' -> { inter with y = inter.y - 1 }
-          | 'd' -> { inter with x = inter.x + 1 }
-          | 'Z' ->
-                  Automata.set inter.x inter.y inter.current board;
-                  { inter with y = inter.y + 1 }
-          | 'Q' ->
-                  Automata.set inter.x inter.y inter.current board;
-                  { inter with x = inter.x - 1 }
-          | 'S' ->
-                  Automata.set inter.x inter.y inter.current board;
-                  { inter with y = inter.y - 1 }
-          | 'D' ->
-                  Automata.set inter.x inter.y inter.current board;
-                  { inter with x = inter.x + 1 }
-          | '\t' -> { inter with running = true }
-          | _ -> inter
-        else inter
+          | ' ' -> (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)
+          | _ -> (board, inter)
+        else (board, inter)
 
 let run (type t) (m : (module Automata.Automaton with type t = t)) =
         let module M = (val m) in
         let rec aux board inter =
                 render m board inter;
                 Graphics.synchronize ();
-                let inter = inputs m board inter in
-                aux (if inter.running then Automata.update m board else board) { inter with running = false }
+                let board, inter = inputs m board inter in
+                aux board inter
         in
-        aux (Automata.initial m) { x = 0; y = 0; current = M.default; running = false }
+        aux (Automata.initial m) { x = 0; y = 0; current = M.default }
 
 let () =
         Graphics.open_graph "";