[cello-cvs] CVS cello/kt-opengl

[fgoenninger]

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)
-	      , at 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)
+		, at body)
+	   (glcolor4i (mem-aref ,ptr 'glint 0)
+		      (mem-aref ,ptr 'glint 1)
+		      (mem-aref ,ptr 'glint 2)
+		      (mem-aref ,ptr 'glint 3))))
+       , at 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)