13 (define (parse-input string)
14 (map string->symbol (string-tokenize string)))
16 (define ((player-beh loc) self . message)
19 (send-message self 'query')
23 (send-message self 'query)
27 (let ((new-message (parse-input (read-line))))
28 (apply send-message (cons self new-message)))
35 (send-message self 'look)
38 (apply send-message (cons loc (cons player message)))
41 (define ((room-beh name description . exits) self . message)
44 (set! exits (cons exit exits))
46 ((or (player 'look) (player 'l) (player 'x))
47 (let* ((room-desc (conc name "\n" description))
48 (accumulator (make-actor (accumulate-descrs player
51 (send-message accumulator 'init))
54 (let ((exit-tryer (make-actor
55 (try-exits player exits x))))
56 (send-message exit-tryer 'init))
58 (else ;ignore unknown messages
61 (define ((accumulate-descrs cust objects descrs) self . message)
66 (send-message cust 'print (string-intersperse (reverse descrs) "\n"))
69 (send-message (car objects) self 'look)
70 (accumulate-descrs cust (cdr objects) descrs))))
72 (let ((new-descrs (cons descr descrs)))
75 (send-message cust 'print (string-intersperse (reverse new-descrs) "\n"))
78 (send-message (car objects) self 'look)
79 (accumulate-descrs cust (cdr objects) new-descrs)))))))
81 (define ((try-exits player exits msg-to-send) self . message)
83 ((or ('init) ('no-match))
86 (send-message player 'print "I don't know how to do that.")
89 (apply send-message (cons (car exits) (cons self msg-to-send)))
90 (try-exits player (cdr exits) msg-to-send))))
92 (apply send-message (cons player message))
95 (define ((exit-beh names description dest) self . message)
96 (if (not (= (length message) 2))
98 (let ((cust (car message))
102 (send-message cust 'print description))
104 (send-message cust 'move-to dest))
106 (send-message cust 'no-match)))
109 (define (make-room title desc)
110 (make-actor (room-beh title desc)))
112 (define (add-exit from to names desc)
113 (send-message from 'add-exit (make-actor (exit-beh names desc to))))
116 (make-room "Rocky shore at night"
117 (conc "You are standing on a rocky shore. Menacing waves crash periodically\n"
118 "against large bolders from all directions, occasionally spraying you\n"
119 "with salty ocean mist.")))
122 (make-room "Cold ocean"
123 "You are now in the water."))
126 (make-room "Underwater"
127 "You are now swimming near the ocean floor."))
129 (add-exit shore ocean '(west w)
130 "A path leads west through the boulders down to the waves.")
132 (add-exit ocean shore '(east e)
133 "The shore is to the east.")
135 (add-exit ocean underwater '(down d)
136 "You can swim down here.")
138 (add-exit underwater ocean '(up u)
139 "You can swim up from here.")
141 (define player (make-actor-with-address 'player (player-beh shore)))
144 (send-message player 'init)