Abstract the semantic meaning of key from the char

This lets us do cool looking stuff, like '⌨:🆗
This commit is contained in:
Jaidyn Ann 2023-06-27 11:54:52 -05:00
parent bc74f43f9a
commit 6849968528
4 changed files with 70 additions and 27 deletions

View File

@ -39,8 +39,9 @@ Programming with nice tea! What a nice day this is. If you happen to be
reading this, I hope your day is going well too! reading this, I hope your day is going well too!
If not, have some tea on me: Im paying. =w=" If not, have some tea on me: Im paying. =w="
(and (listen) (and (listen)
(eq (getf (:normalize-char-plist (:read-char-plist)) :char) (let ((input (getf (:read-gamefied-char-plist) :semantic)))
#\return))) (or (eq input ':🆗)
(eq input ':)))))
@ -138,9 +139,10 @@ data, using :SET and :TO of the DIALOGUE."
(key (getf dialogue :set)) (key (getf dialogue :set))
(data (getf dialogue :to))) (data (getf dialogue :to)))
(when (and key data) (when (and key data)
(format *error-output* "[~A] ~A → ~A???~%" dialogue key data) (setf (🌍:getf-entity-data map speaker key) data))))
(setf (🌍:getf-entity-data map speaker key) data) ;; (format *error-output* "[~A] ~A → ~A???~%" dialogue key data)
(format *error-output* "~A!!!!~%" (🌍:getf-entity-data map speaker :normal-face)))))
;; (format *error-output* "~A!!!!~%" (🌍:getf-entity-data map speaker :normal-face)))))
(defun progress-line-delivery (dialogue) (defun progress-line-delivery (dialogue)

View File

@ -19,25 +19,47 @@
(defpackage :flora-search-aurora.input (defpackage :flora-search-aurora.input
(:use :cl) (:use :cl)
(:nicknames :fsa.i :input :) (:nicknames :fsa.i :input :)
(:export #:read-char-plist #:normalize-char-plist #:plist-char-p (:export #:read-char-plist #:read-gamefied-char-plist
#:normalize-char-plist #:gameify-char-plist
#:plist-char-p
:control :meta :shift :control :meta :shift
+qwerty-layout+ +dvorak-layout+)) +qwerty-layout+ +dvorak-layout+
+arrows-game-layout+ +wasd-game-layout+ +ijkl-game-layout+
: : : : :🆗 :))
(in-package :flora-search-aurora.input) (in-package :flora-search-aurora.input)
;; Yup, they're hardcoded like this. Horrid, ain't it? ^_^ ;; Yup, they're hardcoded like this. Horrid, ain't it? ^_^
(defvar +qwerty-layout+ (defvar +qwerty-layout+
'(#\q #\Q #\w #\W #\e #\E #\r #\R #\t #\T #\y #\Y #\u #\U #\i #\I #\o #\O #\p #\P #\[ #\{ #\] #\} '(#\q #\Q #\w #\W #\e #\E #\r #\R #\t #\T #\y #\Y #\u #\U #\i #\I #\o #\O #\p #\P #\[ #\{ #\] #\}
#\a #\A #\s #\S #\d #\D #\f #\F #\g #\G #\h #\H #\j #\J #\k #\K #\l #\L #\; #\: #\' #\" #\a #\A #\s #\S #\d #\D #\f #\F #\g #\G #\h #\H #\j #\J #\k #\K #\l #\L #\; #\: #\' #\"
#\z #\Z #\x #\X #\c #\C #\v #\V #\b #\B #\n #\N #\m #\M #\, #\< #\. #\> #\/ #\?)) #\z #\Z #\x #\X #\c #\C #\v #\V #\b #\B #\n #\N #\m #\M #\, #\< #\. #\> #\/ #\?))
(defvar +dvorak-layout+ (defvar +dvorak-layout+
'(#\' #\" #\, #\< #\. #\> #\p #\P #\y #\Y #\f #\F #\g #\G #\c #\C #\r #\R #\l #\L #\/ #\? #\= #\+ '(#\' #\" #\, #\< #\. #\> #\p #\P #\y #\Y #\f #\F #\g #\G #\c #\C #\r #\R #\l #\L #\/ #\? #\= #\+
#\a #\A #\o #\O #\e #\E #\u #\U #\i #\I #\d #\D #\h #\H #\t #\T #\n #\N #\s #\S #\- #\_ #\a #\A #\o #\O #\e #\E #\u #\U #\i #\I #\d #\D #\h #\H #\t #\T #\n #\N #\s #\S #\- #\_
#\; #\: #\q #\Q #\j #\J #\k #\K #\x #\X #\b #\B #\m #\M #\w #\W #\v #\V #\z #\Z)) #\; #\: #\q #\Q #\j #\J #\k #\K #\x #\X #\b #\B #\m #\M #\w #\W #\v #\V #\z #\Z))
(defvar +arrows-game-layout+
'((#\↑ . )(#\← . )(#\↓ . )(#\→ . )
(#\a . 🆗)(#\z . 🆗)(#\space . 🆗)(#\return . 🆗)
(#\s . )(#\x . )(#\Esc . )))
(defvar +wasd-game-layout+
'((#\w . )(#\a . )(#\s . )(#\d . )
(#\j . 🆗)(#\← . 🆗)(#\space . 🆗)(#\return . 🆗)
(#\k . )(#\↓ . )(#\Esc . )))
(defvar +ijkl-game-layout+
'((#\i . )(#\j . )(#\k . )(#\l . )
(#\a . 🆗)(#\z . 🆗)(#\← . 🆗)(#\space . 🆗)(#\return . 🆗)
(#\s . )(#\x . )(#\↓ . )(#\Esc . )))
(defun read-char-plist (&optional (stream *standard-input*)) (defun read-char-plist (&optional (stream *standard-input*))
"Reads a character directly from standard-input (sans buffering). "Reads a character directly from standard-input (sans buffering).
Simple terminal escape codes (like arrow-keys) are translated into Simple terminal escape codes (like arrow-keys) are translated into
@ -65,7 +87,7 @@ docstring of #'escape-code-to-character for more info."
(defun normalize-char-plist (char-plist &optional (layout +qwerty-layout+)) (defun normalize-char-plist (char-plist &optional (layout +qwerty-layout+))
"Given a character input property list (as received from read-char-plist), "Given a character input property list (as received from READ-CHAR-PLIST),
massage the output into parsable, deescaped, QWERTY-according format." massage the output into parsable, deescaped, QWERTY-according format."
(let ((normalized (deescape-char-plist char-plist))) (let ((normalized (deescape-char-plist char-plist)))
(setf (getf normalized :char) (setf (getf normalized :char)
@ -81,6 +103,26 @@ Not at all comprehensive, but probably-mostly-just-good-enough. ¯\_ (ツ)_/¯"
char)) char))
(defun read-gamefied-char-plist
(&optional (stream *standard-input*) (layout +qwerty-layout+) (game-layout +arrows-game-layout+))
"Read a character directly from standard-input, then translating its character into the QWERTY
equivalent, then parsing that character into semantic meaning. Results in a plist like so:
(:char #\w :semantic :modifier nil :escaped nil)"
(gameify-char-plist (normalize-char-plist (read-char-plist stream) layout)
game-layout))
(defun gameify-char-plist (char-plist &optional (game-layout +arrows-game-layout+))
"Given a character input plist (as received by READ-CHAR-PLIST), return a
char plist containing a :FUNCTION property, which contains one of several
semantic symbols that match up for menus/gameplay: , , , , 🆗, or ."
(let ((semantic-value (cdr (assoc (getf char-plist :char) game-layout))))
(if semantic-value
(append (list :semantic semantic-value) char-plist)
char-plist)))
(defun deescape-char-plist (char-plist) (defun deescape-char-plist (char-plist)
"Translate escaped characters into somewhat-semantically-adjacent "Translate escaped characters into somewhat-semantically-adjacent
characters, like left arrow-key (escaped D) into (LEFTWARDS ARROW)." characters, like left arrow-key (escaped D) into (LEFTWARDS ARROW)."

View File

@ -174,9 +174,6 @@ Used primarily in moving between different maps in an overworld state."
map-b) map-b)
;;; ——————————————————————————————————— ;;; ———————————————————————————————————
;;; Overworld logic ;;; Overworld logic
@ -216,10 +213,10 @@ Returns parameters to be used in the next invocation of OVERWORLD-STATE."
(defun process-overworld-input (map) (defun process-overworld-input (map)
"Get and process any keyboard input, modifying the map or entities as necessary." "Get and process any keyboard input, modifying the map or entities as necessary."
(if (listen) (if (listen)
(let* ((input (:normalize-char-plist (:read-char-plist)))) (let* ((input (:read-gamefied-char-plist)))
(cond (case (getf input :semantic)
;; Interacting with nearby characters/entities ;; Interacting with nearby characters/entities
((:plist= input '(:modifier nil :char #\return)) (':🆗
(let* ((player (getf-entity map 'player)) (let* ((player (getf-entity map 'player))
(interactee (car (entities-near-entity player (gethash :entities map)))) (interactee (car (entities-near-entity player (gethash :entities map))))
(interactee-id (car interactee)) (interactee-id (car interactee))
@ -230,15 +227,15 @@ Returns parameters to be used in the next invocation of OVERWORLD-STATE."
;; The pause-menu… ;; The pause-menu…
;; ((plist = input '(:modifier nil :char #\Esc))) ;; ((plist = input '(:modifier nil :char #\Esc)))
;; Simple up-down-left-right movements ;; Simple up-down-left-right movements
((:plist= input '(:modifier nil :char #\→)) (':
(move-player map :Δx 1)) (move-player map :Δx 1))
((:plist= input '(:modifier nil :char #\←)) (':
(move-player map :Δx -1)) (move-player map :Δx -1))
((:plist= input '(:modifier nil :char #\↑)) (':
(move-player map :Δy -1)) (move-player map :Δy -1))
((:plist= input '(:modifier nil :char #\↓)) (':
(move-player map :Δy 1)) (move-player map :Δy 1))
('t (otherwise
(list :map map)))) (list :map map))))
(list :map map))) (list :map map)))

12
ui.lisp
View File

@ -200,17 +200,19 @@ That is, 0 for non-selected items and 100 for selected items."
(defun process-menu-input (menu-alist) (defun process-menu-input (menu-alist)
"Get and process any keyboard input, modifying the menu alist as necessary." "Get and process any keyboard input, modifying the menu alist as necessary."
(if (listen) (if (listen)
(let* ((input (:normalize-char-plist (:read-char-plist))) (let* ((input (:read-gamefied-char-plist))
(selected-item (nth (selected-menu-item-position menu-alist) (selected-item (nth (selected-menu-item-position menu-alist)
menu-alist)) menu-alist))
(func (cdr (assoc 'function selected-item))) (func (cdr (assoc 'function selected-item)))
(return-val (assoc 'return selected-item))) (return-val (assoc 'return selected-item)))
(case (getf input :char) (case (getf input :semantic)
(#\(progn (select-right-menu-item menu-alist) (':(progn (select-right-menu-item menu-alist)
't)) 't))
(#\(progn (select-left-menu-item menu-alist) (':(progn (select-left-menu-item menu-alist)
't)) 't))
(#\return (':
nil)
(':🆗
(cond ((and func return-val) (cond ((and func return-val)
(apply func '()) (apply func '())
(cdr return-val)) (cdr return-val))