[cello-cvs] CVS cello/cl-openal

[ktilton]

Update of /project/cello/cvsroot/cello/cl-openal
In directory clnet:/tmp/cvs-serv11178/cl-openal

Modified Files:
	cl-openal-init.lisp cl-openal.lisp cl-openal.lpr 
	wav-handling.lisp 
Log Message:


--- /project/cello/cvsroot/cello/cl-openal/cl-openal-init.lisp	2006/08/31 17:34:49	1.7
+++ /project/cello/cvsroot/cello/cl-openal/cl-openal-init.lisp	2006/11/13 05:29:28	1.8
@@ -26,9 +26,12 @@
 
 (defparameter *openal-initialized-p* nil)
 
-(defun cl-openal-init ()
+#+force
+(cl-openal-init t)
+
+(defun cl-openal-init (&optional force)
   ;;(return-from cl-openal-init nil)
-  (when *openal-initialized-p*
+  (when (and *openal-initialized-p* (not force))
     (return-from cl-openal-init t))
 
 #-macosx (xoa)
@@ -63,7 +66,7 @@
   (format t "~&clear AL error code ~a"
     (al-get-error))
 
-  (let ((l-zip (make-ff-array al-float 10 0 0))
+  (let ((l-zip (make-ff-array al-float 0 0 10))
         (l-ori (make-ff-array al-float 0 0 -1 0 1 0)))
     
     (al-listenerfv al_position l-zip)
--- /project/cello/cvsroot/cello/cl-openal/cl-openal.lisp	2006/08/24 07:55:07	1.4
+++ /project/cello/cvsroot/cello/cl-openal/cl-openal.lisp	2006/11/13 05:29:28	1.5
@@ -22,13 +22,13 @@
 ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS 
 ;;; IN THE SOFTWARE.
 
-;;; $Id: cl-openal.lisp,v 1.4 2006/08/24 07:55:07 fgoenninger Exp $
+;;; $Id: cl-openal.lisp,v 1.5 2006/11/13 05:29:28 ktilton Exp $
 
 (pushnew :cl-openal *features*)
 
 (defpackage #:cl-openal
   (:nicknames #:oal)
-  (:use #:common-lisp #:cffi #:cffi-extender)
+  (:use #:common-lisp #:cffi #:cffi-extender #:utils-kt)
   (:export
    #:xoa
    #:al-chk
--- /project/cello/cvsroot/cello/cl-openal/cl-openal.lpr	2006/11/03 13:38:25	1.10
+++ /project/cello/cvsroot/cello/cl-openal/cl-openal.lpr	2006/11/13 05:29:28	1.11
@@ -1,4 +1,4 @@
-;; -*- lisp-version: "8.0 [Windows] (Oct 17, 2006 12:56)"; cg: "1.81"; -*-
+;; -*- lisp-version: "8.0 [Windows] (Nov 6, 2006 16:43)"; cg: "1.81"; -*-
 
 (in-package :cg-user)
 
--- /project/cello/cvsroot/cello/cl-openal/wav-handling.lisp	2006/05/27 06:01:38	1.3
+++ /project/cello/cvsroot/cello/cl-openal/wav-handling.lisp	2006/11/13 05:29:28	1.4
@@ -77,12 +77,56 @@
                    wav-path
                    *audio-files*)))
     (assert (probe-file wav-path)() "WAV ~a not found" wav-path)
-    (let ((buffer (wav-to-buffer wav-path)))
+    (bwhen (buffer (wav-to-buffer wav-path)) ;; not if OAL does not like the wav file
       (source-buffer-load source buffer)
       (al-source-play source)
       (al-chk "al-Source-Play")
       source)))
 
+#+test
+(go-round)
+
+(defun go-round ()
+  (loop ;;for wav in (directory (make-pathname :directory '(:absolute  "sounds")))
+    with wav = (make-pathname :directory '(:absolute "0dev" "user"  "sounds") :name "galloping" :type "wav")
+    with start = (get-internal-real-time)
+    repeat 4
+    do (wav-play-till-end 
+        (lambda (time srcs)
+          (declare (ignore time srcs))
+          (let* ((elapsed (coerce (/ (- (get-internal-real-time) start) internal-time-units-per-second) 'float))
+                 (angle (* elapsed (/ pi 2)))
+                 (dist 5)
+                 (x (* dist (cos angle)))
+                 (z (* dist (sin angle)))
+                 )
+            
+            ;(cells:trc "time" elapsed srcs)
+            (let ((l-zip (make-ff-array al-float x 0 z ))
+                  (l-vel (make-ff-array al-float 1 0 0))
+                  (l-ori (make-ff-array al-float 0 0 -1 0 1 0)))
+              (declare (ignore l-vel))
+              ;(al-listenerfv al_position l-zip)
+              (al-listenerfv al_position l-zip)
+              (al-chk "alListenerfv POSITION : ")
+              
+              #+noo
+              (progn
+                (al-listenerfv al_velocity l-zip)
+                (al-chk "alListenerfv VELOCITY : "))
+              
+              ;(al-listenerfv al_orientation l-ori)
+              ;(al-chk "alListenerfv ORIENTATION : ")
+              (fgn-free l-zip l-ori))))
+        wav)
+    finally (cells:trc "time" (coerce (/ (- (get-internal-real-time) start) internal-time-units-per-second) 'float))))
+
+#+test
+(source-wav-play-start (car (al-source-gen 1) )
+  (make-pathname :directory '(:absolute "0dev" "user" "sounds")
+          :name "galloping"
+          :type "wav"))
+
 (defun wav-to-buffer (wav-path)
   (when (cl-openal-init)
     (let ((buffer (fgn-alloc 'al-uint 1)) ;; was '(* :void) 1)) ;; was 'aluint
@@ -108,10 +152,10 @@
                              :loop (fgn-pa loop 0)))
             
              (when (null-pointer-p (fgn-pa datahandle 0)) ;; 04-11-14 was elti, bad for OpenMCL
-               (break "null-pointer-p datahandle ~a" datahandle) 
-              (return-from wav-to-buffer nil))
+               (format t "~&Cannot handle WAV ~a null-pointer-p datahandle ~a" (namestring wav-path) datahandle (fgn-pa datahandle 0))
+               (return-from wav-to-buffer nil))
             
-             (print (list :buffering-data (elti buffer 0) (elti format 0) (fgn-pa datahandle 0)
+             #+shh (print (list :buffering-data (elti buffer 0) (elti format 0) (fgn-pa datahandle 0)
                           (elti size 0)(elti freq 0)))
              (al-buffer-data (elti buffer 0) (elti format 0) (fgn-pa datahandle 0)
                              (elti size 0)(elti freq 0))
@@ -120,7 +164,7 @@
             (alut-unload-wav (elti format 0)(fgn-pa datahandle 0)
               (elti size 0)(elti freq 0))
             (al-chk "alut-unload-wav")
-            (format t "~&buffer is ~a" (elti buffer 0))
+            ;;(format t "~&buffer is ~a" (elti buffer 0))
             (elti buffer 0))
         (fgn-free buffer)
         (fgn-free format)