[cells-cvs] CVS update: cell-cultures/cl-ftgl/cl-ftgl.lisp

[Kenny Tilton]

Update of /project/cells/cvsroot/cell-cultures/cl-ftgl
In directory common-lisp.net:/tmp/cvs-serv7571/cl-ftgl

Modified Files:
	cl-ftgl.lisp 
Log Message:
Cleaning up
Date: Sun Dec  5 05:50:46 2004
Author: ktilton

Index: cell-cultures/cl-ftgl/cl-ftgl.lisp
diff -u cell-cultures/cl-ftgl/cl-ftgl.lisp:1.6 cell-cultures/cl-ftgl/cl-ftgl.lisp:1.7
--- cell-cultures/cl-ftgl/cl-ftgl.lisp:1.6	Wed Nov 17 13:31:36 2004
+++ cell-cultures/cl-ftgl/cl-ftgl.lisp	Sun Dec  5 05:50:41 2004
@@ -20,7 +20,7 @@
 ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS 
 ;;; IN THE SOFTWARE.
 
-;;; $Header: /project/cells/cvsroot/cell-cultures/cl-ftgl/cl-ftgl.lisp,v 1.6 2004/11/17 12:31:36 ktilton Exp $
+;;; $Header: /project/cells/cvsroot/cell-cultures/cl-ftgl/cl-ftgl.lisp,v 1.7 2004/12/05 04:50:41 ktilton Exp $
 
 (defpackage #:cl-ftgl
   (:nicknames #:ftgl)
@@ -178,11 +178,17 @@
 #+test
 (cl-ftgl-test)
 
+(defvar *start*)
+(defvar *frames*)
+(defun now () (/ (get-internal-real-time) internal-time-units-per-second))
+
 (defun cl-ftgl-test ()
+  (setf *start* (now)
+    *frames* 0)
   (cl-ftgl-reset)
   (setq *test-fonts*
     (mapcar (lambda (mode)
-       (cons mode (ftgl-make mode *gui-style-default-face* 36 96 18)))
+       (cons mode (ftgl-make mode *gui-style-default-face* 48 96 18)))
      '(:texture :pixmap :bitmap :outline :polygon :extruded)))
   (ogl::lesson-14 'cl-ftgl-test-disp-fc))
 
@@ -194,7 +200,7 @@
 
 
 (defun cl-ftgl-test-disp ()
-
+  (incf *frames*)
   (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))
@@ -209,7 +215,9 @@
   (gl-disable gl_lighting)
   (gl-translatef -100 -200 0)
   (gl-enable gl_texture_2d)
-  (ftgl-render (test-font :texture) "un-rotated texture")
+  (ftgl-render (test-font :texture)
+    (format nil "texture ~d" (floor (/ *frames*
+                                      (max 1 (- (now) *start*))))))
   (gl-translatef 100 200 0)
 
   (gl-translatef -100 200 0)