diff --git a/run.lisp b/run.lisp index 0a02493..f2a20fb 100644 --- a/run.lisp +++ b/run.lisp @@ -5,3 +5,8 @@ (asdf:load-system 'wh-engine) (format t "**** wh-engine READY! ****~%") + +(defun run-test () + (wh-engine:install-systems :wh-engine/input) + (wh-engine:register-test-scene) + (eval '(wh-engine:run))) diff --git a/wh-engine.asd b/wh-engine.asd index 811930a..65c7c81 100644 --- a/wh-engine.asd +++ b/wh-engine.asd @@ -20,5 +20,6 @@ (:file "render/render-system") (:file "render/drawable") (:file "render/view") + (:file "input/input-system") (:file "main")) ))) diff --git a/wh-engine/input/input-system.lisp b/wh-engine/input/input-system.lisp new file mode 100644 index 0000000..9f98992 --- /dev/null +++ b/wh-engine/input/input-system.lisp @@ -0,0 +1,282 @@ +;;;; 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)) diff --git a/wh-engine/main.lisp b/wh-engine/main.lisp index 89c374c..18bb4cd 100644 --- a/wh-engine/main.lisp +++ b/wh-engine/main.lisp @@ -71,21 +71,106 @@ (sdl2:with-event-loop (:method :poll) (:quit () t) - (:idle () - (setf prev-profiling-tick (sdl2:get-performance-counter)) - ;; calculate delta-time - (setf this-tick (sdl2:get-ticks)) - (setf *delta-time* (* (- this-tick prev-tick) 0.001)) - (setf prev-tick this-tick) - (format t "~%Δt = ~S (~S FPS)~%" *delta-time* (/ 1.0 *delta-time*)) - ;; update - (loop for scene in *world* - do (o! scene (update))) - (format t "game=~S " (/ (- (sdl2:get-performance-counter) prev-profiling-tick) profiling-scale)) - ,@(loop for system in *world-systems* - append `((,(third system)) - (format t ,(format nil "~S~A" (first system) "=~S ") - (/ (- (sdl2:get-performance-counter) prev-profiling-tick) profiling-scale)) - )) - (sdl2:gl-swap-window win))) + (:idle + () + + (setf prev-profiling-tick (sdl2:get-performance-counter)) + ;; calculate delta-time + (setf this-tick (sdl2:get-ticks)) + (setf *delta-time* (* (- this-tick prev-tick) 0.001)) + (setf prev-tick this-tick) + ;(format t "~%Δt = ~S (~S FPS)~%" *delta-time* (/ 1.0 *delta-time*)) + ;; update + (loop for scene in *world* + do (o! scene (update))) + ;(format t "game=~S " (/ (- (sdl2:get-performance-counter) prev-profiling-tick) profiling-scale)) + ,@(loop for system in *world-systems* + append `((,(third system)) + #| + (format t ,(format nil "~S~A" (first system) "=~S ") + (/ (- (sdl2:get-performance-counter) prev-profiling-tick) profiling-scale)) + |# + )) + (sdl2:gl-swap-window win)) + (:keydown + (:keysym keysym) + + ,@(loop for system in *world-systems* + for handler = (assoc :keydown (fourth system)) + when handler + collect `(,(cdr handler) keysym))) + (:keyup + (:keysym keysym) + + ,@(loop for system in *world-systems* + for handler = (assoc :keyup (fourth system)) + when handler + collect `(,(cdr handler) keysym))) + (:mousemotion + (:x mouse-x :y mouse-y :xrel delta-x :yrel delta-y :state state) + + ,@(loop for system in *world-systems* + for handler = (assoc :mousemotion (fourth system)) + when handler + collect `(,(cdr handler) + (vec2 (truncate mouse-x whe/render:*pixel-scale*) + (truncate mouse-y whe/render:*pixel-scale*)) + (vec2 (truncate delta-x whe/render:*pixel-scale*) + (truncate delta-y whe/render:*pixel-scale*)) + state))) + (:mousebuttondown + (:x mouse-x :y mouse-y :button button) + + ,@(loop for system in *world-systems* + for handler = (assoc :mousebuttondown (fourth system)) + when handler + collect `(,(cdr handler) + (vec2 (truncate mouse-x whe/render:*pixel-scale*) + (truncate mouse-y whe/render:*pixel-scale*)) + button))) + (:mousebuttonup + (:x mouse-x :y mouse-y :button button) + + ,@(loop for system in *world-systems* + for handler = (assoc :mousebuttonup (fourth system)) + when handler + collect `(,(cdr handler) + (vec2 (truncate mouse-x whe/render:*pixel-scale*) + (truncate mouse-y whe/render:*pixel-scale*)) + button))) + (:joyaxismotion + (:which joy-id :axis axis :value value) + + ,@(loop for system in *world-systems* + for handler = (assoc :joyaxismotion (fourth system)) + when handler + collect `(,(cdr handler) joy-id axis value))) + (:joyballmotion + (:which joy-id :ball ball :xrel delta-x :yrel delta-y) + + ,@(loop for system in *world-systems* + for handler = (assoc :joyballmotion (fourth system)) + when handler + collect `(,(cdr handler) joy-id ball (vec2 delta-x delta-y)))) + (:joyhatmotion + (:which joy-id :hat hat :value value) + + ,@(loop for system in *world-systems* + for handler = (assoc :joyhatmotion (fourth system)) + when handler + collect `(,(cdr handler) joy-id hat value))) + (:joybuttondown + (:which joy-id :button button) + + ,@(loop for system in *world-systems* + for handler = (assoc :joybuttondown (fourth system)) + when handler + collect `(,(cdr handler) joy-id button))) + (:joybuttonup + (:which joy-id :button button) + + ,@(loop for system in *world-systems* + for handler = (assoc :joybuttonup (fourth system)) + when handler + collect `(,(cdr handler) joy-id button)))) ))))) diff --git a/wh-engine/systems.lisp b/wh-engine/systems.lisp index 6384a00..2de1135 100644 --- a/wh-engine/systems.lisp +++ b/wh-engine/systems.lisp @@ -6,12 +6,18 @@ "Alist of defined systems.") (defvar *world-systems* () - "List of enabled systems.") + "List of installed systems.") -(defun register-system (name init-fun-symbol update-fun-symbol sdl-event-rules) - (push `(,name ,init-fun-symbol ,update-fun-symbol ,sdl-event-rules) *system-registry*)) +(defun register-system (name init-fun-symbol update-fun-symbol sdl-event-rules + &key dependencies) + (push `(,name ,init-fun-symbol ,update-fun-symbol + ,sdl-event-rules + ,dependencies) + *system-registry*)) (defun install-systems (&rest systems) (loop for system-name in systems for system = (assoc system-name *system-registry*) - do (push system *world-systems*))) + do (pushnew system *world-systems*) + ;; install dependencies + (apply #'install-systems (fifth system))))