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)