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$ (,@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 ,@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)