283 lines
14 KiB
Common Lisp
283 lines
14 KiB
Common Lisp
;;;; wh-engine/input/input-system.lisp
|
|
;;;; input system main code
|
|
(defpackage wh-engine/input
|
|
(:nicknames whe/input)
|
|
(:use common-lisp 3d-vectors 3d-matrices)
|
|
(:import-from sb-ext
|
|
weak-pointer weak-pointer-p make-weak-pointer weak-pointer-value)
|
|
(:import-from objective-lisp O!)
|
|
(:export))
|
|
|
|
(in-package wh-engine/input)
|
|
|
|
(defun input-system-init ()
|
|
"Initialize the input system."
|
|
())
|
|
|
|
(defun input-system-update ()
|
|
())
|
|
#|
|
|
(defmacro setup-keycode-translation-table (&rest rest)
|
|
(let ((table (gensym)))
|
|
`(let ((,table (make-hash-table)))
|
|
(setf ,@(loop for x from #x21 to #x40
|
|
nconc `((gethash ,x ,table) ,(code-char x)))
|
|
,@(loop for x from #x5b to #x7a
|
|
nconc `((gethash ,x ,table) ,(code-char x)))
|
|
,@(loop for (k v) on rest by #'cddr
|
|
nconc `((gethash ,k ,table) ,v)))
|
|
,table)))
|
|
|#
|
|
(defvar *keycode-translation-reverse-table* nil)
|
|
(defun setup-keycode-translation-table (&rest rest)
|
|
(let ((table (make-hash-table :size (+ (truncate (length rest) 2) 64)))
|
|
(reverse (make-hash-table :size (+ (truncate (length rest) 2) 64))))
|
|
(loop for x from #x21 to #x40
|
|
do (setf (gethash x table) (code-char x)
|
|
(gethash (code-char x) reverse) x))
|
|
(loop for x from #x5b to #x7a
|
|
do (setf (gethash x table) (code-char x)
|
|
(gethash (code-char x) reverse) x))
|
|
(loop for (k v) on rest by #'cddr
|
|
do (setf (gethash k table) v)
|
|
unless (gethash v reverse)
|
|
do (setf (gethash v reverse) k))
|
|
(setf *keycode-translation-reverse-table* reverse)
|
|
table))
|
|
(defvar *keycode-translation-table*
|
|
(setup-keycode-translation-table #x08 :backspace
|
|
#x09 :tab
|
|
#x0d :return
|
|
#x1b :escape
|
|
#x20 :space
|
|
#x7f :delete
|
|
#x40000039 :caps-lock
|
|
#x4000003A :f1
|
|
#x4000003B :f2
|
|
#x4000003C :f3
|
|
#x4000003D :f4
|
|
#x4000003E :f5
|
|
#x4000003F :f6
|
|
#x40000040 :f7
|
|
#x40000041 :f8
|
|
#x40000042 :f9
|
|
#x40000043 :f10
|
|
#x40000044 :f11
|
|
#x40000045 :f12
|
|
#x40000046 :print-screen
|
|
#x40000047 :scroll-lock
|
|
#x40000048 :pause
|
|
#x40000049 :insert
|
|
#x4000004A :home
|
|
#x4000004B :page-up
|
|
#x4000004D :end
|
|
#x4000004E :page-down
|
|
#x4000004F :right
|
|
#x40000050 :left
|
|
#x40000051 :down
|
|
#x40000052 :up
|
|
#x40000053 :num-lock
|
|
#x40000054 '(:keypad #\/)
|
|
#x40000055 '(:keypad #\*)
|
|
#x40000056 '(:keypad #\-)
|
|
#x40000057 '(:keypad #\+)
|
|
#x40000058 '(:keypad :return)
|
|
#x40000059 '(:keypad #\1)
|
|
#x4000005A '(:keypad #\2)
|
|
#x4000005B '(:keypad #\3)
|
|
#x4000005C '(:keypad #\4)
|
|
#x4000005D '(:keypad #\5)
|
|
#x4000005E '(:keypad #\6)
|
|
#x4000005F '(:keypad #\7)
|
|
#x40000060 '(:keypad #\8)
|
|
#x40000061 '(:keypad #\9)
|
|
#x40000062 '(:keypad #\0)
|
|
#x40000063 '(:keypad #\.)
|
|
#x40000065 :application
|
|
#x40000066 :power
|
|
#x40000067 '(:keypad #\=)
|
|
#x40000068 :f13
|
|
#x40000069 :f14
|
|
#x4000006A :f15
|
|
#x4000006B :f16
|
|
#x4000006C :f17
|
|
#x4000006D :f18
|
|
#x4000006E :f19
|
|
#x4000006F :f20
|
|
#x40000070 :f21
|
|
#x40000071 :f22
|
|
#x40000072 :f23
|
|
#x40000073 :f24
|
|
#x40000074 :execute
|
|
#x40000075 :help
|
|
#x40000076 :menu
|
|
#x40000077 :select
|
|
#x40000078 :stop
|
|
#x40000079 :again
|
|
#x4000007A :undo
|
|
#x4000007B :cut
|
|
#x4000007C :copy
|
|
#x4000007D :paste
|
|
#x4000007E :find
|
|
#x4000007F :mute
|
|
#x40000080 :volume+
|
|
#x40000081 :volume-
|
|
#x40000085 '(:keypad #\,)
|
|
#x40000086 '(:keypad :as400=)
|
|
#x40000099 :alt-erase
|
|
#x4000009A :sys-req
|
|
#x4000009B :cancel
|
|
#x4000009C :clear
|
|
#x4000009D :prior
|
|
#x4000009E :return-2
|
|
#x4000009F :separator
|
|
#x400000A0 :out
|
|
#x400000A1 :oper
|
|
#x400000A2 :clear-again
|
|
#x400000A3 :crsel
|
|
#x400000A4 :exsel
|
|
#x400000B0 '(:keypad "00")
|
|
#x400000B1 '(:keypad "000")
|
|
#x400000B2 :thousands-separator
|
|
#x400000B3 :decimal-separator
|
|
#x400000B4 :currency-unit
|
|
#x400000B5 :currency-sub-unit
|
|
#x400000B6 '(:keypad #\()
|
|
#x400000B7 '(:keypad #\))
|
|
#x400000B8 '(:keypad #\{)
|
|
#x400000B9 '(:keypad #\})
|
|
#x400000BA '(:keypad :tab)
|
|
#x400000BB '(:keypad :backspace)
|
|
#x400000BC '(:keypad #\a)
|
|
#x400000BD '(:keypad #\b)
|
|
#x400000BE '(:keypad #\c)
|
|
#x400000BF '(:keypad #\d)
|
|
#x400000C0 '(:keypad #\e)
|
|
#x400000C1 '(:keypad #\f)
|
|
#x400000C2 '(:keypad :xor)
|
|
#x400000C3 '(:keypad #\^)
|
|
#x400000C4 '(:keypad #\%)
|
|
#x400000C5 '(:keypad #\<)
|
|
#x400000C6 '(:keypad #\>)
|
|
#x400000C7 '(:keypad #\&)
|
|
#x400000C8 '(:keypad "&&")
|
|
#x400000C9 '(:keypad #\|)
|
|
#x400000CA '(:keypad "||")
|
|
#x400000CB '(:keypad #\:)
|
|
#x400000CC '(:keypad #\#)
|
|
#x400000CD '(:keypad :space)
|
|
#x400000CE '(:keypad #\@)
|
|
#x400000CF '(:keypad #\!)
|
|
#x400000D0 '(:keypad :mem-store)
|
|
#x400000D1 '(:keypad :mem-recall)
|
|
#x400000D2 '(:keypad :mem-clear)
|
|
#x400000D3 '(:keypad :mem+)
|
|
#x400000D4 '(:keypad :mem-)
|
|
#x400000D5 '(:keypad :mem*)
|
|
#x400000D6 '(:keypad :mem/)
|
|
#x400000D7 '(:keypad #\±)
|
|
#x400000D8 '(:keypad :clear)
|
|
#x400000D9 '(:keypad :clear-entry)
|
|
#x400000DA '(:keypad :binary)
|
|
#x400000DB '(:keypad :octal)
|
|
#x400000DC '(:keypad :decimal)
|
|
#x400000DD '(:keypad :hexadecimal)
|
|
;; modifiers
|
|
#x400000E0 :left-control
|
|
#x400000E1 :left-shift
|
|
#x400000E2 :left-meta
|
|
#x400000E3 :left-super
|
|
#x400000E4 :right-control
|
|
#x400000E5 :right-shift
|
|
#x400000E6 :right-meta
|
|
#x400000E7 :right-super
|
|
;; other keys
|
|
#x40000101 :mode
|
|
#x40000102 :media-next
|
|
#x40000103 :media-previous
|
|
#x40000104 :media-stop
|
|
#x40000105 :media-play
|
|
#x40000106 :audio-mute
|
|
#x40000107 :media-select
|
|
#x40000108 :web
|
|
#x40000109 :mail
|
|
#x4000010A :calculator
|
|
#x4000010B :computer
|
|
#x4000010C :application-search
|
|
#x4000010D :application-home
|
|
#x4000010E :application-back
|
|
#x4000010F :application-forward
|
|
#x40000110 :application-stop
|
|
#x40000111 :application-refresh
|
|
#x40000112 :application-bookmarks
|
|
#x40000113 :brightness-
|
|
#x40000114 :brightness+
|
|
#x40000115 :display-switch
|
|
#x40000116 :backlight
|
|
#x40000117 :backlight-
|
|
#x40000118 :backlight+
|
|
#x40000119 :eject
|
|
#x4000011A :sleep
|
|
))
|
|
|
|
(defun parse-keyspec (keyspec)
|
|
"Parse an Emacs-style key specification."
|
|
(declare (type simple-string keyspec))
|
|
;; 'C-': control, 'M-': meta, 'S-': shift, 'X-': super, 'K-': keypad
|
|
(let* ((keypad-p nil)
|
|
(ks keyspec)
|
|
(modifiers (loop while (and (> (length ks) 2) (char= (schar ks 1) #\-))
|
|
if (char= (schar ks 0) #\K)
|
|
do (setf keypad-p t)
|
|
(setf ks (subseq ks 2))
|
|
else
|
|
if (case (schar ks 0)
|
|
(#\C :control)
|
|
(#\M :meta)
|
|
(#\S :shift)
|
|
(#\X :super))
|
|
collect it
|
|
and do (setf ks (subseq ks 2))
|
|
else do (loop-finish)))
|
|
(key (cond
|
|
((= (length ks) 0)
|
|
(error "Invalid keyspec ~S" keyspec))
|
|
((= (length ks) 1)
|
|
(if (upper-case-p (schar ks 0))
|
|
(progn (setf modifiers (cons :shift modifiers))
|
|
(char-downcase (schar ks 0)))
|
|
(schar ks 0)))
|
|
((string= ks "SPC") :space)
|
|
((string= ks "RET") :return)
|
|
((string= ks "ESC") :escape)
|
|
((string= ks "DEL") :delete)
|
|
((string= ks "BS") :backspace)
|
|
(t (read-from-string ks)))
|
|
))
|
|
(values (if keypad-p `(:keypad ,key) key) modifiers)))
|
|
|
|
(defun on-key-down (key-sym)
|
|
(format t "key-down: ~S (mod ~S)~%"
|
|
(gethash (sdl2:sym-value key-sym) *keycode-translation-table*)
|
|
(sdl2:mod-keywords (sdl2:mod-value key-sym))))
|
|
|
|
(defun on-key-up (key-sym)
|
|
())
|
|
|
|
(defun on-mouse-move (mouse-location mouse-delta mouse-state)
|
|
())
|
|
|
|
(defun on-mouse-down (mouse-location mouse-button)
|
|
())
|
|
|
|
(defun on-mouse-up (mouse-location mouse-button)
|
|
())
|
|
|
|
(wh-engine:register-system :wh-engine/input 'input-system-init 'input-system-update
|
|
'((:keydown . on-key-down)
|
|
(:keyup . on-key-up)
|
|
(:mousemotion . on-mouse-move)
|
|
(:mousebuttondown . on-mouse-down)
|
|
(:mousebuttonup . on-mouse-up))
|
|
:dependencies '(:wh-engine/render))
|