home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / games / dunnet / dun-unix.el < prev    next >
Encoding:
Text File  |  1993-06-27  |  14.0 KB  |  511 lines
  1. ;;;;;;;;;;;;;;;;;;;
  2. ;;;;
  3. ;;;; UNIX
  4. ;;;;
  5. ;;;;;;;;;;;;;;;;;;;
  6.  
  7. (if nil
  8.     (eval-and-compile (setq byte-compile-warnings nil)))
  9.  
  10. (defun unix-parse (args)
  11.   (interactive "*p")
  12.   (beginning-of-line)
  13.   (let (beg esign)
  14.     (setq beg (+ (point) 2))
  15.     (end-of-line)
  16.     (if (and (not (= beg (point)))
  17.          (string= "$" (buffer-substring (- beg 2) (- beg 1))))
  18.     (progn
  19.       (setq line (downcase (buffer-substring beg (point))))
  20.       (princ line)
  21.       (if (eq (parse2 nil unix-verbs line) -1)
  22.           (progn
  23.         (if (setq esign (string-match "=" line))
  24.             (doassign line esign)        
  25.           (mprinc (car line-list))
  26.           (mprincl ": not found.")))))
  27.       (goto-char (point-max))
  28.       (mprinc "\n"))
  29.     (if (eq dungeon-mode 'unix)
  30.     (progn
  31.       (fix-screen)
  32.       (mprinc "$ ")))))
  33.  
  34. (defun doassign (line esign)
  35.   (if (not wizard)
  36.       (let (passwd)
  37.     (mprinc "Enter wizard password: ")
  38.     (setq passwd (read-line))
  39.     (if (not batch-mode)
  40.         (mprinc "\n"))
  41.     (if (string= passwd "moby")
  42.         (progn
  43.           (setq wizard t)
  44.           (doassign line esign))
  45.       (mprincl "Incorrect.")))
  46.  
  47.     (let (varname epoint afterq i value)
  48.       (setq varname (substring line 0 esign))
  49.       (if (not (setq epoint (string-match ")" line)))
  50.       (if (string= (substring line (1+ esign) (+ esign 2))
  51.                "\"")
  52.           (progn
  53.         (setq afterq (substring line (+ esign 2)))
  54.         (setq epoint (+
  55.                   (string-match "\"" afterq)
  56.                   (+ esign 3))))
  57.         
  58.         (if (not (setq epoint (string-match " " line)))
  59.         (setq epoint (length line))))
  60.     (setq epoint (1+ epoint))
  61.     (while (and
  62.         (not (= epoint (length line)))
  63.         (setq i (string-match ")" (substring line epoint))))
  64.       (setq epoint (+ epoint i 1))))
  65.       (setq value (substring line (1+ esign) epoint))
  66.       (dungeon-eval varname value))))
  67.  
  68. (defun dungeon-eval (varname value)
  69.   (let (eval-error)
  70.     (switch-to-buffer (get-buffer-create "*dungeon-eval*"))
  71.     (erase-buffer)
  72.     (insert "(setq ")
  73.     (insert varname)
  74.     (insert " ")
  75.     (insert value)
  76.     (insert ")")
  77.     (setq eval-error nil)
  78.     (condition-case nil
  79.     (eval-current-buffer)
  80.       (error (setq eval-error t)))
  81.     (kill-buffer (current-buffer))
  82.     (switch-to-buffer "*dungeon*")
  83.     (if eval-error
  84.     (mprincl "Invalid syntax."))))
  85.   
  86.  
  87. (defun unix-interface ()
  88.   (login)
  89.   (if logged-in
  90.       (progn
  91.     (setq dungeon-mode 'unix)
  92.     (define-key dungeon-mode-map "\r" 'unix-parse)
  93.     (mprinc "$ "))))
  94.  
  95.  
  96.  
  97. (defun login ()
  98.   (let (tries username password)
  99.     (setq tries 4)
  100.     (while (and (not logged-in) (> (setq tries (- tries 1)) 0))
  101.       (mprinc "\n\nUNIX System V, Release 2.2 (pokey)\n\nlogin: ")
  102.       (setq username (read-line))
  103.       (if (not batch-mode)
  104.       (mprinc "\n"))
  105.       (mprinc "password: ")
  106.       (setq password (read-line))
  107.       (if (not batch-mode)
  108.       (mprinc "\n"))
  109.       (if (or (not (string= username "toukmond"))
  110.           (not (string= password "robert")))
  111.       (mprincl "login incorrect")
  112.     (setq logged-in t)
  113.     (mprincl "
  114. Welcome to Unix\n
  115. Please clean up your directories.  The filesystem is getting full.
  116. Our tcp/ip link to gamma is a little flakey, but seems to work.
  117. The current version of ftp can only send files from the current
  118. directory, and deletes them after they are sent!  Be careful.
  119.  
  120. Note: Restricted bourne shell in use.\n")))
  121.   (setq dungeon-mode 'dungeon)))
  122.  
  123. (defun ls (args)
  124.   (if (car args)
  125.       (let (ocdpath ocdroom)
  126.     (setq ocdpath cdpath)
  127.     (setq ocdroom cdroom)
  128.     (if (not (eq (dunnet-cd args) -2))
  129.         (ls nil))
  130.     (setq cdpath ocdpath)
  131.     (setq cdroom ocdroom))
  132.     (if (= cdroom -10)
  133.     (ls-inven))
  134.     (if (= cdroom -2)
  135.     (ls-rooms))
  136.     (if (= cdroom -3)
  137.     (ls-root))
  138.     (if (= cdroom -4)
  139.     (ls-usr))
  140.     (if (> cdroom 0)
  141.     (ls-room))))
  142.  
  143. (defun ls-root ()
  144.   (mprincl "total 4
  145. drwxr-xr-x  3 root     staff           512 Jan 1 1970 .
  146. drwxr-xr-x  3 root     staff          2048 Jan 1 1970 ..
  147. drwxr-xr-x  3 root     staff          2048 Jan 1 1970 usr
  148. drwxr-xr-x  3 root     staff          2048 Jan 1 1970 rooms"))
  149.  
  150. (defun ls-usr ()
  151.   (mprincl "total 4
  152. drwxr-xr-x  3 root     staff           512 Jan 1 1970 .
  153. drwxr-xr-x  3 root     staff          2048 Jan 1 1970 ..
  154. drwxr-xr-x  3 toukmond restricted      512 Jan 1 1970 toukmond"))
  155.  
  156. (defun ls-rooms ()
  157.   (mprincl "total 16
  158. drwxr-xr-x  3 root     staff           512 Jan 1 1970 .
  159. drwxr-xr-x  3 root     staff          2048 Jan 1 1970 ..")
  160.   (dolist (x visited)
  161.     (mprinc
  162. "drwxr-xr-x  3 root     staff           512 Jan 1 1970 ")
  163.     (mprincl (nth x room-shorts))))
  164.  
  165. (defun ls-room ()
  166.   (mprincl "total 4
  167. drwxr-xr-x  3 root     staff           512 Jan 1 1970 .
  168. drwxr-xr-x  3 root     staff          2048 Jan 1 1970 ..
  169. -rwxr-xr-x  3 root     staff          2048 Jan 1 1970 description")
  170.   (dolist (x (nth cdroom room-objects))
  171.     (if (and (>= x 0) (not (= x 255)))
  172.     (progn
  173.       (mprinc "-rwxr-xr-x  1 toukmond restricted        0 Jan 1 1970 ")
  174.       (mprincl (nth x objfiles))))))
  175.  
  176. (defun ls-inven ()
  177.   (mprinc "total 467
  178. drwxr-xr-x  3 toukmond restricted      512 Jan 1 1970 .
  179. drwxr-xr-x  3 root     staff          2048 Jan 1 1970 ..")
  180.   (dolist (x unix-verbs)
  181.     (if (not (eq (car x) 'IMPOSSIBLE))
  182.     (progn
  183.       (mprinc"
  184. -rwxr-xr-x  1 toukmond restricted    10423 Jan 1 1970 ")
  185.       (mprinc (car x)))))
  186.   (mprinc "\n")
  187.   (if (not uncompressed)
  188.       (mprincl
  189. "-rwxr-xr-x  1 toukmond restricted        0 Jan 1 1970 paper.o.Z"))
  190.   (dolist (x inventory)
  191.     (mprinc 
  192. "-rwxr-xr-x  1 toukmond restricted        0 Jan 1 1970 ")
  193.     (mprincl (nth x objfiles))))
  194.  
  195. (defun echo (args)
  196.   (let (nomore var)
  197.     (setq nomore nil)
  198.     (dolist (x args)
  199.         (if (not nomore)
  200.         (progn
  201.           (if (not (string= (substring x 0 1) "$"))
  202.               (progn
  203.             (mprinc x)
  204.             (mprinc " "))
  205.             (setq var (intern (substring x 1)))
  206.             (if (not (boundp var))
  207.             (mprinc " ")
  208.               (if (member var restricted)
  209.               (progn
  210.                 (mprinc var)
  211.                 (mprinc ": Permission denied")
  212.                 (setq nomore t))
  213.             (eval (list 'mprinc var))
  214.             (mprinc " ")))))))
  215.         (mprinc "\n")))
  216.  
  217.  
  218. (defun ftp (args)
  219.   (let (host username passwd ident newlist)
  220.     (if (not (car args))
  221.     (mprincl "ftp: hostname required on command line.")
  222.       (setq host (intern (car args)))
  223.       (if (not (member host '(gamma endgame)))
  224.       (mprincl "ftp: Unknown host.")
  225.     (if (eq host 'endgame)
  226.         (mprincl "ftp: connection to endgame not allowed")
  227.       (if (not ethernet)
  228.           (mprincl "ftp: host not responding.")
  229.         (mprincl "Connected to gamma. FTP ver 0.9 00:00:00 01/01/70")
  230.         (mprinc "Username: ")
  231.         (setq username (read-line))
  232.         (if (string= username "toukmond")
  233.         (if batch-mode
  234.             (mprincl "toukmond ftp access not allowed.")
  235.           (mprincl "\ntoukmond ftp access not allowed."))
  236.           (if (string= username "anonymous")
  237.           (if batch-mode
  238.               (mprincl
  239.                "Guest login okay, send your user ident as password.")
  240.             (mprincl 
  241.              "\nGuest login okay, send your user ident as password."))
  242.         (if batch-mode
  243.             (mprinc "Password required for ")
  244.           (mprinc "\nPassword required for "))
  245.         (mprincl username))
  246.           (mprinc "Password: ")
  247.           (setq ident (read-line))
  248.           (if (not (string= username "anonymous"))
  249.           (if batch-mode
  250.               (mprincl "Login failed.")
  251.             (mprincl "\nLogin failed."))
  252.         (if batch-mode
  253.            (mprincl "Guest login okay, user access restrictions apply.")
  254.           (mprincl "\nGuest login okay, user access restrictions apply."))
  255.         (ftp-commands)
  256.         (setq newlist 
  257. '("What password did you use during anonymous ftp to gamma?"))
  258.         (setq newlist (append newlist (list ident)))
  259.         (rplaca (nthcdr 1 endgame-questions) newlist)))))))))
  260.   
  261. (defun ftp-commands ()
  262.     (setq exitf nil)
  263.     (let (line)
  264.       (while (not exitf)
  265.     (mprinc "ftp> ")
  266.     (setq line (read-line))
  267.     (if 
  268.         (eq
  269.          (parse2 nil 
  270.             '((type . ftptype) (binary . bin) (bin . bin) (send . send)
  271.               (put . send) (quit . ftpquit) (help . ftphelp)
  272.               (ascii . fascii)
  273.               ) line)
  274.          -1)
  275.         (mprincl "No such command.  Try help.")))
  276.       (setq ftptype 'ascii)))
  277.  
  278. (defun ftptype (args)
  279.   (if (not (car args))
  280.       (mprincl "Usage: type [binary | ascii]")
  281.     (setq args (intern (car args)))
  282.     (if (eq args 'binary)
  283.     (bin nil)
  284.       (if (eq args 'ascii)
  285.       (fascii 'nil)
  286.     (mprincl "Unknown type.")))))
  287.  
  288. (defun bin (args)
  289.   (mprincl "Type set to binary.")
  290.   (setq ftptype 'binary))
  291.  
  292. (defun fascii (args)
  293.   (mprincl "Type set to ascii.")
  294.   (setq ftptype 'ascii))
  295.  
  296. (defun ftpquit (args)
  297.   (setq exitf t))
  298.  
  299. (defun send (args)
  300.   (if (not (car args))
  301.       (mprincl "Usage: send <filename>")
  302.     (setq args (car args))
  303.     (let (counter foo)
  304.       (setq foo nil)
  305.       (setq counter 0)
  306.  
  307. ;;; User can send commands!  Stupid user.
  308.  
  309.  
  310.       (if (assq (intern args) unix-verbs)
  311.       (progn
  312.         (rplaca (assq (intern args) unix-verbs) 'IMPOSSIBLE)
  313.         (mprinc "Sending ")
  314.         (mprinc ftptype)
  315.         (mprinc " file for ")
  316.         (mprincl args)
  317.         (mprincl "Transfer complete."))
  318.  
  319.     (dolist (x objfiles)
  320.       (if (string= args x)
  321.           (progn
  322.         (if (not (member counter inventory))
  323.             (progn
  324.               (mprincl "No such file.")
  325.               (setq foo t))
  326.           (mprinc "Sending ")
  327.           (mprinc ftptype)
  328.           (mprinc " file for ")
  329.           (mprinc (downcase (cadr (nth counter objects))))
  330.           (mprincl ", (0 bytes)")
  331.           (if (not (eq ftptype 'binary))
  332.               (progn
  333.             (if (not (member obj-protoplasm
  334.                      (nth receiving-room room-objects)))
  335.                 (replace room-objects receiving-room
  336.                      (append (nth receiving-room room-objects)
  337.                          (list obj-protoplasm))))
  338.             (remove-obj-from-inven counter))
  339.             (remove-obj-from-inven counter)
  340.             (replace room-objects receiving-room
  341.                  (append (nth receiving-room room-objects)
  342.                      (list counter))))
  343.           (setq foo t)
  344.           (mprincl "Transfer complete."))))
  345.       (setq counter (+ 1 counter)))
  346.     (if (not foo)
  347.         (mprincl "No such file."))))))
  348.  
  349. (defun ftphelp (args)
  350.   (mprincl 
  351.    "Possible commands are:\nsend    quit    type   ascii  binary   help"))
  352.  
  353. (defun uexit (args)
  354.   (setq dungeon-mode 'dungeon)
  355.   (mprincl "\nYou step back from the console.")
  356.   (define-key dungeon-mode-map "\r" 'dungeon-parse)
  357.   (if (not batch-mode)
  358.       (dungeon-messages)))
  359.  
  360. (defun dunnet-pwd (args)
  361.   (mprincl cdpath))
  362.  
  363. (defun uncompress (args)
  364.   (if (not (car args))
  365.       (mprincl "Usage: uncompress <filename>")
  366.     (setq args (car args))
  367.     (if (or uncompressed
  368.         (and (not (string= args "paper.o"))
  369.          (not (string= args "paper.o.z"))))
  370.     (mprincl "Uncompress command failed.")
  371.       (setq uncompressed t)
  372.       (setq inventory (append inventory (list obj-paper))))))
  373.  
  374. (defun rlogin (args)
  375.   (let (passwd)
  376.     (if (not (car args))
  377.     (mprincl "Usage: rlogin <hostname>")
  378.       (setq args (car args))
  379.       (if (string= args "endgame")
  380.       (rlogin-endgame)
  381.     (if (not (string= args "gamma"))
  382.         (mprincl "No such host.")
  383.       (if (not ethernet)
  384.           (mprincl "Host not responding.")
  385.         (mprinc "Password: ")
  386.         (setq passwd (read-line))
  387.         (if (not (string= passwd "worms"))
  388.         (mprincl "\nlogin incorrect")
  389.           (mprinc 
  390. "\nYou begin to feel strange for a moment, and you lose your items."
  391. )
  392.           (replace room-objects computer-room 
  393.                (append (nth computer-room room-objects) inventory))
  394.           (setq inventory nil)
  395.           (setq current-room receiving-room)
  396.           (uexit nil))))))))
  397.   
  398. (defun dunnet-cd (args)
  399.   (let (tcdpath tcdroom path-elemants room-check)
  400.     (if (not (car args))
  401.     (mprincl "Usage: cd <path>")
  402.       (setq tcdpath cdpath)
  403.       (setq tcdroom cdroom)
  404.       (setq badcd nil)
  405.       (condition-case nil
  406.       (setq path-elements (get-path (car args) nil))
  407.     (error (mprincl "Invalid path.")
  408.            (setq badcd t)))
  409.       (dolist (pe path-elements)
  410.           (unless badcd
  411.               (if (not (string= pe "."))
  412.               (if (string= pe "..")
  413.                   (progn
  414.                 (if (> tcdroom 0)                  ;In a room
  415.                     (progn
  416.                       (setq tcdpath "/rooms")
  417.                       (setq tcdroom -2))
  418.                     ;In /rooms,/usr,root
  419.                   (if (or 
  420.                        (= tcdroom -2) (= tcdroom -4) 
  421.                        (= tcdroom -3))
  422.                       (progn
  423.                     (setq tcdpath "/")
  424.                     (setq tcdroom -3))
  425.                     (if (= tcdroom -10)       ;In /usr/toukmond
  426.                     (progn
  427.                       (setq tcdpath "/usr")
  428.                       (setq tcdroom -4))))))
  429.                 (if (string= pe "/")
  430.                 (progn
  431.                   (setq tcdpath "/")
  432.                   (setq tcdroom -3))
  433.                   (if (= tcdroom -4)
  434.                   (if (string= pe "toukmond")
  435.                       (progn
  436.                     (setq tcdpath "/usr/toukmond")
  437.                     (setq tcdroom -10))
  438.                     (nosuchdir))
  439.                 (if (= tcdroom -10)
  440.                     (nosuchdir)
  441.                   (if (> tcdroom 0)
  442.                       (nosuchdir)
  443.                     (if (= tcdroom -3)
  444.                     (progn
  445.                       (if (string= pe "rooms")
  446.                           (progn
  447.                         (setq tcdpath "/rooms")
  448.                         (setq tcdroom -2))
  449.                         (if (string= pe "usr")
  450.                         (progn
  451.                           (setq tcdpath "/usr")
  452.                           (setq tcdroom -4))
  453.                           (nosuchdir))))
  454.                       (if (= tcdroom -2)
  455.                       (progn
  456.                         (dolist (x visited)
  457.                             (setq room-check 
  458.                               (nth x room-shorts))
  459.                             (if (string= room-check pe)
  460.                             (progn
  461.                               (setq tcdpath 
  462.                          (concat "/rooms/" room-check))
  463.                               (setq tcdroom x))))
  464.                         (if (= tcdroom -2)
  465.                         (nosuchdir)))))))))))))
  466.       (if (not badcd)
  467.       (progn
  468.         (setq cdpath tcdpath)
  469.         (setq cdroom tcdroom)
  470.         0)
  471.       -2))))
  472.  
  473. (defun nosuchdir ()
  474.   (mprincl "No such directory.")
  475.   (setq badcd t))
  476.  
  477. (defun cat (args)
  478.   (let (doto checklist)
  479.     (if (not (setq args (car args)))
  480.     (mprincl "Usage: cat <ascii-file-name>")
  481.       (if (string-match "/" args)
  482.       (mprincl "cat: only files in current directory allowed.")
  483.     (if (and (> cdroom 0) (string= args "description"))
  484.         (mprincl (car (nth cdroom rooms)))
  485.       (if (setq doto (string-match "\\.o" args))
  486.           (progn
  487.         (if (= cdroom -10)
  488.             (setq checklist inventory)
  489.           (setq checklist (nth cdroom room-objects)))
  490.         (if (not (member (cdr 
  491.                   (assq (intern 
  492.                      (substring args 0 doto)) objnames))
  493.                  checklist))
  494.             (mprincl "File not found.")
  495.           (mprincl "Ascii files only.")))
  496.         (if (assq (intern args) unix-verbs)
  497.         (mprincl "Ascii files only.")
  498.           (mprincl "File not found."))))))))
  499.   
  500. (defun zippy (args)
  501.   (mprincl (yow)))
  502.  
  503. (defun rlogin-endgame ()
  504.   (if (not (= (score nil) 90))
  505.       (mprincl "You have not achieved enough points to connect to endgame.")
  506.     (mprincl"\nWelcome to the endgame.  You are a truly noble adventurer.")
  507.     (setq current-room treasure-room)
  508.     (setq endgame t)
  509.     (replace room-objects endgame-treasure-room (list obj-bill))
  510.     (uexit nil)))
  511.