home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / games / dunnet / dun-util.el < prev    next >
Encoding:
Text File  |  1993-06-27  |  7.4 KB  |  273 lines
  1. (require 'cl)
  2. (require 'rnews)
  3.  
  4. ;;;;;;;;;;;;;;;;;;;;; Utility functions
  5.  
  6. (if nil
  7.     (eval-and-compile (setq byte-compile-warnings nil)))
  8.  
  9. ;;; Function which takes a verb and a list of other words.  Calls proper
  10. ;;; function associated with the verb, and passes along the other words.
  11.  
  12. (defun doverb (ignore verblist verb rest)
  13.   (if (not verb)
  14.       nil
  15.     (if (member (intern verb) ignore)
  16.     (if (not (car rest)) -1
  17.       (doverb ignore verblist (car rest) (cdr rest)))
  18.       (if (not (cdr (assq (intern verb) verblist))) -1
  19.     (setq numcmds (1+ numcmds))
  20.     (eval (list (cdr (assq (intern verb) verblist)) (quote rest)))))))
  21.  
  22.  
  23. ;;; Function to take a string and change it into a list of lowercase words.
  24.  
  25. (defun listify-string (strin)
  26.   (let (pos ret-list end-pos)
  27.     (setq pos 0)
  28.     (setq ret-list nil)
  29.     (while (setq end-pos (string-match "[ ,:;]" (substring strin pos)))
  30.       (setq end-pos (+ end-pos pos))
  31.       (if (not (= end-pos pos))
  32.       (setq ret-list (append ret-list (list 
  33.                        (downcase
  34.                         (substring strin pos end-pos))))))
  35.       (setq pos (+ end-pos 1))) ret-list))
  36.  
  37. (defun listify-string2 (strin)
  38.   (let (pos ret-list end-pos)
  39.     (setq pos 0)
  40.     (setq ret-list nil)
  41.     (while (setq end-pos (string-match " " (substring strin pos)))
  42.       (setq end-pos (+ end-pos pos))
  43.       (if (not (= end-pos pos))
  44.       (setq ret-list (append ret-list (list 
  45.                        (downcase
  46.                         (substring strin pos end-pos))))))
  47.       (setq pos (+ end-pos 1))) ret-list))
  48.  
  49. (defun replace (list n number)
  50.   (rplaca (nthcdr n list) number))
  51.  
  52.  
  53. ;;; Get the first non-ignored word from a list.
  54.  
  55. (defun firstword (list)
  56.   (if (not (car list))
  57.       nil
  58.     (while (and list (member (intern (car list)) ignore))
  59.       (setq list (cdr list)))
  60.     (car list)))
  61.  
  62. (defun firstwordl (list)
  63.   (if (not (car list))
  64.       nil
  65.     (while (and list (member (intern (car list)) ignore))
  66.       (setq list (cdr list)))
  67.     list))
  68.  
  69. ;; parse a line passed in as a string  Call the proper verb with the
  70. ;; rest of the line passed in as a list.
  71.  
  72. (defun parse (ignore verblist line)
  73.   (mprinc "\n")
  74.   (setq line-list (listify-string (concat line " ")))
  75.   (doverb ignore verblist (car line-list) (cdr line-list)))
  76.  
  77. (defun parse2 (ignore verblist line)
  78.   (mprinc "\n")
  79.   (setq line-list (listify-string2 (concat line " ")))
  80.   (doverb ignore verblist (car line-list) (cdr line-list)))
  81.  
  82. ;; Read a line, in window mode
  83.  
  84. (defun read-line ()
  85.   (let (line)
  86.     (setq line (read-string ""))
  87.     (mprinc line) line))
  88.  
  89. ;; Insert something into the window buffer
  90.  
  91. (defun minsert (string)
  92.   (if (stringp string)
  93.       (insert string)
  94.     (insert (prin1-to-string string))))
  95.  
  96. ;; Print something out, in window mode
  97.  
  98. (defun mprinc (string)
  99.   (if (stringp string)
  100.       (insert string)
  101.     (insert (prin1-to-string string))))
  102.  
  103. ;; In window mode, keep screen from jumping by keeping last line at
  104. ;; the bottom of the screen.
  105.  
  106. (defun fix-screen ()
  107.   (interactive)
  108.   (forward-line (- 0 (- (window-height) 2 )))
  109.   (set-window-start (selected-window) (point))
  110.   (end-of-buffer))
  111.  
  112. ;; Insert something into the buffer, followed by newline.
  113.  
  114. (defun minsertl (string)
  115.   (minsert string)
  116.   (minsert "\n"))
  117.  
  118. ;; Print something, followed by a newline.
  119.  
  120. (defun mprincl (string)
  121.   (mprinc string)
  122.   (mprinc "\n"))
  123.  
  124. ;;;; Function which will get an object number given the list of
  125. ;;;; words in the command, except for the verb.
  126.  
  127. (defun objnum-from-args (obj)
  128.   (let (objnum)
  129.     (setq obj (firstword obj))
  130.     (if (not obj)
  131.     obj-special
  132.       (setq objnum (cdr (assq (intern obj) objnames))))))
  133.  
  134. (defun objnum-from-args-std (obj)
  135.   (let (result)
  136.   (if (eq (setq result (objnum-from-args obj)) obj-special)
  137.       (mprincl "You must supply an object."))
  138.   (if (eq result nil)
  139.       (mprincl "I don't know what that is."))
  140.   (if (eq result obj-special)
  141.       nil
  142.     result)))
  143.  
  144. ;; Take a short room description, and change spaces and slashes to dashes.
  145.  
  146. (defun space-to-hyphen (string)
  147.   (let (space)
  148.     (if (setq space (string-match "[ /]" string))
  149.     (progn
  150.       (setq string (concat (substring string 0 space) "-"
  151.                    (substring string (1+ space))))
  152.       (space-to-hyphen string))
  153.       string)))
  154.  
  155. ;; Given a unix style pathname, build a list of path components (recursive)
  156.  
  157. (defun get-path (dirstring startlist)
  158.   (let (slash pos)
  159.     (if (= (length dirstring) 0)
  160.     startlist
  161.       (if (string= (substring dirstring 0 1) "/")
  162.       (get-path (substring dirstring 1) (append startlist (list "/")))
  163.     (if (not (setq slash (string-match "/" dirstring)))
  164.         (append startlist (list dirstring))
  165.       (get-path (substring dirstring (1+ slash))
  166.             (append startlist
  167.                 (list (substring dirstring 0 slash)))))))))
  168.  
  169.  
  170. ;; Is a string a member of a string list?
  171.  
  172. (defun members (string string-list)
  173.   (let (found)
  174.     (setq found nil)
  175.     (dolist (x string-list)
  176.       (if (string= x string)
  177.       (setq found t))) found))
  178.  
  179. ;; Function to put objects in the treasure room.  Also prints current
  180. ;; score to let user know he has scored.
  181.  
  182. (defun put-objs-in-treas (objlist)
  183.   (let (oscore newscore)
  184.     (setq oscore (reg-score))
  185.     (replace room-objects 0 (append (nth 0 room-objects) objlist))
  186.     (setq newscore (reg-score))
  187.     (if (not (= oscore newscore))
  188.     (score nil))))
  189.  
  190. ;; Load an encrypted file, and eval it.
  191.  
  192. (defun load-d (filename)
  193.   (let (old-buffer result)
  194.     (setq result t)
  195.     (setq old-buffer (current-buffer))
  196.     (switch-to-buffer (get-buffer-create "*loadc*"))
  197.     (erase-buffer)
  198.     (condition-case nil
  199.     (insert-file-contents filename)
  200.       (error (setq result nil)))
  201.     (unless (not result)
  202.       (condition-case nil
  203.       (dun-rot13)
  204.     (error (yank)))
  205.       (eval-current-buffer)
  206.       (kill-buffer (current-buffer))
  207.       (switch-to-buffer old-buffer))
  208.     result))
  209.  
  210. ;; Rotate the globals file, and save it for later loading.
  211.  
  212. (defun compile-globals ()
  213.   (let
  214.     (switch-to-buffer (get-buffer-create "*compd*"))
  215.     (erase-buffer)
  216.     (insert-file-contents "dun-globals.el")
  217.     (dun-rot13)
  218.     (goto-char (point-min))
  219.     (write-region 1 (point-max) "dun-globals.dat")
  220.     (kill-buffer (current-buffer))))
  221.  
  222. ;; Functions to remove an object either from a room, or from inventory.
  223.  
  224. (defun remove-obj-from-room (room objnum)
  225.   (let (newroom)
  226.     (setq newroom nil)
  227.     (dolist (x (nth room room-objects))
  228.       (if (not (= x objnum))
  229.       (setq newroom (append newroom (list x)))))
  230.     (rplaca (nthcdr room room-objects) newroom)))
  231.  
  232. (defun remove-obj-from-inven (objnum)
  233.   (let (new-inven)
  234.     (setq new-inven nil)
  235.     (dolist (x inventory)
  236.       (if (not (= x objnum))
  237.       (setq new-inven (append new-inven (list x)))))
  238.     (setq inventory new-inven)))
  239.  
  240. ;; Find the global data file.
  241.  
  242. (defun get-glob-dat ()
  243.   (let (result)
  244.     (setq result nil)
  245.     (dolist (x load-path)
  246.         (if (file-exists-p (concat x "/dun-globals.dat"))
  247.         (setq result (concat x "/dun-globals.dat"))))
  248.     result))
  249.  
  250. ;; rotate current buffer 13 characters
  251. (let ((i 0) (lower "abcdefghijklmnopqrstuvwxyz") upper)
  252.   (setq translate-table (make-vector 256 0))
  253.   (while (< i 256)
  254.     (aset translate-table i i)
  255.     (setq i (1+ i)))
  256.   (setq lower (concat lower lower))
  257.   (setq upper (upcase lower))
  258.   (setq i 0)
  259.   (while (< i 26)
  260.     (aset translate-table (+ ?a i) (aref lower (+ i 13)))
  261.     (aset translate-table (+ ?A i) (aref upper (+ i 13)))
  262.       (setq i (1+ i))))
  263.   
  264. (defun dun-rot13 ()
  265.   (let (str len (i 0))
  266.     (setq str (buffer-substring (point-min) (point-max)))
  267.     (setq len (length str))
  268.     (while (< i len)
  269.       (aset str i (aref translate-table (aref str i)))
  270.       (setq i (1+ i)))
  271.     (erase-buffer)
  272.     (insert str)))
  273.