1 ;;; Gacela, a GNU Common Lisp extension for fast games development
2 ;;; Copyright (C) 2009 by Javier Sancho Fernandez <jsf at jsancho dot org>
4 ;;; This program is free software: you can redistribute it and/or modify
5 ;;; it under the terms of the GNU General Public License as published by
6 ;;; the Free Software Foundation, either version 3 of the License, or
7 ;;; (at your option) any later version.
9 ;;; This program is distributed in the hope that it will be useful,
10 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
11 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 ;;; GNU General Public License for more details.
14 ;;; You should have received a copy of the GNU General Public License
15 ;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
18 (eval-when (compile load eval)
19 (when (not (find-package 'gacela)) (make-package 'gacela :nicknames '(gg) :use '(lisp)))
20 (in-package 'gacela :nicknames '(gg) :use '(lisp)))
24 (defconstant SDL_NOEVENT 0)
25 (defconstant SDL_ACTIVEEVENT 1)
26 (defconstant SDL_KEYDOWN 2)
27 (defconstant SDL_KEYUP 3)
28 (defconstant SDL_MOUSEMOTION 4)
29 (defconstant SDL_MOUSEBUTTONDOWN 5)
30 (defconstant SDL_MOUSEBUTTONUP 6)
31 (defconstant SDL_JOYAXISMOTION 7)
32 (defconstant SDL_JOYBALLMOTION 8)
33 (defconstant SDL_JOYHATMOTION 9)
34 (defconstant SDL_JOYBUTTONDOWN 10)
35 (defconstant SDL_JOYBUTTONUP 11)
36 (defconstant SDL_QUIT 12)
37 (defconstant SDL_SYSWMEVENT 13)
38 (defconstant SDL_EVENT_RESERVEDA 14)
39 (defconstant SDL_EVENT_RESERVEDB 15)
40 (defconstant SDL_VIDEORESIZE 16)
41 (defconstant SDL_VIDEOEXPOSE 17)
42 (defconstant SDL_EVENT_RESERVED2 18)
43 (defconstant SDL_EVENT_RESERVED3 19)
44 (defconstant SDL_EVENT_RESERVED4 20)
45 (defconstant SDL_EVENT_RESERVED5 21)
46 (defconstant SDL_EVENT_RESERVED6 22)
47 (defconstant SDL_EVENT_RESERVED7 23)
48 (defconstant SDL_USEREVENT 24)
49 (defconstant SDL_NUMEVENTS 32)
52 (defun get-event (events &rest types)
55 (cond ((member (getf l :type) types) l)))
59 (let ((event (SDL_PollEvent)))
60 (cond ((null event) nil)
61 (t (cons event (poll-events))))))
63 (defun process-events ()
64 (let ((events (poll-events)))
65 (quit? t (and (get-event events SDL_QUIT) t))
67 (process-keyboard-events (get-event events SDL_KEYDOWN SDL_KEYUP))))
69 (let (will-happen happenings)
70 (defun next-happenings ()
71 (setq happenings will-happen)
72 (setq will-happen nil))
74 (defun will-happen (happening)
75 (setq will-happen (cons happening will-happen)))
77 (defun is-happening? (happening &optional (test #'eql))
80 (cond ((funcall test happening l) l)))
84 (defun quit? (&optional change newquit)
85 (if change (setq quit newquit) quit)))
87 (defun process-keyboard-events (events)
89 (let ((event (car events)))
90 (cond ((= (getf event :type) SDL_KEYDOWN) (key-press (getf event :key.keysym.sym)))
91 ((= (getf event :type) SDL_KEYUP) (key-release (getf event :key.keysym.sym)))))
92 (process-keyboard-events (cdr events)))))
94 (let ((keymap (make-hash-table))
95 (pressed (make-hash-table))
96 (released (make-hash-table)))
98 (gethash (get-keycode key) keymap))
100 (defun key-pressed? (key)
101 (gethash (get-keycode key) pressed))
103 (defun key-released? (key)
104 (gethash (get-keycode key) released))
106 (defun key-press (key-code)
107 (setf (gethash key-code keymap) t)
108 (setf (gethash key-code pressed) t)
109 (setf (gethash key-code released) nil))
111 (defun key-release (key-code)
112 (setf (gethash key-code keymap) nil)
113 (setf (gethash key-code pressed) nil)
114 (setf (gethash key-code released) t))
116 (defun clear-keymap ()
119 (defun clear-key-state ()
181 (defun get-keycode (keyname)
182 (car (rassoc keyname keys)))
184 (defun get-keyname (keycode)
185 (cdr (assoc keycode keys))))