Permalink
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
193 lines (183 sloc) 8.4 KB
#|
This file is a part of trial
(c) 2018 Shirakumo http://tymoon.eu (shinmera@tymoon.eu)
Author: Nicolas Hafner <shinmera@tymoon.eu>
|#
(in-package #:org.shirakumo.fraf.trial)
(defparameter *prompt-char-table*
(macrolet ((-> (&rest entries)
`(let ((tab (make-hash-table :test 'eq)))
,@(loop for (k c) in entries
collect `(setf (gethash ',k tab) ,(code-char c)))
tab)))
(list :devices (-> (:GAMEPAD #x243C)
(:KEYBOARD #x243D)
(:MOUSE #x243E)
(:KEYBOARD-MOUSE #x243F))
:gamepad (-> (:DEVICE #x243C)
(:DPAD-L #x219E)
(:DPAD-U #x219F)
(:DPAD-R #x21A0)
(:DPAD-D #x21A1)
(:X #x21A4)
(:Y #x21A5)
(:B #x21A6)
(:A #x21A7)
(:L1 #x21B0)
(:R1 #x21B1)
(:L2 #x21B2)
(:R2 #x21B3)
(:L #x21BA)
(:R #x21BB)
(:L-L #x21BC)
(:R-L #x21BD)
(:L-U #x21BE)
(:R-U #x21BF)
(:L-R #x21C0)
(:R-R #x21C1)
(:L-D #x21C2)
(:R-D #x21C3)
(:A-L #x21C7)
(:A-U #x21C8)
(:A-R #x21C9)
(:A-D #x21CA)
(:A-UL #x21D6)
(:A-UR #x21D7)
(:A-DR #x21D8)
(:A-DL #x21D9)
(:SELECT #x21F7)
(:START #x21F8)
(:HOME #x21F9))
:keyboard (-> (:DEVICE #x243D)
(:| | #x0020)
(:! #x0021)
(:|"| #x0022)
(:|#| #x0023)
(:$ #x0024)
(:% #x0025)
(:& #x0026)
(:|'| #x0027)
(:|(| #x0028)
(:|)| #x0029)
(:* #x002A)
(:+ #x002B)
(:|,| #x002C)
(:- #x002D)
(:|.| #x002E)
(:/ #x002F)
(:|0| #x0030)
(:|1| #x0031)
(:|2| #x0032)
(:|3| #x0033)
(:|4| #x0034)
(:|5| #x0035)
(:|6| #x0036)
(:|7| #x0037)
(:|8| #x0038)
(:|9| #x0039)
(:|:| #x003A)
(:|;| #x003B)
(:< #x003C)
(:= #x003D)
(:> #x003E)
(:? #x003F)
(:@ #x0040)
(:A #x0041)
(:B #x0042)
(:C #x0043)
(:D #x0044)
(:E #x0045)
(:F #x0046)
(:G #x0047)
(:H #x0048)
(:I #x0049)
(:J #x004A)
(:K #x004B)
(:L #x004C)
(:M #x004D)
(:N #x004E)
(:O #x004F)
(:P #x0050)
(:Q #x0051)
(:R #x0052)
(:S #x0053)
(:T #x0054)
(:U #x0055)
(:V #x0056)
(:W #x0057)
(:X #x0058)
(:Y #x0059)
(:Z #x005A)
(:[ #x005B)
(:|\\| #x005C)
(:] #x005D)
(:^ #x005E)
(:_ #x005F)
(:|`| #x0060)
(:{ #x007B)
(:|\|| #x007C)
(:} #x007D)
(:~ #x007E)
(:LEFT #x2190)
(:UP #x2191)
(:RIGHT #x2192)
(:DOWN #x2193)
(:CTRL #x2427)
(:ALT #x2428)
(:SHIFT #x2429)
(:SUPER #x242A)
(:TAB #x242B)
(:CAPS #x242C)
(:BACKSPACE #x242D)
(:ENTER #x242E)
(:ESC #x242F)
(:PRTSC #x2430)
(:SCRLK #x2431)
(:PAUSE #x2432)
(:NUMLOCK #x2433)
(:INSERT #x2434)
(:HOME #x2435)
(:PAGEUP #x2436)
(:DELETE #x2437)
(:END #x2438)
(:PAGEDOWN #x2439)
(:F1 #x2460)
(:F2 #x2461)
(:F3 #x2462)
(:F4 #x2463)
(:F5 #x2464)
(:F6 #x2465)
(:F7 #x2466)
(:F8 #x2467)
(:F9 #x2468)
(:F10 #x2469)
(:F11 #x246A)
(:F12 #x246B))
:mouse (-> (:DEVICE #x243D)
(:LEFT #x27F5)
(:RIGHT #x27F6)
(:MIDDLE #x27F7)
(:SCROLL-U #x27F0)
(:SCROLL-D #x27F1)))))
(defun prompt-char (thing &key (bank :gamepad))
(let ((table (getf *prompt-char-table* bank)))
(when table (gethash thing table))))
(defun prompt-charset ()
(sort (delete-duplicates
(with-output-to-string (out)
(loop for (bank table) on *prompt-char-table* by #'cddr
do (loop for string being the hash-values of table
do (write-char string out)))))
#'char<))
(define-asset (trial prompt-font) font
#p"PromptFont.ttf"
:charset (prompt-charset)
:size 64)
(define-shader-subject prompt (text)
((texture :initform (asset 'trial 'prompt-font))))
(defmethod (setf text) ((character character) (prompt prompt))
(setf (text prompt) (string character)))
(defmethod (setf text) ((symbol symbol) (prompt prompt))
(setf (text prompt) (string (prompt-char symbol))))
(defmethod (setf prompt-icon) (char (prompt prompt) &key (bank :gamepad))
(setf (text prompt) (string (prompt-char char :bank bank))))