Update of /project/cello/cvsroot/cello/kt-opengl In directory clnet:/tmp/cvs-serv17675

Modified Files: colors.lisp Log Message: Added: Constant +NO-COLOR-CHANGE+ for macro with-color.

--- /project/cello/cvsroot/cello/kt-opengl/colors.lisp 2006/09/19 11:27:07 1.3 +++ /project/cello/cvsroot/cello/kt-opengl/colors.lisp 2006/10/01 09:34:08 1.4 @@ -20,7 +20,7 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER ;;; DEALINGS IN THE SOFTWARE. ;;; -;;; $Id: colors.lisp,v 1.3 2006/09/19 11:27:07 fgoenninger Exp $ +;;; $Id: colors.lisp,v 1.4 2006/10/01 09:34:08 fgoenninger Exp $

(in-package #:kt-opengl)

@@ -176,16 +176,18 @@

(defmacro with-color (rgba &body body) (let ((ptr (gensym))) - `(with-foreign-object (,ptr 'glint 4) - (gl-get-integerv GL_CURRENT_COLOR ,ptr) - (unwind-protect - (progn - (set-color ,rgba) - ,@body) - (glcolor4i (mem-aref ,ptr 'glint 0) - (mem-aref ,ptr 'glint 1) - (mem-aref ,ptr 'glint 2) - (mem-aref ,ptr 'glint 3)))))) + `(if ,rgba + (with-foreign-object (,ptr 'glint 4) + (gl-get-integerv GL_CURRENT_COLOR ,ptr) + (unwind-protect + (progn + (set-color ,rgba) + ,@body) + (glcolor4i (mem-aref ,ptr 'glint 0) + (mem-aref ,ptr 'glint 1) + (mem-aref ,ptr 'glint 2) + (mem-aref ,ptr 'glint 3)))) + ,@body)))

;;; --------------------------------------------------------------------------- ;;; EXPORT SYMBOLS @@ -207,12 +209,16 @@ make-opengl-rgba rgba-clear-color *known-colors* + +NO-COLOR-CHANGE+ )

;;; =========================================================================== ;;; Color definitions ;;; ===========================================================================

+(defconstant +NO-COLOR-CHANGE+ nil + "Macro WITH-COLOR uses NIL as a discriminator for determining when to not change color but just to execute the body") + ;;; RGBA simple colors

(define-ogl-rgba-color +RED+ 255 0 0 255)