[cells-cvs] CVS update: cell-cultures/cl-opengl/cl-opengl.lisp cell-cultures/cl-opengl/gl-def.lisp cell-cultures/cl-opengl/gl-functions.lisp cell-cultures/cl-opengl/glut-extras.lisp cell-cultures/cl-opengl/ogl-macros.lisp cell-cultures/cl-opengl/ogl-utils.lisp

[Kenny Tilton]

Update of /project/cells/cvsroot/cell-cultures/cl-opengl
In directory common-lisp.net:/tmp/cvs-serv2293/cl-opengl

Modified Files:
	cl-opengl.lisp gl-def.lisp gl-functions.lisp glut-extras.lisp 
	ogl-macros.lisp ogl-utils.lisp 
Log Message:
A couple of simple fixes to get the pixel and texture wands (GraphicksMagic stuff) working again and now Cello is pretty much back in business.
Date: Fri Oct  1 06:01:29 2004
Author: ktilton

Index: cell-cultures/cl-opengl/cl-opengl.lisp
diff -u cell-cultures/cl-opengl/cl-opengl.lisp:1.2 cell-cultures/cl-opengl/cl-opengl.lisp:1.3
--- cell-cultures/cl-opengl/cl-opengl.lisp:1.2	Sun Jul  4 20:59:45 2004
+++ cell-cultures/cl-opengl/cl-opengl.lisp	Fri Oct  1 06:01:29 2004
@@ -58,7 +58,7 @@
     #: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 #:ogl-pen-init #:ogl-pen #:ogl-pen-x #:ogl-pen-y
+    #:ogl-pen-move #:with-bitmap-shifted
     #:texture-name #:ogl-list-cache #:ogl-lists-delete
     #:eltgli #:ogl-tex-activate #:gl-name))
 


Index: cell-cultures/cl-opengl/gl-def.lisp
diff -u cell-cultures/cl-opengl/gl-def.lisp:1.1 cell-cultures/cl-opengl/gl-def.lisp:1.2
--- cell-cultures/cl-opengl/gl-def.lisp:1.1	Sat Jun 26 20:38:41 2004
+++ cell-cultures/cl-opengl/gl-def.lisp	Fri Oct  1 06:01:29 2004
@@ -26,7 +26,7 @@
     `(defun-ffx ,rtn ,module$ ,name$ (, at type-args)
        (progn
          ;;(cells::count-it ,(intern (string-upcase name$) :keyword))
-         (glec ',rtn))))
+         (glec ',(intern name$)))))
 
 (defun aforef (o n)
   (uffi:deref-array o '(:array :int) n))


Index: cell-cultures/cl-opengl/gl-functions.lisp
diff -u cell-cultures/cl-opengl/gl-functions.lisp:1.2 cell-cultures/cl-opengl/gl-functions.lisp:1.3
--- cell-cultures/cl-opengl/gl-functions.lisp:1.2	Sun Jul  4 20:59:45 2004
+++ cell-cultures/cl-opengl/gl-functions.lisp	Fri Oct  1 06:01:29 2004
@@ -169,6 +169,7 @@
 (defun-ffx :void "open-gl" "glGenTextures" (glsizei n gluint *textures))
 (defun-ffx :void "open-gl" "glBindTexture" (glenum target gluint texture))
 (defun-ffx :void "open-gl" "glDeleteTextures" (glsizei n gluint *textures))
+(defun-ffx :int "open-gl" "glIsTexture" (gluint textureName))
 
 
 
@@ -373,13 +374,11 @@
 (defun-ogl :void "open-gl" "glPixelZoom" (glfloat xfactor glfloat yfactor))
 
 #| display lists |#
-(defun-ogl glboolean "open-gl" "glIsList" (gluint list))
+(defun-ogl :int "open-gl" "glIsList" (gluint list))
 (defun-ogl :void "open-gl" "glDeleteLists" (gluint list glsizei range ))
 (defun-ogl gluint "open-gl" "glGenLists" (glsizei range ))
 (defun-ogl :void "open-gl" "glNewList" (gluint list glenum mode ))
 (defun-ogl :void "open-gl" "glEndList" ())
 (defun-ogl :void "open-gl" "glCallList" (gluint list ))
 (defun-ogl :void "open-gl" "glCallLists" (glsizei n glenum type glvoid *lists))
-
-
 (defun-ogl :void "open-gl" "glListBase" (gluint base))


Index: cell-cultures/cl-opengl/glut-extras.lisp
diff -u cell-cultures/cl-opengl/glut-extras.lisp:1.1 cell-cultures/cl-opengl/glut-extras.lisp:1.2
--- cell-cultures/cl-opengl/glut-extras.lisp:1.1	Sat Jun 26 20:38:41 2004
+++ cell-cultures/cl-opengl/glut-extras.lisp	Fri Oct  1 06:01:29 2004
@@ -37,6 +37,7 @@
         (setf *glut-dll* nil *opengl-dll* nil)
         (ff:unload-foreign-library dll)))))
 
+(defparameter *mg-glut-display-busy* nil)
 
 (defun cl-glut-init ()
   (cl-opengl-init)
@@ -60,7 +61,8 @@
                   (print "glut initialised")
                   )
               (fgn-free argc))))
-      (print "Glut already initialized"))))
+      (print "Glut already initialized"))
+    (setf *mg-glut-display-busy* nil)))
 
 (defvar *mdepth*)
 (defvar *selecting*)


Index: cell-cultures/cl-opengl/ogl-macros.lisp
diff -u cell-cultures/cl-opengl/ogl-macros.lisp:1.1 cell-cultures/cl-opengl/ogl-macros.lisp:1.2
--- cell-cultures/cl-opengl/ogl-macros.lisp:1.1	Sat Jun 26 20:38:41 2004
+++ cell-cultures/cl-opengl/ogl-macros.lisp	Fri Oct  1 06:01:29 2004
@@ -100,8 +100,6 @@
 
 (defun cl-opengl-init ()
   (declare (ignorable load-oglfont-p))
-  
-
   (unless *opengl-dll*
     (print "loading open GL/GLU")
     (uffi:load-foreign-library
@@ -112,7 +110,7 @@
                          :module "gl-util"))))
 
 (defun glec (&optional (id :anon))
-  (unless *gl-begun*
+  (unless (and (boundp '*gl-begun*) *gl-begun*)
     (let ((e (glgeterror)))
       (if (zerop e)
           (unless t ;; (find id '(glutcheckloop glutgetwindow))


Index: cell-cultures/cl-opengl/ogl-utils.lisp
diff -u cell-cultures/cl-opengl/ogl-utils.lisp:1.1 cell-cultures/cl-opengl/ogl-utils.lisp:1.2
--- cell-cultures/cl-opengl/ogl-utils.lisp:1.1	Sat Jun 26 20:38:41 2004
+++ cell-cultures/cl-opengl/ogl-utils.lisp	Fri Oct  1 06:01:29 2004
@@ -42,11 +42,12 @@
 
 (defun ogl-texture-gen ()
   (gl-gen-textures 1 *textures-1*)
+  (glec :ogl-texture-gen)
   (ff-elt *textures-1* gluint 0))
 
 (let (gl-s-plane gl-t-plane gl-r-plane gl-q-plane)
   (defun ogl-tex-gen-setup (mode tex-env tex-wrap scale &rest planes)
-    ;(print `(ogl-tex-gen-setup ,mode ,tex-wrap))
+    (ukt::trc nil "ogl-tex-gen-setup:" mode tex-env tex-wrap scale planes)
     (gl-tex-envf gl_texture_env gl_texture_env_mode tex-env)
     (gl-tex-parameterf gl_texture_2d gl_texture_min_filter gl_linear )
     (gl-tex-parameterf gl_texture_2d gl_texture_mag_filter gl_linear )
@@ -192,28 +193,17 @@
 (defun ogl-raster-pos-get ()
   (gl-get-ints-4 gl_current_raster_position))
 
-(defparameter *ogl-pen* nil)
-
-(defun ogl-pen ()
-  *ogl-pen*)
-
-(defun ogl-pen-x ()
-  (car *ogl-pen*))
-
-(defun ogl-pen-y ()
-  (cadr *ogl-pen*))
-
-(defun ogl-pen-init ()
-  (setq *ogl-pen* (ogl-raster-pos-get))
-  ;;(print (list "ogl-pen-init" :to *ogl-pen*))
-  (values))
+(defmacro with-bitmap-shifted ((x y) &body body)
+  (let ((xy (gensym)))
+  `(let ((,xy (cons ,x ,y)))
+     (ogl-pen-move (car ,xy) (cdr ,xy))
+     (prog1
+         (progn , at body)
+       (ogl-pen-move (- (car ,xy)) (- (cdr ,xy)))))))
 
 (defun ogl-pen-move (x y)
-  ;(incf (car *ogl-pen*) x)
-  ;(incf (cadr *ogl-pen*) y)
-  ;(print (list "ogl-pen-move" x y))
-  ;(print (list "in synch?" *ogl-pen* (ogl-raster-pos-get)))
-  (gl-bitmap 0 0 0 0 (+ x) (+ y)))
+  ;;(ukt::trc "ogl-pen-moving" x y)
+  (gl-bitmap 0 0 0 0 x y))
 
 (defclass ogl-texture ()
   ((texture-name :accessor texture-name :initform nil)