Source Code 1994 March/Source_Code_CD-ROM_Walnut_Creek_March_1994.iso/compsrcs/games/volume18/dunnet2/part03

Text File | 1993-07-11 | 13.1 KB | 451 lines

Path: uunet!news.tek.com!saab!billr
From: [e-mail] (Bill Randle)
Newsgroups: comp.sources.games
Subject: v18i013:  dunnet2 - emacs-lisp text adventure, Ver 2, Part03/03
Date: 10 Jul 1993 22:59:05 GMT
Organization: Tektronix, Inc, Redmond, OR, USA
Lines: 438
Approved: [e-mail]
Message-ID: <21nhjp$[e-mail]>
NNTP-Posting-Host: saab.cna.tek.com
Xref: uunet comp.sources.games:1813

Submitted-by: [e-mail]
Posting-number: Volume 18, Issue 13
Archive-name: dunnet2/part03
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 3 (of 3)."
# Contents:  COPYRIGHT LCD-entry dun-util.el dunnet dunnet.curdir
#   dunnet.window dunnet.window.curdir
# Wrapped by billr@saab on Sat Jul 10 15:54:31 1993
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'\" \(941 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-dos.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, 1993 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 941 -ne `wc -c <'COPYRIGHT'`; then
    echo shar: \"'COPYRIGHT'\" unpacked with wrong size!
fi
# end of 'COPYRIGHT'
fi
if test -f 'LCD-entry' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'LCD-entry'\"
else
echo shar: Extracting \"'LCD-entry'\" \(133 characters\)
sed "s/^X//" >'LCD-entry' <<'END_OF_FILE'
X;; LCD Archive Entry:
X;; dunnet|Ron Schnell|[e-mail]
X;; |Text adventure.
X;; |93-06-30|Version: 2.0|~/games/dunnet.tar.Z|
END_OF_FILE
if test 133 -ne `wc -c <'LCD-entry'`; then
    echo shar: \"'LCD-entry'\" unpacked with wrong size!
fi
# end of 'LCD-entry'
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'\" \(7561 characters\)
sed "s/^X//" >'dun-util.el' <<'END_OF_FILE'
X(require 'cl)
X(require 'rnews)
X
X;;;;;;;;;;;;;;;;;;;;; Utility functions
X
X(if nil
X    (eval-and-compile (setq byte-compile-warnings nil)))
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;; Read a line, in window mode
X
X(defun read-line ()
X  (let (line)
X    (setq line (read-string ""))
X    (mprinc line) line))
X
X;; Insert something into the window buffer
X
X(defun minsert (string)
X  (if (stringp string)
X      (insert string)
X    (insert (prin1-to-string string))))
X
X;; Print something out, in window mode
X
X(defun mprinc (string)
X  (if (stringp string)
X      (insert string)
X    (insert (prin1-to-string string))))
X
X;; In window mode, keep screen from jumping by keeping last line at
X;; the bottom of the screen.
X
X(defun fix-screen ()
X  (interactive)
X  (forward-line (- 0 (- (window-height) 2 )))
X  (set-window-start (selected-window) (point))
X  (end-of-buffer))
X
X;; Insert something into the buffer, followed by newline.
X
X(defun minsertl (string)
X  (minsert string)
X  (minsert "\n"))
X
X;; Print something, followed by a newline.
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    obj-special
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)) obj-special)
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 obj-special)
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;; Is a string a member of a string list?
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;; Function to put objects in the treasure room.  Also prints current
X;; score to let user know he has scored.
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;; Load an encrypted file, and eval it.
X
X(defun load-d (filename)
X  (let (old-buffer 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      (condition-case nil
X      (dun-rot13)
X    (error (yank)))
X      (eval-current-buffer)
X      (kill-buffer (current-buffer))
X      (switch-to-buffer old-buffer))
X    result))
X
X;; Rotate the globals file, and save it for later loading.
X
X(defun compile-globals ()
X  (let
X    (switch-to-buffer (get-buffer-create "*compd*"))
X    (erase-buffer)
X    (insert-file-contents "dun-globals.el")
X    (dun-rot13)
X    (goto-char (point-min))
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;; Find the global data file.
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;; rotate current buffer 13 characters
X(let ((i 0) (lower "abcdefghijklmnopqrstuvwxyz") upper)
X  (setq translate-table (make-vector 256 0))
X  (while (< i 256)
X    (aset translate-table i i)
X    (setq i (1+ i)))
X  (setq lower (concat lower lower))
X  (setq upper (upcase lower))
X  (setq i 0)
X  (while (< i 26)
X    (aset translate-table (+ ?a i) (aref lower (+ i 13)))
X    (aset translate-table (+ ?A i) (aref upper (+ i 13)))
X      (setq i (1+ i))))
X
X(defun dun-rot13 ()
X  (let (str len (i 0))
X    (setq str (buffer-substring (point-min) (point-max)))
X    (setq len (length str))
X    (while (< i len)
X      (aset str i (aref translate-table (aref str i)))
X      (setq i (1+ i)))
X    (erase-buffer)
X    (insert str)))
END_OF_FILE
if test 7561 -ne `wc -c <'dun-util.el'`; then
    echo shar: \"'dun-util.el'\" unpacked with wrong size!
fi
chmod +x 'dun-util.el'
# 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.curdir' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'dunnet.curdir'\"
else
echo shar: Extracting \"'dunnet.curdir'\" \(61 characters\)
sed "s/^X//" >'dunnet.curdir' <<'END_OF_FILE'
X#! /bin/sh
X
X    emacs -batch -l `pwd`/dun-main -f batch-dungeon
END_OF_FILE
if test 61 -ne `wc -c <'dunnet.curdir'`; then
    echo shar: \"'dunnet.curdir'\" unpacked with wrong size!
fi
chmod +x 'dunnet.curdir'
# end of 'dunnet.curdir'
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'\" \(50 characters\)
sed "s/^X//" >'dunnet.window' <<'END_OF_FILE'
X#! /bin/sh
X
X    emacs -l dun-main -f dungeon-start
X
X
END_OF_FILE
if test 50 -ne `wc -c <'dunnet.window'`; then
    echo shar: \"'dunnet.window'\" unpacked with wrong size!
fi
chmod +x 'dunnet.window'
# end of 'dunnet.window'
fi
if test -f 'dunnet.window.curdir' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'dunnet.window.curdir'\"
else
echo shar: Extracting \"'dunnet.window.curdir'\" \(56 characters\)
sed "s/^X//" >'dunnet.window.curdir' <<'END_OF_FILE'
X#! /bin/sh
X
X    emacs -l `pwd`/dun-main -f dungeon-start
X
X
END_OF_FILE
if test 56 -ne `wc -c <'dunnet.window.curdir'`; then
    echo shar: \"'dunnet.window.curdir'\" unpacked with wrong size!
fi
chmod +x 'dunnet.window.curdir'
# end of 'dunnet.window.curdir'
fi
echo shar: End of archive 3 \(of 3\).
cp /dev/null ark3isdone
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