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))