/[cells]/triple-cells/hello-world.lisp
ViewVC logotype

Contents of /triple-cells/hello-world.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations)
Fri Dec 21 19:02:10 2007 UTC (6 years, 3 months ago) by ktilton
Branch: MAIN
Changes since 1.1: +20 -16 lines
*** empty log message ***
1 ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: triple-cells; -*-
2 ;;;
3 ;;;
4 ;;; Copyright (c) 1995,2003 by Kenneth William Tilton.
5 ;;;
6 ;;; Permission is hereby granted, free of charge, to any person obtaining a copy
7 ;;; of this software and associated documentation files (the "Software"), to deal
8 ;;; in the Software without restriction, including without limitation the rights
9 ;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
10 ;;; copies of the Software, and to permit persons to whom the Software is furnished
11 ;;; to do so, subject to the following conditions:
12 ;;;
13 ;;; The above copyright notice and this permission notice shall be included in
14 ;;; all copies or substantial portions of the Software.
15 ;;;
16 ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
17 ;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
18 ;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
19 ;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
20 ;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
21 ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
22 ;;; IN THE SOFTWARE.
23
24
25 (in-package :3c)
26
27 #+wait
28 (def-3c-observer happen ()
29 (when new-value
30 (format t "~&happen: ~a" new-value)))
31
32 (defmethod 3c-observe-predicate (s (p (eql 'happen)) new-value prior-value prior-value?)
33 (trc "OBS> happen" *3c-pulse* s new-value prior-value prior-value?))
34
35 (defmethod 3c-observe-predicate (s (p (eql 'location)) new-value prior-value prior-value?)
36 (trc "OBS> location" *3c-pulse* s new-value prior-value prior-value?))
37
38 (defun 3c-test ()
39 (3c-init)
40 (let ((*synchronize-automatically* t))
41 (enable-print-decoded t)
42 (make-tutorial-store)
43 (register-namespace "hw" "helloworld#" :errorp nil)
44 (register-namespace "ccc" "triplecells#" :errorp nil)
45
46 (let ((dell (3c-make "dell" :id !<computer>))
47 (happen !"happen")
48 (location !"location")
49 )
50
51 (stmt-new dell happen #+const "test" (3c-in nil :ephemeral t))
52 (trc "start happen is" (3c dell happen))
53
54 (stmt-new dell location
55 (3c? (trc "RULE-ENTRY>" *3c-pulse*)
56 (if (string-equal (3c (3c-find-id "dell") !"happen") "arrive")
57 "home" "away")))
58
59 (trc "start location is" (3c dell location))
60 ;;; (setf (3c dell happen) "arrive")
61 ;;; (trc "post-arrive location is" (3c dell location))
62 (loop repeat 2 do
63 (setf (3c dell happen) "knock-knock"))
64 (setf (3c dell happen) "arrive")
65 (setf (3c dell happen) "knock-knock")
66 (setf (3c dell happen) "leave")
67
68 )))
69
70
71 #|
72
73 (defmd computer ()
74 (happen (c-in nil) :cell :ephemeral)
75 (location (c? (case (^happen)
76 (:leave :away)
77 (:arrive :at-home)
78 (t .cache)))) ;; ie, unchanged
79 (response nil :cell :ephemeral))
80
81 (defobserver response(self new-response old-response)
82 (when new-response
83 (format t "~&computer: ~a" new-response)))
84
85 (defobserver happen()
86 (when new-value
87 (format t "~&happen: ~a" new-value)))
88
89 (def-cell-test hello-world ()
90 (let ((dell (make-instance 'computer
91 :response (c? (bwhen (h (happen self))
92 (if (eql (^location) :at-home)
93 (case h
94 (:knock-knock "who's there?")
95 (:world "hello, world."))
96 "<silence>"))))))
97 (dotimes (n 2)
98 (setf (happen dell) :knock-knock))
99
100 (setf (happen dell) :arrive)
101 (setf (happen dell) :knock-knock)
102 (setf (happen dell) :leave)
103 (values)))
104
105 |#
106
107 #+(or)
108 (hello-world)
109
110
111 #| output
112
113 happen: KNOCK-KNOCK
114 computer: <silence>
115 happen: KNOCK-KNOCK
116 computer: <silence>
117 happen: ARRIVE
118 happen: KNOCK-KNOCK
119 computer: who's there?
120 happen: LEAVE
121 computer: <silence>
122
123
124 |#
125

  ViewVC Help
Powered by ViewVC 1.1.5