[cello-cvs] CVS cello/cl-openal
ktilton
ktilton at common-lisp.net
Wed May 17 20:38:14 UTC 2006
Update of /project/cello/cvsroot/cello/cl-openal
In directory clnet:/tmp/cvs-serv25061/cl-openal
Modified Files:
al.lisp alc.lisp alctypes.lisp altypes.lisp alut.lisp
cl-openal-demo.lisp cl-openal-init.lisp cl-openal.lisp
cl-openal.lpr wav-handling.lisp
Log Message:
Cello Rizing: cl-openal now CFFI via Hello-CFFI kluge
--- /project/cello/cvsroot/cello/cl-openal/al.lisp 2006/05/17 16:14:29 1.1
+++ /project/cello/cvsroot/cello/cl-openal/al.lisp 2006/05/17 20:38:14 1.2
@@ -45,7 +45,7 @@
(defun-ffx al-void "openal" "alGetIntegerv" ( al-enum param :void *data ))
(defun-ffx al-void "openal" "alGetFloatv" ( al-enum param :void *data ))
(defun-ffx al-void "openal" "alGetDoublev" ( al-enum param :void *data ))
-(defun-ffx :pointer "openal" "alGetString" ( al-enum param ))
+(defun-ffx (* :void) "openal" "alGetString" ( al-enum param ))
#|*
* Error support.
@@ -68,7 +68,7 @@
* Obtain the address of a function (usually an extension)
* with the name fname. All addresses are context-independent.
|#
-(defun-ffx :pointer "openal" "alGetProcAddress" ( :void *fname ))
+(defun-ffx (* :void) "openal" "alGetProcAddress" ( :void *fname ))
#|*
--- /project/cello/cvsroot/cello/cl-openal/alc.lisp 2006/05/17 16:14:29 1.1
+++ /project/cello/cvsroot/cello/cl-openal/alc.lisp 2006/05/17 20:38:14 1.2
@@ -8,14 +8,14 @@
;;;(defun-ffx ALCvoid "openal" "alcGetIntegerv" (ALCdevice *device ALCenum param ALCsizei size ALCint *data))
;;;
-(defun-ffx :pointer "openal" "alcOpenDevice" (:string device-name))
+(defun-ffx (* :void) "openal" "alcOpenDevice" (:string device-name))
(defun-ffx :void "openal" "alcCloseDevice" (:void *device))
-(defun-ffx :pointer "openal" "alcCreateContext" (:void *device alc-int *attr-list))
+(defun-ffx (* :void) "openal" "alcCreateContext" (:void *device alc-int *attr-list))
(defun-ffx alc-enum "openal" "alcMakeContextCurrent" (:void *context))
(defun-ffx :void "openal" "alcProcessContext" (:void *context))
-(defun-ffx :pointer "openal" "alcGetCurrentContext" ())
-(defun-ffx :pointer "openal" "alcGetContextsDevice" (:void *context))
+(defun-ffx (* :void) "openal" "alcGetCurrentContext" ())
+(defun-ffx (* :void) "openal" "alcGetContextsDevice" (:void *context))
(defun-ffx :void "openal" "alcSuspendContext" (:void *context))
(defun-ffx alc-enum "openal" "alcDestroyContext" (:void *context))
;;;
--- /project/cello/cvsroot/cello/cl-openal/alctypes.lisp 2006/05/17 16:14:29 1.1
+++ /project/cello/cvsroot/cello/cl-openal/alctypes.lisp 2006/05/17 20:38:14 1.2
@@ -20,9 +20,9 @@
* Or go to http://www.gnu.org/copyleft/lgpl.html
|#
-(dft alc-boolean :unsigned-char #+allegro character #-allegro number)
-(dft alc-byte :char #+allegro character #-allegro number)
-(dft alc-ubyte :unsigned-char #+allegro character #-allegro number)
+(dft alc-boolean ::unsigned-char #+allegro character #-allegro number)
+(dft alc-byte :unsigned-char #+allegro character #-allegro number)
+(dft alc-ubyte ::unsigned-char #+allegro character #-allegro number)
(dft alc-short #-allegro-v5.0.1 :short #+allegro-v5.0.1 :int integer)
(dft alc-ushort #-allegro-v5.0.1 :unsigned-int #+allegro-v5.0.1 :int integer)
(dft alc-uint #-allegro-v5.0.1 :unsigned-int #+allegro-v5.0.1 :int integer)
--- /project/cello/cvsroot/cello/cl-openal/altypes.lisp 2006/05/17 16:14:29 1.1
+++ /project/cello/cvsroot/cello/cl-openal/altypes.lisp 2006/05/17 20:38:14 1.2
@@ -35,12 +35,12 @@
(dft al-double :double double-float)
(dft al-clampd :double double-float)
-(dft al-boolean :unsigned-char #+allegro character #-allegro number)
-(dft al-byte :char #+allegro character #-allegro number) ;; typedef signed char GLbyte;
+(dft al-boolean ::unsigned-char #+allegro character #-allegro number)
+(dft al-byte :unsigned-char #+allegro character #-allegro number) ;; typedef signed char GLbyte;
(dft al-void :void integer)
(dft al-short #-allegro-v5.0.1 :short #+allegro-v5.0.1 :int integer)
-(dft al-ubyte :unsigned-char #+allegro character #-allegro number)
+(dft al-ubyte ::unsigned-char #+allegro character #-allegro number)
(dft al-sizei #-allegro-v5.0.1 :unsigned-int #+allegro-v5.0.1 :int integer)
--- /project/cello/cvsroot/cello/cl-openal/alut.lisp 2006/05/17 16:14:29 1.1
+++ /project/cello/cvsroot/cello/cl-openal/alut.lisp 2006/05/17 20:38:14 1.2
@@ -3,26 +3,17 @@
(defun-ffx :void "alut" "alutInit" (:void *argc :void *argv))
(defun-ffx :void "alut" "alutExit" ())
-#+nawww
-(defun-ffx :void "alut" "alutLoadWAVFile"
- (:void *file :void *format :void *data
- :void *size :void *freq :void *loop))
+;;;(defun-ffx :void "alut" "alutLoadWAVFile"
+;;; (:void *file :void *format :void *data
+;;; :void *size :void *freq :void *loop))
-(progn (defcfun ("alutloadwavfile" alut-load-wav-file) :void
- (*file :pointer) (*format :pointer) (*data :pointer) (*size :pointer) (*freq :pointer) (*loop :pointer))
-
- (eval-when (compile eval load) (export '( alut-load-wav-file))))
+(defun-ffx :void "alut" "alutLoadWAVFile"
+ (:string file :pointer *format :pointer *data
+ :pointer *size :pointer freq :pointer loop))
-#+nope
(defun-ffx :void "alut" "alutLoadWAVMemory"
(:void *memory :void *format :void *data :void *size
:void *freq :void *loop))
-(progn
- (defcfun ("alutloadwavmemory" alut-load-wav-memory) :void
- (*memory :pointer) (*format :pointer) (*data :pointer)
- (*size :pointer) (*freq :pointer) (*loop :pointer))
- (eval-when (compile eval load) (export '(alut-load-wav-memory))))
-
(defun-ffx :void "alut" "alutUnloadWAV"
(al-enum format :void *data al-sizei size al-sizei freq))
--- /project/cello/cvsroot/cello/cl-openal/cl-openal-demo.lisp 2006/05/17 16:14:29 1.1
+++ /project/cello/cvsroot/cello/cl-openal/cl-openal-demo.lisp 2006/05/17 20:38:14 1.2
@@ -4,17 +4,18 @@
(defparameter g-buffers (fgn-alloc 'al-uint num_buffers))
(defun cl-openal-test ()
- (let ((wave-names (list "/0dev/user/sounds/jshootme.wav" )))
+ (let ((w$ (list "/0dvx/user/sounds/jshootme.wav" )))
(cl-openal-init)
- (apply 'wav-play-till-end
- nil #+not (lambda (dur sources)
- (loop for source in sources
- for gain = (max 0 (- 1 (/ dur 3)))
- do (al-sourcef source al_gain gain)
- (al-chk "openal test GAIN set")))
- wave-names))
+ (apply 'wav-play-till-end
+ (lambda (dur sources)
+ (loop for source in sources
+ for gain = (max 0 (- 1 (/ dur 3)))
+ do (al-sourcef source al_gain gain)
+ (al-chk "openal test GAIN set")))
+ w$))
(sleep 1)
(cl-openal-shutdown))
+
--- /project/cello/cvsroot/cello/cl-openal/cl-openal-init.lisp 2006/05/17 16:14:29 1.1
+++ /project/cello/cvsroot/cello/cl-openal/cl-openal-init.lisp 2006/05/17 20:38:14 1.2
@@ -24,6 +24,7 @@
(in-package :cl-openal)
+
(defparameter *openal-initialized-p* nil)
(defun hex (dec)
@@ -35,6 +36,17 @@
(when *openal-initialized-p*
(return-from cl-openal-init t))
+ (xoa)
+
+ (assert (ffx:load-foreign-library (namestring *al-dynamic-lib*))
+ () "Failed to load OpenAL dynamic lib ~a" *al-dynamic-lib*)
+
+ (assert (ffx:load-foreign-library (namestring *alut-dynamic-lib*))
+ () "Failed to load alut dynamic lib ~a" *alut-dynamic-lib*)
+
+ (format t "~&Open AL loaded")
+
+ #+shakyatbest (print `(alut init ,(alut-init 0 0)))
(let ((device (loop for device-name in '("DirectSound3D" "DirectSound" "MMSYSTEM")
for alc-device = (alc-open-device device-name)
unless (null-pointer-p alc-device)
@@ -45,8 +57,7 @@
(format t "got openal device ~a" device)
- (let* ((nullargs (null-pointer))
- (context (alc-create-context device nullargs)))
+ (let* ((context (alc-create-context device 0)))
(when (null-pointer-p context)
(break "~&Failed to create Open AL context"))
(format t "~&created openal context ~a" context)
@@ -77,7 +88,7 @@
(let ((context (alc-get-current-context)))
(unless (null-pointer-p context)
(let ((device (alc-get-contexts-device context)))
- (alc-make-context-current (null-pointer))
+ (alc-make-context-current 0)
(alc-destroy-context context)
(alc-close-device device)
(setf *openal-initialized-p* nil))))))
@@ -86,6 +97,6 @@
(let ((status (al-get-error)))
(if (eql status al_no_error)
(progn
- (print (list "al-chk OK:" error$)))
+ #+shh (print (list "al-chk OK:" error$)))
(break "~&Error< ~d > on ~a" status error$))))
--- /project/cello/cvsroot/cello/cl-openal/cl-openal.lisp 2006/05/17 16:14:29 1.1
+++ /project/cello/cvsroot/cello/cl-openal/cl-openal.lisp 2006/05/17 20:38:14 1.2
@@ -41,22 +41,17 @@
(in-package :cl-openal)
-(defparameter *audio-files*
- (make-pathname
- :directory '(:absolute "cell-cultures" "user" "sounds")
- :type "wav"))
-
-(cffi:define-foreign-library OpenAL
- (:darwin (:framework "OpenAL"))
- (:windows (:or "C:\\Windows\\System32\\OpenAL32.dll")))
-
-(cffi:define-foreign-library ALut
- (:darwin (:framework "Alut"))
- (:windows (:or "C:\\0dev\\user\\dynlib\\alut.dll")))
-
-(eval-when (load eval)
- (cffi:use-foreign-library OpenAL)
- (cffi:use-foreign-library Alut))
-
+#+doit
+(xoa)
+#+allegro
+(defun xoa ()
+ (dolist (dll (ff:list-all-foreign-libraries))
+ (when (search "openal" (pathname-name dll))
+ (print `(unloading foreign library ,dll))
+ (ff:unload-foreign-library dll)))
+ (dolist (dll (ff:list-all-foreign-libraries))
+ (when (search "alut" (pathname-name dll))
+ (print `(unloading foreign library ,dll))
+ (ff:unload-foreign-library dll))))
--- /project/cello/cvsroot/cello/cl-openal/cl-openal.lpr 2006/05/17 16:14:29 1.1
+++ /project/cello/cvsroot/cello/cl-openal/cl-openal.lpr 2006/05/17 20:38:14 1.2
@@ -1,11 +1,12 @@
-;; -*- lisp-version: "8.0 [Windows] (May 5, 2006 15:39)"; cg: "1.81"; -*-
+;; -*- lisp-version: "8.0 [Windows] (May 11, 2006 6:29)"; cg: "1.81"; -*-
(in-package :cg-user)
(defpackage :CL-OPENAL)
(define-project :name :cl-openal
- :modules (list (make-instance 'module :name "cl-openal.lisp")
+ :modules (list (make-instance 'module :name "cl-openal-config.lisp")
+ (make-instance 'module :name "cl-openal.lisp")
(make-instance 'module :name "altypes.lisp")
(make-instance 'module :name "al.lisp")
(make-instance 'module :name "alctypes.lisp")
@@ -16,7 +17,7 @@
(make-instance 'module :name "wav-handling.lisp")
(make-instance 'module :name "cl-openal-demo.lisp"))
:projects (list (make-instance 'project-module :name
- "..\\hello-cffi\\hello-cffi"))
+ "C:\\0dev\\cello\\hello-cffi\\hello-cffi"))
:libraries nil
:distributed-files nil
:internally-loaded-files nil
--- /project/cello/cvsroot/cello/cl-openal/wav-handling.lisp 2006/05/17 16:14:29 1.1
+++ /project/cello/cvsroot/cello/cl-openal/wav-handling.lisp 2006/05/17 20:38:14 1.2
@@ -80,7 +80,7 @@
(defun wav-to-buffer (wav-path)
(when (cl-openal-init)
- (let ((buffer (fgn-alloc 'al-uint 1)) ;; was ':pointer 1)) ;; was 'aluint
+ (let ((buffer (fgn-alloc 'al-uint 1)) ;; was '(* :void) 1)) ;; was 'aluint
(format (fgn-alloc 'al-enum 1))
(datahandle (fgn-alloc :pointer 1)) ;; was 4
(size (fgn-alloc 'al-sizei 1))
@@ -91,25 +91,25 @@
(al-chk "wav-to-buffer al-gen-buffer")
(unwind-protect
- (let ((f$ (namestring wav-path)))
- (alut-load-wav-file f$ format datahandle size freq loop)
+ (progn
+ (alut-load-wav-file (namestring wav-path) format datahandle size freq loop)
(al-chk " wav-to-buffer alut-load-wav-File")
- #+shhhh (print (list "wav loaded!" f$
+ #+shhhh (print (list "wav loaded!" wav-path
:format (elti format 0)
:datahandle (fgn-pa datahandle 0)
:size (fgn-pa size 0)
:freq (fgn-pa freq 0)
: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)
+ (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))
- (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))
+ (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))
(al-chk "al-buffer-data")
(alut-unload-wav (elti format 0)(fgn-pa datahandle 0)
More information about the Cello-cvs
mailing list