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!
|
||||
If not, have some tea on me: I’m paying. =w="
|
||||
(and (listen)
|
||||
(eq (getf (⌨:normalize-char-plist (⌨:read-char-plist)) :char)
|
||||
#\return)))
|
||||
(let ((input (getf (⌨:read-gamefied-char-plist) :semantic)))
|
||||
(or (eq input '⌨:🆗)
|
||||
(eq input '⌨:❎)))))
|
||||
|
||||
|
||||
|
||||
|
@ -138,9 +139,10 @@ data, using :SET and :TO of the DIALOGUE."
|
|||
(key (getf dialogue :set))
|
||||
(data (getf dialogue :to)))
|
||||
(when (and key data)
|
||||
(format *error-output* "[~A] ~A → ~A???~%" dialogue key data)
|
||||
(setf (🌍:getf-entity-data map speaker key) data)
|
||||
(format *error-output* "~A!!!!~%" (🌍:getf-entity-data map speaker :normal-face)))))
|
||||
(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)))))
|
||||
|
||||
|
||||
(defun progress-line-delivery (dialogue)
|
||||
|
|
50
input.lisp
50
input.lisp
|
@ -19,25 +19,47 @@
|
|||
(defpackage :flora-search-aurora.input
|
||||
(:use :cl)
|
||||
(: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
|
||||
+qwerty-layout+ +dvorak-layout+))
|
||||
+qwerty-layout+ +dvorak-layout+
|
||||
+arrows-game-layout+ +wasd-game-layout+ +ijkl-game-layout+
|
||||
:↑ :← :→ :↓ :🆗 :❎))
|
||||
|
||||
(in-package :flora-search-aurora.input)
|
||||
|
||||
|
||||
;; Yup, they're hardcoded like this. Horrid, ain't it? ^_^
|
||||
(defvar +qwerty-layout+
|
||||
'(#\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 #\; #\: #\' #\"
|
||||
#\z #\Z #\x #\X #\c #\C #\v #\V #\b #\B #\n #\N #\m #\M #\, #\< #\. #\> #\/ #\?))
|
||||
|
||||
|
||||
(defvar +dvorak-layout+
|
||||
'(#\' #\" #\, #\< #\. #\> #\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 #\- #\_
|
||||
#\; #\: #\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*))
|
||||
"Reads a character directly from standard-input (sans buffering).
|
||||
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+))
|
||||
"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."
|
||||
(let ((normalized (deescape-char-plist char-plist)))
|
||||
(setf (getf normalized :char)
|
||||
|
@ -81,6 +103,26 @@ Not at all comprehensive, but probably-mostly-just-good-enough. ¯\_ (ツ)_/¯"
|
|||
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)
|
||||
"Translate escaped characters into somewhat-semantically-adjacent
|
||||
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)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;;; ———————————————————————————————————
|
||||
;;; Overworld logic
|
||||
|
@ -216,10 +213,10 @@ Returns parameters to be used in the next invocation of OVERWORLD-STATE."
|
|||
(defun process-overworld-input (map)
|
||||
"Get and process any keyboard input, modifying the map or entities as necessary."
|
||||
(if (listen)
|
||||
(let* ((input (⌨:normalize-char-plist (⌨:read-char-plist))))
|
||||
(cond
|
||||
(let* ((input (⌨:read-gamefied-char-plist)))
|
||||
(case (getf input :semantic)
|
||||
;; Interacting with nearby characters/entities
|
||||
((…:plist= input '(:modifier nil :char #\return))
|
||||
('⌨:🆗
|
||||
(let* ((player (getf-entity map 'player))
|
||||
(interactee (car (entities-near-entity player (gethash :entities map))))
|
||||
(interactee-id (car interactee))
|
||||
|
@ -230,15 +227,15 @@ Returns parameters to be used in the next invocation of OVERWORLD-STATE."
|
|||
;; The pause-menu…
|
||||
;; ((plist = input '(:modifier nil :char #\Esc)))
|
||||
;; Simple up-down-left-right movements
|
||||
((…:plist= input '(:modifier nil :char #\→))
|
||||
('⌨:→
|
||||
(move-player map :Δx 1))
|
||||
((…:plist= input '(:modifier nil :char #\←))
|
||||
('⌨:→
|
||||
(move-player map :Δx -1))
|
||||
((…:plist= input '(:modifier nil :char #\↑))
|
||||
('⌨:↑
|
||||
(move-player map :Δy -1))
|
||||
((…:plist= input '(:modifier nil :char #\↓))
|
||||
('⌨:↓
|
||||
(move-player map :Δy 1))
|
||||
('t
|
||||
(otherwise
|
||||
(list :map map))))
|
||||
(list :map map)))
|
||||
|
||||
|
|
12
ui.lisp
12
ui.lisp
|
@ -200,17 +200,19 @@ That is, 0 for non-selected items and 100 for selected items."
|
|||
(defun process-menu-input (menu-alist)
|
||||
"Get and process any keyboard input, modifying the menu alist as necessary."
|
||||
(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)
|
||||
menu-alist))
|
||||
(func (cdr (assoc 'function selected-item)))
|
||||
(return-val (assoc 'return selected-item)))
|
||||
(case (getf input :char)
|
||||
(#\→ (progn (select-right-menu-item menu-alist)
|
||||
(case (getf input :semantic)
|
||||
('⌨:→ (progn (select-right-menu-item menu-alist)
|
||||
't))
|
||||
(#\← (progn (select-left-menu-item menu-alist)
|
||||
('⌨:← (progn (select-left-menu-item menu-alist)
|
||||
't))
|
||||
(#\return
|
||||
('⌨:❎
|
||||
nil)
|
||||
('⌨:🆗
|
||||
(cond ((and func return-val)
|
||||
(apply func '())
|
||||
(cdr return-val))
|
||||
|
|
Ŝarĝante…
Reference in New Issue