[cello-cvs] CVS cello/kt-opengl
ktilton
ktilton at common-lisp.net
Mon Aug 28 21:45:32 UTC 2006
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)
- , at body
- (gl-end)
- (glec :with-gl-begun))))
+ `(call-with-gl-begun ,what (lambda () , at 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 @@
, at 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)
More information about the Cello-cvs
mailing list