From 56fe72ae1990989b231294df6109f559a226794f Mon Sep 17 00:00:00 2001 From: =?utf8?q?Am=C3=A9lia=20Coutard-Sander?= Date: Wed, 18 Dec 2024 22:06:21 +0100 Subject: [PATCH] Mode commande (:) qui ne fait rien pour l'instant --- bin/main.ml | 10 ++-- bin/modes.ml | 143 +++++++++++++++++++++++++++++++++----------------- bin/modes.mli | 12 +++-- 3 files changed, 107 insertions(+), 58 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index 60247ae..a33f3bd 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -13,7 +13,7 @@ * with this program. If not, see . *) -let run (type state) (m : (module Modes.Mode with type state = state)) = +let run (type state initer) (m : (module Modes.Mode with type state = state and type initer = initer)) (init : initer) = let rec aux : type state. state -> (module Modes.Mode with type state = state) -> unit = fun state m -> let module M = (val m) in @@ -23,16 +23,14 @@ let run (type state) (m : (module Modes.Mode with type state = state)) = then match M.update state (Graphics.read_key ()) with | Either.Left state -> aux state m - | Either.Right m -> - let module M = (val m) in - aux M.initial (module M) + | Either.Right (ModeAndState (st, m)) -> aux st m else aux state m in let module M = (val m) in - aux M.initial m + aux (M.initial init) (module M) let () = Graphics.open_graph ""; Graphics.set_window_title "Automaton"; Graphics.auto_synchronize false; - try run (module Modes.AutoSelector) with Graphics.Graphic_failure _ -> () + try run (module Modes.AutoSelector) () with Graphics.Graphic_failure _ -> () diff --git a/bin/modes.ml b/bin/modes.ml index 5400d5b..c957f97 100644 --- a/bin/modes.ml +++ b/bin/modes.ml @@ -14,72 +14,113 @@ *) module rec ModeAux : sig + type mode_and_state = ModeAndState : 'a * (module ModeAux.S with type state = 'a) -> mode_and_state + module type S = sig type state - val initial : state + type initer + + val initial : initer -> state val render : state -> unit - val update : state -> char -> (state, (module ModeAux.S)) Either.t + val update : state -> char -> (state, mode_and_state) Either.t end end = ModeAux module type Mode = ModeAux.S +module Command = struct + type state = { cmd: string; old: ModeAux.mode_and_state } + + type initer = ModeAux.mode_and_state + + let initial old = { cmd = ""; old } + + let render { cmd; _ } = + Graphics.set_color Graphics.white; + Graphics.fill_rect 0 0 (Graphics.size_x ()) 25; + Graphics.set_color Graphics.black; + Graphics.moveto 10 8; + Graphics.draw_string (":" ^ cmd) + + let run_cmd { cmd; old } = + Printf.fprintf stderr "Cmd: `%s'\n%!" cmd; + Either.right old + + let update ({ cmd; old } as st) = function + | '\b' -> Either.left { st with cmd = String.sub cmd 0 (max (String.length cmd - 1) 0) } + | '' -> Either.right old + | '\r' -> run_cmd st + | c -> Either.left { st with cmd = cmd ^ String.make 1 c } +end + module Normal (M : Automata.Automaton) = struct - type state = { board: M.t Automata.board; n: int option; pos: int * int; current: M.t } - - let initial = { board = Automata.initial (module M); n = None; pos = (0, 0); current = M.default } - - let render { board; current; pos = px, py; _ } = - for x = 0 to (Graphics.size_x () / 16) + 1 do - for y = 0 to (Graphics.size_y () / 16) + 1 do - let r, g, b = M.color (Automata.get x y board) in - let r, g, b = (int_of_char r, int_of_char g, int_of_char b) in - Graphics.set_color (Graphics.rgb r g b); - Graphics.fill_rect (x * 16) (y * 16) 16 16; - Graphics.set_color (Graphics.rgb 127 127 127); - Graphics.draw_rect (x * 16) (y * 16) 16 16 - done - done; - let r, g, b = M.color current in - let r, g, b = (int_of_char r, int_of_char g, int_of_char b) in - Graphics.set_color (Graphics.rgb r g b); - Graphics.fill_rect ((px * 16) + 5) ((py * 16) + 5) 6 6; - Graphics.set_color (Graphics.rgb 127 127 127); - Graphics.draw_rect ((px * 16) + 5) ((py * 16) + 5) 6 6 - - let update st = - let set_current ({ board; pos = x, y; current; _ } as st) = - { st with board = Automata.set x y current board } - in - let chpos dx dy ({ pos = x, y; _ } as st) = { st with pos = (x + dx, y + dy) } in - let chcur f st = { st with current = f st.current } in - let chnum d st = { st with n = Some ((Option.value st.n ~default:0 * 10) + d) } in - let rec ntimes f st = - match Option.value st.n ~default:1 with - | 0 -> { st with n = None } - | n -> f (ntimes f { st with n = Some (n - 1) }) - in - function - | c when '0' <= c && c <= '9' -> Either.left (chnum (int_of_char c - int_of_char '0') st) - | 's' -> Either.left (set_current st) - | 'q' -> Either.left (ntimes (chcur M.prev) st) - | 'd' -> Either.left (ntimes (chcur M.next) st) - | 'f' -> Either.left (ntimes (fun st -> { st with board = Automata.update (module M) st.board }) st) - | 'k' -> Either.left (ntimes (chpos 0 1) st) - | 'h' -> Either.left (ntimes (chpos (-1) 0) st) - | 'j' -> Either.left (ntimes (chpos 0 (-1)) st) - | 'l' -> Either.left (ntimes (chpos 1 0) st) - | _ -> Either.left st + module rec Impl : (Mode with type initer = unit) = struct + type state = { board: M.t Automata.board; n: int option; pos: int * int; current: M.t } + + type initer = unit + + let initial () = { board = Automata.initial (module M); n = None; pos = (0, 0); current = M.default } + + let render { board; current; pos = px, py; _ } = + for x = 0 to (Graphics.size_x () / 16) + 1 do + for y = 0 to (Graphics.size_y () / 16) + 1 do + let r, g, b = M.color (Automata.get x y board) in + let r, g, b = (int_of_char r, int_of_char g, int_of_char b) in + Graphics.set_color (Graphics.rgb r g b); + Graphics.fill_rect (x * 16) (y * 16) 16 16; + Graphics.set_color (Graphics.rgb 127 127 127); + Graphics.draw_rect (x * 16) (y * 16) 16 16 + done + done; + let r, g, b = M.color current in + let r, g, b = (int_of_char r, int_of_char g, int_of_char b) in + Graphics.set_color (Graphics.rgb r g b); + Graphics.fill_rect ((px * 16) + 5) ((py * 16) + 5) 6 6; + Graphics.set_color (Graphics.rgb 127 127 127); + Graphics.draw_rect ((px * 16) + 5) ((py * 16) + 5) 6 6 + + let update st = + let set_current ({ board; pos = x, y; current; _ } as st) = + { st with board = Automata.set x y current board } + in + let chpos dx dy ({ pos = x, y; _ } as st) = { st with pos = (x + dx, y + dy) } in + let chcur f st = { st with current = f st.current } in + let chnum d st = { st with n = Some ((Option.value st.n ~default:0 * 10) + d) } in + let rec ntimes f st = + match Option.value st.n ~default:1 with + | 0 -> { st with n = None } + | n -> f (ntimes f { st with n = Some (n - 1) }) + in + function + | ':' -> + Either.right + (ModeAux.ModeAndState + (Command.initial (ModeAux.ModeAndState (st, (module Impl))), (module Command))) + | c when '0' <= c && c <= '9' -> Either.left (chnum (int_of_char c - int_of_char '0') st) + | 's' -> Either.left (set_current st) + | 'q' -> Either.left (ntimes (chcur M.prev) st) + | 'd' -> Either.left (ntimes (chcur M.next) st) + | 'f' -> Either.left (ntimes (fun st -> { st with board = Automata.update (module M) st.board }) st) + | 'k' -> Either.left (ntimes (chpos 0 1) st) + | 'h' -> Either.left (ntimes (chpos (-1) 0) st) + | 'j' -> Either.left (ntimes (chpos 0 (-1)) st) + | 'l' -> Either.left (ntimes (chpos 1 0) st) + | _ -> Either.left st + end + + include Impl end module AutoSelector = struct type state = (module Automata.Automaton) list * (module Automata.Automaton) * (module Automata.Automaton) list - let initial = + type initer = unit + + let initial () = match Automata.automata with | au :: aus -> ([], au, aus) | [] -> assert false @@ -112,6 +153,10 @@ module AutoSelector = struct | c :: cs -> Either.left (curr :: above, c, cs)) | 's' -> let module M = (val curr : Automata.Automaton) in - Either.right (module Normal (M) : Mode) + let module NormalM = Normal (M) in + Either.right (ModeAux.ModeAndState (NormalM.initial (), (module NormalM))) + | 'q' -> + Graphics.close_graph (); + Either.left (above, curr, below) | _ -> Either.left (above, curr, below) end diff --git a/bin/modes.mli b/bin/modes.mli index 2a5ba58..7365629 100644 --- a/bin/modes.mli +++ b/bin/modes.mli @@ -14,19 +14,25 @@ *) module rec ModeAux : sig + type mode_and_state = ModeAndState : 'a * (module ModeAux.S with type state = 'a) -> mode_and_state + module type S = sig type state - val initial : state + type initer + + val initial : initer -> state val render : state -> unit - val update : state -> char -> (state, (module ModeAux.S)) Either.t + val update : state -> char -> (state, mode_and_state) Either.t end end module type Mode = ModeAux.S +module Command : Mode + module Normal (_ : Automata.Automaton) : Mode -module AutoSelector : Mode +module AutoSelector : Mode with type initer = unit -- 2.46.0