Interface graphique très basique

diff --git a/bin/main.ml b/bin/main.ml
index 350e3d07aa69a62cff470dd05935e50e847e4f09..b0e5404a5dc649bee71d598f5b294bd7f06c5371 100644 (file)
--- a/bin/main.ml
+++ b/bin/main.ml
@@ -13,9 +13,44 @@
  * with this program. If not, see <https://www.gnu.org/licenses/>.
  *)
 
+let render (type t) (m : (module Automata.Automaton with type t = t)) (board : t Automata.board) =
+        let module M = (val m) in
+        for x = 0 to 63 do
+          for y = 0 to 63 do
+            Graphics.set_color
+              (let r, g, b = M.color (Automata.get x y board) in
+               Graphics.rgb (int_of_char r) (int_of_char g) (int_of_char b));
+            Graphics.fill_rect (x * 16) (y * 16) 16 16;
+            Graphics.set_color Graphics.black;
+            Graphics.draw_rect (x * 16) (y * 16) 16 16
+          done
+        done
+
+let inputs (type t) (m : (module Automata.Automaton with type t = t)) (board : t Automata.board) =
+        let module M = (val m) in
+        if Graphics.button_down ()
+        then (
+          let mx, my = Graphics.mouse_pos () in
+          let x = mx / 16
+          and y = my / 16 in
+          while Graphics.button_down () do
+            ()
+          done;
+          Automata.set x y (M.next (Automata.get x y board)) board)
+
+let run (type t) (m : (module Automata.Automaton with type t = t)) =
+        let rec aux board =
+                render m board;
+                Graphics.synchronize ();
+                inputs m board;
+                aux (if Graphics.key_pressed () && Graphics.read_key () = '\t' then Automata.update m board else board)
+        in
+        aux (Automata.initial m)
+
 let () =
-        List.iter
-          (fun m ->
-            let module Automaton = (val m : Automata.Automaton) in
-            Printf.printf "%s\n" Automaton.name)
-          Automata.automata
+        Graphics.open_graph "";
+        Graphics.set_window_title "Automaton";
+        Graphics.auto_synchronize false;
+        let m = List.nth Automata.automata 0 in
+        let module M = (val m) in
+        run (module M)