Update of /project/pal/cvsroot/pal In directory clnet:/tmp/cvs-serv27783
Modified Files: pal-macros.lisp pal.lisp todo.txt Log Message: Removed MOUSE-BUTTON-DOWN/UP-FN from event handling functions. Use KEY-*-FN instead
--- /project/pal/cvsroot/pal/pal-macros.lisp 2007/07/03 18:10:33 1.3 +++ /project/pal/cvsroot/pal/pal-macros.lisp 2007/07/03 18:42:35 1.4 @@ -112,7 +112,7 @@ `(when ,fn (funcall ,fn ,@args)))
-(defmacro do-event (event key-up-fn key-down-fn mouse-motion-fn mouse-button-up-fn mouse-button-down-fn quit-fn) +(defmacro do-event (event key-up-fn key-down-fn mouse-motion-fn quit-fn) `(loop while (pal-ffi:poll-event ,event) do (let ((type (cffi:mem-ref ,event :uint8))) @@ -143,16 +143,18 @@ (funcall? ,mouse-motion-fn *mouse-x* *mouse-y*))
((= type pal-ffi:+mouse-button-up-event+) - (let ((button (cffi:foreign-slot-value ,event 'pal-ffi:mouse-button-event 'pal-ffi:button))) - (setf (gethash (read-from-string (format nil ":key-mouse-~a" button)) + (let* ((button (cffi:foreign-slot-value ,event 'pal-ffi:mouse-button-event 'pal-ffi:button)) + (keysym (read-from-string (format nil ":key-mouse-~a" button)))) + (setf (gethash keysym *pressed-keys*) nil) - (funcall? ,mouse-button-up-fn button))) + (funcall? ,key-up-fn keysym)))
((= type pal-ffi:+mouse-button-down-event+) - (let ((button (cffi:foreign-slot-value ,event 'pal-ffi:mouse-button-event 'pal-ffi:button) )) - (setf (gethash (read-from-string (format nil ":key-mouse-~a" button)) + (let* ((button (cffi:foreign-slot-value ,event 'pal-ffi:mouse-button-event 'pal-ffi:button)) + (keysym (read-from-string (format nil ":key-mouse-~a" button)))) + (setf (gethash keysym *pressed-keys*) t) - (funcall? ,mouse-button-down-fn button))) + (funcall? ,key-down-fn keysym)))
((= type pal-ffi:+quit-event+) (if ,quit-fn @@ -161,12 +163,12 @@ )))))
-(defmacro event-loop ((&key key-up-fn key-down-fn mouse-motion-fn mouse-button-up-fn mouse-button-down-fn quit-fn) &body redraw) +(defmacro event-loop ((&key key-up-fn key-down-fn mouse-motion-fn quit-fn) &body redraw) (let ((event (gensym))) `(block event-loop (cffi:with-foreign-object (,event :char 1000) (loop - (do-event ,event ,key-up-fn ,key-down-fn ,mouse-motion-fn ,mouse-button-up-fn ,mouse-button-down-fn ,quit-fn) + (do-event ,event ,key-up-fn ,key-down-fn ,mouse-motion-fn ,quit-fn) ,@redraw (update-screen))))))
--- /project/pal/cvsroot/pal/pal.lisp 2007/07/03 18:27:22 1.4 +++ /project/pal/cvsroot/pal/pal.lisp 2007/07/03 18:42:35 1.5 @@ -177,10 +177,10 @@ (defun get-mouse-y () *mouse-y*)
-(defun dispatch-event (&key key-up-fn key-down-fn mouse-motion-fn mouse-button-up-fn mouse-button-down-fn quit-fn) +(defun dispatch-event (&key key-up-fn key-down-fn mouse-motion-fn quit-fn) (block event-loop (cffi:with-foreign-object (event :char 100) - (do-event event key-up-fn key-down-fn mouse-motion-fn mouse-button-up-fn mouse-button-down-fn quit-fn)))) + (do-event event key-up-fn key-down-fn mouse-motion-fn quit-fn))))
(defun wait-keypress () (let ((key nil)) @@ -557,9 +557,6 @@ (ty (/ (- y dy) (pal-ffi:image-texture-height image)))) (pal-ffi:gl-tex-coord2f tx ty) (pal-ffi:gl-vertex2f x y)))))) - ((and (listp fill) image) - (set-image image) - ) ((eq nil fill) (pal-ffi:gl-push-attrib (logior pal-ffi:+gl-color-buffer-bit+ pal-ffi:+gl-current-bit+ pal-ffi:+gl-line-bit+ pal-ffi:+gl-enable-bit+)) (set-blend-color r g b a) @@ -578,7 +575,9 @@ (with-gl pal-ffi:+gl-polygon+ (dolist (p points) (pal-ffi:gl-vertex2f (vx p) (vy p)))) - (pal-ffi:gl-pop-attrib)))) + (pal-ffi:gl-pop-attrib)) + (t + (set-image image))))
--- /project/pal/cvsroot/pal/todo.txt 2007/07/03 18:10:33 1.3 +++ /project/pal/cvsroot/pal/todo.txt 2007/07/03 18:42:35 1.4 @@ -21,3 +21,4 @@
- Make it run on OS X.
+- TrueType font support.