Grille immutable

diff --git a/automata/automata.ml b/automata/automata.ml
index 181f8660ce490e3b752be11a161a1a5e76f4c954..cfc8a8666bf074edb704874a347ab61df8bf87f2 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 f45e5a8f81370bfe80f678799afe7f69c1f173d5..892cec1d7d6c7f5bb4de4bcd5830e0ac631df571 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 bf3129a88ca9b30a46f78cad5afe6f56d8c96573..d4537114f6924e7614e5c8f26e3158551a43af0d 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 "";