Update of /project/pal/cvsroot/pal In directory clnet:/tmp/cvs-serv5293
Modified Files: ffi.lisp package.lisp pal-macros.lisp pal.lisp vector.lisp Log Message: Fixed problems loading the .so's under Linux. TAG thunks must now only return objects of type PAL:RESOURCE.
--- /project/pal/cvsroot/pal/ffi.lisp 2007/07/03 18:10:33 1.3 +++ /project/pal/cvsroot/pal/ffi.lisp 2007/07/09 18:17:44 1.4 @@ -5,23 +5,23 @@
(cffi:define-foreign-library sdl - (:windows "SDL") - (:linux "libSDL-1.2.so.0")) + (:windows "SDL") + (:unix (:or "libSDL-1.2.so.0" "libSDL-1.2.so")))
(cffi:define-foreign-library sdl-mixer - (:windows "SDL_mixer") - (:linux "libSDL_mixer-1.2.so.0")) + (:windows "SDL_mixer") + (:unix (:or "libSDL_mixer-1.2.so.0" "libSDL_mixer-1.2.so")))
(cffi:define-foreign-library sdl-image - (:windows "SDL_image") - (:linux "libSDL_image-1.2.so.0")) + (:windows "SDL_image") + (:unix (:or "libSDL_image-1.2.so.0" "libSDL_image-1.2.so")))
(cffi:define-foreign-library opengl - (:windows "opengl32.dll") - (:linux "libGL.so")) + (:windows "opengl32.dll") + (:unix (:or "libGL.so")))
#+win32 (cffi:define-foreign-library shell32 - (:windows "shell32.dll")) + (:windows "shell32.dll"))
(defun load-foreign-libraries () (cffi:use-foreign-library sdl) @@ -72,19 +72,19 @@
(cffi:defcstruct rectangle - (x :short) + (x :short) (y :short) (w :uint16) (h :uint16))
(cffi:defcstruct color - (r :uint8) + (r :uint8) (g :uint8) (b :uint8) (unused :uint8))
(cffi:defcstruct surface - (flags :uint) + (flags :uint) (pixelformat :pointer) (w :int) (h :int) @@ -100,7 +100,7 @@ (refcount :int))
(cffi:defcstruct pixelformat - (palette :pointer) + (palette :pointer) (BitsPerPixel :uint8) (BytesPerPixel :uint8) (Rloss :uint8) @@ -119,40 +119,40 @@ (alpha :uint8))
(cffi:defcstruct keysym - (scancode :uint8) + (scancode :uint8) (sym :int) (mod :int) (unicode :uint16))
(cffi:defcstruct keyboard-event - (type :uint8) + (type :uint8) (state :uint8) (keysym keysym))
(cffi:defcstruct mouse-button-event - (type :uint8) + (type :uint8) (which :uint8) (button :uint8) (state :uint8) (x :uint16) (y :uint16))
(cffi:defcstruct mouse-motion-event - (type :uint8) + (type :uint8) (which :uint8) (state :uint8) (x :uint16) (y :uint16) (xrel :int16) (yrel :int16))
(cffi:defcstruct quit-event - (type :uint8)) + (type :uint8))
(cffi:defcstruct active-event - (type :uint8) + (type :uint8) (gain :uint8) (state :uint8))
(cffi:defcstruct resize-event - (type :uint8) + (type :uint8) (w :int) (h :int))
@@ -169,7 +169,7 @@ (defconstant +expose-event+ 17)
(cffi:defcenum sdl-key - (:key-unknown 0) + (:key-unknown 0) (:key-first 0) (:key-backspace 8) (:key-tab 9) @@ -405,7 +405,7 @@ :key-last)
(cffi:defcenum sdl-mod - (:mod-none #x0000) + (:mod-none #x0000) (:mod-lshift #x0001) (:mod-rshift #x0002) (:mod-lctrl #x0040) @@ -446,11 +446,21 @@ (defstruct sample chunk)
+ +(deftype resource () '(or music sample image font)) + +(defun resource-p (object) + (typep object 'resource)) + + + (defgeneric register-resource (resource)) (defgeneric free-resource (resource)) (defgeneric free-all-resources ())
+ (defmethod register-resource (resource) + (assert (resource-p resource)) (push resource *resources*) resource)
@@ -472,8 +482,7 @@ (defmethod free-all-resources () (dolist (r *resources*) (free-resource r)) - (when *resources* - (error "Allocated resources left: ~a" *resources*))) + (assert (null *resources*)))
--- /project/pal/cvsroot/pal/package.lisp 2007/07/03 18:10:33 1.2 +++ /project/pal/cvsroot/pal/package.lisp 2007/07/09 18:17:44 1.3 @@ -15,6 +15,8 @@ #:load-foreign-libraries #:sample #:music + #:resource + #:resource-p #:sample-p #:music-p #:gl-get-error @@ -345,7 +347,7 @@ (:use :common-lisp) (:import-from :pal-ffi #:free-resource #:register-resource #:load-foreign-libraries - #:image-p #:image #:font #:font-p #:sample #:music #:sample-p #:music-p + #:image-p #:image #:font #:font-p #:sample #:music #:sample-p #:music-p #:resource #:resource-p #:image-width #:image-height #:u8 #:u11 #:u16) (:export #:open-pal @@ -431,7 +433,7 @@ #:halt-music
#:v #:vec #:copy-vec #:angle-v #:v-angle #:vx #:vy - #:v= #:v-round #:v-random + #:v= #:v-round #:v-floor #:v-random #:v+ #:v+! #:v- #:v-! #:v* #:v*! #:v/ #:v/! #:v-max #:v-min #:v-rotate #:v-dot #:v-magnitude #:v-normalize #:v-distance #:v-truncate #:v-direction --- /project/pal/cvsroot/pal/pal-macros.lisp 2007/07/03 18:42:35 1.4 +++ /project/pal/cvsroot/pal/pal-macros.lisp 2007/07/09 18:17:44 1.5 @@ -22,11 +22,14 @@ (define-tags default-font (load-font "default-font")))
(defun tag (name) + (declare (type symbol name)) (let ((resource (gethash name *tags*))) (if resource (if (cdr resource) - (cdr resource) - (setf (cdr resource) (funcall (car resource)))) + (the resource (cdr resource)) + (let ((r (funcall (car resource)))) + (assert (resource-p r)) + (the resource (setf (cdr resource) r)))) (error "Named resource ~a not found" name))))
(defmacro with-resource ((resource init-form) &body body) @@ -151,7 +154,7 @@
((= type pal-ffi:+mouse-button-down-event+) (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)))) + (keysym (read-from-string (format nil ":key-mouse-~a" button)))) (setf (gethash keysym *pressed-keys*) t) (funcall? ,key-down-fn keysym))) --- /project/pal/cvsroot/pal/pal.lisp 2007/07/04 18:41:12 1.7 +++ /project/pal/cvsroot/pal/pal.lisp 2007/07/09 18:17:44 1.8 @@ -1,3 +1,10 @@ +;; are the texture options sane for draw-poly etc. +;; tags-resources-free? +;; animations +;; circle/box/point overlap functions +;; resources should check for void when freeing +;; sdl window not on top? + (declaim (optimize (speed 3) (safety 3)))
@@ -136,7 +143,7 @@ (if #-:clisp (probe-file path) #+:clisp (ext:probe-directory path) (pushnew path *data-paths*) - (warn "Illegal data path: ~a" path))) + (format *debug-io* "Illegal data path: ~a" path)))
(defun data-path (file) (let ((result nil)) --- /project/pal/cvsroot/pal/vector.lisp 2007/07/03 18:10:33 1.2 +++ /project/pal/cvsroot/pal/vector.lisp 2007/07/09 18:17:44 1.3 @@ -53,6 +53,12 @@ (declare (type vec v)) (v (round (vx v)) (round (vy v))))
+(declaim (inline v-floor)) +(defun v-floor (v) + (declare (type vec v)) + (v (floor (vx v)) (floor (vy v)))) + + (declaim (inline v=)) (defun v= (a b) (and (= (vx a) (vx b))
-
tneste