Update of /project/cello/cvsroot/cl-opengl In directory clnet:/tmp/cvs-serv23051
Modified Files: cl-opengl-config.lisp cl-opengl.asd cl-opengl.lisp cl-opengl.lpr gl-def.lisp gl-functions.lisp glu-functions.lisp glut-extras.lisp glut-functions.lisp nehe-14.lisp ogl-macros.lisp ogl-utils.lisp Log Message: Bringing this up to date for Celtk Geras demo and Cello2
--- /project/cello/cvsroot/cl-opengl/cl-opengl-config.lisp 2005/06/15 21:09:09 1.2 +++ /project/cello/cvsroot/cl-opengl/cl-opengl-config.lisp 2006/05/13 21:33:48 1.3 @@ -21,24 +21,3 @@ ;;; IN THE SOFTWARE.
(in-package :cl-opengl) - -(defparameter *gl-dynamic-lib* - (make-pathname - #+lispworks :host #-lispworks :device "c" - :directory '(:absolute "windows" "system32") - :name "opengl32" - :type "dll")) - -(defparameter *glu-dynamic-lib* - (make-pathname - #+lispworks :host #-lispworks :device "c" - :directory '(:absolute "windows" "system32") - :name "glu32" - :type "dll")) - -(defparameter *glut-dynamic-lib* - (make-pathname - #+lispworks :host #-lispworks :device "c" - :directory '(:absolute "0dev" "user" "dynlib") - :name "freeglut" - :type "dll")) \ No newline at end of file --- /project/cello/cvsroot/cl-opengl/cl-opengl.asd 2005/05/25 03:14:30 1.1 +++ /project/cello/cvsroot/cl-opengl/cl-opengl.asd 2006/05/13 21:33:48 1.2 @@ -1,12 +1,13 @@ ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;(declaim (optimize (debug 2) (speed 1) (safety 1) (compilation-speed 1))) -(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0))) +;(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
(in-package :asdf)
-#+(or allegro lispworks cmu mcl cormanlisp sbcl scl) +#-(or openmcl sbcl cmu clisp lispworks ecl allegro cormanlisp) +(error "Sorry, this Lisp is not yet supported. Patches welcome!")
(defsystem cl-opengl :name "cl-opengl" @@ -18,17 +19,17 @@ :long-description "Bindings to most of OpenGL, more on demand" :perform (load-op :after (op cl-opengl) (pushnew :cl-opengl cl:*features*)) - :depends-on (:utils-kt :ffi-extender) + :depends-on (:hello-cffi) :serial t :components ((:file "cl-opengl") (:file "gl-def" :depends-on ("cl-opengl")) (:file "gl-constants" :depends-on ("gl-def")) (:file "gl-functions" :depends-on ("gl-def")) (:file "glu-functions" :depends-on ("gl-def")) - (:file "glut-functions" :depends-on ("gl-def")) - (:file "glut-def" :depends-on ("gl-def")) - (:file "glut-extras" :depends-on ("gl-def")) + (:file "glut-loader" :depends-on ("cl-opengl")) + (:file "glut-functions" :depends-on ("glut-loader")) + (:file "glut-def" :depends-on ("glut-loader")) + (:file "glut-extras" :depends-on ("glut-loader")) (:file "ogl-macros" :depends-on ("gl-def")) - (:file "ogl-utils" :depends-on ("gl-def")) - (:file "nehe-14" :depends-on ("gl-def")) - )) + (:file "ogl-utils" :depends-on ("ogl-macros")) + (:file "nehe-14" :depends-on ("ogl-macros")))) --- /project/cello/cvsroot/cl-opengl/cl-opengl.lisp 2005/07/08 16:26:47 1.2 +++ /project/cello/cvsroot/cl-opengl/cl-opengl.lisp 2006/05/13 21:33:48 1.3 @@ -1,5 +1,4 @@ ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cl-opengl; -*- -;;________________________________________________________ ;; ;;; ;;; Copyright © 2004 by Kenneth William Tilton. @@ -26,31 +25,17 @@
(defpackage #:cl-opengl (:nicknames #:ogl) - (:use #:common-lisp #:ffx) + (:use #:common-lisp #:cffi #:ffx) (:export #:*ogl-listing-p* - #:glut-get-window - #:glut-set-window - #:glut-post-redisplay #:with-matrix #:with-matrix-mode #:with-attrib #:with-client-attrib #:with-gl-begun #:gl-pushm #:gl-popm - #:glut-callback-set #:cl-opengl-init #:closed-stream-p #:*selecting* #:cl-opengl-reset - #:cl-opengl-set-home-dir - #:cl-opengl-get-home-dir - #:cl-glut-set-home-dir - #:cl-glut-get-home-dir - #:cl-opengl-set-gl-dll-filename - #:cl-opengl-get-gl-dll-filename - #:cl-opengl-set-glu-dll-filename - #:cl-opengl-get-glu-dll-filename - #:cl-glut-set-dll-filename - #:cl-glut-get-dll-filename #:ogl-texture #:ncalc-normalf #:ncalc-normalfv #:ogl-get-int #:ogl-get-boolean #:v3f #:make-v3f #:v3f-x #:v3f-y #:v3f-z @@ -61,24 +46,73 @@ #:ogl-pen-move #:with-bitmap-shifted #:texture-name #:eltgli #:ogl-tex-activate #:gl-name - #:mgwclose #:freeg #:glut-bitmap-string #:glut-stroke-string)) + #:mgwclose #:freeg))
(in-package :cl-opengl)
-(defparameter *opengl-dll* nil) +(defparameter *selecting* nil) + +(push (make-pathname + :directory '(:absolute "0devtools" "cffi")) + asdf:*central-registry*) + +(push (make-pathname + :directory '(:absolute "0devtools" "verrazano-support")) + asdf:*central-registry*) + +(defparameter *gl-dynamic-lib* + #+(or win32 windows mswindows) + (make-pathname + ;; #+lispworks :host #-lispworks :device "C" + :directory '(:absolute "windows" "system32") + :name "opengl32" + :type "dll") + #+(or darwin unix powerpc) + (make-pathname + :directory '(:absolute "System" "Library" "Frameworks" + "OpenGL.framework" "Versions" "Current") + :name "OpenGL" + :type nil)) + +(defparameter *glu-dynamic-lib* + #+(or win32 windows mswindows) + (make-pathname + ;;; #+lispworks :host #-lispworks :device "C" + :directory '(:absolute "windows" "system32") + :name "glu32" + :type "dll") + #+(or darwin unix powerpc) + (make-pathname + :directory '(:absolute "System" "Library" "Frameworks" + "GLU.framework" "Versions" "Current") + :name "GLU" + :type nil)) + +(defvar *opengl-dll* nil) + +(defun cl-opengl-load () + (declare (ignorable load-oglfont-p)) + (unless *opengl-dll* + (print "loading open GL/GLU") + (ffx:load-foreign-library (namestring *gl-dynamic-lib*)) ; :module "open-gl") + ;; -lispworks#-lispworks + (setf *opengl-dll* + (ffx:load-foreign-library + (namestring *glu-dynamic-lib*))))) + +(eval-when (load eval) + (cl-opengl-load))
(defun gl-boolean-test (value) #+allegro (not (eql value #\null)) #-allegro (not (zerop value)))
+#+yeahyeah (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)) + when (gl-boolean-test (glislist lx)) do (if start (if end (if (eql lx (1+ end)) @@ -87,4 +121,31 @@ (if (eql lx (1+ start)) (setf end lx) (print `(gl ,start)))) - (setf start lx)))) \ No newline at end of file + (setf start lx)))) + + +(dfenum storagetype + char-pixel + short-pixel + integer-pixel + long-pixel + float-pixel + double-pixel) + +(dfenum filtertypes + undefined-filter + point-filter + box-filter + triangle-filter + hermite-filter + hanning-filter + hamming-filter + blackman-filter + gaussian-filter + quadratic-filter + cubic-filter + catrom-filter + mitchell-filter + lanczos-filter + bessel-filter + sinc-filter) \ No newline at end of file --- /project/cello/cvsroot/cl-opengl/cl-opengl.lpr 2005/06/15 21:09:09 1.2 +++ /project/cello/cvsroot/cl-opengl/cl-opengl.lpr 2006/05/13 21:33:48 1.3 @@ -1,24 +1,21 @@ -;; -*- lisp-version: "7.0 [Windows] (Jun 10, 2005 13:34)"; cg: "1.54.2.17"; -*- +;; -*- lisp-version: "8.0 [Windows] (May 5, 2006 15:39)"; cg: "1.81"; -*-
(in-package :cg-user)
(defpackage :CL-OPENGL)
(define-project :name :cl-opengl - :modules (list (make-instance 'module :name "cl-opengl-config.lisp") - (make-instance 'module :name "cl-opengl.lisp") + :modules (list (make-instance 'module :name "cl-opengl.lisp") (make-instance 'module :name "gl-def.lisp") (make-instance 'module :name "gl-constants.lisp") (make-instance 'module :name "gl-functions.lisp") (make-instance 'module :name "glu-functions.lisp") - (make-instance 'module :name "glut-functions.lisp") - (make-instance 'module :name "glut-def.lisp") - (make-instance 'module :name "glut-extras.lisp") (make-instance 'module :name "ogl-macros.lisp") - (make-instance 'module :name "ogl-utils.lisp") - (make-instance 'module :name "nehe-14.lisp")) + (make-instance 'module :name "ogl-utils.lisp")) :projects (list (make-instance 'project-module :name - "c:\0dev\hello-c\hello-c")) + "..\cells\utils-kt\utils-kt") + (make-instance 'project-module :name + "..\hello-cffi\hello-cffi")) :libraries nil :distributed-files nil :internally-loaded-files nil --- /project/cello/cvsroot/cl-opengl/gl-def.lisp 2005/05/25 03:14:30 1.1 +++ /project/cello/cvsroot/cl-opengl/gl-def.lisp 2006/05/13 21:33:48 1.2 @@ -30,7 +30,7 @@
(defun aforef (o n) - (uffi:deref-array o '(:array :int) n)) + (mem-aref o :int n))
(dft glenum #-allegro-v5.0.1 :unsigned-int #+allegro-v5.0.1 :int integer) @@ -42,18 +42,21 @@ (dft gluint #-allegro-v5.0.1 :unsigned-int #+allegro-v5.0.1 :int integer) (dft glushort #-allegro-v5.0.1 :unsigned-int #+allegro-v5.0.1 :int integer)
-(dft glfloat #+lispworks :lisp-single-float #-lispworks :float single-float) -(dft glclampf #+lispworks :lisp-single-float #-lispworks :float single-float) +(dft glfloat :float single-float) +(dft glclampf :float single-float) + +;;;(dft glfloat #+lispworks :lisp-single-float #-lispworks :float single-float) +;;;(dft glclampf #+lispworks :lisp-single-float #-lispworks :float single-float)
(dft gldouble :double double-float) (dft glclampd :double double-float)
-(dft glboolean :unsigned-byte #+allegro character #-allegro number) -(dft glbyte :byte #+allegro character #-allegro number) ;; typedef signed char GLbyte; +(dft glboolean :unsigned-char #+allegro character #-allegro number) +(dft glbyte :char #+allegro character #-allegro number) ;; typedef signed char GLbyte; (dft glvoid :void integer)
(dft glshort #-allegro-v5.0.1 :short #+allegro-v5.0.1 :int integer) -(dft glubyte :unsigned-byte #+allegro character #-allegro number) +(dft glubyte :unsigned-char #+allegro character #-allegro number)
--- /project/cello/cvsroot/cl-opengl/gl-functions.lisp 2005/07/08 16:26:47 1.2 +++ /project/cello/cvsroot/cl-opengl/gl-functions.lisp 2006/05/13 21:33:48 1.3 @@ -23,10 +23,11 @@ (in-package #:cl-opengl)
(defparameter *ogl-listing-p* nil) -(defun-ogl :void "open-gl" "glFlush" ()) +
(defun-ogl :void "open-gl" "glMaterialfv" (glenum face glenum pname glfloat *params))
+(defun-ogl :void "open-gl" "glFlush" ())
#| drawing functions |#
@@ -77,6 +78,7 @@ (defun-ogl :void "open-gl" "glIndexiv" (glint *c )) (defun-ogl :void "open-gl" "glIndexsv" (glshort *c )) (defun-ogl :void "open-gl" "glIndexubv" (glubyte *c )) + (defun-ogl :void "open-gl" "glColor3b" (glbyte red glbyte green glbyte blue )) (defun-ogl :void "open-gl" "glColor3d" (gldouble red gldouble green gldouble blue )) (defun-ogl :void "open-gl" "glColor3f" (glfloat red glfloat green glfloat blue )) @@ -354,14 +356,14 @@ glfloat xmove glfloat ymove char *data))
-#+not +#+(or) (DEFUN-FFX :VOID "open-gl" "glBitmap" (GLSIZEI WIDTH GLSIZEI HEIGHT GLFLOAT XORIG GLFLOAT YORIG GLFLOAT XMOVE GLFLOAT YMOVE GLbyte *DATA))
-#+not +#+(or) (DEF-FUNCTION ("glBitmap" GLBITMAP) ((WIDTH GLSIZEI) (HEIGHT GLSIZEI) (XORIG GLFLOAT) (YORIG GLFLOAT) (XMOVE GLFLOAT) (YMOVE GLFLOAT) (*DATA :pointer-void)) @@ -405,4 +407,4 @@ (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)) \ No newline at end of file +(defun-ogl :void "open-gl" "glListBase" (gluint base)) --- /project/cello/cvsroot/cl-opengl/glu-functions.lisp 2005/07/08 16:26:47 1.3 +++ /project/cello/cvsroot/cl-opengl/glu-functions.lisp 2006/05/13 21:33:48 1.4 @@ -225,7 +225,19 @@ (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" "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)) + +#+save +(PROGN + (ffx:DEF-FUNCTION ("gluTessVertex" GLUTESSVERTEX) + ((*TESS (* :VOID)) (*LOCATION (* (:array GLDOUBLE))) (*DATA (* GLVOID))) :RETURNING :VOID :MODULE + "gl-util") + (DEFUN GLU-TESS-VERTEX (*TESS *LOCATION *DATA) + (LET ((tess *TESS) (loc *LOCATION) (dat *DATA)) + (PROG1 (GLUTESSVERTEX tess loc dat) (PROGN (GLEC '|gluTessVertex|))))) + (EVAL-WHEN (COMPILE EVAL LOAD) (EXPORT '(GLUTESSVERTEX GLU-TESS-VERTEX)))) + (defun-ogl :void "gl-util" "gluTessCallback" (:void *tess GLenum which :void *callback)) --- /project/cello/cvsroot/cl-opengl/glut-extras.lisp 2005/05/25 03:14:31 1.1 +++ /project/cello/cvsroot/cl-opengl/glut-extras.lisp 2006/05/13 21:33:48 1.2 @@ -26,8 +26,7 @@ (eval-when (compile eval load) (export '(ffi-glut-id glut-callback-set glut-callbacks-set cl-glut-init xfg)))
-(defparameter *glut-dll* nil) - +#+dead? (defun xfg () #+allegro (dolist (lib '("freeglut" "glu32" "opengl32")) @@ -40,16 +39,8 @@ (defparameter *mg-glut-display-busy* nil)
(defun cl-glut-init () - (cl-opengl-init) - (unless *glut-dll* - (print (list "loading GLUT" *glut-dynamic-lib* (probe-file *glut-dynamic-lib*))) - (assert (setq *glut-dll* (uffi:load-foreign-library *glut-dynamic-lib* - :force-load #+lispworks nil #-lispworks t - :module "glut")) - () "Unable to load GLUT from: ~a" *glut-dynamic-lib* )) - - (let ((glut-state (glutget (coerce glut_init_state 'integer)))) - (format t "~&glut state 2 ~a" glut-state) + (let ((glut-state (glutget (coerce +glut-init-state+ 'integer)))) + (format t "~&cl-glut-init > glut state ~a" glut-state) (if (zerop glut-state) (progn (print "about to initialize") @@ -57,7 +48,7 @@ (setf (eltf argc 0) 0) (unwind-protect (progn - (glut-init argc (uffi:make-null-pointer '(:array :cstring))) + (glutInit argc (make-null-pointer '(:array :cstring))) (print "glut initialised") ) (fgn-free argc)))) @@ -73,50 +64,39 @@ (or (not (zerop (glgeterror))) (zerop w))))
-(let ((mm (uffi:allocate-foreign-object :int 1))) +(let ((mm (ffx:allocate-foreign-object :int 1))) (defun get-matrix-mode () - (glgetintegerv gl_matrix_mode mm) - (uffi:deref-array mm '(:array :int) 0))) + (glgetintegerv +gl-matrix-mode+ mm) + (ffx:deref-array mm '(:array :int) 0)))
-(let ((mm (uffi:allocate-foreign-object :int 1)) - (sd (uffi:allocate-foreign-object :int 1))) +(let ((mm (ffx:allocate-foreign-object :int 1)) + (sd (ffx:allocate-foreign-object :int 1))) (defun get-stack-depth () - (glgetintegerv gl_matrix_mode mm) - (let ((mmi (uffi:deref-array mm '(:array :int) 0))) + (glgetintegerv +gl-matrix-mode+ mm) + (let ((mmi (ffx:deref-array mm '(:array :int) 0))) (glgetintegerv (cond - ((eql mmi gl_modelview) gl_modelview_stack_depth) - ((eql mmi gl_projection) gl_projection_stack_depth) - ((eql mmi gl_texture) gl_texture_stack_depth) + ((eql mmi +gl-modelview+) +gl-modelview-stack-depth+) + ((eql mmi +gl-projection+) +gl-projection-stack-depth+) + ((eql mmi +gl-texture+) +gl-texture-stack-depth+) (t (break "bad matrix"))) sd) - (uffi:deref-array sd '(:array :int) 0)))) + (ffx:deref-array sd '(:array :int) 0))))
(defun cello-matrix-mode (&optional (tag :anon)) - (let ((mm (uffi:allocate-foreign-object :int 1)) + (let ((mm (ffx:allocate-foreign-object :int 1)) ) - (glgetintegerv gl_matrix_mode mm) - (let ((mmi (uffi:deref-array mm '(:array :int) 0))) + (glgetintegerv +gl-matrix-mode+ mm) + (let ((mmi (ffx:deref-array mm '(:array :int) 0))) (unwind-protect (cond - ((eql mmi gl_modelview) :model-view) - ((eql mmi gl_projection) :projection) - ((eql mmi gl_texture) :texture) + ((eql mmi +gl-modelview+) :model-view) + ((eql mmi +gl-projection+) :projection) + ((eql mmi +gl-texture+) :texture)
(t (break "gl-stack-depth> unexpected matrix mode ~a ~a" tag mmi))) - (uffi:free-foreign-object mm))))) + (ffx:free-foreign-object mm)))))
-(defun glut-stroke-string (font string) - "Font must already have been converted to a pointer, string must be Lisp string" - (dotimes (n (length string)) - ;;(print `(stroke ,n ,(elt string n))) - (glut-stroke-character font (coerce (char-code (elt string n)) 'integer)) - )) - -(defun glut-bitmap-string (font string) - "Font must already have been converted to a pointer, string must be Lisp string" - (loop for c across string - do (glut-bitmap-character font (char-code c))))
(defun glut-callback-set (setter settee) (when settee --- /project/cello/cvsroot/cl-opengl/glut-functions.lisp 2005/05/25 03:14:31 1.1 +++ /project/cello/cvsroot/cl-opengl/glut-functions.lisp 2006/05/13 21:33:48 1.2 @@ -55,25 +55,22 @@ (dfc glut_action_on_window_close #x01f9)
(defun-ffx :void "glut" "glutSetOption" (glenum e-what :int value)) -(defun-ffx :void "glut" "glutWCurrencyAssert" ()) -(defun-ffx :void "glut" "glutWCurrencySet" ()) -(defun-ffx :void "glut" "glutWFill" (:float r :float g :float b :float alpha)) -(defun-ffx :void "glut" "glutWFill2" (:float r :float g :float b :float alpha)) -(defun-ffx :void "glut" "glutWClearColor" (:float r :float g :float b :float alpha)) -(defun-ffx :void "glut" "glutWClear" ()) +;;;(defun-ffx :void "glut" "glutWFill" (:float r :float g :float b :float alpha)) +;;;(defun-ffx :void "glut" "glutWFill2" (:float r :float g :float b :float alpha)) +;;;(defun-ffx :void "glut" "glutWClearColor" (:float r :float g :float b :float alpha)) +;;;(defun-ffx :void "glut" "glutWClear" ())
(defun-ffx :int "glut" "glutCreateWindow" (:cstring title)) (defun-ffx :int "glut" "glutCreateSubWindow" (:int win :int x :int y :int width :int height)) (defun-ffx :void "glut" "glutDestroyWindow" (:int win)) -(defun-ffx :void "glut" "fgDeinitialize" ()) +;;;(defun-ffx :void "glut" "fgDeinitialize" ())
-(ff-defun-callable :cdecl :void mgwclose () + +(ff-defun-callable :cdecl :void mgwclose () (print "closing callback entered"))
-(defpackage #:cl-opengl - (:nicknames #:ogl) - (:use) - (:export #:mgwclose #:freeg #:glut-bitmap-string #:glut-stroke-string)) +(eval-when (compile load eval) + (export '(mgwclose freeg glut-bitmap-string glut-stroke-string)))
(defun freeg () t)
@@ -81,7 +78,7 @@ (defun-ffx :void "glut" "glutPostWindowRedisplay" (:int win)) (defun-ffx :void "glut" "glutSwapBuffers" ()) (defun-ffx :int "glut" "glutGetWindow" ()) -(defun-ffx :int "glut" "glutDestroyPending" ()) +;;;(defun-ffx :int "glut" "glutDestroyPending" ()) (defun-ffx :void "glut" "glutSetWindow" (:int win)) (defun-ffx :void "glut" "glutSetWindowTitle" (:cstring title)) (defun-ffx :void "glut" "glutSetIconTitle" (:cstring title)) @@ -96,9 +93,12 @@ (defun-ffx :void "glut" "glutSetCursor" (:int cursor)) (defun-ffx :void "glut" "glutWarpPointer" (:int x :int y))
-;;;(defun-ffx :void "glut" "glutInit" (integer argc integer argv)) no dice +
#-cormanlisp +(defun-ffx :void "glut" "glutInit" (:int *argc :void *argv)) + +#+original-cormanlisp (ff-def-call ("glut" glut-init "glutInit") ((argc (* :int)) (argv (* :void)))) @@ -115,7 +115,7 @@ (defun-ffx :void "glut" "glutInitDisplayString" (:cstring string)) (defun-ffx :void "glut" "glutLeaveMainLoop" ()) (defun-ffx :void "glut" "glutMainLoop" ()) -(defun-ffx :void "glut" "glutCheckLoop" ()) +;;;(defun-ffx :void "glut" "glutCheckLoop" ()) (defun-ffx :void "glut" "glutMainLoopEvent" ())
@@ -171,13 +171,16 @@
(defun-ffx :int "glut" "glutBitmapWidth" (:void *font :int character)) (defun-ffx :int "glut" "glutBitmapHeight" (:void *font)) -(defun-ffx glfloat "glut" "glutBitmapXOrig" (:void *font)) -(defun-ffx glfloat "glut" "glutBitmapYOrig" (:void *font)) +;;;(defun-ffx glfloat "glut" "glutBitmapXOrig" (:void *font)) +;;;(defun-ffx glfloat "glut" "glutBitmapYOrig" (:void *font))
(defun-ffx :void "glut" "glutStrokeCharacter" (:void *font :int character)) -(defun-ffx glfloat "glut" "glutStrokeDescent" (:void *font)) +;;;(DEF-FUNCTION ("glutStrokeCharacter" GLUTSTROKECHARACTER) +;;; ((*FONT (* :VOID)) (CHARACTER :INT)) :RETURNING :VOID :MODULE "glut") +;;;(CFFI:DEFCFUN ("glutStrokeCharacter" GLUTSTROKECHARACTER) :VOID (*FONT :POINTER) (CHARACTER :INT)) +;;;(defun-ffx glfloat "glut" "glutStrokeDescent" (:void *font))
-#+test +#+(or) (list (glut-bitmap-height glut_bitmap_times_roman_24) (glut-bitmap-width glut_bitmap_times_roman_24 (char-code #\h))) @@ -185,7 +188,7 @@ (defun-ffx :int "glut" "glutStrokeWidth" (:void *font :int character)) (defun-ffx glfloat "glut" "glutStrokeHeight" (:void *font))
-#+test +#+(or) (list (glut-stroke-height glut_stroke_mono_roman) (glut-stroke-width glut_stroke_roman (char-code #\h))) --- /project/cello/cvsroot/cl-opengl/nehe-14.lisp 2005/07/08 16:26:47 1.2 +++ /project/cello/cvsroot/cl-opengl/nehe-14.lisp 2006/05/13 21:33:48 1.3 @@ -22,154 +22,61 @@
(in-package :cl-opengl)
+ (defconstant wcx 640) ;; Window Width (defconstant wcy 480) ;; Window Height -(defparameter g_rot 0.0f0) - -(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) - (gl-clear (+ gl_color_buffer_bit gl_depth_buffer_bit)) - - (gl-translatef 0.0f0 0.0f0 2.0f0) ;; Move Into The Screen - - (font-glut-preview) - - (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.002) - - ;; 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))))) - - (with-matrix () - (gl-line-width 3) - (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) +(defparameter g-rot 0.0f0)
- (glut-swap-buffers) - (glut-post-redisplay)) - -#+test -(lesson-14)
-(defun font-glut-preview () - (with-matrix () - (gl-color3f 1 1 1) - (gl-scalef 0.007 0.007 0.0) - (loop for bitmap-font in - '(glut_bitmap_8_by_13 glut_bitmap_9_by_15 - glut_bitmap_helvetica_10 glut_bitmap_helvetica_12 glut_bitmap_helvetica_18 - glut_bitmap_times_roman_10 glut_bitmap_times_roman_24) - for id = (symbol-value bitmap-font) - for y-pos = -50 then (round (- y-pos (glut-bitmap-height (ffi-glut-id id)) 10)) - do - (assert (numberp id)) - #+shh (if (ogl-get-boolean gl_current_raster_position_valid) - (print (list :ok bitmap-font (glut-bitmap-height (ffi-glut-id id)) y-pos id)) - (trc "rasterpos offscreen" self :g-offset (g-offset self))) - (gl-raster-pos3i -250 y-pos 0) ;;(incf zpos 500)) - (glut-bitmap-string (ffi-glut-id id) (format nil "Hello, ~a" bitmap-font)))) - - (with-matrix () - (gl-translatef -2 1 0) - (gl-scalef 0.001 0.001 0.0) - (gl-line-width 3) - (loop for stroke-font in - '(glut_stroke_mono_roman glut_stroke_roman) - for id = (symbol-value stroke-font) - for y-pos = 0 then (round (- y-pos (* 1.1 (/ (glut-stroke-height (ffi-glut-id id)) 1)))) - do - (assert (numberp id)) - ;(print (list stroke-font (glut-stroke-height (ffi-glut-id id)) y-pos id)) - (gl-translatef 0 y-pos 0) - - (let ((msg (format nil "Hello, ~a ~a" (round (glut-stroke-height (ffi-glut-id id))) - stroke-font))) - (uffi:with-cstring (cc msg) - (glut-stroke-string (ffi-glut-id id) msg) - (gl-translatef (- (glut-stroke-length (ffi-glut-id id) cc)) - 0 0)))))) +(defparameter *disp-ct* 0) +(defvar *working-objects*)
-#+test -(lesson-14) +(ff-defun-callable :cdecl :void mgwclose () + (print "closing callback entered"))
+#+nextttt (defun lesson-14 (&optional (dispfunc 'nh14disp)) + (declare (ignorable dispfunc)) + (setf *disp-ct* 0 + *working-objects* (make-hash-table))
- (let ((*gl-begun* nil)) - (cl-glut-init) - (glut-set-option glut_action_on_window_close glut_action_glutmainloop_returns) - - (glut-init-display-mode (+ glut_rgb glut_double)) ;; Display Mode (Rgb And Double Buffered) - (glut-init-window-size 640 480) ;; Window Size If We Start In Windowed Mode - - (let ((key "NeHe's OpenGL Framework")) - (uffi:with-cstring (key-native key) - (glut-create-window key-native))) - - ;(init) ; // Our Initialization - ;; Set up the callbacks in OpenGL/GLUT - (glut-display-func (ff-register-callable dispfunc)) - (glut-wm-close-func (ff-register-callable 'mgwclose)) - (glut-keyboard-func (ff-register-callable 'mgwkey)) - - (gl-matrix-mode gl_projection) - (gl-load-identity) - (glu-perspective 70 1 1 1000) - (glu-look-at 0d0 0d0 5d0 0d0 0d0 0d0 0d0 1d0 0d0) - - (gl-matrix-mode gl_modelview) - (gl-load-identity) - - - (gl-clear-depth 1d0) - - (glutmainloop) - #+not (do () - ((zerop (glut-get-window))) - ;;(format t "before main loop ~a | ~&" (glut-get-window)) - (glutmainloopevent) - (sleep 0.08) - ))) + (progn ;; with-open-file (*standard-output* "/0dev/nh14.log" :direction :output :if-exists :new-version) + (let ((*gl-begun* nil)) + (cl-glut-init) + (glutsetoption +glut-action-on-window-close+ +glut-action-glutmainloop-returns+) + + (glutinitdisplaymode (+ +glut-rgb+ +glut-double+)) ;; Display Mode (Rgb And Double Buffered) + (glutinitwindowsize 640 480) ;; Window Size If We Start In Windowed Mode + + (let ((key "NeHe's OpenGL Framework")) + (uffi:with-cstring (key-native key) + (glutcreatewindow key-native))) + + ;(init) ; // Our Initialization + ;; Set up the callbacks in OpenGL/GLUT + (glutdisplayfunc (ff-register-callable dispfunc)) + (glutwmclosefunc (ff-register-callable 'mgwclose)) + (glutkeyboardfunc (ff-register-callable 'mgwkey)) + (glmatrixmode gl_projection) + (glloadidentity) + (gluperspective 70d0 1d0 1d0 1000d0) + (glulookat 0d0 0d0 5d0 0d0 0d0 0d0 0d0 1d0 0d0) + + (glmatrixmode gl_modelview) + (glloadidentity) + + + (glcleardepth 1d0) + (glutmainloop) + #+(or) (do () + ((zerop (glutgetwindow))) + ;;(format t "before main loop ~a | ~&" (glutgetwindow)) + (glutmainloopevent) + (sleep 0.08) + ))))
-#+test +#+(or) (lesson-14)
(ff-defun-callable :cdecl :void mgwkey ((k :int) (x :int) (y :int)) @@ -179,11 +86,53 @@ (defun mgwkeyi (k x y) (declare (ignorable k x y)) (print (list "mgwkey" k x y (glutgetwindow))) - (let ((mods (glut-get-modifiers))) + (let ((mods (glutgetmodifiers))) (declare (ignorable mods)) - (print (list :keyboard k mods x y (code-char (logand k #xff))#+not(glut-get-window))) + (print (list :keyboard k mods x y (code-char (logand k #xff))#+(or)(glut-get-window))) (case (code-char (logand k #xff)) (#\escape (progn (print (list "destroying window" (glutgetwindow) ) ) - (glut-destroy-window (glutgetwindow))))))) \ No newline at end of file + (glutDestroyWindow (glutgetwindow))))))) + +(ff-defun-callable :cdecl :void nh14disp () + (nh14-disp)) + +#+nexttttt +(defun nh14-disp () + (glloadidentity) ;; Reset The Current Modelview Matrix + + (glclearcolor 0.0 0.0 0.0 0.5) + (glclear (+ gl_color_buffer_bit gl_depth_buffer_bit)) + + (glTranslatef 0.0f0 0.0f0 2.0f0) ;; Move Into The Screen + + ;;(font-glut-preview) + + (glRotatef g-rot 1.0f0 0.0f0 0.0f0) ;; Rotate On The X Axis + (glRotatef (* g-rot 1.5f0) 0.0f0 1.0f0 0.0f0) ;; Rotate On The Y Axis + (glRotatef (* g-rot 1.4f0) 0.0f0 0.0f0 1.0f0) ;; Rotate On The Z Axis + (glScalef 0.002 0.003 0.002) + + ;; Pulsing Colors Based On The Rotation + (glcolor3f (* 1.0f0 (cos (/ g-rot 20.0f0))) + (* 1.0f0 (sin (/ g-rot 25.0f0))) + (- 1.0f0 (* 0.5f0 (cos (/ g-rot 17.0f0))))) + + (with-matrix () + (gllinewidth 3f0) + (let ((x (format nil "NeHe - ~a" (/ g-rot 50.0)))) + (with-cstring (msg x) + (glutstrokestring glut_stroke_roman msg)))) + + + (progn + (gllinewidth 1f0) + (glutwireteapot 1000d0)) + + (incf g-rot 0.10) + + (glutswapbuffers) + (glutPostRedisplay) + ) + --- /project/cello/cvsroot/cl-opengl/ogl-macros.lisp 2005/07/08 16:26:47 1.2 +++ /project/cello/cvsroot/cl-opengl/ogl-macros.lisp 2006/05/13 21:33:48 1.3 @@ -1,5 +1,4 @@ ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cl-opengl; -*- -;;________________________________________________________ ;; ;;; ;;; Copyright © 2004 by Kenneth William Tilton. @@ -33,16 +32,16 @@
(defun call-with-matrix (load-identity-p matrix-fn matrix-code) (declare (ignorable matrix-code)) - (gl-push-matrix) + (glPushMatrix) (unwind-protect (progn (when load-identity-p - (gl-load-identity)) + (glLoadIdentity)) (funcall matrix-fn)) - (gl-pop-matrix))) + (glpopmatrix)))
-(defparameter *matrix-mode* GL_MODELVIEW) +(defparameter *matrix-mode* gl_modelview) (defmacro with-matrix-mode (mode &body body) `(unwind-protect (let ((*matrix-mode* ,mode)) @@ -56,24 +55,24 @@ (let ((mm-pushed (ogl::get-matrix-mode)) (sd-pushed (ogl::get-stack-depth)))
- (gl-push-matrix) + (glPushMatrix) (glec :with-matrix-push) (unwind-protect (progn (when (eql gl_modelview_matrix mm-pushed) - (gl-get-integerv gl_modelview_stack_depth *stack-depth*) + (glgetintegerv gl_modelview_stack_depth *stack-depth*) (glec :get-stack-depth) (print `(with-matrix model matrix stack ,(aforef *stack-depth* 0))))
(when load-identity-p - (gl-load-identity)) + (glLoadIdentity)) (prog1 (funcall matrix-fn) (glec :with-matrix))) (assert (eql mm-pushed (ogl::get-matrix-mode))() "matrix-mode left as ~a instead of ~a by form ~a" (ogl::get-matrix-mode) mm-pushed matrix-code) - (gl-pop-matrix) + (glpopmatrix) (assert (eql sd-pushed (ogl::get-stack-depth))() "matrix depth deviated ~d during ~a" (- sd-pushed (ogl::get-stack-depth)) @@ -86,13 +85,13 @@ (lambda () ,@body)))
(defun call-with-attrib (attrib-mask attrib-fn) - (gl-push-attrib attrib-mask) + (glpushattrib attrib-mask) (glec :with-attrib-push) (unwind-protect (prog1 (funcall attrib-fn) (glec :with-attrib)) - (gl-pop-attrib) + (glpopattrib) ))
(defmacro with-client-attrib ((&rest attribs) &body body) @@ -101,13 +100,13 @@ (lambda () ,@body)))
(defun call-with-client-attrib (attrib-mask attrib-fn) - (gl-push-client-attrib attrib-mask) + (glpushclientattrib attrib-mask) (glec :with-client-attrib-push) (unwind-protect (prog1 (funcall attrib-fn) (glec :with-client-attrib)) - (gl-pop-client-attrib) + (glpopclientattrib) ))
(defvar *gl-begun*) @@ -118,29 +117,18 @@ (setf *gl-stop* t) (break ":nestedbegin")) (let ((*gl-begun* t)) - (gl-begin ,what) + (glbegin ,what) ,@body - (gl-end) + (glend) (glec :with-gl-begun))))
-(defun cl-opengl-init () - (declare (ignorable load-oglfont-p)) - (unless *opengl-dll* - (print "loading open GL/GLU") - (uffi:load-foreign-library - *gl-dynamic-lib* - :module "open-gl") - ;; -lispworks#-lispworks - (setf *opengl-dll* (uffi:load-foreign-library *glu-dynamic-lib* - :module "gl-util")))) - (defun glec (&optional (id :anon)) (unless (and (boundp '*gl-begun*) *gl-begun*) (let ((e (glgeterror))) (if (zerop e) - (unless t ;; (find id '(glutcheckloop glutgetwindow)) + (unless t (print `(cool ,id))) - (if t ;; (null (find id '(glutInitDisplayMode glutInitWindowSize))) + (if t (unless (boundp '*gl-stop*) (setf *gl-stop* t) (format t "~&~%OGL error ~a at ID ~a" e id) --- /project/cello/cvsroot/cl-opengl/ogl-utils.lisp 2005/07/08 16:26:47 1.3 +++ /project/cello/cvsroot/cl-opengl/ogl-utils.lisp 2006/05/13 21:33:48 1.4 @@ -1,5 +1,4 @@ ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cl-opengl; -*- -;;________________________________________________________ ;; ;;; ;;; Copyright © 2004 by Kenneth William Tilton. @@ -54,7 +53,7 @@ (gl-tex-parameterf gl_texture_2d gl_texture_min_filter gl_linear ) (gl-tex-parameterf gl_texture_2d gl_texture_mag_filter gl_linear )
- (gl-tex-parameteri gl_texture_2d gl_texture_wrap_s tex-wrap) ; gl_repeat for tiling + (gl-tex-parameteri gl_texture_2d gl_texture_wrap_s tex-wrap) ; gl-repeat for tiling (gl-tex-parameteri gl_texture_2d gl_texture_wrap_t tex-wrap) ;--
(loop for plane in planes @@ -141,22 +140,12 @@ ;;(cells::count-it :normalize-3f) (values (+ (/ x m)) (+ (/ y m)) (+ (/ z m)))))))
-(uffi:def-foreign-type bool* (* glboolean)) - -#-lispworks -(declaim (type bool* *ogl-boolean*)) - (defparameter *ogl-boolean* (fgn-alloc 'glboolean 1 :ignore))
(defun ogl-get-boolean (gl-code) (gl-get-booleanv gl-code *ogl-boolean*) - (not (zerop (uffi:deref-array *ogl-boolean* '(:array glboolean) 0)))) - -(uffi:def-foreign-type glint* (* glint)) - -#-lispworks -(declaim (type glint* *ogl-int*)) + (not (zerop (mem-aref *ogl-boolean* 'glboolean 0))))
(defparameter *ogl-int* (fgn-alloc 'glint 1 :ignore)) @@ -165,7 +154,7 @@ (fgn-alloc 'glfloat 1 :ignore))
(defun wrap-float (lisp-float-value) - (setf (uffi:deref-array *ogl-float-1* '(:array glfloat) 0) (* 1.0f0 lisp-float-value)) + (setf (mem-aref *ogl-float-1* 'glfloat 0) (* 1.0f0 lisp-float-value)) *ogl-float-1*)
(defun eltgli (v n) @@ -205,7 +194,7 @@
(defun ogl-pen-move (x y) ;;(ukt::trc "ogl-pen-moving" x y) - (gl-bitmap 0 0 0 0 x y (uffi:make-null-pointer '(:array :cstring)))) + (gl-bitmap 0 0 0 0 x y (cffi:null-pointer)))
(defclass ogl-texture () ((texture-name :accessor texture-name :initform nil) @@ -219,11 +208,12 @@
(defparameter *dump-matrix* (fgn-alloc 'glfloat 16 :dump-matrix)) +#+(or) (defun dump-matrix (matrix-id msg) (gl-get-floatv matrix-id *dump-matrix*) (format t "~&~a > ~a matrix> ~{~a ~}" msg (cond ((eql matrix-id gl_modelview_matrix) 'modelview) - ((eql matrix-id GL_PROJECTION_MATRIX) 'projection)) + ((eql matrix-id gl_projection_matrix) 'projection)) (loop for n below 16 collecting (eltf *dump-matrix* n))))