From: Amélia Coutard-Sander <git@ameliathe1st.gay>
Date: Mon, 16 Dec 2024 22:23:00 +0000 (+0100)
Subject: Sélectionneur d'automate au lancement du simulateur
X-Git-Url: https://git.ameliathe1st.gay/?a=commitdiff_plain;h=844b8f1724bc1ad566a5906d10e255367fd1f181;p=cells.git

Sélectionneur d'automate au lancement du simulateur
---

diff --git a/bin/main.ml b/bin/main.ml
index 3b86105..09d3154 100644
--- a/bin/main.ml
+++ b/bin/main.ml
@@ -75,10 +75,46 @@ let run (type t) (m : (module Automata.Automaton with type t = t)) =
         in
         aux (Automata.initial m) { x = 0; y = 0; current = M.default }
 
+let pick f cs =
+        let rec aux above curr below =
+                Graphics.clear_graph ();
+                let x = 25
+                and y = (Graphics.size_y () / 2) - 10 in
+                let draw_text i s =
+                        Graphics.moveto x (y + (i * 25));
+                        Graphics.draw_string s
+                in
+                List.iteri (fun i -> draw_text (i + 1)) (List.map f above);
+                draw_text 0 (f curr);
+                Graphics.draw_rect (x - 5) (y - 5) 200 20;
+                List.iteri (fun i -> draw_text (-i - 1)) (List.map f below);
+                Graphics.synchronize ();
+                match Graphics.read_key () with
+                | 'z' -> (
+                        match above with
+                        | [] -> aux [] curr below
+                        | c :: cs -> aux cs c (curr :: below))
+                | 's' -> (
+                        match below with
+                        | [] -> aux above curr []
+                        | c :: cs -> aux (curr :: above) c cs)
+                | ' ' -> curr
+                | _ -> aux above curr below
+        in
+        match cs with
+        | c :: cs -> aux [] c cs
+        | [] -> assert false (* cs should be non-empty *)
+
 let () =
         Graphics.open_graph "";
         Graphics.set_window_title "Automaton";
         Graphics.auto_synchronize false;
-        let m = List.nth Automata.automata 0 in
+        let m =
+                pick
+                  (fun m ->
+                    let module M = (val m : Automata.Automaton) in
+                    M.name)
+                  Automata.automata
+        in
         let module M = (val m) in
         run (module M)