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