Update of /project/cello/cvsroot/cello In directory clnet:/tmp/cvs-serv7090

Added Files: NeHe-06.lpr nehe-06.lisp nehe-14x.lisp Log Message:

--- /project/cello/cvsroot/cello/NeHe-06.lpr 2006/05/27 06:01:38 NONE +++ /project/cello/cvsroot/cello/NeHe-06.lpr 2006/05/27 06:01:38 1.1 ;; -*- lisp-version: "8.0 [Windows] (May 22, 2006 0:51)"; cg: "1.81"; -*-

(in-package :cg-user)

(defpackage :NEHE-06)

(define-project :name :nehe-06 :modules (list (make-instance 'module :name "nehe-06.lisp") (make-instance 'module :name "nehe-14x.lisp")) :projects (list (make-instance 'project-module :name "..\Celtk\CELTK") (make-instance 'project-module :name "cffi-extender\cffi-extender") (make-instance 'project-module :name "kt-opengl\kt-opengl") (make-instance 'project-module :name "cl-magick\cl-magick") (make-instance 'project-module :name "cl-ftgl\cl-ftgl") (make-instance 'project-module :name "cl-openal\cl-openal")) :libraries nil :distributed-files nil :internally-loaded-files nil :project-package-name :nehe-06 :main-form nil :compilation-unit t :verbose nil :runtime-modules '(:cg-dde-utils :cg.base :cg.bitmap-pane :cg.bitmap-pane.clipboard :cg.bitmap-stream :cg.button :cg.caret :cg.check-box :cg.choice-list :cg.choose-printer :cg.clipboard :cg.clipboard-stack :cg.clipboard.pixmap :cg.color-dialog :cg.combo-box :cg.common-control :cg.comtab :cg.cursor-pixmap :cg.curve :cg.dialog-item :cg.directory-dialog :cg.directory-dialog-os :cg.drag-and-drop :cg.drag-and-drop-image :cg.drawable :cg.drawable.clipboard :cg.dropping-outline :cg.edit-in-place :cg.editable-text :cg.file-dialog :cg.fill-texture :cg.find-string-dialog :cg.font-dialog :cg.gesture-emulation :cg.get-pixmap :cg.get-position :cg.graphics-context :cg.grid-widget :cg.grid-widget.drag-and-drop :cg.group-box :cg.header-control :cg.hotspot :cg.html-dialog :cg.html-widget :cg.icon :cg.icon-pixmap :cg.ie :cg.item-list :cg.keyboard-shortcuts :cg.lamp :cg.lettered-menu :cg.lisp-edit-pane :cg.lisp-text :cg.lisp-widget :cg.list-view :cg.mci :cg.menu :cg.menu.tooltip :cg.message-dialog :cg.multi-line-editable-text :cg.multi-line-lisp-text :cg.multi-picture-button :cg.multi-picture-button.drag-and-drop :cg.multi-picture-button.tooltip :cg.ocx :cg.os-widget :cg.os-window :cg.outline :cg.outline.drag-and-drop :cg.outline.edit-in-place :cg.palette :cg.paren-matching :cg.picture-widget :cg.picture-widget.palette :cg.pixmap :cg.pixmap-widget :cg.pixmap.file-io :cg.pixmap.printing :cg.pixmap.rotate :cg.printing :cg.progress-indicator :cg.project-window :cg.property :cg.radio-button :cg.rich-edit :cg.rich-edit-pane :cg.rich-edit-pane.clipboard :cg.rich-edit-pane.printing :cg.sample-file-menu :cg.scaling-stream :cg.scroll-bar :cg.scroll-bar-mixin :cg.selected-object :cg.shortcut-menu :cg.static-text :cg.status-bar :cg.string-dialog :cg.tab-control :cg.template-string :cg.text-edit-pane :cg.text-edit-pane.file-io :cg.text-edit-pane.mark :cg.text-or-combo :cg.text-widget :cg.timer :cg.toggling-widget :cg.toolbar :cg.tooltip :cg.trackbar :cg.tray :cg.up-down-control :cg.utility-dialog :cg.web-browser :cg.web-browser.dde :cg.wrap-string :cg.yes-no-list :cg.yes-no-string :dde) :splash-file-module (make-instance 'build-module :name "") :icon-file-module (make-instance 'build-module :name "") :include-flags '(:top-level :debugger) :build-flags '(:allow-runtime-debug :purify) :autoload-warning t :full-recompile-for-runtime-conditionalizations nil :default-command-line-arguments "+M +t "Console for Debugging"" :additional-build-lisp-image-arguments '(:read-init-files nil) :old-space-size 256000 :new-space-size 6144 :runtime-build-option :standard :on-initialization 'nehe-06::nehe-06 :on-restart 'do-default-restart)

;; End of Project Definition --- /project/cello/cvsroot/cello/nehe-06.lisp 2006/05/27 06:01:38 NONE +++ /project/cello/cvsroot/cello/nehe-06.lisp 2006/05/27 06:01:38 1.1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- ;;; nehe-06.lisp --- Celtk/Togl version of cl-opengl Lisp version of ;;; nehe lesson 06 spinning cube with texture ;;;

(defpackage :nehe-06 (:use :common-lisp :utils-kt :cells :celtk :kt-opengl :cl-magick ))

(in-package :nehe-06)

(defvar *startx*) (defvar *starty*) (defvar *xangle0*) (defvar *yangle0*) (defvar *xangle*) (defvar *yangle*)

(defparameter *vTime* 100)

(defparameter *grace* nil)

(defconstant wcx 640) ;; Window Width (defconstant wcy 480) ;; Window Height (defparameter xrot 0.0f0) (defparameter yrot 0.0f0) (defparameter zrot 0.0f0) (defparameter *skin6* nil)

(defun nehe-06 () ;; ACL project manager needs a zero-argument function, in project package (setf ogl::*gl-begun* nil) (test-window 'nehe-06-demo))

(defmodel nehe-06-demo (window) () (:default-initargs :title$ "Rotating nehe-06 Widget Test" :kids (c? (the-kids (mk-stack (:packing (c?pack-self)) (make-instance 'nehe06 :fm-parent *parent* :width 400 :height 400 :timer-interval 2 #+later (c? (let ((n$ (md-value (fm-other :vtime)))) (format nil "~a" (max 1 (or (parse-integer n$ :junk-allowed t) 0))))) :double 1 ;; "yes" ))))))

(defconstant +pif+ (coerce pi 'single-float))

(defmodel nehe06 (togl) ((shoot-me :cell nil :initform nil :accessor shoot-me) (frame-count :cell nil :initform 0 :accessor frame-count) (t0 :cell nil :initform 0 :accessor t0) ; (width :initarg :wdith :initform 400 :accessor width) (height :initarg :wdith :initform 400 :accessor height)) (:default-initargs :cb-destroy (lambda (self) (bwhen (s (shoot-me self)) (trc "stopping source" s) (cl-openal::al-source-stop s)))))

(defmethod togl-timer-using-class ((self nehe06)) (trc nil "enter nehe-06 timer" self (togl-ptr self) (get-internal-real-time)) (Togl_PostRedisplay (togl-ptr self)) (if (shoot-me self) (unless (cl-openal::al-source-playing-p (shoot-me self)) (cl-openal::al-source-play (shoot-me self))) (setf (shoot-me self) (cl-openal::wav-play-start "/0dev/cello/user/sounds/spinning.wav"))))

(defmethod togl-reshape-using-class ((self nehe06)) (let ((width (Togl_width (togl-ptr self))) (height (Togl_height (togl-ptr self))))

(trc "enter nh6 reshape" self width height) (unless (or (zerop width) (zerop height)) (gl-viewport 0 0 width height) (gl-matrix-mode gl_projection) (gl-load-identity) (glu-perspective 45 (/ width height) 0.1 100) (gl-matrix-mode gl_modelview) (gl-load-identity))))

(defparameter *jmc-font* (ftgl-make :texture 'sylfaen 48 96 18))

(defmethod togl-display-using-class ((self nehe06)) (gl-load-identity) (gl-clear (+ gl_color_buffer_bit gl_depth_buffer_bit))

(gl-line-width 1) (gl-color3f 1f0 1f0 1f0) (gl-translatef 0 0 -5) (gl-enable gl_texture_2d)

;--------------------------------------------

(progn ;; (gl-translatef 0 0 -5)

(let ((f 0.2)) (gl-rotatef (incf xrot (* f 3)) 1 0 0) (gl-rotatef (incf yrot (* f 2)) 0 1 0) (gl-rotatef (incf zrot (* f 4)) 0 0 1))

(wand-texture-activate *skin6*)

(flet ((v3f (x y z) (let ((scale 1)) (gl-vertex3f (* scale x)(* scale y)(* scale z))))) (with-gl-begun (gl_quads) ;; Front Face (gl-tex-coord2f 0 1)(v3f 1 -1 1) (gl-tex-coord2f 0 0)(v3f 1 1 1) (gl-tex-coord2f 1 0)(v3f -1 1 1) (gl-tex-coord2f 1 1)(v3f -1 -1 1) ;;; (gl-tex-coord2f 1 0)(v3f 1 -1 1) ;;; (gl-tex-coord2f 1 1)(v3f 1 1 1) ;;; (gl-tex-coord2f 0 1)(v3f -1 1 1) ;;; (gl-tex-coord2f 0 0)(v3f -1 -1 1)

;; Back Face (gl-tex-coord2f 1 0) (v3f -1 -1 -1) (gl-tex-coord2f 1 1) (v3f -1 1 -1) (gl-tex-coord2f 0 1) (v3f 1 1 -1) (gl-tex-coord2f 0 0) (v3f 1 -1 -1) ;;; Top Face (gl-tex-coord2f 0 1) (v3f -1 1 -1) (gl-tex-coord2f 0 0) (v3f -1 1 1) (gl-tex-coord2f 1 0) (v3f 1 1 1) (gl-tex-coord2f 1 1) (v3f 1 1 -1) ;;; Bottom Face (gl-tex-coord2f 1 1) (v3f -1 -1 -1) (gl-tex-coord2f 0 1) (v3f 1 -1 -1) (gl-tex-coord2f 0 0) (v3f 1 -1 1) (gl-tex-coord2f 1 0) (v3f -1 -1 1) ;;; Right face (gl-tex-coord2f 1 0) (v3f 1 -1 -1) (gl-tex-coord2f 1 1) (v3f 1 1 -1) (gl-tex-coord2f 0 1) (v3f 1 1 1) (gl-tex-coord2f 0 0) (v3f 1 -1 1) ;;; Left Face (gl-tex-coord2f 0 0) (v3f -1 -1 -1) (gl-tex-coord2f 1 0) (v3f -1 -1 1) (gl-tex-coord2f 1 1) (v3f -1 1 1) (gl-tex-coord2f 0 1) (v3f -1 1 -1) )) #+ifuwanttoseepixmap (wand-render *grace* 0 0 1 -1)

(progn (gl-scalef 0.006 0.006 0.0) (gl-disable gl_lighting) (gl-translatef -250 -300 -100) (gl-enable gl_texture_2d) (loop repeat 4 do (ftgl-render *jmc-font* "Dr. John McCarthy") (gl-rotatef 90 0 0 1)) (gl-translatef 100 200 100) )

) (Togl_SwapBuffers (togl-ptr self)) #+shhh (print-frame-rate self))

(defmethod togl-create-using-class ((self nehe06)) (gl-enable gl_texture_2d) (gl-shade-model gl_smooth) (gl-clear-color 0 0 0 1) (gl-clear-depth 1) (gl-enable gl_depth_test) (gl-depth-func gl_lequal) (gl-hint gl_perspective_correction_hint gl_nicest) (setf *skin6* (mgk:wand-ensure-typed 'wand-texture (test-image "jmcbw512" "jpg"))) (setf *grace* (mgk:wand-ensure-typed 'wand-pixels (test-image "turing" "gif"))))

(defun print-frame-rate (window) (with-slots (frame-count t0) window (incf frame-count) (let ((time (get-internal-real-time))) (when (= t0 0) (setq t0 time)) (when (>= (- time t0) (* 5 internal-time-units-per-second)) (let* ((seconds (/ (- time t0) internal-time-units-per-second)) (fps (/ frame-count seconds))) (declare (ignorable fps)) #+shh (format *terminal-io* "~D frames in ~3,1F seconds = ~6,3F FPS~%" frame-count seconds fps)) (setq t0 time) (setq frame-count 0)))))

(defun test-image (filename filetype) (make-pathname :directory '(:absolute "0dev" "user" "graphics" "shapers") :name (string filename) :type (string filetype))) --- /project/cello/cvsroot/cello/nehe-14x.lisp 2006/05/27 06:01:38 NONE +++ /project/cello/cvsroot/cello/nehe-14x.lisp 2006/05/27 06:01:38 1.1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- ;;; nehe-14.lisp --- Celtk/Togl version of ;;; nehe lesson 14 spinning text string ;;;

(defpackage :nehe-06 (:use :common-lisp :utils-kt :cells :celtk :kt-opengl :cl-ftgl))

(in-package :nehe-06)

(defparameter g_rot 0.0f0) (defvar *frames*) (defvar *start*) (defvar *test-fonts*)

(defun test-font (mode) (cdr (assoc mode *test-fonts*)))

#+test (nehe-14)

(defun nehe-14 () ;; ACL project manager needs a zero-argument function, in project package (setf ogl::*gl-begun* nil) (setq *test-fonts* (mapcar (lambda (mode) (cons mode (ftgl-make mode *gui-style-default-face* 48 96 18))) '(:texture :pixmap :bitmap :outline :polygon :extruded))) (test-window 'nehe-14-demo))

(defmodel nehe-14-demo (window) () (:default-initargs :title$ "NeHe's OpenGL Framework" :kids (c? (the-kids (mk-stack (:packing (c?pack-self)) (make-instance 'nehe14 :fm-parent *parent* :width 400 :height 400 :timer-interval 1 #+later (c? (let ((n$ (md-value (fm-other :vtime)))) (format nil "~a" (max 1 (or (parse-integer n$ :junk-allowed t) 0))))) :double 1 ;; "yes" ))))))

(defmodel nehe14 (togl) ((frame-count :cell nil :initform 0 :accessor frame-count) (t0 :cell nil :initform 0 :accessor t0) ; (width :initarg :wdith :initform 640 :accessor width) (height :initarg :wdith :initform 400 :accessor height)))

(defmethod togl-timer-using-class ((self nehe14)) (trc nil "enter nehe-14 timer" self (togl-ptr self) (get-internal-real-time)) (Togl_PostRedisplay (togl-ptr self)))

(defmethod togl-reshape-using-class ((self nehe14)) (let ((width (Togl_width (togl-ptr self))) (height (Togl_height (togl-ptr self)))) (trc "reshape" width height) (unless (or (zerop width) (zerop height)) (trc "reshape" width height) (gl-viewport 0 0 width height) (gl-matrix-mode gl_projection) (gl-load-identity) (glu-perspective 70 1 1 1000) (glu-look-at 0d0 0d0 5d0 0d0 0d0 0d0 0d0 1d0 0d0)

(gl-matrix-mode gl_modelview) (gl-load-identity) (gl-clear-depth 1d0))))

(defmethod togl-display-using-class ((self nehe14)) (incf *frames*) (gl-load-identity) ;; Reset The Current Modelview Matrix (gl-clear-color 0 0 0 1) (gl-clear (+ gl_color_buffer_bit gl_depth_buffer_bit))

(gl-translatef 0.0f0 0.0f0 2.0f0) ;; Move Into The Screen ;; Pulsing Colors Based On The Rotation (gl-color3f (* 1.0f0 (cos (/ g_rot 20.0f0))) (* 1.0f0 (sin (/ g_rot 25.0f0))) (- 1.0f0 (* 0.5f0 (cos (/ g_rot 17.0f0)))))

(gl-scalef 0.006 0.006 0.0) (gl-disable gl_lighting) (gl-translatef -100 -200 0) (gl-enable gl_texture_2d) (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) (gl-line-width 3) (ftgl-render (test-font :outline) "un-rotated outline") (gl-translatef 100 -200 0)

(gl-translatef -200 100 0) (ftgl-render (test-font :polygon) "un-rotated polygon") (gl-translatef 200 -100 0)

(with-matrix () (gl-polygon-mode gl_front_and_back gl_line) (gl-rotatef g_rot 1.0f0 0.5f0 0.0f0) (gl-scalef 4 4 4) (gl-translatef -70 -20 0) (ftgl-render (test-font :extruded) "NeHe") (gl-polygon-mode gl_front_and_back gl_fill) )

[103 lines skipped]