[cello-cvs] CVS cello/kt-opengl

[fgoenninger]

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

Modified Files:
	ogl-utils.lisp 
Log Message:
Code cleanup.

--- /project/cello/cvsroot/cello/kt-opengl/ogl-utils.lisp	2006/08/28 18:36:40	1.6
+++ /project/cello/cvsroot/cello/kt-opengl/ogl-utils.lisp	2006/10/01 12:30:14	1.7
@@ -22,7 +22,7 @@
 ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS 
 ;;; IN THE SOFTWARE.
 
-;;; $Id: ogl-utils.lisp,v 1.6 2006/08/28 18:36:40 fgoenninger Exp $
+;;; $Id: ogl-utils.lisp,v 1.7 2006/10/01 12:30:14 fgoenninger Exp $
 
 (in-package :kt-opengl)
 
@@ -252,3 +252,25 @@
             (if (consp arg)
                 (mapcan 'flatten arg)
               (list arg))) args))
+
+(defun gl-boolean-test (value)
+  #+allegro (not (eql value #\null))
+  #-allegro (not (zerop value)))
+
+(defun dump-lists (min max)
+  (loop with start
+        and end
+        for lx from min to max
+        when (let ((is (gl-is-list lx)))
+               (when (gl-boolean-test is) 
+                 (print (list "dl test" lx is (char-code is))))
+               (gl-boolean-test is))
+        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))))