From 844b8f1724bc1ad566a5906d10e255367fd1f181 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Am=C3=A9lia=20Coutard-Sander?= Date: Mon, 16 Dec 2024 23:23:00 +0100 Subject: [PATCH] =?utf8?q?S=C3=A9lectionneur=20d'automate=20au=20lancement?= =?utf8?q?=20du=20simulateur?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit --- bin/main.ml | 38 +++++++++++++++++++++++++++++++++++++- 1 file changed, 37 insertions(+), 1 deletion(-) 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) -- 2.46.0