Update of /project/cello/cvsroot/cello/kt-opengl In directory clnet:/tmp/cvs-serv27660/kt-opengl
Modified Files: gl-def.lisp gl-functions.lisp glu-functions.lisp kt-opengl.lisp kt-opengl.lpr ogl-macros.lisp Log Message:
--- /project/cello/cvsroot/cello/kt-opengl/gl-def.lisp 2006/07/03 00:35:16 1.2 +++ /project/cello/cvsroot/cello/kt-opengl/gl-def.lisp 2006/08/28 21:45:27 1.3 @@ -27,7 +27,7 @@ (progn ;;(cells::count-it ,(intern (string-upcase name$) :keyword)) ;;(format t "~&~(~a~) ~{ ~a~}" ,name$ (list ,@(loop for (nil arg) on type-args by #'cddr collecting arg))) - (glec ',(intern name$))))) + #+nogoodinsideglbegin (glec ',(intern name$)))))
(defun aforef (o n) (cffi-uffi-compat:deref-array o '(:array :int) n)) --- /project/cello/cvsroot/cello/kt-opengl/gl-functions.lisp 2006/08/21 04:28:29 1.3 +++ /project/cello/cvsroot/cello/kt-opengl/gl-functions.lisp 2006/08/28 21:45:27 1.4 @@ -24,6 +24,7 @@
(defparameter *ogl-listing-p* nil)
+ (defun-ogl :void "open-gl" "glFlush" ())
(defun-ogl :void "open-gl" "glMaterialfv" (glenum face glenum pname glfloat *params)) @@ -32,12 +33,14 @@
(defun-ogl :void "open-gl" "glBegin" (glenum mode )) (defun-ogl :void "open-gl" "glEnd" ( )) + (defun-ogl :void "open-gl" "glVertex2d" (gldouble x gldouble y )) (defun-ogl :void "open-gl" "glVertex2f" (glfloat x glfloat y )) (defun-ogl :void "open-gl" "glVertex2i" (glint x glint y )) (defun-ogl :void "open-gl" "glVertex2s" (glshort x glshort y )) (defun-ogl :void "open-gl" "glVertex3d" (gldouble x gldouble y gldouble z )) (defun-ogl :void "open-gl" "glVertex3f" (glfloat x glfloat y glfloat z )) + (defun-ogl :void "open-gl" "glVertex3i" (glint x glint y glint z )) (defun-ogl :void "open-gl" "glVertex3s" (glshort x glshort y glshort z )) (defun-ogl :void "open-gl" "glVertex4d" (gldouble x gldouble y gldouble z gldouble w )) --- /project/cello/cvsroot/cello/kt-opengl/glu-functions.lisp 2006/07/03 00:35:16 1.2 +++ /project/cello/cvsroot/cello/kt-opengl/glu-functions.lisp 2006/08/28 21:45:27 1.3 @@ -130,6 +130,7 @@ (dfc GLU_U_STEP 100206) (dfc GLU_V_STEP 100207)
+ ;;; NurbsSampling */ (dfc GLU_PATH_LENGTH 100215) (dfc GLU_PARAMETRIC_ERROR 100216) --- /project/cello/cvsroot/cello/kt-opengl/kt-opengl.lisp 2006/08/28 18:38:03 1.5 +++ /project/cello/cvsroot/cello/kt-opengl/kt-opengl.lisp 2006/08/28 21:45:27 1.6 @@ -21,7 +21,7 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE.
-;;; $Id: kt-opengl.lisp,v 1.5 2006/08/28 18:38:03 fgoenninger Exp $ +;;; $Id: kt-opengl.lisp,v 1.6 2006/08/28 21:45:27 ktilton Exp $
(pushnew :kt-opengl *features*)
@@ -62,7 +62,7 @@ #:ogl-bounds #:ogl-scissor-box #:ogl-raster-pos-get #:ogl-pen-move #:with-bitmap-shifted #:texture-name #:ogl-list-cache #:ogl-lists-delete - #:eltgli #:ogl-tex-activate #:gl-name + #:eltgli #:ogl-tex-activate #:gl-name #:glec
#:gl-get-integers #:gl-get-floats @@ -80,25 +80,45 @@
(defvar *selecting*)
-(define-foreign-library OpenGL - (:windows (:or (namestring +(defparameter *win32-opengl-loc* (namestring (make-pathname ;;#+lispworks :host #-lispworks :device "c" :directory '(:absolute "windows" "system32") :name "opengl32" - :type "dll")))) - (:darwin (:or (:framework "OpenGL")))) + :type "dll")))
-(define-foreign-library GLU - (:windows (:or (namestring +(defparameter *win32-glu-loc* (namestring (make-pathname ;;#+lispworks :host #-lispworks :device "c" :directory '(:absolute "windows" "system32") :name "opengl32" - :type "dll"))))) + :type "dll"))) + +(define-foreign-library OpenGL + (:windows (:or "/windows/system32/opengl32.dll")) + (:darwin (:or (:framework "OpenGL")))) + +(define-foreign-library GLU + (:windows (:or "/windows/system32/glu32.dll")))
(defparameter *opengl-dll* nil)
+(defun kt-opengl-init () + (unless *opengl-dll* + (progn + (let ((opengl-loaded-p + (use-foreign-library OpenGL)) + (glu-loaded-p + #+macosx + t ;; on Mac OS X, no explicit loading of GLU needed. + #-macosx + (use-foreign-library GLU))) + (assert (and opengl-loaded-p glu-loaded-p)) + (setf *opengl-dll* t))))) + +(eval-when (:load-toplevel :execute) + (kt-opengl-init)) + (defun gl-boolean-test (value) #+allegro (not (eql value #\null)) #-allegro (not (zerop value))) --- /project/cello/cvsroot/cello/kt-opengl/kt-opengl.lpr 2006/08/21 04:28:29 1.4 +++ /project/cello/cvsroot/cello/kt-opengl/kt-opengl.lpr 2006/08/28 21:45:28 1.5 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "8.0 [Windows] (Jul 24, 2006 15:27)"; cg: "1.81"; -*- +;; -*- lisp-version: "8.0 [Windows] (Aug 24, 2006 21:48)"; cg: "1.81"; -*-
(in-package :cg-user)
--- /project/cello/cvsroot/cello/kt-opengl/ogl-macros.lisp 2006/08/28 18:37:22 1.7 +++ /project/cello/cvsroot/cello/kt-opengl/ogl-macros.lisp 2006/08/28 21:45:28 1.8 @@ -47,7 +47,7 @@ (defun call-with-matrix (load-identity-p matrix-fn matrix-code) (let* ((mm-pushed (get-matrix-mode)) (sd-pushed (get-stack-depth mm-pushed))) - (cells:wtrc (0 100 "with-matrix starts with mode" (matrix-mode-symbol mm-pushed) :depth sd-pushed) + (progn ;; cells:wtrc (0 100 "with-matrix starts with mode" (matrix-mode-symbol mm-pushed) :depth sd-pushed) (gl-push-matrix) (unwind-protect (progn @@ -59,7 +59,7 @@ (assert (eql mm-pushed (get-matrix-mode))() "matrix-mode left as ~a instead of ~a by form ~a" (ogl::get-matrix-mode) mm-pushed matrix-code) - (cells:trc "poppping matrix!!!!!" (matrix-mode-symbol (get-matrix-mode)) :from-depth (get-stack-depth (get-matrix-mode))) + (cells:trc nil "poppping matrix!!!!!" (matrix-mode-symbol (get-matrix-mode)) :from-depth (get-stack-depth (get-matrix-mode))) (gl-pop-matrix) (assert (eql sd-pushed (get-stack-depth mm-pushed))() "matrix depth deviated ~d during ~a" @@ -93,21 +93,26 @@ (prog1 (funcall attrib-fn) (glec :with-client-attrib)) - (gl-pop-client-attrib))) + (gl-pop-client-attrib) + (glec :with-client-attrib-pop)))
(defvar *gl-begun*) (defvar *gl-stop*)
(defmacro with-gl-begun ((what) &body body) - `(progn - (when (boundp '*gl-begun*) - (setf *gl-stop* t) - (break ":nestedbegin")) - (let ((*gl-begun* t)) - (gl-begin ,what) - ,@body - (gl-end) - (glec :with-gl-begun)))) + `(call-with-gl-begun ,what (lambda () ,@body))) + +(defun call-with-gl-begun (what begun-fn) + (when (boundp '*gl-begun*) + (setf *gl-stop* t) + (break ":nestedbegin")) + (progn + (glec :with-gl-begun-BEFORE) + (let ((*gl-begun* t)) + (gl-begin what) + (funcall begun-fn) + (gl-end)) + (glec :with-gl-begun-exit)))
(defmacro with-gensyms ((&rest syms) &body body) `(let ,(loop for sym in syms @@ -122,29 +127,22 @@ ,@body (gl-translatef (- ,dx)(- ,dy)(- ,dz))))))
-(defun kt-opengl-init () - (unless *opengl-dll* - (progn - (let ((opengl-loaded-p - (use-foreign-library OpenGL)) - (glu-loaded-p - #+macosx - t ;; on Mac OS X, no explicit loading of GLU needed. - #-macosx - (use-foreign-library GLU))) - (assert (and opengl-loaded-p glu-loaded-p)) - (setf *opengl-dll* t)))))
-(eval-when (:load-toplevel :execute) - (kt-opengl-init))
-(defun glec (&optional (id :anon)) +(defun kt-opengl-reset () + (loop for ec = (glgeterror) + for n below 10 + when (zerop ec) do (cells::trc "kt-opengl-reset sees zero error code") + (loop-finish) + do (cells::trc "kt-opengl-init sees error" ec))) + +(defun glec (&optional (id :anon) announce-success) (if (and (boundp '*gl-begun*) *gl-begun*) - (progn #+shhh (cells:trc "not checking error inside gl-begin" id)) + (progn (cells:trc nil "not checking error inside gl.begin" id)) (let ((e (glgeterror))) (if (zerop e) - (unless t ;; (find id '(glutcheckloop glutgetwindow)) - (print `(cool ,id))) + (when announce-success + (print `(OpenGL cool ,id))) (if t ;; (null (find id '(glutInitDisplayMode glutInitWindowSize))) (if (boundp '*gl-stop*) (cells:trc "error but *gl-stop* already bound" e id)