8 ;; .-------------.--.--------.-----------.-----------.
9 ;; | ==== ===== | | | elrond's | |
10 ;; | ==== ===== | | joar's | goblin | |
11 ;; | Dootacenter | + codea | ballroom | | <- here be
12 ;; | ==== ===== + | plex | | | gandaros
13 ;; | ^-- chris's | ;--------'----+--,---' |
14 ;; | emacs ai == |@ | [schendje's] | |
15 ;; | server ==== | | graphic design | TOP SECRET |
16 ;; '-------------' + sweatshop + LABORATORY |
17 ;; .--------+-----. | | |
18 ;; | deb's | '----------------'---------------'
19 ;; | communication| | | | | | | | | | <- stairs
20 ;; | cooridoor + _|_|_|_|_|_|_|_|_|
30 (define-class <fridge> (<gameobj>)
31 (name #:init-value "fridge")
32 (desc #:init-value "The refrigerator is humming. To you? To itself?
33 Only the universe knows."))
39 (define typewriter-commands
41 (direct-command "type" 'cmd-type-gibberish)
42 (indir-command "type" 'cmd-type-something)
43 (direct-greedy-command "type" 'cmd-type-anything)))
45 (define typewriter-actions
47 (cmd-type-gibberish (wrap-apply typewriter-cmd-type-gibberish))
48 (cmd-type-something (wrap-apply typewriter-cmd-type-something))
49 (cmd-type-anything (wrap-apply typewriter-cmd-type-anything))))
51 (define typewriter-dispatch
52 (simple-dispatcher (append typewriter-actions
55 (define-class <typewriter> (<gameobj>)
56 (name #:init-value "fancy typewriter")
57 (goes-by #:init-value '("typewriter"
59 (commands #:init-value typewriter-commands)
62 (wrap-apply typewriter-dispatch)))
64 (define-mhandler (typewriter-cmd-type-gibberish actor message)
65 (<- actor (message-from message) 'tell
66 #:text "*tikka takka!* *tikka takka!*
67 You type some gibberish on the typewriter.\n"))
69 (define (type-thing actor message type-text)
70 (<- actor (message-from message) 'tell
72 (format #f "You type out a note.\nThe note says: ~s\n"
75 (define-mhandler (typewriter-cmd-type-something
76 actor message direct-obj indir-obj)
77 (type-thing actor message direct-obj))
79 (define-mhandler (typewriter-cmd-type-anything
80 actor message direct-obj rest)
81 (type-thing actor message rest))
88 (define wooden-unlocked-door "A wooden door. It appears to be unlocked.")
89 (define metal-stiff-door "A stiff metal door.
90 It looks like with a hard shove, you could step through it.")
93 (define-syntax-rule (lol (list-contents ...) ...)
94 (list (list list-contents ...) ...))
100 #:name "The dootacenter"
102 "You've entered the server room. The isles alternate between hot and
103 cold here. It's not not very comfortable in here, and the combined
104 noise of hundreds, maybe thousands, of fans and various computing
105 mechanisms creates an unpleasant din. Who'd choose to work in such a
107 Still, you have to admit that all the machines look pretty nice."
108 ;; TODO: Allow walking around further in the dootacenter.
112 #:to-symbol 'room:north-hallway
113 #:desc wooden-unlocked-door))) ; eventually make this locked so you have
114 ; to kick it down, joeyh style!
117 #:name "North hallway"
119 "You're at the north end of the hallway. An open window gives a nice
120 breeze, and the curtains dance merrily in the wind. Outside appears
121 to be a pleasant looking lawn.
122 The hallway continues to the south. There are some doors to the east
127 #:to-symbol 'room:server-room
128 #:desc wooden-unlocked-door)
131 #:to-symbol 'room:code-a-plex
132 #:desc metal-stiff-door)
135 ;; #:to-symbol 'center-hallway)
140 #:name "Joar's Code-A-Plex"
142 "You've entered Joar's Code-A-Plex. What that means is anyone's guess.
143 Joar apparently hangs out in here sometimes, but you don't see him here right
145 There's a row of computer desks. Most of them have computers already on them,
146 But one looks invitingly empty."
150 #:to-symbol 'room:north-hallway
151 #:desc metal-stiff-door)))
154 <typewriter> 'room:code-a-plex)
157 <fridge> 'room:code-a-plex)))
159 ;; (room:hallway-intersection
161 ;; #:name "Hallway intersection"
162 ;; #:desc "You're at the hallway intersection. To the east is a door
163 ;; labeled \"get to work!\". The hallway continues to the west and to the
166 ;; ,(list (make <exit>
168 ;; #:to-symbol 'room:))
171 (define (goblin-demo . args)
172 (run-demo "/tmp/goblin-game.db" goblin-rooms 'room:north-hallway))