Update of /project/cello/cvsroot/cello/kt-opengl In directory clnet:/tmp/cvs-serv20668

Modified Files: ogl-utils.lisp Log Message: Code cleanup. Added: Type declarations and compiler directives.

--- /project/cello/cvsroot/cello/kt-opengl/ogl-utils.lisp 2006/10/01 12:30:14 1.7 +++ /project/cello/cvsroot/cello/kt-opengl/ogl-utils.lisp 2006/10/01 20:44:22 1.8 @@ -22,10 +22,82 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE.

-;;; $Id: ogl-utils.lisp,v 1.7 2006/10/01 12:30:14 fgoenninger Exp $ +;;; $Id: ogl-utils.lisp,v 1.8 2006/10/01 20:44:22 fgoenninger Exp $ + +(declaim (optimize (debug 1) (speed 3) (safety 1) (compilation-speed 0)))

(in-package :kt-opengl)

+;;; =========================================================================== +;;; SPECIAL / GLOBAL VARS +;;; =========================================================================== + +(defparameter *textures-1* (fgn-alloc 'gluint 1 :ignore)) +(defparameter *new-listing* nil) + +(defparameter *dbg-viewport-r* (fgn-alloc 'glint 4 :ignore)) + +;;; =========================================================================== +;;; DATA STRUCTURES / DATA DEFINITIONS +;;; =========================================================================== + +(defstruct v3i + (x :type GLint) + (y :type GLint) + (z :type GLint)) + +(defstruct v3f + (x :type GLfloat) + (y :type GLfloat) + (z :type GLfloat)) + +(defstruct v3d + (x :type GLdouble) + (y :type GLdouble) + (z :type GLdouble)) + +;;; =========================================================================== +;;; FUNCTIONS +;;; =========================================================================== + +;;; --------------------------------------------------------------------------- +;;; CONSTRUCTORS +;;; --------------------------------------------------------------------------- + +(defun mk-vertex3i (x y z) + (make-v3i :x x :y y :z z)) + +(defun mk-vertex3f (x y z) + (make-v3f :x x :y y :z z)) + +(defun mk-vertex3d (x y z) + (make-v3d :x x :y y :z z)) + +(defmacro mkv3i (v3i-lists) + `(mapcar #'(lambda (vtx) + (mk-vertex3i (first vtx) + (second vtx) + (third vtx))) + ',v3i-lists)) + +(defmacro mkv3f (v3f-lists) + `(mapcar #'(lambda (vtx) + (mk-vertex3f (first vtx) + (second vtx) + (third vtx))) + ',v3f-lists)) + +(defmacro mkv3d (v3d-lists) + `(mapcar #'(lambda (vtx) + (mk-vertex3d (first vtx) + (second vtx) + (third vtx))) + ',v3d-lists)) + +;;; --------------------------------------------------------------------------- +;;; TEXTURE SUPPORT +;;; --------------------------------------------------------------------------- + (defun ogl-tex-activate (tex-name) (assert tex-name) ;;(print `(ogl-tex-activate doing ,tex-name)) @@ -33,8 +105,6 @@ (gl-bind-texture gl_texture_2d tex-name) (gl-polygon-mode gl_front_and_back gl_fill)) ;; just front ?

-(defparameter *textures-1* (fgn-alloc 'gluint 1 :ignore)) - (defun ogl-texture-delete (texture-name) ;;(print `(deleting-tx ,texture-name)) (setf (ff-elt *textures-1* gluint 0) texture-name) @@ -86,7 +156,6 @@ (gl-get-integerv gl_scissor_box box) box))

-(ukt::export! ogl-current-color) (defun ogl-current-color () (let ((rgba (fgn-alloc 'glint 4 :ogl-current-color))) (gl-get-integerv gl_current_color rgba) @@ -98,34 +167,38 @@

(defun farther (&rest values) (apply '- values)) + (defun xlin (&rest values) ;; yep. moves matrix, not object (apply '+ values))

(defun nearer (&rest values) (apply '+ values)) + (defun xlout (&rest values) ;; yep. moves matrix, not object (apply '- values))

(defun ncalc-normalf(v0x v0y v0z v1x v1y v1z v2x v2y v2z &aux d0x d0y d0z d1x d1y d1z) + (declare (type GLfloat + v0x v0y v0z v1x v1y v1z v2x v2y v2z + d0x d0y d0z d1x d1y d1z)) + (setf d0x (- v1x v0x) - d0y (- v1y v0y) - d0z (- v1z v0z)) + d0y (- v1y v0y) + d0z (- v1z v0z))

(setf d1x (- v2x v1x) - d1y (- v2y v1y) - d1z (- v2z v1z)) + d1y (- v2y v1y) + d1z (- v2z v1z))

(xgl-normalize-v3f (- (* d0y d1z) (* d0z d1y)) (- (* d0z d1x) (* d0x d1z)) (- (* d0x d1y) (* d0y d1x))))

- -(defstruct v3f - (x 0)(y 0)(z 0)) - (defun xgl-normalize-v3f (x y z) + (declare (type GLfloat x y z)) + (let ((m2 (+ (* x x) (* y y) (* z z)))) (if (zerop m2) (values x y z) @@ -134,11 +207,6 @@ ;;(cells::count-it :normalize-3f) (values (+ (/ x m)) (+ (/ y m)) (+ (/ z m)))))))

-;;;(cffi-uffi-compat:def-foreign-type bool* (* glboolean)) -;;; -;;;#-lispworks -;;;(declaim (type bool* *ogl-boolean*)) - (defparameter *ogl-boolean* (fgn-alloc 'glboolean 1 :ignore))

@@ -146,11 +214,6 @@ (gl-get-booleanv gl-code *ogl-boolean*) (not (zerop (cffi-uffi-compat:deref-array *ogl-boolean* '(:array glboolean) 0))))

-;;;(cffi-uffi-compat:def-foreign-type glint* (* glint)) -;;; -;;;#-lispworks -;;;(declaim (type glint* *ogl-int*)) - (defparameter *ogl-int* (fgn-alloc 'glint 1 :ignore))

@@ -168,9 +231,6 @@ (gl-get-integerv gl-code *ogl-int*) (eltgli *ogl-int* 0))

-(defparameter *dbg-viewport-r* - (fgn-alloc 'glint 4 :ignore)) - (defun dump-viewport (key) (gl-get-integerv gl_viewport *dbg-viewport-r*) (format t "~&dump-viewport> ~a: ~a" key @@ -245,8 +305,6 @@ (loop for (key . list) in (ogl-list-cache node) do (format t "~d : ~a" list key)))

-(defparameter *new-listing* nil) - (defun flatten (&rest args) (mapcan (lambda (arg) (if (consp arg)