[pal-cvs] CVS pal

[tneste]

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 , at 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)
             , at 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.