[cells-cvs] CVS cells/tutorial

[ktilton]

Update of /project/cells/cvsroot/cells/tutorial
In directory clnet:/tmp/cvs-serv8778/tutorial

Modified Files:
	tutorial.lpr 
Added Files:
	04-formula-once-then-input.lisp 
Log Message:
Small fix to c-formula to &allow-other-keys, in support of new tutorial.

--- /project/cells/cvsroot/cells/tutorial/tutorial.lpr	2006/05/30 02:47:45	1.1
+++ /project/cells/cvsroot/cells/tutorial/tutorial.lpr	2006/06/09 17:21:35	1.2
@@ -12,7 +12,9 @@
                                 "01b-change-handling.lisp")
                  (make-instance 'module :name "01c-cascade.lisp")
                  (make-instance 'module :name "02-lesson.lisp")
-                 (make-instance 'module :name "03-ephemeral.lisp"))
+                 (make-instance 'module :name "03-ephemeral.lisp")
+                 (make-instance 'module :name
+                                "04-formula-once-then-input.lisp"))
   :projects (list (make-instance 'project-module :name "..\\cells"))
   :libraries nil
   :distributed-files nil

--- /project/cells/cvsroot/cells/tutorial/04-formula-once-then-input.lisp	2006/06/09 17:21:36	NONE
+++ /project/cells/cvsroot/cells/tutorial/04-formula-once-then-input.lisp	2006/06/09 17:21:36	1.1


(defpackage #:tu-rule-once-then-input (:use :cl :utils-kt :cells :tu-cells))
(in-package #:tu-rule-once-then-input)


#|

Often in interactive applications one needs to do interesting things to come up
with an initial value for a field which then is to be edited by a user, or
for some other reason regularly fed as a C-INPUT.

|#

(defvar *db-entry*)

(defun get-age (id)
  (bwhen (props (cdr (assoc id *db-entry* :test 'string=)))
    (getf props :age)))

(defmodel kenny-view ()
  ((age :accessor age :initform (c-formula (:inputp t)
                                  (- (get-age "555-55-5555")
                                    (^grecian-formula-amt))))
   (grecian-formula-amt :accessor grecian-formula-amt
      :initform (c-in 5))))

(defobserver age ((self kenny-view))
  (setf (getf (cdr (assoc "555-55-5555" *db-entry* :test 'string=)) :age) new-value))

#+test
(let ((*db-entry* (copy-list '(("555-55-5555" . (:name "ken" :age 54))
               ("666-66-6666" . (:name "satan" :age most-positive-fixnum))))))
  (cells-reset)
  (let ((kv (make-instance 'kenny-view)))
    (print `(:age-init ,(age kv)))
    (assert (= 49 (age kv)))

    (incf (grecian-formula-amt kv) 10) ;; try looking younger
    (assert (= 15 (grecian-formula-amt kv)))

    (assert (= 49 (age kv))) ;; unchanged -- the age rule is gone

    (print `(:happy-birthday ,(incf (age kv))))
    (assert (= 50 (age kv)(get-age "555-55-5555")))
    ;
    ; just showin' off...
    (assert (= 51 (1+ (age kv))(incf (age kv))(get-age "555-55-5555")))))