Source Code 1994 March/Source_Code_CD-ROM_Walnut_Creek_March_1994.iso/compsrcs/games/volume14/dunnet/part02

Text File | 1992-08-30 | 49.6 KB | 1,607 lines

Path: uunet!zephyr.ens.tek.com!master!saab!billr
From: [e-mail] (Bill Randle)
Newsgroups: comp.sources.games
Subject: v14i029:  dunnet - emacs-lisp text adventure, Part02/02
Message-ID: <[e-mail]>
Date: 4 Aug 92 19:59:55 GMT
Sender: [e-mail]
Lines: 1596
Approved: [e-mail]

Submitted-by: [e-mail] (Ron Schnell)
Posting-number: Volume 14, Issue 29
Archive-name: dunnet/Part02
Environment: gnu-emacs, emacs-lisp


#! /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 2)."
# Contents:  COPYRIGHT dun-batch.el dun-commands.el dun-main.el
#   dun-save.el dun-util.el dunnet dunnet.window
# Wrapped by billr@saab on Tue Aug  4 12:57:55 1992
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'COPYRIGHT' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'COPYRIGHT'\"
else
echo shar: Extracting \"'COPYRIGHT'\" \(908 characters\)
sed "s/^X//" >'COPYRIGHT' <<'END_OF_FILE'
X
X;; dunnet - elisp text adventure game.  The following applies to
X;;           these files contained in this archive:
X;;              dun-batch.el
X;;              dun-commands.el
X;;              dun-globals.el
X;;              dun-main.el
X;;              dun-save.el
X;;              dun-unix.el
X;;              dun-util.el
X
X;; Copyright (C) 1992 by Ron Schnell
X;; ([e-mail])
X
X;; This software is not part of GNU Emacs.
X
X;; It is distributed in the hope that it will be fun.
X;; It is without any warranty.  No author or distributor
X;; accepts responsibility to anyone for the consequences of using it
X;; or for whether it serves any particular purpose, or works at all.
X
X;; Everyone is granted permission to copy, modify, and redistribute
X;; this software, but only so long as it is not for commercial
X;; purposes.
X
X;; This file must be distributed along with all copies, in an unmodified
X;; form.
END_OF_FILE
if test 908 -ne `wc -c <'COPYRIGHT'`; then
    echo shar: \"'COPYRIGHT'\" unpacked with wrong size!
fi
# end of 'COPYRIGHT'
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'\" \(1691 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(defun mprinc (arg)
X
X   (if (stringp arg)
X       (send-string-to-terminal arg)
X     (send-string-to-terminal (prin1-to-string arg))))
X(defun mprincl (arg)
X
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(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-string ""))
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-string "")))
X      (if (eq (parse ignore verblist line) -1)
X          (mprinc "I don't understand that.\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-string "")))
X        (if (eq (parse2 nil unix-verbs line) -1)
X        (progn
X          (if (setq esign (string-match "=" line))
X              (doassign line)
X            (mprinc (car line-list))
X            (mprincl ": not found.")))))
X      (goto-char (point-max))
X      (mprinc "\n"))))
X
END_OF_FILE
if test 1691 -ne `wc -c <'dun-batch.el'`; then
    echo shar: \"'dun-batch.el'\" unpacked with wrong size!
fi
# 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'\" \(28022 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;;;; 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)) (not (member 1 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 255)
X      (special-object)
X    (if (>= xobjs 0)
X        (mprincl (car (nth xobjs objects)))
X      (if (not (and (= xobjs -18) inbus))
X          (progn
X        (mprincl (car (nth (abs xobjs) perm-objects)))))))
X      (if (and (= xobjs 19) jar)
X      (progn
X        (mprincl "The jar contains:")
X        (dolist (x jar)
X          (mprinc "     ")
X          (mprincl (car (nth x objects)))))))
X    (if (and (member -18 (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 10)
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  (if (and (= current-room 46) (not (member 13 (nth 46 room-objects))))
X      (mprincl "There is a hole in the floor here."))
X  (if (and (= current-room 86) black)
X      (mprincl
X"The room is lit by a black light, causing the fish to give off an
Xeerie glow."))
X  (if (and (= current-room 77) hole)
X      (progn
X    (mprincl"You fall into a hole in the ground.")
X    (setq current-room 89)
X    (describe-room 89)))
X
X  (if (> current-room 95)
X      (progn
X    (if (not correct-answer)
X        (endgame-question)
X      (mprincl "Your question is:")
X      (mprincl endgame-question))))
X
X  (if (= current-room 14)
X      (progn
X    (mprincl (nth sauna-level '(
X"It is normal room termperature 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 6 inventory)
X             (member 6 (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 6 inventory)
X          (progn
X            (remove-obj-from-inven 6)
X            (setq inventory (append inventory (list 7))))
X        (remove-obj-from-room current-room 6)
X        (replace room-objects current-room
X             (append (nth current-room room-objects)
X                 (list 7))))))))
X
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 19) 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 -2)
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 -3)
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)
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 '(3 8 19))
X          (drop-check objnum))))))))
X
X;; Dropping certain things causes things to happen.
X
X(defun drop-check (objnum)
X  (if (and (= objnum 3) (= room 7) (member -3 (nth 7 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 -3)
X    (remove-obj-from-room current-room 3)
X    (replace room-objects current-room
X         (append (nth current-room room-objects)
X             (list 4)))))
X
X  (if (and (= objnum 19) (member 21 jar) (member 22 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 19)
X    (if (= current-room 77)
X        (progn
X          (setq hole t)
X          (setq current-room 89)
X          (mprincl
X"The explosion causes a hole to open up in the ground, which you fall
Xthrough.")))))
X
X  (if (and (= objnum 8) (= current-room 17))
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 255)
X    (describe-room (* current-room -1))
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 20) (= current-room 86) 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 255)))
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      (progn
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 19 inventory))
X      (progn
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 13) (= current-room 46))
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
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 (args)
X  (if (not (member -2 (nth current-room room-silents)))
X      (mprincl "There is nothing here to climb.")
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 3))
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 3))))))
X
X(defun dput (args)
X  (if inbus
X      (mprincl "You can't do that while on the bus")
X    (let (newargs objnum objnum2)
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 (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 -17) (not nomail))
X      (setq obj2 -9))
X
X  (if (= obj2 -26) (setq obj2 -9))
X
X  (if (and (= obj1 2) (= obj2 -5))     ;; Put board in cabinet
X      (progn
X    (remove-obj-from-inven 2)
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 8) (= obj2 -8))   ;; Put weight on button
X    (drop '("weight"))
X      (if (= obj2 19)                 ;; Put something in jar
X      (if (not (member obj1 '(5 7 10 16 17 18 21 22)))
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 -9)                 ;; 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 -15)
X          (if (= obj1 4)
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 10 (append
X                            (nth 10 room-objects)
X                            (list obj1)))
X            (remove-obj-from-room current-room -15)
X            (setq key-level (1+ key-level))))
X        (if (= obj2 -12)
X        (progn
X          (remove-obj-from-inven obj1)
X          (replace room-objects 36 (append (nth 36 room-objects)
X                           (list obj1)))
X          (mprincl
X           "You hear it plop down in some water below."))
X          (if (= obj2 -17)
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 10))
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 0))
X
X(defun s (args)
X  (move 1))
X
X(defun e (args)
X  (move 2))
X
X(defun w (args)
X  (move 3))
X
X(defun ne (args)
X  (move 4))
X
X(defun se (args)
X  (move 5))
X
X(defun nw (args)
X  (move 6))
X
X(defun sw (args)
X  (move 7))
X
X(defun up (args)
X  (move 8))
X
X(defun down (args)
X  (move 9))
X
X(defun in (args)
X  (move 10))
X
X(defun out (args)
X  (move 11))
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(defun move (dir)
X  (if (and (not (member current-room light-rooms)) (not (member 1 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 -18)
X          (setq current-room newroom)
X          (replace room-objects newroom
X               (append (nth newroom room-objects) (list -18)))))
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 5)
X      (if (not (member 4 inventory))
X      (mprincl "You don't have a key that can open this door.")
X    (setq current-room 8))
X    (if (= current-room 7)
X    (if (member -3 (nth 7 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 89)
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 90)))
X
X    (if (= current-room 8)
X    (if (and (member 4 inventory)
X         (> key-level 0))
X        (setq current-room 11)
X      (mprincl "You don't have a key that can open this door.")))
X
X    (if (and (= current-room 17) (= dir 6))
X    (if (member 8 (nth 17 room-objects))
X        (setq current-room 18)
X      (mprincl "You can't go that way.")))
X
X    (if (and (= current-room 17) (= dir 8))
X    (if (member 8 (nth 17 room-objects))
X        (mprincl "You can't go that way.")
X      (setq current-room 16)))
X
X    (if (= current-room 88)
X    (mprincl "The door is locked."))
X
X    (if (or (= current-room 25) (= current-room 26))
X    (swim nil))
X
X    (if (= current-room 32)
X    (if (> key-level 0)
X        (setq current-room 57)
X      (mprincl "You don't have a key that can open that door.")))
X
X    (if (= current-room 23)
X    (if (not (= sauna-level 3))
X        (setq current-room 24)
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 46)
X    (if (not (member 13 (nth 46 room-objects)))
X        (setq current-room 47)
X      (mprincl "You can't go that way.")))
X
X    (if (and (> dir 9) (> current-room 57) (< current-room 84))
X    (if (not (member -18 (nth current-room room-objects)))
X        (mprincl "You can't go that way.")
X      (if (= dir 10)
X          (if (member 16 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 80)
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 59)
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 59 -18)
X          (replace room-objects 83 (append (nth 83 room-objects)
X                            (list -18)))
X          (setq current-room 83)))))
X    (if (= current-room 28)
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 29)))))
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 -7))
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 6 inventory)
X        (member 6 (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 6 inventory)
X          (progn
X            (remove-obj-from-inven 6)
X            (setq inventory (append inventory (list 7))))
X        (remove-obj-from-room current-room 6)
X        (replace room-objects current-room
X             (append (nth current-room room-objects)
X                 (list 7))))))))
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 '(-8 -24)))
X        (progn
X          (mprinc "You can't ")
X          (mprinc (car line-list))
X          (mprincl " that."))
X      (if (= objnum -8)
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 -24)
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 '(25 26)))
X      (mprincl "I see no water!")
X    (if (not (member 9 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 25)
X      (setq current-room 26)
X    (setq current-room 25)))))
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 (1.0), by Ron Schnell ([e-mail]).
XThis is a pre-release version.  Here is some useful information (read
Xcarefully because there are one or 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 [e-mail]."))
X
X(defun flush (args)
X  (if (not (= current-room 35))
X      (mprincl "I see nothing to flush.")
X    (mprincl "Whoooosh!!")
X    (put-objs-in-treas (nth 36 room-objects))
X    (replace room-objects 36 nil)))
X
X(defun piss (args)
X  (if (not (= current-room 35))
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 36 (append (nth 36 room-objects) (list -13))))))
X
X
X(defun sleep (args)
X  (if (not (= current-room 34))
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 14 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 -16)
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 57 (append (nth 36 room-objects)
X                           inventory))
X          (if (member 4 inventory)
X              (progn
X            (setq inventory '(4))
X            (remove-obj-from-room 57 4))
X            (setq inventory nil))
X          (setq current-room 10)
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 14))
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 0 room-objects))
X      (setq total (+ total (nth x object-pts))))
X    (if (member -13 (nth 0 room-objects))
X    (setq total 0)) total))
X
X(defun endgame-score ()
X  (let (total)
X    (setq total 0)
X    (dolist (x (nth 102 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))))
END_OF_FILE
if test 28022 -ne `wc -c <'dun-commands.el'`; then
    echo shar: \"'dun-commands.el'\" unpacked with wrong size!
fi
# end of 'dun-commands.el'
fi
if test -f 'dun-main.el' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'dun-main.el'\"
else
echo shar: Extracting \"'dun-main.el'\" \(2311 characters\)
sed "s/^X//" >'dun-main.el' <<'END_OF_FILE'
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X;                                                                      ;
X;                       dunnet.el  Version 1.0                         ;
X;                                                                      ;
X;                   Ron Schnell ([e-mail])                 ;
X;                                                                      ;
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X
X
X;; This is the startup file.  It loads in the other files, and sets up
X;; the functions to be bound to keys if you play in window-mode.
X
X;;;;;  The log file should be set for your system, and it must
X;;;;;  be writeable by all.
X
X      (setq log-file "/user0/rschnell/score/score")
X
X(defun dungeon-mode ()
X  "Major mode for running dungeon"
X  (interactive)
X  (text-mode)
X  (use-local-map dungeon-mode-map)
X  (setq major-mode 'dungeon-mode)
X  (setq mode-name "Dungeon")
X)
X
X(defun dungeon-parse (arg)
X  "foo"
X  (interactive "*p")
X  (beginning-of-line)
X  (setq beg (+ (point) 1))
X  (end-of-line)
X  (if (and (not (= beg (point)))
X       (string= ">" (buffer-substring (- beg 1) beg)))
X      (progn
X    (setq line (downcase (buffer-substring beg (point))))
X    (princ line)
X    (if (eq (parse ignore verblist line) -1)
X        (mprinc "I don't understand that.\n")))
X    (goto-char (point-max))
X    (mprinc "\n"))
X    (dungeon-messages))
X
X(defun dungeon-messages ()
X  (if dead
X      (text-mode)
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
X(defun dungeon-start ()
X  (interactive)
X  (switch-to-buffer "*dungeon*")
X  (dungeon-mode)
X  (setq dead nil)
X  (setq room 0)
X  (dungeon-messages))
X
X(require 'cl)
X
X(defun batch-dungeon ()
X  (setq load-path (append load-path (list ".")))
X  (load "dun-batch")
X  (setq visited '(27))
X  (mprinc "\n")
X  (dungeon-batch-loop))
X
X(setq load-path (append load-path (list ".")))
X
X(load "dun-commands")
X(load "dun-util")
X(if (setq glob (get-glob-dat))
X    (load-d glob)
X  (load "dun-globals"))
X
X(load "dun-unix")
X(load "dun-save")
X(setq tloc (+ 60 (% (abs (random)) 18)))
X(replace room-objects tloc (append (nth tloc room-objects) (list 18)))
X(dungeon-start)
END_OF_FILE
if test 2311 -ne `wc -c <'dun-main.el'`; then
    echo shar: \"'dun-main.el'\" unpacked with wrong size!
fi
# end of 'dun-main.el'
fi
if test -f 'dun-save.el' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'dun-save.el'\"
else
echo shar: Extracting \"'dun-save.el'\" \(4075 characters\)
sed "s/^X//" >'dun-save.el' <<'END_OF_FILE'
X
X;;;;;;;;;;;;;;;;;;;
X;
X;
X;  Save and restore
X;
X;
X;;;;;;;;;;;;;;;;;;;
X
X(defun save-game (filename)
X  (if (not (setq filename (car filename)))
X      (mprincl "You must supply a filename for the save.")
X    (if (file-exists-p filename)
X    (mprincl "File already exists.")
X      (setq numsaves (1+ numsaves))
X      (make-save-buffer)
X      (save-val "current-room")
X      (save-val "computer")
X      (save-val "door1")
X      (save-val "visited")
X      (save-val "diggables")
X      (save-val "key-level")
X      (save-val "numsaves")
X      (save-val "numcmds")
X      (save-val "logged-in")
X      (save-val "dungeon-mode")
X      (save-val "jar")
X      (save-val "lastdir")
X      (save-val "black")
X      (save-val "nomail")
X      (save-val "unix-verbs")
X      (save-val "hole")
X      (save-val "uncompressed")
X      (save-val "ethernet")
X      (save-val "sauna-level")
X      (save-val "room-objects")
X      (save-val "room-silents")
X      (save-val "inventory")
X      (save-val "endgame-question")
X      (save-val "endgame")
X      (save-val "endgame-questions")
X      (save-val "cdroom")
X      (save-val "cdpath")
X      (save-val "correct-answer")
X      (save-val "inbus")
X      (compile-save-out filename)
X      (do-logfile 'save nil)
X      (switch-to-buffer "*dungeon*")
X      (princ "")
X      (mprincl "Done."))))
X
X(defun make-save-buffer ()
X  (switch-to-buffer (get-buffer-create "*save-dungeon*"))
X  (erase-buffer))
X
X;; If you don't have the crypt program, rename this function to
X;; compile-save-out, and get rid of the next function.
X
X(defun compile-save-out-nocrypt (filename)
X  (write-region 1 (point-max) filename nil 1)
X  (kill-buffer (current-buffer)))
X
X(defun compile-save-out (filename)
X  (let (key dir ferror)
X    (setq ferror nil)
X    (if (< lastdir 10)
X    (setq dir (+ lastdir 10))
X      (setq dir lastdir))
X    (setq key (prin1-to-string dir))
X    (condition-case nil
X    (crypt-buffer key)
X      (error (setq ferror t)))
X    (if (not ferror)
X    (progn
X      (goto-char (point-min))
X      (insert key)))
X    (write-region 1 (point-max) filename nil 1)
X    (kill-buffer (current-buffer))))
X
X(defun save-val (varname)
X  (let (value)
X    (setq varname (intern varname))
X    (setq value (eval varname))
X    (minsert "(setq ")
X    (minsert varname)
X    (minsert " ")
X    (if (or (listp value)
X        (symbolp value))
X    (minsert "'"))
X    (if (stringp value)
X    (minsert "\""))
X    (minsert value)
X    (if (stringp value)
X    (minsert "\""))
X    (minsertl ")")))
X
X
X;; If you don't have the crypt program, rename this function to 'restore'
X;; and get rid of the next function.
X
X(defun restore-nocrypt (args)
X  (let (file ferrror)
X    (setq ferror nil)
X    (if (not (setq file (car args)))
X    (mprincl "You must supply a filename.")
X      (condition-case nil
X      (load-file file)
X    (error (setq ferror t)))
X      (if ferror
X      (mprinc "Could not load restore file.")
X    (mprincl "Done.")
X    (setq room 0)))))
X
X(defun restore (args)
X  (let (file)
X    (if (not (setq file (car args)))
X    (mprincl "You must supply a filename.")
X      (if (not (load-d file))
X      (mprincl "Could not load restore file.")
X    (mprincl "Done.")
X    (setq room 0)))))
X
X
X(defun do-logfile (type how)
X  (let (ferror)
X    (setq ferror nil)
X    (switch-to-buffer (get-buffer-create "*score*"))
X    (erase-buffer)
X    (condition-case nil
X    (insert-file-contents log-file)
X      (error (setq ferror t)))
X    (unless ferror
X        (goto-char (point-max))
X        (minsert (user-login-name))
X        (minsert " ")
X        (if (eq type 'save)
X        (minsert "saved ")
X          (if (= (endgame-score) 110)
X          (minsert "won ")
X        (if (not how)
X            (minsert "quit ")
X          (minsert "killed by ")
X          (minsert how)
X          (minsert " "))))
X        (minsert "at ")
X        (minsert (cadr (nth (abs room) rooms)))
X        (minsert ". score: ")
X        (if (> (endgame-score) 0)
X        (minsert (setq newscore (+ 90 (endgame-score))))
X          (minsert (setq newscore (reg-score))))
X        (minsert " saves: ")
X        (minsert numsaves)
X        (minsert " commands: ")
X        (minsert numcmds)
X        (minsert "\n")
X        (write-region 1 (point-max) log-file nil 1))
X    (kill-buffer (current-buffer))))
END_OF_FILE
if test 4075 -ne `wc -c <'dun-save.el'`; then
    echo shar: \"'dun-save.el'\" unpacked with wrong size!
fi
# end of 'dun-save.el'
fi
if test -f 'dun-util.el' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'dun-util.el'\"
else
echo shar: Extracting \"'dun-util.el'\" \(7730 characters\)
sed "s/^X//" >'dun-util.el' <<'END_OF_FILE'
X(require 'cl)
X
X;;;;;;;;;;;;;;;;;;;;; Utility functions
X
X;;; Function which takes a verb and a list of other words.  Calls proper
X;;; function associated with the verb, and passes along the other words.
X
X(defun doverb (ignore verblist verb rest)
X  (if (not verb)
X      nil
X    (if (member (intern verb) ignore)
X    (if (not (car rest)) -1
X      (doverb ignore verblist (car rest) (cdr rest)))
X      (if (not (cdr (assq (intern verb) verblist))) -1
X    (setq numcmds (1+ numcmds))
X    (eval (list (cdr (assq (intern verb) verblist)) (quote rest)))))))
X
X
X;;; Function to take a string and change it into a list of lowercase words.
X
X(defun listify-string (strin)
X  (let (pos ret-list end-pos)
X    (setq pos 0)
X    (setq ret-list nil)
X    (while (setq end-pos (string-match "[ ,:;]" (substring strin pos)))
X      (setq end-pos (+ end-pos pos))
X      (if (not (= end-pos pos))
X      (setq ret-list (append ret-list (list
X                       (downcase
X                        (substring strin pos end-pos))))))
X      (setq pos (+ end-pos 1))) ret-list))
X
X(defun listify-string2 (strin)
X  (let (pos ret-list end-pos)
X    (setq pos 0)
X    (setq ret-list nil)
X    (while (setq end-pos (string-match " " (substring strin pos)))
X      (setq end-pos (+ end-pos pos))
X      (if (not (= end-pos pos))
X      (setq ret-list (append ret-list (list
X                       (downcase
X                        (substring strin pos end-pos))))))
X      (setq pos (+ end-pos 1))) ret-list))
X
X(defun replace (list n number)
X  (rplaca (nthcdr n list) number))
X
X
X;;; Get the first non-ignored word from a list.
X
X(defun firstword (list)
X  (if (not (car list))
X      nil
X    (while (and list (member (intern (car list)) ignore))
X      (setq list (cdr list)))
X    (car list)))
X
X(defun firstwordl (list)
X  (if (not (car list))
X      nil
X    (while (and list (member (intern (car list)) ignore))
X      (setq list (cdr list)))
X    list))
X
X;; parse a line passed in as a string  Call the proper verb with the
X;; rest of the line passed in as a list.
X
X(defun parse (ignore verblist line)
X  (mprinc "\n")
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  (mprinc "\n")
X  (setq line-list (listify-string2 (concat line " ")))
X  (doverb ignore verblist (car line-list) (cdr line-list)))
X
X(defun read-line ()
X  (let (line)
X    (setq line (read-string ""))
X    (mprinc line) line))
X
X(defun minsert (string)
X  (if (stringp string)
X      (insert string)
X    (insert (prin1-to-string string))))
X
X(defun mprinc (string)
X  (if (stringp string)
X      (insert string)
X    (insert (prin1-to-string string))))
X
X(defun minsertl (string)
X  (minsert string)
X  (minsert "\n"))
X
X(defun mprincl (string)
X  (mprinc string)
X  (mprinc "\n"))
X
X;;;; Function which will get an object number given the list of
X;;;; words in the command, except for the verb.
X
X(defun objnum-from-args (obj)
X  (let (objnum)
X    (setq obj (firstword obj))
X    (if (not obj)
X    255
X      (setq objnum (cdr (assq (intern obj) objnames))))))
X
X(defun objnum-from-args-std (obj)
X  (let (result)
X  (if (eq (setq result (objnum-from-args obj)) 255)
X      (mprincl "You must supply an object."))
X  (if (eq result nil)
X      (mprincl "I don't know what that is."))
X  (if (eq result 255)
X      nil
X    result)))
X
X;; Take a short room description, and change spaces and slashes to dashes.
X
X(defun space-to-hyphen (string)
X  (let (space)
X    (if (setq space (string-match "[ /]" string))
X    (progn
X      (setq string (concat (substring string 0 space) "-"
X                   (substring string (1+ space))))
X      (space-to-hyphen string))
X      string)))
X
X;; Given a unix style pathname, build a list of path components (recursive)
X
X(defun get-path (dirstring startlist)
X  (let (slash pos)
X    (if (= (length dirstring) 0)
X    startlist
X      (if (string= (substring dirstring 0 1) "/")
X      (get-path (substring dirstring 1) (append startlist (list "/")))
X    (if (not (setq slash (string-match "/" dirstring)))
X        (append startlist (list dirstring))
X      (get-path (substring dirstring (1+ slash))
X            (append startlist
X                (list (substring dirstring 0 slash)))))))))
X
X
X(defun members (string string-list)
X  (let (found)
X    (setq found nil)
X    (dolist (x string-list)
X      (if (string= x string)
X      (setq found t))) found))
X
X(defun put-objs-in-treas (objlist)
X  (let (oscore newscore)
X    (setq oscore (reg-score))
X    (replace room-objects 0 (append (nth 0 room-objects) objlist))
X    (setq newscore (reg-score))
X    (if (not (= oscore newscore))
X    (score nil))))
X
X(defun load-d (filename)
X  (let (old-buffer key result)
X    (setq result t)
X    (setq old-buffer (current-buffer))
X    (switch-to-buffer (get-buffer-create "*loadc*"))
X    (erase-buffer)
X    (condition-case nil
X    (insert-file-contents filename)
X      (error (setq result nil)))
X    (unless (not result)
X        (setq key (buffer-substring (point-min) (+ (point-min) 2)))
X        (delete-char 2 t)
X        (condition-case nil
X        (crypt-buffer key)
X          (error (yank)))
X        (eval-current-buffer)
X        (kill-buffer (current-buffer))
X        (switch-to-buffer old-buffer))
X    result))
X
X(defun compile-globals ()
X  (switch-to-buffer (get-buffer-create "*compd*"))
X  (erase-buffer)
X  (insert-file-contents "dun-globals.el")
X  (setq key (concat (prin1-to-string (% (abs (random)) 9))
X            (prin1-to-string (% (abs (random)) 9))))
X  (crypt-buffer key)
X  (goto-char (point-min))
X  (insert key)
X  (write-region 1 (point-max) "dun-globals.dat")
X  (kill-buffer (current-buffer)))
X
X;; Functions to remove an object either from a room, or from inventory.
X
X(defun remove-obj-from-room (room objnum)
X  (let (newroom)
X    (setq newroom nil)
X    (dolist (x (nth room room-objects))
X      (if (not (= x objnum))
X      (setq newroom (append newroom (list x)))))
X    (rplaca (nthcdr room room-objects) newroom)))
X
X(defun remove-obj-from-inven (objnum)
X  (let (new-inven)
X    (setq new-inven nil)
X    (dolist (x inventory)
X      (if (not (= x objnum))
X      (setq new-inven (append new-inven (list x)))))
X    (setq inventory new-inven)))
X
X(defun get-glob-dat ()
X  (let (result)
X    (setq result nil)
X    (dolist (x load-path)
X        (if (file-exists-p (concat x "/dun-globals.dat"))
X        (setq result (concat x "/dun-globals.dat"))))
X    result))
X
X;;;
X;;; This is a small part copied from crypt.el by [e-mail], with
X;;; a small change.
X
X
X;;; Compaction, compression and encryption for GNU Emacs
X;;; Copyright (C) 1988, 1989, 1990 Kyle E. Jones
X;;;
X;;; This program is free software; you can redistribute it and/or modify
X;;; it under the terms of the GNU General Public License as published by
X;;; the Free Software Foundation; either version 1, or (at your option)
X;;; any later version.
X;;;
X;;; This program is distributed in the hope that it will be useful,
X;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
X;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
X;;; GNU General Public License for more details.
X;;;
X;;; A copy of the GNU General Public License can be obtained from this
X;;; program's author (send electronic mail to [e-mail]) or from
X;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
X;;; 02139, USA.
X;;;
X;;; Send bug reports to [e-mail].
X
X;;; Changes for dungeon -
X;;; [e-mail] - changed shell to use /bin/sh explicitly.
X;;;                        Otherwise user's 'rc' file might produce
X;;;                        output that gets stuffed into buffer.
X
X(defun crypt-region (start end key)
X   (let ((opoint-max (point-max)))
X     (call-process-region start end "/bin/sh" t t nil "-c"
X              (concat "crypt \"" key "\""))
X     (if (not (= opoint-max (point-max)))
X     (error "crypt command failed!"))))
X
X(defun crypt-buffer (key &optional buffer)
X  (crypt-region (point-min) (point-max) key))
END_OF_FILE
if test 7730 -ne `wc -c <'dun-util.el'`; then
    echo shar: \"'dun-util.el'\" unpacked with wrong size!
fi
# end of 'dun-util.el'
fi
if test -f 'dunnet' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'dunnet'\"
else
echo shar: Extracting \"'dunnet'\" \(55 characters\)
sed "s/^X//" >'dunnet' <<'END_OF_FILE'
X#! /bin/sh
X
X    emacs -batch -l dun-main -f batch-dungeon
END_OF_FILE
if test 55 -ne `wc -c <'dunnet'`; then
    echo shar: \"'dunnet'\" unpacked with wrong size!
fi
chmod +x 'dunnet'
# end of 'dunnet'
fi
if test -f 'dunnet.window' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'dunnet.window'\"
else
echo shar: Extracting \"'dunnet.window'\" \(32 characters\)
sed "s/^X//" >'dunnet.window' <<'END_OF_FILE'
X#! /bin/sh
X
X    emacs -l dun-main
X
END_OF_FILE
if test 32 -ne `wc -c <'dunnet.window'`; then
    echo shar: \"'dunnet.window'\" unpacked with wrong size!
fi
chmod +x 'dunnet.window'
# end of 'dunnet.window'
fi
echo shar: End of archive 2 \(of 2\).
cp /dev/null ark2isdone
MISSING=""
for I in 1 2 ; do
    if test ! -f ark${I}isdone ; then
    MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked both 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