From: Amélia Coutard-Sander Date: Tue, 17 Dec 2024 23:22:19 +0000 (+0100) Subject: Début de transformation en un éditeur modal basé sur les contrôles de vi X-Git-Url: https://git.ameliathe1st.gay/?a=commitdiff_plain;h=daeae20a36afa23bec33bc9f025c1e1aad26a623;p=cells.git Début de transformation en un éditeur modal basé sur les contrôles de vi --- diff --git a/bin/main.ml b/bin/main.ml index 1e9a7b9..60247ae 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -13,121 +13,26 @@ * with this program. If not, see . *) -type 't interface_state = { n: int option; pos: int * int; current: 't } - -let render - (type t) - (m : (module Automata.Automaton with type t = t)) - (board : t Automata.board) - (inter : t interface_state) = - let module M = (val m) in - 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 inter.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 ((fst inter.pos * 16) + 5) ((snd inter.pos * 16) + 5) 6 6; - Graphics.set_color (Graphics.rgb 127 127 127); - Graphics.draw_rect ((fst inter.pos * 16) + 5) ((snd inter.pos * 16) + 5) 6 6 - -let inputs - (type t) - (m : (module Automata.Automaton with type t = t)) - (board : t Automata.board) - (inter : t interface_state) = - let set_current inter = Automata.set (fst inter.pos) (snd inter.pos) inter.current in - let chpos dx dy ({ pos = x, y; _ } as inter) = { inter with pos = (x + dx, y + dy) } in - let chcur f ({ current; _ } as inter) = { inter with current = f current } in - let chnum d ({ n; _ } as inter) = { inter with n = Some ((Option.value n ~default:0 * 10) + d) } in - let rec ntimes f ({ n; _ } as inter) = - match Option.value n ~default:1 with - | 0 -> { inter with n = None } - | n -> f (ntimes f { inter with n = Some (n - 1) }) - in - let rec ntimesb f (board, ({ n; _ } as inter)) = - match Option.value n ~default:1 with - | 0 -> (board, { inter with n = None }) - | n -> f (ntimesb f (board, { inter with n = Some (n - 1) })) - in - let module M = (val m) in - if Graphics.key_pressed () - then - match Graphics.read_key () with - | c when '0' <= c && c <= '9' -> (board, chnum (int_of_char c - int_of_char '0') inter) - | 's' -> (set_current inter board, inter) - | 'q' -> (board, ntimes (chcur M.prev) inter) - | 'd' -> (board, ntimes (chcur M.next) inter) - | 'f' -> ntimesb (fun (b, i) -> (Automata.update m b, i)) (board, inter) - | 'k' -> (board, ntimes (chpos 0 1) inter) - | 'h' -> (board, ntimes (chpos (-1) 0) inter) - | 'j' -> (board, ntimes (chpos 0 (-1)) inter) - | 'l' -> (board, ntimes (chpos 1 0) inter) - | _ -> (board, inter) - else (board, inter) - -let run (type t) (m : (module Automata.Automaton with type t = t)) = - let module M = (val m) in - let rec aux board inter = - render m board inter; - Graphics.synchronize (); - let board, inter = inputs m board inter in - aux board inter - in - aux (Automata.initial m) { n = None; pos = (0, 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); +let run (type state) (m : (module Modes.Mode with type state = state)) = + let rec aux : type state. state -> (module Modes.Mode with type state = state) -> unit = + fun state m -> + let module M = (val m) in + M.render state; Graphics.synchronize (); if Graphics.key_pressed () then - match Graphics.read_key () with - | 'k' -> ( - match above with - | [] -> aux [] curr below - | c :: cs -> aux cs c (curr :: below)) - | 'j' -> ( - match below with - | [] -> aux above curr [] - | c :: cs -> aux (curr :: above) c cs) - | 's' -> curr - | _ -> aux above curr below - else aux above curr below + 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) + else aux state m in - match cs with - | c :: cs -> aux [] c cs - | [] -> assert false (* cs should be non-empty *) + let module M = (val m) in + aux M.initial m let () = Graphics.open_graph ""; Graphics.set_window_title "Automaton"; Graphics.auto_synchronize false; - try - 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) - with Graphics.Graphic_failure _ -> () + try run (module Modes.AutoSelector) with Graphics.Graphic_failure _ -> () diff --git a/bin/modes.ml b/bin/modes.ml new file mode 100644 index 0000000..5400d5b --- /dev/null +++ b/bin/modes.ml @@ -0,0 +1,117 @@ +(* Copyright 2024 Amélia COUTARD . + * + * This file from the program cells is free software: you can redistribute it and/or + * modify it under the terms of the GNU Affero General Public License as published by + * the Free Software Foundation, either version 3 of the License, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, but WITHOUT ANY + * WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A + * PARTICULAR PURPOSE. See the GNU Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License along + * with this program. If not, see . + *) + +module rec ModeAux : sig + module type S = sig + type state + + val initial : state + + val render : state -> unit + + val update : state -> char -> (state, (module ModeAux.S)) Either.t + end +end = + ModeAux + +module type Mode = ModeAux.S + +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 +end + +module AutoSelector = struct + type state = (module Automata.Automaton) list * (module Automata.Automaton) * (module Automata.Automaton) list + + let initial = + match Automata.automata with + | au :: aus -> ([], au, aus) + | [] -> assert false + + let render (above, curr, below) = + let auto_name (m : (module Automata.Automaton)) = + let module M = (val m) in + M.name + in + 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 auto_name above); + draw_text 0 (auto_name curr); + 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 + | 'k' -> ( + match above with + | [] -> Either.left ([], curr, below) + | c :: cs -> Either.left (cs, c, curr :: below)) + | 'j' -> ( + match below with + | [] -> Either.left (above, curr, []) + | c :: cs -> Either.left (curr :: above, c, cs)) + | 's' -> + let module M = (val curr : Automata.Automaton) in + Either.right (module Normal (M) : Mode) + | _ -> Either.left (above, curr, below) +end diff --git a/bin/modes.mli b/bin/modes.mli new file mode 100644 index 0000000..2a5ba58 --- /dev/null +++ b/bin/modes.mli @@ -0,0 +1,32 @@ +(* Copyright 2024 Amélia COUTARD . + * + * This file from the program cells is free software: you can redistribute it and/or + * modify it under the terms of the GNU Affero General Public License as published by + * the Free Software Foundation, either version 3 of the License, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, but WITHOUT ANY + * WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A + * PARTICULAR PURPOSE. See the GNU Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License along + * with this program. If not, see . + *) + +module rec ModeAux : sig + module type S = sig + type state + + val initial : state + + val render : state -> unit + + val update : state -> char -> (state, (module ModeAux.S)) Either.t + end +end + +module type Mode = ModeAux.S + +module Normal (_ : Automata.Automaton) : Mode + +module AutoSelector : Mode