[cello-cvs] CVS cello/kt-opengl

[fgoenninger]

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)