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))))