Abstract the semantic meaning of key from the char
This lets us do cool looking stuff, like '⌨:🆗
This commit is contained in:
parent
bc74f43f9a
commit
6849968528
|
@ -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: I’m paying. =w="
|
If not, have some tea on me: I’m 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)
|
||||||
|
|
50
input.lisp
50
input.lisp
|
@ -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”)."
|
||||||
|
|
|
@ -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)))
|
||||||
|
|
||||||
|
|
16
ui.lisp
16
ui.lisp
|
@ -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))
|
||||||
|
|
Ŝarĝante…
Reference in New Issue