[cello-cvs] CVS cello/cellodemo
ktilton
ktilton at common-lisp.net
Sat Jun 3 12:05:55 UTC 2006
Update of /project/cello/cvsroot/cello/cellodemo
In directory clnet:/tmp/cvs-serv8832/cellodemo
Modified Files:
cellodemo.lisp cellodemo.lpr demo-window.lisp
hedron-decoration.lisp hedron-render.lisp light-panel.lisp
tutor-geometry.lisp
Log Message:
Somewhat resurrected; clean compile anyway
--- /project/cello/cvsroot/cello/cellodemo/cellodemo.lisp 2006/05/17 16:14:28 1.2
+++ /project/cello/cvsroot/cello/cellodemo/cellodemo.lisp 2006/06/03 12:05:55 1.3
@@ -22,7 +22,6 @@
(in-package :cello)
-
#+(or)
(list
(demo-image-subdir "shapers")
--- /project/cello/cvsroot/cello/cellodemo/cellodemo.lpr 2006/05/17 16:14:28 1.2
+++ /project/cello/cvsroot/cello/cellodemo/cellodemo.lpr 2006/06/03 12:05:55 1.3
@@ -1,4 +1,4 @@
-;; -*- lisp-version: "7.0 [Windows] (Aug 5, 2005 12:23)"; cg: "1.54.2.17"; -*-
+;; -*- lisp-version: "8.0 [Windows] (May 22, 2006 0:51)"; cg: "1.81"; -*-
(in-package :cg-user)
@@ -10,8 +10,8 @@
(make-instance 'module :name "tutor-geometry.lisp")
(make-instance 'module :name "light-panel.lisp")
(make-instance 'module :name "hedron-render.lisp")
- (make-instance 'module :name "hedron-decoration.lisp")
- (make-instance 'module :name "virtual-human.lisp"))
+ (make-instance 'module :name
+ "hedron-decoration.lisp"))
:projects (list (make-instance 'project-module :name "..\\cello"))
:libraries nil
:distributed-files nil
--- /project/cello/cvsroot/cello/cellodemo/demo-window.lisp 2006/05/17 16:14:28 1.2
+++ /project/cello/cvsroot/cello/cellodemo/demo-window.lisp 2006/06/03 12:05:55 1.3
@@ -20,13 +20,18 @@
;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
;;; IN THE SOFTWARE.
+
(in-package :cello)
(defun cello-test ()
(let ((cells::*c-debug* (get-internal-real-time)))
- (run-stylish-demos '(light-panel ft-jpg tu-geo ftgl-test demo-scroller)
+ (run-stylish-demos '(#+No light-panel
+ ;;ft-jpg
+ tu-geo
+ ;;ftgl-test
+ #+no demo-scroller)
;;'tu-geo
- 'light-panel
+ 'tu-geo
:skin (c? (wand-ensure-typed 'wand-texture
(car (md-value (fm-other :texture-picker)))))
:focus (c-in nil)
@@ -102,7 +107,7 @@
:text-color +green+))
(apply 'run-demos demo-names start-at iargs)))
-(defmodel demo-window (sound-manager window)
+(defmodel demo-window (sound-manager cello-window)
()
(:default-initargs
:sound `((:open .
@@ -322,23 +327,8 @@
:must-find t
:skip-tree self))))))
-(defmodel proctor-class (ix-row)
- ()
- (:default-initargs
- :kids (c? (the-kids
- (mk-part :class (ct-text)
- :text-font (make-font-glut-bitmapped
- :glut-id glut_bitmap_8_by_13)
- :pre-layer (with-layers +red+)
- :text$ (c? (string (class-name (md-value .parent)))))
- (mk-part :subks (ix-inline)
- :orientation :vertical
- :kids (c? (loop for subk in (class-direct-subclasses (md-value .parent))
- collecting (mk-part :sub (proctor-class)
- :md-value subk))))))))
-(defun proctor ()
- (mk-part :top (proctor-class)
- :md-value (c? (find-class 'standard-object))))
+
+
(defparameter *starter-font* nil)
@@ -353,10 +343,9 @@
;:inset (mkv2 (uPts 4)(uPts 2))
;:lr (uin 1)
:text$ "Close"
- :ct-action (lambda (self event &aux (gw (glutw .w.)))
- (declare (ignorable event))
- (trc "whacking" .w. gw)
- (glut-destroy-window gw)))
+ :ct-action (lambda (self event)
+ (declare (ignorable self event))
+ (ctk::tcl-eval-ex ctk::*tki* "{destroy .}")))
(mk-part :neww (ct-button)
;:inset (mkv2 (uPts 4)(uPts 2))
--- /project/cello/cvsroot/cello/cellodemo/hedron-decoration.lisp 2005/07/05 17:00:29 1.1
+++ /project/cello/cvsroot/cello/cellodemo/hedron-decoration.lisp 2006/06/03 12:05:55 1.2
@@ -22,6 +22,7 @@
(in-package :cello)
+
(defun hedron-options ()
(mk-part :options (ix-inline)
:orientation :vertical
--- /project/cello/cvsroot/cello/cellodemo/hedron-render.lisp 2005/07/05 17:00:29 1.1
+++ /project/cello/cvsroot/cello/cellodemo/hedron-render.lisp 2006/06/03 12:05:55 1.2
@@ -20,6 +20,7 @@
;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
;;; IN THE SOFTWARE.
+
(in-package :cello)
(defun glut-solid-cylinder (quadric base-radius top-radius height slices stacks)
--- /project/cello/cvsroot/cello/cellodemo/light-panel.lisp 2006/05/17 16:14:28 1.2
+++ /project/cello/cvsroot/cello/cellodemo/light-panel.lisp 2006/06/03 12:05:55 1.3
@@ -20,9 +20,10 @@
;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
;;; IN THE SOFTWARE.
+
(in-package :cello)
-(def-c-output rgba-value ()
+(defobserver rgba-value ()
(when old-value
(fgn-free (rgba-fo old-value))))
--- /project/cello/cvsroot/cello/cellodemo/tutor-geometry.lisp 2005/07/05 17:00:29 1.1
+++ /project/cello/cvsroot/cello/cellodemo/tutor-geometry.lisp 2006/06/03 12:05:55 1.2
@@ -20,6 +20,7 @@
;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
;;; IN THE SOFTWARE.
+
(in-package :cello)
(defun degree-radians (degrees)
@@ -63,9 +64,9 @@
:px (c? (/ (l-width .w.) 2))
:py (c? (downs (/ (l-height .w.) 2)))
:text$ "Close"
- :ct-action (lambda (self event &aux (gw (glutw .w.)))
+ :ct-action (lambda (self event)
(declare (ignorable event))
- (glut-destroy-window gw))))))))
+ (ctk::tcl-eval-ex ctk::*tki* "{destroy .}"))))))))
\ No newline at end of file
More information about the Cello-cvs
mailing list