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