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