home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #16 / NN_1992_16.iso / spool / gnu / emacs / sources / 560 < prev    next >
Encoding:
Text File  |  1992-07-28  |  28.7 KB  |  1,046 lines
  1. Path: sparky!uunet!olivea!news.bbn.com!micro-heart-of-gold.mit.edu!mit-eddie!eddie.mit.edu!ronnie
  2. From: ronnie@eddie.mit.edu (Ron Schnell)
  3. Newsgroups: gnu.emacs.sources
  4. Subject: dunnet - text adventure for e-lisp (3/3)
  5. Message-ID: <1992Jul29.012500.19123@eddie.mit.edu>
  6. Date: 29 Jul 92 01:25:00 GMT
  7. Sender: news@eddie.mit.edu (Usenet News)
  8. Reply-To: ronnie@eddie.mit.edu (Ron Schnell)
  9. Organization: MIT EECS/ECF Facility, Cambridge Mass
  10. Lines: 1034
  11.  
  12. #! /bin/sh
  13. # This is a shell archive, meaning:
  14. # 1. Remove everything above the #! /bin/sh line.
  15. # 2. Save the resulting text in a file.
  16. # 3. Execute the file with /bin/sh (not csh) to create the files:
  17. #    dun-main.el
  18. #    dun-save.el
  19. #    dun-unix.el
  20. #    dun-util.el
  21. # This archive created: Tue Jul 28 14:48:24 1992
  22. export PATH; PATH=/bin:$PATH
  23. if test -f 'dun-main.el'
  24. then
  25.     echo shar: will not over-write existing file "'dun-main.el'"
  26. else
  27. cat << \SHAR_EOF > 'dun-main.el'
  28. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  29. ;                                                                      ;
  30. ;                       dunnet.el  Version 1.0                         ;
  31. ;                                                                      ;
  32. ;                   Ron Schnell (ronnie@eddie.mit.edu)                 ;
  33. ;                                                                      ;
  34. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  35.  
  36.  
  37. ;; This is the startup file.  It loads in the other files, and sets up
  38. ;; the functions to be bound to keys if you play in window-mode.
  39.  
  40. ;;;;;  The log file should be set for your system, and it must
  41. ;;;;;  be writeable by all.
  42.  
  43.       (setq log-file "/user0/rschnell/score/score") 
  44.  
  45. (defun dungeon-mode ()
  46.   "Major mode for running dungeon"
  47.   (interactive)
  48.   (text-mode)
  49.   (use-local-map dungeon-mode-map)
  50.   (setq major-mode 'dungeon-mode)
  51.   (setq mode-name "Dungeon")
  52. )
  53.  
  54. (defun dungeon-parse (arg)
  55.   "foo"
  56.   (interactive "*p")
  57.   (beginning-of-line)
  58.   (setq beg (+ (point) 1))
  59.   (end-of-line)
  60.   (if (and (not (= beg (point)))
  61.        (string= ">" (buffer-substring (- beg 1) beg)))
  62.       (progn
  63.     (setq line (downcase (buffer-substring beg (point))))
  64.     (princ line)
  65.     (if (eq (parse ignore verblist line) -1)
  66.         (mprinc "I don't understand that.\n")))
  67.     (goto-char (point-max))
  68.     (mprinc "\n"))
  69.     (dungeon-messages))
  70.     
  71. (defun dungeon-messages ()
  72.   (if dead
  73.       (text-mode)
  74.     (if (eq dungeon-mode 'dungeon)
  75.     (progn
  76.       (if (not (= room current-room))
  77.           (progn
  78.         (describe-room current-room)
  79.         (setq room current-room)))
  80.       (mprinc ">")))))
  81.  
  82. (defun dungeon-start ()
  83.   (interactive)
  84.   (switch-to-buffer "*dungeon*")
  85.   (dungeon-mode)
  86.   (setq dead nil)
  87.   (setq room 0)
  88.   (dungeon-messages))
  89.  
  90. (require 'cl)
  91.  
  92. (defun batch-dungeon ()
  93.   (setq load-path (append load-path (list ".")))
  94.   (load "dun-batch")
  95.   (setq visited '(27))
  96.   (mprinc "\n")
  97.   (dungeon-batch-loop))
  98.  
  99. (setq load-path (append load-path (list ".")))
  100.  
  101. (load "dun-commands")
  102. (load "dun-util")
  103. (if (setq glob (get-glob-dat))
  104.     (load-d glob)
  105.   (load "dun-globals"))
  106.  
  107. (load "dun-unix")
  108. (load "dun-save")
  109. (setq tloc (+ 60 (% (abs (random)) 18)))
  110. (replace room-objects tloc (append (nth tloc room-objects) (list 18)))
  111. (dungeon-start)
  112. SHAR_EOF
  113. fi # end of overwriting check
  114. if test -f 'dun-save.el'
  115. then
  116.     echo shar: will not over-write existing file "'dun-save.el'"
  117. else
  118. cat << \SHAR_EOF > 'dun-save.el'
  119.  
  120. ;;;;;;;;;;;;;;;;;;;
  121. ;
  122. ;
  123. ;  Save and restore
  124. ;
  125. ;
  126. ;;;;;;;;;;;;;;;;;;;
  127.  
  128. (defun save-game (filename)
  129.   (if (not (setq filename (car filename)))
  130.       (mprincl "You must supply a filename for the save.")
  131.     (if (file-exists-p filename)
  132.     (mprincl "File already exists.")
  133.       (setq numsaves (1+ numsaves))
  134.       (make-save-buffer)
  135.       (save-val "current-room")
  136.       (save-val "computer")
  137.       (save-val "door1")
  138.       (save-val "visited")
  139.       (save-val "diggables")
  140.       (save-val "key-level")
  141.       (save-val "numsaves")
  142.       (save-val "numcmds")
  143.       (save-val "logged-in")
  144.       (save-val "dungeon-mode")
  145.       (save-val "jar")
  146.       (save-val "lastdir")
  147.       (save-val "black")
  148.       (save-val "nomail")
  149.       (save-val "unix-verbs")
  150.       (save-val "hole")
  151.       (save-val "uncompressed")
  152.       (save-val "ethernet")
  153.       (save-val "sauna-level")
  154.       (save-val "room-objects")
  155.       (save-val "room-silents")
  156.       (save-val "inventory")
  157.       (save-val "endgame-question")
  158.       (save-val "endgame")
  159.       (save-val "endgame-questions")
  160.       (save-val "cdroom")
  161.       (save-val "cdpath")
  162.       (save-val "correct-answer")
  163.       (save-val "inbus")
  164.       (compile-save-out filename)
  165.       (do-logfile 'save nil)
  166.       (switch-to-buffer "*dungeon*")
  167.       (princ "")
  168.       (mprincl "Done."))))
  169.  
  170. (defun make-save-buffer ()
  171.   (switch-to-buffer (get-buffer-create "*save-dungeon*"))
  172.   (erase-buffer))
  173.  
  174. ;; If you don't have the crypt program, rename this function to
  175. ;; compile-save-out, and get rid of the next function.
  176.  
  177. (defun compile-save-out-nocrypt (filename)
  178.   (write-region 1 (point-max) filename nil 1)
  179.   (kill-buffer (current-buffer)))
  180.  
  181. (defun compile-save-out (filename)
  182.   (let (key dir ferror)
  183.     (setq ferror nil)
  184.     (if (< lastdir 10)
  185.     (setq dir (+ lastdir 10))
  186.       (setq dir lastdir))
  187.     (setq key (prin1-to-string dir))
  188.     (condition-case nil
  189.     (crypt-buffer key)
  190.       (error (setq ferror t)))
  191.     (if (not ferror)
  192.     (progn
  193.       (goto-char (point-min))
  194.       (insert key)))
  195.     (write-region 1 (point-max) filename nil 1)
  196.     (kill-buffer (current-buffer))))
  197.  
  198. (defun save-val (varname)
  199.   (let (value)
  200.     (setq varname (intern varname))
  201.     (setq value (eval varname))
  202.     (minsert "(setq ")
  203.     (minsert varname)
  204.     (minsert " ")
  205.     (if (or (listp value)
  206.         (symbolp value))
  207.     (minsert "'"))
  208.     (if (stringp value)
  209.     (minsert "\""))
  210.     (minsert value)
  211.     (if (stringp value)
  212.     (minsert "\""))
  213.     (minsertl ")")))
  214.  
  215.  
  216. ;; If you don't have the crypt program, rename this function to 'restore'
  217. ;; and get rid of the next function.
  218.  
  219. (defun restore-nocrypt (args)
  220.   (let (file ferrror)
  221.     (setq ferr nil)
  222.     (if (not (setq file (car args)))
  223.     (mprincl "You must supply a filename.")
  224.       (condition-case nil
  225.       (load-file file)
  226.     (error (setq ferror t)))
  227.       (if ferror
  228.       (mprinc "Could not load restore file.")
  229.     (mprincl "Done.")
  230.     (setq room 0)))))
  231.  
  232. (defun restore (args)
  233.   (let (file)
  234.     (if (not (setq file (car args)))
  235.     (mprincl "You must supply a filename.")
  236.       (if (not (load-d file))
  237.       (mprincl "Could not load restore file.")
  238.     (mprincl "Done.")
  239.     (setq room 0)))))
  240.  
  241.  
  242. (defun do-logfile (type how)
  243.   (let (ferror)
  244.     (setq ferror nil)
  245.     (switch-to-buffer (get-buffer-create "*score*"))
  246.     (erase-buffer)
  247.     (condition-case nil
  248.     (insert-file-contents log-file)
  249.       (error (setq ferror t)))
  250.     (unless ferror
  251.         (goto-char (point-max))
  252.         (minsert (user-login-name))
  253.         (minsert " ")
  254.         (if (eq type 'save)
  255.         (minsert "saved ")
  256.           (if (= (endgame-score) 110)
  257.           (minsert "won ")
  258.         (if (not how)
  259.             (minsert "quit ")
  260.           (minsert "killed by ")
  261.           (minsert how)
  262.           (minsert " "))))
  263.         (minsert "at ")
  264.         (minsert (cadr (nth (abs room) rooms)))
  265.         (minsert ". score: ")
  266.         (if (> (endgame-score) 0)
  267.         (minsert (setq newscore (+ 90 (endgame-score))))
  268.           (minsert (setq newscore (reg-score))))
  269.         (minsert " saves: ")
  270.         (minsert numsaves)
  271.         (minsert " commands: ")
  272.         (minsert numcmds)
  273.         (minsert "\n")
  274.         (write-region 1 (point-max) log-file nil 1))
  275.     (kill-buffer (current-buffer))))
  276. SHAR_EOF
  277. fi # end of overwriting check
  278. if test -f 'dun-unix.el'
  279. then
  280.     echo shar: will not over-write existing file "'dun-unix.el'"
  281. else
  282. cat << \SHAR_EOF > 'dun-unix.el'
  283. ;;;;;;;;;;;;;;;;;;;
  284. ;;;;
  285. ;;;; UNIX
  286. ;;;;
  287. ;;;;;;;;;;;;;;;;;;;
  288.  
  289. (defun unix-parse (args)
  290.   (interactive "*p")
  291.   (beginning-of-line)
  292.   (let (beg esign)
  293.     (setq beg (+ (point) 2))
  294.     (end-of-line)
  295.     (if (and (not (= beg (point)))
  296.          (string= "$" (buffer-substring (- beg 2) (- beg 1))))
  297.     (progn
  298.       (setq line (downcase (buffer-substring beg (point))))
  299.       (princ line)
  300.       (if (eq (parse2 nil unix-verbs line) -1)
  301.           (progn
  302.         (if (setq esign (string-match "=" line))
  303.             (doassign line)        
  304.           (mprinc (car line-list))
  305.           (mprincl ": not found.")))))
  306.       (goto-char (point-max))
  307.       (mprinc "\n"))
  308.     (if (eq dungeon-mode 'unix)
  309.     (mprinc "$ "))))
  310.  
  311. (defun doassign (line)
  312.   (if (not wizard)
  313.       (let (passwd)
  314.     (mprinc "Enter wizard password: ")
  315.     (setq passwd (read-line))
  316.     (if (not batch-mode)
  317.         (mprinc "\n"))
  318.     (if (string= passwd "moby")
  319.         (progn
  320.           (setq wizard t)
  321.           (doassign line))
  322.       (mprincl "Incorrect.")))
  323.  
  324.     (let (varname epoint afterq i value)
  325.       (setq varname (substring line 0 esign))
  326.       (if (not (setq epoint (string-match ")" line)))
  327.       (if (string= (substring line (1+ esign) (+ esign 2))
  328.                "\"")
  329.           (progn
  330.         (setq afterq (substring line (+ esign 2)))
  331.         (setq epoint (+
  332.                   (string-match "\"" afterq)
  333.                   (+ esign 3))))
  334.         
  335.         (if (not (setq epoint (string-match " " line)))
  336.         (setq epoint (length line))))
  337.     (setq epoint (1+ epoint))
  338.     (while (and
  339.         (not (= epoint (length line)))
  340.         (setq i (string-match ")" (substring line epoint))))
  341.       (setq epoint (+ epoint i 1))))
  342.       (setq value (substring line (1+ esign) epoint))
  343.       (dungeon-eval varname value))))
  344.  
  345. (defun dungeon-eval (varname value)
  346.   (let (eval-error)
  347.     (switch-to-buffer (get-buffer-create "*dungeon-eval*"))
  348.     (erase-buffer)
  349.     (insert "(setq ")
  350.     (insert varname)
  351.     (insert " ")
  352.     (insert value)
  353.     (insert ")")
  354.     (setq eval-error nil)
  355.     (condition-case nil
  356.     (eval-current-buffer)
  357.       (error (setq eval-error t)))
  358.     (kill-buffer (current-buffer))
  359.     (switch-to-buffer "*dungeon*")
  360.     (if eval-error
  361.     (mprincl "Invalid syntax."))))
  362.   
  363.  
  364. (defun unix-interface ()
  365.   (login)
  366.   (if logged-in
  367.       (progn
  368.     (setq dungeon-mode 'unix)
  369.     (define-key dungeon-mode-map "\r" 'unix-parse)
  370.     (mprinc "$ "))))
  371.  
  372.  
  373.  
  374. (defun login ()
  375.   (let (tries username password)
  376.     (setq tries 4)
  377.     (while (and (not logged-in) (> (setq tries (- tries 1)) 0))
  378.       (mprinc "\n\nUNIX System 5, Release 2.2 (pokey)\n\nlogin: ")
  379.       (setq username (read-line))
  380.       (if (not batch-mode)
  381.       (mprinc "\n"))
  382.       (mprinc "password: ")
  383.       (setq password (read-line))
  384.       (if (not batch-mode)
  385.       (mprinc "\n"))
  386.       (if (or (not (string= username "toukmond"))
  387.           (not (string= password "robert")))
  388.       (mprincl "login incorrect")
  389.     (setq logged-in t)
  390.     (mprincl "
  391. Welcome to Unix\n
  392. Please clean up your directories.  The filesystem is getting full.
  393. Our tcp/ip link to gamma is a little flakey, but seems to work.
  394. The current version of ftp can only send files from the current
  395. directory, and deletes them after they are sent!  Be careful.
  396.  
  397. Note: Restricted bourne shell in use.\n")))
  398.   (setq dungeon-mode 'dungeon)))
  399.  
  400. (defun ls (args)
  401.   (if (car args)
  402.       (let (ocdpath ocdroom)
  403.     (setq ocdpath cdpath)
  404.     (setq ocdroom cdroom)
  405.     (if (not (eq (cd args) -2))
  406.         (ls nil))
  407.     (setq cdpath ocdpath)
  408.     (setq cdroom ocdroom))
  409.     (if (= cdroom -10)
  410.     (ls-inven))
  411.     (if (= cdroom -2)
  412.     (ls-rooms))
  413.     (if (= cdroom -3)
  414.     (ls-root))
  415.     (if (= cdroom -4)
  416.     (ls-usr))
  417.     (if (> cdroom 0)
  418.     (ls-room))))
  419.  
  420. (defun ls-root ()
  421.   (mprincl "total 4
  422. drwxr-xr-x  3 root     staff           512 Jan 1 1970 .
  423. drwxr-xr-x  3 root     staff          2048 Jan 1 1970 ..
  424. drwxr-xr-x  3 root     staff          2048 Jan 1 1970 usr
  425. drwxr-xr-x  3 root     staff          2048 Jan 1 1970 rooms"))
  426.  
  427. (defun ls-usr ()
  428.   (mprincl "total 4
  429. drwxr-xr-x  3 root     staff           512 Jan 1 1970 .
  430. drwxr-xr-x  3 root     staff          2048 Jan 1 1970 ..
  431. drwxr-xr-x  3 toukmond restricted      512 Jan 1 1970 toukmond"))
  432.  
  433. (defun ls-rooms ()
  434.   (mprincl "total 16
  435. drwxr-xr-x  3 root     staff           512 Jan 1 1970 .
  436. drwxr-xr-x  3 root     staff          2048 Jan 1 1970 ..")
  437.   (dolist (x visited)
  438.     (mprinc
  439. "drwxr-xr-x  3 root     staff           512 Jan 1 1970 ")
  440.     (mprincl (nth x room-shorts))))
  441.  
  442. (defun ls-room ()
  443.   (mprincl "total 4
  444. drwxr-xr-x  3 root     staff           512 Jan 1 1970 .
  445. drwxr-xr-x  3 root     staff          2048 Jan 1 1970 ..
  446. -rwxr-xr-x  3 root     staff          2048 Jan 1 1970 description")
  447.   (dolist (x (nth cdroom room-objects))
  448.     (if (and (>= x 0) (not (= x 255)))
  449.     (progn
  450.       (mprinc "-rwxr-xr-x  1 toukmond restricted        0 Jan 1 1970 ")
  451.       (mprincl (nth x objfiles))))))
  452.  
  453. (defun ls-inven ()
  454.   (mprinc "total 467
  455. drwxr-xr-x  3 toukmond restricted      512 Jan 1 1970 .
  456. drwxr-xr-x  3 root     staff          2048 Jan 1 1970 ..")
  457.   (dolist (x unix-verbs)
  458.     (if (not (eq (car x) 'IMPOSSIBLE))
  459.     (progn
  460.       (mprinc"
  461. -rwxr-xr-x  1 toukmond restricted    10423 Jan 1 1970 ")
  462.       (mprinc (car x)))))
  463.   (mprinc "\n")
  464.   (if (not uncompressed)
  465.       (mprincl
  466. "-rwxr-xr-x  1 toukmond restricted        0 Jan 1 1970 paper.o.Z"))
  467.   (dolist (x inventory)
  468.     (mprinc 
  469. "-rwxr-xr-x  1 toukmond restricted        0 Jan 1 1970 ")
  470.     (mprincl (nth x objfiles))))
  471.  
  472. (defun echo (args)
  473.   (let (nomore var)
  474.     (setq nomore nil)
  475.     (dolist (x args)
  476.         (if (not nomore)
  477.         (progn
  478.           (if (not (string= (substring x 0 1) "$"))
  479.               (progn
  480.             (mprinc x)
  481.             (mprinc " "))
  482.             (setq var (intern (substring x 1)))
  483.             (if (not (boundp var))
  484.             (mprinc " ")
  485.               (if (member var restricted)
  486.               (progn
  487.                 (mprinc var)
  488.                 (mprinc ": Permission denied")
  489.                 (setq nomore t))
  490.             (eval (list 'mprinc var))
  491.             (mprinc " ")))))))
  492.         (mprinc "\n")))
  493.  
  494.  
  495. (defun ftp (args)
  496.   (let (host username passwd)
  497.     (if (not (car args))
  498.     (mprincl "ftp: hostname required on command line.")
  499.       (setq host (intern (car args)))
  500.       (if (not (member host '(gamma endgame)))
  501.       (mprincl "ftp: Unknown host.")
  502.     (if (eq host 'endgame)
  503.         (mprincl "ftp: connection to endgame not allowed")
  504.       (if (not ethernet)
  505.           (mprincl "ftp: host not responding.")
  506.         (mprincl "Connected to gamma. FTP ver 0.9 00:00:00 01/01/70")
  507.         (mprinc "Username: ")
  508.         (setq username (read-line))
  509.         (if (string= username "toukmond")
  510.         (if batch-mode
  511.             (mprincl "toukmond ftp access not allowed.")
  512.           (mprincl "\ntoukmond ftp access not allowed."))
  513.           (if (string= username "anonymous")
  514.           (if batch-mode
  515.               (mprincl
  516.                "Guest login okay, send your user ident as password.")
  517.             (mprincl 
  518.              "\nGuest login okay, send your user ident as password."))
  519.         (if batch-mode
  520.             (mprinc "Password required for ")
  521.           (mprinc "\nPassword required for "))
  522.         (mprincl username))
  523.           (mprinc "Password: ")
  524.           (setq ident (read-line))
  525.           (if (not (string= username "anonymous"))
  526.           (if batch-mode
  527.               (mprincl "Login failed.")
  528.             (mprincl "\nLogin failed."))
  529.         (if batch-mode
  530.            (mprincl "Guest login okay, user access restrictions apply.")
  531.           (mprincl "\nGuest login okay, user access restrictions apply."))
  532.         (ftp-commands)
  533.         (setq newlist 
  534. '("What password did you use during anonymous ftp to gamma?"))
  535.         (setq newlist (append newlist (list ident)))
  536.         (rplaca (nthcdr 1 endgame-questions) newlist)))))))))
  537.   
  538. (defun ftp-commands ()
  539.   (setq exitf nil)
  540.   (let (line)
  541.     (while (not exitf)
  542.       (mprinc "ftp> ")
  543.       (setq line (read-line))
  544.       (if 
  545.       (eq
  546.        (parse2 nil 
  547.          '((type . ftptype) (binary . bin) (bin . bin) (send . send)
  548.            (put . send) (quit . ftpquit) (help . ftphelp)
  549.            (ascii . fascii)
  550.          ) line)
  551.      -1)
  552.       (mprincl "No such command.  Try help.")))
  553.     (setq ftptype 'ascii)))
  554.  
  555. (defun ftptype (args)
  556.   (if (not (car args))
  557.       (mprincl "Usage: type [binary | ascii]")
  558.     (setq args (intern (car args)))
  559.     (if (eq args 'binary)
  560.     (bin nil)
  561.       (if (eq args 'ascii)
  562.       (fascii 'nil)
  563.     (mprincl "Unknown type.")))))
  564.  
  565. (defun bin (args)
  566.   (mprincl "Type set to binary.")
  567.   (setq ftptype 'binary))
  568.  
  569. (defun fascii (args)
  570.   (mprincl "Type set to ascii.")
  571.   (setq ftptype 'ascii))
  572.  
  573. (defun ftpquit (args)
  574.   (setq exitf t))
  575.  
  576. (defun send (args)
  577.   (if (not (car args))
  578.       (mprincl "Usage: send <filename>")
  579.     (setq args (car args))
  580.     (let (counter foo)
  581.       (setq foo nil)
  582.       (setq counter 0)
  583.  
  584. ;;; User can send commands!  Stupid user.
  585.  
  586.  
  587.       (if (assq (intern args) unix-verbs)
  588.       (progn
  589.         (rplaca (assq (intern args) unix-verbs) 'IMPOSSIBLE)
  590.         (mprinc "Sending ")
  591.         (mprinc ftptype)
  592.         (mprinc " file for ")
  593.         (mprincl args)
  594.         (mprincl "Transfer complete."))
  595.  
  596.     (dolist (x objfiles)
  597.       (if (string= args x)
  598.           (progn
  599.         (if (not (member counter inventory))
  600.             (progn
  601.               (mprincl "No such file.")
  602.               (setq foo t))
  603.           (mprinc "Sending ")
  604.           (mprinc ftptype)
  605.           (mprinc " file for ")
  606.           (mprinc (downcase (cadr (nth counter objects))))
  607.           (mprincl ", (0 bytes)")
  608.           (if (not (eq ftptype 'binary))
  609.               (progn
  610.             (if (not (member -6 (nth 12 room-objects)))
  611.                 (replace room-objects 12
  612.                      (append (nth 12 room-objects) (list -6))))
  613.             (remove-obj-from-inven counter))
  614.             (remove-obj-from-inven counter)
  615.             (replace room-objects 12
  616.                  (append (nth 12 room-objects) (list counter))))
  617.           (setq foo t)
  618.           (mprincl "Transfer complete."))))
  619.       (setq counter (+ 1 counter)))
  620.     (if (not foo)
  621.         (mprincl "No such file."))))))
  622.  
  623. (defun ftphelp (args)
  624.   (mprincl 
  625.    "Possible commands are:\nsend    quit    type   ascii  binary   help"))
  626.  
  627. (defun uexit (args)
  628.   (setq dungeon-mode 'dungeon)
  629.   (mprincl "\nYou step back from the console.")
  630.   (define-key dungeon-mode-map "\r" 'dungeon-parse)
  631.   (if (not batch-mode)
  632.       (dungeon-messages)))
  633.  
  634. (defun pwd (args)
  635.   (mprincl cdpath))
  636.  
  637. (defun uncompress (args)
  638.   (if (not (car args))
  639.       (mprincl "Usage: uncompress <filename>")
  640.     (setq args (car args))
  641.     (if (or uncompressed
  642.         (and (not (string= args "paper.o"))
  643.          (not (string= args "paper.o.z"))))
  644.     (mprincl "Uncompress command failed.")
  645.       (setq uncompressed t)
  646.       (setq inventory (append inventory (list 5))))))
  647.  
  648. (defun rlogin (args)
  649.   (if (not (car args))
  650.       (mprincl "Usage: rlogin <hostname>")
  651.     (setq args (car args))
  652.     (if (string= args "endgame")
  653.     (rlogin-endgame)
  654.       (if (not (string= args "gamma"))
  655.       (mprincl "No such host.")
  656.     (if (not ethernet)
  657.         (mprincl "Host not responding.")
  658.       (mprinc "Password: ")
  659.       (setq passwd (read-line))
  660.       (if (not (string= passwd "worms"))
  661.           (mprincl "\nlogin incorrect")
  662.         (mprinc 
  663. "\nYou begin to feel strange for a moment, and you lose your items."
  664.          )
  665.         (replace room-objects 10 (append (nth 0 room-objects) inventory))
  666.         (setq inventory nil)
  667.         (setq current-room 12)
  668.         (uexit nil)))))))
  669.   
  670. (defun cd (args)
  671.   (if (not (car args))
  672.       (mprincl "Usage: cd <path>")
  673.     (setq tcdpath cdpath)
  674.     (setq tcdroom cdroom)
  675.     (setq badcd nil)
  676.     (condition-case nil
  677.     (setq path-elements (get-path (car args) nil))
  678.       (error (mprincl "Invalid path.")
  679.          (setq badcd t)))
  680.     (dolist (pe path-elements)
  681.       (unless badcd
  682.       (if (not (string= pe "."))
  683.       (if (string= pe "..")
  684.           (progn
  685.         (if (> tcdroom 0)                       ;In a room
  686.             (progn
  687.               (setq tcdpath "/rooms")
  688.               (setq tcdroom -2))
  689.                     ;In /rooms,/usr,root
  690.           (if (or (= tcdroom -2) (= tcdroom -4) (= tcdroom -3))
  691.               (progn
  692.             (setq tcdpath "/")
  693.             (setq tcdroom -3))
  694.             (if (= tcdroom -10)                  ;In /usr/toukmond
  695.             (progn
  696.               (setq tcdpath "/usr")
  697.               (setq tcdroom -4))))))
  698.         (if (string= pe "/")
  699.         (progn
  700.           (setq tcdpath "/")
  701.           (setq tcdroom -3))
  702.           (if (= tcdroom -4)
  703.           (if (string= pe "toukmond")
  704.               (progn
  705.             (setq tcdpath "/usr/toukmond")
  706.             (setq tcdroom -10))
  707.             (nosuchdir))
  708.         (if (= tcdroom -10)
  709.             (nosuchdir)
  710.           (if (> tcdroom 0)
  711.               (nosuchdir)
  712.             (if (= tcdroom -3)
  713.             (progn
  714.               (if (string= pe "rooms")
  715.                   (progn
  716.                 (setq tcdpath "/rooms")
  717.                 (setq tcdroom -2))
  718.                 (if (string= pe "usr")
  719.                 (progn
  720.                   (setq tcdpath "/usr")
  721.                   (setq tcdroom -4))
  722.                   (nosuchdir))))
  723.               (if (= tcdroom -2)
  724.               (progn
  725.                 (dolist (x visited)
  726.                   (setq room-check (nth x room-shorts))
  727.                   (if (string= room-check pe)
  728.                   (progn
  729.                     (setq tcdpath 
  730.                       (concat "/rooms/" room-check))
  731.                     (setq tcdroom x))))
  732.                 (if (= tcdroom -2)
  733.                 (nosuchdir)))))))))))))
  734.     (if (not badcd)
  735.     (progn
  736.       (setq cdpath tcdpath)
  737.       (setq cdroom tcdroom)
  738.       0)
  739.       -2)))
  740.  
  741. (defun nosuchdir ()
  742.   (mprincl "No such directory.")
  743.   (setq badcd t))
  744.  
  745. (defun cat (args)
  746.   (if (not (setq args (car args)))
  747.       (mprincl "Usage: cat <ascii-file-name>")
  748.     (if (string-match "/" args)
  749.     (mprincl "cat: only files in current directory allowed.")
  750.       (if (and (> cdroom 0) (string= args "description"))
  751.       (mprincl (car (nth cdroom rooms)))
  752.     (if (setq doto (string-match "\\.o" args))
  753.         (progn
  754.           (if (= cdroom -10)
  755.           (setq checklist inventory)
  756.         (setq checklist (nth cdroom room-objects)))
  757.           (if (not (member (cdr 
  758.                (assq (intern (substring args 0 doto)) objnames))
  759.                    checklist))
  760.           (mprincl "File not found.")
  761.         (mprincl "Ascii files only.")))
  762.       (if (assq (intern args) unix-verbs)
  763.           (mprincl "Ascii files only.")
  764.         (mprincl "File not found.")))))))
  765.   
  766. (defun zippy (args)
  767.   (mprincl (yow)))
  768.  
  769. (defun rlogin-endgame ()
  770.   (if (not (= (score nil) 90))
  771.       (mprincl "You have not achieved enough points to connect to endgame.")
  772.     (mprincl"\nWelcome to the endgame.  You are a truly noble adventurer.")
  773.     (setq current-room 0)
  774.     (setq endgame t)
  775.     (replace room-objects 102 '(26))
  776.     (uexit nil)))
  777. SHAR_EOF
  778. fi # end of overwriting check
  779. if test -f 'dun-util.el'
  780. then
  781.     echo shar: will not over-write existing file "'dun-util.el'"
  782. else
  783. cat << \SHAR_EOF > 'dun-util.el'
  784. (require 'cl)
  785.  
  786. ;;;;;;;;;;;;;;;;;;;;; Utility functions
  787.  
  788. ;;; Function which takes a verb and a list of other words.  Calls proper
  789. ;;; function associated with the verb, and passes along the other words.
  790.  
  791. (defun doverb (ignore verblist verb rest)
  792.   (if (not verb)
  793.       nil
  794.     (if (member (intern verb) ignore)
  795.     (if (not (car rest)) -1
  796.       (doverb ignore verblist (car rest) (cdr rest)))
  797.       (if (not (cdr (assq (intern verb) verblist))) -1
  798.     (setq numcmds (1+ numcmds))
  799.     (eval (list (cdr (assq (intern verb) verblist)) (quote rest)))))))
  800.  
  801.  
  802. ;;; Function to take a string and change it into a list of lowercase words.
  803.  
  804. (defun listify-string (strin)
  805.   (let (pos ret-list end-pos)
  806.     (setq pos 0)
  807.     (setq ret-list nil)
  808.     (while (setq end-pos (string-match "[ ,:;]" (substring strin pos)))
  809.       (setq end-pos (+ end-pos pos))
  810.       (if (not (= end-pos pos))
  811.       (setq ret-list (append ret-list (list 
  812.                        (downcase
  813.                         (substring strin pos end-pos))))))
  814.       (setq pos (+ end-pos 1))) ret-list))
  815.  
  816. (defun listify-string2 (strin)
  817.   (let (pos ret-list end-pos)
  818.     (setq pos 0)
  819.     (setq ret-list nil)
  820.     (while (setq end-pos (string-match " " (substring strin pos)))
  821.       (setq end-pos (+ end-pos pos))
  822.       (if (not (= end-pos pos))
  823.       (setq ret-list (append ret-list (list 
  824.                        (downcase
  825.                         (substring strin pos end-pos))))))
  826.       (setq pos (+ end-pos 1))) ret-list))
  827.  
  828. (defun replace (list n number)
  829.   (rplaca (nthcdr n list) number))
  830.  
  831.  
  832. ;;; Get the first non-ignored word from a list.
  833.  
  834. (defun firstword (list)
  835.   (if (not (car list))
  836.       nil
  837.     (while (and list (member (intern (car list)) ignore))
  838.       (setq list (cdr list)))
  839.     (car list)))
  840.  
  841. (defun firstwordl (list)
  842.   (if (not (car list))
  843.       nil
  844.     (while (and list (member (intern (car list)) ignore))
  845.       (setq list (cdr list)))
  846.     list))
  847.  
  848. ;; parse a line passed in as a string  Call the proper verb with the
  849. ;; rest of the line passed in as a list.
  850.  
  851. (defun parse (ignore verblist line)
  852.   (mprinc "\n")
  853.   (setq line-list (listify-string (concat line " ")))
  854.   (doverb ignore verblist (car line-list) (cdr line-list)))
  855.  
  856. (defun parse2 (ignore verblist line)
  857.   (mprinc "\n")
  858.   (setq line-list (listify-string2 (concat line " ")))
  859.   (doverb ignore verblist (car line-list) (cdr line-list)))
  860.  
  861. (defun read-line ()
  862.   (let (line)
  863.     (setq line (read-string ""))
  864.     (mprinc line) line))
  865.  
  866. (defun minsert (string)
  867.   (if (stringp string)
  868.       (insert string)
  869.     (insert (prin1-to-string string))))
  870.  
  871. (defun mprinc (string)
  872.   (if (stringp string)
  873.       (insert string)
  874.     (insert (prin1-to-string string))))
  875.  
  876. (defun minsertl (string)
  877.   (minsert string)
  878.   (minsert "\n"))
  879.  
  880. (defun mprincl (string)
  881.   (mprinc string)
  882.   (mprinc "\n"))
  883.  
  884. ;;;; Function which will get an object number given the list of
  885. ;;;; words in the command, except for the verb.
  886.  
  887. (defun objnum-from-args (obj)
  888.   (let (objnum)
  889.     (setq obj (firstword obj))
  890.     (if (not obj)
  891.     255
  892.       (setq objnum (cdr (assq (intern obj) objnames))))))
  893.  
  894. (defun objnum-from-args-std (obj)
  895.   (let (result)
  896.   (if (eq (setq result (objnum-from-args obj)) 255)
  897.       (mprincl "You must supply an object."))
  898.   (if (eq result nil)
  899.       (mprincl "I don't know what that is."))
  900.   (if (eq result 255)
  901.       nil
  902.     result)))
  903.  
  904. ;; Take a short room description, and change spaces and slashes to dashes.
  905.  
  906. (defun space-to-hyphen (string)
  907.   (let (space)
  908.     (if (setq space (string-match "[ /]" string))
  909.     (progn
  910.       (setq string (concat (substring string 0 space) "-"
  911.                    (substring string (1+ space))))
  912.       (space-to-hyphen string))
  913.       string)))
  914.  
  915. ;; Given a unix style pathname, build a list of path components (recursive)
  916.  
  917. (defun get-path (dirstring startlist)
  918.   (let (slash pos)
  919.     (if (= (length dirstring) 0)
  920.     startlist
  921.       (if (string= (substring dirstring 0 1) "/")
  922.       (get-path (substring dirstring 1) (append startlist (list "/")))
  923.     (if (not (setq slash (string-match "/" dirstring)))
  924.         (append startlist (list dirstring))
  925.       (get-path (substring dirstring (1+ slash))
  926.             (append startlist
  927.                 (list (substring dirstring 0 slash)))))))))
  928.  
  929.  
  930. (defun members (string string-list)
  931.   (let (found)
  932.     (setq found nil)
  933.     (dolist (x string-list)
  934.       (if (string= x string)
  935.       (setq found t))) found))
  936.  
  937. (defun put-objs-in-treas (objlist)
  938.   (let (oscore newscore)
  939.     (setq oscore (reg-score))
  940.     (replace room-objects 0 (append (nth 0 room-objects) objlist))
  941.     (setq newscore (reg-score))
  942.     (if (not (= oscore newscore))
  943.     (score nil))))
  944.  
  945. (defun load-d (filename)
  946.   (let (old-buffer key result)
  947.     (setq result t)
  948.     (setq old-buffer (current-buffer))
  949.     (switch-to-buffer (get-buffer-create "*loadc*"))
  950.     (erase-buffer)
  951.     (condition-case nil
  952.     (insert-file-contents filename)
  953.       (error (setq result nil)))
  954.     (unless (not result)
  955.         (setq key (buffer-substring (point-min) (+ (point-min) 2)))
  956.         (delete-char 2 t)
  957.         (condition-case nil
  958.         (crypt-buffer key)
  959.           (error (yank)))
  960.         (eval-current-buffer)
  961.         (kill-buffer (current-buffer))
  962.         (switch-to-buffer old-buffer))
  963.     result))
  964.  
  965. (defun compile-globals ()
  966.   (switch-to-buffer (get-buffer-create "*compd*"))
  967.   (erase-buffer)
  968.   (insert-file-contents "dun-globals.el")
  969.   (setq key (concat (prin1-to-string (% (abs (random)) 9))
  970.             (prin1-to-string (% (abs (random)) 9))))
  971.   (crypt-buffer key)
  972.   (goto-char (point-min))
  973.   (insert key)
  974.   (write-region 1 (point-max) "dun-globals.dat")
  975.   (kill-buffer (current-buffer)))
  976.  
  977. ;; Functions to remove an object either from a room, or from inventory.
  978.  
  979. (defun remove-obj-from-room (room objnum)
  980.   (let (newroom)
  981.     (setq newroom nil)
  982.     (dolist (x (nth room room-objects))
  983.       (if (not (= x objnum))
  984.       (setq newroom (append newroom (list x)))))
  985.     (rplaca (nthcdr room room-objects) newroom)))
  986.  
  987. (defun remove-obj-from-inven (objnum)
  988.   (let (new-inven)
  989.     (setq new-inven nil)
  990.     (dolist (x inventory)
  991.       (if (not (= x objnum))
  992.       (setq new-inven (append new-inven (list x)))))
  993.     (setq inventory new-inven)))
  994.  
  995. (defun get-glob-dat ()
  996.   (let (result)
  997.     (setq result nil)
  998.     (dolist (x load-path)
  999.         (if (file-exists-p (concat x "/dun-globals.dat"))
  1000.         (setq result (concat x "/dun-globals.dat"))))
  1001.     result))
  1002.  
  1003. ;;;
  1004. ;;; This is a small part copied from crypt.el by kyle@cs.odu.edu, with
  1005. ;;; a small change.
  1006.  
  1007.  
  1008. ;;; Compaction, compression and encryption for GNU Emacs
  1009. ;;; Copyright (C) 1988, 1989, 1990 Kyle E. Jones
  1010. ;;;
  1011. ;;; This program is free software; you can redistribute it and/or modify
  1012. ;;; it under the terms of the GNU General Public License as published by
  1013. ;;; the Free Software Foundation; either version 1, or (at your option)
  1014. ;;; any later version.
  1015. ;;;
  1016. ;;; This program is distributed in the hope that it will be useful,
  1017. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  1018. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  1019. ;;; GNU General Public License for more details.
  1020. ;;;
  1021. ;;; A copy of the GNU General Public License can be obtained from this
  1022. ;;; program's author (send electronic mail to kyle@cs.odu.edu) or from
  1023. ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
  1024. ;;; 02139, USA.
  1025. ;;;
  1026. ;;; Send bug reports to kyle@cs.odu.edu.
  1027.  
  1028. ;;; Changes for dungeon - 
  1029. ;;; ronnie@eddie.mit.edu - changed shell to use /bin/sh explicitly.
  1030. ;;;                        Otherwise user's 'rc' file might produce
  1031. ;;;                        output that gets stuffed into buffer.
  1032.  
  1033. (defun crypt-region (start end key)
  1034.    (let ((opoint-max (point-max)))
  1035.      (call-process-region start end "/bin/sh" t t nil "-c"
  1036.               (concat "crypt \"" key "\""))
  1037.      (if (not (= opoint-max (point-max)))
  1038.      (error "crypt command failed!"))))
  1039.  
  1040. (defun crypt-buffer (key &optional buffer)
  1041.   (crypt-region (point-min) (point-max) key))
  1042. SHAR_EOF
  1043. fi # end of overwriting check
  1044. #    End of shell archive
  1045. exit 0
  1046.