July 2007 - pal-cvs@common-lisp.net - mailman3.common-lisp.net

[pal-cvs] CVS pal
by tneste 16 Jul '07

16 Jul '07

Update of /project/pal/cvsroot/pal In directory clnet:/tmp/cvs-serv16636 Modified Files: pal-macros.lisp pal.lisp Log Message: Added smoothp option to draw-polygon/line/point/rectangle. RGBA values now have effect on textured images drawn with aforementioned functions. Removed some unnecessary gl-state pushing.(+gl-color-buffer-bit+) --- /project/pal/cvsroot/pal/pal-macros.lisp 2007/07/13 13:21:04 1.6 +++ /project/pal/cvsroot/pal/pal-macros.lisp 2007/07/16 20:46:24 1.7 @@ -18,8 +18,7 @@ (maphash (lambda (k v) (declare (ignore k)) (setf (cdr v) nil)) - *tags*) - (define-tags default-font (load-font "default-font"))) + *tags*)) (defun tag (name) (declare (type symbol name)) @@ -82,6 +81,18 @@ ,@body (pal-ffi:gl-end))) +(defmacro with-line-settings (smoothp size r g b a &body body) + `(progn + (pal-ffi:gl-push-attrib (logior pal-ffi:+gl-current-bit+ pal-ffi:+gl-line-bit+ pal-ffi:+gl-enable-bit+)) + (pal-ffi:gl-disable pal-ffi:+gl-texture-2d+) + (set-blend-color ,r ,g ,b ,a) + (pal-ffi:gl-line-width ,size) + (if ,smoothp + (pal-ffi:gl-enable pal-ffi:+gl-line-smooth+) + (pal-ffi:gl-disable pal-ffi:+gl-line-smooth+)) + ,@body + (pal-ffi:gl-pop-attrib))) + (defmacro randomly (p &body body) `(when (= (random ,p) 0) ,@body)) --- /project/pal/cvsroot/pal/pal.lisp 2007/07/16 14:44:12 1.11 +++ /project/pal/cvsroot/pal/pal.lisp 2007/07/16 20:46:24 1.12 @@ -80,9 +80,9 @@ (pal-ffi:gl-ortho 0d0 (coerce width 'double-float) (coerce height 'double-float) 0d0 -1d0 1d0) (pal-ffi:gl-matrix-mode pal-ffi:+gl-modelview+) (pal-ffi:gl-load-identity) - (pal-ffi:gl-alpha-func pal-ffi:+gl-greater+ 0.0f0) (clear-screen 0 0 0) (reset-tags) + (define-tags default-font (load-font "default-font")) (setf *data-paths* nil *messages* nil *pressed-keys* (make-hash-table :test 'eq) @@ -215,7 +215,6 @@ (declare (type simple-string m)) (draw-text m (v 0 (incf y fh)))))) -(declaim (inline update-screen)) (defun update-screen () (let ((e (pal-ffi:gl-get-error))) (unless (= e 0) @@ -365,10 +364,10 @@ (cffi:mem-ref b :uint8) (cffi:mem-ref a :uint8))))) -(defun image-from-array (smooth-p array) +(defun image-from-array (smoothp array) (image-from-fn (array-dimension array 0) (array-dimension array 1) - smooth-p + smoothp (lambda (y x) (let ((pixel (aref array x y))) (values (first pixel) @@ -377,7 +376,7 @@ (fourth pixel)))))) -(defun image-from-fn (width height smooth-p fn) +(defun image-from-fn (width height smoothp fn) (let* ((mode pal-ffi:+gl-rgb+) (width (min 1024 width)) (height (min 1024 height)) @@ -403,8 +402,8 @@ (cffi:mem-ref tdata :uint8 (+ p 3)) (the u8 a))))) (pal-ffi:gl-gen-textures 1 id) (pal-ffi:gl-bind-texture pal-ffi:+gl-texture-2d+ (cffi:mem-ref id :uint)) - (pal-ffi:gl-tex-parameteri pal-ffi:+gl-texture-2d+ pal-ffi:+gl-texture-mag-filter+ (if smooth-p pal-ffi:+gl-linear+ pal-ffi:+gl-nearest+)) - (pal-ffi:gl-tex-parameteri pal-ffi:+gl-texture-2d+ pal-ffi:+gl-texture-min-filter+ (if smooth-p pal-ffi:+gl-linear+ pal-ffi:+gl-nearest+)) + (pal-ffi:gl-tex-parameteri pal-ffi:+gl-texture-2d+ pal-ffi:+gl-texture-mag-filter+ (if smoothp pal-ffi:+gl-linear+ pal-ffi:+gl-nearest+)) + (pal-ffi:gl-tex-parameteri pal-ffi:+gl-texture-2d+ pal-ffi:+gl-texture-min-filter+ (if smoothp pal-ffi:+gl-linear+ pal-ffi:+gl-nearest+)) (pal-ffi:gl-teximage2d pal-ffi:+gl-texture-2d+ 0 mode @@ -420,62 +419,14 @@ (cffi:foreign-free id) (pal-ffi:register-resource image)))) - -(defun image-from-surface (surface smooth-p) - (assert (not (cffi:null-pointer-p surface))) - (image-from-fn (cffi:foreign-slot-value surface 'pal-ffi:surface 'pal-ffi:w) - (cffi:foreign-slot-value surface 'pal-ffi:surface 'pal-ffi:w) - smooth-p - (lambda (x y) - (surface-get-pixel surface x y)))) - -;; (defun image-from-surface (surface smooth-p) -;; (assert (not (cffi:null-pointer-p surface))) -;; (let* ((width (min 1024 (cffi:foreign-slot-value surface 'pal-ffi:surface 'pal-ffi:w))) -;; (height (min 1024 (cffi:foreign-slot-value surface 'pal-ffi:surface 'pal-ffi:h))) -;; (texture-width (expt 2 (or (find-if (lambda (x) -;; (> (expt 2 x) -;; (1- width))) -;; '(6 7 8 9 10)) 10))) -;; (texture-height (expt 2 (or (find-if (lambda (x) -;; (> (expt 2 x) -;; (1- height))) -;; '(6 7 8 9 10)) 10))) -;; (id (cffi:foreign-alloc :uint :count 1))) -;; (with-foreign-vector (tdata (* texture-width texture-height) 4) -;; (do-n (x width y height) -;; (multiple-value-bind (r g b a) (surface-get-pixel surface x y) -;; (let ((p (the fixnum (+ (* y (the u16 (* (the u11 texture-width) 4))) (the u16 (* 4 x)))))) -;; (setf (cffi:mem-ref tdata :uint8 p) (the u8 r) -;; (cffi:mem-ref tdata :uint8 (+ p 1)) (the u8 g) -;; (cffi:mem-ref tdata :uint8 (+ p 2)) (the u8 b) -;; (cffi:mem-ref tdata :uint8 (+ p 3)) (the u8 a))))) -;; (pal-ffi:gl-gen-textures 1 id) -;; (pal-ffi:gl-bind-texture pal-ffi:+gl-texture-2d+ (cffi:mem-ref id :uint)) -;; (pal-ffi:gl-tex-parameteri pal-ffi:+gl-texture-2d+ pal-ffi:+gl-texture-mag-filter+ (if smooth-p pal-ffi:+gl-linear+ pal-ffi:+gl-nearest+)) -;; (pal-ffi:gl-tex-parameteri pal-ffi:+gl-texture-2d+ pal-ffi:+gl-texture-min-filter+ (if smooth-p pal-ffi:+gl-linear+ pal-ffi:+gl-nearest+)) -;; (pal-ffi:gl-teximage2d pal-ffi:+gl-texture-2d+ -;; 0 -;; (if (= (cffi:foreign-slot-value (cffi:foreign-slot-value surface 'pal-ffi:surface 'pal-ffi:pixelformat) -;; 'pal-ffi:pixelformat 'pal-ffi:bytesperpixel) -;; 3) -;; pal-ffi:+gl-rgb+ -;; pal-ffi:+gl-rgba+) -;; texture-width texture-height 0 pal-ffi:+gl-rgba+ pal-ffi:+gl-unsigned-byte+ tdata)) -;; (let ((image (pal-ffi::make-image :texture (cffi:mem-ref id :uint) -;; :tx2 (coerce (/ width texture-width) 'single-float) -;; :ty2 (coerce (/ height texture-height) 'single-float) -;; :texture-width texture-width -;; :texture-height texture-height -;; :width (cffi:foreign-slot-value surface 'pal-ffi:surface 'pal-ffi:w) -;; :height (cffi:foreign-slot-value surface 'pal-ffi:surface 'pal-ffi:h)))) -;; (setf *current-image* image) -;; (cffi:foreign-free id) -;; (pal-ffi:register-resource image)))) - -(defun load-image (file &optional (smooth-p nil)) +(defun load-image (file &optional (smoothp nil)) (let* ((surface (pal-ffi:load-image (data-path file))) - (image (image-from-surface surface smooth-p))) + (image (progn (assert (not (cffi:null-pointer-p surface))) + (image-from-fn (cffi:foreign-slot-value surface 'pal-ffi:surface 'pal-ffi:w) + (cffi:foreign-slot-value surface 'pal-ffi:surface 'pal-ffi:w) + smoothp + (lambda (x y) + (surface-get-pixel surface x y)))))) (pal-ffi::free-surface surface) image)) @@ -548,56 +499,47 @@ (pal-ffi:gl-vertex2f vx-to (+ vy-to height))))) (declaim (inline draw-line)) -(defun draw-line (la lb r g b a &key (size 1.0f0)) +(defun draw-line (la lb r g b a &key (size 1.0f0) (smoothp)) (declare (type vec la lb) (type u8 r g b a) (type single-float size)) - (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+)) - (pal-ffi:gl-disable pal-ffi:+gl-texture-2d+) - (set-blend-color r g b a) - (pal-ffi:gl-line-width size) - (pal-ffi:gl-enable pal-ffi:+gl-line-smooth+) - (with-gl pal-ffi:+gl-lines+ - (pal-ffi:gl-vertex2f (vx la) (vy la)) - (pal-ffi:gl-vertex2f (vx lb) (vy lb))) - (pal-ffi:gl-pop-attrib)) + (with-line-settings smoothp size r g b a + (with-gl pal-ffi:+gl-lines+ + (pal-ffi:gl-vertex2f (vx la) (vy la)) + (pal-ffi:gl-vertex2f (vx lb) (vy lb))))) (declaim (inline draw-arrow)) -(defun draw-arrow (la lb r g b a &key (size 1.0f0)) +(defun draw-arrow (la lb r g b a &key (size 1.0f0) smoothp) (declare (type vec la lb) (type u8 r g b a) (type single-float size)) - (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+)) - (pal-ffi:gl-disable pal-ffi:+gl-texture-2d+) - (set-blend-color r g b a) - (pal-ffi:gl-line-width size) - (pal-ffi:gl-enable pal-ffi:+gl-line-smooth+) - (let ((d (v* (v-direction la lb) (+ size 8f0)))) - (with-gl pal-ffi:+gl-lines+ - (pal-ffi:gl-vertex2f (vx la) (vy la)) - (pal-ffi:gl-vertex2f (vx lb) (vy lb)) - (pal-ffi:gl-vertex2f (vx lb) (vy lb)) - (pal-ffi:gl-vertex2f (vx (v+ lb (v-rotate d 140f0))) - (vy (v+ lb (v-rotate d 140f0)))) - (pal-ffi:gl-vertex2f (vx lb) (vy lb)) - (pal-ffi:gl-vertex2f (vx (v+ lb (v-rotate d -140f0))) - (vy (v+ lb (v-rotate d -140f0)))))) - (pal-ffi:gl-pop-attrib)) + (with-line-settings smoothp size r g b a + (let ((d (v* (v-direction la lb) (+ size 8f0)))) + (with-gl pal-ffi:+gl-lines+ + (pal-ffi:gl-vertex2f (vx la) (vy la)) + (pal-ffi:gl-vertex2f (vx lb) (vy lb)) + (pal-ffi:gl-vertex2f (vx lb) (vy lb)) + (pal-ffi:gl-vertex2f (vx (v+ lb (v-rotate d 140f0))) + (vy (v+ lb (v-rotate d 140f0)))) + (pal-ffi:gl-vertex2f (vx lb) (vy lb)) + (pal-ffi:gl-vertex2f (vx (v+ lb (v-rotate d -140f0))) + (vy (v+ lb (v-rotate d -140f0)))))))) (declaim (inline draw-point)) -(defun draw-point (pos r g b a &key (size 1f0)) +(defun draw-point (pos r g b a &key (size 1f0) smoothp) (declare (type vec pos) (type u8 r g b a) (type single-float size)) - (pal-ffi:gl-push-attrib (logior pal-ffi:+gl-color-buffer-bit+ pal-ffi:+gl-current-bit+ pal-ffi:+gl-enable-bit+)) + (pal-ffi:gl-push-attrib (logior pal-ffi:+gl-current-bit+ pal-ffi:+gl-enable-bit+)) (pal-ffi:gl-disable pal-ffi:+gl-texture-2d+) - (pal-ffi:gl-enable pal-ffi:+gl-point-smooth+) + (if smoothp + (pal-ffi:gl-enable pal-ffi:+gl-point-smooth+) + (pal-ffi:gl-disable pal-ffi:+gl-point-smooth+)) (pal-ffi:gl-point-size size) (set-blend-color r g b a) (with-gl pal-ffi:+gl-point+ (pal-ffi:gl-vertex2f (vx pos) (vy pos))) (pal-ffi:gl-pop-attrib)) -(defun draw-rectangle (pos width height r g b a &key (fill t) (size 1f0) absolutep) +(defun draw-rectangle (pos width height r g b a &key (fill t) (size 1f0) absolutep smoothp) (declare (type vec pos) (type boolean absolutep) (type float size) (type u11 width height) (type u8 r g b a) (type (or image boolean) 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+)) (cond ((image-p fill) (draw-polygon (list pos @@ -608,29 +550,29 @@ :fill fill :absolutep absolutep)) ((eq nil fill) - (pal-ffi:gl-disable pal-ffi:+gl-texture-2d+) - (set-blend-color r g b a) - (pal-ffi:gl-enable pal-ffi:+gl-line-smooth+) - (pal-ffi:gl-line-width size) - (with-gl pal-ffi:+gl-line-loop+ - (pal-ffi:gl-vertex2f (vx pos) (vy pos)) - (pal-ffi:gl-vertex2f (+ (vx pos) width) (vy pos)) - (pal-ffi:gl-vertex2f (+ (vx pos) width) (vy pos)) - (pal-ffi:gl-vertex2f (+ (vx pos) width) (+ (vy pos) height)) - (pal-ffi:gl-vertex2f (+ (vx pos) width) (+ (vy pos) height)) - (pal-ffi:gl-vertex2f (vx pos) (+ (vy pos) height)) - (pal-ffi:gl-vertex2f (vx pos) (+ (vy pos) height)))) + (with-line-settings smoothp size r g b a + (with-gl pal-ffi:+gl-line-loop+ + (pal-ffi:gl-vertex2f (vx pos) (vy pos)) + (pal-ffi:gl-vertex2f (+ (vx pos) width) (vy pos)) + (pal-ffi:gl-vertex2f (+ (vx pos) width) (vy pos)) + (pal-ffi:gl-vertex2f (+ (vx pos) width) (+ (vy pos) height)) + (pal-ffi:gl-vertex2f (+ (vx pos) width) (+ (vy pos) height)) + (pal-ffi:gl-vertex2f (vx pos) (+ (vy pos) height)) + (pal-ffi:gl-vertex2f (vx pos) (+ (vy pos) height))))) (t + (pal-ffi:gl-push-attrib (logior pal-ffi:+gl-current-bit+ pal-ffi:+gl-enable-bit+)) (pal-ffi:gl-disable pal-ffi:+gl-texture-2d+) (set-blend-color r g b a) - (pal-ffi:gl-rectf (vx pos) (vy pos) (+ (vx pos) width) (+ (vy pos) height)))) - (pal-ffi:gl-pop-attrib)) + (pal-ffi:gl-rectf (vx pos) (vy pos) (+ (vx pos) width) (+ (vy pos) height)) + (pal-ffi:gl-pop-attrib)))) -(defun draw-polygon (points r g b a &key (fill t) absolutep (size 1f0)) +(defun draw-polygon (points r g b a &key (fill t) absolutep (size 1f0) smoothp) (declare (type list points) (type u8 r g b a) (type (or image boolean) fill)) (cond ((image-p fill) + (pal-ffi:gl-push-attrib (logior pal-ffi:+gl-current-bit+)) (set-image fill) + (set-blend-color r g b a) (with-gl pal-ffi:+gl-polygon+ (let ((dx (vx (first points))) (dy (vy (first points)))) @@ -646,22 +588,17 @@ (- y dy)) (pal-ffi:image-texture-height fill)))) (pal-ffi:gl-tex-coord2f tx ty) - (pal-ffi:gl-vertex2f x y)))))) - ((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+)) - (pal-ffi:gl-line-width size) - (set-blend-color r g b a) - (pal-ffi:gl-disable pal-ffi:+gl-texture-2d+) - (pal-ffi:gl-enable pal-ffi:+gl-line-smooth+) - (with-gl pal-ffi:+gl-line-loop+ - (dolist (p points) - (pal-ffi:gl-vertex2f (vx p) (vy p)))) + (pal-ffi:gl-vertex2f x y))))) (pal-ffi:gl-pop-attrib)) + ((eq nil fill) + (with-line-settings smoothp size r g b a + (with-gl pal-ffi:+gl-line-loop+ + (dolist (p points) + (pal-ffi:gl-vertex2f (vx p) (vy p)))))) (t - (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+)) + (pal-ffi:gl-push-attrib (logior pal-ffi:+gl-current-bit+ pal-ffi:+gl-enable-bit+)) (set-blend-color r g b a) (pal-ffi:gl-disable pal-ffi:+gl-texture-2d+) - (pal-ffi:gl-enable pal-ffi:+gl-line-smooth+) (with-gl pal-ffi:+gl-polygon+ (dolist (p points) (pal-ffi:gl-vertex2f (vx p) (vy p))))

1 0

[pal-cvs] CVS pal
by tneste 16 Jul '07

16 Jul '07

Update of /project/pal/cvsroot/pal In directory clnet:/tmp/cvs-serv8836 Modified Files: ffi.lisp package.lisp pal.lisp todo.txt Log Message: Added image-from-array and image-from-fn --- /project/pal/cvsroot/pal/ffi.lisp 2007/07/13 13:21:04 1.5 +++ /project/pal/cvsroot/pal/ffi.lisp 2007/07/16 14:44:12 1.6 @@ -436,8 +436,8 @@ (width 0 :type u11)) (defstruct font - (image nil :type (or nil image)) - (glyphs nil :type (or nil (simple-vector 255))) + (image nil :type (or boolean image)) + (glyphs nil :type (or boolean (simple-vector 255))) (height 0 :type u11)) (defstruct music @@ -456,8 +456,6 @@ (defgeneric register-resource (resource)) (defgeneric free-resource (resource)) -(defgeneric free-all-resources ()) - (defmethod register-resource (resource) (assert (resource-p resource)) @@ -471,18 +469,26 @@ (setf *resources* (remove resource *resources*))) (defmethod free-resource ((resource music)) - (free-music (music-music resource))) + (when (music-music resource) + (setf (music-music resource) nil) + (free-music (music-music resource)))) (defmethod free-resource ((resource font)) - (free-resource (font-image resource))) + (when (font-image resource) + (free-resource (font-image resource)) + (setf (font-image resource) nil))) (defmethod free-resource ((resource image)) - (gl-delete-texture (image-texture resource))) + (when (> (image-texture resource) 0) + (setf (image-texture resource) 0) + (gl-delete-texture (image-texture resource)))) (defmethod free-resource ((resource sample)) - (free-chunk (sample-chunk resource))) + (when (sample-chunk resource) + (setf (sample-chunk resource) nil) + (free-chunk (sample-chunk resource)))) -(defmethod free-all-resources () +(defun free-all-resources () (dolist (r *resources*) (free-resource r)) (assert (null *resources*))) @@ -491,12 +497,14 @@ (cffi:defctype new-music :pointer) (defmethod cffi:translate-from-foreign (value (name (eql 'new-music))) + (assert (not (cffi:null-pointer-p value))) (let ((music (make-music :music value))) (register-resource music) music)) (cffi:defctype new-sample :pointer) (defmethod cffi:translate-from-foreign (value (name (eql 'new-sample))) + (assert (not (cffi:null-pointer-p value))) (let ((sample (make-sample :chunk value))) (register-resource sample) sample)) --- /project/pal/cvsroot/pal/package.lisp 2007/07/13 21:30:59 1.5 +++ /project/pal/cvsroot/pal/package.lisp 2007/07/16 14:44:12 1.6 @@ -407,6 +407,9 @@ #:pop-clip #:update-screen + #:image-from-array + #:image-from-fn + #:load-image #:image-width #:image-height @@ -417,7 +420,7 @@ #:draw-arrow #:draw-image #:draw-image* - + #:load-font #:get-font-height #:draw-text --- /project/pal/cvsroot/pal/pal.lisp 2007/07/13 21:30:59 1.10 +++ /project/pal/cvsroot/pal/pal.lisp 2007/07/16 14:44:12 1.11 @@ -1,10 +1,12 @@ ;; Notes: ;; tags-resources-free? ;; circle/box/point overlap functions, fast v-dist -;; resources should check for void when freeing ;; do absolute paths for data-path work? ;; draw-image* aligns & scale, angle? ;; draw-polygon*, draw-circle +;; rgbas for textured polys. +;; opengl state macros + (declaim (optimize (speed 3) (safety 3))) @@ -50,8 +52,7 @@ (type (or boolean image) *current-image*)) -(defgeneric open-pal (&key width height fps title fullscreenp paths)) -(defmethod open-pal (&key (width 800) (height 600) (fps 60) (title "PAL") (fullscreenp nil) (paths nil)) +(defun open-pal (&key (width 800) (height 600) (fps 60) (title "PAL") (fullscreenp nil) (paths nil)) (when *pal-running* (close-pal)) (pal-ffi:init (logior pal-ffi:+init-video+ pal-ffi:+init-audio+)) @@ -121,8 +122,7 @@ (set-cursor nil)) (pal-ffi:free-all-resources)) -(defgeneric close-pal ()) -(defmethod close-pal () +(defun close-pal () (unwind-protect (progn (free-all-resources) (pal-ffi:close-audio) @@ -365,11 +365,22 @@ (cffi:mem-ref b :uint8) (cffi:mem-ref a :uint8))))) - - -(defun make-texture-from-surface (surface smooth-p) - (let* ((width (min 1024 (cffi:foreign-slot-value surface 'pal-ffi:surface 'pal-ffi:w))) - (height (min 1024 (cffi:foreign-slot-value surface 'pal-ffi:surface 'pal-ffi:h))) +(defun image-from-array (smooth-p array) + (image-from-fn (array-dimension array 0) + (array-dimension array 1) + smooth-p + (lambda (y x) + (let ((pixel (aref array x y))) + (values (first pixel) + (second pixel) + (third pixel) + (fourth pixel)))))) + + +(defun image-from-fn (width height smooth-p fn) + (let* ((mode pal-ffi:+gl-rgb+) + (width (min 1024 width)) + (height (min 1024 height)) (texture-width (expt 2 (or (find-if (lambda (x) (> (expt 2 x) (1- width))) @@ -381,8 +392,11 @@ (id (cffi:foreign-alloc :uint :count 1))) (with-foreign-vector (tdata (* texture-width texture-height) 4) (do-n (x width y height) - (multiple-value-bind (r g b a) (surface-get-pixel surface x y) - (let ((p (the fixnum (+ (* y (the u16 (* (the u11 texture-width) 4))) (the u16 (* 4 x)))))) + (multiple-value-bind (r g b a) (funcall fn x y) + (let ((a (or a 255)) + (p (the fixnum (+ (* y (the u16 (* (the u11 texture-width) 4))) (the u16 (* 4 x)))))) + (when (< a 255) + (setf mode pal-ffi:+gl-rgba+)) (setf (cffi:mem-ref tdata :uint8 p) (the u8 r) (cffi:mem-ref tdata :uint8 (+ p 1)) (the u8 g) (cffi:mem-ref tdata :uint8 (+ p 2)) (the u8 b) @@ -393,26 +407,75 @@ (pal-ffi:gl-tex-parameteri pal-ffi:+gl-texture-2d+ pal-ffi:+gl-texture-min-filter+ (if smooth-p pal-ffi:+gl-linear+ pal-ffi:+gl-nearest+)) (pal-ffi:gl-teximage2d pal-ffi:+gl-texture-2d+ 0 - (if (= (cffi:foreign-slot-value (cffi:foreign-slot-value surface 'pal-ffi:surface 'pal-ffi:pixelformat) - 'pal-ffi:pixelformat 'pal-ffi:bytesperpixel) - 3) - pal-ffi:+gl-rgb+ - pal-ffi:+gl-rgba+) + mode texture-width texture-height 0 pal-ffi:+gl-rgba+ pal-ffi:+gl-unsigned-byte+ tdata)) (let ((image (pal-ffi::make-image :texture (cffi:mem-ref id :uint) :tx2 (coerce (/ width texture-width) 'single-float) :ty2 (coerce (/ height texture-height) 'single-float) :texture-width texture-width :texture-height texture-height - :width (cffi:foreign-slot-value surface 'pal-ffi:surface 'pal-ffi:w) - :height (cffi:foreign-slot-value surface 'pal-ffi:surface 'pal-ffi:h)))) + :width width + :height height))) (setf *current-image* image) (cffi:foreign-free id) (pal-ffi:register-resource image)))) + +(defun image-from-surface (surface smooth-p) + (assert (not (cffi:null-pointer-p surface))) + (image-from-fn (cffi:foreign-slot-value surface 'pal-ffi:surface 'pal-ffi:w) + (cffi:foreign-slot-value surface 'pal-ffi:surface 'pal-ffi:w) + smooth-p + (lambda (x y) + (surface-get-pixel surface x y)))) + +;; (defun image-from-surface (surface smooth-p) +;; (assert (not (cffi:null-pointer-p surface))) +;; (let* ((width (min 1024 (cffi:foreign-slot-value surface 'pal-ffi:surface 'pal-ffi:w))) +;; (height (min 1024 (cffi:foreign-slot-value surface 'pal-ffi:surface 'pal-ffi:h))) +;; (texture-width (expt 2 (or (find-if (lambda (x) +;; (> (expt 2 x) +;; (1- width))) +;; '(6 7 8 9 10)) 10))) +;; (texture-height (expt 2 (or (find-if (lambda (x) +;; (> (expt 2 x) +;; (1- height))) +;; '(6 7 8 9 10)) 10))) +;; (id (cffi:foreign-alloc :uint :count 1))) +;; (with-foreign-vector (tdata (* texture-width texture-height) 4) +;; (do-n (x width y height) +;; (multiple-value-bind (r g b a) (surface-get-pixel surface x y) +;; (let ((p (the fixnum (+ (* y (the u16 (* (the u11 texture-width) 4))) (the u16 (* 4 x)))))) +;; (setf (cffi:mem-ref tdata :uint8 p) (the u8 r) +;; (cffi:mem-ref tdata :uint8 (+ p 1)) (the u8 g) +;; (cffi:mem-ref tdata :uint8 (+ p 2)) (the u8 b) +;; (cffi:mem-ref tdata :uint8 (+ p 3)) (the u8 a))))) +;; (pal-ffi:gl-gen-textures 1 id) +;; (pal-ffi:gl-bind-texture pal-ffi:+gl-texture-2d+ (cffi:mem-ref id :uint)) +;; (pal-ffi:gl-tex-parameteri pal-ffi:+gl-texture-2d+ pal-ffi:+gl-texture-mag-filter+ (if smooth-p pal-ffi:+gl-linear+ pal-ffi:+gl-nearest+)) +;; (pal-ffi:gl-tex-parameteri pal-ffi:+gl-texture-2d+ pal-ffi:+gl-texture-min-filter+ (if smooth-p pal-ffi:+gl-linear+ pal-ffi:+gl-nearest+)) +;; (pal-ffi:gl-teximage2d pal-ffi:+gl-texture-2d+ +;; 0 +;; (if (= (cffi:foreign-slot-value (cffi:foreign-slot-value surface 'pal-ffi:surface 'pal-ffi:pixelformat) +;; 'pal-ffi:pixelformat 'pal-ffi:bytesperpixel) +;; 3) +;; pal-ffi:+gl-rgb+ +;; pal-ffi:+gl-rgba+) +;; texture-width texture-height 0 pal-ffi:+gl-rgba+ pal-ffi:+gl-unsigned-byte+ tdata)) +;; (let ((image (pal-ffi::make-image :texture (cffi:mem-ref id :uint) +;; :tx2 (coerce (/ width texture-width) 'single-float) +;; :ty2 (coerce (/ height texture-height) 'single-float) +;; :texture-width texture-width +;; :texture-height texture-height +;; :width (cffi:foreign-slot-value surface 'pal-ffi:surface 'pal-ffi:w) +;; :height (cffi:foreign-slot-value surface 'pal-ffi:surface 'pal-ffi:h)))) +;; (setf *current-image* image) +;; (cffi:foreign-free id) +;; (pal-ffi:register-resource image)))) + (defun load-image (file &optional (smooth-p nil)) (let* ((surface (pal-ffi:load-image (data-path file))) - (image (make-texture-from-surface surface smooth-p))) + (image (image-from-surface surface smooth-p))) (pal-ffi::free-surface surface) image)) @@ -541,7 +604,7 @@ (v+ pos (v width 0)) (v+ pos (v width height)) (v+ pos (v 0 height))) - 0 0 0 0 + r g b a :fill fill :absolutep absolutep)) ((eq nil fill) --- /project/pal/cvsroot/pal/todo.txt 2007/07/13 21:30:59 1.6 +++ /project/pal/cvsroot/pal/todo.txt 2007/07/16 14:44:12 1.7 @@ -6,7 +6,9 @@ - More drawing primitives. -- image-from-array/image-to-array/screen-to-array etc. +- Improved texture handling + +- image-to-array/screen-to-array etc. - Fix the FPS limiter, the results could be a lot smoother.

1 0

[pal-cvs] CVS pal/examples
by tneste 16 Jul '07

16 Jul '07

Update of /project/pal/cvsroot/pal/examples In directory clnet:/tmp/cvs-serv8836/examples Added Files: images.lisp utils.lisp Log Message: Added image-from-array and image-from-fn --- /project/pal/cvsroot/pal/examples/images.lisp 2007/07/16 14:44:12 NONE +++ /project/pal/cvsroot/pal/examples/images.lisp 2007/07/16 14:44:12 1.1 (defpackage :image-tests (:use :cl :pal)) (in-package :image-tests) (define-tags image-1 (image-from-fn 255 255 t (lambda (x y) (values x 0 x y))) image-2 (image-from-array nil #2A(((255 255 255 128) (0 0 0) (255 255 255)) ((255 255 255) (255 255 0) (255 255 255)) ((255 255 255) (0 0 0) (255 255 255 128))))) (with-pal () (set-cursor (tag 'image-1)) (event-loop () (clear-screen 50 100 255) (with-transformation (:scale 100f0) (draw-image (tag 'image-2) (v 0 0)))))--- /project/pal/cvsroot/pal/examples/utils.lisp 2007/07/16 14:44:12 NONE +++ /project/pal/cvsroot/pal/examples/utils.lisp 2007/07/16 14:44:12 1.1 ;; Some examples of the misc macros and utility functions in PAL ;; Get path to applications user specific data directory. Application name is taken from the :title argument ;; to OPEN/WITH-PAL so be careful to set it to something sensible. ;; If the directory doesn't exists it is created, the exact location of the files is OS dependant. (pal:get-application-folder) (pal:get-application-file "saved_game.data") ;; DO-N is like DO-TIMES but it iterates over the cartesian product of its arguments. Handy when working with tilemaps etc. (pal:do-n (i 3 j 3 k 3) (format t "~a ~a ~a~%" i j k)) ;; RANDOMLY evaluates its body, umm, randomly. (pal:randomly 10 (print "I'm a lucky s-expression!")) ;; has a 1/10 chance to get evaluated ;; CURRY, your average currying macro (mapcar (pal:curry '* 2 2) '(1 2 3 4 5)) ;; RELT returns a random element in a sequence (pal:relt (mapcar (pal:curry '* 2 2) '(1 2 3 4 5))) ;; CLAMPs a value between min and max (pal:clamp 10 (random 30) 20) ;; DATA-PATH searches for a file from the PATHS given to PAL and returns the first match (pal:data-path "foo.png")

1 0

[pal-cvs] CVS pal
by tneste 13 Jul '07

13 Jul '07

Update of /project/pal/cvsroot/pal In directory clnet:/tmp/cvs-serv13905 Modified Files: package.lisp pal.asd pal.lisp todo.txt Log Message: Rest of the api changes applied. --- /project/pal/cvsroot/pal/package.lisp 2007/07/13 13:21:04 1.4 +++ /project/pal/cvsroot/pal/package.lisp 2007/07/13 21:30:59 1.5 @@ -416,9 +416,8 @@ #:draw-line #:draw-arrow #:draw-image - #:draw-image-from - #:draw-quad - + #:draw-image* + #:load-font #:get-font-height #:draw-text --- /project/pal/cvsroot/pal/pal.asd 2007/06/28 20:14:05 1.1 +++ /project/pal/cvsroot/pal/pal.asd 2007/07/13 21:30:59 1.2 @@ -2,7 +2,10 @@ (in-package #:asdf) (defsystem pal - :components + :description "Pixel Art Library" + :author "Tomi Neste" + :license "MIT" + :components ((:file "ffi" :depends-on ("package")) (:file "vector" --- /project/pal/cvsroot/pal/pal.lisp 2007/07/13 13:21:04 1.9 +++ /project/pal/cvsroot/pal/pal.lisp 2007/07/13 21:30:59 1.10 @@ -1,10 +1,10 @@ -;; Urgent: +;; Notes: ;; tags-resources-free? ;; circle/box/point overlap functions, fast v-dist ;; resources should check for void when freeing -;; sdl window not always on top on windows? ;; do absolute paths for data-path work? -;; draw-image aligns, draw-quad! abs. +;; draw-image* aligns & scale, angle? +;; draw-polygon*, draw-circle (declaim (optimize (speed 3) (safety 3))) @@ -416,21 +416,30 @@ (pal-ffi::free-surface surface) image)) -(defun draw-image (image pos &key angle scale (valign :left) (halign :top)) +(defun draw-image (image pos &key angle scale valign halign) (declare (type image image) (type vec pos) (type (or boolean single-float) angle scale) (type symbol halign valign)) (set-image image) (let ((width (image-width image)) (height (image-height image)) (tx2 (pal-ffi:image-tx2 image)) (ty2 (pal-ffi:image-ty2 image))) - (if angle + (if (or angle scale valign halign) (with-transformation () (translate pos) - (rotate angle) + (when angle + (rotate angle)) (when scale - (scale scale scale)) - (let ((x (- (/ (image-width image) 2f0))) - (y (- (/ (image-height image) 2f0)))) + (scale scale scale)) ;; :-) + (let ((x (case halign + (:right (coerce (- width) 'single-float)) + (:left 0f0) + (:middle (coerce (- (/ width 2)) 'single-float)) + (otherwise 0f0))) + (y (case valign + (:bottom (coerce (- height) 'single-float)) + (:top 0f0) + (:middle (coerce (- (/ height 2)) 'single-float)) + (otherwise 0f0)))) (with-gl pal-ffi:+gl-quads+ (pal-ffi:gl-tex-coord2f 0f0 0f0) (pal-ffi:gl-vertex2f x y) @@ -440,32 +449,21 @@ (pal-ffi:gl-vertex2f (+ x width) (+ y height)) (pal-ffi:gl-tex-coord2f 0f0 ty2) (pal-ffi:gl-vertex2f x (+ y height))))) - (with-gl pal-ffi:+gl-quads+ - (pal-ffi:gl-tex-coord2f 0f0 0f0) - (pal-ffi:gl-vertex2f (vx pos) (vy pos)) - (pal-ffi:gl-tex-coord2f tx2 0f0) - (pal-ffi:gl-vertex2f (+ (vx pos) width) (vy pos)) - (pal-ffi:gl-tex-coord2f tx2 ty2) - (pal-ffi:gl-vertex2f (+ (vx pos) width) (+ (vy pos) height)) - (pal-ffi:gl-tex-coord2f 0f0 ty2) - (pal-ffi:gl-vertex2f (vx pos) (+ (vy pos) height)))))) + (let ((x (vx pos)) + (y (vy pos))) + (with-gl pal-ffi:+gl-quads+ + (pal-ffi:gl-tex-coord2f 0f0 0f0) + (pal-ffi:gl-vertex2f x y) + (pal-ffi:gl-tex-coord2f tx2 0f0) + (pal-ffi:gl-vertex2f (+ x width) y) + (pal-ffi:gl-tex-coord2f tx2 ty2) + (pal-ffi:gl-vertex2f (+ x width) (+ y height)) + (pal-ffi:gl-tex-coord2f 0f0 ty2) + (pal-ffi:gl-vertex2f x (+ y height))))))) -(defun draw-quad (image a b c d &key absolutep) - (declare (type image image) (type vec a b c d)) - (set-image image) - (let ((tx2 (pal-ffi:image-tx2 image)) - (ty2 (pal-ffi:image-ty2 image))) - (with-gl pal-ffi:+gl-quads+ - (pal-ffi:gl-tex-coord2f 0f0 0f0) - (pal-ffi:gl-vertex2f (vx a) (vy a)) - (pal-ffi:gl-tex-coord2f tx2 0f0) - (pal-ffi:gl-vertex2f (vx b) (vy b)) - (pal-ffi:gl-tex-coord2f tx2 ty2) - (pal-ffi:gl-vertex2f (vx c) (vy c)) - (pal-ffi:gl-tex-coord2f 0f0 ty2) - (pal-ffi:gl-vertex2f (vx d) (vy d))))) -(defun draw-image-from (image from-pos to-pos width height) + +(defun draw-image* (image from-pos to-pos width height) (declare (type image image) (type vec from-pos to-pos) (type u11 width height)) (set-image image) (let* ((vx (vx from-pos)) @@ -534,15 +532,21 @@ (pal-ffi:gl-vertex2f (vx pos) (vy pos))) (pal-ffi:gl-pop-attrib)) -(defun draw-rectangle (pos width height r g b a &key (filledp t) (size 1f0)) - (declare (type vec pos) (type float size) (type u11 width height) (type u8 r g b a) (type boolean filledp)) +(defun draw-rectangle (pos width height r g b a &key (fill t) (size 1f0) absolutep) + (declare (type vec pos) (type boolean absolutep) (type float size) (type u11 width height) (type u8 r g b a) (type (or image boolean) 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+)) - (pal-ffi:gl-disable pal-ffi:+gl-texture-2d+) - (set-blend-color r g b a) (cond - (filledp - (pal-ffi:gl-rectf (vx pos) (vy pos) (+ (vx pos) width) (+ (vy pos) height))) - (t + ((image-p fill) + (draw-polygon (list pos + (v+ pos (v width 0)) + (v+ pos (v width height)) + (v+ pos (v 0 height))) + 0 0 0 0 + :fill fill + :absolutep absolutep)) + ((eq nil fill) + (pal-ffi:gl-disable pal-ffi:+gl-texture-2d+) + (set-blend-color r g b a) (pal-ffi:gl-enable pal-ffi:+gl-line-smooth+) (pal-ffi:gl-line-width size) (with-gl pal-ffi:+gl-line-loop+ @@ -552,10 +556,14 @@ (pal-ffi:gl-vertex2f (+ (vx pos) width) (+ (vy pos) height)) (pal-ffi:gl-vertex2f (+ (vx pos) width) (+ (vy pos) height)) (pal-ffi:gl-vertex2f (vx pos) (+ (vy pos) height)) - (pal-ffi:gl-vertex2f (vx pos) (+ (vy pos) height))))) + (pal-ffi:gl-vertex2f (vx pos) (+ (vy pos) height)))) + (t + (pal-ffi:gl-disable pal-ffi:+gl-texture-2d+) + (set-blend-color r g b a) + (pal-ffi:gl-rectf (vx pos) (vy pos) (+ (vx pos) width) (+ (vy pos) height)))) (pal-ffi:gl-pop-attrib)) -(defun draw-polygon (points r g b a &key fill absolutep (size 1f0)) +(defun draw-polygon (points r g b a &key (fill t) absolutep (size 1f0)) (declare (type list points) (type u8 r g b a) (type (or image boolean) fill)) (cond ((image-p fill) @@ -648,8 +656,7 @@ (defstruct glyph (char #\space :type character) - (x 0 :type u11) - (y 0 :type u11) + (pos (v 0 0) :type vec) (width 0 :type u11) (height 0 :type u11) (xoff 0 :type fixnum) @@ -657,7 +664,7 @@ (defun load-font (font) - (let ((glyphs (make-array 255 :initial-element (make-glyph :x 0 :y 0 :width 1 :height 1 :xoff 0 :dl 0) :element-type 'glyph)) + (let ((glyphs (make-array 255 :initial-element (make-glyph :width 1 :height 1 :xoff 0 :dl 0) :element-type 'glyph)) (lines (with-open-file (file (data-path (concatenate 'string font ".fnt"))) (loop repeat 4 do (read-line file)) (loop for i from 0 to 94 collecting @@ -675,32 +682,29 @@ (coords (read-from-string (concatenate 'string "(" (subseq line 2) ")")))) (make-glyph :char char :dl 0 - :x (first coords) - :y (second coords) + :pos (v (first coords) + (second coords)) :width (third coords) :height (fourth coords) :xoff (sixth coords)))) -(defun draw-glyph (char font) - (declare (type font font) (type character char)) - (let ((image (pal-ffi:font-image font)) - (g (aref (pal-ffi:font-glyphs font) (char-code char)))) - (draw-image-from image - (v (glyph-x g) - (glyph-y g)) - (v 0 0) - (glyph-width g) - (glyph-height g)) - (pal-ffi:gl-translatef (coerce (+ (glyph-width g) (glyph-xoff g)) 'single-float) 0f0 0f0))) - (defun draw-text (text pos &optional font) (declare (type vec pos) (type simple-string text) (type (or font boolean) font)) (with-transformation (:pos pos) - (let ((font (if font - font - (tag 'default-font)))) - (loop for c across text do - (draw-glyph c font))))) + (let* ((font (if font + font + (tag 'default-font))) + (origo (v 0 0)) + (image (pal-ffi:font-image font))) + (declare (type image image) (type vec origo)) + (loop for char across text do + (let ((g (aref (pal-ffi:font-glyphs font) (char-code char)))) + (draw-image* image + (glyph-pos g) + origo + (glyph-width g) + (glyph-height g)) + (pal-ffi:gl-translatef (coerce (+ (glyph-width g) (glyph-xoff g)) 'single-float) 0f0 0f0)))))) (declaim (inline get-font-height)) (defun get-font-height (&optional font) --- /project/pal/cvsroot/pal/todo.txt 2007/07/13 13:21:04 1.5 +++ /project/pal/cvsroot/pal/todo.txt 2007/07/13 21:30:59 1.6 @@ -2,25 +2,40 @@ - Add display list support. -- Make font rendering use display lists. +- Font rendering is too slow, maybe use display lists for that? - More drawing primitives. - image-from-array/image-to-array/screen-to-array etc. -- Fix the FPS limiter. +- Fix the FPS limiter, the results could be a lot smoother. - Check the sanity of vector.lisp and add some operations, esp. bounding-boxes etc. - Correct aspect ratio when fullscreen on widescreen displays. -- CL native font resource builder. +- I would really like to see it run on OS X. -- Fix with-blend (r g b a). +- Simple and transparent animation system for images. -- Make it run on OS X. +- Using fullscreen mode on Windows some times results in screen flickering + between desktop and PAL screen, usually fixed by alt-tabbing. Should be fixed. -- TrueType font support. +- The problems with Linux and some gfx drivers should be somehow fixed. -- Simple animation system for images. +- Documentation and tutorials. + + + +As separate projects on top of PAL: + +- Native CL font resource builder + +- TTF support + +- GUI + +- Some sort of sprite library? + +- Network code?

1 0

[pal-cvs] CVS pal/examples
by tneste 13 Jul '07

13 Jul '07

Update of /project/pal/cvsroot/pal/examples In directory clnet:/tmp/cvs-serv13905/examples Modified Files: hares.lisp hello.lisp polygons.lisp swarm.lisp teddy.lisp Log Message: Rest of the api changes applied. --- /project/pal/cvsroot/pal/examples/hares.lisp 2007/06/28 20:14:05 1.1 +++ /project/pal/cvsroot/pal/examples/hares.lisp 2007/07/13 21:30:58 1.2 @@ -32,8 +32,10 @@ (set-blend-color (r-of s) (g-of s) (b-of s) 255) (draw-image (image-of s) (pos-of s) - (angle-of s) - (scale-of s))) + :halign :middle + :valign :middle + :angle (angle-of s) + :scale (scale-of s))) (defmethod act ((s sprite)) (setf (angle-of s) (mod (+ (angle-of s) 1f0) 360)) @@ -52,7 +54,7 @@ (defun example () - (with-pal (:width 800 :height 600 :fullscreenp nil :fps 6000) + (with-pal (:width 800 :height 600 :fullscreenp nil :fps 6000 :paths (merge-pathnames "examples/" pal::*pal-directory*)) (setf *sprites* nil) (set-cursor nil) @@ -70,11 +72,11 @@ :angle (random 360f0))) (event-loop () - (draw-image-from (tag 'bg) - (v 0 0) - (v 0 0) - (get-screen-width) - (get-screen-height)) + (draw-image* (tag 'bg) + (v 0 0) + (v 0 0) + (get-screen-width) + (get-screen-height)) (with-blend (:mode *blend-mode*) (dolist (i *sprites*) (draw i) --- /project/pal/cvsroot/pal/examples/hello.lisp 2007/07/03 18:42:33 1.4 +++ /project/pal/cvsroot/pal/examples/hello.lisp 2007/07/13 21:30:58 1.5 @@ -3,17 +3,22 @@ (defun hello-1 () - (pal:with-pal (:paths "/path/to/examples/") + (pal:with-pal (:title "Hello!" :paths (merge-pathnames "examples/" pal::*pal-directory*)) (let ((font (pal:load-font "georgia"))) - (pal:draw-text "Hello from PAL" - (pal:v-round - (pal:v (/ (- (pal:get-screen-width) - (pal:get-text-size "Hello from PAL" font)) - 2) - (/ (- (pal:get-screen-height) - (pal:get-font-height font)) - 2))) - font)) + (loop for y from 0 to 300 by 2 do + (pal:draw-line (pal:v 0 (* y 2)) (pal:v 800 (* y 2)) + 50 50 255 (truncate y 2))) + (let ((midpoint (pal:v-round + (pal:v (/ (- (pal:get-screen-width) + (pal:get-text-size "Hello from PAL" font)) + 2) + (/ (- (pal:get-screen-height) + (pal:get-font-height font)) + 2))))) + (pal:set-blend-color 0 0 0 255) + (pal:draw-text "Hello from PAL" (pal:v+ midpoint (pal:v 5 5)) font) + (pal:reset-blend-mode) + (pal:draw-text "Hello from PAL" midpoint font))) (pal:wait-keypress))) ;; (hello-1) --- /project/pal/cvsroot/pal/examples/polygons.lisp 2007/07/13 13:21:04 1.1 +++ /project/pal/cvsroot/pal/examples/polygons.lisp 2007/07/13 21:30:58 1.2 @@ -3,22 +3,34 @@ (in-package :poly-tests) -(with-pal () +(with-pal (:paths (merge-pathnames "examples/" pal::*pal-directory*)) (let ((grid (load-image "bg2.png")) + (plane (load-image "lego-plane.png" t)) (slad (load-image "save_lisp.gif")) (teddy (load-image "yellow-teddy.png"))) (event-loop () - ;; DRAW-RECTANGLE just draws a filled or wireframe rectangle on screen - (draw-rectangle (v 0 0) 800 600 - 0 0 0 32 :filledp t) + 0 0 0 32) ;; Draw a black, transparent rectangle over the scene. + ;; (clear-screen 0 0 0) ;; Use this instead if the afterimages give you a headache. + + ;; DRAW-IMAGE draw the whole image at given position. Keyword arguments can be given to define the + ;; scale, angle and horizontal and vertical alignment ("hotspot") + + (draw-image plane + (v 700 500) + :halign :middle ;; Possible options are :left, :right and :middle. :left is the default. + :valign :bottom ;; -''- :top, :bottom, :middle. :top is the default. + :angle (v-angle (v-direction (v 700 500) (get-mouse-pos))) ;; angle in degrees + :scale (* (v-distance (v 700 500) (get-mouse-pos)) .01f0)) + + (draw-point (v 700 500) 255 0 0 255 :size 10f0) ;; Draw a red point at the hotspot of previous image. ;; DRAW-POLYGON draw a polygon which vertexes are given as a list of VECs. - ;; FILL is either nil, true or image that is used as a pattern. If fill is an image the rgba values are not used. + ;; FILL is either nil, t or image that is used as a pattern. If fill is an image the rgba values have no effect. ;; When ABSOLUTEP is T image patterns position is decided by screen coordinates. - + ;; Max value of SIZE depends on the OpenGL implementation, you probably shouldn't use values greater than 10f0 (with-transformation (:pos (v 100 100)) (draw-polygon (list (v -100 0) @@ -35,34 +47,39 @@ (v -50 100) ) 255 0 0 255 - :fill nil :size 5f0 + :fill nil :size 4f0 :absolutep nil)) - ;; Note: next one doesn't work like you might expect since the image size is rounded up - ;; to the nearest power of two and the extra is filled with blank. - - (with-blend (:color '(255 255 255 20)) - (draw-polygon (list (v+ (get-mouse-pos) (v -100 -100)) - (v+ (get-mouse-pos) (v 100 -100)) - (v+ (get-mouse-pos) (v 100 100)) - (v+ (get-mouse-pos) (v -100 100))) - 0 0 0 0 - :absolutep t - :fill slad)) - ;; DRAW-IMAGE-FROM draws a part of image, defined by a starting point, width and height. - ;; If width or height are larger than the source image the image is tiled + ;; DRAW-RECTANGLEs arguments are similar to DRAW-POLYGON + ;; Notice how the size of the actual SLAD image used is expanded up to the nearest power of two and the extra space is filled with blank, + ;; usually this happens transparently to the user (eg. image-width returns the original width of image) but in some cases + ;; it can cause some artifacts. In this case if the original image had width and height of power of two it would be seamlessly + ;; tiled across the screen. + ;; For example, image of size 65x30 will be expanded to the size 128x32, so it is a + ;; good idea to try and fit the image sizes inside the nearest power of two to save memory. + + (with-blend (:color '(255 255 255 128)) + (draw-rectangle (get-mouse-pos) + 100 100 + 0 0 0 0 + :absolutep t + :fill slad)) - (draw-image-from teddy (v 0 (get-mouse-y)) - (v (get-mouse-x) 0) - (truncate (image-width teddy) 2) - (get-screen-height)) - (draw-image-from teddy (v (truncate (image-width teddy) 2) (get-mouse-y) ) - (v (- (get-screen-width) (get-mouse-x)) 0) - (truncate (image-width teddy) 2) - (get-screen-height)) - ;; (draw-quad ...) to be done + ;; DRAW-IMAGE* draws a part of image, defined by a starting point, width and height. + ;; If width or height are larger than the source image the image is tiled + ;; Like with DRAW-POLYGON non-power-of-two image sizes can give unexpected results. - ))) \ No newline at end of file + (let ((x (abs (- 400 (get-mouse-x))))) + (draw-image* teddy + (v 0 (get-mouse-y)) + (v x 0) + (truncate (image-width teddy) 2) + (get-screen-height)) + (draw-image* teddy + (v (truncate (image-width teddy) 2) (get-mouse-y) ) + (v (- (get-screen-width) x) 0) + (truncate (image-width teddy) 2) + (get-screen-height)))))) \ No newline at end of file --- /project/pal/cvsroot/pal/examples/swarm.lisp 2007/07/03 18:42:33 1.2 +++ /project/pal/cvsroot/pal/examples/swarm.lisp 2007/07/13 21:30:58 1.3 @@ -9,13 +9,13 @@ (setf vectors (append vectors (loop repeat 50 collecting (cons (pal:get-mouse-pos) (pal:v-random 5f0)))))))) (pal:draw-rectangle (pal:v 0 0) 1024 768 0 0 0 128) - (pal:with-blend (:r 255 :g 128 :b 128 :a 255) + (pal:with-blend (:color '(255 128 128 255)) (pal:draw-text "Use left mousekey to add particles." (pal:v 0 0))) (let ((midpoint (pal:v/ (reduce 'pal:v+ vectors :initial-value (pal:v 0 0) :key 'car) (max 1f0 (coerce (length vectors) 'single-float))))) - (pal:draw-point midpoint 255 0 0 255 10f0) + (pal:draw-point midpoint 255 0 0 255 :size 10f0) (setf vectors (mapcar (lambda (v) (cons (pal:v+ (car v) (cdr v)) (pal:v* (pal:v+ (cdr v) @@ -31,6 +31,6 @@ (pal:draw-arrow (car v) (pal:v+ (car v) (cdr v)) 10 7 0 255 - 10f0))))))) + :size 10f0))))))) ;; (swarm) \ No newline at end of file --- /project/pal/cvsroot/pal/examples/teddy.lisp 2007/07/01 22:49:25 1.2 +++ /project/pal/cvsroot/pal/examples/teddy.lisp 2007/07/13 21:30:58 1.3 @@ -22,6 +22,7 @@ (defclass sprite () ((pos :accessor pos-of :initarg :pos :initform (v 0 0)) (vel :accessor vel-of :initarg :vel :initform (v 0 0)) + (alt :accessor alt-of :initarg :alt :initform 10) (image :accessor image-of :initarg :image) (angle :accessor angle-of :initarg :angle :initform 0f0))) @@ -36,7 +37,9 @@ (defmethod draw ((s sprite)) (draw-image (image-of s) (pos-of s) - (angle-of s))) + :valign :middle + :halign :middle + :angle (angle-of s))) @@ -64,15 +67,19 @@ (defun example () - (with-pal (:width 800 :height 600 :fullscreenp nil :fps 60) + (with-pal (:width 800 :height 600 :fullscreenp nil :fps 60 :paths (merge-pathnames "examples/" pal::*pal-directory*)) ;; inits PAL, the args used are the default values. - ;; NOTE: fix the PATHS to point to the location of the resource files - ;; PATHS is a pathname or list of pathnames that defines paths that the LOAD-* functions use for finding resources. + ;; PATHS is a pathname or list of pathnames that PAL uses to find the resource files loaded with LOAD-* functions. + ;; By default PATHS contains the PAL source directory and value of *default-pathname-defaults* ;; only call PAL functions (with the expection of DEFINE-TAGS forms) inside WITH-PAL or between OPEN-PAL and CLOSE-PAL (setf *sprites* nil) + + ;; Hide the mouse cursor and use cursor.png instead. 18,18 is the offset ("hotspot") for the cursor image + ;; Other possible options to cursor are: t - show the default cursor, nil - hide all cursors (set-cursor (tag 'cursor) (v 18 18)) - (make-instance 'plane) + + (make-instance 'plane :alt 20) (dotimes (i 20) (make-instance 'mutant-teddy :pos (v (random (get-screen-width)) @@ -82,35 +89,47 @@ (event-loop () ;; simple event loop, no mouse-move, key-down etc. handlers defined, we'll handle input explicitly with TEST-KEYS. - ;; the default key-down handler quits the event-loop when ESC is pressed. - ;; to define e.g. a key-handler use a form like (event-loop (:key-down-handler (lambda (key) ...)) ...) + ;; The default key-down handler quits the event-loop when ESC is pressed, if you define your own key-down-handler + ;; don't forget to make sure there is a way to quit pal (especially when in fullscreen). + ;; to define e.g. a key-handler use a form like (event-loop (:key-down-fn (lambda (key) ...)) ...) ;; you can quit the event loop with (return-from event-loop) ;; first, draw a scrolling tiled background - (draw-image-from (tag 'tile) - (v 0 0) - (v 0 (- *y-scroll* 64)) - (get-screen-width) - (+ (get-screen-height) 64)) + (draw-image* (tag 'tile) + (v 0 0) + (v 0 (- *y-scroll* 64)) + (get-screen-width) + (+ (get-screen-height) 64)) (setf *y-scroll* (mod (+ *y-scroll* 1) 64)) - ;; then the sprites + ;; then the sprites, first the shadows + ;; sorting the sprites and their shadows according to their altitude is left as an exercise to the reader + + (with-blend (:color '(0 0 0 128)) + (dolist (i *sprites*) + (with-transformation (:pos (v (alt-of i) (alt-of i))) + (draw i)))) + (with-blend (:mode *blend-mode*) (dolist (i *sprites*) (draw i) + + ;; Let's do this for CLisp or we might a get nasty floating-point-undereflow error in the vector operations. #+CLISP (ext:without-floating-point-underflow (act i)) #-CLISP (act i))) + ;; TEST-KEYS is used to check if some key is currently pressed, _all_ the matching forms are evaluated. (test-keys (:key-1 (setf *blend-mode* nil) (message *blend-mode*)) (:key-2 (setf *blend-mode* :blend) (message *blend-mode*)) - (:key-3 (setf *blend-mode* :additive) - (message *blend-mode*))) + ;; We can also test for several keys at once: + ((:key-3 :key-space :key-mouse-1) (setf *blend-mode* :additive) + (message *blend-mode*))) - (draw-fps) + (draw-fps) ;; Draw the frames/second counter to the top left corner. (draw-text "Press key to select blend-mode:" (v 200 (* 0 (get-font-height)))) (draw-text "1=nil 2=:blend 3=:additive" (v 200 (* 1 (get-font-height)))))))

1 0

[pal-cvs] CVS pal
by tneste 13 Jul '07

13 Jul '07

Update of /project/pal/cvsroot/pal In directory clnet:/tmp/cvs-serv16987 Modified Files: ffi.lisp package.lisp pal-macros.lisp pal.lisp todo.txt Log Message: Changes in the API, especially in the various DRAW-* functions. Most examples still not updated, polygon examples added. --- /project/pal/cvsroot/pal/ffi.lisp 2007/07/09 18:17:44 1.4 +++ /project/pal/cvsroot/pal/ffi.lisp 2007/07/13 13:21:04 1.5 @@ -464,6 +464,9 @@ (push resource *resources*) resource) +(defmethod free-resource :before (resource) + (assert (typep resource 'resource))) + (defmethod free-resource :after (resource) (setf *resources* (remove resource *resources*))) @@ -860,4 +863,6 @@ (cffi:defcfun "calloc" :pointer (nelem :uint) (elsize :uint)) (cffi:defcfun "free" :void (ptr :pointer)) - +;; SDL_SysWMinfo wmInfo; +;; SDL_GetWMInfo(&wmInfo); +;; HWND hWnd = wmInfo.window; \ No newline at end of file --- /project/pal/cvsroot/pal/package.lisp 2007/07/09 18:17:44 1.3 +++ /project/pal/cvsroot/pal/package.lisp 2007/07/13 13:21:04 1.4 @@ -371,7 +371,6 @@ #:get-application-file #:data-path #:with-resource - #:with-clipping #:randomly #:relt @@ -403,6 +402,10 @@ #:reset-blend-mode #:set-blend-color #:with-blend + #:with-clipping + #:push-clip + #:pop-clip + #:update-screen #:load-image #:image-width --- /project/pal/cvsroot/pal/pal-macros.lisp 2007/07/09 18:17:44 1.5 +++ /project/pal/cvsroot/pal/pal-macros.lisp 2007/07/13 13:21:04 1.6 @@ -41,17 +41,18 @@ (defmacro with-default-settings (&body body) `(with-transformation () - (with-blend (:mode :blend :r 255 :g 255 :b 255 :a 255) + (with-blend (:mode :blend :color '(255 255 255 255)) (pal-ffi:gl-load-identity) ,@body))) -(defmacro with-blend ((&key (mode t) r g b a) &body body) + +(defmacro with-blend ((&key (mode t) color) &body body) `(progn (pal-ffi:gl-push-attrib (logior pal-ffi:+gl-color-buffer-bit+ pal-ffi:+gl-current-bit+ pal-ffi:+gl-enable-bit+)) ,(unless (eq mode t) `(set-blend-mode ,mode)) - ,(when (and r g b a) - `(set-blend-color ,r ,g ,b ,a)) + ,(when color + `(set-blend-color (first ,color) (second ,color) (third ,color) (fourth ,color))) ,@body (pal-ffi:gl-pop-attrib))) @@ -112,8 +113,10 @@ args))) (defmacro funcall? (fn &rest args) - `(when ,fn - (funcall ,fn ,@args))) + (if (null fn) + nil + `(funcall ,fn ,@args))) + (defmacro do-event (event key-up-fn key-down-fn mouse-motion-fn quit-fn) `(loop while (pal-ffi:poll-event ,event) @@ -169,7 +172,7 @@ (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) + (cffi:with-foreign-object (,event :char 500) (loop (do-event ,event ,key-up-fn ,key-down-fn ,mouse-motion-fn ,quit-fn) ,@redraw --- /project/pal/cvsroot/pal/pal.lisp 2007/07/09 18:17:44 1.8 +++ /project/pal/cvsroot/pal/pal.lisp 2007/07/13 13:21:04 1.9 @@ -1,9 +1,10 @@ -;; are the texture options sane for draw-poly etc. +;; Urgent: ;; tags-resources-free? -;; animations -;; circle/box/point overlap functions +;; circle/box/point overlap functions, fast v-dist ;; resources should check for void when freeing -;; sdl window not on top? +;; sdl window not always on top on windows? +;; do absolute paths for data-path work? +;; draw-image aligns, draw-quad! abs. (declaim (optimize (speed 3) (safety 3))) @@ -186,7 +187,7 @@ (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) + (cffi:with-foreign-object (event :char 500) (do-event event key-up-fn key-down-fn mouse-motion-fn quit-fn)))) (defun wait-keypress () @@ -251,9 +252,9 @@ (declaim (inline clear-screen)) (defun clear-screen (r g b) (declare (type u8 r g b)) - (pal-ffi:gl-clear-color (coerce (/ r 255f0) 'single-float) - (coerce (/ g 255f0) 'single-float) - (coerce (/ b 255f0) 'single-float) + (pal-ffi:gl-clear-color (/ r 255f0) + (/ g 255f0) + (/ b 255f0) 1f0) (pal-ffi:gl-clear pal-ffi:+gl-color-buffer-bit+)) @@ -415,8 +416,8 @@ (pal-ffi::free-surface surface) image)) -(defun draw-image (image pos &optional angle scale) - (declare (type image image) (type vec pos) (type (or boolean single-float) angle scale)) +(defun draw-image (image pos &key angle scale (valign :left) (halign :top)) + (declare (type image image) (type vec pos) (type (or boolean single-float) angle scale) (type symbol halign valign)) (set-image image) (let ((width (image-width image)) (height (image-height image)) @@ -449,7 +450,7 @@ (pal-ffi:gl-tex-coord2f 0f0 ty2) (pal-ffi:gl-vertex2f (vx pos) (+ (vy pos) height)))))) -(defun draw-quad (image a b c d) +(defun draw-quad (image a b c d &key absolutep) (declare (type image image) (type vec a b c d)) (set-image image) (let ((tx2 (pal-ffi:image-tx2 image)) @@ -486,12 +487,12 @@ (pal-ffi:gl-vertex2f vx-to (+ vy-to height))))) (declaim (inline draw-line)) -(defun draw-line (la lb r g b a &optional (width 1.0f0)) - (declare (type vec la lb) (type u8 r g b a) (type single-float width)) +(defun draw-line (la lb r g b a &key (size 1.0f0)) + (declare (type vec la lb) (type u8 r g b a) (type single-float size)) (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+)) (pal-ffi:gl-disable pal-ffi:+gl-texture-2d+) (set-blend-color r g b a) - (pal-ffi:gl-line-width width) + (pal-ffi:gl-line-width size) (pal-ffi:gl-enable pal-ffi:+gl-line-smooth+) (with-gl pal-ffi:+gl-lines+ (pal-ffi:gl-vertex2f (vx la) (vy la)) @@ -500,14 +501,14 @@ (declaim (inline draw-arrow)) -(defun draw-arrow (la lb r g b a &optional (width 1.0f0)) - (declare (type vec la lb) (type u8 r g b a) (type single-float width)) +(defun draw-arrow (la lb r g b a &key (size 1.0f0)) + (declare (type vec la lb) (type u8 r g b a) (type single-float size)) (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+)) (pal-ffi:gl-disable pal-ffi:+gl-texture-2d+) (set-blend-color r g b a) - (pal-ffi:gl-line-width width) + (pal-ffi:gl-line-width size) (pal-ffi:gl-enable pal-ffi:+gl-line-smooth+) - (let ((d (v* (v-direction la lb) (+ width 8f0)))) + (let ((d (v* (v-direction la lb) (+ size 8f0)))) (with-gl pal-ffi:+gl-lines+ (pal-ffi:gl-vertex2f (vx la) (vy la)) (pal-ffi:gl-vertex2f (vx lb) (vy lb)) @@ -522,7 +523,7 @@ (declaim (inline draw-point)) -(defun draw-point (pos r g b a &optional (size 1f0)) +(defun draw-point (pos r g b a &key (size 1f0)) (declare (type vec pos) (type u8 r g b a) (type single-float size)) (pal-ffi:gl-push-attrib (logior pal-ffi:+gl-color-buffer-bit+ pal-ffi:+gl-current-bit+ pal-ffi:+gl-enable-bit+)) (pal-ffi:gl-disable pal-ffi:+gl-texture-2d+) @@ -533,8 +534,8 @@ (pal-ffi:gl-vertex2f (vx pos) (vy pos))) (pal-ffi:gl-pop-attrib)) -(defun draw-rectangle (pos width height r g b a &optional (filledp t)) - (declare (type vec pos) (type u11 width height) (type u8 r g b a) (type boolean filledp)) +(defun draw-rectangle (pos width height r g b a &key (filledp t) (size 1f0)) + (declare (type vec pos) (type float size) (type u11 width height) (type u8 r g b a) (type boolean filledp)) (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+)) (pal-ffi:gl-disable pal-ffi:+gl-texture-2d+) (set-blend-color r g b a) @@ -543,6 +544,7 @@ (pal-ffi:gl-rectf (vx pos) (vy pos) (+ (vx pos) width) (+ (vy pos) height))) (t (pal-ffi:gl-enable pal-ffi:+gl-line-smooth+) + (pal-ffi:gl-line-width size) (with-gl pal-ffi:+gl-line-loop+ (pal-ffi:gl-vertex2f (vx pos) (vy pos)) (pal-ffi:gl-vertex2f (+ (vx pos) width) (vy pos)) @@ -553,23 +555,30 @@ (pal-ffi:gl-vertex2f (vx pos) (+ (vy pos) height))))) (pal-ffi:gl-pop-attrib)) -(defun draw-polygon (points r g b a &optional (fill t) image) - (declare (type list points) (type u8 r g b a) (type symbol fill) (type (or image boolean) image)) +(defun draw-polygon (points r g b a &key fill absolutep (size 1f0)) + (declare (type list points) (type u8 r g b a) (type (or image boolean) fill)) (cond - ((and (eq fill t) image) - (set-image image) + ((image-p fill) + (set-image fill) (with-gl pal-ffi:+gl-polygon+ (let ((dx (vx (first points))) (dy (vy (first points)))) (dolist (p points) (let* ((x (vx p)) (y (vy p)) - (tx (/ (- x dx) (pal-ffi:image-texture-width image))) - (ty (/ (- y dy) (pal-ffi:image-texture-height image)))) + (tx (/ (if absolutep + x + (- x dx)) + (pal-ffi:image-texture-width fill))) + (ty (/ (if absolutep + y + (- y dy)) + (pal-ffi:image-texture-height fill)))) (pal-ffi:gl-tex-coord2f tx ty) (pal-ffi:gl-vertex2f x y)))))) ((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+)) + (pal-ffi:gl-line-width size) (set-blend-color r g b a) (pal-ffi:gl-disable pal-ffi:+gl-texture-2d+) (pal-ffi:gl-enable pal-ffi:+gl-line-smooth+) @@ -577,18 +586,15 @@ (dolist (p points) (pal-ffi:gl-vertex2f (vx p) (vy p)))) (pal-ffi:gl-pop-attrib)) - ((eq t fill) + (t (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) (pal-ffi:gl-disable pal-ffi:+gl-texture-2d+) (pal-ffi:gl-enable pal-ffi:+gl-line-smooth+) - (pal-ffi:gl-disable pal-ffi:+gl-texture-2d+) (with-gl pal-ffi:+gl-polygon+ (dolist (p points) (pal-ffi:gl-vertex2f (vx p) (vy p)))) - (pal-ffi:gl-pop-attrib)) - (t - (set-image image)))) + (pal-ffi:gl-pop-attrib)))) @@ -621,7 +627,7 @@ (defun load-music (file) (pal-ffi:load-music (data-path file))) -(defun play-music (music &optional (loops t) (volume 255)) +(defun play-music (music &key (loops t) (volume 255)) "Volume 0-255. Loops is: t = forever, nil = once, number = number of loops" (pal-ffi:volume-music (1+ (truncate volume 2))) (pal-ffi:play-music (pal-ffi:music-music music) (cond ((eq loops t) -1) --- /project/pal/cvsroot/pal/todo.txt 2007/07/03 18:42:35 1.4 +++ /project/pal/cvsroot/pal/todo.txt 2007/07/13 13:21:04 1.5 @@ -17,8 +17,10 @@ - CL native font resource builder. -- Fix with-blend (r g b a), see that things work on Allegro CL. +- Fix with-blend (r g b a). - Make it run on OS X. - TrueType font support. + +- Simple animation system for images.

1 0

[pal-cvs] CVS pal/examples
by tneste 13 Jul '07

13 Jul '07

Update of /project/pal/cvsroot/pal/examples In directory clnet:/tmp/cvs-serv16987/examples Added Files: polygons.lisp save_lisp.gif Log Message: Changes in the API, especially in the various DRAW-* functions. Most examples still not updated, polygon examples added. --- /project/pal/cvsroot/pal/examples/polygons.lisp 2007/07/13 13:21:04 NONE +++ /project/pal/cvsroot/pal/examples/polygons.lisp 2007/07/13 13:21:04 1.1 (defpackage poly-tests (:use :cl :pal)) (in-package :poly-tests) (with-pal () (let ((grid (load-image "bg2.png")) (slad (load-image "save_lisp.gif")) (teddy (load-image "yellow-teddy.png"))) (event-loop () ;; DRAW-RECTANGLE just draws a filled or wireframe rectangle on screen (draw-rectangle (v 0 0) 800 600 0 0 0 32 :filledp t) ;; DRAW-POLYGON draw a polygon which vertexes are given as a list of VECs. ;; FILL is either nil, true or image that is used as a pattern. If fill is an image the rgba values are not used. ;; When ABSOLUTEP is T image patterns position is decided by screen coordinates. (with-transformation (:pos (v 100 100)) (draw-polygon (list (v -100 0) (v 100 0) (v 50 100) (v -50 100) ) 255 0 0 255 :fill grid :absolutep t) (draw-polygon (list (v -100 0) (v 100 0) (v 50 100) (v -50 100) ) 255 0 0 255 :fill nil :size 5f0 :absolutep nil)) ;; Note: next one doesn't work like you might expect since the image size is rounded up ;; to the nearest power of two and the extra is filled with blank. (with-blend (:color '(255 255 255 20)) (draw-polygon (list (v+ (get-mouse-pos) (v -100 -100)) (v+ (get-mouse-pos) (v 100 -100)) (v+ (get-mouse-pos) (v 100 100)) (v+ (get-mouse-pos) (v -100 100))) 0 0 0 0 :absolutep t :fill slad)) ;; DRAW-IMAGE-FROM draws a part of image, defined by a starting point, width and height. ;; If width or height are larger than the source image the image is tiled (draw-image-from teddy (v 0 (get-mouse-y)) (v (get-mouse-x) 0) (truncate (image-width teddy) 2) (get-screen-height)) (draw-image-from teddy (v (truncate (image-width teddy) 2) (get-mouse-y) ) (v (- (get-screen-width) (get-mouse-x)) 0) (truncate (image-width teddy) 2) (get-screen-height)) ;; (draw-quad ...) to be done )))--- /project/pal/cvsroot/pal/examples/save_lisp.gif 2007/07/13 13:21:04 NONE +++ /project/pal/cvsroot/pal/examples/save_lisp.gif 2007/07/13 13:21:04 1.1 GIF89a#"ÄðððÀÀÀ@@@000 ```ÐÐÐ ààà°°°PPPpppÿÿÿ!ù,#"ÿ $dihª®lëŸp,Ïtmßx®ï|ïÿÀ pH,È€rÉl:ÐštJZ¯Ø¬vËíz¿à°xL.ÏèŽzÍn»ßðž|N¯ÛïøŒ~Ïïûÿ ¡¢£€¥Š§š©ª«¬®¯°±²³Žµ¶·ž¹º»ŒœŸ¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ H° Á*\È°¡Ã#JH±¢Å3jÜÈ±£Ç CI²€É(Sÿª\É²¥Ë0cÊI³ŠÍ8sêÜÉFO xz° À£H` 4ãH£F5 )Å€jJU nû@Õ¯Ã]ûàZ Ä²%K ÀÛFË.õéÀÀ\€Þ÷Á»%ü= @ÀàŒ¢@àwñÇ äý[@2f=àùóÁ¢8À±é6§æúZ`Ê³XP[Õé @`3¹Rwî}*@hÝ¥ï0Èª4sU£6Æ#wÔËI Xày¿n)»Ö³sP iŒkUÎèYž·s(¶U`&0 ßÿZ Ø×š= j1žÞX äö>DapÁrdmÈFû]Ásk6ÀÄE JPÇ€ÀdbR.Â8U(0EôxÔT8[}i°k$8¢L2X%bGíXZ]Vl©Ø%¶u~Pâ§TO-æ_ejWçJôy5H|7tGVdCU×ómÅšwZJhj¡ª]:Ck1%`@f¡åVaPF!6dzTgµ®¥Šýøš[!:ÆúV\¶¬TÂÆÐé$Øúš®u¡ÿl`ìVJÕ ÒFu@²+t+i Ïµ'Ø2È![7nË[ûÂ²B»fu_Tà+Õ ò./,œ/°u²F Hµ:Âª[Ñ0`æ EpÅe€>LàVÀ#Ð»VŒ#€|ša3]©àð~2Tª& ±TÛqPNµ€¹c oÏA°9W³÷EzeÄJÅsÁ-íDÔ[Õ§sI³e6ÖExÜ C×Ã\ÔÛN(°Îl*÷Q'Ã]DØUlšCº.Ð²YÜæáÓgøüþuiê Ðžÿ0PÇ$ÀzhÏõm óæG N¢®@ìU_MB1£[d~û}sM;%§-èÂÏ56 ïTÔÍ Æ¶üÿ®Ekî'Æ,Tì8qïà€`ŸØß/ÀèÇ9¡Ö_»0?RéÆ£¿,©siÃ^ý|Ÿ#oÿCÊêVÐºš$@ÊËÿRd¡ñmCSjö3²0Zk1Nµ =î èôŽÀ}%,Õ²u¡jåu1dÂîžiÅj-0ÝXŠG$`FH¥2;ðîhA|Bã&xæIY-äBŠšÿ FålábP7Ú.c.hÓî77è#0#×Ø·±ÅZA F êWJœXH>Þ (xãöXHÚ°`ÚÃ©æÂÅ¡EÑ2°RÞFLQ*^õEî djðAêencÁÐVX+1kA"°ËŠt}Ë'¹7«rbPßVÐžõò Ì eTÀÑ²åùE1ÔklälÒ(²aâ ÚšËl±-âÔ9? `BR "lçWžoÞk.U4 ß³¶û+·R8(1*î»òcHÿ²,Ÿû(ÛTÎÇIá¢Há4SjUø'KPIfÕ`¡xbÁ>°ÌÔô(.ÈNFðÆoJ²I8Ñù`ÊË Àøc;åÇd`¥{S*Y k.ÁkîëÞÚvf52uI°ê.øR*%X¹¡FÍ§VU!,3K@ZcBŠÑt3žŒY v:ÖúK.ò,Bå+¹®©±,ìÎh0×ÀphÂ4cãX)B6 dÐªçµ ^3ÚµD¹$Y)KP[:JPÈñXæ§ŠêA©Çf²à£VrSÙ'dn\ÿ8ôP·~ÅÔe.pœB`cYæOçRÝ³medCË»î~Œ¹ê Ö]ªïQMxš>xF¶S }y`_Ì|Ž,ëœ^vÙ·±ÓÍÖy`V*"F,@Šú="Å«_ÙgF[,l%db«VöjÃ:Øèà§?úys2Ù#ÖzÁ¬:ëÝ]8à×&4m`@_öãXõÔ`Ì¡ ÆH¹- Kéw@·lùHtiÀ )Ø8M!ÖRžæÍ6l.BÀOÌ÷æ.ÒtHpÿâÜ«Øz >Ý[$âlN,í]~ÚÅ;jÞfE33Ï ÓFË|°X3Š©Mšg`¹aÕ³1Àlj*[ò+øÈd`aØQiò£ð, ÊSöÞ¬B'g0ŒúP\QfÝ(ÐØãÎnPYL!0Tkt>v \Õð{1d¥ßÀªÜ°Ì@Ù`š-ŠÍÍá·vÓÇÞ+ÈõQÔËÊEÖf·"ÛÛi B€ 4nn%11M@yÄoË³ä[ xPN&¿k1® AÛ>àÓ4VAÄÿÙËm:8*7ã^A¹?ôåÁŽ¬IË*åÝ~Ð}<õ]3É@H]ú® ¶é©¶ÜgTíT=B öTËîêÁš¿ÌäÌz£ïÜ×·CaÞ`öÝïHé¿ÛÊ4=á^LÔG°uCo+N(NÆ2§ù&5_AçàóÞÄ ðWõP&Sá§Àô«Qî;ÎÞ>6*OÞÔ##>Žj T³@^1@úâW!ý¿ŽJù£q§ÒúdjóÀL Ø=¡v øJ.RYÕ}p,õ.<K[Qû€Z,×ùí#üËDúG)wÿ¿ žw+=@÷eëté¡SvÔqp bÕiÄj$¶}d[í'Öbñ"Á{° @xÇl¶7±R·5Iö±`.`fUf§m7QS'À#c"ðt"X·BÞ¶)Ð¢18 [Ákâ0Ý²:/k¿0·=ž<öSxD1H0MCèn(Ð-y#gRf¬H81Ðàv71t¢Ñ¿ÇweYñåæsÁ%Í~á¹Ñ:Åjé±øµ×zÁ§®<'e^§HÏ d4@p<v:cÞ Sÿs¡Z'0u[Á¶À^U^x&öÞ}}S4(Ï°SGR1ÒdøÅáðð'Û€mI¡ud2RÍ°dÔQjó#ÚhE&b'ÇHs{Zåx<ò°¡ÇÁç!oæýæ6'ã5¥NÛTfä*Ì$[13|ö«EØS}<šFüSjE$PQ§C(À [°U1é~éåÏTH9dá0DÈw$çqç£/,Wá@NØ=(6ä`4CVhŽæhSŠDeþ§ > Øšã8Òæÿã7sDŸc¡ ÚS&ilEoY&whé$6!6Y (¥¿3:óÈUæónÇ6`I|y {ÆhŽxh ÉjÚajrVSÆÃp}I Æ°S E·EQ°2ãÚÖÇgÕöD²5 @©À$?'ZuâÚQ8æ ì%^|ž&iùM¹7@sÉ(V7<Ã1Á¹ uÃ(0]o«×r"aj4yS)uÉŽyDÆENÑi2ùp9ÃTv '|ókÏX.º"Ykfq\TU>QAÛká÷ÿy^Ê3æiõš2¢à·K÷{Z"é|#Ð)08ä!(¶Aø.S©ó ž¢sA0uH4& %0)¡³BÐI"9 âfÈRá"ØÈÜ0W7€ï)"ùA°Ö,)JQúYð98d«XhÚbl±$^ø€' %PZ.6!@êGñ@pÛ)?Õ¢vŽ¥· jd.©øyb+`[º !j7-`Œå:pF,ÈÄiû/®2sº ë¥·$ÐµãI¿S1ûPRÕÙº bÕ¢B]Ã'c:oQØÿõ¥@÷©¡Ù?3ö^èXšmÿB(M®y³F· ÿYozÑñQ=õ,UA|8Zpsrc (%yxºfØEå¥|SêÃ¥9à4§ ¥dð£Ëóálëbx€PcµŸ >M«I!¥/ç(®íàc¬¿6X ïxŠÙè¢Àr%ê!J¡Ô@J¡rÑîY©![H@.ùV ²vsÅT38³§Fªè B²% .ÆÁ°*LBC¯¢Z@peëž°åÅ¹uW M'»~mJ¡1Ö©²±ÇºÿãÑZ¬Ç¯DROÍ*G€-tåI«YR £WîúÖqÞ9Ç£íð¥rÙw¶jøÊ¢u£s!Ô_ñ:¶ÒhŠÒð,Û!Z£³4xøH9 A,µ}IØ óÅyE$òp.Â€žéÐ9o`\ôSÑ%8ûw{»°Ø¹ÀE£PÓ ú°ÁÔ·ÂsB)t!JgQ~ÚVfêJ;.¹°Â[i¥ºÄ,vÍ»RnfÛ[ouûœß±téKÓéy$ 3Èáœ5¿ä` JÑÿBrî;]ö;3$A5«Á;µ7£%?nô»00Ó[\ºA#ÁñP¿Ðv *EFó¹Üp³?4(+Ûª"Â# UÁõC ,¢©²SËA·SaH&uJHüûÏÑÊ{3yR¡ yd8 V¬ Âž÷fá1jYEÆËZKÀ'1ÃÄ'ãÆ³Cp{"ÆœµÉ³ ?·çf¥ŠvšócGZÇ;pÜ@5×-°Yðã&ÈèP71cÌ2!J|&sQ13H<l;eÃÛ;ÀVµÿÏ@Ã-Rç_ª|ÿ£'CÈ4àD `ü¥k~Ê»Bj\¯XÆ%ÏŽ¥vFÃ,«`üÊ®L<#Ì64¥¶üG4U®tÕ ^§aoC(Þ¡°ÛI®ÀËÐ0Ÿ¶ª~,aÞÌ)#mž¬ÍÙÓ9)þr ÔT1dªk¢ÎäH¶×°ì5&xírÉñ@Ž* V÷Õ<^Iû{GB.Ý²Ìœµ-ðS"0¬,¬Zm@|OÐÜµ;X÷r£ú<ªKû¥€ÁbAuÀ,HÝ#mbŸù`²GÝÃŒÿ£z¹ñµÿëÔå.òT-ÑFšm0ãÌár5qÖÑa€Æ\MÕGXÑTc-lStCÑÒ[[MZ×1]e×ø Šû"aT»a¹\EW<#g `bØ3àÝZÈØQA)UVðw0UmšYfÁ1p6ù®UóÉÚ¥PDEÊÙ6Xf -óqÆF@,J±LDa8NµÜÏÀÝ#zeF±!áÖ=SA¹(EeSÊw¥¡÷¶<^²Á9ÄÜ º!,r£xJÐŠ+"IÞqÁÿ.4*Ò®Ék}$Àg¥ÑË*0CúWZkÛR-¶Œ`É`ðÛ)ÝUÑ.1íÛGÒ2®a$IüC\U®,bÙ1œÛH!¬dP$Søa`gÑ!Â2"u`3¯3Àý ¶Ùâe1Ü)}á+ æ#ëb$ub0¿w"Õå¿beýGbáéCq|äº;X±T,5Ñ9ý90$%Å+ua%ä28s¬ÔÑ*ÄKV Í<hÔå%dQÓH Khº Ã·$EYm{/Ð)@d4NâßãÕ2âêT1ÿ7ägDh%H®ß/">_¢Ç+Wey+ããêóØ(f,·?êì·>Ha:§ê4AÑxÇ^é:;XEÏî^ÓØ"í0`D=®¿Qúb.{¢Dß>Õ" ¢ä^îL°ÞI¬> }@;AÄžqí±ì:`:ïú#§Óvg03×1Le[ð'æá_¬Û>ãðà~Å"ª~ýðm8b8l¡Žñ1kI_3_žr(ô^%(D©òHP-ÓÚ+Y9O3_0lAÏâ 9Oéö)ÿšóó@8€ÓË©±»*8Gï13YlEQáO¯ð9À1,¢UZ¯ÄëÙL]ïñŽÂÐoeä2$Pö;oØ~ô)¿öž%=#\Rs1÷OGbý{Oò Œä·òm1?kŽ$]1¯;V6+õM[§ø®¿"*ùÀõ5ÐYùA@5Ú-Œ®Vù;Æú|ZA0ŒãúdöÑ7:GoïŽ¿&€vy÷(ÙößñÿøSá_HAüoü0°ã)íNÑËÏ(B" Rçå×Vo@ñXÄ8,D ¶äýHÏESTÿ(4 yä#ûÂo`g;ÔOóœÿÂ!±h<"Ê%šX ¹Â!±kb±Ü:øÇ[3®EÕCo9Â@žŸ¯%šž1ýÙàd-2Æ(0} š5VZ^b2&å€eÊuºÐ,måÈÕ8Ô$ Ž žæ€ŽpíBP2À.)8š8Ø2W[_+!Hêb_ s×ì8Ôøö0p!ìr§søÍÕ/ÁB4 z[+ÈÅŸ.C4®FJ ¶p¢ Ðö Ýrvø@Æé$ÿSQÃÍ°% ð¬Æú\yIáD9u ºDàDš E`@ž¢¥êäœD)ÙQ2ŸU*MÔüµB4yPQ®E ]+w.¢NMH¥K$@~ãØ±³°=}PsðzuÂ~ÅØÂnÅ?8]Ž\¢i¯ëN8Ô$ã»GE£NÊóîÓ© àË9#'ñ@@ÏÇb.%By³â1Mçdâ-xDAžr¹ÒœÞ[õåìÞ±dMæç÷ 8°çÎ¡Âõ/Vç`Á¹u Ì¶ã`ón·:Qõ@^÷dAßoáÿXyCl'BhÉâuâ^¹ÐÝpŽæ>Ò5U5]ÅhÒÑ`[aQZÚ<ÀG¡7òØD:!_Ø~ý ÇÃMn(pd|<p0V?-Py¢ðÂ9H#ÃÄáZÉEkÂimrÑÀK¥89YkqåžáÛÃm@9. r/4Ù/ùnÆ`âýš§vµ©§£ÂÀ%)yÑ],n'4ðÈÇÃ¢bÁØøVŸj}É6ô C"°Ñilaq§æÐÿ'©×úEmTÞQ§£4û··š¥5¬DBåsv@ü°ÀI&§º !°@f°@²Þzê×2¶9Ø[@@ŠÉOS4økg0ô×Éžò À6öà ¡ @íÃ7Ìð¬]€õðÅÈÌMÁœeŸ1Pò)L3.Æ6ÀÁÂáI¶ bfäNÂâøDÑÎU4Å97Þ©Ùý±ð00S ð¹ÍœAÐÛÍP¥Ö@·Px¹ÀÑ@ Ütñ\ÃÁló8ö©Ö®õ¿. `ÿ·Sm5 ]n ²69éº\nÓ©:æþxªíBqžûwsÞÃ;pùX/€h ÆŽßv£<ÜàûíåÊ³õ@Ñ »Î€éìn.'Ú¡¶'+ÁÀé§Àµ| ,`»¢{6]Ž·¹ýõÓSOÓ{:üR°+l&E:êÓ*à@` 4Þ^83Zð °ŸVNœ@òßÿR³3}cóÉpŽm&úûuH'Ð¢$_ÆW'ï}¯P£ Â×ü¬rD,¡wÈ2 «+ÜPvøhšø\B2À ü±ÿ"#f'a"&vªs¡&ü¬Èìr!jÜH§'éBN£VùYÒlä©£È%Zöy€8ÄEJ*Ôâ#&õ<ñ±1` Ey-?zËÒ$&©Ê1íãá]B)KÕhË+o9ªáÑéŸ ëîrÉazælÈŒVáèÄÉe^:#4«3Œo!¶ŽæC°©£Iq3·Ëk)Î( Ü æ9Û¹&Ícî4Hù<Î3kRÕè©O 3[â?€¡í&ÈJÁ*.4¢HÃ:u)Ñk$uŒ(Gÿá ¢Ñ€ í(IKjÒ¢4¥*])K[êÒÂ4Š2)MkjÓâº±<sêÓz1*Qº SÒšJ]*PräHŠB5ªE¥jÕ«¡AIÅ*W»º8 4þô*YË:dk«f]+[Tœ¶Â5®¶J\ë*×BÔ®ze*Ozº×¿þÔ],aê>Â6±FEk'ªX&ñ±I š)x#Y&FêÕ e¹1ÖÍzªdøÉ+hÑYqà¬Ž9c[>ñLÕB -l# 3X¶8mQð©ÛQ-`ý-xëaT1ü!mk\ÖŒ6¹7b%¬|+ÿ]?Èö'¢ëuÆîÆÙ=~fYð^K}è}xÕÁøuœ¯|98rõ'µõíÑ'÷«¢°o^{I@G4×¿ÕÈÝoêKK\.[¬xÞ×1)X(ðäz,®±ú&C¬mÂ¿ª*öÁîÿbÆ<U¬ÄÒg§s×öfp/á6LøKëiäõ¯)N&»D÷n4ç~ír@&Öì$n)VürÒÊe©S¥[Ž÷¬ãEîuwd4EãíBK]áøÙåzsàd"øðQþÝê\[FÍÁSYQ\Xhÿx9ÆLµeôÚ>TŽì9Ç nÆé²XAZWŸŠE;Á*5dùžûÕà²ßOqaÐº¥ÝZ œŽŽ.€ ¥Ä®Anú¢-*«vØCÐ1CrÞZµÅT+_ÔYÙÔoõýÒyPÌekÔDpK/×{çÑ4iÞ¯BÀ`Vù«\Èöfá9Ã1;%ÒãI"Ýzv5!Ey6_7ÐåÁ']¶bÆÑdUDm ób÷'ý¶ {öDª}u/QðLÊÑë-û·Úç¿Æg¿ÔÞ€ÆKælØÿ_rÕ7>AßV0Lª3€¿i1ÞŠ°Ë£ÑpoO7Ãî€É©??Ú{ÐC'¶xQÊFo¯1®]çBªùa`]Ð@ãÄ4Ÿ×Àsa8s6®ßºîb>'Ì³Ç?lbÐmÔM°®ï=p9Äœêá)D«[&ã\YÌÝ+ÖIŸÈï]ì£¶®§£LÁGRžîí¶ ÔZÛ¢ÜÏ ÷R<ëúnqü·ð€`&kb¥¯3Ô·»aìã±k&líC`gÉHAã_úºÆu<ôúÇs¿v0èáRA¯`ðœÿàÀR^ô+ý×+Xpí àBÌT kœÕÜl>ü¥ÚüY^xUÐ iå@ôV ^â`ÂS!L{QÏòA¡ÉÀum |ÕC\ É-Ä¥Uç5°GZÐ÷AìšýÈf6 ŽÅD@¡QåFüÁ @ºÚí¡µµ@zE Â@ÜpàÞíAjE~\Î:Á@îÊ@Ÿ^W9ØÂÏHÇ [eêÅ"6B3¿ùîCº J),N %¡&ÿ'r'á(ÓKœ¡ (žlÐÐ.Q#ºC©)²"á(" 6Á µT áRHþÀø``uÂc£,ÝÑ/]íâªP9aÇú]£¥dãÅÆL'²(ÆRÔbÓ]1È+îÛ:fz£ $ßÌ¬Ô=HãqéÏð<?ú?&5Ê£ìÞ@ 5QáB.YxÁaúáÝæIä-d(¢8@* mu8€Vd)D#Ib)_INEò¡Q¿<SÉŒÜ#Gz, qÄ9ø$lå3¥ÿ$fäÿøY÷¢Efc:ºJ,¬ÊMåTe\€S¬€5ñäkÑcG`AäuYï`VfXH HòŒÑ@Aö^6åë4]Vx$`:àYº]MÔBXúÙ!^K-æ÷dS0ú#d>Ç_E!Õ-y8å8bb&¥9æè`t=ßTá3ÎäíäŠ eà]O&ig$]nf!RÄk`)%ÎIŠL6lVr&§ávÂä(ÀUú,&KúÝ_@T×Yãç÷ÕægBmMgÏØf+§NÔPnAA§x¥%`ÿgå{²g|@ö]Þä¬§Nt§ ÁEZ-&0]0ç:^s=©ñÀ zÇ°Ê31e"@TT%gDâ7ôŠøyá÷šèDèk$]ÕlpâÝ9y§äa:%Â(,B|£AÔäBøàKÊÅd_ÛØ=ÓtbæŠ$A$©œqM_ÉÙc^M$ NúÈ%&P€xÔ,ÌAvµ]&©)€Î[A6ö§,ÞlÖå%Ì©xð6ÙB:5~*x mFµvÖ¢Já%<'°µLÓ-Q×eÿè5V¥&\-$yä®ÍxN`ÍšÂqéüAk2CÂhçTÊÑÌX`Âáê-g]0ësÑ)šàò )^éC9ê2JØ%éË|QôæÄ¥Ò€_HÏ£ã^eÕü ¥è%4.êžÂvATR6h@ Íþk+CP#*i/MÍ@ÁË,«-Þ'_k8A6Õ(B¡²Jx*"Âœ^ÂAljVÐu14lOœú1ŸªëÄ @rR×YO\Ö ZÑìnÉKM¬Bºî£=IQí@Î6»ZÿEÔdºÉÊV êbTÚÞ©ãxÉ)]BW«&ÏÈ_ôXK@ôDxUÉ0ÐdÜfÂ'QÐ]-&Nª*mØt«ÒWÂ±Ófäa¯ÄZÅ26YÅÁÑó§ø«€9¶¶€¹ªEè5pê ŒVFÁ£ÊHCX€Ÿ(Â©O/â)D©]Âðîç.A×]nÄ¢Ô5Ñvê!5ÁÂ6Å¥-€:*äòî5äaÇ² -NÝ"Zìù æD%é÷&·a(ïô.C&düÌÂŽGHªÑtïéXYîYuæñäö<Ìÿ/úïÓÌÁ*}vMXË¢ŠãÿÞÐ)ÔèìÒ/lú@<Øñ^/ô0 $Æœ`+¥;âAÎöEeÃééàéJÓÂydp5àªxsdÑÏð óÞ?|ïk®lXgøG|¬(@ÁÆð ^&šžÂðé°'0°ÞØÀO LËyAäàf.$ñ2.p&0E¥yøFhŽ/ã<a790ŒOw¶æáÞÍZE)pî{Ãtö5ÆOÀ~!ÂðÝèùþÃ A ÁéÕ<È £±¯ B~°Q$ÎKà¯BàCô°©õº@"ÿAÛBA`«%ËEvA/8ÔÇžËØpk:EýbñùÉ~¥+÷÷òºÖÝ)mÒ§ÖhÁ|0_O·.MÔÇŽñÊP0r4^±€€S³hš/ªZÑß¥¶Vqé²]P9ß-Ñ³QÈ"ÿ&eîr8¿A]¶²=ék#/b-_t6óÿ4ÙDð¯AÏs#Ë÷äÜš©2°/3*Áé!±EëF#A!a»²µm5rÌóD£ôÐï² C$ÉíFÃÐLT/O@?r"a«æô,ÃÚÿ°Eè30Vk3Óq<ÛŽºr£X=5TsÃ !óô§òLŽ6Â7û#/õ»ÆaÝHÁ;õAüŠhÒPöJ rÓ³ø<C4`^]ëQPïk;×ß|àÒbRŽHv66a¡ÿÐÇOp2€P¬tã'ôquþpDsueëñe_Ï®â;¡0y€tž$Iüuñ¹u+ÖÚªvŒŽ·æJvŽÇvjÐGoCSæHCÆ!ÇÀtb5jÛîpjF+·äò@g{ô/Â÷)ei×È¡E'ŒnvRäµ%D1z(=ªõZDÖŸVŽz³M?ÿEùÐËš^Ø ù ßé·5±¡áæõ)Ï²s>ÍhdºØÅ|'8&ñwkàÚ uúgeÕ¶5¬ecÌÃgxÃ'm¶I§Ðõ2Ð w§x5Yf}ÁzbÉFÈ'ÝÞx5M±ssÇ!Ö¬fŽgHx{Tõµä7@=¹ß4CžEÏìÿÃPÞxù-É2hæhÃh:ÀGG¥®y'Ù¬bÊDý¬¶2Ã_óö×FOñÐ7Î.Pódú,$äâí`?!ëæ£?ÕÊ±ÕZÊr§ŠðÿÌ€kx76'©R@`z)xz'ý¹S8:«ó©ºy³Q,:EÛº*ñ£GOz³QÃâ¯¿ÒKTN R_ÈO#»m°÷. @ÑÔzŽÇÉ¬SËRû³¶ûÒŽ§¹/ñºPû2]:³5,Ž§;%9ÛAÓ&d{Œ3ÏµŸK$äÞó»jÅäÛŒOâÐªüT;7yÂ®Ã×æRð±Ä¿'?µÅ¿'?F¹Æ×:â®Ç;f!À»È#b.ŽÉ+XÜšü{ŠIË¿''€<ÌÏÚFÓüYZëÍ;f4ŒÎûüÏ}ÐýÐ}ÑýÑ#}Ò+ýÒ3}Ó;ýÓCv}ÔKýÔS}Õ[ýÕc}ÖkýÖs}×{ý×}ØýØ}ÙýÙ£}Ú«ýÚ³}Û»ýÛÃ}ÜËýÜÓ}ÝÛýÝã}ÞëýÞó}ßûýß~àþà~áþá#~â+þâ3~ã;þãC~äKþäS~å[þåc~ækþæs~I;

1 0

[pal-cvs] CVS pal
by tneste 09 Jul '07

09 Jul '07

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))

1 0

[pal-cvs] CVS pal
by tneste 04 Jul '07

04 Jul '07

Update of /project/pal/cvsroot/pal In directory clnet:/tmp/cvs-serv24185 Modified Files: pal.lisp Log Message: Fixed a CLisp specific(? )bug in CLEAR-SCREEN --- /project/pal/cvsroot/pal/pal.lisp 2007/07/03 18:50:48 1.6 +++ /project/pal/cvsroot/pal/pal.lisp 2007/07/04 18:41:12 1.7 @@ -244,7 +244,10 @@ (declaim (inline clear-screen)) (defun clear-screen (r g b) (declare (type u8 r g b)) - (pal-ffi:gl-clear-color (/ r 255f0) (/ g 255f0) (/ b 255f0) 255f0) + (pal-ffi:gl-clear-color (coerce (/ r 255f0) 'single-float) + (coerce (/ g 255f0) 'single-float) + (coerce (/ b 255f0) 'single-float) + 1f0) (pal-ffi:gl-clear pal-ffi:+gl-color-buffer-bit+)) (defun set-mouse-pos (x y)

1 0

[pal-cvs] CVS pal
by tneste 03 Jul '07

03 Jul '07

Update of /project/pal/cvsroot/pal In directory clnet:/tmp/cvs-serv2922 Modified Files: changes.txt Log Message: --- /project/pal/cvsroot/pal/changes.txt 2007/06/28 20:14:05 1.1 +++ /project/pal/cvsroot/pal/changes.txt 2007/07/03 19:17:57 1.2 @@ -1,4 +1,14 @@ -Release 3 +Release 3, July 3 2007 + +- Changed some of the parameters to sound functions. Volume is now defined as a + value between 0 - 255 instead of 0 - 128. + +- Removed the MOUSE-BUTTON-DOWN/UP-FNs from event handling functions. Use + KEY-*-FNs instead. + +- Loading bitmaps should be a lot faster now. + +- Fixed the Lispworks bugs. - Renamed GL-PAL system to PAL.

1 0