[cello-cvs] CVS update: cl-opengl/cl-opengl.lisp cl-opengl/gl-constants.lisp cl-opengl/gl-functions.lisp cl-opengl/glu-functions.lisp cl-opengl/nehe-14.lisp cl-opengl/ogl-macros.lisp cl-opengl/ogl-utils.lisp
Kenny Tilton
ktilton at common-lisp.net
Fri Jul 8 16:26:51 UTC 2005
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*)
+ , at 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 () , at 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)
More information about the Cello-cvs
mailing list