May 2006 - cello-cvs@common-lisp.net - mailman3.common-lisp.net

[cello-cvs] CVS cello
by ktilton 27 May '06

27 May '06

Update of /project/cello/cvsroot/cello In directory clnet:/tmp/cvs-serv8567 Modified Files: cello.lisp cello.lpr window.lisp Log Message: Cello Rizing. cl-opengl becomes kt-opengl, hello-cffi becomes cffi-extender, end lots more to come --- /project/cello/cvsroot/cello/cello.lisp 2006/05/17 16:14:27 1.2 +++ /project/cello/cvsroot/cello/cello.lisp 2006/05/26 22:08:55 1.3 @@ -34,6 +34,7 @@ #:cl-openal #:cl-ftgl #:cl-magick - #:celtk)) + #:celtk) + (:shadowing-import-from #:celtk #:window)) (in-package :cello) --- /project/cello/cvsroot/cello/cello.lpr 2006/05/17 16:14:27 1.2 +++ /project/cello/cvsroot/cello/cello.lpr 2006/05/26 22:08:55 1.3 @@ -1,4 +1,4 @@ -;; -*- 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) @@ -6,7 +6,6 @@ (define-project :name :cello :modules (list (make-instance 'module :name "cello.lisp") - (make-instance 'module :name "datetime.lisp") (make-instance 'module :name "window-macros.lisp") (make-instance 'module :name "clipping.lisp") (make-instance 'module :name "mg-geometry.lisp") @@ -48,22 +47,22 @@ (make-instance 'module :name "cello-magick.lisp") (make-instance 'module :name "cello-openal.lisp")) :projects (list (make-instance 'project-module :name - "c:\\0dev\\cells\\cells") - (make-instance 'project-module :name "..\\Celtk\\CELTK") (make-instance 'project-module :name - "c:\\0dev\\cl-opengl\\cl-opengl") + "hello-cffi\\hello-cffi") + (make-instance 'project-module :name + "cl-opengl\\cl-opengl") (make-instance 'project-module :name - "..\\cl-ftgl\\cl-ftgl") + "cl-magick\\cl-magick") (make-instance 'project-module :name - "c:\\0dev\\cl-magick\\cl-magick") + "cl-ftgl\\cl-ftgl") (make-instance 'project-module :name - "..\\cl-openal\\cl-openal")) + "cl-openal\\cl-openal")) :libraries nil :distributed-files nil :internally-loaded-files nil :project-package-name :cello - :main-form 'cello::form3 + :main-form nil :compilation-unit t :verbose nil :runtime-modules nil --- /project/cello/cvsroot/cello/window.lisp 2006/05/17 16:14:28 1.2 +++ /project/cello/cvsroot/cello/window.lisp 2006/05/26 22:08:55 1.3 @@ -26,7 +26,7 @@ ; -(defmodel window (celtk:window focuser ix-lit-scene control ogl-shared-resource-tender) +(defmodel cello-window (celtk:window focuser ix-lit-scene control ogl-shared-resource-tender) ( (redisplayp :cell nil :initarg :redisplayp :initform nil :accessor redisplayp) (self-sizing :cell nil :initarg :self-sizing :initform nil :accessor self-sizing)

1 0

[cello-cvs] CVS cello/cl-ftgl
by ktilton 17 May '06

17 May '06

Update of /project/cello/cvsroot/cello/cl-ftgl In directory clnet:/tmp/cvs-serv25061/cl-ftgl Modified Files: cl-ftgl.lpr Log Message: Cello Rizing: cl-openal now CFFI via Hello-CFFI kluge --- /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lpr 2006/05/17 18:52:20 1.2 +++ /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lpr 2006/05/17 20:38:13 1.3 @@ -6,7 +6,8 @@ (define-project :name :cl-ftgl :modules (list (make-instance 'module :name "cl-ftgl.lisp")) - :projects nil + :projects (list (make-instance 'project-module :name + "C:\\0devtools\\cffi\\cffi")) :libraries nil :distributed-files nil :internally-loaded-files nil

1 0

[cello-cvs] CVS cello/cl-openal
by ktilton 17 May '06

17 May '06

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)

1 0

[cello-cvs] CVS cello/hello-cffi
by ktilton 17 May '06

17 May '06

Update of /project/cello/cvsroot/cello/hello-cffi In directory clnet:/tmp/cvs-serv10478/hello-cffi Added Files: arrays.lisp callbacks.lisp definers.lisp ffi-extender.lisp hello-cffi.asd hello-cffi.lpr my-uffi-compat.lisp Log Message: --- /project/cello/cvsroot/cello/hello-cffi/arrays.lisp 2006/05/17 18:52:21 NONE +++ /project/cello/cvsroot/cello/hello-cffi/arrays.lisp 2006/05/17 18:52:21 1.1 ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: hello-c; -*- ;;; ;;; Copyright © 1995,2003 by Kenneth William Tilton. ;;; ;;; Permission is hereby granted, free of charge, to any person obtaining a copy ;;; of this software and associated documentation files (the "Software"), to deal ;;; in the Software without restriction, including without limitation the rights ;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell ;;; copies of the Software, and to permit persons to whom the Software is furnished ;;; to do so, subject to the following conditions: ;;; ;;; The above copyright notice and this permission notice shall be included in ;;; all copies or substantial portions of the Software. ;;; ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR ;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, ;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE ;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER ;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. (in-package :ffx) (defparameter *gl-rsrc* nil) (defparameter *fgn-mem* nil) (defun fgn-dump () (print (length *fgn-mem*)) (loop for fgn in *fgn-mem* do (print fgn) summing (fgn-amt fgn))) #+check (fgn-dump) (defun ffx-reset (&optional force) (hic-reset force)) (defun hic-reset (&optional force) (if force (progn (loop for fgn in *fgn-mem* do (print fgn) (foreign-free (fgn-ptr fgn)) finally (setf *fgn-mem* nil)) (loop for fgn in *gl-rsrc* do (print fgn) (glfree (fgn-type fgn)(fgn-ptr fgn)) finally (setf *gl-rsrc* nil)) (progn (when *fgn-mem* (loop for fgn in *fgn-mem* do (print fgn) finally (break "above fgn-mem not freed"))) (when *gl-rsrc* (loop for fgn in *gl-rsrc* do (print fgn) finally (break "above *gl-rsrc* not freed"))))))) (defstruct fgn ptr id type amt) (defmethod print-object ((fgn fgn) s) (format s "fgnmem ~a :amt ~a :type ~a" (fgn-id fgn)(fgn-amt fgn)(fgn-type fgn))) (defmacro fgn-alloc (type amt-form &rest keys) (let ((amt (gensym)) (ptr (gensym))) `(let* ((,amt ,amt-form) (,ptr (falloc ,type ,amt))) (call-fgn-alloc ,type ,amt ,ptr (list ,@keys))))) (defun call-fgn-alloc (type amt ptr keys) ;;(print `(call-fgn-alloc ,type ,amt ,keys)) (fgn-ptr (car (push (make-fgn :id keys :type type :amt amt :ptr ptr) *fgn-mem*)))) (defun fgn-free (&rest fgn-ptrs) ;; (print `(fgn-free freeing ,@fgn-ptrs)) (let ((start (copy-list fgn-ptrs))) (loop for fgn-ptr in start do (let ((fgn (find fgn-ptr *fgn-mem* :key 'fgn-ptr))) (if fgn (setf *fgn-mem* (delete fgn *fgn-mem*)) (format t "~&Freeing unknown FGN ~a" fgn-ptr)) (foreign-free fgn-ptr))))) (defun gllog (type resource amt &rest keys) (push (make-fgn :id keys :type type :amt amt :ptr resource) *gl-rsrc*)) (defun glfree (type resource) (let ((fgn (find (cons type resource) *gl-rsrc* :test 'equal :key (lambda (g) (cons (fgn-type g)(fgn-ptr g)))))) (if fgn (setf *gl-rsrc* (delete fgn *gl-rsrc*)) (format t "~&Freeing unknown GL resource ~a" (cons type resource))) #+nonono (ecase type (:texture (ogl:ogl-texture-delete resource))))) (defmacro make-ff-array (type &rest values) (let ((fv (gensym))(n (gensym))(vs (gensym))) `(let ((,fv (fgn-alloc ',type ,(length values) :make-ff-array)) (,vs (list ,@values))) (dotimes (,n ,(length values) ,fv) (setf (ff-elt ,fv ,type ,n) (coerce (nth ,n ,vs) ',(if (keywordp type) (intern (symbol-name type)) (get type 'ffi-cast)))))))) (defmacro ff-list (array type count) (let ((a (gensym))(n (gensym))) `(loop with ,a = ,array for ,n below ,count collecting (ff-elt ,a ,type ,n)))) (defun make-floatv (&rest floats) (let* ((co (fgn-alloc :float (length floats) :make-floatv)) ) (apply 'ff-floatv-setf co floats))) (defmacro ff-floatv-ensure (place &rest values) `(if ,place (ff-floatv-setf ,place ,@values) (setf ,place (make-floatv ,@values)))) (defun ff-floatv-setf (array &rest floats) (loop for f in floats and n upfrom 0 do (setf (mem-aref array :float n) (* 1.0 f))) array) ;--------- with-ff-array-elements ------------------------------------------ (defmacro with-ff-array-elements ((fa type &rest refs) &body body) `(let ,(let ((refn -1)) (mapcar (lambda (ref) `(,ref (mem-aref ,fa ,type) ,(incf refn))) refs)) ,@body)) ;-------- ff-elt --------------------------------------- (defmacro ff-elt-p (v n) `(mem-aref ,v :pointer ,n)) (defmacro ff-elt (v type n) `(mem-aref ,v ',type ,n)) (defun elti (v n) (ff-elt v :int n)) (defun (setf elti) (value v n) (setf (ff-elt v :int n) (coerce value 'integer))) (defun eltf (v n) (ff-elt v :float n)) (defun (setf eltf) (value v n) (setf (ff-elt v :float n) (coerce value 'float))) (defun elt$ (v n) (ff-elt v :string n)) (defun (setf elt$) (value v n) (setf (ff-elt v :string n) value)) (defun eltd (v n) (ff-elt v :double n)) (defun (setf eltd) (value v n) (setf (ff-elt v :double n) (coerce value 'double-float))) (defmacro fgn-pa (pa n) `(mem-aref ,pa :pointer ,n)) (eval-when (compile load eval) (export '(ffx-reset ff-elt ff-list eltf eltd elti fgn-pa with-ff-array-elements make-ff-array make-floatv ff-floatv-ensure hic-reset fgn-alloc fgn-free gllog glfree)))--- /project/cello/cvsroot/cello/hello-cffi/callbacks.lisp 2006/05/17 18:52:21 NONE +++ /project/cello/cvsroot/cello/hello-cffi/callbacks.lisp 2006/05/17 18:52:21 1.1 ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: hello-c; -*- ;;; ;;; Copyright © 1995,2003 by Kenneth William Tilton. ;;; ;;; Permission is hereby granted, free of charge, to any person obtaining a copy ;;; of this software and associated documentation files (the "Software"), to deal ;;; in the Software without restriction, including without limitation the rights ;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell ;;; copies of the Software, and to permit persons to whom the Software is furnished ;;; to do so, subject to the following conditions: ;;; ;;; The above copyright notice and this permission notice shall be included in ;;; all copies or substantial portions of the Software. ;;; ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR ;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, ;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE ;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER ;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. (in-package :ffx) #+precffi (defun ff-register-callable (callback-name) #+allegro (ff:register-foreign-callable callback-name) #+lispworks (let ((cb (progn ;; fli:pointer-address (fli:make-pointer :symbol-name (symbol-name callback-name) ;; leak? :functionp t)))) (print (list :ff-register-callable-returns cb)) cb)) (defun ff-register-callable (callback-name) (let ((known-callback (cffi:get-callback callback-name))) (assert known-callback) known-callback)) (defmacro ff-defun-callable (call-convention result-type name args &body body) (declare (ignorable call-convention)) `(defcallback ,name ,result-type ,args ,@body)) #+precffi (defmacro ff-defun-callable (call-convention result-type name args &body body) (declare (ignorable call-convention result-type)) (let ((native-args (when args ;; without this p-f-a returns '(:void) as if for declare (process-function-args args)))) #+lispworks `(fli:define-foreign-callable (,(symbol-name name) :result-type ,result-type :calling-convention ,call-convention) (,@native-args) ,@body) #+allegro `(ff:defun-foreign-callable ,name ,native-args (declare (:convention ,(ecase call-convention (:cdecl :c) (:stdcall :stdcall)))) ,@body))) #+(or) (ff-defun-callable :cdecl :int square ((arg-1 :int)(data :pointer)) (list data (* arg-1 arg-1))) (eval-when (compile load eval) (export '(ff-register-callable ff-defun-callable ff-pointer-address)))--- /project/cello/cvsroot/cello/hello-cffi/definers.lisp 2006/05/17 18:52:21 NONE +++ /project/cello/cvsroot/cello/hello-cffi/definers.lisp 2006/05/17 18:52:21 1.1 ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: hello-c; -*- ;;; ;;; Copyright © 1995,2003 by Kenneth William Tilton. ;;; ;;; Permission is hereby granted, free of charge, to any person obtaining a copy ;;; of this software and associated documentation files (the "Software"), to deal ;;; in the Software without restriction, including without limitation the rights ;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell ;;; copies of the Software, and to permit persons to whom the Software is furnished ;;; to do so, subject to the following conditions: ;;; ;;; The above copyright notice and this permission notice shall be included in ;;; all copies or substantial portions of the Software. ;;; ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR ;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, ;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE ;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER ;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. ;; $Header: /project/cello/cvsroot/cello/hello-cffi/definers.lisp,v 1.1 2006/05/17 18:52:20 ktilton Exp $ (in-package :ffx) (eval-when (compile load eval) (export '( defun-ffx defun-ffx-multi dffr dfc dft dfenum make-ff-pointer ff-pointer-address ))) (defun ff-pointer-address (ff-ptr) #-lispworks ff-ptr #+lispworks (fli:pointer-address ff-ptr)) ;;;(defun make-ff-pointer (n) ;;; #-lispworks ;;; n ;;; #+lispworks ;;; (fli:make-pointer :address n :pointer-type '(:pointer :void))) (defun make-ff-pointer (n) #+lispworks (fli:make-pointer :address n :pointer-type '(:pointer :void)) #+clisp (ffi:unsigned-foreign-address n) #-(or clisp lispworks) n ) (defmacro defun-ffx (rtn module$ name$ (&rest type-args) &body post-processing) (declare (ignore module$)) (let* ((lisp-fn (lisp-fn name$)) (lispfn (intern (string-upcase name$))) (var-types (let (args) (assert (evenp (length type-args)) () "uneven arg-list for ~a" name$) (dotimes (n (floor (length type-args) 2) (nreverse args)) (let ((type (elt type-args (* 2 n))) (var (elt type-args (1+ (* 2 n))))) (when (eql #\* (elt (symbol-name var) 0)) ;; no, good with *: (setf var (intern (subseq (symbol-name var) 1))) (setf type :pointer)) (push (list var type) args))))) (cast-vars (mapcar (lambda (var-type) (copy-symbol (car var-type))) var-types))) `(progn (cffi:defcfun (,name$ ,lispfn) ,(if (and (consp rtn) (eq '* (car rtn))) :pointer rtn) ,@var-types) (defun ,lisp-fn ,(mapcar #'car var-types) (let ,(mapcar (lambda (cast-var var-type) `(,cast-var ,(if (listp (cadr var-type)) (car var-type) (case (cadr var-type) (:int `(coerce ,(car var-type) 'integer)) (:long `(coerce ,(car var-type) 'integer)) (:unsigned-long `(coerce ,(car var-type) 'integer)) (:unsigned-int `(coerce ,(car var-type) 'integer)) (:float `(coerce ,(car var-type) 'float)) (:double `(coerce ,(car var-type) 'double-float)) (:string (car var-type)) (:pointer (car var-type)) (otherwise (let ((ffc (get (cadr var-type) 'ffi-cast))) (assert ffc () "Don't know how to cast ~a" (cadr var-type)) `(coerce ,(car var-type) ',ffc))))))) cast-vars var-types) (prog1 (,lispfn ,@cast-vars) ,@post-processing))) (eval-when (compile eval load) (export '(,lispfn ,lisp-fn)))))) #+precffi (defmacro defun-ffx (rtn module$ name$ (&rest type-args) &body post-processing) (let* ((lisp-fn (lisp-fn name$)) (lispfn (intern (string-upcase name$))) (var-types (let (args) (assert (evenp (length type-args)) () "uneven arg-list for ~a" name$) (dotimes (n (floor (length type-args) 2) (nreverse args)) (let ((type (elt type-args (* 2 n))) (var (elt type-args (1+ (* 2 n))))) (when (eql #\* (elt (symbol-name var) 0)) ;; no, good with *: (setf var (intern (subseq (symbol-name var) 1))) (setf type `(* ,type))) (push (list var type) args))))) (cast-vars (mapcar (lambda (var-type) (copy-symbol (car var-type))) var-types))) `(progn (def-function (,name$ ,lispfn) ,var-types :returning ,rtn :module ,module$) (defun ,lisp-fn ,(mapcar #'car var-types) (let ,(mapcar (lambda (cast-var var-type) `(,cast-var ,(if (listp (cadr var-type)) (car var-type) (case (cadr var-type) (:int `(coerce ,(car var-type) 'integer)) (:long `(coerce ,(car var-type) 'integer)) (:unsigned-long `(coerce ,(car var-type) 'integer)) (:unsigned-int `(coerce ,(car var-type) 'integer)) (:float `(coerce ,(car var-type) 'float)) (:double `(coerce ,(car var-type) 'double-float)) [59 lines skipped] --- /project/cello/cvsroot/cello/hello-cffi/ffi-extender.lisp 2006/05/17 18:52:21 NONE +++ /project/cello/cvsroot/cello/hello-cffi/ffi-extender.lisp 2006/05/17 18:52:21 1.1 [110 lines skipped] --- /project/cello/cvsroot/cello/hello-cffi/hello-cffi.asd 2006/05/17 18:52:21 NONE +++ /project/cello/cvsroot/cello/hello-cffi/hello-cffi.asd 2006/05/17 18:52:21 1.1 [134 lines skipped] --- /project/cello/cvsroot/cello/hello-cffi/hello-cffi.lpr 2006/05/17 18:52:21 NONE +++ /project/cello/cvsroot/cello/hello-cffi/hello-cffi.lpr 2006/05/17 18:52:21 1.1 [171 lines skipped] --- /project/cello/cvsroot/cello/hello-cffi/my-uffi-compat.lisp 2006/05/17 18:52:21 NONE +++ /project/cello/cvsroot/cello/hello-cffi/my-uffi-compat.lisp 2006/05/17 18:52:21 1.1 [187 lines skipped]

1 0

[cello-cvs] CVS cello/cl-ftgl
by ktilton 17 May '06

17 May '06

Update of /project/cello/cvsroot/cello/cl-ftgl In directory clnet:/tmp/cvs-serv10478/cl-ftgl Modified Files: cl-ftgl.lpr Log Message: --- /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lpr 2006/05/17 16:14:29 1.1 +++ /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lpr 2006/05/17 18:52:20 1.2 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "8.0 [Windows] (Apr 21, 2006 10:24)"; cg: "1.81"; -*- +;; -*- lisp-version: "8.0 [Windows] (May 11, 2006 6:29)"; cg: "1.81"; -*- (in-package :cg-user) @@ -6,8 +6,7 @@ (define-project :name :cl-ftgl :modules (list (make-instance 'module :name "cl-ftgl.lisp")) - :projects (list (make-instance 'project-module :name - "C:\\0devtools\\cl-opengl\\cl-opengl")) + :projects nil :libraries nil :distributed-files nil :internally-loaded-files nil

1 0

[cello-cvs] CVS cello/cl-opengl
by ktilton 17 May '06

17 May '06

Update of /project/cello/cvsroot/cello/cl-opengl In directory clnet:/tmp/cvs-serv10478/cl-opengl Modified Files: cl-opengl.lpr Log Message: --- /project/cello/cvsroot/cello/cl-opengl/cl-opengl.lpr 2006/05/17 16:14:31 1.1 +++ /project/cello/cvsroot/cello/cl-opengl/cl-opengl.lpr 2006/05/17 18:52:20 1.2 @@ -13,8 +13,6 @@ (make-instance 'module :name "ogl-macros.lisp") (make-instance 'module :name "ogl-utils.lisp")) :projects (list (make-instance 'project-module :name - "..\\cells\\utils-kt\\utils-kt") - (make-instance 'project-module :name "..\\hello-cffi\\hello-cffi")) :libraries nil :distributed-files nil

1 0

[cello-cvs] CVS cello/hello-cffi
by ktilton 17 May '06

17 May '06

Update of /project/cello/cvsroot/cello/hello-cffi In directory clnet:/tmp/cvs-serv10421/hello-cffi Log Message: Directory /project/cello/cvsroot/cello/hello-cffi added to the repository

1 0

[cello-cvs] CVS cello/cl-opengl
by ktilton 17 May '06

17 May '06

Update of /project/cello/cvsroot/cello/cl-opengl In directory clnet:/tmp/cvs-serv22618/cl-opengl Added Files: build-prep.lisp cl-opengl.asd cl-opengl.lisp cl-opengl.lpr gl-constants.lisp gl-def.lisp gl-functions.lisp glu-functions.lisp ogl-macros.lisp ogl-utils.lisp Log Message: CVS re-organization bringing auxiliary packages under one Cello module --- /project/cello/cvsroot/cello/cl-opengl/build-prep.lisp 2006/05/17 16:14:36 NONE +++ /project/cello/cvsroot/cello/cl-opengl/build-prep.lisp 2006/05/17 16:14:36 1.1 #-asdf (load "/0devtools/asdf.lisp") ;;;(push (make-pathname :directory '(:absolute "0devtools" "parse-number")) ;;; asdf:*central-registry*) ;;; ;;;(asdf:operate 'asdf:load-op 'parse-number) (progn #+lispworks (setf hcl::*handle-existing-defpackage* (list :add)) (push (make-pathname :directory '(:absolute "0devtools" "cffi")) asdf:*central-registry*) (push (make-pathname :directory '(:absolute "0devtools" "verrazano-support")) asdf:*central-registry*) (asdf:operate 'asdf:load-op 'verrazano-support :force t))--- /project/cello/cvsroot/cello/cl-opengl/cl-opengl.asd 2006/05/17 16:14:36 NONE +++ /project/cello/cvsroot/cello/cl-opengl/cl-opengl.asd 2006/05/17 16:14:36 1.1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;(declaim (optimize (debug 2) (speed 1) (safety 1) (compilation-speed 1))) ;(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0))) (in-package :asdf) #-(or openmcl sbcl cmu clisp lispworks ecl allegro cormanlisp) (error "Sorry, this Lisp is not yet supported. Patches welcome!") (defsystem cl-opengl :name "cl-opengl" :author "Kenny Tilton <ktilton(a)nyc.rr.com>" :version "1.0.0" :maintainer "Kenny Tilton <ktilton(a)nyc.rr.com>" :licence "MIT" :description "Partial OpenGL Bindings" :long-description "Bindings to most of OpenGL, more on demand" :perform (load-op :after (op cl-opengl) (pushnew :cl-opengl cl:*features*)) :depends-on (:hello-cffi) :serial t :components ((:file "cl-opengl") (:file "gl-def" :depends-on ("cl-opengl")) (:file "gl-constants" :depends-on ("gl-def")) (:file "gl-functions" :depends-on ("gl-def")) (:file "glu-functions" :depends-on ("gl-def")) (:file "glut-loader" :depends-on ("cl-opengl")) (:file "glut-functions" :depends-on ("glut-loader")) (:file "glut-def" :depends-on ("glut-loader")) (:file "glut-extras" :depends-on ("glut-loader")) (:file "ogl-macros" :depends-on ("gl-def")) (:file "ogl-utils" :depends-on ("ogl-macros")) (:file "nehe-14" :depends-on ("ogl-macros")))) --- /project/cello/cvsroot/cello/cl-opengl/cl-opengl.lisp 2006/05/17 16:14:36 NONE +++ /project/cello/cvsroot/cello/cl-opengl/cl-opengl.lisp 2006/05/17 16:14:36 1.1 ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cl-opengl; -*- ;; ;;; ;;; Copyright © 2004 by Kenneth William Tilton. ;;; ;;; Permission is hereby granted, free of charge, to any person obtaining a copy ;;; of this software and associated documentation files (the "Software"), to deal ;;; in the Software without restriction, including without limitation the rights ;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell ;;; copies of the Software, and to permit persons to whom the Software is furnished ;;; to do so, subject to the following conditions: ;;; ;;; The above copyright notice and this permission notice shall be included in ;;; all copies or substantial portions of the Software. ;;; ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR ;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, ;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE ;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER ;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. (pushnew :cl-opengl *features*) (defpackage #:cl-opengl (:nicknames #:ogl) (:use #:common-lisp #:cffi #:ffx) (:export #:*ogl-listing-p* #:with-matrix #:with-matrix-mode #:with-attrib #:with-client-attrib #:with-gl-begun #:gl-pushm #:gl-popm #:cl-opengl-init #:closed-stream-p #:*selecting* #:cl-opengl-reset #:ogl-texture #:ncalc-normalf #:ncalc-normalfv #:ogl-get-int #:ogl-get-boolean #:v3f #:make-v3f #:v3f-x #:v3f-y #:v3f-z #:with-gl-param #:xlin #:xlout #:ups #:ups-most #:ups-more #:downs #:downs-most #:downs-more #:farther #:nearer #:ogl-texture-delete #:ogl-texture-gen #:ogl-tex-gen-setup #:ogl-bounds #:ogl-scissor-box #:ogl-raster-pos-get #:ogl-pen-move #:with-bitmap-shifted #:texture-name #:eltgli #:ogl-tex-activate #:gl-name #:mgwclose #:freeg)) (in-package :cl-opengl) (defparameter *selecting* nil) (push (make-pathname :directory '(:absolute "0devtools" "cffi")) asdf:*central-registry*) (push (make-pathname :directory '(:absolute "0devtools" "verrazano-support")) asdf:*central-registry*) (defparameter *gl-dynamic-lib* #+(or win32 windows mswindows) (make-pathname ;; #+lispworks :host #-lispworks :device "C" :directory '(:absolute "windows" "system32") :name "opengl32" :type "dll") #+(or darwin unix powerpc) (make-pathname :directory '(:absolute "System" "Library" "Frameworks" "OpenGL.framework" "Versions" "Current") :name "OpenGL" :type nil)) (defparameter *glu-dynamic-lib* #+(or win32 windows mswindows) (make-pathname ;;; #+lispworks :host #-lispworks :device "C" :directory '(:absolute "windows" "system32") :name "glu32" :type "dll") #+(or darwin unix powerpc) (make-pathname :directory '(:absolute "System" "Library" "Frameworks" "GLU.framework" "Versions" "Current") :name "GLU" :type nil)) (defvar *opengl-dll* nil) (defun cl-opengl-load () (declare (ignorable load-oglfont-p)) (unless *opengl-dll* (print "loading open GL/GLU") (ffx:load-foreign-library (namestring *gl-dynamic-lib*)) ; :module "open-gl") ;; -lispworks#-lispworks (setf *opengl-dll* (ffx:load-foreign-library (namestring *glu-dynamic-lib*))))) (eval-when (load eval) (cl-opengl-load)) (defun gl-boolean-test (value) #+allegro (not (eql value #\null)) #-allegro (not (zerop value))) #+yeahyeah (defun dump-lists (min max) (loop with start and end for lx from min to max when (gl-boolean-test (glislist lx)) do (if start (if end (if (eql lx (1+ end)) (setf end lx) (print `(gl ,start to ,end))) (if (eql lx (1+ start)) (setf end lx) (print `(gl ,start)))) (setf start lx)))) (dfenum storagetype char-pixel short-pixel integer-pixel long-pixel float-pixel double-pixel) (dfenum filtertypes undefined-filter point-filter box-filter triangle-filter hermite-filter hanning-filter hamming-filter blackman-filter gaussian-filter quadratic-filter cubic-filter catrom-filter mitchell-filter lanczos-filter bessel-filter sinc-filter)--- /project/cello/cvsroot/cello/cl-opengl/cl-opengl.lpr 2006/05/17 16:14:36 NONE +++ /project/cello/cvsroot/cello/cl-opengl/cl-opengl.lpr 2006/05/17 16:14:36 1.1 ;; -*- lisp-version: "8.0 [Windows] (May 11, 2006 6:29)"; cg: "1.81"; -*- (in-package :cg-user) (defpackage :CL-OPENGL) (define-project :name :cl-opengl :modules (list (make-instance 'module :name "cl-opengl.lisp") (make-instance 'module :name "gl-def.lisp") (make-instance 'module :name "gl-constants.lisp") (make-instance 'module :name "gl-functions.lisp") (make-instance 'module :name "glu-functions.lisp") (make-instance 'module :name "ogl-macros.lisp") (make-instance 'module :name "ogl-utils.lisp")) :projects (list (make-instance 'project-module :name "..\\cells\\utils-kt\\utils-kt") (make-instance 'project-module :name "..\\hello-cffi\\hello-cffi")) :libraries nil :distributed-files nil :internally-loaded-files nil :project-package-name :cl-opengl :main-form nil :compilation-unit t :verbose nil :runtime-modules nil :splash-file-module (make-instance 'build-module :name "") :icon-file-module (make-instance 'build-module :name "") :include-flags '(:compiler :top-level :local-name-info) :build-flags '(:allow-debug :purify) :autoload-warning t :full-recompile-for-runtime-conditionalizations nil :default-command-line-arguments "+cx +t \"Initializing\"" :additional-build-lisp-image-arguments '(:read-init-files nil) :old-space-size 256000 :new-space-size 6144 :runtime-build-option :standard :on-initialization 'cl-opengl::lesson-14 :on-restart 'do-default-restart) ;; End of Project Definition --- /project/cello/cvsroot/cello/cl-opengl/gl-constants.lisp 2006/05/17 16:14:36 NONE +++ /project/cello/cvsroot/cello/cl-opengl/gl-constants.lisp 2006/05/17 16:14:36 1.1 ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cl-opengl; -*- ;;; ;;; Copyright © 1995,2003 by Kenneth William Tilton. ;;; ;;; Permission is hereby granted, free of charge, to any person obtaining a copy ;;; of this software and associated documentation files (the "Software"), to deal ;;; in the Software without restriction, including without limitation the rights ;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell ;;; copies of the Software, and to permit persons to whom the Software is furnished ;;; to do so, subject to the following conditions: ;;; ;;; The above copyright notice and this permission notice shall be included in ;;; all copies or substantial portions of the Software. ;;; ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR ;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, ;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE ;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER ;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. (in-package #:cl-opengl) #| blendingfactordest |# (dfc gl_zero 0) (dfc gl_one 1) (dfc gl_src_color #x0300) (dfc gl_one_minus_src_color #x0301) (dfc gl_src_alpha #x0302) (dfc gl_one_minus_src_alpha #x0303) (dfc gl_dst_alpha #x0304) (dfc gl_one_minus_dst_alpha #x0305) #| pixelcopytype |# (dfc gl_color #x1800) (dfc gl_depth #x1801) (dfc gl_stencil #x1802) #| pixelformat |# (dfc gl_color_index #x1900) (dfc gl_stencil_index #x1901) (dfc gl_depth_component #x1902) (dfc gl_red #x1903) (dfc gl_green #x1904) (dfc gl_blue #x1905) (dfc gl_alpha #x1906) (dfc gl_rgb #x1907) (dfc gl_rgba #x1908) (dfc gl_luminance #x1909) (dfc gl_luminance_alpha #x190a) #| polygons |# (dfc gl_point #x1b00) (dfc gl_line #x1b01) (dfc gl_fill #x1b02) (dfc gl_cw #x0900) (dfc gl_ccw #x0901) (dfc gl_front #x0404) (dfc gl_back #x0405) (dfc gl_polygon_offset_factor #x8038) (dfc gl_polygon_offset_units #x2a00) (dfc gl_polygon_offset_point #x2a01) (dfc gl_polygon_offset_line #x2a02) (dfc gl_polygon_offset_fill #x8037) #| lighting |# (dfc gl_light0 #x4000) (dfc gl_light1 #x4001) (dfc gl_light2 #x4002) (dfc gl_light3 #x4003) (dfc gl_light4 #x4004) (dfc gl_light5 #x4005) (dfc gl_light6 #x4006) (dfc gl_light7 #x4007) (dfc gl_spot_exponent #x1205) (dfc gl_spot_cutoff #x1206) (dfc gl_constant_attenuation #x1207) (dfc gl_linear_attenuation #x1208) (dfc gl_quadratic_attenuation #x1209) (dfc gl_ambient #x1200) (dfc gl_diffuse #x1201) (dfc gl_specular #x1202) (dfc gl_shininess #x1601) (dfc gl_emission #x1600) (dfc gl_position #x1203) (dfc gl_spot_direction #x1204) (dfc gl_ambient_and_diffuse #x1602) (dfc gl_color_indexes #x1603) (dfc gl_front_and_back #x0408) (dfc gl_flat #x1d00) (dfc gl_smooth #x1d01) #| user clipping planes |# (dfc gl_clip_plane0 #x3000) (dfc gl_clip_plane1 #x3001) (dfc gl_clip_plane2 #x3002) (dfc gl_clip_plane3 #x3003) (dfc gl_clip_plane4 #x3004) (dfc gl_clip_plane5 #x3005) #| boolean values |# (dfc gl_false #x0) (dfc gl_true #x1) #| data types |# (dfc gl_byte #x1400) (dfc gl_unsigned_byte #x1401) (dfc gl_short #x1402) (dfc gl_unsigned_short #x1403) (dfc gl_int #x1404) (dfc gl_unsigned_int #x1405) (dfc gl_float #x1406) (dfc gl_double #x140a) (dfc gl_2_bytes #x1407) (dfc gl_3_bytes #x1408) (dfc gl_4_bytes #x1409) #| primitives |# (dfc gl_points #x0000) (dfc gl_lines #x0001) (dfc gl_line_loop #x0002) (dfc gl_line_strip #x0003) (dfc gl_triangles #x0004) (dfc gl_triangle_strip #x0005) (dfc gl_triangle_fan #x0006) (dfc gl_quads #x0007) (dfc gl_quad_strip #x0008) (dfc gl_polygon #x0009) #| vertex arrays |# (dfc gl_vertex_array #x8074) (dfc gl_normal_array #x8075) (dfc gl_color_array #x8076) (dfc gl_index_array #x8077) (dfc gl_texture_coord_array #x8078) (dfc gl_edge_flag_array #x8079) (dfc gl_vertex_array_size #x807a) (dfc gl_vertex_array_type #x807b) (dfc gl_vertex_array_stride #x807c) (dfc gl_normal_array_type #x807e) (dfc gl_normal_array_stride #x807f) (dfc gl_color_array_size #x8081) (dfc gl_color_array_type #x8082) (dfc gl_color_array_stride #x8083) (dfc gl_index_array_type #x8085) (dfc gl_index_array_stride #x8086) (dfc gl_texture_coord_array_size #x8088) (dfc gl_texture_coord_array_type #x8089) (dfc gl_texture_coord_array_stride #x808a) (dfc gl_edge_flag_array_stride #x808c) (dfc gl_vertex_array_pointer #x808e) (dfc gl_normal_array_pointer #x808f) [346 lines skipped] --- /project/cello/cvsroot/cello/cl-opengl/gl-def.lisp 2006/05/17 16:14:36 NONE +++ /project/cello/cvsroot/cello/cl-opengl/gl-def.lisp 2006/05/17 16:14:36 1.1 [408 lines skipped] --- /project/cello/cvsroot/cello/cl-opengl/gl-functions.lisp 2006/05/17 16:14:36 NONE +++ /project/cello/cvsroot/cello/cl-opengl/gl-functions.lisp 2006/05/17 16:14:36 1.1 [818 lines skipped] --- /project/cello/cvsroot/cello/cl-opengl/glu-functions.lisp 2006/05/17 16:14:36 NONE +++ /project/cello/cvsroot/cello/cl-opengl/glu-functions.lisp 2006/05/17 16:14:36 1.1 [1061 lines skipped] --- /project/cello/cvsroot/cello/cl-opengl/ogl-macros.lisp 2006/05/17 16:14:36 NONE +++ /project/cello/cvsroot/cello/cl-opengl/ogl-macros.lisp 2006/05/17 16:14:36 1.1 [1199 lines skipped] --- /project/cello/cvsroot/cello/cl-opengl/ogl-utils.lisp 2006/05/17 16:14:36 NONE +++ /project/cello/cvsroot/cello/cl-opengl/ogl-utils.lisp 2006/05/17 16:14:36 1.1 [1420 lines skipped]

1 0

[cello-cvs] CVS cello/cl-openal
by ktilton 17 May '06

17 May '06

Update of /project/cello/cvsroot/cello/cl-openal In directory clnet:/tmp/cvs-serv22618/cl-openal Added Files: al.lisp alc.lisp alctypes.lisp altypes.lisp alu.lisp alut.lisp cl-openal-config.lisp cl-openal-demo.lisp cl-openal-init.lisp cl-openal.asd cl-openal.lisp cl-openal.lpr cl-opengl-config.lisp wav-handling.lisp Log Message: CVS re-organization bringing auxiliary packages under one Cello module --- /project/cello/cvsroot/cello/cl-openal/al.lisp 2006/05/17 16:14:30 NONE +++ /project/cello/cvsroot/cello/cl-openal/al.lisp 2006/05/17 16:14:30 1.1 (in-package :cl-openal) #|* * OpenAL cross platform audio library * Copyright (C) 1999-2000 by authors. * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 59 Temple Place - Suite 330, * Boston, MA 02111-1307, USA. * Or go to http://www.gnu.org/copyleft/lgpl.html |# #|* * OpenAL Maintenance Functions * Initialization and exiting. * State Management and Query. * Error Handling. * Extension Support. |# #|* State management. |# (defun-ffx al-void "openal" "alEnable" ( al-enum capability )) (defun-ffx al-void "openal" "alDisable" ( al-enum capability )) (defun-ffx al-boolean "openal" "alIsEnabled" ( al-enum capability )) #|* Application preferences for driver performance choices. |# (defun-ffx al-void "openal" "alHint" ( al-enum target al-enum mode )) #|* State retrieval. |# (defun-ffx al-boolean "openal" "alGetBoolean" ( al-enum param )) (defun-ffx al-int "openal" "alGetInteger" ( al-enum param )) (defun-ffx al-float "openal" "alGetFloat" ( al-enum param )) (defun-ffx al-double "openal" "alGetDouble" ( al-enum param )) (defun-ffx al-void "openal" "alGetBooleanv" ( al-enum param :void *data )) (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 )) #|* * Error support. * Obtain the most recent error generated in the AL state machine. |# (defun-ffx al-enum "openal" "alGetError" ( )) #|* * Extension support. * Obtain the address of a function (usually an extension) * with the name fname. All addresses are context-independent. |# (defun-ffx al-boolean "openal" "alIsExtensionPresent" ( :void *fname )) #|* * Extension support. * 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 )) #|* * Extension support. * Obtain the integer value of an enumeration (usually an extension) with the name ename. |# (defun-ffx al-enum "openal" "alGetEnumValue" ( :void *ename )) #|* * LISTENER * Listener is the sample position for a given context. * The multi-channel (usually stereo) output stream generated * by the mixer is parametrized by this Listener object: * its position and velocity relative to Sources, within * occluder and reflector geometry. |# #|* * * Listener Environment: default 0. |# (defun-ffx al-void "openal" "alListeneri" ( al-enum param al-int value )) #|* * * Listener Gain: default 1.0f. |# (defun-ffx al-void "openal" "alListenerf" ( al-enum param al-float value )) #|* * * Listener Position. * Listener Velocity. |# (defun-ffx al-void "openal" "alListener3f" ( al-enum param al-float v1 al-float v2 al-float v3 )) #|* * * Listener Position: ALfloat[3] * Listener Velocity: ALfloat[3] * Listener Orientation: ALfloat[6] (forward and up vector). |# (defun-ffx al-void "openal" "alListenerfv" ( al-enum param :void *values )) (defun-ffx al-void "openal" "alGetListeneri" ( al-enum param :void *value )) (defun-ffx al-void "openal" "alGetListenerf" ( al-enum param :void *value )) (defun-ffx al-void "openal" "alGetListener3f" ( al-enum param :void *v1 :void *v2 :void *v3 )) (defun-ffx al-void "openal" "alGetListenerfv" ( al-enum param :void *values )) #|* * SOURCE * Source objects are by default localized. Sources * take the PCM data provided in the specified Buffer, * apply Source-specific modifications, and then * submit them to be mixed according to spatial * arrangement etc. |# #|* Create Source objects. |# (defun-ffx al-void "openal" "alGenSources" ( al-sizei n :void *sources )) #|* Delete Source objects. |# (defun-ffx al-void "openal" "alDeleteSources" ( al-sizei n :void *sources )) #|* Verify a handle is a valid Source. |# (defun-ffx al-boolean "openal" "alIsSource" ( al-uint id )) #|* Set an integer parameter for a Source object. |# (defun-ffx al-void "openal" "alSourcei" ( al-uint source al-enum param al-int value )) (defun-ffx al-void "openal" "alSourcef" ( al-uint source al-enum param al-float value )) (defun-ffx al-void "openal" "alSource3f" ( al-uint source al-enum param al-float v1 al-float v2 al-float v3 )) (defun-ffx al-void "openal" "alSourcefv" ( al-uint source al-enum param :void *values )) #|* Get an integer parameter for a Source object. |# (defun-ffx al-void "openal" "alGetSourcei" ( al-uint source al-enum param :void *value )) (defun-ffx al-void "openal" "alGetSourcef" ( al-uint source al-enum param :void *value )) (defun-ffx al-void "openal" "alGetSource3f" ( al-uint source al-enum param :void *v1 :void *v2 :void *v3 )) (defun-ffx al-void "openal" "alGetSourcefv" ( al-uint source al-enum param :void *values )) (defun-ffx al-void "openal" "alSourcePlayv" ( al-sizei n al-uint *sources )) (defun-ffx al-void "openal" "alSourcePausev" ( al-sizei n al-uint *sources )) (defun-ffx al-void "openal" "alSourceStopv" ( al-sizei n al-uint *sources )) (defun-ffx al-void "openal" "alSourceRewindv" (al-sizei n al-uint *sources)) #|* Activate a source, start replay. |# (defun-ffx al-void "openal" "alSourcePlay" ( al-uint source )) #|* * Pause a source, * temporarily remove it from the mixer list. |# (defun-ffx al-void "openal" "alSourcePause" ( al-uint source )) #|* * Stop a source, * temporarily remove it from the mixer list, * and reset its internal state to pre-Play. * To remove a Source completely, it has to be * deleted following Stop, or before Play. |# (defun-ffx al-void "openal" "alSourceStop" ( al-uint source )) #| * * Rewinds a source, * temporarily remove it from the mixer list, * and reset its internal state to pre-Play. |# (defun-ffx al-void "openal" "alSourceRewind" ( al-uint source )) #| * * BUFFER * Buffer objects are storage space for sample data. * Buffers are referred to by Sources. There can be more than * one Source using the same Buffer data. If Buffers have * to be duplicated on a per-Source basis, the driver has to * take care of allocation, copying, and deallocation as well * as propagating buffer data changes. |# #|* Buffer object generation. |# (defun-ffx al-void "openal" "alGenBuffers" ( al-sizei n :void *buffer-uints )) (defun-ffx al-void "openal" "alDeleteBuffers" ( al-sizei n :void *buffers )) (defun-ffx al-boolean "openal" "alIsBuffer" ( al-uint buffer )) #| * * Specify the data to be filled into a buffer. * |# (defun-ffx al-void "openal" "alBufferData" ( al-uint buffer al-enum format :void *data al-sizei size al-sizei freq )) (defun-ffx al-void "openal" "alGetBufferi" ( al-uint buffer al-enum param :void *value )) (defun-ffx al-void "openal" "alGetBufferf" ( al-uint buffer al-enum param :void *value )) #| * * Queue stuff * |# (defun-ffx al-void "openal" "alSourceQueueBuffers" ( al-uint source al-sizei n :void *buffers )) (defun-ffx al-void "openal" "alSourceUnqueueBuffers" ( al-uint source al-sizei n :void *buffers )) #| * * Knobs and dials * |# (defun-ffx al-void "openal" "alDistanceModel" ( al-enum value )) (defun-ffx al-void "openal" "alDopplerFactor" ( al-float value )) (defun-ffx al-void "openal" "alDopplerVelocity" ( al-float value )) --- /project/cello/cvsroot/cello/cl-openal/alc.lisp 2006/05/17 16:14:30 NONE +++ /project/cello/cvsroot/cello/cl-openal/alc.lisp 2006/05/17 16:14:30 1.1 (in-package :cl-openal) ; typedef struct ALCdevice_struct ALCdevice; ; typedef struct ALCcontext_struct ALCcontext; ;;;(defun-ffx ALCubyte* "openal" "alcGetString" (ALCdevice *device ALCenum param)) ;;;(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" "alcCloseDevice" (:void *device)) (defun-ffx :pointer "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" "alcSuspendContext" (:void *context)) (defun-ffx alc-enum "openal" "alcDestroyContext" (:void *context)) ;;; (defun-ffx alc-enum "openal" "alcGetError" (:void *device)) ;;; (defun-ffx alc-boolean "openal" "alcIsExtensionPresent" (:void *device alc-ubyte *ext-name)) (defun-ffx :void "openal" "alcGetProcAddress" (:void *device alc-ubyte *func-name)) (defun-ffx alc-enum "openal" "alcGetEnumValue" (:void *device alc-ubyte *enum-name)) --- /project/cello/cvsroot/cello/cl-openal/alctypes.lisp 2006/05/17 16:14:30 NONE +++ /project/cello/cvsroot/cello/cl-openal/alctypes.lisp 2006/05/17 16:14:30 1.1 (in-package :cl-openal) #| * OpenAL cross platform audio library * Copyright (C) 1999-2000 by authors. * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 59 Temple Place - Suite 330, * Boston, MA 02111-1307, USA. * 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-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) (dft alc-int :int integer) (dft alc-float #+lispworks :lisp-single-float #-lispworks :float single-float) (dft alc-double :double double-float) (dft alc-sizei #-allegro-v5.0.1 :unsigned-int #+allegro-v5.0.1 :int integer) (dft alc-void :void integer) (dft alc-enum #-allegro-v5.0.1 :unsigned-int #+allegro-v5.0.1 :int integer) (dfc alc_invalid -1) (dfc alc_false 0) (dfc alc_true 1) (dfc alc_no_error alc_false) (dfc alc_major_version #x1000) (dfc alc_minor_version #x1001) (dfc alc_attributes_size #x1002) (dfc alc_all_attributes #x1003) (dfc alc_default_device_specifier #x1004) (dfc alc_device_specifier #x1005) (dfc alc_extensions #x1006) (dfc alc_frequency #x1007) (dfc alc_refresh #x1008) (dfc alc_sync #x1009) (dfc alc_invalid_device #xa001) (dfc alc_invalid_context #xa002) (dfc alc_invalid_enum #xa003) (dfc alc_invalid_value #xa004) (dfc alc_out_of_memory #xa005) --- /project/cello/cvsroot/cello/cl-openal/altypes.lisp 2006/05/17 16:14:30 NONE +++ /project/cello/cvsroot/cello/cl-openal/altypes.lisp 2006/05/17 16:14:30 1.1 (in-package :cl-openal) #| * OpenAL cross platform audio library * Copyright (C) 1999-2000 by authors. * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 59 Temple Place - Suite 330, * Boston, MA 02111-1307, USA. * Or go to http://www.gnu.org/copyleft/lgpl.html |# (dft al-enum #-allegro-v5.0.1 :unsigned-int #+allegro-v5.0.1 :int integer) (dft al-bitfield #-allegro-v5.0.1 :unsigned-int #+allegro-v5.0.1 :int integer) (dft al-int :int integer) (dft al-sizei :int integer) (dft al-uint #-allegro-v5.0.1 :unsigned-int #+allegro-v5.0.1 :int integer) (dft al-ushort #-allegro-v5.0.1 :unsigned-int #+allegro-v5.0.1 :int integer) (dft al-float #+lispworks :lisp-single-float #-lispworks :float single-float) (dft al-clampf #+lispworks :lisp-single-float #-lispworks :float single-float) (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-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-sizei #-allegro-v5.0.1 :unsigned-int #+allegro-v5.0.1 :int integer) (dfc al_invalid -1) (dfc al_none 0) (dfc al_false 0) (dfc al_true 1) #|* * Indicate the type of AL_SOURCE. * Sources can be spatialized |# (dfc al_source_type #x200) #|* Indicate source has absolute coordinates. |# (dfc al_source_absolute #x201) #|* Indicate Source has listener relative coordinates. |# (dfc al_source_relative #x202) #|* * Directional source, inner cone angle, in degrees. * Range: [0-360] * Default: 360 |# (dfc al_cone_inner_angle #x1001) #|* * Directional source, outer cone angle, in degrees. * Range: [0-360] * Default: 360 |# (dfc al_cone_outer_angle #x1002) #|* * Specify the pitch to be applied, either at source, [219 lines skipped] --- /project/cello/cvsroot/cello/cl-openal/alu.lisp 2006/05/17 16:14:30 NONE +++ /project/cello/cvsroot/cello/cl-openal/alu.lisp 2006/05/17 16:14:30 1.1 [258 lines skipped] --- /project/cello/cvsroot/cello/cl-openal/alut.lisp 2006/05/17 16:14:30 NONE +++ /project/cello/cvsroot/cello/cl-openal/alut.lisp 2006/05/17 16:14:30 1.1 [286 lines skipped] --- /project/cello/cvsroot/cello/cl-openal/cl-openal-config.lisp 2006/05/17 16:14:30 NONE +++ /project/cello/cvsroot/cello/cl-openal/cl-openal-config.lisp 2006/05/17 16:14:30 1.1 [327 lines skipped] --- /project/cello/cvsroot/cello/cl-openal/cl-openal-demo.lisp 2006/05/17 16:14:30 NONE +++ /project/cello/cvsroot/cello/cl-openal/cl-openal-demo.lisp 2006/05/17 16:14:30 1.1 [347 lines skipped] --- /project/cello/cvsroot/cello/cl-openal/cl-openal-init.lisp 2006/05/17 16:14:30 NONE +++ /project/cello/cvsroot/cello/cl-openal/cl-openal-init.lisp 2006/05/17 16:14:30 1.1 [438 lines skipped] --- /project/cello/cvsroot/cello/cl-openal/cl-openal.asd 2006/05/17 16:14:30 NONE +++ /project/cello/cvsroot/cello/cl-openal/cl-openal.asd 2006/05/17 16:14:30 1.1 [469 lines skipped] --- /project/cello/cvsroot/cello/cl-openal/cl-openal.lisp 2006/05/17 16:14:30 NONE +++ /project/cello/cvsroot/cello/cl-openal/cl-openal.lisp 2006/05/17 16:14:30 1.1 [531 lines skipped] --- /project/cello/cvsroot/cello/cl-openal/cl-openal.lpr 2006/05/17 16:14:30 NONE +++ /project/cello/cvsroot/cello/cl-openal/cl-openal.lpr 2006/05/17 16:14:30 1.1 [573 lines skipped] --- /project/cello/cvsroot/cello/cl-openal/cl-opengl-config.lisp 2006/05/17 16:14:30 NONE +++ /project/cello/cvsroot/cello/cl-openal/cl-opengl-config.lisp 2006/05/17 16:14:30 1.1 [616 lines skipped] --- /project/cello/cvsroot/cello/cl-openal/wav-handling.lisp 2006/05/17 16:14:30 NONE +++ /project/cello/cvsroot/cello/cl-openal/wav-handling.lisp 2006/05/17 16:14:30 1.1 [753 lines skipped]

1 0

[cello-cvs] CVS cello/cl-magick
by ktilton 17 May '06

17 May '06

Update of /project/cello/cvsroot/cello/cl-magick In directory clnet:/tmp/cvs-serv22618/cl-magick Added Files: build.lisp cl-magick.asd cl-magick.lisp cl-magick.lpr drawing-wand.lisp magick-wand.lisp mgk-utils.lisp pixel-wand.lisp wand-image.lisp wand-pixels.lisp wand-texture.lisp Log Message: CVS re-organization bringing auxiliary packages under one Cello module --- /project/cello/cvsroot/cello/cl-magick/build.lisp 2006/05/17 16:14:29 NONE +++ /project/cello/cvsroot/cello/cl-magick/build.lisp 2006/05/17 16:14:29 1.1 (in-package :cl-user) #-allegro-ide (let ((drive "C") (d-force nil)) (build-sys d-force drive "dvx" "uffi") (build-sys d-force drive "dvx" "ffi-extender") (build-sys d-force drive "dvx" "cl-opengl") (load (dev-root "cl-ftgl" "cl-ftgl.lisp")) (build-sys d-force drive "dvx" "cl-magick") ; (cl-magick::cl-magick-test) ) #+test (cl-magick::cl-magick-test) (in-package :cl-user) #-allegro-ide (let ((drive "C") (d-force nil)) (build-sys d-force drive "dvx" "uffi") (build-sys d-force drive "dvx" "ffi-extender") (build-sys d-force drive "dvx" "cl-opengl") (load (dev-root "cl-ftgl" "cl-ftgl.lisp")) (build-sys d-force drive "dvx" "cl-magick") ; (cl-magick::cl-magick-test) ) #+test (cl-magick::cl-magick-test) --- /project/cello/cvsroot/cello/cl-magick/cl-magick.asd 2006/05/17 16:14:29 NONE +++ /project/cello/cvsroot/cello/cl-magick/cl-magick.asd 2006/05/17 16:14:29 1.1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;(declaim (optimize (debug 2) (speed 1) (safety 1) (compilation-speed 1))) (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0))) (in-package :asdf) #+(or allegro lispworks cmu mcl cormanlisp sbcl scl) (defsystem cl-magick :name "cl-magick" :author "Kenny Tilton <ktilton(a)nyc.rr.com>" :version "1.0.0" :maintainer "Kenny Tilton <ktilton(a)nyc.rr.com>" :licence "MIT" :description "Bindings for ImageMagick" :long-description "Poorly implemented bindings to half of ImageMagick" :components ((:file "cl-magick") (:file "magick-wand" :depends-on ("cl-magick")) (:file "drawing-wand" :depends-on ("magick-wand")) (:file "pixel-wand" :depends-on ("drawing-wand")) (:file "mgk-utils" :depends-on ("pixel-wand")) (:file "wand-image" :depends-on ("mgk-utils")) (:file "wand-texture" :depends-on ("wand-image")) (:file "wand-pixels" :depends-on ("wand-texture")) (:file "mgk-test" :depends-on ("wand-pixels")))) --- /project/cello/cvsroot/cello/cl-magick/cl-magick.lisp 2006/05/17 16:14:29 NONE +++ /project/cello/cvsroot/cello/cl-magick/cl-magick.lisp 2006/05/17 16:14:29 1.1 ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cl-magick; -*- ;;; ;;; Copyright © 2004 by Kenneth William Tilton. ;;; ;;; Permission is hereby granted, free of charge, to any person obtaining a copy ;;; of this software and associated documentation files (the "Software"), to deal ;;; in the Software without restriction, including without limitation the rights ;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell ;;; copies of the Software, and to permit persons to whom the Software is furnished ;;; to do so, subject to the following conditions: ;;; ;;; The above copyright notice and this permission notice shall be included in ;;; all copies or substantial portions of the Software. ;;; ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR ;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, ;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE ;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER ;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. (defpackage :cl-magick (:nicknames :mgk) (:use #:common-lisp #-(or cormanlisp ccl) #:clos #:hello-c #:ffx #+cl-opengl #:cl-opengl ;; wands as opengl textures ) (:export #:wand-manager #:wand-ensure-typed #:wands-clear #:wand-pixels #:wand-texture #:wand-render #:image-size #:wand-texture-activate #:xim #:magick-get-image-width #:magick-get-image-height #:magick-get-image-pixels #:new-magick-wand #:magick-read-image #:magick-flip-image #:wand-get-image-pixels #:path-to-wand #:mgk-wand-images-write #:magick-wand-template)) (eval-when (:compile-toplevel :load-toplevel :execute) (pushnew :cl-magick *features*)) (in-package :cl-magick) (defun magick-wand-template () (path-to-wand (make-pathname :directory '(:absolute "0dev" "user" "graphics" "templates") :name "metal" :type "gif"))) (defparameter *imagick-dll-loaded* nil) (defparameter *wands-loaded* nil) (defparameter *mgk-version* (fgn-alloc :unsigned-long 1)) (cffi:define-foreign-library Magick (:darwin (:framework "GraphicsMagick")) (:windows (:or #+not "C:\\Program Files\\ImageMagick-6.2.7-Q8\\CORE_RL_wand_.dll" "C:\\Program Files\\GraphicsMagick-1.1.7-Q8\\CORE_RL_wand_.dll"))) (eval-when (load eval) (cffi:use-foreign-library magick)) ;------------------------------------------------------------------- (defun cl-magick-init () (or *imagick-dll-loaded* (progn ;(print "clearing magick wands") ;(wands-clear) (assert (setq *imagick-dll-loaded* t #+not (cffi:use-foreign-library magick)) () "Unable to load imagick" ) (print `(magick-copyright ,(magick-get-copyright))) (print `(magick-version ,(magick-get-version *mgk-version*))) *imagick-dll-loaded*))) #+test (cl-magick-init) (defun wands-loaded () *wands-loaded*) (DEFUN (setf wands-loaded) (new-value) (setf *wands-loaded* new-value)) (defun wands-clear () (loop for wand in *wands-loaded* do (wand-release (cdr wand))) (setf *wands-loaded* nil)) (defun wand-ensure-typed (wand-type file-path$ &rest iargs) (when file-path$ (cl-magick-init) (let ((key (list* wand-type (namestring file-path$) iargs))) (or (let ((old nil #+nope (cdr (assoc key (wands-loaded) :test 'equal)))) ;;/// primitive test (when old (print `(wand-ensure-typed re-using prior load ,wand-type ,file-path$))) old) (let ((wi (apply 'make-instance wand-type :file-path$ file-path$ iargs))) (print `(wand-ensure-typed forced to load ,wand-type ,file-path$)) (push (cons key wi) (wands-loaded)) wi) (error "Unable to load image file ~a" file-path$))))) #+allegro (defun xim () (wands-clear) (dolist (dll (ff:list-all-foreign-libraries)) (when (search "wand" (pathname-name dll)) (print `(unloading foreign library ,dll)) (setf *imagick-dll-loaded* nil) (ff:unload-foreign-library dll)))) --- /project/cello/cvsroot/cello/cl-magick/cl-magick.lpr 2006/05/17 16:14:29 NONE +++ /project/cello/cvsroot/cello/cl-magick/cl-magick.lpr 2006/05/17 16:14:29 1.1 ;; -*- lisp-version: "8.0 [Windows] (May 5, 2006 15:39)"; cg: "1.81"; -*- (in-package :cg-user) (defpackage :CL-MAGICK) (define-project :name :cl-magick :modules (list (make-instance 'module :name "cl-magick.lisp") (make-instance 'module :name "magick-wand.lisp") (make-instance 'module :name "drawing-wand.lisp") (make-instance 'module :name "pixel-wand.lisp") (make-instance 'module :name "mgk-utils.lisp") (make-instance 'module :name "wand-image.lisp") (make-instance 'module :name "wand-texture.lisp") (make-instance 'module :name "wand-pixels.lisp")) :projects (list (make-instance 'project-module :name "..\\cl-opengl\\cl-opengl")) :libraries nil :distributed-files nil :internally-loaded-files nil :project-package-name :cl-magick :main-form nil :compilation-unit t :verbose nil :runtime-modules nil :splash-file-module (make-instance 'build-module :name "") :icon-file-module (make-instance 'build-module :name "") :include-flags '(:local-name-info) :build-flags '(:allow-debug :purify) :autoload-warning t :full-recompile-for-runtime-conditionalizations nil :default-command-line-arguments "+cx +t \"Initializing\"" :additional-build-lisp-image-arguments '(:read-init-files nil) :old-space-size 256000 :new-space-size 6144 :runtime-build-option :standard :on-initialization 'cl-magick::cl-magick-test :on-restart 'do-default-restart) ;; End of Project Definition --- /project/cello/cvsroot/cello/cl-magick/drawing-wand.lisp 2006/05/17 16:14:29 NONE +++ /project/cello/cvsroot/cello/cl-magick/drawing-wand.lisp 2006/05/17 16:14:29 1.1 ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cl-magick; -*- ;;; ;;; Copyright © 2004 by Kenneth William Tilton. ;;; ;;; Permission is hereby granted, free of charge, to any person obtaining a copy ;;; of this software and associated documentation files (the "Software"), to deal ;;; in the Software without restriction, including without limitation the rights ;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell ;;; copies of the Software, and to permit persons to whom the Software is furnished ;;; to do so, subject to the following conditions: ;;; ;;; The above copyright notice and this permission notice shall be included in ;;; all copies or substantial portions of the Software. ;;; ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR ;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, ;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE ;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER ;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. (in-package :cl-magick) ;;;/* ;;; ImageMagick Drawing Wand API. ;;;*/ ;;;#ifndef _MAGICK_DRAWING_WAND_H ;;;#define _MAGICK_DRAWING_WAND_H ;;; ;;;#if defined(__cplusplus) || defined(c_plusplus) ;;;extern "C" { ;;;#endif ;;; ;;;#include "wand/pixel_wand.h" ;;; ;;;typedef struct _DrawingWand ;;; *DrawContext ;;; DrawingWand; ;;; ;;;extern WandExport char ;;; *DrawGetClipPath( :void *DrawingWand) ;;; *DrawGetFont( :void *DrawingWand) ;;; *DrawGetFontFamily( :void *DrawingWand) ;;; *DrawGetTextEncoding( :void *DrawingWand); ;;; ;;;extern WandExport ClipPathUnits ;;; DrawGetClipUnits( :void *DrawingWand); ;;; ;;;extern WandExport DecorationType ;;; DrawGetTextDecoration( :void *DrawingWand); ;;; ;;;extern WandExport double ;;; DrawGetFillOpacity( :void *DrawingWand) ;;; DrawGetFontSize( :void *DrawingWand) ;;; *DrawGetStrokeDashArray( :void *DrawingWandunsigned long *) ;;; DrawGetStrokeDashOffset( :void *DrawingWand) ;;; DrawGetStrokeOpacity( :void *DrawingWand) ;;; DrawGetStrokeWidth( :void *DrawingWand); ;;; ;;;extern WandExport DrawInfo ;;; *DrawPeekGraphicContext( :void *DrawingWand); ;;; (defun-ffx (* :void) "imagick" "NewDrawingWand" ()) ;;;extern WandExport DrawingWand ;;; *DrawAllocateWand( DrawInfo *Image *) ;;; *NewDrawingWand(void); ;;; ;;;extern WandExport FillRule ;;; DrawGetClipRule( :void *DrawingWand) ;;; DrawGetFillRule( :void *DrawingWand); ;;; ;;;extern WandExport GravityType ;;; DrawGetGravity( :void *DrawingWand); ;;; ;;;extern WandExport LineCap ;;; DrawGetStrokeLineCap( :void *DrawingWand); ;;; ;;;extern WandExport LineJoin ;;; DrawGetStrokeLineJoin( :void *DrawingWand); ;;; ;;;extern WandExport StretchType ;;; DrawGetFontStretch( :void *DrawingWand); ;;; ;;;extern WandExport StyleType ;;; DrawGetFontStyle( :void *DrawingWand); ;;; ;;;extern WandExport :unsigned-int ;;; DrawGetStrokeAntialias( :void *DrawingWand) ;;; DrawGetTextAntialias( :void *DrawingWand) ;;; DrawRender( :void *DrawingWand); ;;; ;;;extern WandExport :unsigned-long ;;; DrawGetFontWeight( :void *DrawingWand) ;;; DrawGetStrokeMiterLimit( :void *DrawingWand); ;;; (ffx::defun-ffx-multi :void "imagick" ;;; DrawAffine(:void *DrawingWand AffineMatrix *) ;;; DrawAnnotation(:void *DrawingWand double double :unsigned-char *) ;;; DrawArc(:void *DrawingWand double double double double ;;; double double) ;;; DrawBezier(:void *DrawingWand :unsigned-long PointInfo *) ;;; DrawCircle(:void *DrawingWand double double double double) ;;; DrawColor(:void *DrawingWand double double PaintMethod) ;;; DrawComment(:void *DrawingWand char *) ;;; DestroyDrawingWand(:void *DrawingWand) "DrawEllipse" (:void *drawingwand :double ox :double oy :double rx :double ry :double start-angle :double end-angle) ;;; DrawComposite(:void *DrawingWand CompositeOperator double double ;;; double double Image *) ;;; DrawGetFillColor( :void *DrawingWandPixelWand *) ;;; DrawGetStrokeColor( :void *DrawingWandPixelWand *) ;;; DrawGetTextUnderColor( :void *DrawingWandPixelWand *) ;;; DrawLine(:void *DrawingWand double double double double) ;;; DrawMatte(:void *DrawingWand double double PaintMethod) ;;; DrawPathClose(:void *DrawingWand) ;;; DrawPathCurveToAbsolute(:void *DrawingWand double double double ;;; double double double) ;;; DrawPathCurveToRelative(:void *DrawingWand double double double ;;; double double double) ;;; DrawPathCurveToQuadraticBezierAbsolute(:void *DrawingWand double ;;; double double double) ;;; DrawPathCurveToQuadraticBezierRelative(:void *DrawingWand double ;;; double double double) ;;; DrawPathCurveToQuadraticBezierSmoothAbsolute(:void *DrawingWand double ;;; double) ;;; DrawPathCurveToQuadraticBezierSmoothRelative(:void *DrawingWand double ;;; double) ;;; DrawPathCurveToSmoothAbsolute(:void *DrawingWand double double ;;; double double) ;;; DrawPathCurveToSmoothRelative(:void *DrawingWand double double ;;; double double) ;;; DrawPathEllipticArcAbsolute(:void *DrawingWand double double ;;; double:unsigned-int:unsigned-int double double) ;;; DrawPathEllipticArcRelative(:void *DrawingWand double double ;;; double:unsigned-int:unsigned-int double double) ;;; DrawPathFinish(:void *DrawingWand) ;;; DrawPathLineToAbsolute(:void *DrawingWand double double) ;;; DrawPathLineToRelative(:void *DrawingWand double double) ;;; DrawPathLineToHorizontalAbsolute(:void *DrawingWand double) ;;; DrawPathLineToHorizontalRelative(:void *DrawingWand double) ;;; DrawPathLineToVerticalAbsolute(:void *DrawingWand double) ;;; DrawPathLineToVerticalRelative(:void *DrawingWand double) ;;; DrawPathMoveToAbsolute(:void *DrawingWand double double) ;;; DrawPathMoveToRelative(:void *DrawingWand double double) ;;; DrawPathStart(:void *DrawingWand) ;;; DrawPoint(:void *DrawingWand double double) ;;; DrawPolygon(:void *DrawingWand :unsigned-long PointInfo *) ;;; DrawPolyline(:void *DrawingWand :unsigned-long PointInfo *) ;;; DrawPopClipPath(:void *DrawingWand) ;;; DrawPopDefs(:void *DrawingWand) ;;; DrawPopGraphicContext(:void *DrawingWand) ;;; DrawPopPattern(:void *DrawingWand) ;;; DrawPushClipPath(:void *DrawingWand char *) ;;; DrawPushDefs(:void *DrawingWand) ;;; DrawPushGraphicContext(:void *DrawingWand) ;;; DrawPushPattern(:void *DrawingWand char * double double ;;; double double) ;;; DrawRectangle(:void *DrawingWand double double double ;;; double) ;;; DrawRotate(:void *DrawingWand double) ;;; DrawRoundRectangle(:void *DrawingWanddoubledoubledoubledoubledoubledouble) ;;; DrawScale(:void *DrawingWand double double) ;;; DrawSetClipPath(:void *DrawingWand char *) ;;; DrawSetClipRule(:void *DrawingWand FillRule) ;;; DrawSetClipUnits(:void *DrawingWand ClipPathUnits) ;;; DrawSetFillColor(:void *DrawingWand PixelWand *) ;;; DrawSetFillOpacity(:void *DrawingWand double) ;;; DrawSetFillRule(:void *DrawingWand FillRule) ;;; DrawSetFillPatternURL(:void *DrawingWand char *) ;;; DrawSetFont(:void *DrawingWand char *) ;;; DrawSetFontFamily(:void *DrawingWand char *) ;;; DrawSetFontSize(:void *DrawingWand double) ;;; DrawSetFontStretch(:void *DrawingWand StretchType) ;;; DrawSetFontStyle(:void *DrawingWand StyleType) ;;; DrawSetFontWeight(:void *DrawingWand :unsigned-long) ;;; DrawSetGravity(:void *DrawingWand GravityType) ;;; DrawSkewX(:void *DrawingWand double) ;;; DrawSkewY(:void *DrawingWand double) ;;; DrawSetStrokeAntialias(:void *DrawingWand :unsigned-int) ;;; DrawSetStrokeColor(:void *DrawingWand PixelWand *) ;;; DrawSetStrokeDashArray(:void *DrawingWand :unsigned-long double *) [21 lines skipped] --- /project/cello/cvsroot/cello/cl-magick/magick-wand.lisp 2006/05/17 16:14:29 NONE +++ /project/cello/cvsroot/cello/cl-magick/magick-wand.lisp 2006/05/17 16:14:29 1.1 [357 lines skipped] --- /project/cello/cvsroot/cello/cl-magick/mgk-utils.lisp 2006/05/17 16:14:29 NONE +++ /project/cello/cvsroot/cello/cl-magick/mgk-utils.lisp 2006/05/17 16:14:29 1.1 [457 lines skipped] --- /project/cello/cvsroot/cello/cl-magick/pixel-wand.lisp 2006/05/17 16:14:29 NONE +++ /project/cello/cvsroot/cello/cl-magick/pixel-wand.lisp 2006/05/17 16:14:29 1.1 [555 lines skipped] --- /project/cello/cvsroot/cello/cl-magick/wand-image.lisp 2006/05/17 16:14:29 NONE +++ /project/cello/cvsroot/cello/cl-magick/wand-image.lisp 2006/05/17 16:14:29 1.1 [665 lines skipped] --- /project/cello/cvsroot/cello/cl-magick/wand-pixels.lisp 2006/05/17 16:14:29 NONE +++ /project/cello/cvsroot/cello/cl-magick/wand-pixels.lisp 2006/05/17 16:14:29 1.1 [740 lines skipped] --- /project/cello/cvsroot/cello/cl-magick/wand-texture.lisp 2006/05/17 16:14:29 NONE +++ /project/cello/cvsroot/cello/cl-magick/wand-texture.lisp 2006/05/17 16:14:29 1.1 [875 lines skipped]

1 0