[cells-cvs] CVS Celtk

[ktilton]

Update of /project/cells/cvsroot/Celtk
In directory clnet:/tmp/cvs-serv24777

Modified Files:
	CELTK.lpr demos.lisp gears.lisp ltktest-cells-inside.lisp 
Log Message:


--- /project/cells/cvsroot/Celtk/CELTK.lpr	2006/05/04 06:11:10	1.7
+++ /project/cells/cvsroot/Celtk/CELTK.lpr	2006/05/04 10:06:37	1.8
@@ -27,8 +27,7 @@
                  (make-instance 'module :name "togl.lisp")
                  (make-instance 'module :name "run.lisp")
                  (make-instance 'module :name "demos.lisp")
-                 (make-instance 'module :name
-                                "ltktest-cells-inside.lisp")
+                 (make-instance 'module :name "ltktest-ci.lisp")
                  (make-instance 'module :name "gears.lisp"))
   :projects (list (make-instance 'project-module :name
                                  "..\\cells\\cells")
--- /project/cells/cvsroot/Celtk/demos.lisp	2006/05/04 06:11:10	1.9
+++ /project/cells/cvsroot/Celtk/demos.lisp	2006/05/04 10:06:37	1.10
@@ -24,9 +24,10 @@
 (in-package :celtk-user)
 
 (defun ctk::tk-test () ;; ACL project manager needs a zero-argument function, in project package
-  ;;(test-window 'one-button)
-  (test-window 'gears-demo)
-  )
+  (test-window ;; 'one-button
+    ;;'ltktest-cells-inside
+    'gears-demo
+  ))
 
 (defmodel one-button (window)
   ()
--- /project/cells/cvsroot/Celtk/gears.lisp	2006/05/04 06:11:10	1.4
+++ /project/cells/cvsroot/Celtk/gears.lisp	2006/05/04 10:06:37	1.5
@@ -2,12 +2,12 @@
 (in-package :celtk-user)
 
 
-(defparameter *startx* nil)
-(defparameter *starty* nil)
-(defparameter *xangle0* nil)
-(defparameter *yangle0* nil)
-(defparameter *xangle* 0.0)
-(defparameter *yangle* 0.0)
+(defvar *startx*)
+(defvar *starty*)
+(defvar *xangle0*)
+(defvar *yangle0*)
+(defvar *xangle*)
+(defvar *yangle*)
 
 (defparameter *vTime* 100)
 
@@ -16,7 +16,7 @@
         (*starty* nil)
         (*xangle0* nil)
         (*yangle0* nil)
-        (*xangle* 0.0)
+        (*xangle* 0.2)
         (*yangle* 0.0))
     (test-window 'gears-demo)))
 
@@ -28,21 +28,19 @@
     :kids (c? (the-kids
                (mk-stack (:packing (c?pack-self))
                  (mk-label :text "Click and drag to rotate image")
-                 #+tki (mk-row ()
+                 (mk-row ()
                          (mk-button-ex ("  Add " (incf (gear-ct .tkw))))
                          (mk-button-ex ("Remove" (when (plusp (gear-ct .tkw))
                                                    (decf (gear-ct .tkw)))))
                          (mk-entry :id :vtime
                            :md-value (c-in "100"))
-                         (mk-button-ex (" Quit " (progn))))
+                         (mk-button-ex (" Quit " (tk-eval "destroy ."))))
                  (make-instance 'gears
                    :fm-parent *parent*
-                   :width 400
-                   :height 400
-                   :timer-interval nil #+tki (c? (or .cache ;; comment out just ".cache" for some fun
-                                                   (eko ("vtime is")
-                                                     (md-value (fm-other :vtime)))))
-                   :double "yes"
+                   :width 400 :height 400
+                   :timer-interval (c? (let ((n$ (md-value (fm-other :vtime))))
+                                         (format nil "~a" (or (parse-integer n$ :junk-allowed t) 0))))
+                   :double 1 ;; "yes"
                    :bindings (c? (list
                                   (list '|<1>| (lambda (self event root-x root-y) 
                                                  (declare (ignorable self event root-x root-y))
@@ -74,9 +72,9 @@
 (defconstant +pif+ (coerce pi 'single-float))
 
 (defmodel gears (togl)
-  ((rotx :initform (c-in 0.0) :accessor rotx :initarg :rotx)
-   (roty :initform (c-in 0.0) :accessor roty :initarg :roty)
-   (rotz :initform (c-in 0.0) :accessor rotz :initarg :rotz)
+  ((rotx :initform (c-in 0.2) :accessor rotx :initarg :rotx)
+   (roty :initform (c-in 0.5) :accessor roty :initarg :roty)
+   (rotz :initform (c-in 0.8) :accessor rotz :initarg :rotz)
    (gear1 :accessor gear1 :initform (c-in nil))
    (gear2 :accessor gear2 :initform (c-in nil))
    (gear3 :accessor gear3 :initform (c-in nil))
@@ -104,7 +102,7 @@
       (gl:frustum -1 1 (- h) h 5 60))
     (gl:matrix-mode :modelview)
     (gl:load-identity)
-    (gl:translate 0 0 -40)))
+    (gl:translate 0 0 -30)))
 
 (defmethod togl-display-using-class ((self gears) &aux (scale (scale (upper self gears-demo))))
   (declare (ignorable scale))
--- /project/cells/cvsroot/Celtk/ltktest-cells-inside.lisp	2006/05/03 17:34:58	1.16
+++ /project/cells/cvsroot/Celtk/ltktest-cells-inside.lisp	2006/05/04 10:06:37	1.17
@@ -398,7 +398,7 @@
                           ; around the TCL after command. See the class definition of timer
                           ; for the fireworks (in terms of Cells) that resulted
                           ;
-                          :repeat (c-in nil)
+                          :repeat (c-in t)
                           :delay 1 ;; milliseconds since this gets passed unvarnished to TK after
                           :action (lambda (timer)
                                     (declare (ignorable timer))