Commit | Line | Data |
---|---|---|
6e44da43 | 1 | ;;; dunnet.el --- text adventure for Emacs |
62078373 | 2 | |
c4f90182 | 3 | ;; Copyright (C) 1992, 1993, 2001 Free Software Foundation, Inc. |
b578f267 | 4 | |
058c1767 | 5 | ;; Author: Ron Schnell <ronnie@driver-aces.com> |
62078373 | 6 | ;; Created: 25 Jul 1992 |
058c1767 | 7 | ;; Version: 2.01 |
62078373 | 8 | ;; Keywords: games |
62078373 RS |
9 | |
10 | ;; This file is part of GNU Emacs. | |
11 | ||
12 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
13 | ;; it under the terms of the GNU General Public License as published by | |
14 | ;; the Free Software Foundation; either version 2, or (at your option) | |
15 | ;; any later version. | |
16 | ||
17 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;; GNU General Public License for more details. | |
21 | ||
22 | ;; You should have received a copy of the GNU General Public License | |
b578f267 EN |
23 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
24 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
25 | ;; Boston, MA 02111-1307, USA. | |
62078373 RS |
26 | |
27 | ;;; Commentary: | |
28 | ||
29 | ;; This game can be run in batch mode. To do this, use: | |
a399c536 | 30 | ;; emacs -batch -l dunnet |
62078373 | 31 | |
a1506d29 | 32 | ;;; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
62078373 | 33 | ;;; The log file should be set for your system, and it must |
163d1767 | 34 | ;;; be writable by all. |
62078373 | 35 | |
6e44da43 PJ |
36 | ;;; Code: |
37 | ||
323f7c49 SE |
38 | (defgroup dunnet nil |
39 | "Text adventure for Emacs." | |
40 | :prefix "dun-" | |
41 | :group 'games) | |
42 | ||
43 | (defcustom dun-log-file "/usr/local/dunnet.score" | |
44 | "Name of file to store score information for dunnet." | |
45 | :type 'file | |
46 | :group 'dunnet) | |
62078373 RS |
47 | |
48 | (if nil | |
49 | (eval-and-compile (setq byte-compile-warnings nil))) | |
50 | ||
3e2b8c1c RS |
51 | (eval-when-compile |
52 | (require 'cl)) | |
62078373 RS |
53 | |
54 | ;;;; Mode definitions for interactive mode | |
55 | ||
a399c536 RS |
56 | (defun dun-mode () |
57 | "Major mode for running dunnet." | |
62078373 RS |
58 | (interactive) |
59 | (text-mode) | |
3e2b8c1c RS |
60 | (make-local-variable 'scroll-step) |
61 | (setq scroll-step 2) | |
62078373 | 62 | (use-local-map dungeon-mode-map) |
c4f90182 | 63 | (setq major-mode 'dun-mode) |
62078373 RS |
64 | (setq mode-name "Dungeon")) |
65 | ||
a399c536 RS |
66 | (defun dun-parse (arg) |
67 | "Function called when return is pressed in interactive mode to parse line." | |
62078373 RS |
68 | (interactive "*p") |
69 | (beginning-of-line) | |
70 | (setq beg (+ (point) 1)) | |
71 | (end-of-line) | |
72 | (if (and (not (= beg (point))) (not (< (point) beg)) | |
73 | (string= ">" (buffer-substring (- beg 1) beg))) | |
74 | (progn | |
75 | (setq line (downcase (buffer-substring beg (point)))) | |
76 | (princ line) | |
a399c536 RS |
77 | (if (eq (dun-vparse dun-ignore dun-verblist line) -1) |
78 | (dun-mprinc "I don't understand that.\n"))) | |
62078373 | 79 | (goto-char (point-max)) |
a399c536 RS |
80 | (dun-mprinc "\n")) |
81 | (dun-messages)) | |
a1506d29 | 82 | |
a399c536 RS |
83 | (defun dun-messages () |
84 | (if dun-dead | |
62078373 RS |
85 | (text-mode) |
86 | (if (eq dungeon-mode 'dungeon) | |
87 | (progn | |
a399c536 | 88 | (if (not (= room dun-current-room)) |
62078373 | 89 | (progn |
a399c536 RS |
90 | (dun-describe-room dun-current-room) |
91 | (setq room dun-current-room))) | |
92 | (dun-fix-screen) | |
93 | (dun-mprinc ">"))))) | |
62078373 RS |
94 | |
95 | \f | |
96 | ;;;###autoload | |
97 | (defun dunnet () | |
98 | "Switch to *dungeon* buffer and start game." | |
99 | (interactive) | |
100 | (switch-to-buffer "*dungeon*") | |
a399c536 RS |
101 | (dun-mode) |
102 | (setq dun-dead nil) | |
62078373 | 103 | (setq room 0) |
a399c536 | 104 | (dun-messages)) |
62078373 RS |
105 | |
106 | ;;;; | |
107 | ;;;; This section contains all of the verbs and commands. | |
108 | ;;;; | |
109 | ||
110 | ;;; Give long description of room if haven't been there yet. Otherwise | |
111 | ;;; short. Also give long if we were called with negative room number. | |
112 | ||
a399c536 | 113 | (defun dun-describe-room (room) |
a1506d29 | 114 | (if (and (not (member (abs room) dun-light-rooms)) |
a399c536 RS |
115 | (not (member obj-lamp dun-inventory))) |
116 | (dun-mprincl "It is pitch dark. You are likely to be eaten by a grue.") | |
117 | (dun-mprincl (cadr (nth (abs room) dun-rooms))) | |
a1506d29 | 118 | (if (and (and (or (member room dun-visited) |
a399c536 RS |
119 | (string= dun-mode "dun-superb")) (> room 0)) |
120 | (not (string= dun-mode "long"))) | |
62078373 | 121 | nil |
a399c536 RS |
122 | (dun-mprinc (car (nth (abs room) dun-rooms))) |
123 | (dun-mprinc "\n")) | |
124 | (if (not (string= dun-mode "long")) | |
125 | (if (not (member (abs room) dun-visited)) | |
126 | (setq dun-visited (append (list (abs room)) dun-visited)))) | |
127 | (dolist (xobjs (nth dun-current-room dun-room-objects)) | |
62078373 | 128 | (if (= xobjs obj-special) |
a399c536 | 129 | (dun-special-object) |
62078373 | 130 | (if (>= xobjs 0) |
a399c536 RS |
131 | (dun-mprincl (car (nth xobjs dun-objects))) |
132 | (if (not (and (= xobjs obj-bus) dun-inbus)) | |
62078373 | 133 | (progn |
a399c536 RS |
134 | (dun-mprincl (car (nth (abs xobjs) dun-perm-objects))))))) |
135 | (if (and (= xobjs obj-jar) dun-jar) | |
62078373 | 136 | (progn |
a399c536 RS |
137 | (dun-mprincl "The jar contains:") |
138 | (dolist (x dun-jar) | |
139 | (dun-mprinc " ") | |
140 | (dun-mprincl (car (nth x dun-objects))))))) | |
141 | (if (and (member obj-bus (nth dun-current-room dun-room-objects)) dun-inbus) | |
142 | (dun-mprincl "You are on the bus.")))) | |
62078373 RS |
143 | |
144 | ;;; There is a special object in the room. This object's description, | |
145 | ;;; or lack thereof, depends on certain conditions. | |
146 | ||
a399c536 | 147 | (defun dun-special-object () |
a399c536 RS |
148 | (if (= dun-current-room computer-room) |
149 | (if dun-computer | |
a1506d29 | 150 | (dun-mprincl |
62078373 | 151 | "The panel lights are flashing in a seemingly organized pattern.") |
a399c536 | 152 | (dun-mprincl "The panel lights are steady and motionless."))) |
62078373 | 153 | |
a1506d29 | 154 | (if (and (= dun-current-room red-room) |
a399c536 RS |
155 | (not (member obj-towel (nth red-room dun-room-objects)))) |
156 | (dun-mprincl "There is a hole in the floor here.")) | |
62078373 | 157 | |
a399c536 | 158 | (if (and (= dun-current-room marine-life-area) dun-black) |
a1506d29 JB |
159 | (dun-mprincl |
160 | "The room is lit by a black light, causing the fish, and some of | |
62078373 | 161 | your objects, to give off an eerie glow.")) |
a399c536 | 162 | (if (and (= dun-current-room fourth-vermont-intersection) dun-hole) |
62078373 | 163 | (progn |
60d38d30 RS |
164 | (if (not dun-inbus) |
165 | (progn | |
166 | (dun-mprincl"You fall into a hole in the ground.") | |
167 | (setq dun-current-room vermont-station) | |
168 | (dun-describe-room vermont-station)) | |
169 | (progn | |
a1506d29 | 170 | (dun-mprincl |
60d38d30 RS |
171 | "The bus falls down a hole in the ground and explodes.") |
172 | (dun-die "burning"))))) | |
62078373 | 173 | |
a399c536 | 174 | (if (> dun-current-room endgame-computer-room) |
62078373 | 175 | (progn |
a399c536 RS |
176 | (if (not dun-correct-answer) |
177 | (dun-endgame-question) | |
178 | (dun-mprincl "Your question is:") | |
179 | (dun-mprincl dun-endgame-question)))) | |
62078373 | 180 | |
a399c536 | 181 | (if (= dun-current-room sauna) |
62078373 | 182 | (progn |
a399c536 | 183 | (dun-mprincl (nth dun-sauna-level '( |
62078373 RS |
184 | "It is normal room temperature in here." |
185 | "It is luke warm in here." | |
186 | "It is comfortably hot in here." | |
187 | "It is refreshingly hot in here." | |
188 | "You are dead now."))) | |
a1506d29 | 189 | (if (= dun-sauna-level 3) |
62078373 | 190 | (progn |
058c1767 RS |
191 | (if (or (member obj-rms dun-inventory) |
192 | (member obj-rms (nth dun-current-room dun-room-objects))) | |
193 | (progn | |
a1506d29 | 194 | (dun-mprincl |
62078373 RS |
195 | "You notice the wax on your statuette beginning to melt, until it completely |
196 | melts off. You are left with a beautiful diamond!") | |
058c1767 RS |
197 | (if (member obj-rms dun-inventory) |
198 | (progn | |
199 | (dun-remove-obj-from-inven obj-rms) | |
a1506d29 | 200 | (setq dun-inventory (append dun-inventory |
058c1767 RS |
201 | (list obj-diamond)))) |
202 | (dun-remove-obj-from-room dun-current-room obj-rms) | |
203 | (dun-replace dun-room-objects dun-current-room | |
204 | (append (nth dun-current-room dun-room-objects) | |
205 | (list obj-diamond)))))) | |
206 | (if (or (member obj-floppy dun-inventory) | |
207 | (member obj-floppy (nth dun-current-room dun-room-objects))) | |
62078373 | 208 | (progn |
a399c536 | 209 | (dun-mprincl |
a1506d29 | 210 | "You notice your floppy disk beginning to melt. As you grab for it, the |
62078373 | 211 | disk bursts into flames, and disintegrates.") |
a399c536 | 212 | (dun-remove-obj-from-inven obj-floppy) |
058c1767 RS |
213 | (dun-remove-obj-from-room dun-current-room obj-floppy)))))))) |
214 | ||
62078373 | 215 | |
a399c536 RS |
216 | (defun dun-die (murderer) |
217 | (dun-mprinc "\n") | |
62078373 | 218 | (if murderer |
a399c536 RS |
219 | (dun-mprincl "You are dead.")) |
220 | (dun-do-logfile 'dun-die murderer) | |
221 | (dun-score nil) | |
222 | (setq dun-dead t)) | |
62078373 | 223 | |
a399c536 RS |
224 | (defun dun-quit (args) |
225 | (dun-die nil)) | |
62078373 RS |
226 | |
227 | ;;; Print every object in player's inventory. Special case for the jar, | |
228 | ;;; as we must also print what is in it. | |
229 | ||
a399c536 RS |
230 | (defun dun-inven (args) |
231 | (dun-mprinc "You currently have:") | |
232 | (dun-mprinc "\n") | |
233 | (dolist (curobj dun-inventory) | |
62078373 RS |
234 | (if curobj |
235 | (progn | |
a399c536 RS |
236 | (dun-mprincl (cadr (nth curobj dun-objects))) |
237 | (if (and (= curobj obj-jar) dun-jar) | |
62078373 | 238 | (progn |
a399c536 RS |
239 | (dun-mprincl "The jar contains:") |
240 | (dolist (x dun-jar) | |
241 | (dun-mprinc " ") | |
242 | (dun-mprincl (cadr (nth x dun-objects)))))))))) | |
62078373 | 243 | |
a399c536 | 244 | (defun dun-shake (obj) |
62078373 | 245 | (let (objnum) |
a399c536 RS |
246 | (when (setq objnum (dun-objnum-from-args-std obj)) |
247 | (if (member objnum dun-inventory) | |
62078373 RS |
248 | (progn |
249 | ;;; If shaking anything will do anything, put here. | |
a399c536 RS |
250 | (dun-mprinc "Shaking ") |
251 | (dun-mprinc (downcase (cadr (nth objnum dun-objects)))) | |
252 | (dun-mprinc " seems to have no effect.") | |
253 | (dun-mprinc "\n") | |
62078373 | 254 | ) |
a399c536 RS |
255 | (if (and (not (member objnum (nth dun-current-room dun-room-silents))) |
256 | (not (member objnum (nth dun-current-room dun-room-objects)))) | |
257 | (dun-mprincl "I don't see that here.") | |
62078373 RS |
258 | ;;; Shaking trees can be deadly |
259 | (if (= objnum obj-tree) | |
260 | (progn | |
a399c536 | 261 | (dun-mprinc |
62078373 RS |
262 | "You begin to shake a tree, and notice a coconut begin to fall from the air. |
263 | As you try to get your hand up to block it, you feel the impact as it lands | |
264 | on your head.") | |
a399c536 | 265 | (dun-die "a coconut")) |
62078373 RS |
266 | (if (= objnum obj-bear) |
267 | (progn | |
a399c536 | 268 | (dun-mprinc |
62078373 | 269 | "As you go up to the bear, it removes your head and places it on the ground.") |
a399c536 | 270 | (dun-die "a bear")) |
62078373 | 271 | (if (< objnum 0) |
a399c536 RS |
272 | (dun-mprincl "You cannot shake that.") |
273 | (dun-mprincl "You don't have that."))))))))) | |
62078373 RS |
274 | |
275 | ||
a399c536 RS |
276 | (defun dun-drop (obj) |
277 | (if dun-inbus | |
278 | (dun-mprincl "You can't drop anything while on the bus.") | |
62078373 | 279 | (let (objnum ptr) |
a399c536 RS |
280 | (when (setq objnum (dun-objnum-from-args-std obj)) |
281 | (if (not (setq ptr (member objnum dun-inventory))) | |
282 | (dun-mprincl "You don't have that.") | |
62078373 | 283 | (progn |
a399c536 RS |
284 | (dun-remove-obj-from-inven objnum) |
285 | (dun-replace dun-room-objects dun-current-room | |
286 | (append (nth dun-current-room dun-room-objects) | |
62078373 | 287 | (list objnum))) |
a399c536 | 288 | (dun-mprincl "Done.") |
62078373 | 289 | (if (member objnum (list obj-food obj-weight obj-jar)) |
a399c536 | 290 | (dun-drop-check objnum)))))))) |
62078373 RS |
291 | |
292 | ;;; Dropping certain things causes things to happen. | |
293 | ||
a399c536 | 294 | (defun dun-drop-check (objnum) |
62078373 | 295 | (if (and (= objnum obj-food) (= room bear-hangout) |
a399c536 | 296 | (member obj-bear (nth bear-hangout dun-room-objects))) |
62078373 | 297 | (progn |
a399c536 | 298 | (dun-mprincl |
62078373 | 299 | "The bear takes the food and runs away with it. He left something behind.") |
a399c536 RS |
300 | (dun-remove-obj-from-room dun-current-room obj-bear) |
301 | (dun-remove-obj-from-room dun-current-room obj-food) | |
302 | (dun-replace dun-room-objects dun-current-room | |
303 | (append (nth dun-current-room dun-room-objects) | |
62078373 RS |
304 | (list obj-key))))) |
305 | ||
a1506d29 | 306 | (if (and (= objnum obj-jar) (member obj-nitric dun-jar) |
a399c536 | 307 | (member obj-glycerine dun-jar)) |
62078373 | 308 | (progn |
a1506d29 | 309 | (dun-mprincl |
a399c536 RS |
310 | "As the jar impacts the ground it explodes into many pieces.") |
311 | (setq dun-jar nil) | |
312 | (dun-remove-obj-from-room dun-current-room obj-jar) | |
313 | (if (= dun-current-room fourth-vermont-intersection) | |
62078373 | 314 | (progn |
a399c536 RS |
315 | (setq dun-hole t) |
316 | (setq dun-current-room vermont-station) | |
a1506d29 | 317 | (dun-mprincl |
62078373 RS |
318 | "The explosion causes a hole to open up in the ground, which you fall |
319 | through."))))) | |
320 | ||
a399c536 RS |
321 | (if (and (= objnum obj-weight) (= dun-current-room maze-button-room)) |
322 | (dun-mprincl "A passageway opens."))) | |
62078373 RS |
323 | |
324 | ;;; Give long description of current room, or an object. | |
a1506d29 | 325 | |
a399c536 | 326 | (defun dun-examine (obj) |
62078373 | 327 | (let (objnum) |
a399c536 | 328 | (setq objnum (dun-objnum-from-args obj)) |
62078373 | 329 | (if (eq objnum obj-special) |
a399c536 | 330 | (dun-describe-room (* dun-current-room -1)) |
62078373 | 331 | (if (and (eq objnum obj-computer) |
a399c536 RS |
332 | (member obj-pc (nth dun-current-room dun-room-silents))) |
333 | (dun-examine '("pc")) | |
62078373 | 334 | (if (eq objnum nil) |
a399c536 | 335 | (dun-mprincl "I don't know what that is.") |
a1506d29 | 336 | (if (and (not (member objnum |
a399c536 | 337 | (nth dun-current-room dun-room-objects))) |
058c1767 RS |
338 | (not (and (member obj-jar dun-inventory) |
339 | (member objnum dun-jar))) | |
a1506d29 | 340 | (not (member objnum |
a399c536 RS |
341 | (nth dun-current-room dun-room-silents))) |
342 | (not (member objnum dun-inventory))) | |
343 | (dun-mprincl "I don't see that here.") | |
62078373 | 344 | (if (>= objnum 0) |
a1506d29 | 345 | (if (and (= objnum obj-bone) |
a399c536 | 346 | (= dun-current-room marine-life-area) dun-black) |
a1506d29 | 347 | (dun-mprincl |
62078373 RS |
348 | "In this light you can see some writing on the bone. It says: |
349 | For an explosive time, go to Fourth St. and Vermont.") | |
a399c536 RS |
350 | (if (nth objnum dun-physobj-desc) |
351 | (dun-mprincl (nth objnum dun-physobj-desc)) | |
352 | (dun-mprincl "I see nothing special about that."))) | |
353 | (if (nth (abs objnum) dun-permobj-desc) | |
62078373 | 354 | (progn |
a399c536 RS |
355 | (dun-mprincl (nth (abs objnum) dun-permobj-desc))) |
356 | (dun-mprincl "I see nothing special about that."))))))))) | |
62078373 | 357 | |
a399c536 | 358 | (defun dun-take (obj) |
058c1767 RS |
359 | (setq obj (dun-firstword obj)) |
360 | (if (not obj) | |
361 | (dun-mprincl "You must supply an object.") | |
362 | (if (string= obj "all") | |
363 | (let (gotsome) | |
364 | (if dun-inbus | |
365 | (dun-mprincl "You can't take anything while on the bus.") | |
366 | (setq gotsome nil) | |
367 | (dolist (x (nth dun-current-room dun-room-objects)) | |
368 | (if (and (>= x 0) (not (= x obj-special))) | |
369 | (progn | |
370 | (setq gotsome t) | |
371 | (dun-mprinc (cadr (nth x dun-objects))) | |
372 | (dun-mprinc ": ") | |
373 | (dun-take-object x)))) | |
374 | (if (not gotsome) | |
375 | (dun-mprincl "Nothing to take.")))) | |
376 | (let (objnum) | |
377 | (setq objnum (cdr (assq (intern obj) dun-objnames))) | |
378 | (if (eq objnum nil) | |
379 | (progn | |
380 | (dun-mprinc "I don't know what that is.") | |
381 | (dun-mprinc "\n")) | |
382 | (if (and dun-inbus (not (and (member objnum dun-jar) | |
383 | (member obj-jar dun-inventory)))) | |
384 | (dun-mprincl "You can't take anything while on the bus.") | |
385 | (dun-take-object objnum))))))) | |
62078373 | 386 | |
a399c536 RS |
387 | (defun dun-take-object (objnum) |
388 | (if (and (member objnum dun-jar) (member obj-jar dun-inventory)) | |
62078373 | 389 | (let (newjar) |
a399c536 | 390 | (dun-mprincl "You remove it from the jar.") |
62078373 | 391 | (setq newjar nil) |
a399c536 | 392 | (dolist (x dun-jar) |
62078373 RS |
393 | (if (not (= x objnum)) |
394 | (setq newjar (append newjar (list x))))) | |
a399c536 RS |
395 | (setq dun-jar newjar) |
396 | (setq dun-inventory (append dun-inventory (list objnum)))) | |
397 | (if (not (member objnum (nth dun-current-room dun-room-objects))) | |
398 | (if (not (member objnum (nth dun-current-room dun-room-silents))) | |
399 | (dun-mprinc "I do not see that here.") | |
400 | (dun-try-take objnum)) | |
62078373 RS |
401 | (if (>= objnum 0) |
402 | (progn | |
a1506d29 | 403 | (if (and (car dun-inventory) |
a399c536 RS |
404 | (> (+ (dun-inven-weight) (nth objnum dun-object-lbs)) 11)) |
405 | (dun-mprinc "Your load would be too heavy.") | |
406 | (setq dun-inventory (append dun-inventory (list objnum))) | |
407 | (dun-remove-obj-from-room dun-current-room objnum) | |
408 | (dun-mprinc "Taken. ") | |
409 | (if (and (= objnum obj-towel) (= dun-current-room red-room)) | |
a1506d29 | 410 | (dun-mprinc |
a399c536 RS |
411 | "Taking the towel reveals a hole in the floor.")))) |
412 | (dun-try-take objnum))) | |
413 | (dun-mprinc "\n"))) | |
414 | ||
415 | (defun dun-inven-weight () | |
62078373 RS |
416 | (let (total) |
417 | (setq total 0) | |
a399c536 RS |
418 | (dolist (x dun-jar) |
419 | (setq total (+ total (nth x dun-object-lbs)))) | |
420 | (dolist (x dun-inventory) | |
421 | (setq total (+ total (nth x dun-object-lbs)))) total)) | |
62078373 RS |
422 | |
423 | ;;; We try to take an object that is untakable. Print a message | |
424 | ;;; depending on what it is. | |
425 | ||
a399c536 RS |
426 | (defun dun-try-take (obj) |
427 | (dun-mprinc "You cannot take that.")) | |
428 | ||
429 | (defun dun-dig (args) | |
430 | (if dun-inbus | |
058c1767 | 431 | (dun-mprincl "Digging here reveals nothing.") |
a399c536 RS |
432 | (if (not (member 0 dun-inventory)) |
433 | (dun-mprincl "You have nothing with which to dig.") | |
434 | (if (not (nth dun-current-room dun-diggables)) | |
435 | (dun-mprincl "Digging here reveals nothing.") | |
436 | (dun-mprincl "I think you found something.") | |
437 | (dun-replace dun-room-objects dun-current-room | |
438 | (append (nth dun-current-room dun-room-objects) | |
439 | (nth dun-current-room dun-diggables))) | |
440 | (dun-replace dun-diggables dun-current-room nil))))) | |
441 | ||
442 | (defun dun-climb (obj) | |
62078373 | 443 | (let (objnum) |
a399c536 | 444 | (setq objnum (dun-objnum-from-args obj)) |
058c1767 RS |
445 | (cond ((not objnum) |
446 | (dun-mprincl "I don't know what that object is.")) | |
85cff943 RS |
447 | ((and (not (eq objnum obj-special)) |
448 | (not (member objnum (nth dun-current-room dun-room-objects))) | |
449 | (not (member objnum (nth dun-current-room dun-room-silents))) | |
058c1767 | 450 | (not (and (member objnum dun-jar) (member obj-jar dun-inventory))) |
85cff943 RS |
451 | (not (member objnum dun-inventory))) |
452 | (dun-mprincl "I don't see that here.")) | |
453 | ((and (eq objnum obj-special) | |
454 | (not (member obj-tree (nth dun-current-room dun-room-silents)))) | |
455 | (dun-mprincl "There is nothing here to climb.")) | |
456 | ((and (not (eq objnum obj-tree)) (not (eq objnum obj-special))) | |
457 | (dun-mprincl "You can't climb that.")) | |
458 | (t | |
459 | (dun-mprincl | |
460 | "You manage to get about two feet up the tree and fall back down. You | |
461 | notice that the tree is very unsteady."))))) | |
62078373 | 462 | |
a399c536 | 463 | (defun dun-eat (obj) |
62078373 | 464 | (let (objnum) |
a399c536 RS |
465 | (when (setq objnum (dun-objnum-from-args-std obj)) |
466 | (if (not (member objnum dun-inventory)) | |
467 | (dun-mprincl "You don't have that.") | |
62078373 RS |
468 | (if (not (= objnum obj-food)) |
469 | (progn | |
a399c536 RS |
470 | (dun-mprinc "You forcefully shove ") |
471 | (dun-mprinc (downcase (cadr (nth objnum dun-objects)))) | |
472 | (dun-mprincl " down your throat, and start choking.") | |
473 | (dun-die "choking")) | |
474 | (dun-mprincl "That tasted horrible.") | |
475 | (dun-remove-obj-from-inven obj-food)))))) | |
476 | ||
477 | (defun dun-put (args) | |
62078373 | 478 | (let (newargs objnum objnum2 obj) |
a399c536 | 479 | (setq newargs (dun-firstwordl args)) |
62078373 | 480 | (if (not newargs) |
a399c536 | 481 | (dun-mprincl "You must supply an object") |
62078373 | 482 | (setq obj (intern (car newargs))) |
a399c536 | 483 | (setq objnum (cdr (assq obj dun-objnames))) |
62078373 | 484 | (if (not objnum) |
a399c536 RS |
485 | (dun-mprincl "I don't know what that object is.") |
486 | (if (not (member objnum dun-inventory)) | |
487 | (dun-mprincl "You don't have that.") | |
488 | (setq newargs (dun-firstwordl (cdr newargs))) | |
489 | (setq newargs (dun-firstwordl (cdr newargs))) | |
62078373 | 490 | (if (not newargs) |
a399c536 RS |
491 | (dun-mprincl "You must supply an indirect object.") |
492 | (setq objnum2 (cdr (assq (intern (car newargs)) dun-objnames))) | |
493 | (if (and (eq objnum2 obj-computer) (= dun-current-room pc-area)) | |
62078373 RS |
494 | (setq objnum2 obj-pc)) |
495 | (if (not objnum2) | |
a399c536 | 496 | (dun-mprincl "I don't know what that indirect object is.") |
a1506d29 | 497 | (if (and (not (member objnum2 |
a399c536 | 498 | (nth dun-current-room dun-room-objects))) |
a1506d29 | 499 | (not (member objnum2 |
a399c536 RS |
500 | (nth dun-current-room dun-room-silents))) |
501 | (not (member objnum2 dun-inventory))) | |
502 | (dun-mprincl "That indirect object is not here.") | |
058c1767 | 503 | (dun-put-objs objnum objnum2))))))))) |
a399c536 RS |
504 | |
505 | (defun dun-put-objs (obj1 obj2) | |
506 | (if (and (= obj2 obj-drop) (not dun-nomail)) | |
62078373 RS |
507 | (setq obj2 obj-chute)) |
508 | ||
509 | (if (= obj2 obj-disposal) (setq obj2 obj-chute)) | |
510 | ||
511 | (if (and (= obj1 obj-cpu) (= obj2 obj-computer)) | |
512 | (progn | |
a399c536 RS |
513 | (dun-remove-obj-from-inven obj-cpu) |
514 | (setq dun-computer t) | |
515 | (dun-mprincl | |
62078373 RS |
516 | "As you put the CPU board in the computer, it immediately springs to life. |
517 | The lights start flashing, and the fans seem to startup.")) | |
518 | (if (and (= obj1 obj-weight) (= obj2 obj-button)) | |
a399c536 | 519 | (dun-drop '("weight")) |
62078373 RS |
520 | (if (= obj2 obj-jar) ;; Put something in jar |
521 | (if (not (member obj1 (list obj-paper obj-diamond obj-emerald | |
522 | obj-license obj-coins obj-egg | |
523 | obj-nitric obj-glycerine))) | |
a399c536 RS |
524 | (dun-mprincl "That will not fit in the jar.") |
525 | (dun-remove-obj-from-inven obj1) | |
526 | (setq dun-jar (append dun-jar (list obj1))) | |
527 | (dun-mprincl "Done.")) | |
62078373 RS |
528 | (if (= obj2 obj-chute) ;; Put something in chute |
529 | (progn | |
a399c536 | 530 | (dun-remove-obj-from-inven obj1) |
a1506d29 | 531 | (dun-mprincl |
62078373 | 532 | "You hear it slide down the chute and off into the distance.") |
a399c536 | 533 | (dun-put-objs-in-treas (list obj1))) |
62078373 RS |
534 | (if (= obj2 obj-box) ;; Put key in key box |
535 | (if (= obj1 obj-key) | |
536 | (progn | |
a399c536 | 537 | (dun-mprincl |
62078373 RS |
538 | "As you drop the key, the box begins to shake. Finally it explodes |
539 | with a bang. The key seems to have vanished!") | |
a399c536 RS |
540 | (dun-remove-obj-from-inven obj1) |
541 | (dun-replace dun-room-objects computer-room (append | |
62078373 | 542 | (nth computer-room |
a399c536 | 543 | dun-room-objects) |
62078373 | 544 | (list obj1))) |
a399c536 RS |
545 | (dun-remove-obj-from-room dun-current-room obj-box) |
546 | (setq dun-key-level (1+ dun-key-level))) | |
547 | (dun-mprincl "You can't put that in the key box!")) | |
62078373 RS |
548 | |
549 | (if (and (= obj1 obj-floppy) (= obj2 obj-pc)) | |
550 | (progn | |
a399c536 RS |
551 | (setq dun-floppy t) |
552 | (dun-remove-obj-from-inven obj1) | |
553 | (dun-mprincl "Done.")) | |
62078373 RS |
554 | |
555 | (if (= obj2 obj-urinal) ;; Put object in urinal | |
556 | (progn | |
a399c536 | 557 | (dun-remove-obj-from-inven obj1) |
a1506d29 | 558 | (dun-replace dun-room-objects urinal (append |
a399c536 | 559 | (nth urinal dun-room-objects) |
62078373 | 560 | (list obj1))) |
a399c536 | 561 | (dun-mprincl |
62078373 RS |
562 | "You hear it plop down in some water below.")) |
563 | (if (= obj2 obj-mail) | |
a399c536 RS |
564 | (dun-mprincl "The mail chute is locked.") |
565 | (if (member obj1 dun-inventory) | |
a1506d29 | 566 | (dun-mprincl |
62078373 RS |
567 | "I don't know how to combine those objects. Perhaps you should |
568 | just try dropping it.") | |
a399c536 | 569 | (dun-mprincl"You can't put that there."))))))))))) |
62078373 | 570 | |
a399c536 RS |
571 | (defun dun-type (args) |
572 | (if (not (= dun-current-room computer-room)) | |
573 | (dun-mprincl "There is nothing here on which you could type.") | |
574 | (if (not dun-computer) | |
a1506d29 | 575 | (dun-mprincl |
62078373 | 576 | "You type on the keyboard, but your characters do not even echo.") |
a399c536 | 577 | (dun-unix-interface)))) |
62078373 RS |
578 | |
579 | ;;; Various movement directions | |
580 | ||
a399c536 RS |
581 | (defun dun-n (args) |
582 | (dun-move north)) | |
62078373 | 583 | |
a399c536 RS |
584 | (defun dun-s (args) |
585 | (dun-move south)) | |
62078373 | 586 | |
a399c536 RS |
587 | (defun dun-e (args) |
588 | (dun-move east)) | |
62078373 | 589 | |
a399c536 RS |
590 | (defun dun-w (args) |
591 | (dun-move west)) | |
62078373 | 592 | |
a399c536 RS |
593 | (defun dun-ne (args) |
594 | (dun-move northeast)) | |
62078373 | 595 | |
a399c536 RS |
596 | (defun dun-se (args) |
597 | (dun-move southeast)) | |
62078373 | 598 | |
a399c536 RS |
599 | (defun dun-nw (args) |
600 | (dun-move northwest)) | |
62078373 | 601 | |
a399c536 RS |
602 | (defun dun-sw (args) |
603 | (dun-move southwest)) | |
62078373 | 604 | |
a399c536 RS |
605 | (defun dun-up (args) |
606 | (dun-move up)) | |
62078373 | 607 | |
a399c536 RS |
608 | (defun dun-down (args) |
609 | (dun-move down)) | |
62078373 | 610 | |
a399c536 RS |
611 | (defun dun-in (args) |
612 | (dun-move in)) | |
62078373 | 613 | |
a399c536 RS |
614 | (defun dun-out (args) |
615 | (dun-move out)) | |
62078373 | 616 | |
a399c536 | 617 | (defun dun-go (args) |
a1506d29 JB |
618 | (if (or (not (car args)) |
619 | (eq (dun-doverb dun-ignore dun-verblist (car args) | |
a399c536 RS |
620 | (cdr (cdr args))) -1)) |
621 | (dun-mprinc "I don't understand where you want me to go.\n"))) | |
62078373 RS |
622 | |
623 | ;;; Uses the dungeon-map to figure out where we are going. If the | |
624 | ;;; requested direction yields 255, we know something special is | |
625 | ;;; supposed to happen, or perhaps you can't go that way unless | |
626 | ;;; certain conditions are met. | |
627 | ||
a399c536 | 628 | (defun dun-move (dir) |
a1506d29 | 629 | (if (and (not (member dun-current-room dun-light-rooms)) |
a399c536 | 630 | (not (member obj-lamp dun-inventory))) |
62078373 | 631 | (progn |
a1506d29 | 632 | (dun-mprinc |
62078373 RS |
633 | "You trip over a grue and fall into a pit and break every bone in your |
634 | body.") | |
a399c536 | 635 | (dun-die "a grue")) |
62078373 | 636 | (let (newroom) |
a399c536 | 637 | (setq newroom (nth dir (nth dun-current-room dungeon-map))) |
62078373 | 638 | (if (eq newroom -1) |
a399c536 | 639 | (dun-mprinc "You can't go that way.\n") |
62078373 | 640 | (if (eq newroom 255) |
a399c536 | 641 | (dun-special-move dir) |
62078373 | 642 | (setq room -1) |
a399c536 RS |
643 | (setq dun-lastdir dir) |
644 | (if dun-inbus | |
62078373 RS |
645 | (progn |
646 | (if (or (< newroom 58) (> newroom 83)) | |
a399c536 | 647 | (dun-mprincl "The bus cannot go this way.") |
a1506d29 | 648 | (dun-mprincl |
62078373 | 649 | "The bus lurches ahead and comes to a screeching halt.") |
a399c536 RS |
650 | (dun-remove-obj-from-room dun-current-room obj-bus) |
651 | (setq dun-current-room newroom) | |
652 | (dun-replace dun-room-objects newroom | |
653 | (append (nth newroom dun-room-objects) | |
62078373 | 654 | (list obj-bus))))) |
a399c536 | 655 | (setq dun-current-room newroom))))))) |
62078373 RS |
656 | |
657 | ;;; Movement in this direction causes something special to happen if the | |
658 | ;;; right conditions exist. It may be that you can't go this way unless | |
659 | ;;; you have a key, or a passage has been opened. | |
660 | ||
661 | ;;; coding note: Each check of the current room is on the same 'if' level, | |
662 | ;;; i.e. there aren't else's. If two rooms next to each other have | |
663 | ;;; specials, and they are connected by specials, this could cause | |
664 | ;;; a problem. Be careful when adding them to consider this, and | |
665 | ;;; perhaps use else's. | |
666 | ||
a399c536 RS |
667 | (defun dun-special-move (dir) |
668 | (if (= dun-current-room building-front) | |
669 | (if (not (member obj-key dun-inventory)) | |
670 | (dun-mprincl "You don't have a key that can open this door.") | |
671 | (setq dun-current-room old-building-hallway)) | |
672 | (if (= dun-current-room north-end-of-cave-passage) | |
62078373 | 673 | (let (combo) |
a1506d29 | 674 | (dun-mprincl |
62078373 | 675 | "You must type a 3 digit combination code to enter this room.") |
a399c536 RS |
676 | (dun-mprinc "Enter it here: ") |
677 | (setq combo (dun-read-line)) | |
678 | (if (not dun-batch-mode) | |
679 | (dun-mprinc "\n")) | |
680 | (if (string= combo dun-combination) | |
681 | (setq dun-current-room gamma-computing-center) | |
682 | (dun-mprincl "Sorry, that combination is incorrect.")))) | |
683 | ||
684 | (if (= dun-current-room bear-hangout) | |
685 | (if (member obj-bear (nth bear-hangout dun-room-objects)) | |
62078373 | 686 | (progn |
a1506d29 | 687 | (dun-mprinc |
62078373 RS |
688 | "The bear is very annoyed that you would be so presumptuous as to try |
689 | and walk right by it. He tells you so by tearing your head off. | |
690 | ") | |
a399c536 RS |
691 | (dun-die "a bear")) |
692 | (dun-mprincl "You can't go that way."))) | |
62078373 | 693 | |
a399c536 | 694 | (if (= dun-current-room vermont-station) |
62078373 | 695 | (progn |
a399c536 | 696 | (dun-mprincl |
62078373 RS |
697 | "As you board the train it immediately leaves the station. It is a very |
698 | bumpy ride. It is shaking from side to side, and up and down. You | |
699 | sit down in one of the chairs in order to be more comfortable.") | |
a399c536 | 700 | (dun-mprincl |
62078373 RS |
701 | "\nFinally the train comes to a sudden stop, and the doors open, and some |
702 | force throws you out. The train speeds away.\n") | |
a399c536 RS |
703 | (setq dun-current-room museum-station))) |
704 | ||
705 | (if (= dun-current-room old-building-hallway) | |
706 | (if (and (member obj-key dun-inventory) | |
707 | (> dun-key-level 0)) | |
708 | (setq dun-current-room meadow) | |
709 | (dun-mprincl "You don't have a key that can open this door."))) | |
710 | ||
711 | (if (and (= dun-current-room maze-button-room) (= dir northwest)) | |
712 | (if (member obj-weight (nth maze-button-room dun-room-objects)) | |
713 | (setq dun-current-room 18) | |
714 | (dun-mprincl "You can't go that way."))) | |
715 | ||
716 | (if (and (= dun-current-room maze-button-room) (= dir up)) | |
717 | (if (member obj-weight (nth maze-button-room dun-room-objects)) | |
718 | (dun-mprincl "You can't go that way.") | |
719 | (setq dun-current-room weight-room))) | |
720 | ||
721 | (if (= dun-current-room classroom) | |
722 | (dun-mprincl "The door is locked.")) | |
723 | ||
a1506d29 | 724 | (if (or (= dun-current-room lakefront-north) |
a399c536 RS |
725 | (= dun-current-room lakefront-south)) |
726 | (dun-swim nil)) | |
727 | ||
728 | (if (= dun-current-room reception-area) | |
729 | (if (not (= dun-sauna-level 3)) | |
730 | (setq dun-current-room health-club-front) | |
731 | (dun-mprincl | |
62078373 RS |
732 | "As you exit the building, you notice some flames coming out of one of the |
733 | windows. Suddenly, the building explodes in a huge ball of fire. The flames | |
734 | engulf you, and you burn to death.") | |
a399c536 | 735 | (dun-die "burning"))) |
62078373 | 736 | |
a399c536 RS |
737 | (if (= dun-current-room red-room) |
738 | (if (not (member obj-towel (nth red-room dun-room-objects))) | |
739 | (setq dun-current-room long-n-s-hallway) | |
740 | (dun-mprincl "You can't go that way."))) | |
62078373 | 741 | |
a1506d29 | 742 | (if (and (> dir down) (> dun-current-room gamma-computing-center) |
a399c536 RS |
743 | (< dun-current-room museum-lobby)) |
744 | (if (not (member obj-bus (nth dun-current-room dun-room-objects))) | |
745 | (dun-mprincl "You can't go that way.") | |
62078373 | 746 | (if (= dir in) |
058c1767 RS |
747 | (if dun-inbus |
748 | (dun-mprincl | |
749 | "You are already in the bus!") | |
750 | (if (member obj-license dun-inventory) | |
751 | (progn | |
a1506d29 | 752 | (dun-mprincl |
058c1767 RS |
753 | "You board the bus and get in the driver's seat.") |
754 | (setq dun-nomail t) | |
755 | (setq dun-inbus t)) | |
756 | (dun-mprincl "You are not licensed for this type of vehicle."))) | |
757 | (if (not dun-inbus) | |
758 | (dun-mprincl "You are already off the bus!") | |
759 | (dun-mprincl "You hop off the bus.") | |
760 | (setq dun-inbus nil)))) | |
a399c536 RS |
761 | (if (= dun-current-room fifth-oaktree-intersection) |
762 | (if (not dun-inbus) | |
62078373 | 763 | (progn |
a399c536 RS |
764 | (dun-mprincl "You fall down the cliff and land on your head.") |
765 | (dun-die "a cliff")) | |
766 | (dun-mprincl | |
62078373 | 767 | "The bus flies off the cliff, and plunges to the bottom, where it explodes.") |
a399c536 RS |
768 | (dun-die "a bus accident"))) |
769 | (if (= dun-current-room main-maple-intersection) | |
62078373 | 770 | (progn |
a399c536 RS |
771 | (if (not dun-inbus) |
772 | (dun-mprincl "The gate will not open.") | |
773 | (dun-mprincl | |
62078373 | 774 | "As the bus approaches, the gate opens and you drive through.") |
a399c536 | 775 | (dun-remove-obj-from-room main-maple-intersection obj-bus) |
a1506d29 | 776 | (dun-replace dun-room-objects museum-entrance |
a399c536 | 777 | (append (nth museum-entrance dun-room-objects) |
62078373 | 778 | (list obj-bus))) |
a399c536 RS |
779 | (setq dun-current-room museum-entrance))))) |
780 | (if (= dun-current-room cave-entrance) | |
62078373 | 781 | (progn |
a399c536 | 782 | (dun-mprincl |
62078373 RS |
783 | "As you enter the room you hear a rumbling noise. You look back to see |
784 | huge rocks sliding down from the ceiling, and blocking your way out.\n") | |
a399c536 | 785 | (setq dun-current-room misty-room))))) |
62078373 | 786 | |
a399c536 RS |
787 | (defun dun-long (args) |
788 | (setq dun-mode "long")) | |
62078373 | 789 | |
a399c536 | 790 | (defun dun-turn (obj) |
62078373 | 791 | (let (objnum direction) |
a399c536 RS |
792 | (when (setq objnum (dun-objnum-from-args-std obj)) |
793 | (if (not (or (member objnum (nth dun-current-room dun-room-objects)) | |
794 | (member objnum (nth dun-current-room dun-room-silents)))) | |
795 | (dun-mprincl "I don't see that here.") | |
62078373 | 796 | (if (not (= objnum obj-dial)) |
a399c536 RS |
797 | (dun-mprincl "You can't turn that.") |
798 | (setq direction (dun-firstword (cdr obj))) | |
a1506d29 | 799 | (if (or (not direction) |
62078373 RS |
800 | (not (or (string= direction "clockwise") |
801 | (string= direction "counterclockwise")))) | |
a399c536 | 802 | (dun-mprincl "You must indicate clockwise or counterclockwise.") |
62078373 | 803 | (if (string= direction "clockwise") |
a399c536 RS |
804 | (setq dun-sauna-level (+ dun-sauna-level 1)) |
805 | (setq dun-sauna-level (- dun-sauna-level 1))) | |
a1506d29 | 806 | |
a399c536 | 807 | (if (< dun-sauna-level 0) |
62078373 | 808 | (progn |
a1506d29 | 809 | (dun-mprincl |
62078373 | 810 | "The dial will not turn further in that direction.") |
a399c536 RS |
811 | (setq dun-sauna-level 0)) |
812 | (dun-sauna-heat)))))))) | |
813 | ||
814 | (defun dun-sauna-heat () | |
815 | (if (= dun-sauna-level 0) | |
a1506d29 | 816 | (dun-mprincl |
163d1767 | 817 | "The temperature has returned to normal room temperature.")) |
a399c536 | 818 | (if (= dun-sauna-level 1) |
058c1767 | 819 | (dun-mprincl "It is now luke warm in here. You are perspiring.")) |
a399c536 RS |
820 | (if (= dun-sauna-level 2) |
821 | (dun-mprincl "It is pretty hot in here. It is still very comfortable.")) | |
822 | (if (= dun-sauna-level 3) | |
62078373 | 823 | (progn |
a1506d29 | 824 | (dun-mprincl |
62078373 | 825 | "It is now very hot. There is something very refreshing about this.") |
a1506d29 | 826 | (if (or (member obj-rms dun-inventory) |
a399c536 | 827 | (member obj-rms (nth dun-current-room dun-room-objects))) |
62078373 | 828 | (progn |
a1506d29 | 829 | (dun-mprincl |
62078373 RS |
830 | "You notice the wax on your statuette beginning to melt, until it completely |
831 | melts off. You are left with a beautiful diamond!") | |
a399c536 | 832 | (if (member obj-rms dun-inventory) |
62078373 | 833 | (progn |
a399c536 | 834 | (dun-remove-obj-from-inven obj-rms) |
a1506d29 | 835 | (setq dun-inventory (append dun-inventory |
a399c536 RS |
836 | (list obj-diamond)))) |
837 | (dun-remove-obj-from-room dun-current-room obj-rms) | |
838 | (dun-replace dun-room-objects dun-current-room | |
839 | (append (nth dun-current-room dun-room-objects) | |
62078373 | 840 | (list obj-diamond)))))) |
a399c536 RS |
841 | (if (or (member obj-floppy dun-inventory) |
842 | (member obj-floppy (nth dun-current-room dun-room-objects))) | |
62078373 | 843 | (progn |
a399c536 | 844 | (dun-mprincl |
a1506d29 | 845 | "You notice your floppy disk beginning to melt. As you grab for it, the |
62078373 | 846 | disk bursts into flames, and disintegrates.") |
a399c536 RS |
847 | (if (member obj-floppy dun-inventory) |
848 | (dun-remove-obj-from-inven obj-floppy) | |
849 | (dun-remove-obj-from-room dun-current-room obj-floppy)))))) | |
62078373 | 850 | |
a399c536 | 851 | (if (= dun-sauna-level 4) |
62078373 | 852 | (progn |
a1506d29 | 853 | (dun-mprincl |
62078373 | 854 | "As the dial clicks into place, you immediately burst into flames.") |
a399c536 | 855 | (dun-die "burning")))) |
62078373 | 856 | |
a399c536 | 857 | (defun dun-press (obj) |
62078373 | 858 | (let (objnum) |
a399c536 RS |
859 | (when (setq objnum (dun-objnum-from-args-std obj)) |
860 | (if (not (or (member objnum (nth dun-current-room dun-room-objects)) | |
861 | (member objnum (nth dun-current-room dun-room-silents)))) | |
862 | (dun-mprincl "I don't see that here.") | |
62078373 RS |
863 | (if (not (member objnum (list obj-button obj-switch))) |
864 | (progn | |
a399c536 RS |
865 | (dun-mprinc "You can't ") |
866 | (dun-mprinc (car line-list)) | |
867 | (dun-mprincl " that.")) | |
62078373 | 868 | (if (= objnum obj-button) |
a399c536 | 869 | (dun-mprincl |
62078373 RS |
870 | "As you press the button, you notice a passageway open up, but |
871 | as you release it, the passageway closes.")) | |
872 | (if (= objnum obj-switch) | |
a399c536 | 873 | (if dun-black |
62078373 | 874 | (progn |
a399c536 RS |
875 | (dun-mprincl "The button is now in the off position.") |
876 | (setq dun-black nil)) | |
877 | (dun-mprincl "The button is now in the on position.") | |
878 | (setq dun-black t)))))))) | |
879 | ||
880 | (defun dun-swim (args) | |
881 | (if (not (member dun-current-room (list lakefront-north lakefront-south))) | |
882 | (dun-mprincl "I see no water!") | |
883 | (if (not (member obj-life dun-inventory)) | |
62078373 | 884 | (progn |
a1506d29 | 885 | (dun-mprincl |
62078373 RS |
886 | "You dive in the water, and at first notice it is quite cold. You then |
887 | start to get used to it as you realize that you never really learned how | |
888 | to swim.") | |
a399c536 RS |
889 | (dun-die "drowning")) |
890 | (if (= dun-current-room lakefront-north) | |
891 | (setq dun-current-room lakefront-south) | |
892 | (setq dun-current-room lakefront-north))))) | |
62078373 RS |
893 | |
894 | ||
a399c536 RS |
895 | (defun dun-score (args) |
896 | (if (not dun-endgame) | |
62078373 | 897 | (let (total) |
a399c536 RS |
898 | (setq total (dun-reg-score)) |
899 | (dun-mprinc "You have scored ") | |
900 | (dun-mprinc total) | |
901 | (dun-mprincl " out of a possible 90 points.") total) | |
902 | (dun-mprinc "You have scored ") | |
903 | (dun-mprinc (dun-endgame-score)) | |
904 | (dun-mprincl " endgame points out of a possible 110.") | |
905 | (if (= (dun-endgame-score) 110) | |
a1506d29 | 906 | (dun-mprincl |
62078373 RS |
907 | "\n\nCongratulations. You have won. The wizard password is 'moby'")))) |
908 | ||
a399c536 RS |
909 | (defun dun-help (args) |
910 | (dun-mprincl | |
058c1767 | 911 | "Welcome to dunnet (2.01), by Ron Schnell (ronnie@driver-aces.com). |
62078373 RS |
912 | Here is some useful information (read carefully because there are one |
913 | or more clues in here): | |
914 | - If you have a key that can open a door, you do not need to explicitly | |
915 | open it. You may just use 'in' or walk in the direction of the door. | |
916 | ||
917 | - If you have a lamp, it is always lit. | |
918 | ||
919 | - You will not get any points until you manage to get treasures to a certain | |
920 | place. Simply finding the treasures is not good enough. There is more | |
921 | than one way to get a treasure to the special place. It is also | |
922 | important that the objects get to the special place *unharmed* and | |
923 | *untarnished*. You can tell if you have successfully transported the | |
924 | object by looking at your score, as it changes immediately. Note that | |
925 | an object can become harmed even after you have received points for it. | |
926 | If this happens, your score will decrease, and in many cases you can never | |
927 | get credit for it again. | |
928 | ||
929 | - You can save your game with the 'save' command, and use restore it | |
930 | with the 'restore' command. | |
931 | ||
932 | - There are no limits on lengths of object names. | |
933 | ||
934 | - Directions are: north,south,east,west,northeast,southeast,northwest, | |
935 | southwest,up,down,in,out. | |
936 | ||
937 | - These can be abbreviated: n,s,e,w,ne,se,nw,sw,u,d,in,out. | |
938 | ||
939 | - If you go down a hole in the floor without an aid such as a ladder, | |
940 | you probably won't be able to get back up the way you came, if at all. | |
941 | ||
942 | - To run this game in batch mode (no emacs window), use: | |
a399c536 | 943 | emacs -batch -l dunnet |
058c1767 | 944 | NOTE: This game *should* be run in batch mode! |
62078373 | 945 | |
058c1767 RS |
946 | If you have questions or comments, please contact ronnie@driver-aces.com |
947 | My home page is http://www.driver-aces.com/ronnie.html | |
948 | ")) | |
62078373 | 949 | |
a399c536 RS |
950 | (defun dun-flush (args) |
951 | (if (not (= dun-current-room bathroom)) | |
952 | (dun-mprincl "I see nothing to flush.") | |
953 | (dun-mprincl "Whoooosh!!") | |
954 | (dun-put-objs-in-treas (nth urinal dun-room-objects)) | |
955 | (dun-replace dun-room-objects urinal nil))) | |
956 | ||
cd9012b5 | 957 | (defun dun-piss (args) |
a399c536 RS |
958 | (if (not (= dun-current-room bathroom)) |
959 | (dun-mprincl "You can't do that here, don't even bother trying.") | |
960 | (if (not dun-gottago) | |
961 | (dun-mprincl "I'm afraid you don't have to go now.") | |
962 | (dun-mprincl "That was refreshing.") | |
963 | (setq dun-gottago nil) | |
a1506d29 | 964 | (dun-replace dun-room-objects urinal (append |
a399c536 RS |
965 | (nth urinal dun-room-objects) |
966 | (list obj-URINE)))))) | |
967 | ||
968 | ||
969 | (defun dun-sleep (args) | |
970 | (if (not (= dun-current-room bedroom)) | |
971 | (dun-mprincl | |
62078373 | 972 | "You try to go to sleep while standing up here, but can't seem to do it.") |
a399c536 RS |
973 | (setq dun-gottago t) |
974 | (dun-mprincl | |
62078373 RS |
975 | "As soon as you start to doze off you begin dreaming. You see images of |
976 | workers digging caves, slaving in the humid heat. Then you see yourself | |
977 | as one of these workers. While no one is looking, you leave the group | |
978 | and walk into a room. The room is bare except for a horseshoe | |
979 | shaped piece of stone in the center. You see yourself digging a hole in | |
980 | the ground, then putting some kind of treasure in it, and filling the hole | |
981 | with dirt again. After this, you immediately wake up."))) | |
982 | ||
a399c536 | 983 | (defun dun-break (obj) |
62078373 | 984 | (let (objnum) |
a399c536 RS |
985 | (if (not (member obj-axe dun-inventory)) |
986 | (dun-mprincl "You have nothing you can use to break things.") | |
987 | (when (setq objnum (dun-objnum-from-args-std obj)) | |
988 | (if (member objnum dun-inventory) | |
62078373 | 989 | (progn |
a399c536 | 990 | (dun-mprincl |
62078373 RS |
991 | "You take the object in your hands and swing the axe. Unfortunately, you miss |
992 | the object and slice off your hand. You bleed to death.") | |
a399c536 RS |
993 | (dun-die "an axe")) |
994 | (if (not (or (member objnum (nth dun-current-room dun-room-objects)) | |
a1506d29 | 995 | (member objnum |
a399c536 RS |
996 | (nth dun-current-room dun-room-silents)))) |
997 | (dun-mprincl "I don't see that here.") | |
62078373 RS |
998 | (if (= objnum obj-cable) |
999 | (progn | |
a1506d29 | 1000 | (dun-mprincl |
62078373 RS |
1001 | "As you break the ethernet cable, everything starts to blur. You collapse |
1002 | for a moment, then straighten yourself up. | |
1003 | ") | |
a399c536 | 1004 | (dun-replace dun-room-objects gamma-computing-center |
a1506d29 | 1005 | (append |
a399c536 RS |
1006 | (nth gamma-computing-center dun-room-objects) |
1007 | dun-inventory)) | |
1008 | (if (member obj-key dun-inventory) | |
62078373 | 1009 | (progn |
a399c536 | 1010 | (setq dun-inventory (list obj-key)) |
a1506d29 | 1011 | (dun-remove-obj-from-room |
a399c536 RS |
1012 | gamma-computing-center obj-key)) |
1013 | (setq dun-inventory nil)) | |
1014 | (setq dun-current-room computer-room) | |
1015 | (setq dun-ethernet nil) | |
1016 | (dun-mprincl "Connection closed.") | |
1017 | (dun-unix-interface)) | |
62078373 RS |
1018 | (if (< objnum 0) |
1019 | (progn | |
a399c536 RS |
1020 | (dun-mprincl "Your axe shatters into a million pieces.") |
1021 | (dun-remove-obj-from-inven obj-axe)) | |
1022 | (dun-mprincl "Your axe breaks it into a million pieces.") | |
1023 | (dun-remove-obj-from-room dun-current-room objnum))))))))) | |
62078373 | 1024 | |
a399c536 RS |
1025 | (defun dun-drive (args) |
1026 | (if (not dun-inbus) | |
1027 | (dun-mprincl "You cannot drive when you aren't in a vehicle.") | |
1028 | (dun-mprincl "To drive while you are in the bus, just give a direction."))) | |
62078373 | 1029 | |
a399c536 RS |
1030 | (defun dun-superb (args) |
1031 | (setq dun-mode 'dun-superb)) | |
62078373 | 1032 | |
a399c536 | 1033 | (defun dun-reg-score () |
62078373 RS |
1034 | (let (total) |
1035 | (setq total 0) | |
a399c536 RS |
1036 | (dolist (x (nth treasure-room dun-room-objects)) |
1037 | (setq total (+ total (nth x dun-object-pts)))) | |
1038 | (if (member obj-URINE (nth treasure-room dun-room-objects)) | |
62078373 RS |
1039 | (setq total 0)) total)) |
1040 | ||
a399c536 | 1041 | (defun dun-endgame-score () |
62078373 RS |
1042 | (let (total) |
1043 | (setq total 0) | |
a399c536 RS |
1044 | (dolist (x (nth endgame-treasure-room dun-room-objects)) |
1045 | (setq total (+ total (nth x dun-object-pts)))) total)) | |
62078373 | 1046 | |
a399c536 RS |
1047 | (defun dun-answer (args) |
1048 | (if (not dun-correct-answer) | |
1049 | (dun-mprincl "I don't believe anyone asked you anything.") | |
62078373 RS |
1050 | (setq args (car args)) |
1051 | (if (not args) | |
a399c536 RS |
1052 | (dun-mprincl "You must give the answer on the same line.") |
1053 | (if (dun-members args dun-correct-answer) | |
62078373 | 1054 | (progn |
a399c536 RS |
1055 | (dun-mprincl "Correct.") |
1056 | (if (= dun-lastdir 0) | |
1057 | (setq dun-current-room (1+ dun-current-room)) | |
1058 | (setq dun-current-room (- dun-current-room 1))) | |
1059 | (setq dun-correct-answer nil)) | |
1060 | (dun-mprincl "That answer is incorrect."))))) | |
1061 | ||
1062 | (defun dun-endgame-question () | |
1063 | (if (not dun-endgame-questions) | |
62078373 | 1064 | (progn |
a399c536 RS |
1065 | (dun-mprincl "Your question is:") |
1066 | (dun-mprincl "No more questions, just do 'answer foo'.") | |
1067 | (setq dun-correct-answer '("foo"))) | |
62078373 RS |
1068 | (let (which i newques) |
1069 | (setq i 0) | |
1070 | (setq newques nil) | |
93cc044b | 1071 | (setq which (random (length dun-endgame-questions))) |
a399c536 | 1072 | (dun-mprincl "Your question is:") |
a1506d29 JB |
1073 | (dun-mprincl (setq dun-endgame-question (car |
1074 | (nth which | |
a399c536 RS |
1075 | dun-endgame-questions)))) |
1076 | (setq dun-correct-answer (cdr (nth which dun-endgame-questions))) | |
62078373 | 1077 | (while (< i which) |
a399c536 | 1078 | (setq newques (append newques (list (nth i dun-endgame-questions)))) |
62078373 RS |
1079 | (setq i (1+ i))) |
1080 | (setq i (1+ which)) | |
a399c536 RS |
1081 | (while (< i (length dun-endgame-questions)) |
1082 | (setq newques (append newques (list (nth i dun-endgame-questions)))) | |
62078373 | 1083 | (setq i (1+ i))) |
a399c536 | 1084 | (setq dun-endgame-questions newques)))) |
62078373 RS |
1085 | |
1086 | (defun dun-power (args) | |
a399c536 RS |
1087 | (if (not (= dun-current-room pc-area)) |
1088 | (dun-mprincl "That operation is not applicable here.") | |
1089 | (if (not dun-floppy) | |
1090 | (dun-dos-no-disk) | |
1091 | (dun-dos-interface)))) | |
62078373 RS |
1092 | |
1093 | (defun dun-feed (args) | |
1094 | (let (objnum) | |
a399c536 | 1095 | (when (setq objnum (dun-objnum-from-args-std args)) |
a1506d29 | 1096 | (if (and (= objnum obj-bear) |
a399c536 | 1097 | (member obj-bear (nth dun-current-room dun-room-objects))) |
62078373 | 1098 | (progn |
a399c536 RS |
1099 | (if (not (member obj-food dun-inventory)) |
1100 | (dun-mprincl "You have nothing with which to feed it.") | |
1101 | (dun-drop '("food")))) | |
1102 | (if (not (or (member objnum (nth dun-current-room dun-room-objects)) | |
1103 | (member objnum dun-inventory) | |
1104 | (member objnum (nth dun-current-room dun-room-silents)))) | |
1105 | (dun-mprincl "I don't see that here.") | |
1106 | (dun-mprincl "You cannot feed that.")))))) | |
62078373 RS |
1107 | |
1108 | ||
1109 | ;;;; | |
1110 | ;;;; This section defines various utility functions used | |
1111 | ;;;; by dunnet. | |
1112 | ;;;; | |
1113 | ||
1114 | ||
1115 | ;;; Function which takes a verb and a list of other words. Calls proper | |
1116 | ;;; function associated with the verb, and passes along the other words. | |
1117 | ||
a399c536 | 1118 | (defun dun-doverb (dun-ignore dun-verblist verb rest) |
62078373 RS |
1119 | (if (not verb) |
1120 | nil | |
a399c536 | 1121 | (if (member (intern verb) dun-ignore) |
62078373 | 1122 | (if (not (car rest)) -1 |
a399c536 RS |
1123 | (dun-doverb dun-ignore dun-verblist (car rest) (cdr rest))) |
1124 | (if (not (cdr (assq (intern verb) dun-verblist))) -1 | |
1125 | (setq dun-numcmds (1+ dun-numcmds)) | |
1126 | (eval (list (cdr (assq (intern verb) dun-verblist)) (quote rest))))))) | |
62078373 RS |
1127 | |
1128 | ||
1129 | ;;; Function to take a string and change it into a list of lowercase words. | |
1130 | ||
a399c536 | 1131 | (defun dun-listify-string (strin) |
62078373 RS |
1132 | (let (pos ret-list end-pos) |
1133 | (setq pos 0) | |
1134 | (setq ret-list nil) | |
1135 | (while (setq end-pos (string-match "[ ,:;]" (substring strin pos))) | |
1136 | (setq end-pos (+ end-pos pos)) | |
1137 | (if (not (= end-pos pos)) | |
a1506d29 | 1138 | (setq ret-list (append ret-list (list |
62078373 RS |
1139 | (downcase |
1140 | (substring strin pos end-pos)))))) | |
1141 | (setq pos (+ end-pos 1))) ret-list)) | |
1142 | ||
a399c536 | 1143 | (defun dun-listify-string2 (strin) |
62078373 RS |
1144 | (let (pos ret-list end-pos) |
1145 | (setq pos 0) | |
1146 | (setq ret-list nil) | |
1147 | (while (setq end-pos (string-match " " (substring strin pos))) | |
1148 | (setq end-pos (+ end-pos pos)) | |
1149 | (if (not (= end-pos pos)) | |
a1506d29 | 1150 | (setq ret-list (append ret-list (list |
62078373 RS |
1151 | (downcase |
1152 | (substring strin pos end-pos)))))) | |
1153 | (setq pos (+ end-pos 1))) ret-list)) | |
1154 | ||
a399c536 | 1155 | (defun dun-replace (list n number) |
62078373 RS |
1156 | (rplaca (nthcdr n list) number)) |
1157 | ||
1158 | ||
1159 | ;;; Get the first non-ignored word from a list. | |
1160 | ||
a399c536 | 1161 | (defun dun-firstword (list) |
62078373 RS |
1162 | (if (not (car list)) |
1163 | nil | |
a399c536 | 1164 | (while (and list (member (intern (car list)) dun-ignore)) |
62078373 RS |
1165 | (setq list (cdr list))) |
1166 | (car list))) | |
1167 | ||
a399c536 | 1168 | (defun dun-firstwordl (list) |
62078373 RS |
1169 | (if (not (car list)) |
1170 | nil | |
a399c536 | 1171 | (while (and list (member (intern (car list)) dun-ignore)) |
62078373 RS |
1172 | (setq list (cdr list))) |
1173 | list)) | |
1174 | ||
1175 | ;;; parse a line passed in as a string Call the proper verb with the | |
1176 | ;;; rest of the line passed in as a list. | |
1177 | ||
a399c536 RS |
1178 | (defun dun-vparse (dun-ignore dun-verblist line) |
1179 | (dun-mprinc "\n") | |
1180 | (setq line-list (dun-listify-string (concat line " "))) | |
1181 | (dun-doverb dun-ignore dun-verblist (car line-list) (cdr line-list))) | |
62078373 | 1182 | |
a399c536 RS |
1183 | (defun dun-parse2 (dun-ignore dun-verblist line) |
1184 | (dun-mprinc "\n") | |
1185 | (setq line-list (dun-listify-string2 (concat line " "))) | |
1186 | (dun-doverb dun-ignore dun-verblist (car line-list) (cdr line-list))) | |
62078373 RS |
1187 | |
1188 | ;;; Read a line, in window mode | |
1189 | ||
a399c536 | 1190 | (defun dun-read-line () |
62078373 RS |
1191 | (let (line) |
1192 | (setq line (read-string "")) | |
a399c536 | 1193 | (dun-mprinc line) line)) |
62078373 RS |
1194 | |
1195 | ;;; Insert something into the window buffer | |
1196 | ||
a399c536 | 1197 | (defun dun-minsert (string) |
62078373 RS |
1198 | (if (stringp string) |
1199 | (insert string) | |
1200 | (insert (prin1-to-string string)))) | |
1201 | ||
1202 | ;;; Print something out, in window mode | |
1203 | ||
a399c536 | 1204 | (defun dun-mprinc (string) |
62078373 RS |
1205 | (if (stringp string) |
1206 | (insert string) | |
1207 | (insert (prin1-to-string string)))) | |
1208 | ||
1209 | ;;; In window mode, keep screen from jumping by keeping last line at | |
1210 | ;;; the bottom of the screen. | |
1211 | ||
a399c536 | 1212 | (defun dun-fix-screen () |
62078373 RS |
1213 | (interactive) |
1214 | (forward-line (- 0 (- (window-height) 2 ))) | |
1215 | (set-window-start (selected-window) (point)) | |
1216 | (end-of-buffer)) | |
1217 | ||
1218 | ;;; Insert something into the buffer, followed by newline. | |
1219 | ||
a399c536 RS |
1220 | (defun dun-minsertl (string) |
1221 | (dun-minsert string) | |
1222 | (dun-minsert "\n")) | |
62078373 RS |
1223 | |
1224 | ;;; Print something, followed by a newline. | |
1225 | ||
a399c536 RS |
1226 | (defun dun-mprincl (string) |
1227 | (dun-mprinc string) | |
1228 | (dun-mprinc "\n")) | |
62078373 RS |
1229 | |
1230 | ;;; Function which will get an object number given the list of | |
1231 | ;;; words in the command, except for the verb. | |
1232 | ||
a399c536 | 1233 | (defun dun-objnum-from-args (obj) |
62078373 | 1234 | (let (objnum) |
a399c536 | 1235 | (setq obj (dun-firstword obj)) |
62078373 RS |
1236 | (if (not obj) |
1237 | obj-special | |
a399c536 | 1238 | (setq objnum (cdr (assq (intern obj) dun-objnames)))))) |
62078373 | 1239 | |
a399c536 | 1240 | (defun dun-objnum-from-args-std (obj) |
62078373 | 1241 | (let (result) |
a399c536 RS |
1242 | (if (eq (setq result (dun-objnum-from-args obj)) obj-special) |
1243 | (dun-mprincl "You must supply an object.")) | |
62078373 | 1244 | (if (eq result nil) |
a399c536 | 1245 | (dun-mprincl "I don't know what that is.")) |
62078373 RS |
1246 | (if (eq result obj-special) |
1247 | nil | |
1248 | result))) | |
1249 | ||
1250 | ;;; Take a short room description, and change spaces and slashes to dashes. | |
1251 | ||
a399c536 | 1252 | (defun dun-space-to-hyphen (string) |
62078373 RS |
1253 | (let (space) |
1254 | (if (setq space (string-match "[ /]" string)) | |
1255 | (progn | |
1256 | (setq string (concat (substring string 0 space) "-" | |
1257 | (substring string (1+ space)))) | |
a399c536 | 1258 | (dun-space-to-hyphen string)) |
62078373 RS |
1259 | string))) |
1260 | ||
1261 | ;;; Given a unix style pathname, build a list of path components (recursive) | |
1262 | ||
a399c536 | 1263 | (defun dun-get-path (dirstring startlist) |
62078373 RS |
1264 | (let (slash pos) |
1265 | (if (= (length dirstring) 0) | |
1266 | startlist | |
1267 | (if (string= (substring dirstring 0 1) "/") | |
a399c536 | 1268 | (dun-get-path (substring dirstring 1) (append startlist (list "/"))) |
62078373 RS |
1269 | (if (not (setq slash (string-match "/" dirstring))) |
1270 | (append startlist (list dirstring)) | |
a399c536 | 1271 | (dun-get-path (substring dirstring (1+ slash)) |
62078373 RS |
1272 | (append startlist |
1273 | (list (substring dirstring 0 slash))))))))) | |
1274 | ||
1275 | ||
1276 | ;;; Is a string a member of a string list? | |
1277 | ||
a399c536 | 1278 | (defun dun-members (string string-list) |
62078373 RS |
1279 | (let (found) |
1280 | (setq found nil) | |
1281 | (dolist (x string-list) | |
1282 | (if (string= x string) | |
1283 | (setq found t))) found)) | |
1284 | ||
1285 | ;;; Function to put objects in the treasure room. Also prints current | |
1286 | ;;; score to let user know he has scored. | |
1287 | ||
a399c536 | 1288 | (defun dun-put-objs-in-treas (objlist) |
62078373 | 1289 | (let (oscore newscore) |
a399c536 RS |
1290 | (setq oscore (dun-reg-score)) |
1291 | (dun-replace dun-room-objects 0 (append (nth 0 dun-room-objects) objlist)) | |
1292 | (setq newscore (dun-reg-score)) | |
62078373 | 1293 | (if (not (= oscore newscore)) |
a399c536 | 1294 | (dun-score nil)))) |
62078373 RS |
1295 | |
1296 | ;;; Load an encrypted file, and eval it. | |
1297 | ||
a399c536 | 1298 | (defun dun-load-d (filename) |
62078373 RS |
1299 | (let (old-buffer result) |
1300 | (setq result t) | |
1301 | (setq old-buffer (current-buffer)) | |
1302 | (switch-to-buffer (get-buffer-create "*loadc*")) | |
1303 | (erase-buffer) | |
1304 | (condition-case nil | |
1305 | (insert-file-contents filename) | |
1306 | (error (setq result nil))) | |
1307 | (unless (not result) | |
1308 | (condition-case nil | |
1309 | (dun-rot13) | |
1310 | (error (yank))) | |
1311 | (eval-current-buffer) | |
058c1767 RS |
1312 | (kill-buffer (current-buffer))) |
1313 | (switch-to-buffer old-buffer) | |
62078373 RS |
1314 | result)) |
1315 | ||
62078373 RS |
1316 | ;;; Functions to remove an object either from a room, or from inventory. |
1317 | ||
a399c536 | 1318 | (defun dun-remove-obj-from-room (room objnum) |
62078373 RS |
1319 | (let (newroom) |
1320 | (setq newroom nil) | |
a399c536 | 1321 | (dolist (x (nth room dun-room-objects)) |
62078373 RS |
1322 | (if (not (= x objnum)) |
1323 | (setq newroom (append newroom (list x))))) | |
a399c536 | 1324 | (rplaca (nthcdr room dun-room-objects) newroom))) |
62078373 | 1325 | |
a399c536 | 1326 | (defun dun-remove-obj-from-inven (objnum) |
62078373 RS |
1327 | (let (new-inven) |
1328 | (setq new-inven nil) | |
a399c536 | 1329 | (dolist (x dun-inventory) |
62078373 RS |
1330 | (if (not (= x objnum)) |
1331 | (setq new-inven (append new-inven (list x))))) | |
a399c536 | 1332 | (setq dun-inventory new-inven))) |
62078373 | 1333 | |
62078373 RS |
1334 | |
1335 | (let ((i 0) (lower "abcdefghijklmnopqrstuvwxyz") upper) | |
a399c536 | 1336 | (setq dun-translate-table (make-vector 256 0)) |
62078373 | 1337 | (while (< i 256) |
a399c536 | 1338 | (aset dun-translate-table i i) |
62078373 RS |
1339 | (setq i (1+ i))) |
1340 | (setq lower (concat lower lower)) | |
1341 | (setq upper (upcase lower)) | |
1342 | (setq i 0) | |
1343 | (while (< i 26) | |
a399c536 RS |
1344 | (aset dun-translate-table (+ ?a i) (aref lower (+ i 13))) |
1345 | (aset dun-translate-table (+ ?A i) (aref upper (+ i 13))) | |
62078373 | 1346 | (setq i (1+ i)))) |
a1506d29 | 1347 | |
62078373 RS |
1348 | (defun dun-rot13 () |
1349 | (let (str len (i 0)) | |
1350 | (setq str (buffer-substring (point-min) (point-max))) | |
1351 | (setq len (length str)) | |
1352 | (while (< i len) | |
a399c536 | 1353 | (aset str i (aref dun-translate-table (aref str i))) |
62078373 RS |
1354 | (setq i (1+ i))) |
1355 | (erase-buffer) | |
1356 | (insert str))) | |
1357 | ||
1358 | ;;;; | |
1359 | ;;;; This section defines the globals that are used in dunnet. | |
1360 | ;;;; | |
1361 | ;;;; IMPORTANT | |
1362 | ;;;; All globals which can change must be saved from 'save-game. Add | |
1363 | ;;;; all new globals to bottom of file. | |
1364 | ||
a399c536 RS |
1365 | (setq dun-visited '(27)) |
1366 | (setq dun-current-room 1) | |
1367 | (setq dun-exitf nil) | |
1368 | (setq dun-badcd nil) | |
62078373 RS |
1369 | (defvar dungeon-mode-map nil) |
1370 | (setq dungeon-mode-map (make-sparse-keymap)) | |
a399c536 | 1371 | (define-key dungeon-mode-map "\r" 'dun-parse) |
62078373 RS |
1372 | (defvar dungeon-batch-map (make-keymap)) |
1373 | (if (string= (substring emacs-version 0 2) "18") | |
1374 | (let (n) | |
1375 | (setq n 32) | |
1376 | (while (< 0 (setq n (- n 1))) | |
1377 | (aset dungeon-batch-map n 'dungeon-nil))) | |
1378 | (let (n) | |
1379 | (setq n 32) | |
1380 | (while (< 0 (setq n (- n 1))) | |
1381 | (aset (car (cdr dungeon-batch-map)) n 'dungeon-nil)))) | |
1382 | (define-key dungeon-batch-map "\r" 'exit-minibuffer) | |
1383 | (define-key dungeon-batch-map "\n" 'exit-minibuffer) | |
a399c536 RS |
1384 | (setq dun-computer nil) |
1385 | (setq dun-floppy nil) | |
1386 | (setq dun-key-level 0) | |
1387 | (setq dun-hole nil) | |
1388 | (setq dun-correct-answer nil) | |
1389 | (setq dun-lastdir 0) | |
1390 | (setq dun-numsaves 0) | |
1391 | (setq dun-jar nil) | |
1392 | (setq dun-dead nil) | |
1393 | (setq room 0) | |
1394 | (setq dun-numcmds 0) | |
1395 | (setq dun-wizard nil) | |
1396 | (setq dun-endgame-question nil) | |
1397 | (setq dun-logged-in nil) | |
62078373 | 1398 | (setq dungeon-mode 'dungeon) |
a1506d29 | 1399 | (setq dun-unix-verbs '((ls . dun-ls) (ftp . dun-ftp) (echo . dun-echo) |
a399c536 RS |
1400 | (exit . dun-uexit) (cd . dun-cd) (pwd . dun-pwd) |
1401 | (rlogin . dun-rlogin) (uncompress . dun-uncompress) | |
1402 | (cat . dun-cat) (zippy . dun-zippy))) | |
62078373 | 1403 | |
a399c536 RS |
1404 | (setq dun-dos-verbs '((dir . dun-dos-dir) (type . dun-dos-type) |
1405 | (exit . dun-dos-exit) (command . dun-dos-spawn) | |
1406 | (b: . dun-dos-invd) (c: . dun-dos-invd) | |
1407 | (a: . dun-dos-nil))) | |
62078373 RS |
1408 | |
1409 | ||
a399c536 | 1410 | (setq dun-batch-mode nil) |
62078373 | 1411 | |
a399c536 RS |
1412 | (setq dun-cdpath "/usr/toukmond") |
1413 | (setq dun-cdroom -10) | |
1414 | (setq dun-uncompressed nil) | |
1415 | (setq dun-ethernet t) | |
a1506d29 JB |
1416 | (setq dun-restricted |
1417 | '(dun-room-objects dungeon-map dun-rooms | |
a399c536 RS |
1418 | dun-room-silents dun-combination)) |
1419 | (setq dun-ftptype 'ascii) | |
1420 | (setq dun-endgame nil) | |
1421 | (setq dun-gottago t) | |
1422 | (setq dun-black nil) | |
62078373 | 1423 | |
a399c536 | 1424 | (setq dun-rooms '( |
62078373 RS |
1425 | ( |
1426 | "You are in the treasure room. A door leads out to the north." | |
1427 | "Treasure room" | |
1428 | ) | |
1429 | ( | |
1430 | "You are at a dead end of a dirt road. The road goes to the east. | |
1431 | In the distance you can see that it will eventually fork off. The | |
1432 | trees here are very tall royal palms, and they are spaced equidistant | |
1433 | from each other." | |
1434 | "Dead end" | |
1435 | ) | |
1436 | ( | |
1437 | "You are on the continuation of a dirt road. There are more trees on | |
1438 | both sides of you. The road continues to the east and west." | |
1439 | "E/W Dirt road" | |
1440 | ) | |
1441 | ( | |
1442 | "You are at a fork of two passages, one to the northeast, and one to the | |
1443 | southeast. The ground here seems very soft. You can also go back west." | |
1444 | "Fork" | |
1445 | ) | |
1446 | ( | |
1447 | "You are on a northeast/southwest road." | |
1448 | "NE/SW road" | |
1449 | ) | |
1450 | ( | |
1451 | "You are at the end of the road. There is a building in front of you | |
1452 | to the northeast, and the road leads back to the southwest." | |
1453 | "Building front" | |
1454 | ) | |
1455 | ( | |
1456 | "You are on a southeast/northwest road." | |
1457 | "SE/NW road" | |
1458 | ) | |
1459 | ( | |
1460 | "You are standing at the end of a road. A passage leads back to the | |
1461 | northwest." | |
1462 | "Bear hangout" | |
1463 | ) | |
1464 | ( | |
1465 | "You are in the hallway of an old building. There are rooms to the east | |
1466 | and west, and doors leading out to the north and south." | |
1467 | "Old Building hallway" | |
1468 | ) | |
1469 | ( | |
1470 | "You are in a mailroom. There are many bins where the mail is usually | |
1471 | kept. The exit is to the west." | |
1472 | "Mailroom" | |
1473 | ) | |
1474 | ( | |
1475 | "You are in a computer room. It seems like most of the equipment has | |
1476 | been removed. There is a VAX 11/780 in front of you, however, with | |
1477 | one of the cabinets wide open. A sign on the front of the machine | |
1478 | says: This VAX is named 'pokey'. To type on the console, use the | |
1479 | 'type' command. The exit is to the east." | |
1480 | "Computer room" | |
1481 | ) | |
1482 | ( | |
1483 | "You are in a meadow in the back of an old building. A small path leads | |
1484 | to the west, and a door leads to the south." | |
1485 | "Meadow" | |
1486 | ) | |
1487 | ( | |
1488 | "You are in a round, stone room with a door to the east. There | |
1489 | is a sign on the wall that reads: 'receiving room'." | |
1490 | "Receiving room" | |
1491 | ) | |
1492 | ( | |
1493 | "You are at the south end of a hallway that leads to the north. There | |
1494 | are rooms to the east and west." | |
1495 | "Northbound Hallway" | |
1496 | ) | |
1497 | ( | |
1498 | "You are in a sauna. There is nothing in the room except for a dial | |
1499 | on the wall. A door leads out to west." | |
1500 | "Sauna" | |
1501 | ) | |
1502 | ( | |
1503 | "You are at the end of a north/south hallway. You can go back to the south, | |
1504 | or off to a room to the east." | |
1505 | "End of N/S Hallway" | |
1506 | ) | |
1507 | ( | |
1508 | "You are in an old weight room. All of the equipment is either destroyed | |
1509 | or completely broken. There is a door out to the west, and there is a ladder | |
1510 | leading down a hole in the floor." | |
1511 | "Weight room" ;16 | |
1512 | ) | |
1513 | ( | |
1514 | "You are in a maze of twisty little passages, all alike. | |
1515 | There is a button on the ground here." | |
1516 | "Maze button room" | |
1517 | ) | |
1518 | ( | |
1519 | "You are in a maze of little twisty passages, all alike." | |
1520 | "Maze" | |
1521 | ) | |
1522 | ( | |
1523 | "You are in a maze of thirsty little passages, all alike." | |
1524 | "Maze" ;19 | |
1525 | ) | |
1526 | ( | |
1527 | "You are in a maze of twenty little passages, all alike." | |
1528 | "Maze" | |
1529 | ) | |
1530 | ( | |
1531 | "You are in a daze of twisty little passages, all alike." | |
1532 | "Maze" ;21 | |
1533 | ) | |
1534 | ( | |
1535 | "You are in a maze of twisty little cabbages, all alike." | |
1536 | "Maze" ;22 | |
1537 | ) | |
1538 | ( | |
1539 | "You are in a reception area for a health and fitness center. The place | |
1540 | appears to have been recently ransacked, and nothing is left. There is | |
1541 | a door out to the south, and a crawlspace to the southeast." | |
1542 | "Reception area" | |
1543 | ) | |
1544 | ( | |
1545 | "You are outside a large building to the north which used to be a health | |
1546 | and fitness center. A road leads to the south." | |
1547 | "Health Club front" | |
1548 | ) | |
1549 | ( | |
1550 | "You are at the north side of a lake. On the other side you can see | |
1551 | a road which leads to a cave. The water appears very deep." | |
1552 | "Lakefront North" | |
1553 | ) | |
1554 | ( | |
1555 | "You are at the south side of a lake. A road goes to the south." | |
1556 | "Lakefront South" | |
1557 | ) | |
1558 | ( | |
1559 | "You are in a well-hidden area off to the side of a road. Back to the | |
1560 | northeast through the brush you can see the bear hangout." | |
1561 | "Hidden area" | |
1562 | ) | |
1563 | ( | |
1564 | "The entrance to a cave is to the south. To the north, a road leads | |
1565 | towards a deep lake. On the ground nearby there is a chute, with a sign | |
1566 | that says 'put treasures here for points'." | |
1567 | "Cave Entrance" ;28 | |
1568 | ) | |
1569 | ( | |
1570 | "You are in a misty, humid room carved into a mountain. | |
1571 | To the north is the remains of a rockslide. To the east, a small | |
1572 | passage leads away into the darkness." ;29 | |
1573 | "Misty Room" | |
1574 | ) | |
1575 | ( | |
1576 | "You are in an east/west passageway. The walls here are made of | |
1577 | multicolored rock and are quite beautiful." | |
1578 | "Cave E/W passage" ;30 | |
1579 | ) | |
1580 | ( | |
1581 | "You are at the junction of two passages. One goes north/south, and | |
1582 | the other goes west." | |
1583 | "N/S/W Junction" ;31 | |
1584 | ) | |
1585 | ( | |
1586 | "You are at the north end of a north/south passageway. There are stairs | |
1587 | leading down from here. There is also a door leading west." | |
1588 | "North end of cave passage" ;32 | |
1589 | ) | |
1590 | ( | |
1591 | "You are at the south end of a north/south passageway. There is a hole | |
1592 | in the floor here, into which you could probably fit." | |
1593 | "South end of cave passage" ;33 | |
1594 | ) | |
1595 | ( | |
1596 | "You are in what appears to be a worker's bedroom. There is a queen- | |
1597 | sized bed in the middle of the room, and a painting hanging on the | |
1598 | wall. A door leads to another room to the south, and stairways | |
1599 | lead up and down." | |
1600 | "Bedroom" ;34 | |
1601 | ) | |
1602 | ( | |
1603 | "You are in a bathroom built for workers in the cave. There is a | |
1604 | urinal hanging on the wall, and some exposed pipes on the opposite | |
1605 | wall where a sink used to be. To the north is a bedroom." | |
1606 | "Bathroom" ;35 | |
1607 | ) | |
1608 | ( | |
1609 | "This is a marker for the urinal. User will not see this, but it | |
1610 | is a room that can contain objects." | |
1611 | "Urinal" ;36 | |
1612 | ) | |
1613 | ( | |
1614 | "You are at the northeast end of a northeast/southwest passageway. | |
1615 | Stairs lead up out of sight." | |
058c1767 | 1616 | "NE end of NE/SW cave passage" ;37 |
62078373 RS |
1617 | ) |
1618 | ( | |
1619 | "You are at the junction of northeast/southwest and east/west passages." | |
058c1767 | 1620 | "NE/SW-E/W junction" ;38 |
62078373 RS |
1621 | ) |
1622 | ( | |
1623 | "You are at the southwest end of a northeast/southwest passageway." | |
058c1767 | 1624 | "SW end of NE/SW cave passage" ;39 |
62078373 RS |
1625 | ) |
1626 | ( | |
058c1767 | 1627 | "You are at the east end of an E/W passage. There are stairs leading up |
62078373 | 1628 | to a room above." |
058c1767 | 1629 | "East end of E/W cave passage" ;40 |
62078373 RS |
1630 | ) |
1631 | ( | |
058c1767 | 1632 | "You are at the west end of an E/W passage. There is a hole on the ground |
62078373 | 1633 | which leads down out of sight." |
058c1767 | 1634 | "West end of E/W cave passage" ;41 |
62078373 RS |
1635 | ) |
1636 | ( | |
1637 | "You are in a room which is bare, except for a horseshoe shaped boulder | |
1638 | in the center. Stairs lead down from here." ;42 | |
1639 | "Horseshoe boulder room" | |
1640 | ) | |
1641 | ( | |
1642 | "You are in a room which is completely empty. Doors lead out to the north | |
1643 | and east." | |
1644 | "Empty room" ;43 | |
1645 | ) | |
1646 | ( | |
1647 | "You are in an empty room. Interestingly enough, the stones in this | |
1648 | room are painted blue. Doors lead out to the east and south." ;44 | |
1649 | "Blue room" | |
1650 | ) | |
1651 | ( | |
1652 | "You are in an empty room. Interestingly enough, the stones in this | |
1653 | room are painted yellow. Doors lead out to the south and west." ;45 | |
1654 | "Yellow room" | |
1655 | ) | |
1656 | ( | |
1657 | "You are in an empty room. Interestingly enough, the stones in this room | |
1658 | are painted red. Doors lead out to the west and north." | |
1659 | "Red room" ;46 | |
1660 | ) | |
1661 | ( | |
1662 | "You are in the middle of a long north/south hallway." ;47 | |
1663 | "Long n/s hallway" | |
1664 | ) | |
1665 | ( | |
1666 | "You are 3/4 of the way towards the north end of a long north/south hallway." | |
1667 | "3/4 north" ;48 | |
1668 | ) | |
1669 | ( | |
1670 | "You are at the north end of a long north/south hallway. There are stairs | |
1671 | leading upwards." | |
1672 | "North end of long hallway" ;49 | |
1673 | ) | |
1674 | ( | |
1675 | "You are 3/4 of the way towards the south end of a long north/south hallway." | |
1676 | "3/4 south" ;50 | |
1677 | ) | |
1678 | ( | |
1679 | "You are at the south end of a long north/south hallway. There is a hole | |
1680 | to the south." | |
1681 | "South end of long hallway" ;51 | |
1682 | ) | |
1683 | ( | |
1684 | "You are at a landing in a stairwell which continues up and down." | |
1685 | "Stair landing" ;52 | |
1686 | ) | |
1687 | ( | |
1688 | "You are at the continuation of an up/down staircase." | |
1689 | "Up/down staircase" ;53 | |
1690 | ) | |
1691 | ( | |
1692 | "You are at the top of a staircase leading down. A crawlway leads off | |
1693 | to the northeast." | |
1694 | "Top of staircase." ;54 | |
1695 | ) | |
1696 | ( | |
1697 | "You are in a crawlway that leads northeast or southwest." | |
058c1767 | 1698 | "NE crawlway" ;55 |
62078373 RS |
1699 | ) |
1700 | ( | |
1701 | "You are in a small crawlspace. There is a hole in the ground here, and | |
1702 | a small passage back to the southwest." | |
1703 | "Small crawlspace" ;56 | |
1704 | ) | |
1705 | ( | |
1706 | "You are in the Gamma Computing Center. An IBM 3090/600s is whirring | |
1707 | away in here. There is an ethernet cable coming out of one of the units, | |
1708 | and going through the ceiling. There is no console here on which you | |
1709 | could type." | |
1710 | "Gamma computing center" ;57 | |
1711 | ) | |
1712 | ( | |
1713 | "You are near the remains of a post office. There is a mail drop on the | |
1714 | face of the building, but you cannot see where it leads. A path leads | |
1715 | back to the east, and a road leads to the north." | |
1716 | "Post office" ;58 | |
1717 | ) | |
1718 | ( | |
1719 | "You are at the intersection of Main Street and Maple Ave. Main street | |
1720 | runs north and south, and Maple Ave runs east off into the distance. | |
1721 | If you look north and east you can see many intersections, but all of | |
1722 | the buildings that used to stand here are gone. Nothing remains except | |
1723 | street signs. | |
1724 | There is a road to the northwest leading to a gate that guards a building." | |
1725 | "Main-Maple intersection" ;59 | |
1726 | ) | |
1727 | ( | |
1728 | "You are at the intersection of Main Street and the west end of Oaktree Ave." | |
1729 | "Main-Oaktree intersection" ;60 | |
1730 | ) | |
1731 | ( | |
1732 | "You are at the intersection of Main Street and the west end of Vermont Ave." | |
1733 | "Main-Vermont intersection" ;61 | |
1734 | ) | |
1735 | ( | |
1736 | "You are at the north end of Main Street at the west end of Sycamore Ave." ;62 | |
1737 | "Main-Sycamore intersection" | |
1738 | ) | |
1739 | ( | |
1740 | "You are at the south end of First Street at Maple Ave." ;63 | |
1741 | "First-Maple intersection" | |
1742 | ) | |
1743 | ( | |
1744 | "You are at the intersection of First Street and Oaktree Ave." ;64 | |
1745 | "First-Oaktree intersection" | |
1746 | ) | |
1747 | ( | |
1748 | "You are at the intersection of First Street and Vermont Ave." ;65 | |
1749 | "First-Vermont intersection" | |
1750 | ) | |
1751 | ( | |
1752 | "You are at the north end of First Street at Sycamore Ave." ;66 | |
1753 | "First-Sycamore intersection" | |
1754 | ) | |
1755 | ( | |
1756 | "You are at the south end of Second Street at Maple Ave." ;67 | |
1757 | "Second-Maple intersection" | |
1758 | ) | |
1759 | ( | |
1760 | "You are at the intersection of Second Street and Oaktree Ave." ;68 | |
1761 | "Second-Oaktree intersection" | |
1762 | ) | |
1763 | ( | |
1764 | "You are at the intersection of Second Street and Vermont Ave." ;69 | |
1765 | "Second-Vermont intersection" | |
1766 | ) | |
1767 | ( | |
1768 | "You are at the north end of Second Street at Sycamore Ave." ;70 | |
1769 | "Second-Sycamore intersection" | |
1770 | ) | |
1771 | ( | |
1772 | "You are at the south end of Third Street at Maple Ave." ;71 | |
1773 | "Third-Maple intersection" | |
1774 | ) | |
1775 | ( | |
1776 | "You are at the intersection of Third Street and Oaktree Ave." ;72 | |
1777 | "Third-Oaktree intersection" | |
1778 | ) | |
1779 | ( | |
1780 | "You are at the intersection of Third Street and Vermont Ave." ;73 | |
1781 | "Third-Vermont intersection" | |
1782 | ) | |
1783 | ( | |
1784 | "You are at the north end of Third Street at Sycamore Ave." ;74 | |
1785 | "Third-Sycamore intersection" | |
1786 | ) | |
1787 | ( | |
1788 | "You are at the south end of Fourth Street at Maple Ave." ;75 | |
1789 | "Fourth-Maple intersection" | |
1790 | ) | |
1791 | ( | |
1792 | "You are at the intersection of Fourth Street and Oaktree Ave." ;76 | |
1793 | "Fourth-Oaktree intersection" | |
1794 | ) | |
1795 | ( | |
1796 | "You are at the intersection of Fourth Street and Vermont Ave." ;77 | |
1797 | "Fourth-Vermont intersection" | |
1798 | ) | |
1799 | ( | |
1800 | "You are at the north end of Fourth Street at Sycamore Ave." ;78 | |
1801 | "Fourth-Sycamore intersection" | |
1802 | ) | |
1803 | ( | |
1804 | "You are at the south end of Fifth Street at the east end of Maple Ave." ;79 | |
1805 | "Fifth-Maple intersection" | |
1806 | ) | |
1807 | ( | |
1808 | "You are at the intersection of Fifth Street and the east end of Oaktree Ave. | |
1809 | There is a cliff off to the east." | |
1810 | "Fifth-Oaktree intersection" ;80 | |
1811 | ) | |
1812 | ( | |
1813 | "You are at the intersection of Fifth Street and the east end of Vermont Ave." | |
1814 | "Fifth-Vermont intersection" ;81 | |
1815 | ) | |
1816 | ( | |
1817 | "You are at the north end of Fifth Street and the east end of Sycamore Ave." | |
1818 | "Fifth-Sycamore intersection" ;82 | |
1819 | ) | |
1820 | ( | |
1821 | "You are in front of the Museum of Natural History. A door leads into | |
1822 | the building to the north, and a road leads to the southeast." | |
1823 | "Museum entrance" ;83 | |
1824 | ) | |
1825 | ( | |
1826 | "You are in the main lobby for the Museum of Natural History. In the center | |
1827 | of the room is the huge skeleton of a dinosaur. Doors lead out to the | |
a1506d29 | 1828 | south and east." |
62078373 RS |
1829 | "Museum lobby" ;84 |
1830 | ) | |
1831 | ( | |
1832 | "You are in the geological display. All of the objects that used to | |
a1506d29 | 1833 | be on display are missing. There are rooms to the east, west, and |
62078373 RS |
1834 | north." |
1835 | "Geological display" ;85 | |
1836 | ) | |
1837 | ( | |
1838 | "You are in the marine life area. The room is filled with fish tanks, | |
1839 | which are filled with dead fish that have apparently died due to | |
1840 | starvation. Doors lead out to the south and east." | |
1841 | "Marine life area" ;86 | |
1842 | ) | |
1843 | ( | |
1844 | "You are in some sort of maintenance room for the museum. There is a | |
1845 | switch on the wall labeled 'BL'. There are doors to the west and north." | |
1846 | "Maintenance room" ;87 | |
1847 | ) | |
1848 | ( | |
1849 | "You are in a classroom where school children were taught about natural | |
1850 | history. On the blackboard is written, 'No children allowed downstairs.' | |
1851 | There is a door to the east with an 'exit' sign on it. There is another | |
1852 | door to the west." | |
1853 | "Classroom" ;88 | |
1854 | ) | |
1855 | ( | |
1856 | "You are at the Vermont St. subway station. A train is sitting here waiting." | |
1857 | "Vermont station" ;89 | |
1858 | ) | |
1859 | ( | |
1860 | "You are at the Museum subway stop. A passage leads off to the north." | |
1861 | "Museum station" ;90 | |
1862 | ) | |
1863 | ( | |
1864 | "You are in a north/south tunnel." | |
1865 | "N/S tunnel" ;91 | |
1866 | ) | |
1867 | ( | |
1868 | "You are at the north end of a north/south tunnel. Stairs lead up and | |
1869 | down from here. There is a garbage disposal here." | |
058c1767 | 1870 | "North end of N/S tunnel" ;92 |
62078373 RS |
1871 | ) |
1872 | ( | |
1873 | "You are at the top of some stairs near the subway station. There is | |
1874 | a door to the west." | |
1875 | "Top of subway stairs" ;93 | |
1876 | ) | |
1877 | ( | |
1878 | "You are at the bottom of some stairs near the subway station. There is | |
1879 | a room to the northeast." | |
1880 | "Bottom of subway stairs" ;94 | |
1881 | ) | |
1882 | ( | |
1883 | "You are in another computer room. There is a computer in here larger | |
1884 | than you have ever seen. It has no manufacturers name on it, but it | |
1885 | does have a sign that says: This machine's name is 'endgame'. The | |
1886 | exit is to the southwest. There is no console here on which you could | |
1887 | type." | |
1888 | "Endgame computer room" ;95 | |
1889 | ) | |
1890 | ( | |
1891 | "You are in a north/south hallway." | |
058c1767 | 1892 | "Endgame N/S hallway" ;96 |
62078373 RS |
1893 | ) |
1894 | ( | |
1895 | "You have reached a question room. You must answer a question correctly in | |
1896 | order to get by. Use the 'answer' command to answer the question." | |
1897 | "Question room 1" ;97 | |
1898 | ) | |
1899 | ( | |
1900 | "You are in a north/south hallway." | |
058c1767 | 1901 | "Endgame N/S hallway" ;98 |
62078373 RS |
1902 | ) |
1903 | ( | |
1904 | "You are in a second question room." | |
1905 | "Question room 2" ;99 | |
1906 | ) | |
1907 | ( | |
1908 | "You are in a north/south hallway." | |
058c1767 | 1909 | "Endgame N/S hallway" ;100 |
62078373 RS |
1910 | ) |
1911 | ( | |
1912 | "You are in a third question room." | |
1913 | "Question room 3" ;101 | |
1914 | ) | |
1915 | ( | |
1916 | "You are in the endgame treasure room. A door leads out to the north, and | |
1917 | a hallway leads to the south." | |
1918 | "Endgame treasure room" ;102 | |
1919 | ) | |
1920 | ( | |
1921 | "You are in the winner's room. A door leads back to the south." | |
1922 | "Winner's room" ;103 | |
1923 | ) | |
1924 | ( | |
1925 | "You have reached a dead end. There is a PC on the floor here. Above | |
1926 | it is a sign that reads: | |
a1506d29 | 1927 | Type the 'reset' command to type on the PC. |
62078373 RS |
1928 | A hole leads north." |
1929 | "PC area" ;104 | |
a1506d29 | 1930 | ) |
62078373 RS |
1931 | )) |
1932 | ||
a399c536 | 1933 | (setq dun-light-rooms '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 24 25 26 27 28 58 59 |
62078373 RS |
1934 | 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 |
1935 | 77 78 79 80 81 82 83)) | |
1936 | ||
a1506d29 | 1937 | (setq dun-verblist '((die . dun-die) (ne . dun-ne) (north . dun-n) |
a399c536 RS |
1938 | (south . dun-s) (east . dun-e) (west . dun-w) |
1939 | (u . dun-up) (d . dun-down) (i . dun-inven) | |
1940 | (inventory . dun-inven) (look . dun-examine) (n . dun-n) | |
1941 | (s . dun-s) (e . dun-e) (w . dun-w) (se . dun-se) | |
a1506d29 | 1942 | (nw . dun-nw) (sw . dun-sw) (up . dun-up) |
a399c536 RS |
1943 | (down . dun-down) (in . dun-in) (out . dun-out) |
1944 | (go . dun-go) (drop . dun-drop) (southeast . dun-se) | |
1945 | (southwest . dun-sw) (northeast . dun-ne) | |
1946 | (northwest . dun-nw) (save . dun-save-game) | |
1947 | (restore . dun-restore) (long . dun-long) (dig . dun-dig) | |
1948 | (shake . dun-shake) (wave . dun-shake) | |
a1506d29 | 1949 | (examine . dun-examine) (describe . dun-examine) |
a399c536 RS |
1950 | (climb . dun-climb) (eat . dun-eat) (put . dun-put) |
1951 | (type . dun-type) (insert . dun-put) | |
a1506d29 JB |
1952 | (score . dun-score) (help . dun-help) (quit . dun-quit) |
1953 | (read . dun-examine) (verbose . dun-long) | |
cd9012b5 | 1954 | (urinate . dun-piss) (piss . dun-piss) |
a1506d29 | 1955 | (flush . dun-flush) (sleep . dun-sleep) (lie . dun-sleep) |
a399c536 RS |
1956 | (x . dun-examine) (break . dun-break) (drive . dun-drive) |
1957 | (board . dun-in) (enter . dun-in) (turn . dun-turn) | |
1958 | (press . dun-press) (push . dun-press) (swim . dun-swim) | |
1959 | (on . dun-in) (off . dun-out) (chop . dun-break) | |
1960 | (switch . dun-press) (cut . dun-break) (exit . dun-out) | |
1961 | (leave . dun-out) (reset . dun-power) (flick . dun-press) | |
1962 | (superb . dun-superb) (answer . dun-answer) | |
1963 | (throw . dun-drop) (l . dun-examine) (take . dun-take) | |
1964 | (get . dun-take) (feed . dun-feed))) | |
1965 | ||
1966 | (setq dun-inbus nil) | |
1967 | (setq dun-nomail nil) | |
1968 | (setq dun-ignore '(the to at)) | |
1969 | (setq dun-mode 'moby) | |
1970 | (setq dun-sauna-level 0) | |
62078373 RS |
1971 | |
1972 | (defconst north 0) | |
1973 | (defconst south 1) | |
1974 | (defconst east 2) | |
1975 | (defconst west 3) | |
1976 | (defconst northeast 4) | |
1977 | (defconst southeast 5) | |
1978 | (defconst northwest 6) | |
1979 | (defconst southwest 7) | |
1980 | (defconst up 8) | |
1981 | (defconst down 9) | |
1982 | (defconst in 10) | |
1983 | (defconst out 11) | |
1984 | ||
1985 | (setq dungeon-map '( | |
1986 | ; no so ea we ne se nw sw up do in ot | |
1987 | ( 96 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;0 | |
1988 | ( -1 -1 2 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;1 | |
1989 | ( -1 -1 3 1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;2 | |
1990 | ( -1 -1 -1 2 4 6 -1 -1 -1 -1 -1 -1 ) ;3 | |
1991 | ( -1 -1 -1 -1 5 -1 -1 3 -1 -1 -1 -1 ) ;4 | |
1992 | ( -1 -1 -1 -1 255 -1 -1 4 -1 -1 255 -1 ) ;5 | |
1993 | ( -1 -1 -1 -1 -1 7 3 -1 -1 -1 -1 -1 ) ;6 | |
1994 | ( -1 -1 -1 -1 -1 255 6 27 -1 -1 -1 -1 ) ;7 | |
1995 | ( 255 5 9 10 -1 -1 -1 5 -1 -1 -1 5 ) ;8 | |
1996 | ( -1 -1 -1 8 -1 -1 -1 -1 -1 -1 -1 -1 ) ;9 | |
1997 | ( -1 -1 8 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;10 | |
1998 | ( -1 8 -1 58 -1 -1 -1 -1 -1 -1 -1 -1 ) ;11 | |
1999 | ( -1 -1 13 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;12 | |
2000 | ( 15 -1 14 12 -1 -1 -1 -1 -1 -1 -1 -1 ) ;13 | |
2001 | ( -1 -1 -1 13 -1 -1 -1 -1 -1 -1 -1 -1 ) ;14 | |
2002 | ( -1 13 16 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;15 | |
2003 | ( -1 -1 -1 15 -1 -1 -1 -1 -1 17 16 -1 ) ;16 | |
2004 | ( -1 -1 17 17 17 17 255 17 255 17 -1 -1 ) ;17 | |
2005 | ( 18 18 18 18 18 -1 18 18 19 18 -1 -1 ) ;18 | |
2006 | ( -1 18 18 19 19 20 19 19 -1 18 -1 -1 ) ;19 | |
2007 | ( -1 -1 -1 18 -1 -1 -1 -1 -1 21 -1 -1 ) ;20 | |
2008 | ( -1 -1 -1 -1 -1 20 22 -1 -1 -1 -1 -1 ) ;21 | |
2009 | ( 18 18 18 18 16 18 23 18 18 18 18 18 ) ;22 | |
2010 | ( -1 255 -1 -1 -1 19 -1 -1 -1 -1 -1 -1 ) ;23 | |
2011 | ( 23 25 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;24 | |
2012 | ( 24 255 -1 -1 -1 -1 -1 -1 -1 -1 255 -1 ) ;25 | |
2013 | (255 28 -1 -1 -1 -1 -1 -1 -1 -1 255 -1 ) ;26 | |
2014 | ( -1 -1 -1 -1 7 -1 -1 -1 -1 -1 -1 -1 ) ;27 | |
2015 | ( 26 255 -1 -1 -1 -1 -1 -1 -1 -1 255 -1 ) ;28 | |
2016 | ( -1 -1 30 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;29 | |
2017 | ( -1 -1 31 29 -1 -1 -1 -1 -1 -1 -1 -1 ) ;30 | |
2018 | ( 32 33 -1 30 -1 -1 -1 -1 -1 -1 -1 -1 ) ;31 | |
2019 | ( -1 31 -1 255 -1 -1 -1 -1 -1 34 -1 -1 ) ;32 | |
2020 | ( 31 -1 -1 -1 -1 -1 -1 -1 -1 35 -1 -1 ) ;33 | |
2021 | ( -1 35 -1 -1 -1 -1 -1 -1 32 37 -1 -1 ) ;34 | |
2022 | ( 34 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;35 | |
2023 | ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;36 | |
2024 | ( -1 -1 -1 -1 -1 -1 -1 38 34 -1 -1 -1 ) ;37 | |
2025 | ( -1 -1 40 41 37 -1 -1 39 -1 -1 -1 -1 ) ;38 | |
2026 | ( -1 -1 -1 -1 38 -1 -1 -1 -1 -1 -1 -1 ) ;39 | |
2027 | ( -1 -1 -1 38 -1 -1 -1 -1 42 -1 -1 -1 ) ;40 | |
2028 | ( -1 -1 38 -1 -1 -1 -1 -1 -1 43 -1 -1 ) ;41 | |
2029 | ( -1 -1 -1 -1 -1 -1 -1 -1 -1 40 -1 -1 ) ;42 | |
2030 | ( 44 -1 46 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;43 | |
2031 | ( -1 43 45 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;44 | |
2032 | ( -1 46 -1 44 -1 -1 -1 -1 -1 -1 -1 -1 ) ;45 | |
2033 | ( 45 -1 -1 43 -1 -1 -1 -1 -1 255 -1 -1 ) ;46 | |
2034 | ( 48 50 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;47 | |
2035 | ( 49 47 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;48 | |
2036 | ( -1 48 -1 -1 -1 -1 -1 -1 52 -1 -1 -1 ) ;49 | |
2037 | ( 47 51 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;50 | |
2038 | ( 50 104 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;51 | |
2039 | ( -1 -1 -1 -1 -1 -1 -1 -1 53 49 -1 -1 ) ;52 | |
2040 | ( -1 -1 -1 -1 -1 -1 -1 -1 54 52 -1 -1 ) ;53 | |
2041 | ( -1 -1 -1 -1 55 -1 -1 -1 -1 53 -1 -1 ) ;54 | |
2042 | ( -1 -1 -1 -1 56 -1 -1 54 -1 -1 -1 54 ) ;55 | |
2043 | ( -1 -1 -1 -1 -1 -1 -1 55 -1 31 -1 -1 ) ;56 | |
2044 | ( -1 -1 32 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;57 | |
2045 | ( 59 -1 11 -1 -1 -1 -1 -1 -1 -1 255 255) ;58 | |
2046 | ( 60 58 63 -1 -1 -1 255 -1 -1 -1 255 255) ;59 | |
2047 | ( 61 59 64 -1 -1 -1 -1 -1 -1 -1 255 255) ;60 | |
2048 | ( 62 60 65 -1 -1 -1 -1 -1 -1 -1 255 255) ;61 | |
2049 | ( -1 61 66 -1 -1 -1 -1 -1 -1 -1 255 255) ;62 | |
2050 | ( 64 -1 67 59 -1 -1 -1 -1 -1 -1 255 255) ;63 | |
2051 | ( 65 63 68 60 -1 -1 -1 -1 -1 -1 255 255) ;64 | |
2052 | ( 66 64 69 61 -1 -1 -1 -1 -1 -1 255 255) ;65 | |
2053 | ( -1 65 70 62 -1 -1 -1 -1 -1 -1 255 255) ;66 | |
2054 | ( 68 -1 71 63 -1 -1 -1 -1 -1 -1 255 255) ;67 | |
2055 | ( 69 67 72 64 -1 -1 -1 -1 -1 -1 255 255) ;68 | |
2056 | ( 70 68 73 65 -1 -1 -1 -1 -1 -1 255 255) ;69 | |
2057 | ( -1 69 74 66 -1 -1 -1 -1 -1 -1 255 255) ;70 | |
2058 | ( 72 -1 75 67 -1 -1 -1 -1 -1 -1 255 255) ;71 | |
2059 | ( 73 71 76 68 -1 -1 -1 -1 -1 -1 255 255) ;72 | |
2060 | ( 74 72 77 69 -1 -1 -1 -1 -1 -1 255 255) ;73 | |
2061 | ( -1 73 78 70 -1 -1 -1 -1 -1 -1 255 255) ;74 | |
2062 | ( 76 -1 79 71 -1 -1 -1 -1 -1 -1 255 255) ;75 | |
2063 | ( 77 75 80 72 -1 -1 -1 -1 -1 -1 255 255) ;76 | |
2064 | ( 78 76 81 73 -1 -1 -1 -1 -1 -1 255 255) ;77 | |
2065 | ( -1 77 82 74 -1 -1 -1 -1 -1 -1 255 255) ;78 | |
2066 | ( 80 -1 -1 75 -1 -1 -1 -1 -1 -1 255 255) ;79 | |
2067 | ( 81 79 255 76 -1 -1 -1 -1 -1 -1 255 255) ;80 | |
2068 | ( 82 80 -1 77 -1 -1 -1 -1 -1 -1 255 255) ;81 | |
2069 | ( -1 81 -1 78 -1 -1 -1 -1 -1 -1 255 255) ;82 | |
2070 | ( 84 -1 -1 -1 -1 59 -1 -1 -1 -1 255 255) ;83 | |
2071 | ( -1 83 85 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;84 | |
2072 | ( 86 -1 87 84 -1 -1 -1 -1 -1 -1 -1 -1 ) ;85 | |
2073 | ( -1 85 88 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;86 | |
2074 | ( 88 -1 -1 85 -1 -1 -1 -1 -1 -1 -1 -1 ) ;87 | |
2075 | ( -1 87 255 86 -1 -1 -1 -1 -1 -1 -1 -1 ) ;88 | |
2076 | ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 255 -1 ) ;89 | |
2077 | ( 91 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;90 | |
2078 | ( 92 90 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;91 | |
2079 | ( -1 91 -1 -1 -1 -1 -1 -1 93 94 -1 -1 ) ;92 | |
2080 | ( -1 -1 -1 88 -1 -1 -1 -1 -1 92 -1 -1 ) ;93 | |
2081 | ( -1 -1 -1 -1 95 -1 -1 -1 92 -1 -1 -1 ) ;94 | |
2082 | ( -1 -1 -1 -1 -1 -1 -1 94 -1 -1 -1 -1 ) ;95 | |
2083 | ( 97 0 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;96 | |
2084 | ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;97 | |
2085 | ( 99 97 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;98 | |
2086 | ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;99 | |
2087 | ( 101 99 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;100 | |
2088 | ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;101 | |
2089 | ( 103 101 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;102 | |
2090 | ( -1 102 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;103 | |
2091 | ( 51 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;104 | |
2092 | ) | |
2093 | ; no so ea we ne se nw sw up do in ot | |
2094 | ) | |
2095 | ||
2096 | ||
2097 | ;;; How the user references *all* objects, permanent and regular. | |
a399c536 | 2098 | (setq dun-objnames '( |
a1506d29 | 2099 | (shovel . 0) |
62078373 | 2100 | (lamp . 1) |
058c1767 | 2101 | (cpu . 2) (board . 2) (card . 2) (chip . 2) |
a1506d29 JB |
2102 | (food . 3) |
2103 | (key . 4) | |
058c1767 | 2104 | (paper . 5) (slip . 5) |
62078373 RS |
2105 | (rms . 6) (statue . 6) (statuette . 6) (stallman . 6) |
2106 | (diamond . 7) | |
2107 | (weight . 8) | |
2108 | (life . 9) (preserver . 9) | |
a1506d29 | 2109 | (bracelet . 10) (emerald . 10) |
62078373 RS |
2110 | (gold . 11) |
2111 | (platinum . 12) | |
2112 | (towel . 13) (beach . 13) | |
2113 | (axe . 14) | |
2114 | (silver . 15) | |
2115 | (license . 16) | |
2116 | (coins . 17) | |
2117 | (egg . 18) | |
2118 | (jar . 19) | |
2119 | (bone . 20) | |
2120 | (acid . 21) (nitric . 21) | |
2121 | (glycerine . 22) | |
2122 | (ruby . 23) | |
a1506d29 | 2123 | (amethyst . 24) |
62078373 | 2124 | (mona . 25) |
a1506d29 | 2125 | (bill . 26) |
62078373 | 2126 | (floppy . 27) (disk . 27) |
a1506d29 | 2127 | |
62078373 | 2128 | (boulder . -1) |
a1506d29 | 2129 | (tree . -2) (trees . -2) (palm . -2) |
62078373 RS |
2130 | (bear . -3) |
2131 | (bin . -4) (bins . -4) | |
a1506d29 | 2132 | (cabinet . -5) (computer . -5) (vax . -5) (ibm . -5) |
62078373 | 2133 | (protoplasm . -6) |
a1506d29 JB |
2134 | (dial . -7) |
2135 | (button . -8) | |
2136 | (chute . -9) | |
62078373 RS |
2137 | (painting . -10) |
2138 | (bed . -11) | |
2139 | (urinal . -12) | |
2140 | (URINE . -13) | |
a1506d29 JB |
2141 | (pipes . -14) (pipe . -14) |
2142 | (box . -15) (slit . -15) | |
2143 | (cable . -16) (ethernet . -16) | |
62078373 RS |
2144 | (mail . -17) (drop . -17) |
2145 | (bus . -18) | |
2146 | (gate . -19) | |
a1506d29 | 2147 | (cliff . -20) |
62078373 RS |
2148 | (skeleton . -21) (dinosaur . -21) |
2149 | (fish . -22) | |
058c1767 | 2150 | (tanks . -23) (tank . -23) |
62078373 RS |
2151 | (switch . -24) |
2152 | (blackboard . -25) | |
2153 | (disposal . -26) (garbage . -26) | |
2154 | (ladder . -27) | |
a1506d29 | 2155 | (subway . -28) (train . -28) |
058c1767 RS |
2156 | (pc . -29) (drive . -29) (coconut . -30) (coconuts . -30) |
2157 | (lake . -32) (water . -32) | |
62078373 RS |
2158 | )) |
2159 | ||
a399c536 | 2160 | (dolist (x dun-objnames) |
62078373 RS |
2161 | (let (name) |
2162 | (setq name (concat "obj-" (prin1-to-string (car x)))) | |
2163 | (eval (list 'defconst (intern name) (cdr x))))) | |
2164 | ||
2165 | (defconst obj-special 255) | |
2166 | ||
2167 | ;;; The initial setup of what objects are in each room. | |
2168 | ;;; Regular objects have whole numbers lower than 255. | |
2169 | ;;; Objects that cannot be taken but might move and are | |
2170 | ;;; described during room description are negative. | |
2171 | ;;; Stuff that is described and might change are 255, and are | |
a1506d29 | 2172 | ;;; handled specially by 'dun-describe-room. |
62078373 | 2173 | |
a1506d29 | 2174 | (setq dun-room-objects (list nil |
62078373 RS |
2175 | |
2176 | (list obj-shovel) ;; treasure-room | |
2177 | (list obj-boulder) ;; dead-end | |
2178 | nil nil nil | |
2179 | (list obj-food) ;; se-nw-road | |
2180 | (list obj-bear) ;; bear-hangout | |
2181 | nil nil | |
2182 | (list obj-special) ;; computer-room | |
2183 | (list obj-lamp obj-license obj-silver);; meadow | |
2184 | nil nil | |
2185 | (list obj-special) ;; sauna | |
a1506d29 | 2186 | nil |
62078373 RS |
2187 | (list obj-weight obj-life) ;; weight-room |
2188 | nil nil | |
2189 | (list obj-rms obj-floppy) ;; thirsty-maze | |
a1506d29 | 2190 | nil nil nil nil nil nil nil |
62078373 RS |
2191 | (list obj-emerald) ;; hidden-area |
2192 | nil | |
2193 | (list obj-gold) ;; misty-room | |
2194 | nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil | |
2195 | (list obj-towel obj-special) ;; red-room | |
2196 | nil nil nil nil nil | |
2197 | (list obj-box) ;; stair-landing | |
2198 | nil nil nil | |
2199 | (list obj-axe) ;; smal-crawlspace | |
2200 | nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil | |
2201 | nil nil nil nil nil | |
2202 | (list obj-special) ;; fourth-vermont-intersection | |
2203 | nil nil | |
2204 | (list obj-coins) ;; fifth-oaktree-intersection | |
2205 | nil | |
2206 | (list obj-bus) ;; fifth-sycamore-intersection | |
2207 | nil | |
2208 | (list obj-bone) ;; museum-lobby | |
2209 | nil | |
2210 | (list obj-jar obj-special obj-ruby) ;; marine-life-area | |
2211 | (list obj-nitric) ;; maintenance-room | |
2212 | (list obj-glycerine) ;; classroom | |
2213 | nil nil nil nil nil | |
2214 | (list obj-amethyst) ;; bottom-of-subway-stairs | |
2215 | nil nil | |
2216 | (list obj-special) ;; question-room-1 | |
2217 | nil | |
2218 | (list obj-special) ;; question-room-2 | |
2219 | nil | |
2220 | (list obj-special) ;; question-room-three | |
2221 | nil | |
2222 | (list obj-mona) ;; winner's-room | |
2223 | nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil | |
2224 | nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil | |
2225 | nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil | |
2226 | nil)) | |
2227 | ||
2228 | ;;; These are objects in a room that are only described in the | |
2229 | ;;; room description. They are permanent. | |
2230 | ||
a399c536 | 2231 | (setq dun-room-silents (list nil |
058c1767 RS |
2232 | (list obj-tree obj-coconut) ;; dead-end |
2233 | (list obj-tree obj-coconut) ;; e-w-dirt-road | |
62078373 RS |
2234 | nil nil nil nil nil nil |
2235 | (list obj-bin) ;; mailroom | |
2236 | (list obj-computer) ;; computer-room | |
2237 | nil nil nil | |
2238 | (list obj-dial) ;; sauna | |
2239 | nil | |
2240 | (list obj-ladder) ;; weight-room | |
2241 | (list obj-button obj-ladder) ;; maze-button-room | |
2242 | nil nil nil | |
058c1767 RS |
2243 | nil nil nil nil |
2244 | (list obj-lake) ;; lakefront-north | |
2245 | (list obj-lake) ;; lakefront-south | |
2246 | nil | |
62078373 RS |
2247 | (list obj-chute) ;; cave-entrance |
2248 | nil nil nil nil nil | |
2249 | (list obj-painting obj-bed) ;; bedroom | |
2250 | (list obj-urinal obj-pipes) ;; bathroom | |
2251 | nil nil nil nil nil nil | |
2252 | (list obj-boulder) ;; horseshoe-boulder-room | |
2253 | nil nil nil nil nil nil nil nil nil nil nil nil nil nil | |
2254 | (list obj-computer obj-cable) ;; gamma-computing-center | |
2255 | (list obj-mail) ;; post-office | |
2256 | (list obj-gate) ;; main-maple-intersection | |
2257 | nil nil nil nil nil nil nil nil nil nil nil nil nil | |
2258 | nil nil nil nil nil nil nil | |
2259 | (list obj-cliff) ;; fifth-oaktree-intersection | |
2260 | nil nil nil | |
2261 | (list obj-dinosaur) ;; museum-lobby | |
2262 | nil | |
2263 | (list obj-fish obj-tanks) ;; marine-life-area | |
2264 | (list obj-switch) ;; maintenance-room | |
2265 | (list obj-blackboard) ;; classroom | |
2266 | (list obj-train) ;; vermont-station | |
2267 | nil nil | |
2268 | (list obj-disposal) ;; north-end-of-n-s-tunnel | |
2269 | nil nil | |
2270 | (list obj-computer) ;; endgame-computer-room | |
a1506d29 | 2271 | nil nil nil nil nil nil nil nil |
62078373 RS |
2272 | (list obj-pc) ;; pc-area |
2273 | nil nil nil nil nil nil | |
2274 | )) | |
a399c536 | 2275 | (setq dun-inventory '(1)) |
62078373 RS |
2276 | |
2277 | ;;; Descriptions of objects, as they appear in the room description, and | |
2278 | ;;; the inventory. | |
2279 | ||
a399c536 | 2280 | (setq dun-objects '( |
62078373 RS |
2281 | ("There is a shovel here." "A shovel") ;0 |
2282 | ("There is a lamp nearby." "A lamp") ;1 | |
2283 | ("There is a CPU card here." "A computer board") ;2 | |
2284 | ("There is some food here." "Some food") ;3 | |
2285 | ("There is a shiny brass key here." "A brass key") ;4 | |
2286 | ("There is a slip of paper here." "A slip of paper") ;5 | |
2287 | ("There is a wax statuette of Richard Stallman here." ;6 | |
2288 | "An RMS statuette") | |
2289 | ("There is a shimmering diamond here." "A diamond") ;7 | |
2290 | ("There is a 10 pound weight here." "A weight") ;8 | |
2291 | ("There is a life preserver here." "A life preserver");9 | |
2292 | ("There is an emerald bracelet here." "A bracelet") ;10 | |
2293 | ("There is a gold bar here." "A gold bar") ;11 | |
2294 | ("There is a platinum bar here." "A platinum bar") ;12 | |
2295 | ("There is a beach towel on the ground here." "A beach towel") | |
2296 | ("There is an axe here." "An axe") ;14 | |
2297 | ("There is a silver bar here." "A silver bar") ;15 | |
2298 | ("There is a bus driver's license here." "A license") ;16 | |
2299 | ("There are some valuable coins here." "Some valuable coins") | |
2300 | ("There is a jewel-encrusted egg here." "A valuable egg") ;18 | |
2301 | ("There is a glass jar here." "A glass jar") ;19 | |
2302 | ("There is a dinosaur bone here." "A bone") ;20 | |
2303 | ("There is a packet of nitric acid here." "Some nitric acid") | |
2304 | ("There is a packet of glycerine here." "Some glycerine") ;22 | |
2305 | ("There is a valuable ruby here." "A ruby") ;23 | |
2306 | ("There is a valuable amethyst here." "An amethyst") ;24 | |
2307 | ("The Mona Lisa is here." "The Mona Lisa") ;25 | |
2308 | ("There is a 100 dollar bill here." "A $100 bill") ;26 | |
2309 | ("There is a floppy disk here." "A floppy disk") ;27 | |
2310 | ) | |
2311 | ) | |
2312 | ||
2313 | ;;; Weight of objects | |
2314 | ||
a1506d29 | 2315 | (setq dun-object-lbs |
a399c536 | 2316 | '(2 1 1 1 1 0 2 2 10 3 1 1 1 0 1 1 0 1 1 1 1 0 0 2 2 1 0 0)) |
a1506d29 | 2317 | (setq dun-object-pts |
a399c536 | 2318 | '(0 0 0 0 0 0 0 10 0 0 10 10 10 0 0 10 0 10 10 0 0 0 0 10 10 10 10 0)) |
62078373 RS |
2319 | |
2320 | ||
2321 | ;;; Unix representation of objects. | |
a399c536 | 2322 | (setq dun-objfiles '( |
62078373 RS |
2323 | "shovel.o" "lamp.o" "cpu.o" "food.o" "key.o" "paper.o" |
2324 | "rms.o" "diamond.o" "weight.o" "preserver.o" "bracelet.o" | |
2325 | "gold.o" "platinum.o" "towel.o" "axe.o" "silver.o" "license.o" | |
2326 | "coins.o" "egg.o" "jar.o" "bone.o" "nitric.o" "glycerine.o" | |
2327 | "ruby.o" "amethyst.o" | |
2328 | )) | |
2329 | ||
2330 | ;;; These are the descriptions for the negative numbered objects from | |
a399c536 | 2331 | ;;; dun-room-objects |
62078373 | 2332 | |
a399c536 | 2333 | (setq dun-perm-objects '( |
62078373 RS |
2334 | nil |
2335 | ("There is a large boulder here.") | |
2336 | nil | |
2337 | ("There is a ferocious bear here!") | |
2338 | nil | |
2339 | nil | |
2340 | ("There is a worthless pile of protoplasm here.") | |
2341 | nil | |
2342 | nil | |
2343 | nil | |
2344 | nil | |
2345 | nil | |
2346 | nil | |
2347 | ("There is a strange smell in this room.") | |
2348 | nil | |
2349 | ( | |
2350 | "There is a box with a slit in it, bolted to the wall here." | |
2351 | ) | |
2352 | nil | |
2353 | nil | |
2354 | ("There is a bus here.") | |
2355 | nil | |
2356 | nil | |
2357 | nil | |
2358 | )) | |
2359 | ||
2360 | ||
2361 | ;;; These are the descriptions the user gets when regular objects are | |
2362 | ;;; examined. | |
2363 | ||
a399c536 | 2364 | (setq dun-physobj-desc '( |
62078373 RS |
2365 | "It is a normal shovel with a price tag attached that says $19.99." |
2366 | "The lamp is hand-crafted by Geppetto." | |
2367 | "The CPU board has a VAX chip on it. It seems to have | |
2368 | 2 Megabytes of RAM onboard." | |
2369 | "It looks like some kind of meat. Smells pretty bad." | |
2370 | nil | |
2371 | "The paper says: Don't forget to type 'help' for help. Also, remember | |
2372 | this word: 'worms'" | |
2373 | "The statuette is of the likeness of Richard Stallman, the author of the | |
2374 | famous EMACS editor. You notice that he is not wearing any shoes." | |
2375 | nil | |
2376 | "You observe that the weight is heavy." | |
2377 | "It says S. S. Minnow." | |
2378 | nil | |
2379 | nil | |
2380 | nil | |
2381 | "It has a picture of snoopy on it." | |
2382 | nil | |
2383 | nil | |
2384 | "It has your picture on it!" | |
2385 | "They are old coins from the 19th century." | |
2386 | "It is a valuable Fabrege egg." | |
318cfc64 | 2387 | "It is a plain glass jar." |
62078373 RS |
2388 | nil |
2389 | nil | |
2390 | nil | |
2391 | nil | |
2392 | nil | |
2393 | ) | |
2394 | ) | |
2395 | ||
2396 | ;;; These are the descriptions the user gets when non-regular objects | |
2397 | ;;; are examined. | |
2398 | ||
a399c536 | 2399 | (setq dun-permobj-desc '( |
62078373 RS |
2400 | nil |
2401 | "It is just a boulder. It cannot be moved." | |
2402 | "They are palm trees with a bountiful supply of coconuts in them." | |
2403 | "It looks like a grizzly to me." | |
2404 | "All of the bins are empty. Looking closely you can see that there | |
2405 | are names written at the bottom of each bin, but most of them are | |
2406 | faded away so that you cannot read them. You can only make out three | |
2407 | names: | |
2408 | Jeffrey Collier | |
2409 | Robert Toukmond | |
2410 | Thomas Stock | |
2411 | " | |
2412 | nil | |
2413 | "It is just a garbled mess." | |
2414 | "The dial points to a temperature scale which has long since faded away." | |
2415 | nil | |
2416 | nil | |
058c1767 | 2417 | "It is a velvet painting of Elvis Presley. It seems to be nailed to the |
62078373 RS |
2418 | wall, and you cannot move it." |
2419 | "It is a queen sized bed, with a very firm mattress." | |
2420 | "The urinal is very clean compared with everything else in the cave. There | |
2421 | isn't even any rust. Upon close examination you realize that the drain at the | |
2422 | bottom is missing, and there is just a large hole leading down the | |
a1506d29 | 2423 | pipes into nowhere. The hole is too small for a person to fit in. The |
62078373 RS |
2424 | flush handle is so clean that you can see your reflection in it." |
2425 | nil | |
2426 | nil | |
2427 | "The box has a slit in the top of it, and on it, in sloppy handwriting, is | |
2428 | written: 'For key upgrade, put key in here.'" | |
2429 | nil | |
2430 | "It says 'express mail' on it." | |
2431 | "It is a 35 passenger bus with the company name 'mobytours' on it." | |
2432 | "It is a large metal gate that is too big to climb over." | |
2433 | "It is a HIGH cliff." | |
2434 | "Unfortunately you do not know enough about dinosaurs to tell very much about | |
2435 | it. It is very big, though." | |
2436 | "The fish look like they were once quite beautiful." | |
2437 | nil | |
2438 | nil | |
2439 | nil | |
2440 | nil | |
2441 | "It is a normal ladder that is permanently attached to the hole." | |
2442 | "It is a passenger train that is ready to go." | |
2443 | "It is a personal computer that has only one floppy disk drive." | |
2444 | ) | |
2445 | ) | |
2446 | ||
a1506d29 | 2447 | (setq dun-diggables |
a399c536 | 2448 | (list nil nil nil (list obj-cpu) nil nil nil nil nil nil nil |
62078373 RS |
2449 | nil nil nil nil nil nil nil nil nil nil ;11-20 |
2450 | nil nil nil nil nil nil nil nil nil nil ;21-30 | |
2451 | nil nil nil nil nil nil nil nil nil nil ;31-40 | |
2452 | nil (list obj-platinum) nil nil nil nil nil nil nil nil)) | |
2453 | ||
a399c536 RS |
2454 | (setq dun-room-shorts nil) |
2455 | (dolist (x dun-rooms) | |
a1506d29 JB |
2456 | (setq dun-room-shorts |
2457 | (append dun-room-shorts (list (downcase | |
a399c536 RS |
2458 | (dun-space-to-hyphen |
2459 | (cadr x))))))) | |
2460 | ||
2461 | (setq dun-endgame-questions '( | |
62078373 RS |
2462 | ( |
2463 | "What is your password on the machine called 'pokey'?" "robert") | |
2464 | ( | |
2465 | "What password did you use during anonymous ftp to gamma?" "foo") | |
2466 | ( | |
2467 | "Excluding the endgame, how many places are there where you can put | |
2468 | treasures for points?" "4" "four") | |
2469 | ( | |
2470 | "What is your login name on the 'endgame' machine?" "toukmond" | |
2471 | ) | |
2472 | ( | |
2473 | "What is the nearest whole dollar to the price of the shovel?" "20" "twenty") | |
2474 | ( | |
2475 | "What is the name of the bus company serving the town?" "mobytours") | |
2476 | ( | |
2477 | "Give either of the two last names in the mailroom, other than your own." | |
2478 | "collier" "stock") | |
2479 | ( | |
2480 | "What cartoon character is on the towel?" "snoopy") | |
2481 | ( | |
2482 | "What is the last name of the author of EMACS?" "stallman") | |
2483 | ( | |
2484 | "How many megabytes of memory is on the CPU board for the Vax?" "2") | |
2485 | ( | |
2486 | "Which street in town is named after a U.S. state?" "vermont") | |
2487 | ( | |
2488 | "How many pounds did the weight weigh?" "ten" "10") | |
2489 | ( | |
2490 | "Name the STREET which runs right over the subway stop." "fourth" "4" "4th") | |
2491 | ( | |
2492 | "How many corners are there in town (excluding the one with the Post Office)?" | |
2493 | "24" "twentyfour" "twenty-four") | |
2494 | ( | |
2495 | "What type of bear was hiding your key?" "grizzly") | |
2496 | ( | |
2497 | "Name either of the two objects you found by digging." "cpu" "card" "vax" | |
2498 | "board" "platinum") | |
2499 | ( | |
2500 | "What network protocol is used between pokey and gamma?" "tcp/ip" "ip" "tcp") | |
2501 | )) | |
2502 | ||
2503 | (let (a) | |
2504 | (setq a 0) | |
a399c536 | 2505 | (dolist (x dun-room-shorts) |
62078373 RS |
2506 | (eval (list 'defconst (intern x) a)) |
2507 | (setq a (+ a 1)))) | |
2508 | ||
2509 | ||
2510 | ||
2511 | ;;;; | |
2512 | ;;;; This section defines the UNIX emulation functions for dunnet. | |
2513 | ;;;; | |
2514 | ||
a399c536 | 2515 | (defun dun-unix-parse (args) |
62078373 RS |
2516 | (interactive "*p") |
2517 | (beginning-of-line) | |
2518 | (let (beg esign) | |
2519 | (setq beg (+ (point) 2)) | |
2520 | (end-of-line) | |
2521 | (if (and (not (= beg (point))) | |
2522 | (string= "$" (buffer-substring (- beg 2) (- beg 1)))) | |
2523 | (progn | |
2524 | (setq line (downcase (buffer-substring beg (point)))) | |
2525 | (princ line) | |
a399c536 | 2526 | (if (eq (dun-parse2 nil dun-unix-verbs line) -1) |
62078373 RS |
2527 | (progn |
2528 | (if (setq esign (string-match "=" line)) | |
a1506d29 | 2529 | (dun-doassign line esign) |
a399c536 RS |
2530 | (dun-mprinc (car line-list)) |
2531 | (dun-mprincl ": not found."))))) | |
62078373 | 2532 | (goto-char (point-max)) |
a399c536 | 2533 | (dun-mprinc "\n")) |
62078373 RS |
2534 | (if (eq dungeon-mode 'unix) |
2535 | (progn | |
a399c536 RS |
2536 | (dun-fix-screen) |
2537 | (dun-mprinc "$ "))))) | |
62078373 | 2538 | |
a399c536 RS |
2539 | (defun dun-doassign (line esign) |
2540 | (if (not dun-wizard) | |
62078373 | 2541 | (let (passwd) |
a399c536 RS |
2542 | (dun-mprinc "Enter wizard password: ") |
2543 | (setq passwd (dun-read-line)) | |
2544 | (if (not dun-batch-mode) | |
2545 | (dun-mprinc "\n")) | |
62078373 RS |
2546 | (if (string= passwd "moby") |
2547 | (progn | |
a399c536 RS |
2548 | (setq dun-wizard t) |
2549 | (dun-doassign line esign)) | |
2550 | (dun-mprincl "Incorrect."))) | |
62078373 RS |
2551 | |
2552 | (let (varname epoint afterq i value) | |
2553 | (setq varname (substring line 0 esign)) | |
2554 | (if (not (setq epoint (string-match ")" line))) | |
2555 | (if (string= (substring line (1+ esign) (+ esign 2)) | |
2556 | "\"") | |
2557 | (progn | |
2558 | (setq afterq (substring line (+ esign 2))) | |
2559 | (setq epoint (+ | |
2560 | (string-match "\"" afterq) | |
2561 | (+ esign 3)))) | |
a1506d29 | 2562 | |
62078373 RS |
2563 | (if (not (setq epoint (string-match " " line))) |
2564 | (setq epoint (length line)))) | |
2565 | (setq epoint (1+ epoint)) | |
2566 | (while (and | |
2567 | (not (= epoint (length line))) | |
2568 | (setq i (string-match ")" (substring line epoint)))) | |
2569 | (setq epoint (+ epoint i 1)))) | |
2570 | (setq value (substring line (1+ esign) epoint)) | |
a399c536 | 2571 | (dun-eval varname value)))) |
62078373 | 2572 | |
a399c536 | 2573 | (defun dun-eval (varname value) |
62078373 RS |
2574 | (let (eval-error) |
2575 | (switch-to-buffer (get-buffer-create "*dungeon-eval*")) | |
2576 | (erase-buffer) | |
2577 | (insert "(setq ") | |
2578 | (insert varname) | |
2579 | (insert " ") | |
2580 | (insert value) | |
2581 | (insert ")") | |
2582 | (setq eval-error nil) | |
2583 | (condition-case nil | |
2584 | (eval-current-buffer) | |
2585 | (error (setq eval-error t))) | |
2586 | (kill-buffer (current-buffer)) | |
2587 | (switch-to-buffer "*dungeon*") | |
2588 | (if eval-error | |
a399c536 | 2589 | (dun-mprincl "Invalid syntax.")))) |
a1506d29 | 2590 | |
62078373 | 2591 | |
a399c536 RS |
2592 | (defun dun-unix-interface () |
2593 | (dun-login) | |
2594 | (if dun-logged-in | |
62078373 RS |
2595 | (progn |
2596 | (setq dungeon-mode 'unix) | |
a399c536 RS |
2597 | (define-key dungeon-mode-map "\r" 'dun-unix-parse) |
2598 | (dun-mprinc "$ ")))) | |
62078373 | 2599 | |
a399c536 | 2600 | (defun dun-login () |
62078373 RS |
2601 | (let (tries username password) |
2602 | (setq tries 4) | |
a399c536 RS |
2603 | (while (and (not dun-logged-in) (> (setq tries (- tries 1)) 0)) |
2604 | (dun-mprinc "\n\nUNIX System V, Release 2.2 (pokey)\n\nlogin: ") | |
2605 | (setq username (dun-read-line)) | |
2606 | (if (not dun-batch-mode) | |
2607 | (dun-mprinc "\n")) | |
2608 | (dun-mprinc "password: ") | |
2609 | (setq password (dun-read-line)) | |
2610 | (if (not dun-batch-mode) | |
2611 | (dun-mprinc "\n")) | |
62078373 RS |
2612 | (if (or (not (string= username "toukmond")) |
2613 | (not (string= password "robert"))) | |
a399c536 RS |
2614 | (dun-mprincl "login incorrect") |
2615 | (setq dun-logged-in t) | |
2616 | (dun-mprincl " | |
62078373 RS |
2617 | Welcome to Unix\n |
2618 | Please clean up your directories. The filesystem is getting full. | |
163d1767 | 2619 | Our tcp/ip link to gamma is a little flaky, but seems to work. |
058c1767 | 2620 | The current version of ftp can only send files from your home |
62078373 RS |
2621 | directory, and deletes them after they are sent! Be careful. |
2622 | ||
2623 | Note: Restricted bourne shell in use.\n"))) | |
2624 | (setq dungeon-mode 'dungeon))) | |
2625 | ||
a399c536 | 2626 | (defun dun-ls (args) |
62078373 RS |
2627 | (if (car args) |
2628 | (let (ocdpath ocdroom) | |
a399c536 RS |
2629 | (setq ocdpath dun-cdpath) |
2630 | (setq ocdroom dun-cdroom) | |
2631 | (if (not (eq (dun-cd args) -2)) | |
2632 | (dun-ls nil)) | |
2633 | (setq dun-cdpath ocdpath) | |
2634 | (setq dun-cdroom ocdroom)) | |
2635 | (if (= dun-cdroom -10) | |
2636 | (dun-ls-inven)) | |
2637 | (if (= dun-cdroom -2) | |
2638 | (dun-ls-rooms)) | |
2639 | (if (= dun-cdroom -3) | |
2640 | (dun-ls-root)) | |
2641 | (if (= dun-cdroom -4) | |
2642 | (dun-ls-usr)) | |
2643 | (if (> dun-cdroom 0) | |
2644 | (dun-ls-room)))) | |
2645 | ||
2646 | (defun dun-ls-root () | |
2647 | (dun-mprincl "total 4 | |
62078373 RS |
2648 | drwxr-xr-x 3 root staff 512 Jan 1 1970 . |
2649 | drwxr-xr-x 3 root staff 2048 Jan 1 1970 .. | |
2650 | drwxr-xr-x 3 root staff 2048 Jan 1 1970 usr | |
2651 | drwxr-xr-x 3 root staff 2048 Jan 1 1970 rooms")) | |
2652 | ||
a399c536 RS |
2653 | (defun dun-ls-usr () |
2654 | (dun-mprincl "total 4 | |
62078373 RS |
2655 | drwxr-xr-x 3 root staff 512 Jan 1 1970 . |
2656 | drwxr-xr-x 3 root staff 2048 Jan 1 1970 .. | |
2657 | drwxr-xr-x 3 toukmond restricted 512 Jan 1 1970 toukmond")) | |
2658 | ||
a399c536 RS |
2659 | (defun dun-ls-rooms () |
2660 | (dun-mprincl "total 16 | |
62078373 RS |
2661 | drwxr-xr-x 3 root staff 512 Jan 1 1970 . |
2662 | drwxr-xr-x 3 root staff 2048 Jan 1 1970 ..") | |
a399c536 RS |
2663 | (dolist (x dun-visited) |
2664 | (dun-mprinc | |
62078373 | 2665 | "drwxr-xr-x 3 root staff 512 Jan 1 1970 ") |
a399c536 | 2666 | (dun-mprincl (nth x dun-room-shorts)))) |
62078373 | 2667 | |
a399c536 RS |
2668 | (defun dun-ls-room () |
2669 | (dun-mprincl "total 4 | |
62078373 RS |
2670 | drwxr-xr-x 3 root staff 512 Jan 1 1970 . |
2671 | drwxr-xr-x 3 root staff 2048 Jan 1 1970 .. | |
2672 | -rwxr-xr-x 3 root staff 2048 Jan 1 1970 description") | |
a399c536 | 2673 | (dolist (x (nth dun-cdroom dun-room-objects)) |
62078373 RS |
2674 | (if (and (>= x 0) (not (= x 255))) |
2675 | (progn | |
a399c536 RS |
2676 | (dun-mprinc "-rwxr-xr-x 1 toukmond restricted 0 Jan 1 1970 ") |
2677 | (dun-mprincl (nth x dun-objfiles)))))) | |
62078373 | 2678 | |
a399c536 RS |
2679 | (defun dun-ls-inven () |
2680 | (dun-mprinc "total 467 | |
62078373 RS |
2681 | drwxr-xr-x 3 toukmond restricted 512 Jan 1 1970 . |
2682 | drwxr-xr-x 3 root staff 2048 Jan 1 1970 ..") | |
a399c536 | 2683 | (dolist (x dun-unix-verbs) |
62078373 RS |
2684 | (if (not (eq (car x) 'IMPOSSIBLE)) |
2685 | (progn | |
a399c536 | 2686 | (dun-mprinc" |
62078373 | 2687 | -rwxr-xr-x 1 toukmond restricted 10423 Jan 1 1970 ") |
a399c536 RS |
2688 | (dun-mprinc (car x))))) |
2689 | (dun-mprinc "\n") | |
2690 | (if (not dun-uncompressed) | |
2691 | (dun-mprincl | |
62078373 | 2692 | "-rwxr-xr-x 1 toukmond restricted 0 Jan 1 1970 paper.o.Z")) |
a399c536 | 2693 | (dolist (x dun-inventory) |
a1506d29 | 2694 | (dun-mprinc |
62078373 | 2695 | "-rwxr-xr-x 1 toukmond restricted 0 Jan 1 1970 ") |
a399c536 | 2696 | (dun-mprincl (nth x dun-objfiles)))) |
62078373 | 2697 | |
a399c536 | 2698 | (defun dun-echo (args) |
62078373 RS |
2699 | (let (nomore var) |
2700 | (setq nomore nil) | |
2701 | (dolist (x args) | |
2702 | (if (not nomore) | |
2703 | (progn | |
2704 | (if (not (string= (substring x 0 1) "$")) | |
2705 | (progn | |
a399c536 RS |
2706 | (dun-mprinc x) |
2707 | (dun-mprinc " ")) | |
62078373 RS |
2708 | (setq var (intern (substring x 1))) |
2709 | (if (not (boundp var)) | |
a399c536 RS |
2710 | (dun-mprinc " ") |
2711 | (if (member var dun-restricted) | |
62078373 | 2712 | (progn |
a399c536 RS |
2713 | (dun-mprinc var) |
2714 | (dun-mprinc ": Permission denied") | |
62078373 | 2715 | (setq nomore t)) |
a399c536 RS |
2716 | (eval (list 'dun-mprinc var)) |
2717 | (dun-mprinc " "))))))) | |
2718 | (dun-mprinc "\n"))) | |
62078373 RS |
2719 | |
2720 | ||
a399c536 | 2721 | (defun dun-ftp (args) |
62078373 RS |
2722 | (let (host username passwd ident newlist) |
2723 | (if (not (car args)) | |
a399c536 | 2724 | (dun-mprincl "ftp: hostname required on command line.") |
62078373 | 2725 | (setq host (intern (car args))) |
a399c536 RS |
2726 | (if (not (member host '(gamma dun-endgame))) |
2727 | (dun-mprincl "ftp: Unknown host.") | |
2728 | (if (eq host 'dun-endgame) | |
2729 | (dun-mprincl "ftp: connection to endgame not allowed") | |
2730 | (if (not dun-ethernet) | |
2731 | (dun-mprincl "ftp: host not responding.") | |
2732 | (dun-mprincl "Connected to gamma. FTP ver 0.9 00:00:00 01/01/70") | |
2733 | (dun-mprinc "Username: ") | |
2734 | (setq username (dun-read-line)) | |
62078373 | 2735 | (if (string= username "toukmond") |
a399c536 RS |
2736 | (if dun-batch-mode |
2737 | (dun-mprincl "toukmond ftp access not allowed.") | |
2738 | (dun-mprincl "\ntoukmond ftp access not allowed.")) | |
62078373 | 2739 | (if (string= username "anonymous") |
a399c536 RS |
2740 | (if dun-batch-mode |
2741 | (dun-mprincl | |
62078373 | 2742 | "Guest login okay, send your user ident as password.") |
a1506d29 | 2743 | (dun-mprincl |
62078373 | 2744 | "\nGuest login okay, send your user ident as password.")) |
a399c536 RS |
2745 | (if dun-batch-mode |
2746 | (dun-mprinc "Password required for ") | |
2747 | (dun-mprinc "\nPassword required for ")) | |
2748 | (dun-mprincl username)) | |
2749 | (dun-mprinc "Password: ") | |
2750 | (setq ident (dun-read-line)) | |
62078373 | 2751 | (if (not (string= username "anonymous")) |
a399c536 RS |
2752 | (if dun-batch-mode |
2753 | (dun-mprincl "Login failed.") | |
2754 | (dun-mprincl "\nLogin failed.")) | |
2755 | (if dun-batch-mode | |
a1506d29 | 2756 | (dun-mprincl |
a399c536 | 2757 | "Guest login okay, user access restrictions apply.") |
a1506d29 | 2758 | (dun-mprincl |
a399c536 RS |
2759 | "\nGuest login okay, user access restrictions apply.")) |
2760 | (dun-ftp-commands) | |
a1506d29 | 2761 | (setq newlist |
62078373 RS |
2762 | '("What password did you use during anonymous ftp to gamma?")) |
2763 | (setq newlist (append newlist (list ident))) | |
a399c536 | 2764 | (rplaca (nthcdr 1 dun-endgame-questions) newlist))))))))) |
a1506d29 | 2765 | |
a399c536 RS |
2766 | (defun dun-ftp-commands () |
2767 | (setq dun-exitf nil) | |
62078373 | 2768 | (let (line) |
a399c536 RS |
2769 | (while (not dun-exitf) |
2770 | (dun-mprinc "ftp> ") | |
2771 | (setq line (dun-read-line)) | |
a1506d29 | 2772 | (if |
62078373 | 2773 | (eq |
a1506d29 | 2774 | (dun-parse2 nil |
a399c536 RS |
2775 | '((type . dun-ftptype) (binary . dun-bin) (bin . dun-bin) |
2776 | (send . dun-send) (put . dun-send) (quit . dun-ftpquit) | |
2777 | (help . dun-ftphelp)(ascii . dun-fascii) | |
62078373 RS |
2778 | ) line) |
2779 | -1) | |
a399c536 RS |
2780 | (dun-mprincl "No such command. Try help."))) |
2781 | (setq dun-ftptype 'ascii))) | |
62078373 | 2782 | |
a399c536 | 2783 | (defun dun-ftptype (args) |
62078373 | 2784 | (if (not (car args)) |
a399c536 | 2785 | (dun-mprincl "Usage: type [binary | ascii]") |
62078373 RS |
2786 | (setq args (intern (car args))) |
2787 | (if (eq args 'binary) | |
a399c536 | 2788 | (dun-bin nil) |
62078373 | 2789 | (if (eq args 'ascii) |
a399c536 RS |
2790 | (dun-fascii 'nil) |
2791 | (dun-mprincl "Unknown type."))))) | |
62078373 | 2792 | |
a399c536 RS |
2793 | (defun dun-bin (args) |
2794 | (dun-mprincl "Type set to binary.") | |
2795 | (setq dun-ftptype 'binary)) | |
62078373 | 2796 | |
a399c536 RS |
2797 | (defun dun-fascii (args) |
2798 | (dun-mprincl "Type set to ascii.") | |
2799 | (setq dun-ftptype 'ascii)) | |
62078373 | 2800 | |
a399c536 RS |
2801 | (defun dun-ftpquit (args) |
2802 | (setq dun-exitf t)) | |
62078373 | 2803 | |
a399c536 | 2804 | (defun dun-send (args) |
62078373 | 2805 | (if (not (car args)) |
a399c536 | 2806 | (dun-mprincl "Usage: send <filename>") |
62078373 RS |
2807 | (setq args (car args)) |
2808 | (let (counter foo) | |
2809 | (setq foo nil) | |
2810 | (setq counter 0) | |
2811 | ||
2812 | ;;; User can send commands! Stupid user. | |
2813 | ||
2814 | ||
a399c536 | 2815 | (if (assq (intern args) dun-unix-verbs) |
62078373 | 2816 | (progn |
a399c536 RS |
2817 | (rplaca (assq (intern args) dun-unix-verbs) 'IMPOSSIBLE) |
2818 | (dun-mprinc "Sending ") | |
2819 | (dun-mprinc dun-ftptype) | |
2820 | (dun-mprinc " file for ") | |
2821 | (dun-mprincl args) | |
2822 | (dun-mprincl "Transfer complete.")) | |
2823 | ||
2824 | (dolist (x dun-objfiles) | |
62078373 RS |
2825 | (if (string= args x) |
2826 | (progn | |
a399c536 | 2827 | (if (not (member counter dun-inventory)) |
62078373 | 2828 | (progn |
a399c536 | 2829 | (dun-mprincl "No such file.") |
62078373 | 2830 | (setq foo t)) |
a399c536 RS |
2831 | (dun-mprinc "Sending ") |
2832 | (dun-mprinc dun-ftptype) | |
2833 | (dun-mprinc " file for ") | |
2834 | (dun-mprinc (downcase (cadr (nth counter dun-objects)))) | |
2835 | (dun-mprincl ", (0 bytes)") | |
2836 | (if (not (eq dun-ftptype 'binary)) | |
62078373 RS |
2837 | (progn |
2838 | (if (not (member obj-protoplasm | |
a1506d29 | 2839 | (nth receiving-room |
a399c536 RS |
2840 | dun-room-objects))) |
2841 | (dun-replace dun-room-objects receiving-room | |
a1506d29 | 2842 | (append (nth receiving-room |
a399c536 | 2843 | dun-room-objects) |
62078373 | 2844 | (list obj-protoplasm)))) |
a399c536 RS |
2845 | (dun-remove-obj-from-inven counter)) |
2846 | (dun-remove-obj-from-inven counter) | |
2847 | (dun-replace dun-room-objects receiving-room | |
2848 | (append (nth receiving-room dun-room-objects) | |
62078373 RS |
2849 | (list counter)))) |
2850 | (setq foo t) | |
a399c536 | 2851 | (dun-mprincl "Transfer complete.")))) |
62078373 RS |
2852 | (setq counter (+ 1 counter))) |
2853 | (if (not foo) | |
a399c536 | 2854 | (dun-mprincl "No such file.")))))) |
62078373 | 2855 | |
a399c536 | 2856 | (defun dun-ftphelp (args) |
a1506d29 | 2857 | (dun-mprincl |
62078373 RS |
2858 | "Possible commands are:\nsend quit type ascii binary help")) |
2859 | ||
a399c536 | 2860 | (defun dun-uexit (args) |
62078373 | 2861 | (setq dungeon-mode 'dungeon) |
a399c536 RS |
2862 | (dun-mprincl "\nYou step back from the console.") |
2863 | (define-key dungeon-mode-map "\r" 'dun-parse) | |
2864 | (if (not dun-batch-mode) | |
2865 | (dun-messages))) | |
62078373 | 2866 | |
a399c536 RS |
2867 | (defun dun-pwd (args) |
2868 | (dun-mprincl dun-cdpath)) | |
62078373 | 2869 | |
a399c536 | 2870 | (defun dun-uncompress (args) |
62078373 | 2871 | (if (not (car args)) |
a399c536 | 2872 | (dun-mprincl "Usage: uncompress <filename>") |
62078373 | 2873 | (setq args (car args)) |
a399c536 | 2874 | (if (or dun-uncompressed |
62078373 RS |
2875 | (and (not (string= args "paper.o")) |
2876 | (not (string= args "paper.o.z")))) | |
a399c536 RS |
2877 | (dun-mprincl "Uncompress command failed.") |
2878 | (setq dun-uncompressed t) | |
2879 | (setq dun-inventory (append dun-inventory (list obj-paper)))))) | |
62078373 | 2880 | |
a399c536 | 2881 | (defun dun-rlogin (args) |
62078373 RS |
2882 | (let (passwd) |
2883 | (if (not (car args)) | |
a399c536 | 2884 | (dun-mprincl "Usage: rlogin <hostname>") |
62078373 RS |
2885 | (setq args (car args)) |
2886 | (if (string= args "endgame") | |
a399c536 | 2887 | (dun-rlogin-endgame) |
62078373 | 2888 | (if (not (string= args "gamma")) |
058c1767 RS |
2889 | (if (string= args "pokey") |
2890 | (dun-mprincl "Can't rlogin back to localhost") | |
2891 | (dun-mprincl "No such host.")) | |
a399c536 RS |
2892 | (if (not dun-ethernet) |
2893 | (dun-mprincl "Host not responding.") | |
2894 | (dun-mprinc "Password: ") | |
2895 | (setq passwd (dun-read-line)) | |
62078373 | 2896 | (if (not (string= passwd "worms")) |
a399c536 | 2897 | (dun-mprincl "\nlogin incorrect") |
a1506d29 | 2898 | (dun-mprinc |
62078373 RS |
2899 | "\nYou begin to feel strange for a moment, and you lose your items." |
2900 | ) | |
a1506d29 JB |
2901 | (dun-replace dun-room-objects computer-room |
2902 | (append (nth computer-room dun-room-objects) | |
a399c536 RS |
2903 | dun-inventory)) |
2904 | (setq dun-inventory nil) | |
2905 | (setq dun-current-room receiving-room) | |
2906 | (dun-uexit nil)))))))) | |
a1506d29 | 2907 | |
a399c536 | 2908 | (defun dun-cd (args) |
163d1767 | 2909 | (let (tcdpath tcdroom path-elements room-check) |
62078373 | 2910 | (if (not (car args)) |
a399c536 RS |
2911 | (dun-mprincl "Usage: cd <path>") |
2912 | (setq tcdpath dun-cdpath) | |
2913 | (setq tcdroom dun-cdroom) | |
2914 | (setq dun-badcd nil) | |
62078373 | 2915 | (condition-case nil |
a399c536 | 2916 | (setq path-elements (dun-get-path (car args) nil)) |
6e44da43 | 2917 | (error (dun-mprincl "Invalid path") |
a399c536 | 2918 | (setq dun-badcd t))) |
62078373 | 2919 | (dolist (pe path-elements) |
a399c536 | 2920 | (unless dun-badcd |
62078373 RS |
2921 | (if (not (string= pe ".")) |
2922 | (if (string= pe "..") | |
2923 | (progn | |
2924 | (if (> tcdroom 0) ;In a room | |
2925 | (progn | |
2926 | (setq tcdpath "/rooms") | |
2927 | (setq tcdroom -2)) | |
2928 | ;In /rooms,/usr,root | |
a1506d29 JB |
2929 | (if (or |
2930 | (= tcdroom -2) (= tcdroom -4) | |
62078373 RS |
2931 | (= tcdroom -3)) |
2932 | (progn | |
2933 | (setq tcdpath "/") | |
2934 | (setq tcdroom -3)) | |
2935 | (if (= tcdroom -10) ;In /usr/toukmond | |
2936 | (progn | |
2937 | (setq tcdpath "/usr") | |
2938 | (setq tcdroom -4)))))) | |
2939 | (if (string= pe "/") | |
2940 | (progn | |
2941 | (setq tcdpath "/") | |
2942 | (setq tcdroom -3)) | |
2943 | (if (= tcdroom -4) | |
2944 | (if (string= pe "toukmond") | |
2945 | (progn | |
2946 | (setq tcdpath "/usr/toukmond") | |
2947 | (setq tcdroom -10)) | |
a399c536 | 2948 | (dun-nosuchdir)) |
62078373 | 2949 | (if (= tcdroom -10) |
a399c536 | 2950 | (dun-nosuchdir) |
62078373 | 2951 | (if (> tcdroom 0) |
a399c536 | 2952 | (dun-nosuchdir) |
62078373 RS |
2953 | (if (= tcdroom -3) |
2954 | (progn | |
2955 | (if (string= pe "rooms") | |
2956 | (progn | |
2957 | (setq tcdpath "/rooms") | |
2958 | (setq tcdroom -2)) | |
2959 | (if (string= pe "usr") | |
2960 | (progn | |
2961 | (setq tcdpath "/usr") | |
2962 | (setq tcdroom -4)) | |
a399c536 | 2963 | (dun-nosuchdir)))) |
62078373 RS |
2964 | (if (= tcdroom -2) |
2965 | (progn | |
a399c536 | 2966 | (dolist (x dun-visited) |
a1506d29 JB |
2967 | (setq room-check |
2968 | (nth x | |
a399c536 | 2969 | dun-room-shorts)) |
62078373 RS |
2970 | (if (string= room-check pe) |
2971 | (progn | |
a1506d29 | 2972 | (setq tcdpath |
62078373 RS |
2973 | (concat "/rooms/" room-check)) |
2974 | (setq tcdroom x)))) | |
2975 | (if (= tcdroom -2) | |
a399c536 RS |
2976 | (dun-nosuchdir))))))))))))) |
2977 | (if (not dun-badcd) | |
62078373 | 2978 | (progn |
a399c536 RS |
2979 | (setq dun-cdpath tcdpath) |
2980 | (setq dun-cdroom tcdroom) | |
62078373 RS |
2981 | 0) |
2982 | -2)))) | |
2983 | ||
a399c536 RS |
2984 | (defun dun-nosuchdir () |
2985 | (dun-mprincl "No such directory.") | |
2986 | (setq dun-badcd t)) | |
62078373 | 2987 | |
a399c536 | 2988 | (defun dun-cat (args) |
62078373 RS |
2989 | (let (doto checklist) |
2990 | (if (not (setq args (car args))) | |
a399c536 | 2991 | (dun-mprincl "Usage: cat <ascii-file-name>") |
62078373 | 2992 | (if (string-match "/" args) |
a399c536 RS |
2993 | (dun-mprincl "cat: only files in current directory allowed.") |
2994 | (if (and (> dun-cdroom 0) (string= args "description")) | |
2995 | (dun-mprincl (car (nth dun-cdroom dun-rooms))) | |
62078373 RS |
2996 | (if (setq doto (string-match "\\.o" args)) |
2997 | (progn | |
a399c536 RS |
2998 | (if (= dun-cdroom -10) |
2999 | (setq checklist dun-inventory) | |
3000 | (setq checklist (nth dun-cdroom dun-room-objects))) | |
a1506d29 JB |
3001 | (if (not (member (cdr |
3002 | (assq (intern | |
3003 | (substring args 0 doto)) | |
a399c536 | 3004 | dun-objnames)) |
62078373 | 3005 | checklist)) |
a399c536 RS |
3006 | (dun-mprincl "File not found.") |
3007 | (dun-mprincl "Ascii files only."))) | |
3008 | (if (assq (intern args) dun-unix-verbs) | |
3009 | (dun-mprincl "Ascii files only.") | |
3010 | (dun-mprincl "File not found.")))))))) | |
a1506d29 | 3011 | |
a399c536 RS |
3012 | (defun dun-zippy (args) |
3013 | (dun-mprincl (yow))) | |
62078373 | 3014 | |
a399c536 RS |
3015 | (defun dun-rlogin-endgame () |
3016 | (if (not (= (dun-score nil) 90)) | |
a1506d29 | 3017 | (dun-mprincl |
a399c536 RS |
3018 | "You have not achieved enough points to connect to endgame.") |
3019 | (dun-mprincl"\nWelcome to the endgame. You are a truly noble adventurer.") | |
3020 | (setq dun-current-room treasure-room) | |
3021 | (setq dun-endgame t) | |
3022 | (dun-replace dun-room-objects endgame-treasure-room (list obj-bill)) | |
3023 | (dun-uexit nil))) | |
62078373 RS |
3024 | |
3025 | ||
3026 | (random t) | |
93cc044b | 3027 | (setq tloc (+ 60 (random 18))) |
a1506d29 | 3028 | (dun-replace dun-room-objects tloc |
a399c536 RS |
3029 | (append (nth tloc dun-room-objects) (list 18))) |
3030 | ||
93cc044b | 3031 | (setq tcomb (+ 100 (random 899))) |
a399c536 | 3032 | (setq dun-combination (prin1-to-string tcomb)) |
62078373 RS |
3033 | |
3034 | ;;;; | |
3035 | ;;;; This section defines the DOS emulation functions for dunnet | |
3036 | ;;;; | |
3037 | ||
a399c536 | 3038 | (defun dun-dos-parse (args) |
62078373 RS |
3039 | (interactive "*p") |
3040 | (beginning-of-line) | |
3041 | (let (beg) | |
3042 | (setq beg (+ (point) 3)) | |
3043 | (end-of-line) | |
3044 | (if (not (= beg (point))) | |
3045 | (let (line) | |
3046 | (setq line (downcase (buffer-substring beg (point)))) | |
3047 | (princ line) | |
a399c536 | 3048 | (if (eq (dun-parse2 nil dun-dos-verbs line) -1) |
62078373 RS |
3049 | (progn |
3050 | (sleep-for 1) | |
a399c536 | 3051 | (dun-mprincl "Bad command or file name")))) |
62078373 | 3052 | (goto-char (point-max)) |
a399c536 | 3053 | (dun-mprinc "\n")) |
62078373 RS |
3054 | (if (eq dungeon-mode 'dos) |
3055 | (progn | |
a399c536 RS |
3056 | (dun-fix-screen) |
3057 | (dun-dos-prompt))))) | |
62078373 | 3058 | |
a399c536 RS |
3059 | (defun dun-dos-interface () |
3060 | (dun-dos-boot-msg) | |
62078373 | 3061 | (setq dungeon-mode 'dos) |
a399c536 RS |
3062 | (define-key dungeon-mode-map "\r" 'dun-dos-parse) |
3063 | (dun-dos-prompt)) | |
62078373 | 3064 | |
a399c536 | 3065 | (defun dun-dos-type (args) |
62078373 RS |
3066 | (sleep-for 2) |
3067 | (if (setq args (car args)) | |
3068 | (if (string= args "foo.txt") | |
a399c536 | 3069 | (dun-dos-show-combination) |
62078373 | 3070 | (if (string= args "command.com") |
a399c536 RS |
3071 | (dun-mprincl "Cannot type binary files") |
3072 | (dun-mprinc "File not found - ") | |
3073 | (dun-mprincl (upcase args)))) | |
3074 | (dun-mprincl "Must supply file name"))) | |
62078373 | 3075 | |
a399c536 | 3076 | (defun dun-dos-invd (args) |
62078373 | 3077 | (sleep-for 1) |
a399c536 | 3078 | (dun-mprincl "Invalid drive specification")) |
62078373 | 3079 | |
a399c536 | 3080 | (defun dun-dos-dir (args) |
62078373 RS |
3081 | (sleep-for 1) |
3082 | (if (or (not (setq args (car args))) (string= args "\\")) | |
a399c536 | 3083 | (dun-mprincl " |
a1506d29 | 3084 | Volume in drive A is FOO |
62078373 RS |
3085 | Volume Serial Number is 1A16-08C9 |
3086 | Directory of A:\\ | |
3087 | ||
3088 | COMMAND COM 47845 04-09-91 2:00a | |
3089 | FOO TXT 40 01-20-93 1:01a | |
3090 | 2 file(s) 47845 bytes | |
3091 | 1065280 bytes free | |
3092 | ") | |
a399c536 | 3093 | (dun-mprincl " |
a1506d29 | 3094 | Volume in drive A is FOO |
62078373 RS |
3095 | Volume Serial Number is 1A16-08C9 |
3096 | Directory of A:\\ | |
3097 | ||
3098 | File not found"))) | |
3099 | ||
3100 | ||
a399c536 RS |
3101 | (defun dun-dos-prompt () |
3102 | (dun-mprinc "A> ")) | |
62078373 | 3103 | |
a399c536 | 3104 | (defun dun-dos-boot-msg () |
62078373 | 3105 | (sleep-for 3) |
a399c536 RS |
3106 | (dun-mprinc "Current time is ") |
3107 | (dun-mprincl (substring (current-time-string) 12 20)) | |
3108 | (dun-mprinc "Enter new time: ") | |
3109 | (dun-read-line) | |
3110 | (if (not dun-batch-mode) | |
3111 | (dun-mprinc "\n"))) | |
3112 | ||
3113 | (defun dun-dos-spawn (args) | |
62078373 | 3114 | (sleep-for 1) |
a399c536 | 3115 | (dun-mprincl "Cannot spawn subshell")) |
62078373 | 3116 | |
a399c536 | 3117 | (defun dun-dos-exit (args) |
62078373 | 3118 | (setq dungeon-mode 'dungeon) |
a399c536 RS |
3119 | (dun-mprincl "\nYou power down the machine and step back.") |
3120 | (define-key dungeon-mode-map "\r" 'dun-parse) | |
3121 | (if (not dun-batch-mode) | |
3122 | (dun-messages))) | |
62078373 | 3123 | |
a399c536 | 3124 | (defun dun-dos-no-disk () |
62078373 | 3125 | (sleep-for 3) |
a399c536 | 3126 | (dun-mprincl "Boot sector not found")) |
62078373 RS |
3127 | |
3128 | ||
a399c536 | 3129 | (defun dun-dos-show-combination () |
62078373 | 3130 | (sleep-for 2) |
a399c536 RS |
3131 | (dun-mprinc "\nThe combination is ") |
3132 | (dun-mprinc dun-combination) | |
3133 | (dun-mprinc ".\n")) | |
62078373 | 3134 | |
a399c536 | 3135 | (defun dun-dos-nil (args)) |
62078373 RS |
3136 | |
3137 | ||
3138 | ;;;; | |
3139 | ;;;; This section defines the save and restore game functions for dunnet. | |
3140 | ;;;; | |
3141 | ||
a399c536 | 3142 | (defun dun-save-game (filename) |
62078373 | 3143 | (if (not (setq filename (car filename))) |
a399c536 | 3144 | (dun-mprincl "You must supply a filename for the save.") |
62078373 RS |
3145 | (if (file-exists-p filename) |
3146 | (delete-file filename)) | |
a399c536 RS |
3147 | (setq dun-numsaves (1+ dun-numsaves)) |
3148 | (dun-make-save-buffer) | |
3149 | (dun-save-val "dun-current-room") | |
3150 | (dun-save-val "dun-computer") | |
3151 | (dun-save-val "dun-combination") | |
3152 | (dun-save-val "dun-visited") | |
3153 | (dun-save-val "dun-diggables") | |
3154 | (dun-save-val "dun-key-level") | |
3155 | (dun-save-val "dun-floppy") | |
3156 | (dun-save-val "dun-numsaves") | |
3157 | (dun-save-val "dun-numcmds") | |
3158 | (dun-save-val "dun-logged-in") | |
3159 | (dun-save-val "dungeon-mode") | |
3160 | (dun-save-val "dun-jar") | |
3161 | (dun-save-val "dun-lastdir") | |
3162 | (dun-save-val "dun-black") | |
3163 | (dun-save-val "dun-nomail") | |
3164 | (dun-save-val "dun-unix-verbs") | |
3165 | (dun-save-val "dun-hole") | |
3166 | (dun-save-val "dun-uncompressed") | |
3167 | (dun-save-val "dun-ethernet") | |
3168 | (dun-save-val "dun-sauna-level") | |
3169 | (dun-save-val "dun-room-objects") | |
3170 | (dun-save-val "dun-room-silents") | |
3171 | (dun-save-val "dun-inventory") | |
66b8b1d5 | 3172 | (dun-save-val "dun-endgame-questions") |
a399c536 RS |
3173 | (dun-save-val "dun-endgame") |
3174 | (dun-save-val "dun-cdroom") | |
3175 | (dun-save-val "dun-cdpath") | |
3176 | (dun-save-val "dun-correct-answer") | |
3177 | (dun-save-val "dun-inbus") | |
3178 | (if (dun-compile-save-out filename) | |
3179 | (dun-mprincl "Error saving to file.") | |
3180 | (dun-do-logfile 'save nil) | |
62078373 RS |
3181 | (switch-to-buffer "*dungeon*") |
3182 | (princ "") | |
a399c536 | 3183 | (dun-mprincl "Done.")))) |
62078373 | 3184 | |
a399c536 | 3185 | (defun dun-make-save-buffer () |
62078373 RS |
3186 | (switch-to-buffer (get-buffer-create "*save-dungeon*")) |
3187 | (erase-buffer)) | |
3188 | ||
a399c536 | 3189 | (defun dun-compile-save-out (filename) |
62078373 RS |
3190 | (let (ferror) |
3191 | (setq ferror nil) | |
3192 | (condition-case nil | |
3193 | (dun-rot13) | |
3194 | (error (setq ferror t))) | |
3195 | (if (not ferror) | |
3196 | (progn | |
3197 | (goto-char (point-min)))) | |
3198 | (condition-case nil | |
3199 | (write-region 1 (point-max) filename nil 1) | |
3200 | (error (setq ferror t))) | |
3201 | (kill-buffer (current-buffer)) | |
3202 | ferror)) | |
a1506d29 | 3203 | |
62078373 | 3204 | |
a399c536 | 3205 | (defun dun-save-val (varname) |
62078373 RS |
3206 | (let (value) |
3207 | (setq varname (intern varname)) | |
3208 | (setq value (eval varname)) | |
a399c536 RS |
3209 | (dun-minsert "(setq ") |
3210 | (dun-minsert varname) | |
3211 | (dun-minsert " ") | |
62078373 RS |
3212 | (if (or (listp value) |
3213 | (symbolp value)) | |
a399c536 | 3214 | (dun-minsert "'")) |
62078373 | 3215 | (if (stringp value) |
a399c536 RS |
3216 | (dun-minsert "\"")) |
3217 | (dun-minsert value) | |
62078373 | 3218 | (if (stringp value) |
a399c536 RS |
3219 | (dun-minsert "\"")) |
3220 | (dun-minsertl ")"))) | |
62078373 RS |
3221 | |
3222 | ||
a399c536 | 3223 | (defun dun-restore (args) |
62078373 RS |
3224 | (let (file) |
3225 | (if (not (setq file (car args))) | |
a399c536 RS |
3226 | (dun-mprincl "You must supply a filename.") |
3227 | (if (not (dun-load-d file)) | |
3228 | (dun-mprincl "Could not load restore file.") | |
3229 | (dun-mprincl "Done.") | |
62078373 RS |
3230 | (setq room 0))))) |
3231 | ||
3232 | ||
a399c536 | 3233 | (defun dun-do-logfile (type how) |
62078373 RS |
3234 | (let (ferror newscore) |
3235 | (setq ferror nil) | |
3236 | (switch-to-buffer (get-buffer-create "*score*")) | |
3237 | (erase-buffer) | |
3238 | (condition-case nil | |
a399c536 | 3239 | (insert-file-contents dun-log-file) |
62078373 RS |
3240 | (error (setq ferror t))) |
3241 | (unless ferror | |
3242 | (goto-char (point-max)) | |
a399c536 RS |
3243 | (dun-minsert (current-time-string)) |
3244 | (dun-minsert " ") | |
3245 | (dun-minsert (user-login-name)) | |
3246 | (dun-minsert " ") | |
62078373 | 3247 | (if (eq type 'save) |
a399c536 RS |
3248 | (dun-minsert "saved ") |
3249 | (if (= (dun-endgame-score) 110) | |
3250 | (dun-minsert "won ") | |
62078373 | 3251 | (if (not how) |
a399c536 RS |
3252 | (dun-minsert "quit ") |
3253 | (dun-minsert "killed by ") | |
3254 | (dun-minsert how) | |
3255 | (dun-minsert " ")))) | |
3256 | (dun-minsert "at ") | |
3257 | (dun-minsert (cadr (nth (abs room) dun-rooms))) | |
3258 | (dun-minsert ". score: ") | |
3259 | (if (> (dun-endgame-score) 0) | |
3260 | (dun-minsert (setq newscore (+ 90 (dun-endgame-score)))) | |
3261 | (dun-minsert (setq newscore (dun-reg-score)))) | |
3262 | (dun-minsert " saves: ") | |
3263 | (dun-minsert dun-numsaves) | |
3264 | (dun-minsert " commands: ") | |
3265 | (dun-minsert dun-numcmds) | |
3266 | (dun-minsert "\n") | |
3267 | (write-region 1 (point-max) dun-log-file nil 1)) | |
62078373 RS |
3268 | (kill-buffer (current-buffer)))) |
3269 | ||
3270 | ||
3271 | ;;;; | |
3272 | ;;;; These are functions, and function re-definitions so that dungeon can | |
3273 | ;;;; be run in batch mode. | |
3274 | ||
3275 | ||
a399c536 | 3276 | (defun dun-batch-mprinc (arg) |
62078373 RS |
3277 | (if (stringp arg) |
3278 | (send-string-to-terminal arg) | |
3279 | (send-string-to-terminal (prin1-to-string arg)))) | |
3280 | ||
3281 | ||
a399c536 | 3282 | (defun dun-batch-mprincl (arg) |
62078373 RS |
3283 | (if (stringp arg) |
3284 | (progn | |
3285 | (send-string-to-terminal arg) | |
3286 | (send-string-to-terminal "\n")) | |
3287 | (send-string-to-terminal (prin1-to-string arg)) | |
3288 | (send-string-to-terminal "\n"))) | |
3289 | ||
a399c536 RS |
3290 | (defun dun-batch-parse (dun-ignore dun-verblist line) |
3291 | (setq line-list (dun-listify-string (concat line " "))) | |
3292 | (dun-doverb dun-ignore dun-verblist (car line-list) (cdr line-list))) | |
62078373 | 3293 | |
a399c536 RS |
3294 | (defun dun-batch-parse2 (dun-ignore dun-verblist line) |
3295 | (setq line-list (dun-listify-string2 (concat line " "))) | |
3296 | (dun-doverb dun-ignore dun-verblist (car line-list) (cdr line-list))) | |
62078373 | 3297 | |
a399c536 | 3298 | (defun dun-batch-read-line () |
62078373 RS |
3299 | (read-from-minibuffer "" nil dungeon-batch-map)) |
3300 | ||
3301 | ||
a399c536 RS |
3302 | (defun dun-batch-loop () |
3303 | (setq dun-dead nil) | |
62078373 | 3304 | (setq room 0) |
a399c536 | 3305 | (while (not dun-dead) |
62078373 RS |
3306 | (if (eq dungeon-mode 'dungeon) |
3307 | (progn | |
a399c536 | 3308 | (if (not (= room dun-current-room)) |
62078373 | 3309 | (progn |
a399c536 RS |
3310 | (dun-describe-room dun-current-room) |
3311 | (setq room dun-current-room))) | |
3312 | (dun-mprinc ">") | |
3313 | (setq line (downcase (dun-read-line))) | |
3314 | (if (eq (dun-vparse dun-ignore dun-verblist line) -1) | |
3315 | (dun-mprinc "I don't understand that.\n")))))) | |
3316 | ||
3317 | (defun dun-batch-dos-interface () | |
3318 | (dun-dos-boot-msg) | |
62078373 RS |
3319 | (setq dungeon-mode 'dos) |
3320 | (while (eq dungeon-mode 'dos) | |
a399c536 RS |
3321 | (dun-dos-prompt) |
3322 | (setq line (downcase (dun-read-line))) | |
3323 | (if (eq (dun-parse2 nil dun-dos-verbs line) -1) | |
62078373 RS |
3324 | (progn |
3325 | (sleep-for 1) | |
a399c536 | 3326 | (dun-mprincl "Bad command or file name")))) |
62078373 | 3327 | (goto-char (point-max)) |
a399c536 | 3328 | (dun-mprinc "\n")) |
62078373 | 3329 | |
a399c536 RS |
3330 | (defun dun-batch-unix-interface () |
3331 | (dun-login) | |
3332 | (if dun-logged-in | |
62078373 RS |
3333 | (progn |
3334 | (setq dungeon-mode 'unix) | |
3335 | (while (eq dungeon-mode 'unix) | |
a399c536 RS |
3336 | (dun-mprinc "$ ") |
3337 | (setq line (downcase (dun-read-line))) | |
3338 | (if (eq (dun-parse2 nil dun-unix-verbs line) -1) | |
62078373 RS |
3339 | (let (esign) |
3340 | (if (setq esign (string-match "=" line)) | |
a1506d29 | 3341 | (dun-doassign line esign) |
a399c536 RS |
3342 | (dun-mprinc (car line-list)) |
3343 | (dun-mprincl ": not found."))))) | |
62078373 | 3344 | (goto-char (point-max)) |
a399c536 | 3345 | (dun-mprinc "\n")))) |
62078373 RS |
3346 | |
3347 | (defun dungeon-nil (arg) | |
3348 | "noop" | |
af4d27fb RS |
3349 | (interactive "*p") |
3350 | nil) | |
62078373 | 3351 | |
a399c536 | 3352 | (defun dun-batch-dungeon () |
62078373 | 3353 | (load "dun-batch") |
a399c536 RS |
3354 | (setq dun-visited '(27)) |
3355 | (dun-mprinc "\n") | |
3356 | (dun-batch-loop)) | |
62078373 RS |
3357 | |
3358 | (unless (not noninteractive) | |
a399c536 RS |
3359 | (fset 'dun-mprinc 'dun-batch-mprinc) |
3360 | (fset 'dun-mprincl 'dun-batch-mprincl) | |
3361 | (fset 'dun-vparse 'dun-batch-parse) | |
3362 | (fset 'dun-parse2 'dun-batch-parse2) | |
3363 | (fset 'dun-read-line 'dun-batch-read-line) | |
3364 | (fset 'dun-dos-interface 'dun-batch-dos-interface) | |
3365 | (fset 'dun-unix-interface 'dun-batch-unix-interface) | |
3366 | (dun-mprinc "\n") | |
3367 | (setq dun-batch-mode t) | |
3368 | (dun-batch-loop)) | |
e5e8bb4a | 3369 | |
896546cd RS |
3370 | (provide 'dunnet) |
3371 | ||
ab5796a9 | 3372 | ;;; arch-tag: 4cc8e47c-d9e1-4ef4-936b-578e7f529558 |
6e44da43 | 3373 | ;;; dunnet.el ends here |