From tneste at common-lisp.net Fri Sep 7 07:55:16 2007 From: tneste at common-lisp.net (tneste) Date: Fri, 7 Sep 2007 03:55:16 -0400 (EDT) Subject: [pal-cvs] CVS pal/examples Message-ID: <20070907075516.0B40D3C048@common-lisp.net> Update of /project/pal/cvsroot/pal/examples In directory clnet:/tmp/cvs-serv13419/examples Modified Files: images.lisp teddy.lisp Log Message: Added fading arguments to play-music/halt-music. --- /project/pal/cvsroot/pal/examples/images.lisp 2007/07/29 19:11:44 1.7 +++ /project/pal/cvsroot/pal/examples/images.lisp 2007/09/07 07:55:15 1.8 @@ -4,7 +4,7 @@ (define-tags - ;; IMAGE-FROM-FN builds and image by calling the FN with x and y coordinates. + ;; IMAGE-FROM-FN builds an image by calling the FN with x and y coordinates. ;; FN should return at least three VALUES for r, g and b and an optional fourth value for alpha. image-1 (image-from-fn 255 255 nil (lambda (x y) @@ -12,7 +12,7 @@ (truncate (+ 127 (* 128 (cos (/ y 10))))) (truncate (+ 127 (* 128 (cos (/ (+ x y) 10))))) (truncate (+ 127 (* 128 (cos (/ (- x y) 10)))))))) - ;; IMAGE-FROM-ARRAY builds and image from an 2d array of (list r g b &optional a) + ;; IMAGE-FROM-ARRAY builds an image from a 2d array of (list r g b &optional a) ;; Try setting the SMOOTHP parameter to T and see what happens. 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)) @@ -55,7 +55,9 @@ :angle (incf a .1))) - ;; Press left mousebutton to capture part of the screen as a new cursor + ;; Press left mousebutton to capture part of the screen as a new cursor. + ;; Note that altough the allocated images are released when PAL is closed we really should manually release + ;; the old cursor image with FREE-RESOURCE if we keep allocating lots of new images. (when (key-pressed-p :key-mouse-1) (set-cursor (image-from-array nil --- /project/pal/cvsroot/pal/examples/teddy.lisp 2007/08/30 09:02:23 1.9 +++ /project/pal/cvsroot/pal/examples/teddy.lisp 2007/09/07 07:55:15 1.10 @@ -92,7 +92,7 @@ ;; Other possible options to cursor are: t - show the default cursor, nil - hide all cursors (set-cursor (tag 'cursor) (v 18 18)) - (play-music (tag 'music)) + (play-music (tag 'music) :fade 10000) (play-sample (tag 'engine) :loops t :volume 50) (make-instance 'plane :alt 20) @@ -137,6 +137,7 @@ ;; TEST-KEYS is used to check if some key is currently pressed, _all_ the matching forms are evaluated. (test-keys + (:key-f (halt-music 10000)) (:key-1 (setf *blend-mode* nil) (message *blend-mode*)) (:key-2 (setf *blend-mode* :blend) From tneste at common-lisp.net Fri Sep 7 07:55:16 2007 From: tneste at common-lisp.net (tneste) Date: Fri, 7 Sep 2007 03:55:16 -0400 (EDT) Subject: [pal-cvs] CVS pal Message-ID: <20070907075516.529FA3C076@common-lisp.net> Update of /project/pal/cvsroot/pal In directory clnet:/tmp/cvs-serv13419 Modified Files: ffi.lisp package.lisp pal.lisp todo.txt Log Message: Added fading arguments to play-music/halt-music. --- /project/pal/cvsroot/pal/ffi.lisp 2007/08/30 21:11:23 1.19 +++ /project/pal/cvsroot/pal/ffi.lisp 2007/09/07 07:55:16 1.20 @@ -639,9 +639,15 @@ (cffi:defcfun ("Mix_HaltMusic" halt-music) :int) +(cffi:defcfun ("Mix_FadeOutMusic" fade-out-music) :int + (fade :int)) + (cffi:defcfun ("Mix_LoadMUS" load-music) :pointer (file :string)) +(cffi:defcfun ("Mix_FadeInMusic" fade-in-music) :int + (music :pointer) (loops :int) (fade :int)) + (cffi:defcfun ("Mix_PlayMusic" play-music) :int (music :pointer) (loops :int)) --- /project/pal/cvsroot/pal/package.lisp 2007/08/30 09:22:19 1.16 +++ /project/pal/cvsroot/pal/package.lisp 2007/09/07 07:55:16 1.17 @@ -4,6 +4,8 @@ (:use :common-lisp) (:export #:+NO-EVENT+ #:+gl-line-smooth+ + #:fade-out-music + #:fade-in-music #:make-font #:+gl-pack-alignment+ #:gl-flush --- /project/pal/cvsroot/pal/pal.lisp 2007/08/30 21:11:23 1.29 +++ /project/pal/cvsroot/pal/pal.lisp 2007/09/07 07:55:16 1.30 @@ -56,7 +56,7 @@ (when *pal-running* (close-pal)) (pal-ffi:init (logior pal-ffi:+init-video+ pal-ffi:+init-audio+)) - (pal-ffi:open-audio 22050 pal-ffi:+audio-s16+ 0 2048) + (pal-ffi:open-audio 22050 pal-ffi:+audio-s16+ 0 1024) (pal-ffi:gl-set-attribute pal-ffi:+gl-depth-size+ 0) (pal-ffi:gl-set-attribute pal-ffi:+gl-doublebuffer+ 1) (let ((surface (pal-ffi::set-video-mode @@ -762,19 +762,26 @@ (let ((music (pal-ffi::make-music :music music))) (pal-ffi:register-resource music)))) -(defun play-music (music &key (loops t) (volume 255)) +(defun play-music (music &key (loops t) (volume 255) (fade 0)) "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 (truncate loops))))) + (if (> fade 0) + (pal-ffi:fade-in-music (pal-ffi:music-music music) (cond ((eq loops t) -1) + ((null loops) 0) + (t (truncate loops))) + fade) + (pal-ffi:play-music (pal-ffi:music-music music) (cond ((eq loops t) -1) + ((null loops) 0) + (t (truncate loops)))))) (defun set-music-volume (volume) "Volume 0-255" (pal-ffi:volume-music (1+ (truncate volume 2)))) -(defun halt-music () - (pal-ffi:halt-music)) +(defun halt-music (&optional fade) + (if fade + (pal-ffi:fade-out-music fade) + (pal-ffi:halt-music))) --- /project/pal/cvsroot/pal/todo.txt 2007/08/30 09:02:24 1.17 +++ /project/pal/cvsroot/pal/todo.txt 2007/09/07 07:55:16 1.18 @@ -4,9 +4,6 @@ - Implement image mirroring, tiles and animation. -- Add more complex sound/music handling functions, channel set volume/dir, - fade/etc. music. - - Box/box/line/circle etc. overlap functions, faster v-dist. - Correct aspect ratio when fullscreen on widescreen displays.