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