[cells-cvs] CVS Celtk

[ktilton]

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

Modified Files:
	Celtk.lisp ltktest-cells-inside.lisp tk-format.lisp 
Log Message:


--- /project/cells/cvsroot/Celtk/Celtk.lisp	2006/03/24 03:46:25	1.7
+++ /project/cells/cvsroot/Celtk/Celtk.lisp	2006/03/24 12:09:44	1.8
@@ -123,8 +123,9 @@
                               rpt) ;; a little redundant since bwhen checks that rpt is not nil
                         (with-integrity (:client `(:fini ,self)) ;; just guessing as to when, not sure it matters
                           (setf (id self) (after (^delay) (lambda ()
-                                                            (funcall (^action) self)
-                                                            (setf (^executed) t))))))))))))
+                                                            (when (eq (^state) :on)
+                                                              (funcall (^action) self)
+                                                              (setf (^executed) t)))))))))))))
 
 
 (defobserver timers ((self tk-object) new-value old-value)
--- /project/cells/cvsroot/Celtk/ltktest-cells-inside.lisp	2006/03/24 03:46:25	1.7
+++ /project/cells/cvsroot/Celtk/ltktest-cells-inside.lisp	2006/03/24 12:09:44	1.8
@@ -341,9 +341,9 @@
                           :repeat (c-in nil)
                           :delay 25 ;; milliseconds since this gets passed unvarnished to TK after
                           :action (lambda (timer)
-                                    (when (eq (state timer) :on)
-                                      (incf (^angle-1) 0.1))))))
-    :coords (c? (let* ((angle-2 (* 0.3 (^angle-1)))
+                                    (declare (ignore timer))
+                                    (incf (^angle-1) 0.1)))))
+    :coords (c? (let ((angle-2 (* 0.3 (^angle-1)))
                        (wx (sin (* 0.1 (^angle-1)))))
                   (loop for i below 100
                       for w = (+ (^angle-1) (* i 2.8001))
--- /project/cells/cvsroot/Celtk/tk-format.lisp	2006/03/24 03:46:25	1.4
+++ /project/cells/cvsroot/Celtk/tk-format.lisp	2006/03/24 12:09:44	1.5
@@ -56,6 +56,7 @@
         (trc nil "!!! --- tk-user-queue-handler dispatching" defer-info)
         (funcall task)))
 
+#+debug
 (defun tk-format-now (fmt$ &rest fmt-args &aux (tk$ (apply 'format nil fmt$ fmt-args)))
   ;
   ; --- pure debug stuff ---
@@ -77,6 +78,11 @@
   (format (wish-stream *wish*) "~A~%" tk$)
   (force-output (wish-stream *wish*)))
 
+(defun tk-format-now (fmt$ &rest fmt-args &aux (tk$ (apply 'format nil fmt$ fmt-args)))
+  ;;(format t "~&tk> ~A~%" tk$)
+  (format (wish-stream *wish*) "~A~%" tk$)
+  (force-output (wish-stream *wish*)))
+
 (defun tk-format (defer-info fmt$ &rest fmt-args)
   "Format then send to wish (via user queue)"
   (assert (or (eq defer-info :grouped)