Update of /project/cello/cvsroot/cl-opengl In directory common-lisp.net:/tmp/cvs-serv29876

Modified Files: cl-opengl.lisp gl-constants.lisp gl-functions.lisp glu-functions.lisp nehe-14.lisp ogl-macros.lisp ogl-utils.lisp Log Message: Filling in omitted subdirectory Date: Fri Jul 8 18:26:48 2005 Author: ktilton

Index: cl-opengl/cl-opengl.lisp diff -u cl-opengl/cl-opengl.lisp:1.1 cl-opengl/cl-opengl.lisp:1.2 --- cl-opengl/cl-opengl.lisp:1.1 Wed May 25 05:14:30 2005 +++ cl-opengl/cl-opengl.lisp Fri Jul 8 18:26:47 2005 @@ -31,8 +31,8 @@ #:glut-get-window #:glut-set-window #:glut-post-redisplay - #:with-matrix - #:with-attrib + #:with-matrix #:with-matrix-mode + #:with-attrib #:with-client-attrib #:with-gl-begun #:gl-pushm #:gl-popm

Index: cl-opengl/gl-constants.lisp diff -u cl-opengl/gl-constants.lisp:1.1 cl-opengl/gl-constants.lisp:1.2 --- cl-opengl/gl-constants.lisp:1.1 Wed May 25 05:14:30 2005 +++ cl-opengl/gl-constants.lisp Fri Jul 8 18:26:47 2005 @@ -347,6 +347,9 @@ (dfc gl_texture_matrix #x0ba8) (dfc gl_attrib_stack_depth #x0bb0) (dfc gl_client_attrib_stack_depth #x0bb1) +(dfc gl_client_pixel_store_bit #x00000001) +(dfc gl_client_vertex_array_bit #x00000002) +(dfc gl_client_all_attrib_bits #xffffffff) (dfc gl_alpha_test #x0bc0) (dfc gl_alpha_test_func #x0bc1) (dfc gl_alpha_test_ref #x0bc2)

Index: cl-opengl/gl-functions.lisp diff -u cl-opengl/gl-functions.lisp:1.1 cl-opengl/gl-functions.lisp:1.2 --- cl-opengl/gl-functions.lisp:1.1 Wed May 25 05:14:31 2005 +++ cl-opengl/gl-functions.lisp Fri Jul 8 18:26:47 2005 @@ -162,8 +162,12 @@ (defun-ffx :void "open-gl" "glTexParameterfv" (glenum target glenum pname glfloat *params)) (defun-ffx :void "open-gl" "glTexParameteri" (glenum target glenum pname glint param)) (defun-ffx :void "open-gl" "glTexParameteriv" (glenum target glenum pname glint *params)) -;;;(defun-ffx :void "open-gl" "glTexSubImage1D" (GLenum target GLint level GLint xoffset GLsizei width GLenum format GLenum type GLvoid *pixels)) -;;;(defun-ffx :void "open-gl" "glTexSubImage2D" (GLenum target GLint level GLint xoffset GLint yoffset GLsizei width GLsizei height GLenum format GLenum type GLvoid *pixels)) +(defun-ffx :void "open-gl" "glTexSubImage1D" (GLenum target GLint level GLint xoffset + GLsizei width + GLenum format GLenum type GLvoid *pixels)) +(defun-ffx :void "open-gl" "glTexSubImage2D" (GLenum target GLint level GLint xoffset + GLint yoffset GLsizei width GLsizei height + GLenum format GLenum type GLvoid *pixels))

(defun-ffx :void "open-gl" "glGenTextures" (glsizei n gluint *textures)) (defun-ffx :void "open-gl" "glBindTexture" (glenum target gluint texture)) @@ -346,14 +350,34 @@ (defun-ogl :void "open-gl" "glTranslatef" (glfloat x glfloat y glfloat z ))

(defun-ogl :void "open-gl" "glBitmap" (glsizei width glsizei height - glfloat xorig glfloat yorig - glfloat xmove glfloat ymove)) - + glfloat xorig glfloat yorig + glfloat xmove glfloat ymove + char *data)) + +#+not +(DEFUN-FFX :VOID "open-gl" "glBitmap" + (GLSIZEI WIDTH GLSIZEI HEIGHT + GLFLOAT XORIG GLFLOAT YORIG + GLFLOAT XMOVE GLFLOAT YMOVE + GLbyte *DATA)) + +#+not +(DEF-FUNCTION ("glBitmap" GLBITMAP) + ((WIDTH GLSIZEI) (HEIGHT GLSIZEI) (XORIG GLFLOAT) (YORIG GLFLOAT) (XMOVE GLFLOAT) + (YMOVE GLFLOAT) (*DATA :pointer-void)) + :RETURNING :VOID :MODULE "open-gl" + :call-direct t) + +;;;(FF:DEF-FOREIGN-CALL (GLBITMAP "glBitmap") +;;; ((WIDTH GLSIZEI) (HEIGHT GLSIZEI) (XORIG GLFLOAT) (YORIG GLFLOAT) (XMOVE GLFLOAT) +;;; (YMOVE GLFLOAT) (*DATA (* :void))) +;;; :RETURNING :VOID :CALL-DIRECT T :STRINGS-CONVERT NIL)

(defun-ogl :void "open-gl" "glReadPixels" ( glint x glint y glsizei width glsizei height glenum format glenum type glvoid *pixels ))

(defun-ogl :void "open-gl" "glDrawPixels" (glsizei width glsizei height glenum format glenum type glvoid *pixels)) + (defun-ogl :void "open-gl" "glCopyPixels" ( glint x glint y glsizei width glsizei height glenum type ))

#| stenciling |#

Index: cl-opengl/glu-functions.lisp diff -u cl-opengl/glu-functions.lisp:1.2 cl-opengl/glu-functions.lisp:1.3 --- cl-opengl/glu-functions.lisp:1.2 Wed Jun 15 23:09:09 2005 +++ cl-opengl/glu-functions.lisp Fri Jul 8 18:26:47 2005 @@ -156,8 +156,9 @@

(defun-ogl (* glubyte) "gl-util" "gluErrorString" (glenum error)) ;;;(defun-ogl GLubyte *"gl-util" "gluGetString" (GLenum name)) -;;;(defun-ogl void "gl-util" "gluGetTessProperty" (GLUtesselator *tess GLenum which GLdouble *data)) -;;;(defun-ogl void "gl-util" "gluLoadSamplingMatrices" (GLUnurbs *nurb GLfloat *model GLfloat *perspective GLint *view)) +(defun-ogl :void "gl-util" "gluGetTessProperty" (:void *tess GLenum which GLdouble *data)) + +;;;(defun-ogl :void "gl-util" "gluLoadSamplingMatrices" (GLUnurbs *nurb GLfloat *model GLfloat *perspective GLint *view))

(defun-ogl :int "gl-util" "gluBuild2DMipmaps" (glenum target glint components @@ -196,11 +197,10 @@ (defun-ogl :void "gl-util" "gluNurbsProperty" (:void *nurb GLenum property GLfloat value)) (defun-ogl :void "gl-util" "gluNurbsSurface" (:void *nurb GLint sKnotCount GLfloat *sKnots GLint tKnotCount GLfloat *tKnots GLint sStride GLint tStride GLfloat *control GLint sOrder GLint tOrder GLenum type))

-;;;(defun-ogl GLUtesselator *"gl-util" "gluNewTess" ()) -;;;(defun-ogl void "gl-util" "gluNextContour" (GLUtesselator *tess GLenum type)) +(defun-ogl :void "gl-util" "gluNextContour" (:void *tess GLenum type)) (defun-ogl :void "gl-util" "gluOrtho2D" (GLdouble left GLdouble right GLdouble bottom GLdouble top)) -;;;(defun-ogl void "gl-util" "gluPartialDisk" (GLUquadric *quad GLdouble inner GLdouble outer GLint slices GLint loops GLdouble start GLdouble sweep)) +;;;(defun-ogl :void "gl-util" "gluPartialDisk" (GLUquadric *quad GLdouble inner GLdouble outer GLint slices GLint loops GLdouble start GLdouble sweep))

(defun-ogl :void "gl-util" "gluPerspective" (gldouble fovy gldouble aspect gldouble z-near gldouble z-far)) @@ -208,20 +208,24 @@ (defun-ogl glint "gl-util" "gluProject" (gldouble obj-x gldouble obj-y gldouble obj-z gldouble *model gldouble *proj glint *view gldouble *winx gldouble *winy gldouble *winz)) -;;;(defun-ogl void "gl-util" "gluPwlCurve" (GLUnurbs *nurb GLint count GLfloat *data GLint stride GLenum type)) -;;;(defun-ogl void "gl-util" "gluQuadricDrawStyle" (GLUquadric *quad GLenum draw)) -;;;(defun-ogl void "gl-util" "gluQuadricNormals" (GLUquadric *quad GLenum normal)) -;;;(defun-ogl void "gl-util" "gluQuadricOrientation" (GLUquadric *quad GLenum orientation)) -(defun-ogl :void "gl-util" "gluQuadricTexture" (:void *quad glboolean texture)) +;;;(defun-ogl :void "gl-util" "gluPwlCurve" (GLUnurbs *nurb GLint count GLfloat *data GLint stride GLenum type)) +;;;(defun-ogl :void "gl-util" "gluQuadricDrawStyle" (GLUquadric *quad GLenum draw)) +;;;(defun-ogl :void "gl-util" "gluQuadricNormals" (GLUquadric *quad GLenum normal)) +;;;(defun-ogl :void "gl-util" "gluQuadricOrientation" (GLUquadric *quad GLenum orientation)) +(defun-ogl :void "gl-util" "gluQuadricTexture" (:void *quad glint texture)) ;;;(defun-ogl GLint "gl-util" "gluScaleImage" (GLenum format GLsizei wIn GLsizei hIn GLenum typeIn void *dataIn GLsizei wOut GLsizei hOut GLenum typeOut GLvoid *dataOut)) -;;;(defun-ogl void "gl-util" "gluSphere" (GLUquadric *quad GLdouble radius GLint slices GLint stacks)) -;;;(defun-ogl void "gl-util" "gluTessBeginContour" (GLUtesselator *tess)) -;;;(defun-ogl void "gl-util" "gluTessBeginPolygon" (GLUtesselator *tess GLvoid *data)) -;;;(defun-ogl void "gl-util" "gluTessEndContour" (GLUtesselator *tess)) -;;;(defun-ogl void "gl-util" "gluTessEndPolygon" (GLUtesselator *tess)) -;;;(defun-ogl void "gl-util" "gluTessNormal" (GLUtesselator *tess GLdouble valueX GLdouble valueY GLdouble valueZ)) -;;;(defun-ogl void "gl-util" "gluTessProperty" (GLUtesselator *tess GLenum which GLdouble data)) -;;;(defun-ogl void "gl-util" "gluTessVertex" (GLUtesselator *tess GLdouble *location GLvoid *data)) +;;;(defun-ogl :void "gl-util" "gluSphere" (GLUquadric *quad GLdouble radius GLint slices GLint stacks)) + (defun-ogl glint "gl-util" "gluUnProject" (gldouble winx gldouble winy gldouble winz gldouble *model gldouble *proj glint *view gldouble *obj-x gldouble *obj-y gldouble *obj-z)) +(defun-ogl (* :void) "gl-util" "gluNewTess" ()) +(defun-ogl :void "gl-util" "gluDeleteTess" (:void *tess)) +(defun-ogl :void "gl-util" "gluTessBeginContour" (:void *tess)) +(defun-ogl :void "gl-util" "gluTessBeginPolygon" (:void *tess GLvoid *data)) +(defun-ogl :void "gl-util" "gluTessEndContour" (:void *tess)) +(defun-ogl :void "gl-util" "gluTessEndPolygon" (:void *tess)) +(defun-ogl :void "gl-util" "gluTessNormal" (:void *tess GLdouble valueX GLdouble valueY GLdouble valueZ)) +(defun-ogl :void "gl-util" "gluTessProperty" (:void *tess GLenum which GLdouble data)) +(defun-ogl :void "gl-util" "gluTessVertex" (:void *tess GLdouble *location GLvoid *data)) +(defun-ogl :void "gl-util" "gluTessCallback" (:void *tess GLenum which :void *callback))

Index: cl-opengl/nehe-14.lisp diff -u cl-opengl/nehe-14.lisp:1.1 cl-opengl/nehe-14.lisp:1.2 --- cl-opengl/nehe-14.lisp:1.1 Wed May 25 05:14:31 2005 +++ cl-opengl/nehe-14.lisp Fri Jul 8 18:26:47 2005 @@ -29,7 +29,7 @@ (ff-defun-callable :cdecl :void nh14disp () (nh14-disp))

- +#+not (defun nh14-disp () (gl-load-identity) ;; Reset The Current Modelview Matrix (gl-clear-color 0.0 0.0 0.0 0.5) @@ -42,7 +42,7 @@ (gl-rotatef g_rot 1.0f0 0.0f0 0.0f0) ;; Rotate On The X Axis (gl-rotatef (* g_rot 1.5f0) 0.0f0 1.0f0 0.0f0) ;; Rotate On The Y Axis (gl-rotatef (* g_rot 1.4f0) 0.0f0 0.0f0 1.0f0) ;; Rotate On The Z Axis - (gl-scalef 0.002 0.003 0.0) + (gl-scalef 0.002 0.003 0.002)

;; Pulsing Colors Based On The Rotation (gl-color3f (* 1.0f0 (cos (/ g_rot 20.0f0))) @@ -54,6 +54,33 @@ (glut-stroke-string (ffi-glut-id glut_stroke_roman) (format nil "NeHe - ~a" (/ g_rot 50.0))))

+ (gl-line-width 1) + (glut-wire-teapot 1000) + + (incf g_rot 0.4f0) + + (glut-swap-buffers) + (glut-post-redisplay)) + +(defun nh14-disp () + (gl-load-identity) ;; Reset The Current Modelview Matrix + (gl-clear-color 0.0 0.0 0.0 0.5) + (gl-clear (+ gl_color_buffer_bit gl_depth_buffer_bit)) + + (gl-translatef 0.0f0 0.0f0 2.0f0) ;; Move Into The Screen + + (gl-rotatef g_rot 1.0f0 0.0f0 0.0f0) ;; Rotate On The X Axis + (gl-rotatef (* g_rot 1.5f0) 0.0f0 1.0f0 0.0f0) ;; Rotate On The Y Axis + (gl-rotatef (* g_rot 1.4f0) 0.0f0 0.0f0 1.0f0) ;; Rotate On The Z Axis + + ;; Pulsing Colors Based On The Rotation + (gl-color3f (* 1.0f0 (cos (/ g_rot 20.0f0))) + (* 1.0f0 (sin (/ g_rot 25.0f0))) + (- 1.0f0 (* 0.5f0 (cos (/ g_rot 17.0f0))))) + + (gl-line-width 1) + (glut-wire-teapot 1) + (incf g_rot 0.4f0)

(glut-swap-buffers)

Index: cl-opengl/ogl-macros.lisp diff -u cl-opengl/ogl-macros.lisp:1.1 cl-opengl/ogl-macros.lisp:1.2 --- cl-opengl/ogl-macros.lisp:1.1 Wed May 25 05:14:31 2005 +++ cl-opengl/ogl-macros.lisp Fri Jul 8 18:26:47 2005 @@ -41,6 +41,16 @@ (funcall matrix-fn)) (gl-pop-matrix)))

+ +(defparameter *matrix-mode* GL_MODELVIEW) +(defmacro with-matrix-mode (mode &body body) + `(unwind-protect + (let ((*matrix-mode* ,mode)) + (glMatrixMode *matrix-mode*) + ,@body) + (glMatrixMode *matrix-mode*))) + + #+debugversion (defun call-with-matrix (load-identity-p matrix-fn matrix-code) (let ((mm-pushed (ogl::get-matrix-mode)) @@ -83,6 +93,21 @@ (funcall attrib-fn) (glec :with-attrib)) (gl-pop-attrib) + )) + +(defmacro with-client-attrib ((&rest attribs) &body body) + `(call-with-client-attrib + ,(apply '+ (mapcar 'symbol-value attribs)) + (lambda () ,@body))) + +(defun call-with-client-attrib (attrib-mask attrib-fn) + (gl-push-client-attrib attrib-mask) + (glec :with-client-attrib-push) + (unwind-protect + (prog1 + (funcall attrib-fn) + (glec :with-client-attrib)) + (gl-pop-client-attrib) ))

(defvar *gl-begun*)

Index: cl-opengl/ogl-utils.lisp diff -u cl-opengl/ogl-utils.lisp:1.2 cl-opengl/ogl-utils.lisp:1.3 --- cl-opengl/ogl-utils.lisp:1.2 Wed Jun 15 23:09:09 2005 +++ cl-opengl/ogl-utils.lisp Fri Jul 8 18:26:47 2005 @@ -205,7 +205,7 @@

(defun ogl-pen-move (x y) ;;(ukt::trc "ogl-pen-moving" x y) - (gl-bitmap 0 0 0 0 x y)) + (gl-bitmap 0 0 0 0 x y (uffi:make-null-pointer '(:array :cstring))))

(defclass ogl-texture () ((texture-name :accessor texture-name :initform nil)