From 16fbaec308ccb45ce71503ea0a0ebf0b9972ae7e Mon Sep 17 00:00:00 2001 From: =?utf8?q?Am=C3=A9lia=20Coutard-Sander?= Date: Sat, 4 Jan 2025 12:49:24 +0100 Subject: [PATCH] =?utf8?q?Simplification:=20l'=C3=A9tat=20de=20la=20grille?= =?utf8?q?=20est=20maintenant=20en=20dehors=20du=20mode?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit --- bin/main.ml | 16 ++-- bin/modes.ml | 222 ++++++++++++++++++++++++++------------------------ bin/modes.mli | 10 ++- 3 files changed, 130 insertions(+), 118 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index 5c84bfe..c0f9c3f 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -14,20 +14,20 @@ *) let run (type state initer) (m : (module Modes.Mode with type state = state and type initer = initer)) (init : initer) = - let rec aux : type state. (module Modes.Mode with type state = state) -> state -> unit = - fun m state -> + let rec aux : type state. Modes.editor_state -> (module Modes.Mode with type state = state) -> state -> unit = + fun estate m state -> let module M = (val m) in - M.render state; + M.render estate state; Graphics.synchronize (); if Graphics.key_pressed () then - match M.update state (Graphics.read_key ()) with - | Either.Left state -> aux m state - | Either.Right (ModeAndState (m, st)) -> aux m st - else aux m state + match M.update estate state (Graphics.read_key ()) with + | estate, Either.Left state -> aux estate m state + | estate, Either.Right (ModeAndState (m, state)) -> aux estate m state + else aux estate m state in let module M = (val m) in - aux (module M) (M.initial init) + aux Modes.default_state (module M) (M.initial init) let () = Graphics.open_graph ""; diff --git a/bin/modes.ml b/bin/modes.ml index 4ce1aa2..74d1330 100644 --- a/bin/modes.ml +++ b/bin/modes.ml @@ -13,6 +13,19 @@ * with this program. If not, see . *) +type 'c editor_state_aux = { board: 'c Automata.board; pos: int * int; current: 'c; size: int } + +type editor_state = EditorState : (module Automata.Automaton with type t = 'c) * 'c editor_state_aux -> editor_state + +let default_state = + match Automata.automata with + | auto :: _ -> + let module Auto = (val auto) in + EditorState + ( (module Auto), + { board = Automata.initial (module Auto); pos = (0, 0); current = Auto.default; size = 16 } ) + | [] -> assert false + module rec ModeAux : sig type mode_and_state = ModeAndState : (module ModeAux.S with type state = 'a) * 'a -> mode_and_state @@ -23,129 +36,123 @@ module rec ModeAux : sig val initial : initer -> state - val render : state -> unit + val render : editor_state -> state -> unit - val update : state -> char -> (state, mode_and_state) Either.t + val update : editor_state -> state -> char -> editor_state * (state, mode_and_state) Either.t end end = ModeAux module type Mode = ModeAux.S -module rec Command : (Mode with type initer = ModeAux.mode_and_state) = struct - type state = { cmd: string; old: ModeAux.mode_and_state } +module rec Command : (Mode with type initer = string) = struct + type state = string - type initer = ModeAux.mode_and_state + type initer = string - let initial old = { cmd = ""; old } + let initial s = s - let render { cmd; _ } = + 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 } = + let run_cmd estate cmd = match cmd with | "quit" -> Graphics.close_graph (); - Either.right old - | "select" -> Either.right (ModeAux.ModeAndState ((module AutoSelector), AutoSelector.initial ())) + (estate, Either.right (ModeAux.ModeAndState ((module Normal), Normal.initial ()))) + | "select" -> (estate, Either.right (ModeAux.ModeAndState ((module AutoSelector), AutoSelector.initial ()))) | _ -> Printf.fprintf stderr "Unknown cmd: `%s'\n%!" cmd; - Either.right old + (estate, Either.right (ModeAux.ModeAndState ((module Normal), Normal.initial ()))) - 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 } + let update estate cmd = function + | '\b' -> (estate, Either.left (String.sub cmd 0 (max (String.length cmd - 1) 0))) + | '' -> (estate, Either.right (ModeAux.ModeAndState ((module Normal), Normal.initial ()))) + | '\r' -> run_cmd estate cmd + | c -> (estate, Either.left (cmd ^ String.make 1 c)) end -and Normal : functor (M : Automata.Automaton) -> Mode with type initer = unit = -functor - (M : Automata.Automaton) - -> - struct - 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; size: int } - - type initer = unit - - let initial () = { board = Automata.initial (module M); n = None; pos = (0, 0); current = M.default; size = 16 } - - let render { board; current; pos = px, py; size; _ } = - let w = (Graphics.size_x () / size) + 1 - and h = (Graphics.size_y () / size) + 1 in - let wx = px - (w / 2) - and wy = py - (h / 2) in - for x = wx to wx + w do - for y = wy to wy + h 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 - wx) * size) ((y - wy) * size) size size; - Graphics.set_color (Graphics.rgb 127 127 127); - Graphics.draw_rect ((x - wx) * size) ((y - wy) * size) size size - 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 - wx) * size) + 5) - (((py - wy) * size) + 5) - (max (size - 10) 1) - (max (size - 10) 1); - Graphics.set_color (Graphics.rgb 127 127 127); - Graphics.draw_rect - (((px - wx) * size) + 5) - (((py - wy) * size) + 5) - (max (size - 10) 1) - (max (size - 10) 1) - - 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 chsize ds ({ size; _ } as st) = { st with size = max (size + ds) 1 } 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 - ((module Command), Command.initial (ModeAux.ModeAndState ((module Impl), st)))) - | 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) - | 'i' -> Either.left (ntimes (chsize 1) st) - | 'o' -> Either.left (ntimes (chsize (-1)) st) - | 'w' -> - Out_channel.with_open_text "test.auto" (Automata.serialise (module M) st.board); - Either.left st - | 'r' -> - Either.left - { st with board = In_channel.with_open_text "test.auto" (Automata.deserialise (module M)) } - | _ -> Either.left st - end - - include Impl +and Normal : (Mode with type initer = unit) = struct + module rec Impl : (Mode with type initer = unit) = struct + type state = { n: int option } + + type initer = unit + + let initial () = { n = None } + + let render (EditorState (m, { board; current; pos = px, py; size })) _ = + let module M = (val m) in + let w = (Graphics.size_x () / size) + 1 + and h = (Graphics.size_y () / size) + 1 in + let wx = px - (w / 2) + and wy = py - (h / 2) in + for x = wx to wx + w do + for y = wy to wy + h 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 - wx) * size) ((y - wy) * size) size size; + Graphics.set_color (Graphics.rgb 127 127 127); + Graphics.draw_rect ((x - wx) * size) ((y - wy) * size) size size + 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 - wx) * size) + 5) (((py - wy) * size) + 5) (max (size - 10) 1) (max (size - 10) 1); + Graphics.set_color (Graphics.rgb 127 127 127); + Graphics.draw_rect (((px - wx) * size) + 5) (((py - wy) * size) + 5) (max (size - 10) 1) (max (size - 10) 1) + + let update (EditorState (m, st)) n = + let module M = (val m) in + 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 chsize ds ({ size; _ } as st) = { st with size = max (size + ds) 1 } in + let chcur f st = { st with current = f st.current } in + let chnum d { n } = { n = Some ((Option.value n ~default:0 * 10) + d) } in + let ntimes { n } = + let rec iter_n n f v = + match n with + | 0 -> v + | n -> iter_n (n - 1) f (f v) + in + iter_n (Option.value n ~default:1) + in + function + | ':' -> (EditorState (m, st), Either.right (ModeAux.ModeAndState ((module Command), Command.initial ""))) + | c when '0' <= c && c <= '9' -> + (EditorState (m, st), Either.left (chnum (int_of_char c - int_of_char '0') n)) + | 's' -> (EditorState (m, set_current st), Either.left { n = None }) + | 'q' -> (EditorState (m, ntimes n (chcur M.prev) st), Either.left { n = None }) + | 'd' -> (EditorState (m, ntimes n (chcur M.next) st), Either.left { n = None }) + | 'f' -> + ( EditorState (m, ntimes n (fun st -> { st with board = Automata.update (module M) st.board }) st), + Either.left { n = None } ) + | 'k' -> (EditorState (m, ntimes n (chpos 0 1) st), Either.left { n = None }) + | 'h' -> (EditorState (m, ntimes n (chpos (-1) 0) st), Either.left { n = None }) + | 'j' -> (EditorState (m, ntimes n (chpos 0 (-1)) st), Either.left { n = None }) + | 'l' -> (EditorState (m, ntimes n (chpos 1 0) st), Either.left { n = None }) + | 'i' -> (EditorState (m, ntimes n (chsize 1) st), Either.left { n = None }) + | 'o' -> (EditorState (m, ntimes n (chsize (-1)) st), Either.left { n = None }) + | 'w' -> + Out_channel.with_open_text "test.auto" (Automata.serialise (module M) st.board); + (EditorState (m, st), Either.left { n = None }) + | 'r' -> + ( EditorState + (m, { st with board = In_channel.with_open_text "test.auto" (Automata.deserialise (module M)) }), + Either.left { n = None } ) + | _ -> (EditorState (m, st), Either.left { n = None }) end + include Impl +end + and AutoSelector : (Mode with type initer = unit) = struct type state = (module Automata.Automaton) list * (module Automata.Automaton) * (module Automata.Automaton) list @@ -156,7 +163,7 @@ and AutoSelector : (Mode with type initer = unit) = struct | au :: aus -> ([], au, aus) | [] -> assert false - let render (above, curr, below) = + let render _ (above, curr, below) = let auto_name (m : (module Automata.Automaton)) = let module M = (val m) in M.name @@ -173,21 +180,22 @@ and AutoSelector : (Mode with type initer = unit) = struct Graphics.draw_rect (x - 5) (y - 5) 200 20; List.iteri (fun i -> draw_text (-i - 1)) (List.map auto_name below) - let update (above, curr, below) = function + let update estate (above, curr, below) = function | 'k' -> ( match above with - | [] -> Either.left ([], curr, below) - | c :: cs -> Either.left (cs, c, curr :: below)) + | [] -> (estate, Either.left ([], curr, below)) + | c :: cs -> (estate, Either.left (cs, c, curr :: below))) | 'j' -> ( match below with - | [] -> Either.left (above, curr, []) - | c :: cs -> Either.left (curr :: above, c, cs)) + | [] -> (estate, Either.left (above, curr, [])) + | c :: cs -> (estate, Either.left (curr :: above, c, cs))) | 's' -> let module M = (val curr : Automata.Automaton) in - let module NormalM = Normal (M) in - Either.right (ModeAux.ModeAndState ((module NormalM), NormalM.initial ())) + ( EditorState + ((module M), { board = Automata.initial (module M); pos = (0, 0); current = M.default; size = 16 }), + Either.right (ModeAux.ModeAndState ((module Normal), Normal.initial ())) ) | 'q' -> Graphics.close_graph (); - Either.left (above, curr, below) - | _ -> Either.left (above, curr, below) + (estate, Either.left (above, curr, below)) + | _ -> (estate, Either.left (above, curr, below)) end diff --git a/bin/modes.mli b/bin/modes.mli index d291e63..b0427ef 100644 --- a/bin/modes.mli +++ b/bin/modes.mli @@ -13,6 +13,10 @@ * with this program. If not, see . *) +type editor_state + +val default_state : editor_state + module rec ModeAux : sig type mode_and_state = ModeAndState : (module ModeAux.S with type state = 'a) * 'a -> mode_and_state @@ -23,9 +27,9 @@ module rec ModeAux : sig val initial : initer -> state - val render : state -> unit + val render : editor_state -> state -> unit - val update : state -> char -> (state, mode_and_state) Either.t + val update : editor_state -> state -> char -> editor_state * (state, mode_and_state) Either.t end end @@ -33,6 +37,6 @@ module type Mode = ModeAux.S module Command : Mode -module Normal (_ : Automata.Automaton) : Mode +module Normal : Mode module AutoSelector : Mode with type initer = unit -- 2.46.0