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