[pal-cvs] CVS pal
tneste
tneste at common-lisp.net
Mon Jul 9 18:17:44 UTC 2007
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))
More information about the Pal-cvs
mailing list