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