pal-cvs

pal-cvs@common-lisp.net

127 discussions

[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

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

03 Jul '07

Update of /project/pal/cvsroot/pal In directory clnet:/tmp/cvs-serv29106 Modified Files: pal.lisp Log Message: Fixed a major two byte memory leak --- /project/pal/cvsroot/pal/pal.lisp 2007/07/03 18:42:35 1.5 +++ /project/pal/cvsroot/pal/pal.lisp 2007/07/03 18:50:48 1.6 @@ -396,6 +396,7 @@ :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))

1 0

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

03 Jul '07

Update of /project/pal/cvsroot/pal/examples In directory clnet:/tmp/cvs-serv27783/examples Modified Files: hello.lisp swarm.lisp Log Message: Removed MOUSE-BUTTON-DOWN/UP-FN from event handling functions. Use KEY-*-FN instead --- /project/pal/cvsroot/pal/examples/hello.lisp 2007/07/03 18:10:33 1.3 +++ /project/pal/cvsroot/pal/examples/hello.lisp 2007/07/03 18:42:33 1.4 @@ -6,14 +6,14 @@ (pal:with-pal (:paths "/path/to/examples/") (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)) + (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)) (pal:wait-keypress))) ;; (hello-1) @@ -22,11 +22,12 @@ (defun hello-2 () (pal:with-pal () (let ((angle 0f0)) + (pal:set-blend-color 0 255 0 255) (pal:event-loop () - (pal:draw-rectangle (pal:v 0 0) - (pal:get-screen-width) (pal:get-screen-height) - 50 50 200 10) - (pal:with-transformation (:pos (pal:v 400 300) :angle (incf angle 1f0) :scale 3f0) - (pal:draw-text "Hello from PAL" (pal:v 0 0))))))) + (pal:draw-rectangle (pal:v 0 0) + (pal:get-screen-width) (pal:get-screen-height) + 0 0 0 10) + (pal:with-transformation (:pos (pal:v 400 300) :angle (incf angle 1f0) :scale 3f0) + (pal:draw-text "Hello from PAL" (pal:v 0 0))))))) ;; (hello-2) \ No newline at end of file --- /project/pal/cvsroot/pal/examples/swarm.lisp 2007/06/28 20:14:05 1.1 +++ /project/pal/cvsroot/pal/examples/swarm.lisp 2007/07/03 18:42:33 1.2 @@ -3,10 +3,11 @@ (defun swarm () (let ((vectors nil)) (pal:with-pal (:width 1024 :height 768) - (pal:event-loop (:mouse-button-down-fn (lambda (mb) - (when (= mb 1) - (setf vectors (append vectors (loop repeat 50 collecting (cons (pal:get-mouse-pos) - (pal:v-random 5f0)))))))) + (pal:event-loop (:key-down-fn (lambda (key) + (pal:message key) + (when (eq key :key-mouse-1) + (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:draw-text "Use left mousekey to add particles." (pal:v 0 0)))

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

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-serv23257 Modified Files: pal.lisp Log Message: Changed the arguments of sound functions. Volume is now 0 - 255. --- /project/pal/cvsroot/pal/pal.lisp 2007/07/03 18:10:33 1.3 +++ /project/pal/cvsroot/pal/pal.lisp 2007/07/03 18:27:22 1.4 @@ -585,23 +585,24 @@ ;;; Samples -(defun load-sample (file &optional (volume 128)) - "Volume 0-128" +(defun load-sample (file &optional (volume 255)) + "Volume 0-255" (let ((sample (pal-ffi:load-wav (data-path file)))) - (pal-ffi:volume-chunk (pal-ffi:sample-chunk sample) volume) + (pal-ffi:volume-chunk (pal-ffi:sample-chunk sample) (1+ (truncate volume 2))) sample)) (declaim (inline play-sample)) -(defun play-sample (sample &optional (loops 0) (angle 0) (distance 0)) - "Angle is an integer between 0-360. Distance is an integer between 0-255." - (let ((channel (pal-ffi:play-channel -1 (pal-ffi:sample-chunk sample) loops))) - (pal-ffi:set-position channel angle distance) +(defun play-sample (sample &key (loops nil) (angle 0) (volume 255)) + "Angle is an integer between 0-360. Volume is an integer between 0-255." + (let ((channel (pal-ffi:play-channel -1 (pal-ffi:sample-chunk sample) (if (numberp loops) + loops + 0)))) + (pal-ffi:set-position channel angle (- 255 volume)) channel)) (defun set-sample-volume (sample volume) - "Volume 0-128." - (pal-ffi:volume-chunk (pal-ffi:sample-chunk sample) volume)) - + "Volume 0-255" + (pal-ffi:volume-chunk (pal-ffi:sample-chunk sample) (1+ (truncate volume 2)))) @@ -610,14 +611,16 @@ (defun load-music (file) (pal-ffi:load-music (data-path file))) -(defun play-music (music &optional (loops -1) (volume 128)) - "Volume 0-128, -1 for loops is repeat" - (pal-ffi:volume-music volume) - (pal-ffi:play-music (pal-ffi:music-music music) loops)) +(defun play-music (music &optional (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) + ((null loops) 0) + (t loops)))) (defun set-music-volume (volume) - "Volume 0-128" - (pal-ffi:volume-music volume)) + "Volume 0-255" + (pal-ffi:volume-music (1+ (truncate volume 2)))) (defun halt-music () (pal-ffi:halt-music))

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-serv18496 Modified Files: ffi.lisp package.lisp pal-macros.lisp pal.lisp todo.txt vector.lisp Log Message: Faster bitmap loading --- /project/pal/cvsroot/pal/ffi.lisp 2007/07/01 22:49:25 1.2 +++ /project/pal/cvsroot/pal/ffi.lisp 2007/07/03 18:10:33 1.3 @@ -846,4 +846,9 @@ #+win32 (defun get-application-folder () (cffi:with-foreign-object (path :char 4096) (shgetfolderpatha (cffi:null-pointer) #x001c (cffi:null-pointer) 0 path) - (concatenate 'string (cffi:foreign-string-to-lisp path) "/"))) \ No newline at end of file + (concatenate 'string (cffi:foreign-string-to-lisp path) "/"))) + +(cffi:defcfun "calloc" :pointer (nelem :uint) (elsize :uint)) +(cffi:defcfun "free" :void (ptr :pointer)) + + --- /project/pal/cvsroot/pal/package.lisp 2007/06/28 20:14:05 1.1 +++ /project/pal/cvsroot/pal/package.lisp 2007/07/03 18:10:33 1.2 @@ -7,6 +7,8 @@ #:make-font #:+gl-scissor-test+ #:+gl-points+ + #:free + #:calloc #:music-music #:register-resource #:sample-chunk @@ -349,7 +351,7 @@ (:export #:open-pal #:with-pal #:close-pal - #:get-info + #:get-gl-info #:load-foreign-libraries #:register-resource #:free-resource @@ -367,7 +369,6 @@ #:get-application-file #:data-path #:with-resource - #:with-blend #:with-clipping #:randomly @@ -385,9 +386,7 @@ #:get-mouse-x #:get-mouse-y - #:update-screen #:clear-screen - #:clear-depth-buffer #:get-screen-width #:get-screen-height #:set-cursor @@ -401,6 +400,7 @@ #:set-blend-mode #:reset-blend-mode #:set-blend-color + #:with-blend #:load-image #:image-width @@ -409,7 +409,7 @@ #:draw-rectangle #:draw-point #:draw-line - #:draw-arrow + #:draw-arrow #:draw-image #:draw-image-from #:draw-quad --- /project/pal/cvsroot/pal/pal-macros.lisp 2007/07/01 22:49:25 1.2 +++ /project/pal/cvsroot/pal/pal-macros.lisp 2007/07/03 18:10:33 1.3 @@ -176,4 +176,11 @@ (apply 'open-pal (list ,@args)) (unwind-protect (progn ,@body) - (close-pal)))) \ No newline at end of file + (close-pal)))) + + +(defmacro with-foreign-vector ((chunk n size) &body body) + `(let ((,chunk (pal-ffi:calloc ,n ,size))) + (unwind-protect + ,@body + (pal-ffi:free ,chunk)))) --- /project/pal/cvsroot/pal/pal.lisp 2007/07/01 22:49:25 1.2 +++ /project/pal/cvsroot/pal/pal.lisp 2007/07/03 18:10:33 1.3 @@ -147,7 +147,7 @@ result (error "Data file not found: ~a" file)))) -(defun get-info () +(defun get-gl-info () (format nil "Vendor: ~a~%Renderer: ~a~%Version: ~a~%Extensions: ~a~%" (pal-ffi:gl-get-string pal-ffi:+gl-vendor+) (pal-ffi:gl-get-string pal-ffi:+gl-renderer+) @@ -367,30 +367,27 @@ (> (expt 2 x) (1- height))) '(6 7 8 9 10)) 10))) - (id (cffi:foreign-alloc :uint :count 1)) - (tdata (cffi:foreign-alloc :uint32 :count (* texture-width texture-height) :initial-element 0)) - ;; (tdata (cffi:foreign-alloc :uint64 :count (/ (* texture-width texture-height) 2) :initial-element 0)) - ) - (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) - (cffi:foreign-free tdata) + (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) --- /project/pal/cvsroot/pal/todo.txt 2007/07/01 22:49:25 1.2 +++ /project/pal/cvsroot/pal/todo.txt 2007/07/03 18:10:33 1.3 @@ -19,7 +19,5 @@ - Fix with-blend (r g b a), see that things work on Allegro CL. -- Image loader need a faster way to allocate zeroed foreign vector. - - Make it run on OS X. --- /project/pal/cvsroot/pal/vector.lisp 2007/06/28 20:14:05 1.1 +++ /project/pal/cvsroot/pal/vector.lisp 2007/07/03 18:10:33 1.2 @@ -3,7 +3,8 @@ (in-package :pal) -(deftype component () 'single-float) +#+CL-HAS-FULL-NUMERIC-TOWER-DAMMIT (deftype component () 'number) +#-CL-HAS-FULL-NUMERIC-TOWER-DAMMIT (deftype component () 'single-float) (defstruct (vec (:conc-name v)) (x 0 :type component) (y 0 :type component))

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

pal-cvs