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