home *** CD-ROM | disk | FTP | other *** search
Text File | 1993-07-11 | 56.1 KB | 1,805 lines |
- Path: uunet!news.tek.com!saab!billr
- From: billr@saab.CNA.TEK.COM (Bill Randle)
- Newsgroups: comp.sources.games
- Subject: v18i012: dunnet2 - emacs-lisp text adventure, Ver 2, Part02/03
- Date: 10 Jul 1993 22:58:41 GMT
- Organization: Tektronix, Inc, Redmond, OR, USA
- Lines: 1792
- Approved: billr@saab.CNA.TEK.COM
- Message-ID: <21nhj1$q4h@ying.cna.tek.com>
- NNTP-Posting-Host: saab.cna.tek.com
- Xref: uunet comp.sources.games:1812
-
- Submitted-by: ronnie@media.mit.edu
- Posting-number: Volume 18, Issue 12
- Archive-name: dunnet2/part02
- Supersedes: dunnet: Volume 14, Issue 28-29
- Environment: Emacs
-
-
-
- #! /bin/sh
- # This is a shell archive. Remove anything before this line, then unpack
- # it by saving it into a file and typing "sh file". To overwrite existing
- # files, type "sh file -c". You can also feed this as standard input via
- # unshar, or by typing "sh <file", e.g.. If this archive is complete, you
- # will see the following message at the end:
- # "End of archive 2 (of 3)."
- # Contents: CHANGES dun-batch.el dun-commands.el dun-dos.el
- # dun-unix.el
- # Wrapped by billr@saab on Sat Jul 10 15:54:30 1993
- PATH=/bin:/usr/bin:/usr/ucb ; export PATH
- if test -f 'CHANGES' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'CHANGES'\"
- else
- echo shar: Extracting \"'CHANGES'\" \(693 characters\)
- sed "s/^X//" >'CHANGES' <<'END_OF_FILE'
- XChanges to dunnet for version 2:
- X
- XVery few changes to game content except for the movement of one
- Xobject which makes the game a little easier, and a small section added.
- XNot really worth playing again if you have already finished it.
- X
- XFixed to work with version 19 keymaps.
- X
- XMany bugfixes and code style fixes.
- X
- XSpelling fixes.
- X
- XNow uses rot13 instead of /bin/crypt to encrypt the saved games and
- Xglobal data.
- X
- XYou can now write over old saved files.
- X
- XIn dunnet.window it now correctly fixes the screen when it would have
- Xjump-scrolled the screen up before.
- X
- XYou can now type random control characters in batch mode without it
- Xerroring out (not control-c).
- X
- XOld saved games are incompatible.
- END_OF_FILE
- if test 693 -ne `wc -c <'CHANGES'`; then
- echo shar: \"'CHANGES'\" unpacked with wrong size!
- fi
- # end of 'CHANGES'
- fi
- if test -f 'dun-batch.el' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'dun-batch.el'\"
- else
- echo shar: Extracting \"'dun-batch.el'\" \(2156 characters\)
- sed "s/^X//" >'dun-batch.el' <<'END_OF_FILE'
- X;;;;;;;;;;;;;;;;;;;
- X;;;;;;;;;;;;;;;;;;;
- X
- X
- X; These are functions, and function re-definitions so that dungeon can
- X; be run in batch mode.
- X
- X(if nil
- X (eval-and-compile (setq byte-compile-warnings nil)))
- X
- X(defun mprinc (arg)
- X (if (stringp arg)
- X (send-string-to-terminal arg)
- X (send-string-to-terminal (prin1-to-string arg))))
- X
- X(defun mprincl (arg)
- X (if (stringp arg)
- X (progn
- X (send-string-to-terminal arg)
- X (send-string-to-terminal "\n"))
- X (send-string-to-terminal (prin1-to-string arg))
- X (send-string-to-terminal "\n")))
- X
- X(defun parse (ignore verblist line)
- X (setq line-list (listify-string (concat line " ")))
- X (doverb ignore verblist (car line-list) (cdr line-list)))
- X
- X(defun parse2 (ignore verblist line)
- X (setq line-list (listify-string2 (concat line " ")))
- X (doverb ignore verblist (car line-list) (cdr line-list)))
- X
- X(defun read-line ()
- X (read-from-minibuffer "" nil dungeon-batch-map))
- X
- X(setq batch-mode t)
- X
- X(defun dungeon-batch-loop ()
- X (setq dead nil)
- X (setq room 0)
- X (while (not dead)
- X (if (eq dungeon-mode 'dungeon)
- X (progn
- X (if (not (= room current-room))
- X (progn
- X (describe-room current-room)
- X (setq room current-room)))
- X (mprinc ">")
- X (setq line (downcase (read-line)))
- X (if (eq (parse ignore verblist line) -1)
- X (mprinc "I don't understand that.\n"))))))
- X
- X(defun dos-interface ()
- X (dos-boot-msg)
- X (setq dungeon-mode 'dos)
- X (while (eq dungeon-mode 'dos)
- X (dos-prompt)
- X (setq line (downcase (read-line)))
- X (if (eq (parse2 nil dos-verbs line) -1)
- X (progn
- X (sleep-for 1)
- X (mprincl "Bad command or file name"))))
- X (goto-char (point-max))
- X (mprinc "\n"))
- X
- X(defun unix-interface ()
- X (login)
- X (if logged-in
- X (progn
- X (setq dungeon-mode 'unix)
- X (while (eq dungeon-mode 'unix)
- X (mprinc "$ ")
- X (setq line (downcase (read-line)))
- X (if (eq (parse2 nil unix-verbs line) -1)
- X (let (esign)
- X (if (setq esign (string-match "=" line))
- X (doassign line esign)
- X (mprinc (car line-list))
- X (mprincl ": not found.")))))
- X (goto-char (point-max))
- X (mprinc "\n"))))
- X
- X(defun dungeon-nil (arg)
- X "noop"
- X (interactive "*p"))
- END_OF_FILE
- if test 2156 -ne `wc -c <'dun-batch.el'`; then
- echo shar: \"'dun-batch.el'\" unpacked with wrong size!
- fi
- chmod +x 'dun-batch.el'
- # end of 'dun-batch.el'
- fi
- if test -f 'dun-commands.el' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'dun-commands.el'\"
- else
- echo shar: Extracting \"'dun-commands.el'\" \(32652 characters\)
- sed "s/^X//" >'dun-commands.el' <<'END_OF_FILE'
- X;;
- X;; This file contains all of the verbs and commands.
- X;;
- X
- X(require 'cl)
- X
- X(if nil
- X (eval-and-compile (setq byte-compile-warnings nil)))
- X
- X;;;; Give long description of room if haven't been there yet. Otherwise
- X;;;; short. Also give long if we were called with negative room number.
- X
- X(defun describe-room (room)
- X (if (and (not (member (abs room) light-rooms))
- X (not (member obj-lamp inventory)))
- X (mprincl "It is pitch dark. You are likely to be eaten by a grue.")
- X (mprincl (cadr (nth (abs room) rooms)))
- X (if (and (and (or (member room visited)
- X (string= mode "superb")) (> room 0))
- X (not (string= mode "long")))
- X nil
- X (mprinc (car (nth (abs room) rooms)))
- X (mprinc "\n"))
- X (if (not (string= mode "long"))
- X (if (not (member (abs room) visited))
- X (setq visited (append (list (abs room)) visited))))
- X (dolist (xobjs (nth current-room room-objects))
- X (if (= xobjs obj-special)
- X (special-object)
- X (if (>= xobjs 0)
- X (mprincl (car (nth xobjs objects)))
- X (if (not (and (= xobjs obj-bus) inbus))
- X (progn
- X (mprincl (car (nth (abs xobjs) perm-objects)))))))
- X (if (and (= xobjs obj-jar) jar)
- X (progn
- X (mprincl "The jar contains:")
- X (dolist (x jar)
- X (mprinc " ")
- X (mprincl (car (nth x objects)))))))
- X (if (and (member obj-bus (nth current-room room-objects)) inbus)
- X (mprincl "You are on the bus."))))
- X
- X;;; There is a special object in the room. This object's description,
- X;;; or lack thereof, depends on certain conditions.
- X
- X(defun special-object ()
- X (if (= current-room computer-room)
- X (if computer
- X (mprincl
- X"The panel lights are flashing in a seemingly organized pattern.")
- X (mprincl "The panel lights are steady and motionless.")))
- X
- X (if (and (= current-room red-room)
- X (not (member obj-towel (nth red-room room-objects))))
- X (mprincl "There is a hole in the floor here."))
- X
- X (if (and (= current-room marine-life-area) black)
- X (mprincl
- X"The room is lit by a black light, causing the fish, and some of
- Xyour objects, to give off an eerie glow."))
- X (if (and (= current-room fourth-vermont-intersection) hole)
- X (progn
- X (mprincl"You fall into a hole in the ground.")
- X (setq current-room vermont-station)
- X (describe-room vermont-station)))
- X
- X (if (> current-room endgame-computer-room)
- X (progn
- X (if (not correct-answer)
- X (endgame-question)
- X (mprincl "Your question is:")
- X (mprincl endgame-question))))
- X
- X (if (= current-room sauna)
- X (progn
- X (mprincl (nth sauna-level '(
- X"It is normal room temperature in here."
- X"It is luke warm in here."
- X"It is comfortably hot in here."
- X"It is refreshingly hot in here."
- X"You are dead now.")))
- X (if (and (= sauna-level 3)
- X (or (member obj-rms inventory)
- X (member obj-rms (nth current-room room-objects))))
- X (progn
- X (mprincl
- X"You notice the wax on your statuette beginning to melt, until it completely
- Xmelts off. You are left with a beautiful diamond!")
- X (if (member obj-rms inventory)
- X (progn
- X (remove-obj-from-inven obj-rms)
- X (setq inventory (append inventory (list obj-diamond))))
- X (remove-obj-from-room current-room obj-rms)
- X (replace room-objects current-room
- X (append (nth current-room room-objects)
- X (list obj-diamond))))
- X (if (member obj-floppy inventory)
- X (progn
- X (mprincl
- X"You notice your floppy disk beginning to melt. As you grab for it, the
- Xdisk bursts into flames, and disintegrates.")
- X (remove-obj-from-inven obj-floppy)
- X (remove-obj-from-room current-room obj-floppy)))))))
- X)
- X
- X;;;;;;;;;;;;;;;;;;;;;; Commands start here
- X
- X(defun die (murderer)
- X (mprinc "\n")
- X (if murderer
- X (mprincl "You are dead."))
- X (do-logfile 'die murderer)
- X (score nil)
- X (setq dead t))
- X
- X(defun quit (args)
- X (die nil))
- X
- X;; Print every object in player's inventory. Special case for the jar,
- X;; as we must also print what is in it.
- X
- X(defun inven (args)
- X (mprinc "You currently have:")
- X (mprinc "\n")
- X (dolist (curobj inventory)
- X (if curobj
- X (progn
- X (mprincl (cadr (nth curobj objects)))
- X (if (and (= curobj obj-jar) jar)
- X (progn
- X (mprincl "The jar contains:")
- X (dolist (x jar)
- X (mprinc " ")
- X (mprincl (cadr (nth x objects))))))))))
- X
- X(defun shake (obj)
- X (let (objnum)
- X (when (setq objnum (objnum-from-args-std obj))
- X (if (member objnum inventory)
- X (progn
- X;;; If shaking anything will do anything, put here.
- X (mprinc "Shaking ")
- X (mprinc (downcase (cadr (nth objnum objects))))
- X (mprinc " seems to have no effect.")
- X (mprinc "\n")
- X )
- X (if (and (not (member objnum (nth current-room room-silents)))
- X (not (member objnum (nth current-room room-objects))))
- X (mprincl "I don't see that here.")
- X;;; Shaking trees can be deadly
- X (if (= objnum obj-tree)
- X (progn
- X (mprinc
- X "You begin to shake a tree, and notice a coconut begin to fall from the air.
- XAs you try to get your hand up to block it, you feel the impact as it lands
- Xon your head.")
- X (die "a coconut"))
- X (if (= objnum obj-bear)
- X (progn
- X (mprinc
- X"As you go up to the bear, it removes your head and places it on the ground.")
- X (die "a bear"))
- X (if (< objnum 0)
- X (mprincl "You cannot shake that.")
- X (mprincl "You don't have that.")))))))))
- X
- X
- X(defun drop (obj)
- X (if inbus
- X (mprincl "You can't drop anything while on the bus.")
- X (let (objnum ptr)
- X (when (setq objnum (objnum-from-args-std obj))
- X (if (not (setq ptr (member objnum inventory)))
- X (mprincl "You don't have that.")
- X (progn
- X (remove-obj-from-inven objnum)
- X (replace room-objects current-room
- X (append (nth current-room room-objects)
- X (list objnum)))
- X (mprincl "Done.")
- X (if (member objnum (list obj-food obj-weight obj-jar))
- X (drop-check objnum))))))))
- X
- X;; Dropping certain things causes things to happen.
- X
- X(defun drop-check (objnum)
- X (if (and (= objnum obj-food) (= room bear-hangout)
- X (member obj-bear (nth bear-hangout room-objects)))
- X (progn
- X (mprincl
- X"The bear takes the food and runs away with it. He left something behind.")
- X (remove-obj-from-room current-room obj-bear)
- X (remove-obj-from-room current-room obj-food)
- X (replace room-objects current-room
- X (append (nth current-room room-objects)
- X (list obj-key)))))
- X
- X (if (and (= objnum obj-jar) (member obj-nitric jar)
- X (member obj-glycerine jar))
- X (progn
- X (mprincl "As the jar impacts the ground it explodes into many pieces.")
- X (setq jar nil)
- X (remove-obj-from-room current-room obj-jar)
- X (if (= current-room fourth-vermont-intersection)
- X (progn
- X (setq hole t)
- X (setq current-room vermont-station)
- X (mprincl
- X"The explosion causes a hole to open up in the ground, which you fall
- Xthrough.")))))
- X
- X (if (and (= objnum obj-weight) (= current-room maze-button-room))
- X (mprincl "A passageway opens.")))
- X
- X;;; Give long description of current room, or an object.
- X
- X(defun examine (obj)
- X (let (objnum)
- X (setq objnum (objnum-from-args obj))
- X (if (eq objnum obj-special)
- X (describe-room (* current-room -1))
- X (if (and (eq objnum obj-computer)
- X (member obj-pc (nth current-room room-silents)))
- X (examine '("pc"))
- X (if (eq objnum nil)
- X (mprincl "I don't know what that is.")
- X (if (and (not (member objnum (nth current-room room-objects)))
- X (not (member objnum (nth current-room room-silents)))
- X (not (member objnum inventory)))
- X (mprincl "I don't see that here.")
- X (if (>= objnum 0)
- X (if (and (= objnum obj-bone)
- X (= current-room marine-life-area) black)
- X (mprincl
- X"In this light you can see some writing on the bone. It says:
- XFor an explosive time, go to Fourth St. and Vermont.")
- X (if (nth objnum physobj-desc)
- X (mprincl (nth objnum physobj-desc))
- X (mprincl "I see nothing special about that.")))
- X (if (nth (abs objnum) permobj-desc)
- X (progn
- X (mprincl (nth (abs objnum) permobj-desc)))
- X (mprincl "I see nothing special about that.")))))))))
- X
- X(defun take (obj)
- X (if inbus
- X (mprincl "You can't take anything while on the bus.")
- X (setq obj (firstword obj))
- X (if (not obj)
- X (mprincl "You must supply an object.")
- X (if (string= obj "all")
- X (let (gotsome)
- X (setq gotsome nil)
- X (dolist (x (nth current-room room-objects))
- X (if (and (>= x 0) (not (= x obj-special)))
- X (progn
- X (setq gotsome t)
- X (mprinc (cadr (nth x objects)))
- X (mprinc ": ")
- X (take-object x))))
- X (if (not gotsome)
- X (mprincl "Nothing to take.")))
- X (let (objnum)
- X (setq objnum (cdr (assq (intern obj) objnames)))
- X (if (eq objnum nil)
- X (progn
- X (mprinc "I don't know what that is.")
- X (mprinc "\n"))
- X (take-object objnum)))))))
- X
- X(defun take-object (objnum)
- X (if (and (member objnum jar) (member obj-jar inventory))
- X (let (newjar)
- X (mprincl "You remove it from the jar.")
- X (setq newjar nil)
- X (dolist (x jar)
- X (if (not (= x objnum))
- X (setq newjar (append newjar (list x)))))
- X (setq jar newjar)
- X (setq inventory (append inventory (list objnum))))
- X (if (not (member objnum (nth current-room room-objects)))
- X (if (not (member objnum (nth current-room room-silents)))
- X (mprinc "I do not see that here.")
- X (try-take objnum))
- X (if (>= objnum 0)
- X (progn
- X (if (and (car inventory)
- X (> (+ (inven-weight) (nth objnum object-lbs)) 11))
- X (mprinc "Your load would be too heavy.")
- X (setq inventory (append inventory (list objnum)))
- X (remove-obj-from-room current-room objnum)
- X (mprinc "Taken. ")
- X (if (and (= objnum obj-towel) (= current-room red-room))
- X (mprinc "Taking the towel reveals a hole in the floor."))))
- X (try-take objnum)))
- X (mprinc "\n")))
- X
- X(defun inven-weight ()
- X (let (total)
- X (setq total 0)
- X (dolist (x jar)
- X (setq total (+ total (nth x object-lbs))))
- X (dolist (x inventory)
- X (setq total (+ total (nth x object-lbs)))) total))
- X
- X;;; We try to take an object that is untakable. Print a message
- X;;; depending on what it is.
- X
- X(defun try-take (obj)
- X (mprinc "You cannot take that."))
- X
- X(defun dig (args)
- X (if inbus
- X (mprincl "You can't dig while on the bus.")
- X (if (not (member 0 inventory))
- X (mprincl "You have nothing with which to dig.")
- X (if (not (nth current-room diggables))
- X (mprincl "Digging here reveals nothing.")
- X (mprincl "I think you found something.")
- X (replace room-objects current-room
- X (append (nth current-room room-objects)
- X (nth current-room diggables)))
- X (replace diggables current-room nil)))))
- X
- X(defun climb (obj)
- X (let (objnum)
- X (setq objnum (objnum-from-args obj))
- X (if (and (not (= objnum obj-special))
- X (not (member objnum (nth current-room room-objects)))
- X (not (member objnum (nth current-room room-silents)))
- X (not (member objnum inventory)))
- X (mprincl "I don't see that here.")
- X (if (and (= objnum obj-special)
- X (not (member obj-tree (nth current-room room-silents))))
- X (mprincl "There is nothing here to climb.")
- X (if (and (not (= objnum obj-tree)) (not (= objnum obj-special)))
- X (mprincl "You can't climb that.")
- X (mprincl
- X"You manage to get about two feet up the tree and fall back down. You
- Xnotice that the tree is very unsteady."))))))
- X
- X(defun eat (obj)
- X (let (objnum)
- X (when (setq objnum (objnum-from-args-std obj))
- X (if (not (member objnum inventory))
- X (mprincl "You don't have that.")
- X (if (not (= objnum obj-food))
- X (progn
- X (mprinc "You forcefully shove ")
- X (mprinc (downcase (cadr (nth objnum objects))))
- X (mprincl " down your throat, and start choking.")
- X (die "choking"))
- X (mprincl "That tasted horrible.")
- X (remove-obj-from-inven obj-food))))))
- X
- X(defun dput (args)
- X (if inbus
- X (mprincl "You can't do that while on the bus")
- X (let (newargs objnum objnum2 obj)
- X (setq newargs (firstwordl args))
- X (if (not newargs)
- X (mprincl "You must supply an object")
- X (setq obj (intern (car newargs)))
- X (setq objnum (cdr (assq obj objnames)))
- X (if (not objnum)
- X (mprincl "I don't know what that object is.")
- X (if (not (member objnum inventory))
- X (mprincl "You don't have that.")
- X (setq newargs (firstwordl (cdr newargs)))
- X (setq newargs (firstwordl (cdr newargs)))
- X (if (not newargs)
- X (mprincl "You must supply an indirect object.")
- X (setq objnum2 (cdr (assq (intern (car newargs)) objnames)))
- X (if (and (eq objnum2 obj-computer) (= current-room pc-area))
- X (setq objnum2 obj-pc))
- X (if (not objnum2)
- X (mprincl "I don't know what that indirect object is.")
- X (if (and (not (member objnum2 (nth current-room room-objects)))
- X (not (member objnum2 (nth current-room room-silents)))
- X (not (member objnum2 inventory)))
- X (mprincl "That indirect object is not here.")
- X (put-objs objnum objnum2))))))))))
- X
- X(defun put-objs (obj1 obj2)
- X (if (and (= obj2 obj-drop) (not nomail))
- X (setq obj2 obj-chute))
- X
- X (if (= obj2 obj-disposal) (setq obj2 obj-chute))
- X
- X (if (and (= obj1 obj-cpu) (= obj2 obj-computer))
- X (progn
- X (remove-obj-from-inven obj-cpu)
- X (setq computer t)
- X (mprincl
- X"As you put the CPU board in the computer, it immediately springs to life.
- XThe lights start flashing, and the fans seem to startup."))
- X (if (and (= obj1 obj-weight) (= obj2 obj-button))
- X (drop '("weight"))
- X (if (= obj2 obj-jar) ;; Put something in jar
- X (if (not (member obj1 (list obj-paper obj-diamond obj-emerald
- X obj-license obj-coins obj-egg
- X obj-nitric obj-glycerine)))
- X (mprincl "That will not fit in the jar.")
- X (remove-obj-from-inven obj1)
- X (setq jar (append jar (list obj1)))
- X (mprincl "Done."))
- X (if (= obj2 obj-chute) ;; Put something in chute
- X (progn
- X (remove-obj-from-inven obj1)
- X (mprincl
- X"You hear it slide down the chute and off into the distance.")
- X (put-objs-in-treas (list obj1)))
- X (if (= obj2 obj-box) ;; Put key in key box
- X (if (= obj1 obj-key)
- X (progn
- X (mprincl
- X"As you drop the key, the box begins to shake. Finally it explodes
- Xwith a bang. The key seems to have vanished!")
- X (remove-obj-from-inven obj1)
- X (replace room-objects computer-room (append
- X (nth computer-room
- X room-objects)
- X (list obj1)))
- X (remove-obj-from-room current-room obj-box)
- X (setq key-level (1+ key-level)))
- X (mprincl "You can't put that in the key box!"))
- X
- X (if (and (= obj1 obj-floppy) (= obj2 obj-pc))
- X (progn
- X (setq floppy t)
- X (remove-obj-from-inven obj1)
- X (mprincl "Done."))
- X
- X (if (= obj2 obj-urinal) ;; Put object in urinal
- X (progn
- X (remove-obj-from-inven obj1)
- X (replace room-objects urinal (append
- X (nth urinal room-objects)
- X (list obj1)))
- X (mprincl
- X "You hear it plop down in some water below."))
- X (if (= obj2 obj-mail)
- X (mprincl "The mail chute is locked.")
- X (if (member obj1 inventory)
- X (mprincl
- X"I don't know how to combine those objects. Perhaps you should
- Xjust try dropping it.")
- X (mprincl"You can't put that there.")))))))))))
- X
- X(defun type (args)
- X (if (not (= current-room computer-room))
- X (mprincl "There is nothing here on which you could type.")
- X (if (not computer)
- X (mprincl
- X"You type on the keyboard, but your characters do not even echo.")
- X (unix-interface))))
- X
- X;;;; Various movement directions
- X
- X(defun n (args)
- X (move north))
- X
- X(defun s (args)
- X (move south))
- X
- X(defun e (args)
- X (move east))
- X
- X(defun w (args)
- X (move west))
- X
- X(defun ne (args)
- X (move northeast))
- X
- X(defun se (args)
- X (move southeast))
- X
- X(defun nw (args)
- X (move northwest))
- X
- X(defun sw (args)
- X (move southwest))
- X
- X(defun up (args)
- X (move up))
- X
- X(defun down (args)
- X (move down))
- X
- X(defun in (args)
- X (move in))
- X
- X(defun out (args)
- X (move out))
- X
- X(defun go (args)
- X (if (or (not (car args))
- X (eq (doverb ignore verblist (car args) (cdr (cdr args))) -1))
- X (mprinc "I don't understand where you want me to go.\n")))
- X
- X;; Uses the dungeon-map to figure out where we are going. If the
- X;; requested direction yields 255, we know something special is
- X;; supposed to happen, or perhaps you can't go that way unless
- X;; certain conditions are met.
- X
- X(defun move (dir)
- X (if (and (not (member current-room light-rooms))
- X (not (member obj-lamp inventory)))
- X (progn
- X (mprinc
- X"You trip over a grue and fall into a pit and break every bone in your
- Xbody.")
- X (die "a grue"))
- X (let (newroom)
- X (setq newroom (nth dir (nth current-room dungeon-map)))
- X (if (eq newroom -1)
- X (mprinc "You can't go that way.\n")
- X (if (eq newroom 255)
- X (special-move dir)
- X (setq room -1)
- X (setq lastdir dir)
- X (if inbus
- X (progn
- X (if (or (< newroom 58) (> newroom 83))
- X (mprincl "The bus cannot go this way.")
- X (mprincl
- X "The bus lurches ahead and comes to a screeching halt.")
- X (remove-obj-from-room current-room obj-bus)
- X (setq current-room newroom)
- X (replace room-objects newroom
- X (append (nth newroom room-objects)
- X (list obj-bus)))))
- X (setq current-room newroom)))))))
- X
- X;; Movement in this direction causes something special to happen if the
- X;; right conditions exist. It may be that you can't go this way unless
- X;; you have a key, or a passage has been opened.
- X
- X;; coding note: Each check of the current room is on the same 'if' level,
- X;; i.e. there aren't else's. If two rooms next to each other have
- X;; specials, and they are connected by specials, this could cause
- X;; a problem. Be careful when adding them to consider this, and
- X;; perhaps use else's.
- X
- X(defun special-move (dir)
- X (if (= current-room building-front)
- X (if (not (member obj-key inventory))
- X (mprincl "You don't have a key that can open this door.")
- X (setq current-room old-building-hallway))
- X (if (= current-room north-end-of-cave-passage)
- X (let (combo)
- X (mprincl
- X"You must type a 3 digit combination code to enter this room.")
- X (mprinc "Enter it here: ")
- X (setq combo (read-line))
- X (if (not batch-mode)
- X (mprinc "\n"))
- X (if (string= combo combination)
- X (setq current-room gamma-computing-center)
- X (mprincl "Sorry, that combination is incorrect."))))
- X
- X (if (= current-room bear-hangout)
- X (if (member obj-bear (nth bear-hangout room-objects))
- X (progn
- X (mprinc
- X"The bear is very annoyed that you would be so presumptuous as to try
- Xand walk right by it. He tells you so by tearing your head off.
- X")
- X (die "a bear"))
- X (mprincl "You can't go that way.")))
- X
- X (if (= current-room vermont-station)
- X (progn
- X (mprincl
- X"As you board the train it immediately leaves the station. It is a very
- Xbumpy ride. It is shaking from side to side, and up and down. You
- Xsit down in one of the chairs in order to be more comfortable.")
- X (mprincl
- X"\nFinally the train comes to a sudden stop, and the doors open, and some
- Xforce throws you out. The train speeds away.\n")
- X (setq current-room museum-station)))
- X
- X (if (= current-room old-building-hallway)
- X (if (and (member obj-key inventory)
- X (> key-level 0))
- X (setq current-room meadow)
- X (mprincl "You don't have a key that can open this door.")))
- X
- X (if (and (= current-room maze-button-room) (= dir northwest))
- X (if (member obj-weight (nth maze-button-room room-objects))
- X (setq current-room 18)
- X (mprincl "You can't go that way.")))
- X
- X (if (and (= current-room maze-button-room) (= dir up))
- X (if (member obj-weight (nth maze-button-room room-objects))
- X (mprincl "You can't go that way.")
- X (setq current-room weight-room)))
- X
- X (if (= current-room classroom)
- X (mprincl "The door is locked."))
- X
- X (if (or (= current-room lakefront-north) (= current-room lakefront-south))
- X (swim nil))
- X
- X (if (= current-room reception-area)
- X (if (not (= sauna-level 3))
- X (setq current-room health-club-front)
- X (mprincl
- X"As you exit the building, you notice some flames coming out of one of the
- Xwindows. Suddenly, the building explodes in a huge ball of fire. The flames
- Xengulf you, and you burn to death.")
- X (die "burning")))
- X
- X (if (= current-room red-room)
- X (if (not (member obj-towel (nth red-room room-objects)))
- X (setq current-room long-n-s-hallway)
- X (mprincl "You can't go that way.")))
- X
- X (if (and (> dir down) (> current-room gamma-computing-center)
- X (< current-room museum-lobby))
- X (if (not (member obj-bus (nth current-room room-objects)))
- X (mprincl "You can't go that way.")
- X (if (= dir in)
- X (if (member obj-license inventory)
- X (progn
- X (mprincl "You board the bus and get in the driver's seat.")
- X (setq nomail t)
- X (setq inbus t))
- X (mprincl "You are not licensed for this type of vehicle."))
- X (mprincl "You hop off the bus.")
- X (setq inbus nil)))
- X (if (= current-room fifth-oaktree-intersection)
- X (if (not inbus)
- X (progn
- X (mprincl "You fall down the cliff and land on your head.")
- X (die "a cliff"))
- X (mprincl
- X"The bus flies off the cliff, and plunges to the bottom, where it explodes.")
- X (die "a bus accident")))
- X (if (= current-room main-maple-intersection)
- X (progn
- X (if (not inbus)
- X (mprincl "The gate will not open.")
- X (mprincl
- X"As the bus approaches, the gate opens and you drive through.")
- X (remove-obj-from-room main-maple-intersection obj-bus)
- X (replace room-objects museum-entrance
- X (append (nth museum-entrance room-objects)
- X (list obj-bus)))
- X (setq current-room museum-entrance)))))
- X (if (= current-room cave-entrance)
- X (progn
- X (mprincl
- X"As you enter the room you hear a rumbling noise. You look back to see
- Xhuge rocks sliding down from the ceiling, and blocking your way out.\n")
- X (setq current-room misty-room)))))
- X
- X(defun long (args)
- X (setq mode "long"))
- X
- X(defun turn (obj)
- X (let (objnum direction)
- X (when (setq objnum (objnum-from-args-std obj))
- X (if (not (or (member objnum (nth current-room room-objects))
- X (member objnum (nth current-room room-silents))))
- X (mprincl "I don't see that here.")
- X (if (not (= objnum obj-dial))
- X (mprincl "You can't turn that.")
- X (setq direction (firstword (cdr obj)))
- X (if (or (not direction)
- X (not (or (string= direction "clockwise")
- X (string= direction "counterclockwise"))))
- X (mprincl "You must indicate clockwise or counterclockwise.")
- X (if (string= direction "clockwise")
- X (setq sauna-level (+ sauna-level 1))
- X (setq sauna-level (- sauna-level 1)))
- X
- X (if (< sauna-level 0)
- X (progn
- X (mprincl
- X "The dial will not turn further in that direction.")
- X (setq sauna-level 0))
- X (sauna-heat))))))))
- X
- X(defun sauna-heat ()
- X (if (= sauna-level 0)
- X (mprincl "The termperature has returned to normal room termperature."))
- X (if (= sauna-level 1)
- X (mprincl "It is now luke warm in here. You begin to sweat."))
- X (if (= sauna-level 2)
- X (mprincl "It is pretty hot in here. It is still very comfortable."))
- X (if (= sauna-level 3)
- X (progn
- X (mprincl
- X"It is now very hot. There is something very refreshing about this.")
- X (if (or (member obj-rms inventory)
- X (member obj-rms (nth current-room room-objects)))
- X (progn
- X (mprincl
- X"You notice the wax on your statuette beginning to melt, until it completely
- Xmelts off. You are left with a beautiful diamond!")
- X (if (member obj-rms inventory)
- X (progn
- X (remove-obj-from-inven obj-rms)
- X (setq inventory (append inventory (list obj-diamond))))
- X (remove-obj-from-room current-room obj-rms)
- X (replace room-objects current-room
- X (append (nth current-room room-objects)
- X (list obj-diamond))))))
- X (if (or (member obj-floppy inventory)
- X (member obj-floppy (nth current-room room-objects)))
- X (progn
- X (mprincl
- X"You notice your floppy disk beginning to melt. As you grab for it, the
- Xdisk bursts into flames, and disintegrates.")
- X (if (member obj-floppy inventory)
- X (remove-obj-from-inven obj-floppy)
- X (remove-obj-from-room current-room obj-floppy))))))
- X
- X (if (= sauna-level 4)
- X (progn
- X (mprincl
- X"As the dial clicks into place, you immediately burst into flames.")
- X (die "burning"))))
- X
- X(defun press (obj)
- X (let (objnum)
- X (when (setq objnum (objnum-from-args-std obj))
- X (if (not (or (member objnum (nth current-room room-objects))
- X (member objnum (nth current-room room-silents))))
- X (mprincl "I don't see that here.")
- X (if (not (member objnum (list obj-button obj-switch)))
- X (progn
- X (mprinc "You can't ")
- X (mprinc (car line-list))
- X (mprincl " that."))
- X (if (= objnum obj-button)
- X (mprincl
- X"As you press the button, you notice a passageway open up, but
- Xas you release it, the passageway closes."))
- X (if (= objnum obj-switch)
- X (if black
- X (progn
- X (mprincl "The button is now in the off position.")
- X (setq black nil))
- X (mprincl "The button is now in the on position.")
- X (setq black t))))))))
- X
- X(defun swim (args)
- X (if (not (member current-room (list lakefront-north lakefront-south)))
- X (mprincl "I see no water!")
- X (if (not (member obj-life inventory))
- X (progn
- X (mprincl
- X"You dive in the water, and at first notice it is quite cold. You then
- Xstart to get used to it as you realize that you never really learned how
- Xto swim.")
- X (die "drowning"))
- X (if (= current-room lakefront-north)
- X (setq current-room lakefront-south)
- X (setq current-room lakefront-north)))))
- X
- X
- X(defun score (args)
- X (if (not endgame)
- X (let (total)
- X (setq total (reg-score))
- X (mprinc "You have scored ")
- X (mprinc total)
- X (mprincl " out of a possible 90 points.") total)
- X (mprinc "You have scored ")
- X (mprinc (endgame-score))
- X (mprincl " endgame points out of a possible 110.")
- X (if (= (endgame-score) 110)
- X (mprincl
- X"\n\nCongratulations. You have won. The wizard password is 'moby'"))))
- X
- X(defun help (args)
- X (mprincl
- X"Welcome to dunnet (2.0), by Ron Schnell (ronnie@media.mit.edu).
- XHere is some useful information (read carefully because there are one
- Xor more clues in here):
- X
- X- If you have a key that can open a door, you do not need to explicitly
- X open it. You may just use 'in' or walk in the direction of the door.
- X
- X- If you have a lamp, it is always lit.
- X
- X- You will not get any points until you manage to get treasures to a certain
- X place. Simply finding the treasures is not good enough. There is more
- X than one way to get a treasure to the special place. It is also
- X important that the objects get to the special place *unharmed* and
- X *untarnished*. You can tell if you have successfully transported the
- X object by looking at your score, as it changes immediately. Note that
- X an object can become harmed even after you have received points for it.
- X If this happens, your score will decrease, and in many cases you can never
- X get credit for it again.
- X
- X- You can save your game with the 'save' command, and use restore it
- X with the 'restore' command.
- X
- X- There are no limits on lengths of object names.
- X
- X- Directions are: north,south,east,west,northeast,southeast,northwest,
- X southwest,up,down,in,out.
- X
- X- These can be abbreviated: n,s,e,w,ne,se,nw,sw,u,d,in,out.
- X
- X- If you go down a hole in the floor without an aid such as a ladder,
- X you probably won't be able to get back up the way you came, if at all.
- X
- X- It is possible to get the maximum points.
- X
- XIf you have questions or comments, contact ronnie@media.mit.edu."))
- X
- X(defun flush (args)
- X (if (not (= current-room bathroom))
- X (mprincl "I see nothing to flush.")
- X (mprincl "Whoooosh!!")
- X (put-objs-in-treas (nth urinal room-objects))
- X (replace room-objects urinal nil)))
- X
- X(defun piss (args)
- X (if (not (= current-room bathroom))
- X (mprincl "You can't do that here, don't even bother trying.")
- X (if (not gottago)
- X (mprincl "I'm afraid you don't have to go now.")
- X (mprincl "That was refreshing.")
- X (setq gottago nil)
- X (replace room-objects urinal (append (nth urinal room-objects)
- X (list obj-URINE))))))
- X
- X
- X(defun dsleep (args)
- X (if (not (= current-room bedroom))
- X (mprincl
- X"You try to go to sleep while standing up here, but can't seem to do it.")
- X (setq gottago t)
- X (mprincl
- X"As soon as you start to doze off you begin dreaming. You see images of
- Xworkers digging caves, slaving in the humid heat. Then you see yourself
- Xas one of these workers. While no one is looking, you leave the group
- Xand walk into a room. The room is bare except for a horseshoe
- Xshaped piece of stone in the center. You see yourself digging a hole in
- Xthe ground, then putting some kind of treasure in it, and filling the hole
- Xwith dirt again. After this, you immediately wake up.")))
- X
- X(defun break (obj)
- X (let (objnum)
- X (if (not (member obj-axe inventory))
- X (mprincl "You have nothing you can use to break things.")
- X (when (setq objnum (objnum-from-args-std obj))
- X (if (member objnum inventory)
- X (progn
- X (mprincl
- X"You take the object in your hands and swing the axe. Unfortunately, you miss
- Xthe object and slice off your hand. You bleed to death.")
- X (die "an axe"))
- X (if (not (or (member objnum (nth current-room room-objects))
- X (member objnum (nth current-room room-silents))))
- X (mprincl "I don't see that here.")
- X (if (= objnum obj-cable)
- X (progn
- X (mprincl
- X"As you break the ethernet cable, everything starts to blur. You collapse
- Xfor a moment, then straighten yourself up.
- X")
- X (replace room-objects gamma-computing-center
- X (append (nth gamma-computing-center room-objects)
- X inventory))
- X (if (member obj-key inventory)
- X (progn
- X (setq inventory (list obj-key))
- X (remove-obj-from-room gamma-computing-center obj-key))
- X (setq inventory nil))
- X (setq current-room computer-room)
- X (setq ethernet nil)
- X (mprincl "Connection closed.")
- X (unix-interface))
- X (if (< objnum 0)
- X (progn
- X (mprincl "Your axe shatters into a million pieces.")
- X (remove-obj-from-inven obj-axe))
- X (mprincl "Your axe breaks it into a million pieces.")
- X (remove-obj-from-room current-room objnum)))))))))
- X
- X(defun drive (args)
- X (if (not inbus)
- X (mprincl "You cannot drive when you aren't in a vehicle.")
- X (mprincl "To drive while you are in the bus, just give a direction.")))
- X
- X(defun superb (args)
- X (setq mode 'superb))
- X
- X(defun reg-score ()
- X (let (total)
- X (setq total 0)
- X (dolist (x (nth treasure-room room-objects))
- X (setq total (+ total (nth x object-pts))))
- X (if (member obj-URINE (nth treasure-room room-objects))
- X (setq total 0)) total))
- X
- X(defun endgame-score ()
- X (let (total)
- X (setq total 0)
- X (dolist (x (nth endgame-treasure-room room-objects))
- X (setq total (+ total (nth x object-pts)))) total))
- X
- X(defun answer (args)
- X (if (not correct-answer)
- X (mprincl "I don't believe anyone asked you anything.")
- X (setq args (car args))
- X (if (not args)
- X (mprincl "You must give the answer on the same line.")
- X (if (members args correct-answer)
- X (progn
- X (mprincl "Correct.")
- X (if (= lastdir 0)
- X (setq current-room (1+ current-room))
- X (setq current-room (- current-room 1)))
- X (setq correct-answer nil))
- X (mprincl "That answer is incorrect.")))))
- X
- X(defun endgame-question ()
- X(if (not endgame-questions)
- X (progn
- X (mprincl "Your question is:")
- X (mprincl "No more questions, just do 'answer foo'.")
- X (setq correct-answer '("foo")))
- X (let (which i newques)
- X (setq i 0)
- X (setq newques nil)
- X (setq which (% (abs (random)) (length endgame-questions)))
- X (mprincl "Your question is:")
- X (mprincl (setq endgame-question (car (nth which endgame-questions))))
- X (setq correct-answer (cdr (nth which endgame-questions)))
- X (while (< i which)
- X (setq newques (append newques (list (nth i endgame-questions))))
- X (setq i (1+ i)))
- X (setq i (1+ which))
- X (while (< i (length endgame-questions))
- X (setq newques (append newques (list (nth i endgame-questions))))
- X (setq i (1+ i)))
- X (setq endgame-questions newques))))
- X
- X(defun dun-power (args)
- X (if (not (= current-room pc-area))
- X (mprincl "That operation is not applicable here.")
- X (if (not floppy)
- X (dos-no-disk)
- X (dos-interface))))
- X
- X(defun touka (args)
- X (setq current-room computer-room)
- X (setq logged-in t)
- X (setq computer t))
- X
- X(defun dun-feed (args)
- X (let (objnum)
- X (when (setq objnum (objnum-from-args-std args))
- X (if (and (= objnum obj-bear)
- X (member obj-bear (nth current-room room-objects)))
- X (progn
- X (if (not (member obj-food inventory))
- X (mprincl "You have nothing with which to feed it.")
- X (drop '("food"))))
- X (if (not (or (member objnum (nth current-room room-objects))
- X (member objnum inventory)
- X (member objnum (nth current-room room-silents))))
- X (mprincl "I don't see that here.")
- X (mprincl "You cannot feed that."))))))
- END_OF_FILE
- if test 32652 -ne `wc -c <'dun-commands.el'`; then
- echo shar: \"'dun-commands.el'\" unpacked with wrong size!
- fi
- chmod +x 'dun-commands.el'
- # end of 'dun-commands.el'
- fi
- if test -f 'dun-dos.el' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'dun-dos.el'\"
- else
- echo shar: Extracting \"'dun-dos.el'\" \(2389 characters\)
- sed "s/^X//" >'dun-dos.el' <<'END_OF_FILE'
- X;;;;;;;;;;;;;;;;;;;
- X;;;;
- X;;;; DOS
- X;;;;
- X;;;;;;;;;;;;;;;;;;;
- X
- X(if nil
- X (eval-and-compile (setq byte-compile-warnings nil)))
- X
- X(defun dos-parse (args)
- X (interactive "*p")
- X (beginning-of-line)
- X (let (beg)
- X (setq beg (+ (point) 3))
- X (end-of-line)
- X (if (not (= beg (point)))
- X (let (line)
- X (setq line (downcase (buffer-substring beg (point))))
- X (princ line)
- X (if (eq (parse2 nil dos-verbs line) -1)
- X (progn
- X (sleep-for 1)
- X (mprincl "Bad command or file name"))))
- X (goto-char (point-max))
- X (mprinc "\n"))
- X (if (eq dungeon-mode 'dos)
- X (progn
- X (fix-screen)
- X (dos-prompt)))))
- X
- X(defun dos-interface ()
- X (dos-boot-msg)
- X (setq dungeon-mode 'dos)
- X (define-key dungeon-mode-map "\r" 'dos-parse)
- X (dos-prompt))
- X
- X(defun dos-type (args)
- X (sleep-for 2)
- X (if (setq args (car args))
- X (if (string= args "foo.txt")
- X (dos-show-combination)
- X (if (string= args "command.com")
- X (mprincl "Cannot type binary files")
- X (mprinc "File not found - ")
- X (mprincl (upcase args))))
- X (mprincl "Must supply file name")))
- X
- X(defun dos-invd (args)
- X (sleep-for 1)
- X (mprincl "Invalid drive specification"))
- X
- X(defun dos-dir (args)
- X (sleep-for 1)
- X (if (or (not (setq args (car args))) (string= args "\\"))
- X (mprincl "
- X Volume in drive A is FOO
- X Volume Serial Number is 1A16-08C9
- X Directory of A:\\
- X
- XCOMMAND COM 47845 04-09-91 2:00a
- XFOO TXT 40 01-20-93 1:01a
- X 2 file(s) 47845 bytes
- X 1065280 bytes free
- X")
- X (mprincl "
- X Volume in drive A is FOO
- X Volume Serial Number is 1A16-08C9
- X Directory of A:\\
- X
- XFile not found")))
- X
- X
- X(defun dos-prompt ()
- X (mprinc "A> "))
- X
- X(defun dos-boot-msg ()
- X (sleep-for 3)
- X (mprinc "Current time is ")
- X (mprincl (substring (current-time-string) 12 20))
- X (mprinc "Enter new time: ")
- X (read-line)
- X (if (not batch-mode)
- X (mprinc "\n")))
- X
- X(defun dos-spawn (args)
- X (sleep-for 1)
- X (mprincl "Cannot spawn subshell"))
- X
- X(defun dos-exit (args)
- X (setq dungeon-mode 'dungeon)
- X (mprincl "\nYou power down the machine and step back.")
- X (define-key dungeon-mode-map "\r" 'dungeon-parse)
- X (if (not batch-mode)
- X (dungeon-messages)))
- X
- X(defun dos-no-disk ()
- X (sleep-for 3)
- X (mprincl "Boot sector not found"))
- X
- X
- X(defun dos-show-combination ()
- X (sleep-for 2)
- X (mprinc "\nThe combination is ")
- X (mprinc combination)
- X (mprinc ".\n"))
- X
- X(defun dos-nil (args))
- END_OF_FILE
- if test 2389 -ne `wc -c <'dun-dos.el'`; then
- echo shar: \"'dun-dos.el'\" unpacked with wrong size!
- fi
- chmod +x 'dun-dos.el'
- # end of 'dun-dos.el'
- fi
- if test -f 'dun-unix.el' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'dun-unix.el'\"
- else
- echo shar: Extracting \"'dun-unix.el'\" \(14344 characters\)
- sed "s/^X//" >'dun-unix.el' <<'END_OF_FILE'
- X;;;;;;;;;;;;;;;;;;;
- X;;;;
- X;;;; UNIX
- X;;;;
- X;;;;;;;;;;;;;;;;;;;
- X
- X(if nil
- X (eval-and-compile (setq byte-compile-warnings nil)))
- X
- X(defun unix-parse (args)
- X (interactive "*p")
- X (beginning-of-line)
- X (let (beg esign)
- X (setq beg (+ (point) 2))
- X (end-of-line)
- X (if (and (not (= beg (point)))
- X (string= "$" (buffer-substring (- beg 2) (- beg 1))))
- X (progn
- X (setq line (downcase (buffer-substring beg (point))))
- X (princ line)
- X (if (eq (parse2 nil unix-verbs line) -1)
- X (progn
- X (if (setq esign (string-match "=" line))
- X (doassign line esign)
- X (mprinc (car line-list))
- X (mprincl ": not found.")))))
- X (goto-char (point-max))
- X (mprinc "\n"))
- X (if (eq dungeon-mode 'unix)
- X (progn
- X (fix-screen)
- X (mprinc "$ ")))))
- X
- X(defun doassign (line esign)
- X (if (not wizard)
- X (let (passwd)
- X (mprinc "Enter wizard password: ")
- X (setq passwd (read-line))
- X (if (not batch-mode)
- X (mprinc "\n"))
- X (if (string= passwd "moby")
- X (progn
- X (setq wizard t)
- X (doassign line esign))
- X (mprincl "Incorrect.")))
- X
- X (let (varname epoint afterq i value)
- X (setq varname (substring line 0 esign))
- X (if (not (setq epoint (string-match ")" line)))
- X (if (string= (substring line (1+ esign) (+ esign 2))
- X "\"")
- X (progn
- X (setq afterq (substring line (+ esign 2)))
- X (setq epoint (+
- X (string-match "\"" afterq)
- X (+ esign 3))))
- X
- X (if (not (setq epoint (string-match " " line)))
- X (setq epoint (length line))))
- X (setq epoint (1+ epoint))
- X (while (and
- X (not (= epoint (length line)))
- X (setq i (string-match ")" (substring line epoint))))
- X (setq epoint (+ epoint i 1))))
- X (setq value (substring line (1+ esign) epoint))
- X (dungeon-eval varname value))))
- X
- X(defun dungeon-eval (varname value)
- X (let (eval-error)
- X (switch-to-buffer (get-buffer-create "*dungeon-eval*"))
- X (erase-buffer)
- X (insert "(setq ")
- X (insert varname)
- X (insert " ")
- X (insert value)
- X (insert ")")
- X (setq eval-error nil)
- X (condition-case nil
- X (eval-current-buffer)
- X (error (setq eval-error t)))
- X (kill-buffer (current-buffer))
- X (switch-to-buffer "*dungeon*")
- X (if eval-error
- X (mprincl "Invalid syntax."))))
- X
- X
- X(defun unix-interface ()
- X (login)
- X (if logged-in
- X (progn
- X (setq dungeon-mode 'unix)
- X (define-key dungeon-mode-map "\r" 'unix-parse)
- X (mprinc "$ "))))
- X
- X
- X
- X(defun login ()
- X (let (tries username password)
- X (setq tries 4)
- X (while (and (not logged-in) (> (setq tries (- tries 1)) 0))
- X (mprinc "\n\nUNIX System V, Release 2.2 (pokey)\n\nlogin: ")
- X (setq username (read-line))
- X (if (not batch-mode)
- X (mprinc "\n"))
- X (mprinc "password: ")
- X (setq password (read-line))
- X (if (not batch-mode)
- X (mprinc "\n"))
- X (if (or (not (string= username "toukmond"))
- X (not (string= password "robert")))
- X (mprincl "login incorrect")
- X (setq logged-in t)
- X (mprincl "
- XWelcome to Unix\n
- XPlease clean up your directories. The filesystem is getting full.
- XOur tcp/ip link to gamma is a little flakey, but seems to work.
- XThe current version of ftp can only send files from the current
- Xdirectory, and deletes them after they are sent! Be careful.
- X
- XNote: Restricted bourne shell in use.\n")))
- X (setq dungeon-mode 'dungeon)))
- X
- X(defun ls (args)
- X (if (car args)
- X (let (ocdpath ocdroom)
- X (setq ocdpath cdpath)
- X (setq ocdroom cdroom)
- X (if (not (eq (dunnet-cd args) -2))
- X (ls nil))
- X (setq cdpath ocdpath)
- X (setq cdroom ocdroom))
- X (if (= cdroom -10)
- X (ls-inven))
- X (if (= cdroom -2)
- X (ls-rooms))
- X (if (= cdroom -3)
- X (ls-root))
- X (if (= cdroom -4)
- X (ls-usr))
- X (if (> cdroom 0)
- X (ls-room))))
- X
- X(defun ls-root ()
- X (mprincl "total 4
- Xdrwxr-xr-x 3 root staff 512 Jan 1 1970 .
- Xdrwxr-xr-x 3 root staff 2048 Jan 1 1970 ..
- Xdrwxr-xr-x 3 root staff 2048 Jan 1 1970 usr
- Xdrwxr-xr-x 3 root staff 2048 Jan 1 1970 rooms"))
- X
- X(defun ls-usr ()
- X (mprincl "total 4
- Xdrwxr-xr-x 3 root staff 512 Jan 1 1970 .
- Xdrwxr-xr-x 3 root staff 2048 Jan 1 1970 ..
- Xdrwxr-xr-x 3 toukmond restricted 512 Jan 1 1970 toukmond"))
- X
- X(defun ls-rooms ()
- X (mprincl "total 16
- Xdrwxr-xr-x 3 root staff 512 Jan 1 1970 .
- Xdrwxr-xr-x 3 root staff 2048 Jan 1 1970 ..")
- X (dolist (x visited)
- X (mprinc
- X"drwxr-xr-x 3 root staff 512 Jan 1 1970 ")
- X (mprincl (nth x room-shorts))))
- X
- X(defun ls-room ()
- X (mprincl "total 4
- Xdrwxr-xr-x 3 root staff 512 Jan 1 1970 .
- Xdrwxr-xr-x 3 root staff 2048 Jan 1 1970 ..
- X-rwxr-xr-x 3 root staff 2048 Jan 1 1970 description")
- X (dolist (x (nth cdroom room-objects))
- X (if (and (>= x 0) (not (= x 255)))
- X (progn
- X (mprinc "-rwxr-xr-x 1 toukmond restricted 0 Jan 1 1970 ")
- X (mprincl (nth x objfiles))))))
- X
- X(defun ls-inven ()
- X (mprinc "total 467
- Xdrwxr-xr-x 3 toukmond restricted 512 Jan 1 1970 .
- Xdrwxr-xr-x 3 root staff 2048 Jan 1 1970 ..")
- X (dolist (x unix-verbs)
- X (if (not (eq (car x) 'IMPOSSIBLE))
- X (progn
- X (mprinc"
- X-rwxr-xr-x 1 toukmond restricted 10423 Jan 1 1970 ")
- X (mprinc (car x)))))
- X (mprinc "\n")
- X (if (not uncompressed)
- X (mprincl
- X"-rwxr-xr-x 1 toukmond restricted 0 Jan 1 1970 paper.o.Z"))
- X (dolist (x inventory)
- X (mprinc
- X"-rwxr-xr-x 1 toukmond restricted 0 Jan 1 1970 ")
- X (mprincl (nth x objfiles))))
- X
- X(defun echo (args)
- X (let (nomore var)
- X (setq nomore nil)
- X (dolist (x args)
- X (if (not nomore)
- X (progn
- X (if (not (string= (substring x 0 1) "$"))
- X (progn
- X (mprinc x)
- X (mprinc " "))
- X (setq var (intern (substring x 1)))
- X (if (not (boundp var))
- X (mprinc " ")
- X (if (member var restricted)
- X (progn
- X (mprinc var)
- X (mprinc ": Permission denied")
- X (setq nomore t))
- X (eval (list 'mprinc var))
- X (mprinc " ")))))))
- X (mprinc "\n")))
- X
- X
- X(defun ftp (args)
- X (let (host username passwd ident newlist)
- X (if (not (car args))
- X (mprincl "ftp: hostname required on command line.")
- X (setq host (intern (car args)))
- X (if (not (member host '(gamma endgame)))
- X (mprincl "ftp: Unknown host.")
- X (if (eq host 'endgame)
- X (mprincl "ftp: connection to endgame not allowed")
- X (if (not ethernet)
- X (mprincl "ftp: host not responding.")
- X (mprincl "Connected to gamma. FTP ver 0.9 00:00:00 01/01/70")
- X (mprinc "Username: ")
- X (setq username (read-line))
- X (if (string= username "toukmond")
- X (if batch-mode
- X (mprincl "toukmond ftp access not allowed.")
- X (mprincl "\ntoukmond ftp access not allowed."))
- X (if (string= username "anonymous")
- X (if batch-mode
- X (mprincl
- X "Guest login okay, send your user ident as password.")
- X (mprincl
- X "\nGuest login okay, send your user ident as password."))
- X (if batch-mode
- X (mprinc "Password required for ")
- X (mprinc "\nPassword required for "))
- X (mprincl username))
- X (mprinc "Password: ")
- X (setq ident (read-line))
- X (if (not (string= username "anonymous"))
- X (if batch-mode
- X (mprincl "Login failed.")
- X (mprincl "\nLogin failed."))
- X (if batch-mode
- X (mprincl "Guest login okay, user access restrictions apply.")
- X (mprincl "\nGuest login okay, user access restrictions apply."))
- X (ftp-commands)
- X (setq newlist
- X'("What password did you use during anonymous ftp to gamma?"))
- X (setq newlist (append newlist (list ident)))
- X (rplaca (nthcdr 1 endgame-questions) newlist)))))))))
- X
- X(defun ftp-commands ()
- X (setq exitf nil)
- X (let (line)
- X (while (not exitf)
- X (mprinc "ftp> ")
- X (setq line (read-line))
- X (if
- X (eq
- X (parse2 nil
- X '((type . ftptype) (binary . bin) (bin . bin) (send . send)
- X (put . send) (quit . ftpquit) (help . ftphelp)
- X (ascii . fascii)
- X ) line)
- X -1)
- X (mprincl "No such command. Try help.")))
- X (setq ftptype 'ascii)))
- X
- X(defun ftptype (args)
- X (if (not (car args))
- X (mprincl "Usage: type [binary | ascii]")
- X (setq args (intern (car args)))
- X (if (eq args 'binary)
- X (bin nil)
- X (if (eq args 'ascii)
- X (fascii 'nil)
- X (mprincl "Unknown type.")))))
- X
- X(defun bin (args)
- X (mprincl "Type set to binary.")
- X (setq ftptype 'binary))
- X
- X(defun fascii (args)
- X (mprincl "Type set to ascii.")
- X (setq ftptype 'ascii))
- X
- X(defun ftpquit (args)
- X (setq exitf t))
- X
- X(defun send (args)
- X (if (not (car args))
- X (mprincl "Usage: send <filename>")
- X (setq args (car args))
- X (let (counter foo)
- X (setq foo nil)
- X (setq counter 0)
- X
- X;;; User can send commands! Stupid user.
- X
- X
- X (if (assq (intern args) unix-verbs)
- X (progn
- X (rplaca (assq (intern args) unix-verbs) 'IMPOSSIBLE)
- X (mprinc "Sending ")
- X (mprinc ftptype)
- X (mprinc " file for ")
- X (mprincl args)
- X (mprincl "Transfer complete."))
- X
- X (dolist (x objfiles)
- X (if (string= args x)
- X (progn
- X (if (not (member counter inventory))
- X (progn
- X (mprincl "No such file.")
- X (setq foo t))
- X (mprinc "Sending ")
- X (mprinc ftptype)
- X (mprinc " file for ")
- X (mprinc (downcase (cadr (nth counter objects))))
- X (mprincl ", (0 bytes)")
- X (if (not (eq ftptype 'binary))
- X (progn
- X (if (not (member obj-protoplasm
- X (nth receiving-room room-objects)))
- X (replace room-objects receiving-room
- X (append (nth receiving-room room-objects)
- X (list obj-protoplasm))))
- X (remove-obj-from-inven counter))
- X (remove-obj-from-inven counter)
- X (replace room-objects receiving-room
- X (append (nth receiving-room room-objects)
- X (list counter))))
- X (setq foo t)
- X (mprincl "Transfer complete."))))
- X (setq counter (+ 1 counter)))
- X (if (not foo)
- X (mprincl "No such file."))))))
- X
- X(defun ftphelp (args)
- X (mprincl
- X "Possible commands are:\nsend quit type ascii binary help"))
- X
- X(defun uexit (args)
- X (setq dungeon-mode 'dungeon)
- X (mprincl "\nYou step back from the console.")
- X (define-key dungeon-mode-map "\r" 'dungeon-parse)
- X (if (not batch-mode)
- X (dungeon-messages)))
- X
- X(defun dunnet-pwd (args)
- X (mprincl cdpath))
- X
- X(defun uncompress (args)
- X (if (not (car args))
- X (mprincl "Usage: uncompress <filename>")
- X (setq args (car args))
- X (if (or uncompressed
- X (and (not (string= args "paper.o"))
- X (not (string= args "paper.o.z"))))
- X (mprincl "Uncompress command failed.")
- X (setq uncompressed t)
- X (setq inventory (append inventory (list obj-paper))))))
- X
- X(defun rlogin (args)
- X (let (passwd)
- X (if (not (car args))
- X (mprincl "Usage: rlogin <hostname>")
- X (setq args (car args))
- X (if (string= args "endgame")
- X (rlogin-endgame)
- X (if (not (string= args "gamma"))
- X (mprincl "No such host.")
- X (if (not ethernet)
- X (mprincl "Host not responding.")
- X (mprinc "Password: ")
- X (setq passwd (read-line))
- X (if (not (string= passwd "worms"))
- X (mprincl "\nlogin incorrect")
- X (mprinc
- X"\nYou begin to feel strange for a moment, and you lose your items."
- X)
- X (replace room-objects computer-room
- X (append (nth computer-room room-objects) inventory))
- X (setq inventory nil)
- X (setq current-room receiving-room)
- X (uexit nil))))))))
- X
- X(defun dunnet-cd (args)
- X (let (tcdpath tcdroom path-elemants room-check)
- X (if (not (car args))
- X (mprincl "Usage: cd <path>")
- X (setq tcdpath cdpath)
- X (setq tcdroom cdroom)
- X (setq badcd nil)
- X (condition-case nil
- X (setq path-elements (get-path (car args) nil))
- X (error (mprincl "Invalid path.")
- X (setq badcd t)))
- X (dolist (pe path-elements)
- X (unless badcd
- X (if (not (string= pe "."))
- X (if (string= pe "..")
- X (progn
- X (if (> tcdroom 0) ;In a room
- X (progn
- X (setq tcdpath "/rooms")
- X (setq tcdroom -2))
- X ;In /rooms,/usr,root
- X (if (or
- X (= tcdroom -2) (= tcdroom -4)
- X (= tcdroom -3))
- X (progn
- X (setq tcdpath "/")
- X (setq tcdroom -3))
- X (if (= tcdroom -10) ;In /usr/toukmond
- X (progn
- X (setq tcdpath "/usr")
- X (setq tcdroom -4))))))
- X (if (string= pe "/")
- X (progn
- X (setq tcdpath "/")
- X (setq tcdroom -3))
- X (if (= tcdroom -4)
- X (if (string= pe "toukmond")
- X (progn
- X (setq tcdpath "/usr/toukmond")
- X (setq tcdroom -10))
- X (nosuchdir))
- X (if (= tcdroom -10)
- X (nosuchdir)
- X (if (> tcdroom 0)
- X (nosuchdir)
- X (if (= tcdroom -3)
- X (progn
- X (if (string= pe "rooms")
- X (progn
- X (setq tcdpath "/rooms")
- X (setq tcdroom -2))
- X (if (string= pe "usr")
- X (progn
- X (setq tcdpath "/usr")
- X (setq tcdroom -4))
- X (nosuchdir))))
- X (if (= tcdroom -2)
- X (progn
- X (dolist (x visited)
- X (setq room-check
- X (nth x room-shorts))
- X (if (string= room-check pe)
- X (progn
- X (setq tcdpath
- X (concat "/rooms/" room-check))
- X (setq tcdroom x))))
- X (if (= tcdroom -2)
- X (nosuchdir)))))))))))))
- X (if (not badcd)
- X (progn
- X (setq cdpath tcdpath)
- X (setq cdroom tcdroom)
- X 0)
- X -2))))
- X
- X(defun nosuchdir ()
- X (mprincl "No such directory.")
- X (setq badcd t))
- X
- X(defun cat (args)
- X (let (doto checklist)
- X (if (not (setq args (car args)))
- X (mprincl "Usage: cat <ascii-file-name>")
- X (if (string-match "/" args)
- X (mprincl "cat: only files in current directory allowed.")
- X (if (and (> cdroom 0) (string= args "description"))
- X (mprincl (car (nth cdroom rooms)))
- X (if (setq doto (string-match "\\.o" args))
- X (progn
- X (if (= cdroom -10)
- X (setq checklist inventory)
- X (setq checklist (nth cdroom room-objects)))
- X (if (not (member (cdr
- X (assq (intern
- X (substring args 0 doto)) objnames))
- X checklist))
- X (mprincl "File not found.")
- X (mprincl "Ascii files only.")))
- X (if (assq (intern args) unix-verbs)
- X (mprincl "Ascii files only.")
- X (mprincl "File not found."))))))))
- X
- X(defun zippy (args)
- X (mprincl (yow)))
- X
- X(defun rlogin-endgame ()
- X (if (not (= (score nil) 90))
- X (mprincl "You have not achieved enough points to connect to endgame.")
- X (mprincl"\nWelcome to the endgame. You are a truly noble adventurer.")
- X (setq current-room treasure-room)
- X (setq endgame t)
- X (replace room-objects endgame-treasure-room (list obj-bill))
- X (uexit nil)))
- END_OF_FILE
- if test 14344 -ne `wc -c <'dun-unix.el'`; then
- echo shar: \"'dun-unix.el'\" unpacked with wrong size!
- fi
- chmod +x 'dun-unix.el'
- # end of 'dun-unix.el'
- fi
- echo shar: End of archive 2 \(of 3\).
- cp /dev/null ark2isdone
- MISSING=""
- for I in 1 2 3 ; do
- if test ! -f ark${I}isdone ; then
- MISSING="${MISSING} ${I}"
- fi
- done
- if test "${MISSING}" = "" ; then
- echo You have unpacked all 3 archives.
- rm -f ark[1-9]isdone
- else
- echo You still need to unpack the following archives:
- echo " " ${MISSING}
- fi
- ## End of shell archive.
- exit 0
-