commit b2b31596f807cd593481b75a543b76c9fd76affb (HEAD, refs/remotes/origin/master) Author: Katsumi Yamaoka Date: Mon Feb 20 06:40:03 2017 +0000 mm-decode.el: Simplify regexp used to search html meta tag * lisp/gnus/mm-decode.el (mm-add-meta-html-tag, mm-shr): Simplify regexp used to search html meta tag. diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index becf6d140b..5b8aeb3ca3 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -1414,10 +1414,9 @@ Return t if meta tag is added or replaced." (goto-char (point-min)) (if (re-search-forward "\ ]+\\)\\)?[^>]*>" nil t) +text/html\\(?:;\\s-*charset=\\([^\t\n\r \"'>]+\\)\\)?[^>]*>" nil t) (if (and (not force-charset) - (match-beginning 2) - (string-match "\\`html\\'" (match-string 1))) + (match-beginning 1)) ;; Don't modify existing meta tag. nil ;; Replace it with the one specifying charset. @@ -1796,18 +1795,16 @@ If RECURSIVE, search recursively." charset coding char document) (mm-with-part (or handle (setq handle (mm-dissect-buffer t))) (setq case-fold-search t) - (setq charset - (or (mail-content-type-get (mm-handle-type handle) 'charset) - (progn - (goto-char (point-min)) - (and (re-search-forward "\ + (or (setq charset + (mail-content-type-get (mm-handle-type handle) 'charset)) + (progn + (goto-char (point-min)) + (and (re-search-forward "\ ]+\\)\\)?[^>]*>" nil t) - (setq coding - (mm-charset-to-coding-system (match-string 2) - nil t)) - (string-match "\\`html\\'" (match-string 1)))) - mail-parse-charset)) +text/html;\\s-*charset=\\([^\t\n\r \"'>]+\\)[^>]*>" nil t) + (setq coding (mm-charset-to-coding-system (match-string 1) + nil t)))) + (setq charset mail-parse-charset)) (when (and (or coding (setq coding (mm-charset-to-coding-system charset nil t))) (not (eq coding 'ascii))) commit 851b38bcdfdb1a503f1434f4459af9d1d325f2d0 Author: Katsumi Yamaoka Date: Mon Feb 20 06:17:20 2017 +0000 mm-shr: Ignore coding-system `ascii' * lisp/gnus/mm-decode.el (mm-shr): Ignore coding-system `ascii'. diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 6683d68a31..becf6d140b 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -1808,8 +1808,9 @@ text/\\(\\sw+\\)\\(?:;\\s-*charset=\\([^\t\n\r \"'>]+\\)\\)?[^>]*>" nil t) nil t)) (string-match "\\`html\\'" (match-string 1)))) mail-parse-charset)) - (when (or coding - (setq coding (mm-charset-to-coding-system charset nil t))) + (when (and (or coding + (setq coding (mm-charset-to-coding-system charset nil t))) + (not (eq coding 'ascii))) (insert (prog1 (decode-coding-string (buffer-string) coding) (erase-buffer) commit 0a670690f19bf263dadfe387e5bb22311e3b5231 Author: Tom Tromey Date: Wed Feb 15 05:12:18 2017 -0700 vc-log-outgoing fixes for git; add binding to vc-dir * lisp/vc/vc-dir.el (vc-dir-mode-map): Bind "O" to vc-log-outgoing. * lisp/vc/vc-git.el (vc-git-log-outgoing, vc-git-log-incoming): Use async execution. (vc-git-log-view-mode): Also truncate lines for log-outgoing and log-incoming. * lisp/vc/vc.el (vc-log-incoming, vc-log-outgoing): Don't pass nil as remote-location argument. diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index b7eb8b592d..21bd21e15d 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -255,6 +255,7 @@ See `run-hooks'." (define-key map "l" 'vc-print-log) ;; C-x v l (define-key map "L" 'vc-print-root-log) ;; C-x v L (define-key map "I" 'vc-log-incoming) ;; C-x v I + (define-key map "O" 'vc-log-outgoing) ;; C-x v O ;; More confusing than helpful, probably ;;(define-key map "R" 'vc-revert) ;; u is taken by vc-dir-unmark. ;;(define-key map "A" 'vc-annotate) ;; g is taken by revert-buffer diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 8a22d747b7..1a3f1bf2f4 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -972,7 +972,7 @@ If LIMIT is non-nil, show no more than this many entries." (defun vc-git-log-outgoing (buffer remote-location) (interactive) (vc-git-command - buffer 0 nil + buffer 'async nil "log" "--no-color" "--graph" "--decorate" "--date=short" (format "--pretty=tformat:%s" (car vc-git-root-log-format)) @@ -986,7 +986,7 @@ If LIMIT is non-nil, show no more than this many entries." (interactive) (vc-git-command nil 0 nil "fetch") (vc-git-command - buffer 0 nil + buffer 'async nil "log" "--no-color" "--graph" "--decorate" "--date=short" (format "--pretty=tformat:%s" (car vc-git-root-log-format)) @@ -1011,7 +1011,7 @@ If LIMIT is non-nil, show no more than this many entries." (cadr vc-git-root-log-format) "^commit *\\([0-9a-z]+\\)")) ;; Allow expanding short log entries. - (when (eq vc-log-view-type 'short) + (when (memq vc-log-view-type '(short log-outgoing log-incoming)) (setq truncate-lines t) (set (make-local-variable 'log-view-expanded-log-entry-function) 'vc-git-expanded-log-entry)) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index c3088560c1..64e88de60e 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -2378,8 +2378,8 @@ When called interactively with a prefix argument, prompt for REMOTE-LOCATION." (let ((backend (vc-deduce-backend))) (unless backend (error "Buffer is not version controlled")) - (vc-incoming-outgoing-internal backend remote-location "*vc-incoming*" - 'log-incoming))) + (vc-incoming-outgoing-internal backend (or remote-location "") + "*vc-incoming*" 'log-incoming))) ;;;###autoload (defun vc-log-outgoing (&optional remote-location) @@ -2391,8 +2391,8 @@ When called interactively with a prefix argument, prompt for REMOTE-LOCATION." (let ((backend (vc-deduce-backend))) (unless backend (error "Buffer is not version controlled")) - (vc-incoming-outgoing-internal backend remote-location "*vc-outgoing*" - 'log-outgoing))) + (vc-incoming-outgoing-internal backend (or remote-location "") + "*vc-outgoing*" 'log-outgoing))) ;;;###autoload (defun vc-region-history (from to) commit a4c3227230fbdbcb324313b6aae067ad284f8239 Author: Tom Tromey Date: Mon Feb 13 17:24:04 2017 -0700 Remove stale comments from vc-git and vc-hg * lisp/vc/vc-git.el (vc-git-retrieve-tag): Remove comment. * lisp/vc/vc-hg.el (vc-hg-retrieve-tag): Remove comment. diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 0f58892eb4..8a22d747b7 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1240,9 +1240,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." (defun vc-git-retrieve-tag (dir name _update) (let ((default-directory dir)) - (vc-git-command nil 0 nil "checkout" name) - ;; FIXME: update buffers if `update' is true - )) + (vc-git-command nil 0 nil "checkout" name))) ;;; MISCELLANEOUS diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 2f9487ca2e..8a2b07718c 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -76,7 +76,7 @@ ;; - annotate-extract-revision-at-line () OK ;; TAG SYSTEM ;; - create-tag (dir name branchp) OK -;; - retrieve-tag (dir name update) OK FIXME UPDATE BUFFERS +;; - retrieve-tag (dir name update) OK ;; MISCELLANEOUS ;; - make-version-backups-p (file) ?? ;; - previous-revision (file rev) OK @@ -562,7 +562,6 @@ Optional arg REVISION is a revision to annotate from." "Retrieve the version tagged by NAME of all registered files at or below DIR." (let ((default-directory dir)) (vc-hg-command nil 0 nil "update" name) - ;; FIXME: update buffers if `update' is true ;; TODO: update *vc-change-log* buffer so can see @ if --graph )) commit e7b0dac11356f4f343f0441ce2078e994e1a7219 Author: Mark Oteiza Date: Sun Feb 19 22:19:57 2017 -0500 Remove member clone * lisp/play/dunnet.el (dun-answer): Use member instead. (dun-members): Remove. diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el index d8e0681b7a..bffb38a01a 100644 --- a/lisp/play/dunnet.el +++ b/lisp/play/dunnet.el @@ -2109,7 +2109,7 @@ for a moment, then straighten yourself up. (setq args (car args)) (if (not args) (dun-mprincl "You must give the answer on the same line.") - (if (dun-members args dun-correct-answer) + (if (member args dun-correct-answer) (progn (dun-mprincl "Correct.") (if (= dun-lastdir 0) @@ -2330,16 +2330,6 @@ for a moment, then straighten yourself up. (append startlist (list (substring dirstring 0 slash))))))))) - -;;; Is a string a member of a string list? - -(defun dun-members (string string-list) - (let (found) - (setq found nil) - (dolist (x string-list) - (if (string= x string) - (setq found t))) found)) - ;;; Function to put objects in the treasure room. Also prints current ;;; score to let user know he has scored. commit 2f605c3f89d5d3657d364f45e1b6b6c23bf0de70 Author: Mark Oteiza Date: Sun Feb 19 22:15:57 2017 -0500 Prefix global var * lisp/play/dunnet.el (room): Rename to dun-room. (dun-messages, dunnet, dun-describe-room, dun-drop, dun-move): (dun-restore, dun-do-logfile, dun-batch-loop): Use new name. diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el index a5aa7040c1..d8e0681b7a 100644 --- a/lisp/play/dunnet.el +++ b/lisp/play/dunnet.el @@ -63,7 +63,7 @@ (defvar dun-numsaves 0) (defvar dun-jar nil) (defvar dun-dead nil) -(defvar room 0) +(defvar dun-room 0) (defvar dun-numcmds 0) (defvar dun-wizard nil) (defvar dun-endgame-question nil) @@ -1155,9 +1155,9 @@ treasures for points?" "4" "four") (if dun-dead (text-mode) (when (eq dungeon-mode 'dungeon) - (when (not (= room dun-current-room)) + (when (not (= dun-room dun-current-room)) (dun-describe-room dun-current-room) - (setq room dun-current-room)) + (setq dun-room dun-current-room)) (dun-fix-screen) (dun-mprinc ">")))) @@ -1169,7 +1169,7 @@ treasures for points?" "4" "four") (switch-to-buffer "*dungeon*") (dun-mode) (setq dun-dead nil) - (setq room 0) + (setq dun-room 0) (dun-messages)) ;;;; @@ -1186,7 +1186,8 @@ treasures for points?" "4" "four") (dun-mprincl "It is pitch dark. You are likely to be eaten by a grue.") (dun-mprincl (cadr (nth (abs room) dun-rooms))) (if (and (and (or (member room dun-visited) - (string= dun-mode "dun-superb")) (> room 0)) + (string= dun-mode "dun-superb")) + (> room 0)) (not (string= dun-mode "long"))) nil (dun-mprinc (car (nth (abs room) dun-rooms))) @@ -1357,7 +1358,7 @@ on your head.") ;;; Dropping certain things causes things to happen. (defun dun-drop-check (objnum) - (if (and (= objnum obj-food) (= room bear-hangout) + (if (and (= objnum obj-food) (= dun-room bear-hangout) (member obj-bear (nth bear-hangout dun-room-objects))) (progn (dun-mprincl @@ -1700,7 +1701,7 @@ body.") (dun-mprinc "You can't go that way.\n") (if (eq newroom 255) (dun-special-move dir) - (setq room -1) + (setq dun-room -1) (setq dun-lastdir dir) (if dun-inbus (progn @@ -3117,7 +3118,7 @@ File not found"))) (if (not (dun-load-d file)) (dun-mprincl "Could not load restore file.") (dun-mprincl "Done.") - (setq room 0))))) + (setq dun-room 0))))) (defun dun-do-logfile (type how) @@ -3144,7 +3145,7 @@ File not found"))) (dun-minsert how) (dun-minsert " ")))) (dun-minsert "at ") - (dun-minsert (cadr (nth (abs room) dun-rooms))) + (dun-minsert (cadr (nth (abs dun-room) dun-rooms))) (dun-minsert ". score: ") (if (> (dun-endgame-score) 0) (dun-minsert (+ 90 (dun-endgame-score))) @@ -3191,14 +3192,14 @@ File not found"))) (defun dun-batch-loop () (setq dun-dead nil) - (setq room 0) + (setq dun-room 0) (while (not dun-dead) (if (eq dungeon-mode 'dungeon) (progn - (if (not (= room dun-current-room)) + (if (not (= dun-room dun-current-room)) (progn (dun-describe-room dun-current-room) - (setq room dun-current-room))) + (setq dun-room dun-current-room))) (dun-mprinc ">") (setq line (downcase (dun-read-line))) (if (eq (dun-vparse dun-ignore dun-verblist line) -1) commit 0db5ba48b294640774262b01e2f9abc9cbf23d31 Author: Mark Oteiza Date: Sun Feb 19 21:31:22 2017 -0500 Replace nested ifs with cond * lisp/play/dunnet.el (dun-messages, dun-describe-room, dun-examine): (dun-eat, dun-put-objs, dun-turn, dun-press, dun-ls, dun-cd): Use when and cond where appropriate. (dun-sauna-heat): Accept sauna level as an argument. Use cond. (dun-take): Use null and dun-mprincl. (dun-inven-weight, dun-load-d): Reformat. (dun-remove-obj-from-inven, dun-remove-obj-from-room): Nix setq to nil. diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el index 755c6583e7..a5aa7040c1 100644 --- a/lisp/play/dunnet.el +++ b/lisp/play/dunnet.el @@ -1154,14 +1154,12 @@ treasures for points?" "4" "four") (defun dun-messages () (if dun-dead (text-mode) - (if (eq dungeon-mode 'dungeon) - (progn - (if (not (= room dun-current-room)) - (progn - (dun-describe-room dun-current-room) - (setq room dun-current-room))) - (dun-fix-screen) - (dun-mprinc ">"))))) + (when (eq dungeon-mode 'dungeon) + (when (not (= room dun-current-room)) + (dun-describe-room dun-current-room) + (setq room dun-current-room)) + (dun-fix-screen) + (dun-mprinc ">")))) ;;;###autoload @@ -1192,24 +1190,23 @@ treasures for points?" "4" "four") (not (string= dun-mode "long"))) nil (dun-mprinc (car (nth (abs room) dun-rooms))) - (dun-mprinc "\n")) - (if (not (string= dun-mode "long")) - (if (not (member (abs room) dun-visited)) - (setq dun-visited (append (list (abs room)) dun-visited)))) + (dun-mprinc "\n")) + (when (and (not (string= dun-mode "long")) + (not (member (abs room) dun-visited))) + (setq dun-visited (append (list (abs room)) dun-visited))) (dolist (xobjs (nth dun-current-room dun-room-objects)) - (if (= xobjs obj-special) - (dun-special-object) - (if (>= xobjs 0) - (dun-mprincl (car (nth xobjs dun-objects))) - (if (not (and (= xobjs obj-bus) dun-inbus)) - (progn - (dun-mprincl (car (nth (abs xobjs) dun-perm-objects))))))) - (if (and (= xobjs obj-jar) dun-jar) - (progn - (dun-mprincl "The jar contains:") - (dolist (x dun-jar) - (dun-mprinc " ") - (dun-mprincl (car (nth x dun-objects))))))) + (cond + ((= xobjs obj-special) + (dun-special-object)) + ((>= xobjs 0) + (dun-mprincl (car (nth xobjs dun-objects)))) + ((not (and (= xobjs obj-bus) dun-inbus)) + (dun-mprincl (car (nth (abs xobjs) dun-perm-objects))))) + (when (and (= xobjs obj-jar) dun-jar) + (dun-mprincl "The jar contains:") + (dolist (x dun-jar) + (dun-mprinc " ") + (dun-mprincl (car (nth x dun-objects)))))) (if (and (member obj-bus (nth dun-current-room dun-room-objects)) dun-inbus) (dun-mprincl "You are on the bus.")))) @@ -1314,35 +1311,31 @@ disk bursts into flames, and disintegrates.") (dun-mprincl (cadr (nth x dun-objects)))))))))) (defun dun-shake (obj) - (let (objnum) - (when (setq objnum (dun-objnum-from-args-std obj)) - (if (member objnum dun-inventory) - (progn -;;; If shaking anything will do anything, put here. - (dun-mprinc "Shaking ") - (dun-mprinc (downcase (cadr (nth objnum dun-objects)))) - (dun-mprinc " seems to have no effect.") - (dun-mprinc "\n") - ) - (if (and (not (member objnum (nth dun-current-room dun-room-silents))) - (not (member objnum (nth dun-current-room dun-room-objects)))) - (dun-mprincl "I don't see that here.") -;;; Shaking trees can be deadly - (if (= objnum obj-tree) - (progn - (dun-mprinc + (let ((objnum (dun-objnum-from-args-std obj))) + (when objnum + (cond + ((member objnum dun-inventory) + ;; If shaking anything will do anything, put here. + (dun-mprinc "Shaking ") + (dun-mprinc (downcase (cadr (nth objnum dun-objects)))) + (dun-mprinc " seems to have no effect.") + (dun-mprinc "\n")) + ((and (not (member objnum (nth dun-current-room dun-room-silents))) + (not (member objnum (nth dun-current-room dun-room-objects)))) + (dun-mprincl "I don't see that here.")) + ;; Shaking trees can be deadly + ((= objnum obj-tree) + (dun-mprinc "You begin to shake a tree, and notice a coconut begin to fall from the air. As you try to get your hand up to block it, you feel the impact as it lands on your head.") - (dun-die "a coconut")) - (if (= objnum obj-bear) - (progn - (dun-mprinc + (dun-die "a coconut")) + ((= objnum obj-bear) + (dun-mprinc "As you go up to the bear, it removes your head and places it on the ground.") - (dun-die "a bear")) - (if (< objnum 0) - (dun-mprincl "You cannot shake that.") - (dun-mprincl "You don't have that."))))))))) + (dun-die "a bear")) + ((< objnum 0) (dun-mprincl "You cannot shake that.")) + (t (dun-mprincl "You don't have that.")))))) (defun dun-drop (obj) @@ -1396,36 +1389,33 @@ through."))))) ;;; Give long description of current room, or an object. (defun dun-examine (obj) - (let (objnum) - (setq objnum (dun-objnum-from-args obj)) - (if (eq objnum obj-special) - (dun-describe-room (* dun-current-room -1)) - (if (and (eq objnum obj-computer) - (member obj-pc (nth dun-current-room dun-room-silents))) - (dun-examine '("pc")) - (if (eq objnum nil) - (dun-mprincl "I don't know what that is.") - (if (and (not (member objnum - (nth dun-current-room dun-room-objects))) - (not (and (member obj-jar dun-inventory) - (member objnum dun-jar))) - (not (member objnum - (nth dun-current-room dun-room-silents))) - (not (member objnum dun-inventory))) - (dun-mprincl "I don't see that here.") - (if (>= objnum 0) - (if (and (= objnum obj-bone) - (= dun-current-room marine-life-area) dun-black) + (let ((objnum (dun-objnum-from-args obj))) + (cond + ((eq objnum obj-special) + (dun-describe-room (* dun-current-room -1))) + ((and (eq objnum obj-computer) + (member obj-pc (nth dun-current-room dun-room-silents))) + (dun-examine '("pc"))) + ((null objnum) + (dun-mprincl "I don't know what that is.")) + ((and (not (member objnum (nth dun-current-room dun-room-objects))) + (not (and (member obj-jar dun-inventory) + (member objnum dun-jar))) + (not (member objnum (nth dun-current-room dun-room-silents))) + (not (member objnum dun-inventory))) + (dun-mprincl "I don't see that here.")) + ((>= objnum 0) + (if (and (= objnum obj-bone) + (= dun-current-room marine-life-area) dun-black) (dun-mprincl "In this light you can see some writing on the bone. It says: For an explosive time, go to Fourth St. and Vermont.") - (if (nth objnum dun-physobj-desc) - (dun-mprincl (nth objnum dun-physobj-desc)) - (dun-mprincl "I see nothing special about that."))) - (if (nth (abs objnum) dun-permobj-desc) - (progn - (dun-mprincl (nth (abs objnum) dun-permobj-desc))) - (dun-mprincl "I see nothing special about that."))))))))) + (if (nth objnum dun-physobj-desc) + (dun-mprincl (nth objnum dun-physobj-desc)) + (dun-mprincl "I see nothing special about that.")))) + ((nth (abs objnum) dun-permobj-desc) + (dun-mprincl (nth (abs objnum) dun-permobj-desc))) + (t (dun-mprincl "I see nothing special about that."))))) (defun dun-take (obj) (setq obj (dun-firstword obj)) @@ -1447,10 +1437,8 @@ For an explosive time, go to Fourth St. and Vermont.") (dun-mprincl "Nothing to take.")))) (let (objnum) (setq objnum (cdr (assq (intern obj) dun-objnames))) - (if (eq objnum nil) - (progn - (dun-mprinc "I don't know what that is.") - (dun-mprinc "\n")) + (if (null objnum) + (dun-mprincl "I don't know what that is.") (if (and dun-inbus (not (and (member objnum dun-jar) (member obj-jar dun-inventory)))) (dun-mprincl "You can't take anything while on the bus.") @@ -1485,12 +1473,12 @@ For an explosive time, go to Fourth St. and Vermont.") (dun-mprinc "\n"))) (defun dun-inven-weight () - (let (total) - (setq total 0) + (let ((total 0)) (dolist (x dun-jar) (setq total (+ total (nth x dun-object-lbs)))) (dolist (x dun-inventory) - (setq total (+ total (nth x dun-object-lbs)))) total)) + (setq total (+ total (nth x dun-object-lbs)))) + total)) ;;; We try to take an object that is untakable. Print a message ;;; depending on what it is. @@ -1533,18 +1521,19 @@ For an explosive time, go to Fourth St. and Vermont.") notice that the tree is very unsteady."))))) (defun dun-eat (obj) - (let (objnum) - (when (setq objnum (dun-objnum-from-args-std obj)) - (if (not (member objnum dun-inventory)) - (dun-mprincl "You don't have that.") - (if (not (= objnum obj-food)) - (progn - (dun-mprinc "You forcefully shove ") - (dun-mprinc (downcase (cadr (nth objnum dun-objects)))) - (dun-mprincl " down your throat, and start choking.") - (dun-die "choking")) - (dun-mprincl "That tasted horrible.") - (dun-remove-obj-from-inven obj-food)))))) + (let ((objnum (dun-objnum-from-args-std obj))) + (when objnum + (cond + ((not (member objnum dun-inventory)) + (dun-mprincl "You don't have that.")) + ((/= objnum obj-food) + (dun-mprinc "You forcefully shove ") + (dun-mprinc (downcase (cadr (nth objnum dun-objects)))) + (dun-mprincl " down your throat, and start choking.") + (dun-die "choking")) + (t + (dun-mprincl "That tasted horrible.") + (dun-remove-obj-from-inven obj-food)))))) (defun dun-put (args) (let (newargs objnum objnum2 obj) @@ -1580,65 +1569,59 @@ notice that the tree is very unsteady."))))) (if (= obj2 obj-disposal) (setq obj2 obj-chute)) - (if (and (= obj1 obj-cpu) (= obj2 obj-computer)) - (progn - (dun-remove-obj-from-inven obj-cpu) - (setq dun-computer t) - (dun-mprincl + (cond + ((and (= obj1 obj-cpu) (= obj2 obj-computer)) + (dun-remove-obj-from-inven obj-cpu) + (setq dun-computer t) + (dun-mprincl "As you put the CPU board in the computer, it immediately springs to life. The lights start flashing, and the fans seem to startup.")) - (if (and (= obj1 obj-weight) (= obj2 obj-button)) - (dun-drop '("weight")) - (if (= obj2 obj-jar) ;; Put something in jar - (if (not (member obj1 (list obj-paper obj-diamond obj-emerald - obj-license obj-coins obj-egg - obj-nitric obj-glycerine))) - (dun-mprincl "That will not fit in the jar.") - (dun-remove-obj-from-inven obj1) - (setq dun-jar (append dun-jar (list obj1))) - (dun-mprincl "Done.")) - (if (= obj2 obj-chute) ;; Put something in chute - (progn - (dun-remove-obj-from-inven obj1) - (dun-mprincl -"You hear it slide down the chute and off into the distance.") - (dun-put-objs-in-treas (list obj1))) - (if (= obj2 obj-box) ;; Put key in key box - (if (= obj1 obj-key) - (progn - (dun-mprincl + ((and (= obj1 obj-weight) (= obj2 obj-button)) + (dun-drop '("weight"))) + ((= obj2 obj-jar) ; Put something in jar + (if (not (member obj1 (list obj-paper obj-diamond obj-emerald + obj-license obj-coins obj-egg + obj-nitric obj-glycerine))) + (dun-mprincl "That will not fit in the jar.") + (dun-remove-obj-from-inven obj1) + (setq dun-jar (append dun-jar (list obj1))) + (dun-mprincl "Done."))) + ((= obj2 obj-chute) ; Put something in chute + (dun-remove-obj-from-inven obj1) + (dun-mprincl "You hear it slide down the chute and off into the distance.") + (dun-put-objs-in-treas (list obj1))) + ((= obj2 obj-box) ; Put key in key box + (if (/= obj1 obj-key) + (dun-mprincl "You can't put that in the key box!") + (dun-mprincl "As you drop the key, the box begins to shake. Finally it explodes with a bang. The key seems to have vanished!") - (dun-remove-obj-from-inven obj1) - (dun-replace dun-room-objects computer-room (append - (nth computer-room - dun-room-objects) - (list obj1))) - (dun-remove-obj-from-room dun-current-room obj-box) - (setq dun-key-level (1+ dun-key-level))) - (dun-mprincl "You can't put that in the key box!")) - - (if (and (= obj1 obj-floppy) (= obj2 obj-pc)) - (progn - (setq dun-floppy t) - (dun-remove-obj-from-inven obj1) - (dun-mprincl "Done.")) - - (if (= obj2 obj-urinal) ;; Put object in urinal - (progn - (dun-remove-obj-from-inven obj1) - (dun-replace dun-room-objects urinal (append - (nth urinal dun-room-objects) - (list obj1))) - (dun-mprincl - "You hear it plop down in some water below.")) - (if (= obj2 obj-mail) - (dun-mprincl "The mail chute is locked.") - (if (member obj1 dun-inventory) - (dun-mprincl + (dun-remove-obj-from-inven obj1) + (dun-replace dun-room-objects computer-room (append + (nth computer-room + dun-room-objects) + (list obj1))) + (dun-remove-obj-from-room dun-current-room obj-box) + (setq dun-key-level (1+ dun-key-level)))) + + ((and (= obj1 obj-floppy) (= obj2 obj-pc)) + (setq dun-floppy t) + (dun-remove-obj-from-inven obj1) + (dun-mprincl "Done.")) + + ((= obj2 obj-urinal) ; Put object in urinal + (dun-remove-obj-from-inven obj1) + (dun-replace dun-room-objects urinal (append + (nth urinal dun-room-objects) + (list obj1))) + (dun-mprincl "You hear it plop down in some water below.")) + ((= obj2 obj-mail) + (dun-mprincl "The mail chute is locked.")) + ((member obj1 dun-inventory) + (dun-mprincl "I don't know how to combine those objects. Perhaps you should -just try dropping it.") - (dun-mprincl "You can't put that there."))))))))))) +just try dropping it.")) + (t (dun-mprincl "You can't put that there.")))) (defun dun-type (_args) (if (not (= dun-current-room computer-room)) @@ -1890,73 +1873,67 @@ huge rocks sliding down from the ceiling, and blocking your way out.\n") (dun-mprincl "The dial will not turn further in that direction.") (setq dun-sauna-level 0)) - (dun-sauna-heat)))))))) - -(defun dun-sauna-heat () - (if (= dun-sauna-level 0) - (dun-mprincl - "The temperature has returned to normal room temperature.")) - (if (= dun-sauna-level 1) - (dun-mprincl "It is now luke warm in here. You are perspiring.")) - (if (= dun-sauna-level 2) - (dun-mprincl "It is pretty hot in here. It is still very comfortable.")) - (if (= dun-sauna-level 3) - (progn - (dun-mprincl -"It is now very hot. There is something very refreshing about this.") - (if (or (member obj-rms dun-inventory) - (member obj-rms (nth dun-current-room dun-room-objects))) - (progn - (dun-mprincl + (dun-sauna-heat dun-sauna-level)))))))) + +(defun dun-sauna-heat (level) + (cond + ((= level 0) + (dun-mprincl "The temperature has returned to normal room temperature.")) + ((= level 1) + (dun-mprincl "It is now luke warm in here. You are perspiring.")) + ((= level 2) + (dun-mprincl "It is pretty hot in here. It is still very comfortable.")) + ((= level 3) + (dun-mprincl + "It is now very hot. There is something very refreshing about this.") + (when (or (member obj-rms dun-inventory) + (member obj-rms (nth dun-current-room dun-room-objects))) + (dun-mprincl "You notice the wax on your statuette beginning to melt, until it completely melts off. You are left with a beautiful diamond!") - (if (member obj-rms dun-inventory) - (progn - (dun-remove-obj-from-inven obj-rms) - (setq dun-inventory (append dun-inventory - (list obj-diamond)))) - (dun-remove-obj-from-room dun-current-room obj-rms) - (dun-replace dun-room-objects dun-current-room - (append (nth dun-current-room dun-room-objects) - (list obj-diamond)))))) - (if (or (member obj-floppy dun-inventory) - (member obj-floppy (nth dun-current-room dun-room-objects))) - (progn - (dun-mprincl + (if (member obj-rms dun-inventory) + (progn + (dun-remove-obj-from-inven obj-rms) + (setq dun-inventory (append dun-inventory + (list obj-diamond)))) + (dun-remove-obj-from-room dun-current-room obj-rms) + (dun-replace dun-room-objects dun-current-room + (append (nth dun-current-room dun-room-objects) + (list obj-diamond))))) + (when (or (member obj-floppy dun-inventory) + (member obj-floppy (nth dun-current-room dun-room-objects))) + (dun-mprincl "You notice your floppy disk beginning to melt. As you grab for it, the disk bursts into flames, and disintegrates.") - (if (member obj-floppy dun-inventory) - (dun-remove-obj-from-inven obj-floppy) - (dun-remove-obj-from-room dun-current-room obj-floppy)))))) + (if (member obj-floppy dun-inventory) + (dun-remove-obj-from-inven obj-floppy) + (dun-remove-obj-from-room dun-current-room obj-floppy)))) - (if (= dun-sauna-level 4) - (progn - (dun-mprincl -"As the dial clicks into place, you immediately burst into flames.") - (dun-die "burning")))) + ((= level 4) + (dun-mprincl "As the dial clicks into place, you immediately burst into flames.") + (dun-die "burning")))) (defun dun-press (obj) - (let (objnum) - (when (setq objnum (dun-objnum-from-args-std obj)) - (if (not (or (member objnum (nth dun-current-room dun-room-objects)) - (member objnum (nth dun-current-room dun-room-silents)))) - (dun-mprincl "I don't see that here.") - (if (not (member objnum (list obj-button obj-switch))) - (progn - (dun-mprinc "You can't ") - (dun-mprinc (car line-list)) - (dun-mprincl " that.")) - (if (= objnum obj-button) - (dun-mprincl + (let ((objnum (dun-objnum-from-args-std obj))) + (cond + ((not (or (member objnum (nth dun-current-room dun-room-objects)) + (member objnum (nth dun-current-room dun-room-silents)))) + (dun-mprincl "I don't see that here.")) + ((not (member objnum (list obj-button obj-switch))) + (dun-mprinc "You can't ") + (dun-mprinc (car line-list)) + (dun-mprincl " that.")) + ((= objnum obj-button) + (dun-mprincl "As you press the button, you notice a passageway open up, but as you release it, the passageway closes.")) - (if (= objnum obj-switch) - (if dun-black - (progn - (dun-mprincl "The button is now in the off position.") - (setq dun-black nil)) - (dun-mprincl "The button is now in the on position.") - (setq dun-black t)))))))) + ((= objnum obj-switch) + (if dun-black + (progn + (dun-mprincl "The button is now in the off position.") + (setq dun-black nil)) + (dun-mprincl "The button is now in the on position.") + (setq dun-black t)))))) (defun dun-swim (_args) (if (not (member dun-current-room (list lakefront-north lakefront-south))) @@ -2376,15 +2353,14 @@ for a moment, then straighten yourself up. ;;; Load an encrypted file, and eval it. (defun dun-load-d (filename) - (let (old-buffer result) - (setq result t) - (setq old-buffer (current-buffer)) + (let ((old-buffer (current-buffer)) + (result t)) (switch-to-buffer (get-buffer-create "*loadc*")) (erase-buffer) (condition-case nil (insert-file-contents filename) (error (setq result nil))) - (unless (not result) + (when result (condition-case nil (dun-rot13) (error (yank))) @@ -2397,7 +2373,6 @@ for a moment, then straighten yourself up. (defun dun-remove-obj-from-room (room objnum) (let (newroom) - (setq newroom nil) (dolist (x (nth room dun-room-objects)) (if (not (= x objnum)) (setq newroom (append newroom (list x))))) @@ -2405,7 +2380,6 @@ for a moment, then straighten yourself up. (defun dun-remove-obj-from-inven (objnum) (let (new-inven) - (setq new-inven nil) (dolist (x dun-inventory) (if (not (= x objnum)) (setq new-inven (append new-inven (list x))))) @@ -2567,24 +2541,19 @@ Note: Restricted bourne shell in use.\n"))) (setq dungeon-mode 'dungeon))) (defun dun-ls (args) - (if (car args) - (let (ocdpath ocdroom) - (setq ocdpath dun-cdpath) - (setq ocdroom dun-cdroom) - (if (not (eq (dun-cd args) -2)) - (dun-ls nil)) - (setq dun-cdpath ocdpath) - (setq dun-cdroom ocdroom)) - (if (= dun-cdroom -10) - (dun-ls-inven)) - (if (= dun-cdroom -2) - (dun-ls-rooms)) - (if (= dun-cdroom -3) - (dun-ls-root)) - (if (= dun-cdroom -4) - (dun-ls-usr)) - (if (> dun-cdroom 0) - (dun-ls-room)))) + (let ((ocdroom dun-cdroom)) + (if (car args) + (let ((ocdpath dun-cdpath)) + (if (not (eq (dun-cd args) -2)) + (dun-ls nil)) + (setq dun-cdpath ocdpath) + (setq dun-cdroom ocdroom)) + (cond + ((= ocdroom -10) (dun-ls-inven)) + ((= ocdroom -2) (dun-ls-rooms)) + ((= ocdroom -3) (dun-ls-root)) + ((= ocdroom -4) (dun-ls-usr)) + ((> ocdroom 0) (dun-ls-room)))))) (defun dun-ls-root () (dun-mprincl "total 4 @@ -2853,80 +2822,63 @@ drwxr-xr-x 3 root staff 2048 Jan 1 1970 ..") (dun-uexit nil)))))))) (defun dun-cd (args) - (let (tcdpath tcdroom path-elements room-check) - (if (not (car args)) - (dun-mprincl "Usage: cd ") - (setq tcdpath dun-cdpath) - (setq tcdroom dun-cdroom) + (if (not (car args)) + (dun-mprincl "Usage: cd ") + (let ((tcdpath dun-cdpath) + (tcdroom dun-cdroom) + path-elements) (setq dun-badcd nil) (condition-case nil (setq path-elements (dun-get-path (car args) nil)) (error (dun-mprincl "Invalid path") (setq dun-badcd t))) (dolist (pe path-elements) - (unless dun-badcd - (if (not (string= pe ".")) - (if (string= pe "..") - (progn - (if (> tcdroom 0) ;In a room - (progn - (setq tcdpath "/rooms") - (setq tcdroom -2)) - ;In /rooms,/usr,root - (if (or - (= tcdroom -2) (= tcdroom -4) - (= tcdroom -3)) - (progn - (setq tcdpath "/") - (setq tcdroom -3)) - (if (= tcdroom -10) ;In /usr/toukmond - (progn - (setq tcdpath "/usr") - (setq tcdroom -4)))))) - (if (string= pe "/") - (progn - (setq tcdpath "/") - (setq tcdroom -3)) - (if (= tcdroom -4) - (if (string= pe "toukmond") - (progn - (setq tcdpath "/usr/toukmond") - (setq tcdroom -10)) - (dun-nosuchdir)) - (if (= tcdroom -10) - (dun-nosuchdir) - (if (> tcdroom 0) - (dun-nosuchdir) - (if (= tcdroom -3) - (progn - (if (string= pe "rooms") - (progn - (setq tcdpath "/rooms") - (setq tcdroom -2)) - (if (string= pe "usr") - (progn - (setq tcdpath "/usr") - (setq tcdroom -4)) - (dun-nosuchdir)))) - (if (= tcdroom -2) - (progn - (dolist (x dun-visited) - (setq room-check - (nth x - dun-room-shorts)) - (if (string= room-check pe) - (progn - (setq tcdpath - (concat "/rooms/" room-check)) - (setq tcdroom x)))) - (if (= tcdroom -2) - (dun-nosuchdir))))))))))))) - (if (not dun-badcd) - (progn - (setq dun-cdpath tcdpath) - (setq dun-cdroom tcdroom) - 0) - -2)))) + (when (and (not dun-badcd) + (not (string= pe "."))) + (cond + ((string= pe "..") + (cond + ((> tcdroom 0) ;In a room + (setq tcdpath "/rooms") + (setq tcdroom -2)) + ((memq tcdroom '(-2 -3 -4)) ; In /rooms,/usr,root + (setq tcdpath "/") + (setq tcdroom -3)) + ((= tcdroom -10) + (setq tcdpath "/usr") + (setq tcdroom -4)))) + ((string= pe "/") + (setq tcdpath "/") + (setq tcdroom -3)) + ((= tcdroom -4) + (if (not (string= pe "toukmond")) + (dun-nosuchdir) + (setq tcdpath "/usr/toukmond") + (setq tcdroom -10))) + ((or (= tcdroom -10) (> tcdroom 0)) (dun-nosuchdir)) + ((= tcdroom -3) + (cond + ((string= pe "rooms") + (setq tcdpath "/rooms") + (setq tcdroom -2)) + ((string= pe "usr") + (setq tcdpath "/usr") + (setq tcdroom -4)) + (t (dun-nosuchdir)))) + ((= tcdroom -2) + (let (room-check) + (dolist (x dun-visited) + (setq room-check (nth x dun-room-shorts)) + (when (string= room-check pe) + (setq tcdpath (concat "/rooms/" room-check)) + (setq tcdroom x)))) + (when (= tcdroom -2) + (dun-nosuchdir)))))) + (if dun-badcd + -2 + (setq dun-cdpath tcdpath) + (setq dun-cdroom tcdroom) + 0)))) (defun dun-nosuchdir () (dun-mprincl "No such directory.") commit c8d14cfc6c2d19077d137c7e917fbb4f104de222 Author: Paul Eggert Date: Sun Feb 19 12:22:33 2017 -0800 Fix glitches in recent hash table changes * src/fns.c (Fmake_hash_table): Simplify the machine code slightly by using 0 rather than -1. * src/lisp.h (struct Lisp_Hash_Table.pure): Now bool rather than a bitfield, for speed (the bitfield did not save space). (struct Lisp_Hash_Table.rehash_threshold): Now double rather than float, since the float caused unwanted rounding errors, e.g., (hash-table-rehash-threshold (make-hash-table)) yielded 0.800000011920929 instead of the correct 0.8. diff --git a/src/fns.c b/src/fns.c index be00bfd868..3fed92dfec 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4445,9 +4445,8 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) /* Look for `:rehash-threshold THRESHOLD'. */ i = get_key_arg (QCrehash_threshold, nargs, args, used); - rehash_threshold = - i ? (FLOATP (args[i]) ? XFLOAT_DATA (args[i]) : -1.0) - : DEFAULT_REHASH_THRESHOLD; + rehash_threshold = (!i ? DEFAULT_REHASH_THRESHOLD + : FLOATP (args[i]) ? XFLOAT_DATA (args[i]) : 0); if (! (0 < rehash_threshold && rehash_threshold <= 1)) signal_error ("Invalid hash table rehash threshold", args[i]); diff --git a/src/lisp.h b/src/lisp.h index d8030728a5..be42b3354e 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1998,13 +1998,13 @@ struct Lisp_Hash_Table /* Number of key/value entries in the table. */ ptrdiff_t count; - /* Non-nil if the table can be purecopied. The table cannot be + /* True if the table can be purecopied. The table cannot be changed afterwards. */ - bool_bf pure : 1; + bool pure; - /* Resize hash table when number of entries/ table size is >= this - ratio, a float. */ - float rehash_threshold; + /* Resize hash table when number of entries / table size is >= this + ratio. */ + double rehash_threshold; /* Vector of keys and values. The key of item I is found at index 2 * I, the value is found at index 2 * I + 1. commit 5c1ebfc504bc0649a9e1105b1d9265c461739254 Author: Stefan Monnier Date: Sun Feb 19 13:12:16 2017 -0500 * src/insdel.c (make_gap): Increase enough to avoid O(N^2) behavior. diff --git a/src/insdel.c b/src/insdel.c index 3f933b0ad8..8b684fd278 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -560,7 +560,20 @@ void make_gap (ptrdiff_t nbytes_added) { if (nbytes_added >= 0) - make_gap_larger (nbytes_added); + /* With set-buffer-multibyte on a large buffer, we can end up growing the + * buffer *many* times. Avoid an O(N^2) behavior by increasing by an + * amount at least proportional to the size of the buffer. + * On my test (a 223.9MB zip file on a Thinkpad T61): + * With /5 => 24s + * With /32 => 25s + * With /64 => 26s + * With /128 => 28s + * With /1024 => 51s + * With /4096 => 131s + * With /∞ => gave up after 858s + * Of couse, ideally we should never call set-buffer-multibyte on + * a non-empty buffer (e.g. use buffer-swa-text instead). */ + make_gap_larger (max (nbytes_added, (Z - BEG) / 64)); #if defined USE_MMAP_FOR_BUFFERS || defined REL_ALLOC || defined DOUG_LEA_MALLOC else make_gap_smaller (-nbytes_added); commit f03d936cd7a9e22f68c8ac1c14516d5079307b90 Author: Eli Zaretskii Date: Sun Feb 19 18:40:52 2017 +0200 ; Minor fix of recent change in fringe.c * src/fringe.c (init_fringe_bitmap) [HAVE_NTGUI]: Remove an unnecessary #ifdef introduced in a recent change. diff --git a/src/fringe.c b/src/fringe.c index dbcd52be05..5d3108a6c7 100644 --- a/src/fringe.c +++ b/src/fringe.c @@ -1456,9 +1456,9 @@ init_fringe_bitmap (int which, struct fringe_bitmap *fb, int once_p) { unsigned short b = *bits; b <<= (16 - fb->width); -#ifndef WORDS_BIGENDIAN + /* Windows is little-endian, so the next line is always + needed. */ b = ((b >> 8) | (b << 8)); -#endif *bits++ = b; } #endif commit 35acb3950f546503b0000cde8854b251601f3fb4 Author: Eli Zaretskii Date: Sun Feb 19 18:35:48 2017 +0200 ; * src/fns.c (Fmake_hash_table): Prefer 'double' to 'float'. diff --git a/src/fns.c b/src/fns.c index ccb5230f5c..be00bfd868 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4390,7 +4390,7 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) (ptrdiff_t nargs, Lisp_Object *args) { Lisp_Object test, size, rehash_size, weak; - float rehash_threshold; + double rehash_threshold; bool pure; struct hash_table_test testdesc; ptrdiff_t i; commit b36f8a4d350735006293e01ab87208b579e67bf6 Author: Eli Zaretskii Date: Sun Feb 19 18:32:51 2017 +0200 Avoid aborts during loadup * src/emacs-module.c (syms_of_module): * src/image.c (xpm_make_color_table_h): Update calls to make_hash_table to adjust to a recent change in fns.c. * src/fns.c (make_hash_table): * src/lisp.h (make_hash_table): 4th arg is now of type double. diff --git a/src/emacs-module.c b/src/emacs-module.c index 69fa5c8e64..5a66b51651 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -1015,8 +1015,8 @@ syms_of_module (void) Vmodule_refs_hash = make_hash_table (hashtest_eq, make_number (DEFAULT_HASH_SIZE), make_float (DEFAULT_REHASH_SIZE), - make_float (DEFAULT_REHASH_THRESHOLD), - Qnil, Qnil); + DEFAULT_REHASH_THRESHOLD, + Qnil, false); Funintern (Qmodule_refs_hash, Qnil); DEFSYM (Qmodule_environments, "module-environments"); diff --git a/src/fns.c b/src/fns.c index e3e040b82d..ccb5230f5c 100644 --- a/src/fns.c +++ b/src/fns.c @@ -3676,7 +3676,7 @@ allocate_hash_table (void) Lisp_Object make_hash_table (struct hash_table_test test, Lisp_Object size, Lisp_Object rehash_size, - float rehash_threshold, Lisp_Object weak, + double rehash_threshold, Lisp_Object weak, bool pure) { struct Lisp_Hash_Table *h; diff --git a/src/image.c b/src/image.c index 1e8ebfd40d..0a6bbd17d8 100644 --- a/src/image.c +++ b/src/image.c @@ -4019,8 +4019,8 @@ xpm_make_color_table_h (void (**put_func) (Lisp_Object, const char *, int, *get_func = xpm_get_color_table_h; return make_hash_table (hashtest_equal, make_number (DEFAULT_HASH_SIZE), make_float (DEFAULT_REHASH_SIZE), - make_float (DEFAULT_REHASH_THRESHOLD), - Qnil, Qnil); + DEFAULT_REHASH_THRESHOLD, + Qnil, false); } static void diff --git a/src/lisp.h b/src/lisp.h index 985d54a079..d8030728a5 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3363,7 +3363,7 @@ EMACS_UINT hash_string (char const *, ptrdiff_t); EMACS_UINT sxhash (Lisp_Object, int); Lisp_Object make_hash_table (struct hash_table_test test, Lisp_Object size, Lisp_Object rehash_size, - float rehash_threshold, Lisp_Object weak, + double rehash_threshold, Lisp_Object weak, bool pure); ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *); ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object, commit 143bc75c414434badcb324db056ad37c15893bd9 Author: Michael Albinus Date: Sun Feb 19 17:14:35 2017 +0100 Rework connection local variables For connection local variables interface, `class' is renamed to `profile'. All arguments `criteria' are a plist now. * doc/lispref/variables.texi (Connection Local Variables): Rewrite. * lisp/files-x.el (connection-local-profile-alist): Rename from `connection-local-class-alist'. Adapt docstring. (connection-local-criteria-alist): Adapt docstring. (connection-local-normalize-criteria): New defun. (connection-local-get-profiles): Rename from `connection-local-get-classes'. Rewrite. (connection-local-set-profiles): Rename from `connection-local-set-classes'. Rewrite. (connection-local-get-profile-variables): Rename from `connection-local-get-class-variables'. Rewrite. (connection-local-set-profile-variables): Rename from `connection-local-set-class-variables'. Rewrite. (hack-connection-local-variables) (hack-connection-local-variables-apply)): Rewrite. (with-connection-local-profiles): Rename from `ith-connection-local-classes'. Rewrite. * lisp/net/tramp.el (tramp-set-connection-local-variables): Compute criteria. * lisp/net/tramp-cmds.el (tramp-bug): Use `connection-local-profile-alist'. * test/lisp/files-x-tests.el (files-x-test--variables1) (files-x-test--variables2, files-x-test--variables3) (files-x-test--variables4, files-x-test--criteria1) (files-x-test--criteria2): Make them a defconst. (files-x-test--application) (files-x-test--another-application, files-x-test--protocol) (files-x-test--user, files-x-test--machine): New defconst. (files-x-test--criteria): New defvar. (files-x-test--criteria3): Remove. (files-x-test-connection-local-set-profile-variables): Rename from `files-x-test-connection-local-set-class-variables'. Rewrite. (files-x-test-connection-local-set-profiles): Rename from `files-x-test-connection-local-set-classes'. Rewrite. (files-x-test-hack-connection-local-variables-apply) Rewrite. (files-x-test-with-connection-local-profiles): Rename from `files-x-test-with-connection-local-classes'. Rewrite. diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 8a61018a61..2818ea067d 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -1979,24 +1979,21 @@ still respecting file-local variables (@pxref{File Local Variables}). @section Connection Local Variables @cindex connection local variables - Connection-local variables provide a general mechanism for -different variable settings in buffers with a remote default -directory. They are bound and set depending on the remote connection -a buffer is dedicated to. Per default, they are set in all process -buffers for a remote connection, but they could be applied also in -other buffers with a remote directory. - -@defun connection-local-set-class-variables class variables -This function defines a set of variable settings for the named -@var{class}, which is a symbol. You can later assign the class to one -or more remote connections, and Emacs will apply those variable -settings to all process buffers for those connections. The list in -@var{variables} is an alist of the form @code{(@var{name} -. @var{value})}. Example: + Connection-local variables provide a general mechanism for different +variable settings in buffers with a remote connection. They are bound +and set depending on the remote connection a buffer is dedicated to. + +@defun connection-local-set-profile-variables profile variables +This function defines a set of variable settings for the connection +@var{profile}, which is a symbol. You can later assign the connection +profile to one or more remote connections, and Emacs will apply those +variable settings to all process buffers for those connections. The +list in @var{variables} is an alist of the form +@code{(@var{name}@tie{}.@tie{}@var{value})}. Example: @example @group -(connection-local-set-class-variables +(connection-local-set-profile-variables 'remote-bash '((shell-file-name . "/bin/bash") (shell-command-switch . "-c") @@ -2005,7 +2002,7 @@ settings to all process buffers for those connections. The list in @end group @group -(connection-local-set-class-variables +(connection-local-set-profile-variables 'remote-ksh '((shell-file-name . "/bin/ksh") (shell-command-switch . "-c") @@ -2014,38 +2011,41 @@ settings to all process buffers for those connections. The list in @end group @group -(connection-local-set-class-variables +(connection-local-set-profile-variables 'remote-null-device '((null-device . "/dev/null"))) @end group @end example @end defun -@defvar connection-local-class-alist -This alist holds the class symbols and the associated variable -settings. It is updated by @code{connection-local-set-class-variables}. +@defvar connection-local-profile-alist +This alist holds the connection profile symbols and the associated +variable settings. It is updated by +@code{connection-local-set-profile-variables}. @end defvar -@defun connection-local-set-classes criteria &rest classes -This function assigns @var{classes}, which are symbols, to all remote -connections identified by @var{criteria}. @var{criteria} is either a -regular expression identifying a remote server, or a function with one -argument @var{identification}, which must return non-nil when a remote -server shall apply @var{classes} variables, or @code{nil}. - -If @var{criteria} is a regexp, is must match the result of -@code{(file-remote-p default-directory)} of a buffer in order to apply -the variables setting. Example: +@defun connection-local-set-profiles criteria &rest profiles +This function assigns @var{profiles}, which are symbols, to all remote +connections identified by @var{criteria}. @var{criteria} is a plist +identifying a connection and the application using this connection. +Property names might be @code{:application}, @code{:protocol}, +@code{:user} and @code{:machine}. The property value of +@code{:application} is a symbol, all other property values are +strings. All properties are optional; if @var{criteria} is nil, it +always applies. Example: @example @group -(connection-local-set-classes - "^/ssh:" 'remote-bash 'remote-null-device) +(connection-local-set-profiles + '(:application 'tramp :protocol "ssh" :machine "localhost") + 'remote-bash 'remote-null-device) @end group @group -(connection-local-set-classes - "^/sudo:" 'remote-ksh 'remote-null-device) +(connection-local-set-profiles + '(:application 'tramp :protocol "sudo" + :user "root" :machine "localhost") + 'remote-ksh 'remote-null-device) @end group @end example @@ -2053,82 +2053,80 @@ the variables setting. Example: Therefore, the example above would be equivalent to @example -(connection-local-set-classes "^/ssh:" 'remote-bash) -(connection-local-set-classes "^/sudo:" 'remote-ksh) -(connection-local-set-classes nil 'remote-null-device) -@end example - - If @var{criteria} is a lambda function it must accept one parameter, -the identification. The example above could be rewritten as - -@example @group -(connection-local-set-classes - (lambda (identification) - (string-equal (file-remote-p identification 'method) "ssh")) +(connection-local-set-profiles + '(:application 'tramp :protocol "ssh" :machine "localhost") 'remote-bash) @end group @group -(connection-local-set-classes - (lambda (identification) - (string-equal (file-remote-p identification 'method) "sudo")) +(connection-local-set-profiles + '(:application 'tramp :protocol "sudo" + :user "root" :machine "localhost") 'remote-ksh) @end group @group -(connection-local-set-classes - (lambda (identification) t) - 'remote-null-device) +(connection-local-set-profiles + nil 'remote-null-device) @end group @end example - Thereafter, all the variable settings specified for @var{classes} -will be applied to any buffer with a matching remote directory, when -activated by @code{hack-connection-local-variables-apply}. Any class -of @var{classes} must have been already defined by -@code{connection-local-set-class-variables}. + Any connection profile of @var{profiles} must have been already +defined by @code{connection-local-set-profile-variables}. @end defun @defvar connection-local-criteria-alist -This alist contains remote server identifications and their assigned -class names. The function @code{connection-local-set-classes} updates -this list. +This alist contains connection criteria and their assigned profile +names. The function @code{connection-local-set-profiles} updates this +list. @end defvar -@defun hack-connection-local-variables -This function collects applicable connection-local variables in -@code{connection-local-variables-alist} that is local to the buffer, -without applying them. Whether a connection-local variable is -applicable is specified by the remote identifier of a buffer, -evaluated by @code{(file-remote-p default-directory)}. +@defun hack-connection-local-variables criteria +This function collects applicable connection-local variables +associated with @var{criteria} in +@code{connection-local-variables-alist}, without applying them. +Example: + +@example +@group +(hack-connection-local-variables + '(:application 'tramp :protocol "ssh" :machine "localhost")) +@end group + +@group +connection-local-variables-alist + @result{} ((null-device . "/dev/null") + (shell-login-switch . "-l") + (shell-interactive-switch . "-i") + (shell-command-switch . "-c") + (shell-file-name . "/bin/bash")) +@end group +@end example @end defun -@defun hack-connection-local-variables-apply -This function looks for connection-local variables, and immediately -applies them in the current buffer. It is called per default for -every process-buffer related to a remote connection. For other remote -buffers, it could be called by any mode. +@defun hack-connection-local-variables-apply criteria +This function looks for connection-local variables according to +@var{criteria}, and immediately applies them in the current buffer. @end defun -@defmac with-connection-local-classes classes &rest body -All connection-local variables, which are specified by a class in -@var{classes}, are applied. An implicit binding of the classes to the -remote connection is enabled. +@defmac with-connection-local-profiles profiles &rest body +All connection-local variables, which are specified by a connection +profile in @var{profiles}, are applied. After that, @var{body} is executed, and the connection-local variables are unwound. Example: @example @group -(connection-local-set-class-variables +(connection-local-set-profile-variables 'remote-perl '((perl-command-name . "/usr/local/bin/perl") (perl-command-switch . "-e %s"))) @end group @group -(with-connection-local-classes '(remote-perl) +(with-connection-local-profiles '(remote-perl) do something useful) @end group @end example diff --git a/lisp/files-x.el b/lisp/files-x.el index 2b4658f642..a0cad70842 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el @@ -559,119 +559,132 @@ changed by the user.") (setq ignored-local-variables (cons 'connection-local-variables-alist ignored-local-variables)) -(defvar connection-local-class-alist '() - "Alist mapping connection-local variable classes (symbols) to variable lists. -Each element in this list has the form (CLASS VARIABLES). -CLASS is the name of a variable class (a symbol). +(defvar connection-local-profile-alist '() + "Alist mapping connection profiles to variable lists. +Each element in this list has the form (PROFILE VARIABLES). +PROFILE is the name of a connection profile (a symbol). VARIABLES is a list that declares connection-local variables for -CLASS. An element in VARIABLES is an alist whose elements are of -the form (VAR . VALUE).") +PROFILE. An element in VARIABLES is an alist whose elements are +of the form (VAR . VALUE).") (defvar connection-local-criteria-alist '() - "Alist mapping criteria to connection-local variable classes (symbols). -Each element in this list has the form (CRITERIA CLASSES). -CRITERIA is either a regular expression identifying a remote -server, or a function with one argument IDENTIFICATION, which -returns non-nil when a remote server shall apply CLASS'es -variables. If CRITERIA is nil, it always applies. -CLASSES is a list of variable classes (symbols).") - -(defsubst connection-local-get-classes (criteria &optional identification) - "Return the connection-local classes list for CRITERIA. -CRITERIA is either a regular expression identifying a remote -server, or a function with one argument IDENTIFICATION, which -returns non-nil when a remote server shall apply CLASS'es -variables. If CRITERIA is nil, it always applies. -If IDENTIFICATION is non-nil, CRITERIA must be nil, or match -IDENTIFICATION accordingly." - (and (cond ((null identification)) - ((not (stringp identification)) - (error "Wrong identification `%s'" identification)) - ((null criteria)) - ((stringp criteria) (string-match criteria identification)) - ((functionp criteria) (funcall criteria identification)) - (t "Wrong criteria `%s'" criteria)) - (cdr (assoc criteria connection-local-criteria-alist)))) + "Alist mapping connection criteria to connection profiles. +Each element in this list has the form (CRITERIA PROFILES). +CRITERIA is a plist identifying a connection and the application +using this connection. Property names might be `:application', +`:protocol', `:user' and `:machine'. The property value of +`:application' is a symbol, all other property values are +strings. All properties are optional; if CRITERIA is nil, it +always applies. +PROFILES is a list of connection profiles (symbols).") + +(defsubst connection-local-normalize-criteria (criteria &rest properties) + "Normalize plist CRITERIA according to PROPERTIES. +Return a new ordered plist list containing only property names from PROPERTIES." + (delq + nil + (mapcar + (lambda (property) + (when (plist-member criteria property) + (list property (plist-get criteria property)))) + properties))) + +(defsubst connection-local-get-profiles (criteria) + "Return the connection profiles list for CRITERIA. +CRITERIA is a plist identifying a connection and the application +using this connection, see `connection-local-criteria-alist'." + (or (cdr + (assoc + (connection-local-normalize-criteria + criteria :application :protocol :user :machine) + connection-local-criteria-alist)) + ;; Try it without :application. + (cdr + (assoc + (connection-local-normalize-criteria criteria :protocol :user :machine) + connection-local-criteria-alist)))) ;;;###autoload -(defun connection-local-set-classes (criteria &rest classes) - "Add CLASSES for remote servers. +(defun connection-local-set-profiles (criteria &rest profiles) + "Add PROFILES for remote servers. CRITERIA is either a regular expression identifying a remote server, or a function with one argument IDENTIFICATION, which -returns non-nil when a remote server shall apply CLASS'es +returns non-nil when a remote server shall apply PROFILE's variables. If CRITERIA is nil, it always applies. -CLASSES are the names of a variable class (a symbol). +PROFILES are the names of a connection profile (a symbol). When a connection to a remote server is opened and CRITERIA -matches to that server, the connection-local variables from CLASSES -are applied to the corresponding process buffer. The variables -for a class are defined using `connection-local-set-class-variables'." - (unless (or (null criteria) (stringp criteria) (functionp criteria)) +matches to that server, the connection-local variables from +PROFILES are applied to the corresponding process buffer. The +variables for a connection profile are defined using +`connection-local-set-profile-variables'." + (unless (listp criteria) (error "Wrong criteria `%s'" criteria)) - (dolist (class classes) - (unless (assq class connection-local-class-alist) - (error "No such class `%s'" (symbol-name class)))) - (let ((slot (assoc criteria connection-local-criteria-alist))) + (dolist (profile profiles) + (unless (assq profile connection-local-profile-alist) + (error "No such connection profile `%s'" (symbol-name profile)))) + (let* ((criteria (connection-local-normalize-criteria + criteria :application :protocol :user :machine)) + (slot (assoc criteria connection-local-criteria-alist))) (if slot - (setcdr slot (delete-dups (append (cdr slot) classes))) + (setcdr slot (delete-dups (append (cdr slot) profiles))) (setq connection-local-criteria-alist - (cons (cons criteria (delete-dups classes)) + (cons (cons criteria (delete-dups profiles)) connection-local-criteria-alist))))) -(defsubst connection-local-get-class-variables (class) - "Return the connection-local variable list for CLASS." - (cdr (assq class connection-local-class-alist))) +(defsubst connection-local-get-profile-variables (profile) + "Return the connection-local variable list for PROFILE." + (cdr (assq profile connection-local-profile-alist))) ;;;###autoload -(defun connection-local-set-class-variables (class variables) - "Map the symbol CLASS to a list of variable settings. +(defun connection-local-set-profile-variables (profile variables) + "Map the symbol PROFILE to a list of variable settings. VARIABLES is a list that declares connection-local variables for -the class. An element in VARIABLES is an alist whose elements -are of the form (VAR . VALUE). +the connection profile. An element in VARIABLES is an alist +whose elements are of the form (VAR . VALUE). When a connection to a remote server is opened, the server's -classes are found. A server may be assigned a class using -`connection-local-set-class'. Then variables are set in the -server's process buffer according to the VARIABLES list of the -class. The list is processed in order." - (setf (alist-get class connection-local-class-alist) variables)) - -(defun hack-connection-local-variables () - "Read per-connection local variables for the current buffer. -Store the connection-local variables in `connection-local-variables-alist'. +connection profiles are found. A server may be assigned a +connection profile using `connection-local-set-profile'. Then +variables are set in the server's process buffer according to the +VARIABLES list of the connection profile. The list is processed +in order." + (setf (alist-get profile connection-local-profile-alist) variables)) + +(defun hack-connection-local-variables (criteria) + "Read connection-local variables according to CRITERIA. +Store the connection-local variables in buffer local +variable`connection-local-variables-alist'. This does nothing if `enable-connection-local-variables' is nil." - (let ((identification (file-remote-p default-directory))) - (when (and enable-connection-local-variables identification) - ;; Loop over criteria. - (dolist (criteria (mapcar 'car connection-local-criteria-alist)) - ;; Filter classes which map identification. - (dolist (class (connection-local-get-classes criteria identification)) - ;; Loop over variables. - (dolist (variable (connection-local-get-class-variables class)) - (unless (assq (car variable) connection-local-variables-alist) - (push variable connection-local-variables-alist)))))))) + (when enable-connection-local-variables + ;; Filter connection profiles. + (dolist (profile (connection-local-get-profiles criteria)) + ;; Loop over variables. + (dolist (variable (connection-local-get-profile-variables profile)) + (unless (assq (car variable) connection-local-variables-alist) + (push variable connection-local-variables-alist)))))) ;;;###autoload -(defun hack-connection-local-variables-apply () - "Apply connection-local variables identified by `default-directory'. +(defun hack-connection-local-variables-apply (criteria) + "Apply connection-local variables identified by CRITERIA. Other local variables, like file-local and dir-local variables, will not be changed." - (hack-connection-local-variables) + (hack-connection-local-variables criteria) (let ((file-local-variables-alist (copy-tree connection-local-variables-alist))) (hack-local-variables-apply))) ;;;###autoload -(defmacro with-connection-local-classes (classes &rest body) - "Apply connection-local variables according to CLASSES in current buffer. +(defmacro with-connection-local-profiles (profiles &rest body) + "Apply connection-local variables according to PROFILES in current buffer. Execute BODY, and unwind connection local variables." (declare (indent 1) (debug t)) `(let ((enable-connection-local-variables t) (old-buffer-local-variables (buffer-local-variables)) connection-local-variables-alist connection-local-criteria-alist) - (apply 'connection-local-set-classes "" ,classes) - (hack-connection-local-variables-apply) + (apply 'connection-local-set-profiles nil ,profiles) + (hack-connection-local-variables-apply nil) (unwind-protect (progn ,@body) ;; Cleanup. diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index 05adaa49e3..576f9b1ead 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -190,7 +190,7 @@ This includes password cache, file cache, connection cache, buffers." password-cache password-cache-expiry remote-file-name-inhibit-cache - connection-local-class-alist + connection-local-profile-alist connection-local-criteria-alist file-name-handler-alist)))) (lambda (x y) (string< (symbol-name (car x)) (symbol-name (car y))))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index b05d55f9e0..891f961245 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1342,10 +1342,18 @@ from the default one." "Set connection-local variables in the connection buffer used for VEC. If connection-local variables are not supported by this Emacs version, the function does nothing." - ;; `tramp-get-connection-buffer' sets proper `default-directory'." (with-current-buffer (tramp-get-connection-buffer vec) ;; `hack-connection-local-variables-apply' exists since Emacs 26.1. - (tramp-compat-funcall 'hack-connection-local-variables-apply))) + (tramp-compat-funcall + 'hack-connection-local-variables-apply + (append + '(tramp) + (when (tramp-file-name-method vec) + `(:protocol ,(tramp-file-name-method vec))) + (when (tramp-file-name-user vec) + `(:user ,(tramp-file-name-user vec))) + (when (tramp-file-name-host vec) + `(:machine ,(tramp-file-name-host vec))))))) (defun tramp-debug-buffer-name (vec) "A name for the debug buffer for VEC." diff --git a/test/lisp/files-x-tests.el b/test/lisp/files-x-tests.el index 88b58fe957..21d0087ebc 100644 --- a/test/lisp/files-x-tests.el +++ b/test/lisp/files-x-tests.el @@ -24,130 +24,167 @@ (require 'ert) (require 'files-x) -(defvar files-x-test--criteria1 "my-user@my-remote-host") -(defvar files-x-test--criteria2 - (lambda (identification) - (string-match "another-user@my-remote-host" identification))) -(defvar files-x-test--criteria3 nil) - -(defvar files-x-test--variables1 +(defconst files-x-test--variables1 '((remote-shell-file-name . "/bin/bash") (remote-shell-command-switch . "-c") (remote-shell-interactive-switch . "-i") (remote-shell-login-switch . "-l"))) -(defvar files-x-test--variables2 +(defconst files-x-test--variables2 '((remote-shell-file-name . "/bin/ksh"))) -(defvar files-x-test--variables3 +(defconst files-x-test--variables3 '((remote-null-device . "/dev/null"))) -(defvar files-x-test--variables4 +(defconst files-x-test--variables4 '((remote-null-device . "null"))) -(ert-deftest files-x-test-connection-local-set-class-variables () - "Test setting connection-local class variables." - - ;; Declare (CLASS VARIABLES) objects. - (let (connection-local-class-alist connection-local-criteria-alist) - (connection-local-set-class-variables 'remote-bash files-x-test--variables1) +(defconst files-x-test--application '(:application 'my-application)) +(defconst files-x-test--another-application + '(:application 'another-application)) +(defconst files-x-test--protocol '(:protocol "my-protocol")) +(defconst files-x-test--user '(:user "my-user")) +(defconst files-x-test--machine '(:machine "my-machine")) + +(defvar files-x-test--criteria nil) +(defconst files-x-test--criteria1 + (append files-x-test--application files-x-test--protocol + files-x-test--user files-x-test--machine)) +(defconst files-x-test--criteria2 + (append files-x-test--another-application files-x-test--protocol + files-x-test--user files-x-test--machine)) + +(ert-deftest files-x-test-connection-local-set-profile-variables () + "Test setting connection-local profile variables." + + ;; Declare (PROFILE VARIABLES) objects. + (let (connection-local-profile-alist connection-local-criteria-alist) + (connection-local-set-profile-variables + 'remote-bash files-x-test--variables1) (should (equal - (connection-local-get-class-variables 'remote-bash) + (connection-local-get-profile-variables 'remote-bash) files-x-test--variables1)) - (connection-local-set-class-variables 'remote-ksh files-x-test--variables2) + (connection-local-set-profile-variables + 'remote-ksh files-x-test--variables2) (should (equal - (connection-local-get-class-variables 'remote-ksh) + (connection-local-get-profile-variables 'remote-ksh) files-x-test--variables2)) - (connection-local-set-class-variables + (connection-local-set-profile-variables 'remote-nullfile files-x-test--variables3) (should (equal - (connection-local-get-class-variables 'remote-nullfile) + (connection-local-get-profile-variables 'remote-nullfile) files-x-test--variables3)) ;; A redefinition overwrites existing values. - (connection-local-set-class-variables + (connection-local-set-profile-variables 'remote-nullfile files-x-test--variables4) (should (equal - (connection-local-get-class-variables 'remote-nullfile) + (connection-local-get-profile-variables 'remote-nullfile) files-x-test--variables4)))) -(ert-deftest files-x-test-connection-local-set-classes () - "Test setting connection-local classes." +(ert-deftest files-x-test-connection-local-set-profiles () + "Test setting connection-local profiles." - ;; Declare (CRITERIA CLASSES) objects. - (let (connection-local-class-alist connection-local-criteria-alist) - (connection-local-set-class-variables 'remote-bash files-x-test--variables1) - (connection-local-set-class-variables 'remote-ksh files-x-test--variables2) - (connection-local-set-class-variables + ;; Declare (CRITERIA PROFILES) objects. + (let (connection-local-profile-alist connection-local-criteria-alist) + (connection-local-set-profile-variables + 'remote-bash files-x-test--variables1) + (connection-local-set-profile-variables + 'remote-ksh files-x-test--variables2) + (connection-local-set-profile-variables 'remote-nullfile files-x-test--variables3) - (connection-local-set-classes - files-x-test--criteria1 'remote-bash 'remote-ksh) + ;; Use a criteria with all properties. + (setq files-x-test--criteria + (append files-x-test--application files-x-test--protocol + files-x-test--user files-x-test--machine)) + ;; An empty variable list is accepted (but makes no sense). + (connection-local-set-profiles files-x-test--criteria) + (should-not (connection-local-get-profiles files-x-test--criteria)) + (connection-local-set-profiles + files-x-test--criteria 'remote-bash 'remote-ksh) (should (equal - (connection-local-get-classes files-x-test--criteria1) + (connection-local-get-profiles files-x-test--criteria) '(remote-bash remote-ksh))) - - (connection-local-set-classes files-x-test--criteria2 'remote-ksh) + ;; Changing the order of properties doesn't matter. + (setq files-x-test--criteria + (append files-x-test--protocol files-x-test--application + files-x-test--machine files-x-test--user)) (should (equal - (connection-local-get-classes files-x-test--criteria2) - '(remote-ksh))) - ;; A further call adds classes. - (connection-local-set-classes files-x-test--criteria2 'remote-nullfile) + (connection-local-get-profiles files-x-test--criteria) + '(remote-bash remote-ksh))) + ;; A further call adds profiles. + (connection-local-set-profiles files-x-test--criteria 'remote-nullfile) (should (equal - (connection-local-get-classes files-x-test--criteria2) - '(remote-ksh remote-nullfile))) - ;; Adding existing classes doesn't matter. - (connection-local-set-classes - files-x-test--criteria2 'remote-bash 'remote-nullfile) + (connection-local-get-profiles files-x-test--criteria) + '(remote-bash remote-ksh remote-nullfile))) + ;; Adding existing profiles doesn't matter. + (connection-local-set-profiles + files-x-test--criteria 'remote-bash 'remote-nullfile) (should (equal - (connection-local-get-classes files-x-test--criteria2) - '(remote-ksh remote-nullfile remote-bash))) - - ;; An empty variable list is accepted (but makes no sense). - (connection-local-set-classes files-x-test--criteria3) - (should-not (connection-local-get-classes files-x-test--criteria3)) + (connection-local-get-profiles files-x-test--criteria) + '(remote-bash remote-ksh remote-nullfile))) + + ;; Use a criteria without application. + (setq files-x-test--criteria + (append files-x-test--protocol + files-x-test--user files-x-test--machine)) + (connection-local-set-profiles files-x-test--criteria 'remote-ksh) + (should + (equal + (connection-local-get-profiles files-x-test--criteria) + '(remote-ksh))) + ;; An application not used in any registered criteria matches also this. + (setq files-x-test--criteria + (append files-x-test--another-application files-x-test--protocol + files-x-test--user files-x-test--machine)) + (should + (equal + (connection-local-get-profiles files-x-test--criteria) + '(remote-ksh))) - ;; Using a nil criteria also works. Duplicate classes are trashed. - (connection-local-set-classes - files-x-test--criteria3 'remote-bash 'remote-ksh 'remote-ksh 'remote-bash) + ;; Using a nil criteria also works. Duplicate profiles are trashed. + (connection-local-set-profiles + nil 'remote-bash 'remote-ksh 'remote-ksh 'remote-bash) (should (equal - (connection-local-get-classes files-x-test--criteria3) + (connection-local-get-profiles nil) '(remote-bash remote-ksh))) - ;; A criteria other than nil, regexp or lambda function is wrong. - (should-error (connection-local-set-classes 'dummy)))) + ;; A criteria other than plist is wrong. + (should-error (connection-local-set-profiles 'dummy)))) (ert-deftest files-x-test-hack-connection-local-variables-apply () "Test setting connection-local variables." - (let (connection-local-class-alist connection-local-criteria-alist) + (let (connection-local-profile-alist connection-local-criteria-alist) - (connection-local-set-class-variables 'remote-bash files-x-test--variables1) - (connection-local-set-class-variables 'remote-ksh files-x-test--variables2) - (connection-local-set-class-variables + (connection-local-set-profile-variables + 'remote-bash files-x-test--variables1) + (connection-local-set-profile-variables + 'remote-ksh files-x-test--variables2) + (connection-local-set-profile-variables 'remote-nullfile files-x-test--variables3) - (connection-local-set-classes + (connection-local-set-profiles files-x-test--criteria1 'remote-bash 'remote-ksh) - (connection-local-set-classes + (connection-local-set-profiles files-x-test--criteria2 'remote-ksh 'remote-nullfile) ;; Apply the variables. (with-temp-buffer - (let ((enable-connection-local-variables t) - (default-directory "/sudo:my-user@my-remote-host:")) + (let ((enable-connection-local-variables t)) (should-not connection-local-variables-alist) (should-not (local-variable-p 'remote-shell-file-name)) (should-not (boundp 'remote-shell-file-name)) - (hack-connection-local-variables-apply) + (hack-connection-local-variables-apply files-x-test--criteria1) ;; All connection-local variables are set. They apply in ;; reverse order in `connection-local-variables-alist'. The ;; settings from `remote-ksh' are not contained, because they @@ -163,12 +200,11 @@ ;; The second test case. (with-temp-buffer - (let ((enable-connection-local-variables t) - (default-directory "/ssh:another-user@my-remote-host:")) + (let ((enable-connection-local-variables t)) (should-not connection-local-variables-alist) (should-not (local-variable-p 'remote-shell-file-name)) (should-not (boundp 'remote-shell-file-name)) - (hack-connection-local-variables-apply) + (hack-connection-local-variables-apply files-x-test--criteria2) ;; All connection-local variables are set. They apply in ;; reverse order in `connection-local-variables-alist'. (should @@ -182,18 +218,17 @@ (should (string-equal (symbol-value 'remote-shell-file-name) "/bin/ksh")))) - ;; The third test case. Both `files-x-test--criteria1' and - ;; `files-x-test--criteria3' apply, but there are no double + ;; The third test case. Both criteria `files-x-test--criteria1' + ;; and `files-x-test--criteria2' apply, but there are no double ;; entries. - (connection-local-set-classes - files-x-test--criteria3 'remote-bash 'remote-ksh) + (connection-local-set-profiles + nil 'remote-bash 'remote-ksh) (with-temp-buffer - (let ((enable-connection-local-variables t) - (default-directory "/sudo:my-user@my-remote-host:")) + (let ((enable-connection-local-variables t)) (should-not connection-local-variables-alist) (should-not (local-variable-p 'remote-shell-file-name)) (should-not (boundp 'remote-shell-file-name)) - (hack-connection-local-variables-apply) + (hack-connection-local-variables-apply nil) ;; All connection-local variables are set. They apply in ;; reverse order in `connection-local-variables-alist'. The ;; settings from `remote-ksh' are not contained, because they @@ -209,31 +244,32 @@ ;; When `enable-connection-local-variables' is nil, nothing happens. (with-temp-buffer - (let ((enable-connection-local-variables nil) - (default-directory "/ssh:another-user@my-remote-host:")) + (let ((enable-connection-local-variables nil)) (should-not connection-local-variables-alist) (should-not (local-variable-p 'remote-shell-file-name)) (should-not (boundp 'remote-shell-file-name)) - (hack-connection-local-variables-apply) + (hack-connection-local-variables-apply nil) (should-not connection-local-variables-alist) (should-not (local-variable-p 'remote-shell-file-name)) (should-not (boundp 'remote-shell-file-name)))))) -(ert-deftest files-x-test-with-connection-local-classes () +(ert-deftest files-x-test-with-connection-local-profiles () "Test setting connection-local variables." - (let (connection-local-class-alist connection-local-criteria-alist) - (connection-local-set-class-variables 'remote-bash files-x-test--variables1) - (connection-local-set-class-variables 'remote-ksh files-x-test--variables2) - (connection-local-set-class-variables + (let (connection-local-profile-alist connection-local-criteria-alist) + (connection-local-set-profile-variables + 'remote-bash files-x-test--variables1) + (connection-local-set-profile-variables + 'remote-ksh files-x-test--variables2) + (connection-local-set-profile-variables 'remote-nullfile files-x-test--variables3) - (connection-local-set-classes - files-x-test--criteria3 'remote-ksh 'remote-nullfile) + + (connection-local-set-profiles + nil 'remote-ksh 'remote-nullfile) (with-temp-buffer - (let ((enable-connection-local-variables t) - (default-directory "/sudo:my-user@my-remote-host:")) - (hack-connection-local-variables-apply) + (let ((enable-connection-local-variables t)) + (hack-connection-local-variables-apply nil) ;; All connection-local variables are set. They apply in ;; reverse order in `connection-local-variables-alist'. @@ -255,7 +291,7 @@ (should-not (local-variable-p 'remote-shell-command-switch)) ;; Use the macro. - (with-connection-local-classes '(remote-bash remote-ksh) + (with-connection-local-profiles '(remote-bash remote-ksh) ;; All connection-local variables are set. They apply in ;; reverse order in `connection-local-variables-alist'. ;; This variable keeps only the variables to be set inside commit b6a1a74522120979fe1a63b2d5517a490ee572b0 Author: Mark Oteiza Date: Sun Feb 19 08:55:45 2017 -0500 ; Fix previous change Actually adjust the comment. * lisp/play/dunnet.el: Change comment to refer to section, add page break to better demarcate section. diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el index 1c8fab0509..755c6583e7 100644 --- a/lisp/play/dunnet.el +++ b/lisp/play/dunnet.el @@ -48,7 +48,7 @@ ;;;; ;;;; IMPORTANT ;;;; All globals which can change must be saved from 'save-game. Add -;;;; all new globals to bottom of file. +;;;; all new globals to bottom of this section. (defvar dun-visited '(27)) (defvar dun-current-room 1) @@ -1125,6 +1125,7 @@ treasures for points?" "4" "four") (defconst dun-combination (prin1-to-string (+ 100 (random 899)))) + ;;;; Mode definitions for interactive mode (define-derived-mode dun-mode text-mode "Dungeon" commit 7455c2ad80ec0cdf009d9f2396127c58ded2dc3c Author: Mark Oteiza Date: Tue Jan 17 23:15:25 2017 -0500 Set up combination and random item location * lisp/play/dunnet.el (dun-combination): Make defconst. (tloc, tcomb): Remove. Replace with a top-level form. diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el index 95a9e9ce7d..1c8fab0509 100644 --- a/lisp/play/dunnet.el +++ b/lisp/play/dunnet.el @@ -1123,6 +1123,8 @@ treasures for points?" "4" "four") ("What network protocol is used between pokey and gamma?" "tcp/ip" "ip" "tcp"))) +(defconst dun-combination (prin1-to-string (+ 100 (random 899)))) + ;;;; Mode definitions for interactive mode (define-derived-mode dun-mode text-mode "Dungeon" @@ -2964,12 +2966,9 @@ drwxr-xr-x 3 root staff 2048 Jan 1 1970 ..") (dun-uexit nil))) -(setq tloc (+ 60 (random 18))) -(dun-replace dun-room-objects tloc - (append (nth tloc dun-room-objects) (list 18))) - -(setq tcomb (+ 100 (random 899))) -(setq dun-combination (prin1-to-string tcomb)) +(let ((tloc (+ 60 (random 18)))) + (dun-replace dun-room-objects tloc + (append (nth tloc dun-room-objects) (list 18)))) ;;;; ;;;; This section defines the DOS emulation functions for dunnet commit 44931dafa95ed0e00a639168712fbabeb35569f4 Author: Mark Oteiza Date: Tue Jan 17 22:05:48 2017 -0500 Replace movement variables with an alist and accessor * lisp/play/dunnet.el (north, south, east, west, northeast, southeast): (northwest, southwest, up, down, in, out): Remove. (dun-movement-alist): New constant. (dun-movement): New function. (dun-n, dun-s, dun-e, dun-w, dun-ne, dun-se, dun-nw, dun-sw, dun-up): (dun-down, dun-in, dun-out): Use a symbol for indicating movement. (dun-move, dun-special-move): Translate movement symbol to an enumeration. diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el index b6392c12e7..95a9e9ce7d 100644 --- a/lisp/play/dunnet.el +++ b/lisp/play/dunnet.el @@ -644,18 +644,20 @@ A hole leads north." (defvar dun-mode 'moby) (defvar dun-sauna-level 0) -(defconst north 0) -(defconst south 1) -(defconst east 2) -(defconst west 3) -(defconst northeast 4) -(defconst southeast 5) -(defconst northwest 6) -(defconst southwest 7) -(defconst up 8) -(defconst down 9) -(defconst in 10) -(defconst out 11) +(defconst dun-movement-alist + '((north . 0) + (south . 1) + (east . 2) + (west . 3) + (northeast . 4) + (southeast . 5) + (northwest . 6) + (southwest . 7) + (up . 8) + (down . 9) + (in . 10) + (out . 11)) + "Alist enumerating movement directions.") (defconst dungeon-map ;; no so ea we ne se nw sw up do in ot @@ -1645,41 +1647,45 @@ just try dropping it.") ;;; Various movement directions +(defun dun-movement (dir) + "Return enumeral of movement symbol DIR." + (cdr (assq dir dun-movement-alist))) + (defun dun-n (_args) - (dun-move north)) + (dun-move 'north)) (defun dun-s (_args) - (dun-move south)) + (dun-move 'south)) (defun dun-e (_args) - (dun-move east)) + (dun-move 'east)) (defun dun-w (_args) - (dun-move west)) + (dun-move 'west)) (defun dun-ne (_args) - (dun-move northeast)) + (dun-move 'northeast)) (defun dun-se (_args) - (dun-move southeast)) + (dun-move 'southeast)) (defun dun-nw (_args) - (dun-move northwest)) + (dun-move 'northwest)) (defun dun-sw (_args) - (dun-move southwest)) + (dun-move 'southwest)) (defun dun-up (_args) - (dun-move up)) + (dun-move 'up)) (defun dun-down (_args) - (dun-move down)) + (dun-move 'down)) (defun dun-in (_args) - (dun-move in)) + (dun-move 'in)) (defun dun-out (_args) - (dun-move out)) + (dun-move 'out)) (defun dun-go (args) (if (or (not (car args)) @@ -1701,6 +1707,7 @@ just try dropping it.") "You trip over a grue and fall into a pit and break every bone in your body.") (dun-die "a grue")) + (setq dir (dun-movement dir)) (let (newroom) (setq newroom (nth dir (nth dun-current-room dungeon-map))) (if (eq newroom -1) @@ -1776,12 +1783,14 @@ force throws you out. The train speeds away.\n") (setq dun-current-room meadow) (dun-mprincl "You don't have a key that can open this door."))) - (if (and (= dun-current-room maze-button-room) (= dir northwest)) + (if (and (= dun-current-room maze-button-room) + (= dir (dun-movement 'northwest))) (if (member obj-weight (nth maze-button-room dun-room-objects)) (setq dun-current-room 18) (dun-mprincl "You can't go that way."))) - (if (and (= dun-current-room maze-button-room) (= dir up)) + (if (and (= dun-current-room maze-button-room) + (= dir (dun-movement 'up))) (if (member obj-weight (nth maze-button-room dun-room-objects)) (dun-mprincl "You can't go that way.") (setq dun-current-room weight-room))) @@ -1807,11 +1816,12 @@ engulf you, and you burn to death.") (setq dun-current-room long-n-s-hallway) (dun-mprincl "You can't go that way."))) - (if (and (> dir down) (> dun-current-room gamma-computing-center) + (if (and (> dir (dun-movement 'down)) + (> dun-current-room gamma-computing-center) (< dun-current-room museum-lobby)) (if (not (member obj-bus (nth dun-current-room dun-room-objects))) (dun-mprincl "You can't go that way.") - (if (= dir in) + (if (= dir (dun-movement 'in)) (if dun-inbus (dun-mprincl "You are already in the bus!") commit 48cb4a96f3f3c9195d0e1286a0325e7625f13e39 Author: Mark Oteiza Date: Tue Jan 17 21:34:59 2017 -0500 Change top-level setq forms to defvar or defconst Also collect some code onto fewer lines and reindent. * lisp/play/dunnet.el (dun-visited, dun-current-room, dun-exitf): (dun-badcd, dun-computer, dun-floppy, dun-key-level, dun-hole): (dun-correct-answer, dun-lastdir, dun-numsaves, dun-jar, dun-dead): (room, dun-numcmds, dun-wizard, dun-endgame-question, dun-logged-in): (dungeon-mode, dun-unix-verbs, dun-dos-verbs, dun-batch-mode): (dun-cdpath, dun-cdroom, dun-uncompressed, dun-ethernet): (dun-restricted, dun-ftptype, dun-endgame, dun-rooms): (dun-light-rooms, dun-verblist, dun-inbus, dun-nomail, dun-ignore): (dun-mode, dun-sauna-level, north, south, east, west, northeast): (southeast, northwest, southwest, up, down, in, out, dungeon-map): (dun-objnames, obj-special, dun-room-objects, dun-room-silents): (dun-inventory, dun-objects, dun-object-lbs, dun-object-pts): (dun-objfiles, dun-perm-objects, dun-physobj-desc, dun-permobj-desc): (dun-diggables, dun-room-shorts, dun-endgame-questions): Change declaration to use defvar or defconst. (dun-doverb, dun-vparse, dun-vparse2, dun-batch-parse): (dun-batch-parse2): Omit the dun- prefix from arguments dun-ignore dun-verblist. Those are now constants and the byte compiler doesn't allow defconsts in lambda lists. diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el index 08189c1b0a..b6392c12e7 100644 --- a/lisp/play/dunnet.el +++ b/lisp/play/dunnet.el @@ -50,51 +50,51 @@ ;;;; All globals which can change must be saved from 'save-game. Add ;;;; all new globals to bottom of file. -(setq dun-visited '(27)) -(setq dun-current-room 1) -(setq dun-exitf nil) -(setq dun-badcd nil) -(setq dun-computer nil) -(setq dun-floppy nil) -(setq dun-key-level 0) -(setq dun-hole nil) -(setq dun-correct-answer nil) -(setq dun-lastdir 0) -(setq dun-numsaves 0) -(setq dun-jar nil) -(setq dun-dead nil) -(setq room 0) -(setq dun-numcmds 0) -(setq dun-wizard nil) -(setq dun-endgame-question nil) -(setq dun-logged-in nil) -(setq dungeon-mode 'dungeon) -(setq dun-unix-verbs '((ls . dun-ls) (ftp . dun-ftp) (echo . dun-echo) +(defvar dun-visited '(27)) +(defvar dun-current-room 1) +(defvar dun-exitf nil) +(defvar dun-badcd nil) +(defvar dun-computer nil) +(defvar dun-floppy nil) +(defvar dun-key-level 0) +(defvar dun-hole nil) +(defvar dun-correct-answer nil) +(defvar dun-lastdir 0) +(defvar dun-numsaves 0) +(defvar dun-jar nil) +(defvar dun-dead nil) +(defvar room 0) +(defvar dun-numcmds 0) +(defvar dun-wizard nil) +(defvar dun-endgame-question nil) +(defvar dun-logged-in nil) +(defvar dungeon-mode 'dungeon) +(defvar dun-unix-verbs '((ls . dun-ls) (ftp . dun-ftp) (echo . dun-echo) (exit . dun-uexit) (cd . dun-cd) (pwd . dun-pwd) (rlogin . dun-rlogin) (ssh . dun-rlogin) (uncompress . dun-uncompress) (cat . dun-cat))) -(setq dun-dos-verbs '((dir . dun-dos-dir) (type . dun-dos-type) +(defvar dun-dos-verbs '((dir . dun-dos-dir) (type . dun-dos-type) (exit . dun-dos-exit) (command . dun-dos-spawn) (b: . dun-dos-invd) (c: . dun-dos-invd) (a: . dun-dos-nil))) -(setq dun-batch-mode nil) +(defvar dun-batch-mode nil) -(setq dun-cdpath "/usr/toukmond") -(setq dun-cdroom -10) -(setq dun-uncompressed nil) -(setq dun-ethernet t) -(setq dun-restricted - '(dun-room-objects dungeon-map dun-rooms - dun-room-silents dun-combination)) -(setq dun-ftptype 'ascii) -(setq dun-endgame nil) -(setq dun-gottago t) -(setq dun-black nil) +(defvar dun-cdpath "/usr/toukmond") +(defvar dun-cdroom -10) +(defvar dun-uncompressed nil) +(defvar dun-ethernet t) +(defconst dun-restricted + '(dun-room-objects dungeon-map dun-rooms + dun-room-silents dun-combination)) +(defvar dun-ftptype 'ascii) +(defvar dun-endgame nil) +(defvar dun-gottago t) +(defvar dun-black nil) -(setq dun-rooms '( +(defconst dun-rooms '( ( "You are in the treasure room. A door leads out to the north." "Treasure room" @@ -603,44 +603,46 @@ A hole leads north." ) )) -(setq dun-light-rooms '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 24 25 26 27 28 58 59 - 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 - 77 78 79 80 81 82 83)) - -(setq dun-verblist '((die . dun-die) (ne . dun-ne) (north . dun-n) - (south . dun-s) (east . dun-e) (west . dun-w) - (u . dun-up) (d . dun-down) (i . dun-inven) - (inventory . dun-inven) (look . dun-examine) (n . dun-n) - (s . dun-s) (e . dun-e) (w . dun-w) (se . dun-se) - (nw . dun-nw) (sw . dun-sw) (up . dun-up) - (down . dun-down) (in . dun-in) (out . dun-out) - (go . dun-go) (drop . dun-drop) (southeast . dun-se) - (southwest . dun-sw) (northeast . dun-ne) - (northwest . dun-nw) (save . dun-save-game) - (restore . dun-restore) (long . dun-long) (dig . dun-dig) - (shake . dun-shake) (wave . dun-shake) - (examine . dun-examine) (describe . dun-examine) - (climb . dun-climb) (eat . dun-eat) (put . dun-put) - (type . dun-type) (insert . dun-put) - (score . dun-score) (help . dun-help) (quit . dun-quit) - (read . dun-examine) (verbose . dun-long) - (urinate . dun-piss) (piss . dun-piss) - (flush . dun-flush) (sleep . dun-sleep) (lie . dun-sleep) - (x . dun-examine) (break . dun-break) (drive . dun-drive) - (board . dun-in) (enter . dun-in) (turn . dun-turn) - (press . dun-press) (push . dun-press) (swim . dun-swim) - (on . dun-in) (off . dun-out) (chop . dun-break) - (switch . dun-press) (cut . dun-break) (exit . dun-out) - (leave . dun-out) (reset . dun-power) (flick . dun-press) - (superb . dun-superb) (answer . dun-answer) - (throw . dun-drop) (l . dun-examine) (take . dun-take) - (get . dun-take) (feed . dun-feed))) - -(setq dun-inbus nil) -(setq dun-nomail nil) -(setq dun-ignore '(the to at)) -(setq dun-mode 'moby) -(setq dun-sauna-level 0) +(defconst dun-light-rooms + '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 24 25 26 27 28 58 59 + 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 + 77 78 79 80 81 82 83)) + +(defconst dun-verblist + '((die . dun-die) (ne . dun-ne) (north . dun-n) + (south . dun-s) (east . dun-e) (west . dun-w) + (u . dun-up) (d . dun-down) (i . dun-inven) + (inventory . dun-inven) (look . dun-examine) (n . dun-n) + (s . dun-s) (e . dun-e) (w . dun-w) (se . dun-se) + (nw . dun-nw) (sw . dun-sw) (up . dun-up) + (down . dun-down) (in . dun-in) (out . dun-out) + (go . dun-go) (drop . dun-drop) (southeast . dun-se) + (southwest . dun-sw) (northeast . dun-ne) + (northwest . dun-nw) (save . dun-save-game) + (restore . dun-restore) (long . dun-long) (dig . dun-dig) + (shake . dun-shake) (wave . dun-shake) + (examine . dun-examine) (describe . dun-examine) + (climb . dun-climb) (eat . dun-eat) (put . dun-put) + (type . dun-type) (insert . dun-put) + (score . dun-score) (help . dun-help) (quit . dun-quit) + (read . dun-examine) (verbose . dun-long) + (urinate . dun-piss) (piss . dun-piss) + (flush . dun-flush) (sleep . dun-sleep) (lie . dun-sleep) + (x . dun-examine) (break . dun-break) (drive . dun-drive) + (board . dun-in) (enter . dun-in) (turn . dun-turn) + (press . dun-press) (push . dun-press) (swim . dun-swim) + (on . dun-in) (off . dun-out) (chop . dun-break) + (switch . dun-press) (cut . dun-break) (exit . dun-out) + (leave . dun-out) (reset . dun-power) (flick . dun-press) + (superb . dun-superb) (answer . dun-answer) + (throw . dun-drop) (l . dun-examine) (take . dun-take) + (get . dun-take) (feed . dun-feed))) + +(defvar dun-inbus nil) +(defvar dun-nomail nil) +(defconst dun-ignore '(the to at)) +(defvar dun-mode 'moby) +(defvar dun-sauna-level 0) (defconst north 0) (defconst south 1) @@ -655,180 +657,178 @@ A hole leads north." (defconst in 10) (defconst out 11) -(setq dungeon-map '( -; no so ea we ne se nw sw up do in ot - ( 96 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;0 - ( -1 -1 2 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;1 - ( -1 -1 3 1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;2 - ( -1 -1 -1 2 4 6 -1 -1 -1 -1 -1 -1 ) ;3 - ( -1 -1 -1 -1 5 -1 -1 3 -1 -1 -1 -1 ) ;4 - ( -1 -1 -1 -1 255 -1 -1 4 -1 -1 255 -1 ) ;5 - ( -1 -1 -1 -1 -1 7 3 -1 -1 -1 -1 -1 ) ;6 - ( -1 -1 -1 -1 -1 255 6 27 -1 -1 -1 -1 ) ;7 - ( 255 5 9 10 -1 -1 -1 5 -1 -1 -1 5 ) ;8 - ( -1 -1 -1 8 -1 -1 -1 -1 -1 -1 -1 -1 ) ;9 - ( -1 -1 8 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;10 - ( -1 8 -1 58 -1 -1 -1 -1 -1 -1 -1 -1 ) ;11 - ( -1 -1 13 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;12 - ( 15 -1 14 12 -1 -1 -1 -1 -1 -1 -1 -1 ) ;13 - ( -1 -1 -1 13 -1 -1 -1 -1 -1 -1 -1 -1 ) ;14 - ( -1 13 16 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;15 - ( -1 -1 -1 15 -1 -1 -1 -1 -1 17 16 -1 ) ;16 - ( -1 -1 17 17 17 17 255 17 255 17 -1 -1 ) ;17 - ( 18 18 18 18 18 -1 18 18 19 18 -1 -1 ) ;18 - ( -1 18 18 19 19 20 19 19 -1 18 -1 -1 ) ;19 - ( -1 -1 -1 18 -1 -1 -1 -1 -1 21 -1 -1 ) ;20 - ( -1 -1 -1 -1 -1 20 22 -1 -1 -1 -1 -1 ) ;21 - ( 18 18 18 18 16 18 23 18 18 18 18 18 ) ;22 - ( -1 255 -1 -1 -1 19 -1 -1 -1 -1 -1 -1 ) ;23 - ( 23 25 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;24 - ( 24 255 -1 -1 -1 -1 -1 -1 -1 -1 255 -1 ) ;25 - (255 28 -1 -1 -1 -1 -1 -1 -1 -1 255 -1 ) ;26 - ( -1 -1 -1 -1 7 -1 -1 -1 -1 -1 -1 -1 ) ;27 - ( 26 255 -1 -1 -1 -1 -1 -1 -1 -1 255 -1 ) ;28 - ( -1 -1 30 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;29 - ( -1 -1 31 29 -1 -1 -1 -1 -1 -1 -1 -1 ) ;30 - ( 32 33 -1 30 -1 -1 -1 -1 -1 -1 -1 -1 ) ;31 - ( -1 31 -1 255 -1 -1 -1 -1 -1 34 -1 -1 ) ;32 - ( 31 -1 -1 -1 -1 -1 -1 -1 -1 35 -1 -1 ) ;33 - ( -1 35 -1 -1 -1 -1 -1 -1 32 37 -1 -1 ) ;34 - ( 34 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;35 - ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;36 - ( -1 -1 -1 -1 -1 -1 -1 38 34 -1 -1 -1 ) ;37 - ( -1 -1 40 41 37 -1 -1 39 -1 -1 -1 -1 ) ;38 - ( -1 -1 -1 -1 38 -1 -1 -1 -1 -1 -1 -1 ) ;39 - ( -1 -1 -1 38 -1 -1 -1 -1 42 -1 -1 -1 ) ;40 - ( -1 -1 38 -1 -1 -1 -1 -1 -1 43 -1 -1 ) ;41 - ( -1 -1 -1 -1 -1 -1 -1 -1 -1 40 -1 -1 ) ;42 - ( 44 -1 46 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;43 - ( -1 43 45 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;44 - ( -1 46 -1 44 -1 -1 -1 -1 -1 -1 -1 -1 ) ;45 - ( 45 -1 -1 43 -1 -1 -1 -1 -1 255 -1 -1 ) ;46 - ( 48 50 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;47 - ( 49 47 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;48 - ( -1 48 -1 -1 -1 -1 -1 -1 52 -1 -1 -1 ) ;49 - ( 47 51 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;50 - ( 50 104 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;51 - ( -1 -1 -1 -1 -1 -1 -1 -1 53 49 -1 -1 ) ;52 - ( -1 -1 -1 -1 -1 -1 -1 -1 54 52 -1 -1 ) ;53 - ( -1 -1 -1 -1 55 -1 -1 -1 -1 53 -1 -1 ) ;54 - ( -1 -1 -1 -1 56 -1 -1 54 -1 -1 -1 54 ) ;55 - ( -1 -1 -1 -1 -1 -1 -1 55 -1 31 -1 -1 ) ;56 - ( -1 -1 32 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;57 - ( 59 -1 11 -1 -1 -1 -1 -1 -1 -1 255 255) ;58 - ( 60 58 63 -1 -1 -1 255 -1 -1 -1 255 255) ;59 - ( 61 59 64 -1 -1 -1 -1 -1 -1 -1 255 255) ;60 - ( 62 60 65 -1 -1 -1 -1 -1 -1 -1 255 255) ;61 - ( -1 61 66 -1 -1 -1 -1 -1 -1 -1 255 255) ;62 - ( 64 -1 67 59 -1 -1 -1 -1 -1 -1 255 255) ;63 - ( 65 63 68 60 -1 -1 -1 -1 -1 -1 255 255) ;64 - ( 66 64 69 61 -1 -1 -1 -1 -1 -1 255 255) ;65 - ( -1 65 70 62 -1 -1 -1 -1 -1 -1 255 255) ;66 - ( 68 -1 71 63 -1 -1 -1 -1 -1 -1 255 255) ;67 - ( 69 67 72 64 -1 -1 -1 -1 -1 -1 255 255) ;68 - ( 70 68 73 65 -1 -1 -1 -1 -1 -1 255 255) ;69 - ( -1 69 74 66 -1 -1 -1 -1 -1 -1 255 255) ;70 - ( 72 -1 75 67 -1 -1 -1 -1 -1 -1 255 255) ;71 - ( 73 71 76 68 -1 -1 -1 -1 -1 -1 255 255) ;72 - ( 74 72 77 69 -1 -1 -1 -1 -1 -1 255 255) ;73 - ( -1 73 78 70 -1 -1 -1 -1 -1 -1 255 255) ;74 - ( 76 -1 79 71 -1 -1 -1 -1 -1 -1 255 255) ;75 - ( 77 75 80 72 -1 -1 -1 -1 -1 -1 255 255) ;76 - ( 78 76 81 73 -1 -1 -1 -1 -1 -1 255 255) ;77 - ( -1 77 82 74 -1 -1 -1 -1 -1 -1 255 255) ;78 - ( 80 -1 -1 75 -1 -1 -1 -1 -1 -1 255 255) ;79 - ( 81 79 255 76 -1 -1 -1 -1 -1 -1 255 255) ;80 - ( 82 80 -1 77 -1 -1 -1 -1 -1 -1 255 255) ;81 - ( -1 81 -1 78 -1 -1 -1 -1 -1 -1 255 255) ;82 - ( 84 -1 -1 -1 -1 59 -1 -1 -1 -1 255 255) ;83 - ( -1 83 85 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;84 - ( 86 -1 87 84 -1 -1 -1 -1 -1 -1 -1 -1 ) ;85 - ( -1 85 88 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;86 - ( 88 -1 -1 85 -1 -1 -1 -1 -1 -1 -1 -1 ) ;87 - ( -1 87 255 86 -1 -1 -1 -1 -1 -1 -1 -1 ) ;88 - ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 255 -1 ) ;89 - ( 91 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;90 - ( 92 90 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;91 - ( -1 91 -1 -1 -1 -1 -1 -1 93 94 -1 -1 ) ;92 - ( -1 -1 -1 88 -1 -1 -1 -1 -1 92 -1 -1 ) ;93 - ( -1 -1 -1 -1 95 -1 -1 -1 92 -1 -1 -1 ) ;94 - ( -1 -1 -1 -1 -1 -1 -1 94 -1 -1 -1 -1 ) ;95 - ( 97 0 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;96 - ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;97 - ( 99 97 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;98 - ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;99 - ( 101 99 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;100 - ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;101 - ( 103 101 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;102 - ( -1 102 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;103 - ( 51 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;104 - ) -; no so ea we ne se nw sw up do in ot +(defconst dungeon-map + ;; no so ea we ne se nw sw up do in ot + '(( 96 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;0 + ( -1 -1 2 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;1 + ( -1 -1 3 1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;2 + ( -1 -1 -1 2 4 6 -1 -1 -1 -1 -1 -1 ) ;3 + ( -1 -1 -1 -1 5 -1 -1 3 -1 -1 -1 -1 ) ;4 + ( -1 -1 -1 -1 255 -1 -1 4 -1 -1 255 -1 ) ;5 + ( -1 -1 -1 -1 -1 7 3 -1 -1 -1 -1 -1 ) ;6 + ( -1 -1 -1 -1 -1 255 6 27 -1 -1 -1 -1 ) ;7 + ( 255 5 9 10 -1 -1 -1 5 -1 -1 -1 5 ) ;8 + ( -1 -1 -1 8 -1 -1 -1 -1 -1 -1 -1 -1 ) ;9 + ( -1 -1 8 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;10 + ( -1 8 -1 58 -1 -1 -1 -1 -1 -1 -1 -1 ) ;11 + ( -1 -1 13 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;12 + ( 15 -1 14 12 -1 -1 -1 -1 -1 -1 -1 -1 ) ;13 + ( -1 -1 -1 13 -1 -1 -1 -1 -1 -1 -1 -1 ) ;14 + ( -1 13 16 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;15 + ( -1 -1 -1 15 -1 -1 -1 -1 -1 17 16 -1 ) ;16 + ( -1 -1 17 17 17 17 255 17 255 17 -1 -1 ) ;17 + ( 18 18 18 18 18 -1 18 18 19 18 -1 -1 ) ;18 + ( -1 18 18 19 19 20 19 19 -1 18 -1 -1 ) ;19 + ( -1 -1 -1 18 -1 -1 -1 -1 -1 21 -1 -1 ) ;20 + ( -1 -1 -1 -1 -1 20 22 -1 -1 -1 -1 -1 ) ;21 + ( 18 18 18 18 16 18 23 18 18 18 18 18 ) ;22 + ( -1 255 -1 -1 -1 19 -1 -1 -1 -1 -1 -1 ) ;23 + ( 23 25 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;24 + ( 24 255 -1 -1 -1 -1 -1 -1 -1 -1 255 -1 ) ;25 + (255 28 -1 -1 -1 -1 -1 -1 -1 -1 255 -1 ) ;26 + ( -1 -1 -1 -1 7 -1 -1 -1 -1 -1 -1 -1 ) ;27 + ( 26 255 -1 -1 -1 -1 -1 -1 -1 -1 255 -1 ) ;28 + ( -1 -1 30 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;29 + ( -1 -1 31 29 -1 -1 -1 -1 -1 -1 -1 -1 ) ;30 + ( 32 33 -1 30 -1 -1 -1 -1 -1 -1 -1 -1 ) ;31 + ( -1 31 -1 255 -1 -1 -1 -1 -1 34 -1 -1 ) ;32 + ( 31 -1 -1 -1 -1 -1 -1 -1 -1 35 -1 -1 ) ;33 + ( -1 35 -1 -1 -1 -1 -1 -1 32 37 -1 -1 ) ;34 + ( 34 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;35 + ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;36 + ( -1 -1 -1 -1 -1 -1 -1 38 34 -1 -1 -1 ) ;37 + ( -1 -1 40 41 37 -1 -1 39 -1 -1 -1 -1 ) ;38 + ( -1 -1 -1 -1 38 -1 -1 -1 -1 -1 -1 -1 ) ;39 + ( -1 -1 -1 38 -1 -1 -1 -1 42 -1 -1 -1 ) ;40 + ( -1 -1 38 -1 -1 -1 -1 -1 -1 43 -1 -1 ) ;41 + ( -1 -1 -1 -1 -1 -1 -1 -1 -1 40 -1 -1 ) ;42 + ( 44 -1 46 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;43 + ( -1 43 45 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;44 + ( -1 46 -1 44 -1 -1 -1 -1 -1 -1 -1 -1 ) ;45 + ( 45 -1 -1 43 -1 -1 -1 -1 -1 255 -1 -1 ) ;46 + ( 48 50 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;47 + ( 49 47 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;48 + ( -1 48 -1 -1 -1 -1 -1 -1 52 -1 -1 -1 ) ;49 + ( 47 51 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;50 + ( 50 104 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;51 + ( -1 -1 -1 -1 -1 -1 -1 -1 53 49 -1 -1 ) ;52 + ( -1 -1 -1 -1 -1 -1 -1 -1 54 52 -1 -1 ) ;53 + ( -1 -1 -1 -1 55 -1 -1 -1 -1 53 -1 -1 ) ;54 + ( -1 -1 -1 -1 56 -1 -1 54 -1 -1 -1 54 ) ;55 + ( -1 -1 -1 -1 -1 -1 -1 55 -1 31 -1 -1 ) ;56 + ( -1 -1 32 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;57 + ( 59 -1 11 -1 -1 -1 -1 -1 -1 -1 255 255) ;58 + ( 60 58 63 -1 -1 -1 255 -1 -1 -1 255 255) ;59 + ( 61 59 64 -1 -1 -1 -1 -1 -1 -1 255 255) ;60 + ( 62 60 65 -1 -1 -1 -1 -1 -1 -1 255 255) ;61 + ( -1 61 66 -1 -1 -1 -1 -1 -1 -1 255 255) ;62 + ( 64 -1 67 59 -1 -1 -1 -1 -1 -1 255 255) ;63 + ( 65 63 68 60 -1 -1 -1 -1 -1 -1 255 255) ;64 + ( 66 64 69 61 -1 -1 -1 -1 -1 -1 255 255) ;65 + ( -1 65 70 62 -1 -1 -1 -1 -1 -1 255 255) ;66 + ( 68 -1 71 63 -1 -1 -1 -1 -1 -1 255 255) ;67 + ( 69 67 72 64 -1 -1 -1 -1 -1 -1 255 255) ;68 + ( 70 68 73 65 -1 -1 -1 -1 -1 -1 255 255) ;69 + ( -1 69 74 66 -1 -1 -1 -1 -1 -1 255 255) ;70 + ( 72 -1 75 67 -1 -1 -1 -1 -1 -1 255 255) ;71 + ( 73 71 76 68 -1 -1 -1 -1 -1 -1 255 255) ;72 + ( 74 72 77 69 -1 -1 -1 -1 -1 -1 255 255) ;73 + ( -1 73 78 70 -1 -1 -1 -1 -1 -1 255 255) ;74 + ( 76 -1 79 71 -1 -1 -1 -1 -1 -1 255 255) ;75 + ( 77 75 80 72 -1 -1 -1 -1 -1 -1 255 255) ;76 + ( 78 76 81 73 -1 -1 -1 -1 -1 -1 255 255) ;77 + ( -1 77 82 74 -1 -1 -1 -1 -1 -1 255 255) ;78 + ( 80 -1 -1 75 -1 -1 -1 -1 -1 -1 255 255) ;79 + ( 81 79 255 76 -1 -1 -1 -1 -1 -1 255 255) ;80 + ( 82 80 -1 77 -1 -1 -1 -1 -1 -1 255 255) ;81 + ( -1 81 -1 78 -1 -1 -1 -1 -1 -1 255 255) ;82 + ( 84 -1 -1 -1 -1 59 -1 -1 -1 -1 255 255) ;83 + ( -1 83 85 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;84 + ( 86 -1 87 84 -1 -1 -1 -1 -1 -1 -1 -1 ) ;85 + ( -1 85 88 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;86 + ( 88 -1 -1 85 -1 -1 -1 -1 -1 -1 -1 -1 ) ;87 + ( -1 87 255 86 -1 -1 -1 -1 -1 -1 -1 -1 ) ;88 + ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 255 -1 ) ;89 + ( 91 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;90 + ( 92 90 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;91 + ( -1 91 -1 -1 -1 -1 -1 -1 93 94 -1 -1 ) ;92 + ( -1 -1 -1 88 -1 -1 -1 -1 -1 92 -1 -1 ) ;93 + ( -1 -1 -1 -1 95 -1 -1 -1 92 -1 -1 -1 ) ;94 + ( -1 -1 -1 -1 -1 -1 -1 94 -1 -1 -1 -1 ) ;95 + ( 97 0 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;96 + ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;97 + ( 99 97 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;98 + ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;99 + ( 101 99 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;100 + ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;101 + ( 103 101 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;102 + ( -1 102 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;103 + ( 51 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ));104 + ;; no so ea we ne se nw sw up do in ot ) ;;; How the user references *all* objects, permanent and regular. -(setq dun-objnames '( - (shovel . 0) - (lamp . 1) - (cpu . 2) (board . 2) (card . 2) (chip . 2) - (food . 3) - (key . 4) - (paper . 5) (slip . 5) - (rms . 6) (statue . 6) (statuette . 6) (stallman . 6) - (diamond . 7) - (weight . 8) - (life . 9) (preserver . 9) - (bracelet . 10) (emerald . 10) - (gold . 11) - (platinum . 12) - (towel . 13) (beach . 13) - (axe . 14) - (silver . 15) - (license . 16) - (coins . 17) - (egg . 18) - (jar . 19) - (bone . 20) - (acid . 21) (nitric . 21) - (glycerine . 22) - (ruby . 23) - (amethyst . 24) - (mona . 25) - (bill . 26) - (floppy . 27) (disk . 27) - - (boulder . -1) - (tree . -2) (trees . -2) (palm . -2) - (bear . -3) - (bin . -4) (bins . -4) - (cabinet . -5) (computer . -5) (vax . -5) (ibm . -5) - (protoplasm . -6) - (dial . -7) - (button . -8) - (chute . -9) - (painting . -10) - (bed . -11) - (urinal . -12) - (URINE . -13) - (pipes . -14) (pipe . -14) - (box . -15) (slit . -15) - (cable . -16) (ethernet . -16) - (mail . -17) (drop . -17) - (bus . -18) - (gate . -19) - (cliff . -20) - (skeleton . -21) (dinosaur . -21) - (fish . -22) - (tanks . -23) (tank . -23) - (switch . -24) - (blackboard . -25) - (disposal . -26) (garbage . -26) - (ladder . -27) - (subway . -28) (train . -28) - (pc . -29) (drive . -29) (coconut . -30) (coconuts . -30) - (lake . -32) (water . -32) -)) +(defconst dun-objnames + '((shovel . 0) + (lamp . 1) + (cpu . 2) (board . 2) (card . 2) (chip . 2) + (food . 3) + (key . 4) + (paper . 5) (slip . 5) + (rms . 6) (statue . 6) (statuette . 6) (stallman . 6) + (diamond . 7) + (weight . 8) + (life . 9) (preserver . 9) + (bracelet . 10) (emerald . 10) + (gold . 11) + (platinum . 12) + (towel . 13) (beach . 13) + (axe . 14) + (silver . 15) + (license . 16) + (coins . 17) + (egg . 18) + (jar . 19) + (bone . 20) + (acid . 21) (nitric . 21) + (glycerine . 22) + (ruby . 23) + (amethyst . 24) + (mona . 25) + (bill . 26) + (floppy . 27) (disk . 27) + + (boulder . -1) + (tree . -2) (trees . -2) (palm . -2) + (bear . -3) + (bin . -4) (bins . -4) + (cabinet . -5) (computer . -5) (vax . -5) (ibm . -5) + (protoplasm . -6) + (dial . -7) + (button . -8) + (chute . -9) + (painting . -10) + (bed . -11) + (urinal . -12) + (URINE . -13) + (pipes . -14) (pipe . -14) + (box . -15) (slit . -15) + (cable . -16) (ethernet . -16) + (mail . -17) (drop . -17) + (bus . -18) + (gate . -19) + (cliff . -20) + (skeleton . -21) (dinosaur . -21) + (fish . -22) + (tanks . -23) (tank . -23) + (switch . -24) + (blackboard . -25) + (disposal . -26) (garbage . -26) + (ladder . -27) + (subway . -28) (train . -28) + (pc . -29) (drive . -29) (coconut . -30) (coconuts . -30) + (lake . -32) (water . -32))) (dolist (x dun-objnames) (let (name) @@ -844,7 +844,7 @@ A hole leads north." ;;; Stuff that is described and might change are 255, and are ;;; handled specially by 'dun-describe-room. -(setq dun-room-objects (list nil +(defvar dun-room-objects (list nil (list obj-shovel) ;; treasure-room (list obj-boulder) ;; dead-end @@ -901,7 +901,7 @@ nil)) ;;; These are objects in a room that are only described in the ;;; room description. They are permanent. -(setq dun-room-silents (list nil +(defconst dun-room-silents (list nil (list obj-tree obj-coconut) ;; dead-end (list obj-tree obj-coconut) ;; e-w-dirt-road nil nil nil nil nil nil @@ -945,96 +945,81 @@ nil)) (list obj-pc) ;; pc-area nil nil nil nil nil nil )) -(setq dun-inventory '(1)) +(defvar dun-inventory '(1)) ;;; Descriptions of objects, as they appear in the room description, and ;;; the inventory. -(setq dun-objects '( - ("There is a shovel here." "A shovel") ;0 - ("There is a lamp nearby." "A lamp") ;1 - ("There is a CPU card here." "A computer board") ;2 - ("There is some food here." "Some food") ;3 - ("There is a shiny brass key here." "A brass key") ;4 - ("There is a slip of paper here." "A slip of paper") ;5 - ("There is a wax statuette of Richard Stallman here." ;6 - "An RMS statuette") - ("There is a shimmering diamond here." "A diamond") ;7 - ("There is a 10 pound weight here." "A weight") ;8 - ("There is a life preserver here." "A life preserver");9 - ("There is an emerald bracelet here." "A bracelet") ;10 - ("There is a gold bar here." "A gold bar") ;11 - ("There is a platinum bar here." "A platinum bar") ;12 - ("There is a beach towel on the ground here." "A beach towel") - ("There is an axe here." "An axe") ;14 - ("There is a silver bar here." "A silver bar") ;15 - ("There is a bus driver's license here." "A license") ;16 - ("There are some valuable coins here." "Some valuable coins") - ("There is a jewel-encrusted egg here." "A valuable egg") ;18 - ("There is a glass jar here." "A glass jar") ;19 - ("There is a dinosaur bone here." "A bone") ;20 - ("There is a packet of nitric acid here." "Some nitric acid") - ("There is a packet of glycerine here." "Some glycerine") ;22 - ("There is a valuable ruby here." "A ruby") ;23 - ("There is a valuable amethyst here." "An amethyst") ;24 - ("The Mona Lisa is here." "The Mona Lisa") ;25 - ("There is a 100 dollar bill here." "A $100 bill") ;26 - ("There is a floppy disk here." "A floppy disk") ;27 - ) -) +(defconst dun-objects + '(("There is a shovel here." "A shovel") ;0 + ("There is a lamp nearby." "A lamp") ;1 + ("There is a CPU card here." "A computer board") ;2 + ("There is some food here." "Some food") ;3 + ("There is a shiny brass key here." "A brass key") ;4 + ("There is a slip of paper here." "A slip of paper") ;5 + ("There is a wax statuette of Richard Stallman here." ;6 + "An RMS statuette") + ("There is a shimmering diamond here." "A diamond") ;7 + ("There is a 10 pound weight here." "A weight") ;8 + ("There is a life preserver here." "A life preserver");9 + ("There is an emerald bracelet here." "A bracelet") ;10 + ("There is a gold bar here." "A gold bar") ;11 + ("There is a platinum bar here." "A platinum bar") ;12 + ("There is a beach towel on the ground here." "A beach towel") + ("There is an axe here." "An axe") ;14 + ("There is a silver bar here." "A silver bar") ;15 + ("There is a bus driver's license here." "A license") ;16 + ("There are some valuable coins here." "Some valuable coins") + ("There is a jewel-encrusted egg here." "A valuable egg") ;18 + ("There is a glass jar here." "A glass jar") ;19 + ("There is a dinosaur bone here." "A bone") ;20 + ("There is a packet of nitric acid here." "Some nitric acid") + ("There is a packet of glycerine here." "Some glycerine") ;22 + ("There is a valuable ruby here." "A ruby") ;23 + ("There is a valuable amethyst here." "An amethyst") ;24 + ("The Mona Lisa is here." "The Mona Lisa") ;25 + ("There is a 100 dollar bill here." "A $100 bill") ;26 + ("There is a floppy disk here." "A floppy disk"))) ;27 ;;; Weight of objects -(setq dun-object-lbs - '(2 1 1 1 1 0 2 2 10 3 1 1 1 0 1 1 0 1 1 1 1 0 0 2 2 1 0 0)) -(setq dun-object-pts - '(0 0 0 0 0 0 0 10 0 0 10 10 10 0 0 10 0 10 10 0 0 0 0 10 10 10 10 0)) +(defconst dun-object-lbs + '(2 1 1 1 1 0 2 2 10 3 1 1 1 0 1 1 0 1 1 1 1 0 0 2 2 1 0 0)) +(defconst dun-object-pts + '(0 0 0 0 0 0 0 10 0 0 10 10 10 0 0 10 0 10 10 0 0 0 0 10 10 10 10 0)) ;;; Unix representation of objects. -(setq dun-objfiles '( - "shovel.o" "lamp.o" "cpu.o" "food.o" "key.o" "paper.o" - "rms.o" "diamond.o" "weight.o" "preserver.o" "bracelet.o" - "gold.o" "platinum.o" "towel.o" "axe.o" "silver.o" "license.o" - "coins.o" "egg.o" "jar.o" "bone.o" "nitric.o" "glycerine.o" - "ruby.o" "amethyst.o" - )) +(defconst dun-objfiles + '("shovel.o" "lamp.o" "cpu.o" "food.o" "key.o" "paper.o" + "rms.o" "diamond.o" "weight.o" "preserver.o" "bracelet.o" + "gold.o" "platinum.o" "towel.o" "axe.o" "silver.o" "license.o" + "coins.o" "egg.o" "jar.o" "bone.o" "nitric.o" "glycerine.o" + "ruby.o" "amethyst.o")) ;;; These are the descriptions for the negative numbered objects from ;;; dun-room-objects -(setq dun-perm-objects '( - nil - ("There is a large boulder here.") - nil - ("There is a ferocious bear here!") - nil - nil - ("There is a worthless pile of protoplasm here.") - nil - nil - nil - nil - nil - nil - ("There is a strange smell in this room.") - nil - ( -"There is a box with a slit in it, bolted to the wall here." - ) - nil - nil - ("There is a bus here.") - nil - nil - nil -)) +(defconst dun-perm-objects + '(nil + ("There is a large boulder here.") + nil + ("There is a ferocious bear here!") + nil nil + ("There is a worthless pile of protoplasm here.") + nil nil nil nil nil nil + ("There is a strange smell in this room.") + nil + ("There is a box with a slit in it, bolted to the wall here.") + nil nil + ("There is a bus here.") + nil nil nil)) ;;; These are the descriptions the user gets when regular objects are ;;; examined. -(setq dun-physobj-desc '( +(defconst dun-physobj-desc '( "It is a normal shovel with a price tag attached that says $19.99." "The lamp is hand-crafted by Geppetto." "The CPU board has a VAX chip on it. It seems to have @@ -1048,29 +1033,20 @@ famous EMACS editor. You notice that he is not wearing any shoes." nil "You observe that the weight is heavy." "It says S. S. Minnow." -nil -nil -nil +nil nil nil "It has a picture of snoopy on it." -nil -nil +nil nil "It has your picture on it!" "They are old coins from the 19th century." "It is a valuable Fabrege egg." "It is a plain glass jar." -nil -nil -nil -nil -nil - ) -) +nil nil nil nil nil)) ;;; These are the descriptions the user gets when non-regular objects ;;; are examined. -(setq dun-permobj-desc '( - nil +(defconst dun-permobj-desc + '(nil "It is just a boulder. It cannot be moved." "They are palm trees with a bountiful supply of coconuts in them." "It looks like a grizzly to me." @@ -1082,11 +1058,10 @@ names: Robert Toukmond Thomas Stock " - nil +nil "It is just a garbled mess." "The dial points to a temperature scale which has long since faded away." -nil -nil +nil nil "It is a velvet painting of Elvis Presley. It seems to be nailed to the wall, and you cannot move it." "It is a queen sized bed, with a very firm mattress." @@ -1095,8 +1070,7 @@ isn't even any rust. Upon close examination you realize that the drain at the bottom is missing, and there is just a large hole leading down the pipes into nowhere. The hole is too small for a person to fit in. The flush handle is so clean that you can see your reflection in it." -nil -nil +nil nil "The box has a slit in the top of it, and on it, in sloppy handwriting, is written: ‘For key upgrade, put key in here.’" nil @@ -1107,67 +1081,45 @@ nil "Unfortunately you do not know enough about dinosaurs to tell very much about it. It is very big, though." "The fish look like they were once quite beautiful." -nil -nil -nil -nil +nil nil nil nil "It is a normal ladder that is permanently attached to the hole." "It is a passenger train that is ready to go." -"It is a personal computer that has only one floppy disk drive." - ) -) +"It is a personal computer that has only one floppy disk drive.")) -(setq dun-diggables +(defconst dun-diggables (list nil nil nil (list obj-cpu) nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ;11-20 nil nil nil nil nil nil nil nil nil nil ;21-30 nil nil nil nil nil nil nil nil nil nil ;31-40 nil (list obj-platinum) nil nil nil nil nil nil nil nil)) -(setq dun-room-shorts nil) +(defvar dun-room-shorts nil) -(setq dun-endgame-questions '( - ( -"What is your password on the machine called ‘pokey’?" "robert") - ( -"What password did you use during anonymous ftp to gamma?" "foo") - ( -"Excluding the endgame, how many places are there where you can put +(defconst dun-endgame-questions + '(("What is your password on the machine called ‘pokey’?" "robert") + ("What password did you use during anonymous ftp to gamma?" "foo") + ("Excluding the endgame, how many places are there where you can put treasures for points?" "4" "four") - ( -"What is your login name on the ‘endgame’ machine?" "toukmond" -) - ( -"What is the nearest whole dollar to the price of the shovel?" "20" "twenty") - ( -"What is the name of the bus company serving the town?" "mobytours") - ( -"Give either of the two last names in the mailroom, other than your own." -"collier" "stock") - ( -"What cartoon character is on the towel?" "snoopy") - ( -"What is the last name of the author of EMACS?" "stallman") - ( -"How many megabytes of memory is on the CPU board for the Vax?" "2") - ( -"Which street in town is named after a U.S. state?" "vermont") - ( -"How many pounds did the weight weigh?" "ten" "10") - ( -"Name the STREET which runs right over the subway stop." "fourth" "4" "4th") - ( -"How many corners are there in town (excluding the one with the Post Office)?" - "24" "twentyfour" "twenty-four") - ( -"What type of bear was hiding your key?" "grizzly") - ( -"Name either of the two objects you found by digging." "cpu" "card" "vax" -"board" "platinum") - ( -"What network protocol is used between pokey and gamma?" "tcp/ip" "ip" "tcp") -)) - + ("What is your login name on the ‘endgame’ machine?" "toukmond") + ("What is the nearest whole dollar to the price of the shovel?" + "20" "twenty") + ("What is the name of the bus company serving the town?" "mobytours") + ("Give either of the two last names in the mailroom, other than your own." + "collier" "stock") + ("What cartoon character is on the towel?" "snoopy") + ("What is the last name of the author of EMACS?" "stallman") + ("How many megabytes of memory is on the CPU board for the Vax?" "2") + ("Which street in town is named after a U.S. state?" "vermont") + ("How many pounds did the weight weigh?" "ten" "10") + ("Name the STREET which runs right over the subway stop." + "fourth" "4" "4th") + ("How many corners are there in town (excluding the one with the Post Office)?" + "24" "twentyfour" "twenty-four") + ("What type of bear was hiding your key?" "grizzly") + ("Name either of the two objects you found by digging." + "cpu" "card" "vax" "board" "platinum") + ("What network protocol is used between pokey and gamma?" + "tcp/ip" "ip" "tcp"))) ;;;; Mode definitions for interactive mode @@ -2231,15 +2183,15 @@ for a moment, then straighten yourself up. ;;; Function which takes a verb and a list of other words. Calls proper ;;; function associated with the verb, and passes along the other words. -(defun dun-doverb (dun-ignore dun-verblist verb rest) +(defun dun-doverb (ignore verblist verb rest) (if (not verb) nil - (if (member (intern verb) dun-ignore) + (if (member (intern verb) ignore) (if (not (car rest)) -1 - (dun-doverb dun-ignore dun-verblist (car rest) (cdr rest))) - (if (not (cdr (assq (intern verb) dun-verblist))) -1 + (dun-doverb ignore verblist (car rest) (cdr rest))) + (if (not (cdr (assq (intern verb) verblist))) -1 (setq dun-numcmds (1+ dun-numcmds)) - (funcall (cdr (assq (intern verb) dun-verblist)) rest))))) + (funcall (cdr (assq (intern verb) verblist)) rest))))) ;;; Function to take a string and change it into a list of lowercase words. @@ -2291,15 +2243,15 @@ for a moment, then straighten yourself up. ;;; parse a line passed in as a string Call the proper verb with the ;;; rest of the line passed in as a list. -(defun dun-vparse (dun-ignore dun-verblist line) +(defun dun-vparse (ignore verblist line) (dun-mprinc "\n") (setq line-list (dun-listify-string (concat line " "))) - (dun-doverb dun-ignore dun-verblist (car line-list) (cdr line-list))) + (dun-doverb ignore verblist (car line-list) (cdr line-list))) -(defun dun-parse2 (dun-ignore dun-verblist line) +(defun dun-parse2 (ignore verblist line) (dun-mprinc "\n") (setq line-list (dun-listify-string2 (concat line " "))) - (dun-doverb dun-ignore dun-verblist (car line-list) (cdr line-list))) + (dun-doverb ignore verblist (car line-list) (cdr line-list))) ;;; Read a line, in window mode @@ -3263,13 +3215,13 @@ File not found"))) (send-string-to-terminal (prin1-to-string arg)) (send-string-to-terminal "\n"))) -(defun dun-batch-parse (dun-ignore dun-verblist line) +(defun dun-batch-parse (ignore verblist line) (setq line-list (dun-listify-string (concat line " "))) - (dun-doverb dun-ignore dun-verblist (car line-list) (cdr line-list))) + (dun-doverb ignore verblist (car line-list) (cdr line-list))) -(defun dun-batch-parse2 (dun-ignore dun-verblist line) +(defun dun-batch-parse2 (ignore verblist line) (setq line-list (dun-listify-string2 (concat line " "))) - (dun-doverb dun-ignore dun-verblist (car line-list) (cdr line-list))) + (dun-doverb ignore verblist (car line-list) (cdr line-list))) (defun dun-batch-read-line () (read-from-minibuffer "" nil dungeon-batch-map)) commit 33400529c61d98a8db9e8dbb1b686a5b55964403 Author: Mark Oteiza Date: Tue Jan 17 19:11:06 2017 -0500 Move all dunnet globals up to the top * lisp/play/dunnet.el: Adjust comments to reflect moved forms. (dun-visited, dun-current-room, dun-exitf): (dun-badcd, dun-computer, dun-floppy, dun-key-level, dun-hole): (dun-correct-answer, dun-lastdir, dun-numsaves, dun-jar, dun-dead): (room, dun-numcmds, dun-wizard, dun-endgame-question, dun-logged-in): (dungeon-mode, dun-unix-verbs, dun-dos-verbs, dun-batch-mode): (dun-cdpath, dun-cdroom, dun-uncompressed, dun-ethernet): (dun-restricted, dun-ftptype, dun-endgame, dun-rooms): (dun-light-rooms, dun-verblist, dun-inbus, dun-nomail, dun-ignore): (dun-mode, dun-sauna-level, north, south, east, west, northeast): (southeast, northwest, southwest, up, down, in, out, dungeon-map): (dun-objnames, obj-special, dun-room-objects, dun-room-silents): (dun-inventory, dun-objects, dun-object-lbs, dun-object-pts): (dun-objfiles, dun-perm-objects, dun-physobj-desc, dun-permobj-desc): (dun-diggables, dun-room-shorts, dun-endgame-questions): Move to the top of the file, before any uses. diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el index 8ddb680f25..08189c1b0a 100644 --- a/lisp/play/dunnet.el +++ b/lisp/play/dunnet.el @@ -43,1350 +43,56 @@ :type 'file :group 'dunnet) -;;;; Mode definitions for interactive mode - -(define-derived-mode dun-mode text-mode "Dungeon" - "Major mode for running dunnet." - (make-local-variable 'scroll-step) - (setq scroll-step 2)) - -(defun dun-parse (_arg) - "Function called when return is pressed in interactive mode to parse line." - (interactive "*p") - (beginning-of-line) - (let ((beg (1+ (point))) - line) - (end-of-line) - (if (and (not (= beg (point))) (not (< (point) beg)) - (string= ">" (buffer-substring (- beg 1) beg))) - (progn - (setq line (downcase (buffer-substring beg (point)))) - (princ line) - (if (eq (dun-vparse dun-ignore dun-verblist line) -1) - (dun-mprinc "I don't understand that.\n"))) - (goto-char (point-max)) - (dun-mprinc "\n"))) - (dun-messages)) - -(defun dun-messages () - (if dun-dead - (text-mode) - (if (eq dungeon-mode 'dungeon) - (progn - (if (not (= room dun-current-room)) - (progn - (dun-describe-room dun-current-room) - (setq room dun-current-room))) - (dun-fix-screen) - (dun-mprinc ">"))))) - - -;;;###autoload -(defun dunnet () - "Switch to *dungeon* buffer and start game." - (interactive) - (switch-to-buffer "*dungeon*") - (dun-mode) - (setq dun-dead nil) - (setq room 0) - (dun-messages)) - ;;;; -;;;; This section contains all of the verbs and commands. +;;;; This section defines the globals that are used in dunnet. ;;;; +;;;; IMPORTANT +;;;; All globals which can change must be saved from 'save-game. Add +;;;; all new globals to bottom of file. -;;; Give long description of room if haven't been there yet. Otherwise -;;; short. Also give long if we were called with negative room number. - -(defun dun-describe-room (room) - (if (and (not (member (abs room) dun-light-rooms)) - (not (member obj-lamp dun-inventory)) - (not (member obj-lamp (nth dun-current-room dun-room-objects)))) - (dun-mprincl "It is pitch dark. You are likely to be eaten by a grue.") - (dun-mprincl (cadr (nth (abs room) dun-rooms))) - (if (and (and (or (member room dun-visited) - (string= dun-mode "dun-superb")) (> room 0)) - (not (string= dun-mode "long"))) - nil - (dun-mprinc (car (nth (abs room) dun-rooms))) - (dun-mprinc "\n")) - (if (not (string= dun-mode "long")) - (if (not (member (abs room) dun-visited)) - (setq dun-visited (append (list (abs room)) dun-visited)))) - (dolist (xobjs (nth dun-current-room dun-room-objects)) - (if (= xobjs obj-special) - (dun-special-object) - (if (>= xobjs 0) - (dun-mprincl (car (nth xobjs dun-objects))) - (if (not (and (= xobjs obj-bus) dun-inbus)) - (progn - (dun-mprincl (car (nth (abs xobjs) dun-perm-objects))))))) - (if (and (= xobjs obj-jar) dun-jar) - (progn - (dun-mprincl "The jar contains:") - (dolist (x dun-jar) - (dun-mprinc " ") - (dun-mprincl (car (nth x dun-objects))))))) - (if (and (member obj-bus (nth dun-current-room dun-room-objects)) dun-inbus) - (dun-mprincl "You are on the bus.")))) - -;;; There is a special object in the room. This object's description, -;;; or lack thereof, depends on certain conditions. - -(defun dun-special-object () - (if (= dun-current-room computer-room) - (if dun-computer - (dun-mprincl -"The panel lights are flashing in a seemingly organized pattern.") - (dun-mprincl "The panel lights are steady and motionless."))) - - (if (and (= dun-current-room red-room) - (not (member obj-towel (nth red-room dun-room-objects)))) - (dun-mprincl "There is a hole in the floor here.")) - - (if (and (= dun-current-room marine-life-area) dun-black) - (dun-mprincl -"The room is lit by a black light, causing the fish, and some of -your objects, to give off an eerie glow.")) - (if (and (= dun-current-room fourth-vermont-intersection) dun-hole) - (progn - (if (not dun-inbus) - (progn - (dun-mprincl "You fall into a hole in the ground.") - (setq dun-current-room vermont-station) - (dun-describe-room vermont-station)) - (progn - (dun-mprincl -"The bus falls down a hole in the ground and explodes.") - (dun-die "burning"))))) - - (if (> dun-current-room endgame-computer-room) - (progn - (if (not dun-correct-answer) - (dun-endgame-question) - (dun-mprincl "Your question is:") - (dun-mprincl dun-endgame-question)))) - - (if (= dun-current-room sauna) - (progn - (dun-mprincl (nth dun-sauna-level '( -"It is normal room temperature in here." -"It is luke warm in here." -"It is comfortably hot in here." -"It is refreshingly hot in here." -"You are dead now."))) - (if (= dun-sauna-level 3) - (progn - (if (or (member obj-rms dun-inventory) - (member obj-rms (nth dun-current-room dun-room-objects))) - (progn - (dun-mprincl -"You notice the wax on your statuette beginning to melt, until it completely -melts off. You are left with a beautiful diamond!") - (if (member obj-rms dun-inventory) - (progn - (dun-remove-obj-from-inven obj-rms) - (setq dun-inventory (append dun-inventory - (list obj-diamond)))) - (dun-remove-obj-from-room dun-current-room obj-rms) - (dun-replace dun-room-objects dun-current-room - (append (nth dun-current-room dun-room-objects) - (list obj-diamond)))))) - (if (or (member obj-floppy dun-inventory) - (member obj-floppy (nth dun-current-room dun-room-objects))) - (progn - (dun-mprincl -"You notice your floppy disk beginning to melt. As you grab for it, the -disk bursts into flames, and disintegrates.") - (dun-remove-obj-from-inven obj-floppy) - (dun-remove-obj-from-room dun-current-room obj-floppy)))))))) - - -(defun dun-die (murderer) - (dun-mprinc "\n") - (if murderer - (dun-mprincl "You are dead.")) - (dun-do-logfile 'dun-die murderer) - (dun-score nil) - (setq dun-dead t)) - -(defun dun-quit (_args) - (dun-die nil)) +(setq dun-visited '(27)) +(setq dun-current-room 1) +(setq dun-exitf nil) +(setq dun-badcd nil) +(setq dun-computer nil) +(setq dun-floppy nil) +(setq dun-key-level 0) +(setq dun-hole nil) +(setq dun-correct-answer nil) +(setq dun-lastdir 0) +(setq dun-numsaves 0) +(setq dun-jar nil) +(setq dun-dead nil) +(setq room 0) +(setq dun-numcmds 0) +(setq dun-wizard nil) +(setq dun-endgame-question nil) +(setq dun-logged-in nil) +(setq dungeon-mode 'dungeon) +(setq dun-unix-verbs '((ls . dun-ls) (ftp . dun-ftp) (echo . dun-echo) + (exit . dun-uexit) (cd . dun-cd) (pwd . dun-pwd) + (rlogin . dun-rlogin) (ssh . dun-rlogin) + (uncompress . dun-uncompress) (cat . dun-cat))) -;;; Print every object in player's inventory. Special case for the jar, -;;; as we must also print what is in it. +(setq dun-dos-verbs '((dir . dun-dos-dir) (type . dun-dos-type) + (exit . dun-dos-exit) (command . dun-dos-spawn) + (b: . dun-dos-invd) (c: . dun-dos-invd) + (a: . dun-dos-nil))) -(defun dun-inven (_args) - (dun-mprinc "You currently have:") - (dun-mprinc "\n") - (dolist (curobj dun-inventory) - (if curobj - (progn - (dun-mprincl (cadr (nth curobj dun-objects))) - (if (and (= curobj obj-jar) dun-jar) - (progn - (dun-mprincl "The jar contains:") - (dolist (x dun-jar) - (dun-mprinc " ") - (dun-mprincl (cadr (nth x dun-objects)))))))))) -(defun dun-shake (obj) - (let (objnum) - (when (setq objnum (dun-objnum-from-args-std obj)) - (if (member objnum dun-inventory) - (progn -;;; If shaking anything will do anything, put here. - (dun-mprinc "Shaking ") - (dun-mprinc (downcase (cadr (nth objnum dun-objects)))) - (dun-mprinc " seems to have no effect.") - (dun-mprinc "\n") - ) - (if (and (not (member objnum (nth dun-current-room dun-room-silents))) - (not (member objnum (nth dun-current-room dun-room-objects)))) - (dun-mprincl "I don't see that here.") -;;; Shaking trees can be deadly - (if (= objnum obj-tree) - (progn - (dun-mprinc - "You begin to shake a tree, and notice a coconut begin to fall from the air. -As you try to get your hand up to block it, you feel the impact as it lands -on your head.") - (dun-die "a coconut")) - (if (= objnum obj-bear) - (progn - (dun-mprinc -"As you go up to the bear, it removes your head and places it on the ground.") - (dun-die "a bear")) - (if (< objnum 0) - (dun-mprincl "You cannot shake that.") - (dun-mprincl "You don't have that."))))))))) +(setq dun-batch-mode nil) - -(defun dun-drop (obj) - (if dun-inbus - (dun-mprincl "You can't drop anything while on the bus.") - (let (objnum) - (when (setq objnum (dun-objnum-from-args-std obj)) - (if (not (member objnum dun-inventory)) - (dun-mprincl "You don't have that.") - (progn - (dun-remove-obj-from-inven objnum) - (dun-replace dun-room-objects dun-current-room - (append (nth dun-current-room dun-room-objects) - (list objnum))) - (dun-mprincl "Done.") - (if (member objnum (list obj-food obj-weight obj-jar)) - (dun-drop-check objnum)))))))) - -;;; Dropping certain things causes things to happen. - -(defun dun-drop-check (objnum) - (if (and (= objnum obj-food) (= room bear-hangout) - (member obj-bear (nth bear-hangout dun-room-objects))) - (progn - (dun-mprincl -"The bear takes the food and runs away with it. He left something behind.") - (dun-remove-obj-from-room dun-current-room obj-bear) - (dun-remove-obj-from-room dun-current-room obj-food) - (dun-replace dun-room-objects dun-current-room - (append (nth dun-current-room dun-room-objects) - (list obj-key))))) - - (if (and (= objnum obj-jar) (member obj-nitric dun-jar) - (member obj-glycerine dun-jar)) - (progn - (dun-mprincl - "As the jar impacts the ground it explodes into many pieces.") - (setq dun-jar nil) - (dun-remove-obj-from-room dun-current-room obj-jar) - (if (= dun-current-room fourth-vermont-intersection) - (progn - (setq dun-hole t) - (setq dun-current-room vermont-station) - (dun-mprincl -"The explosion causes a hole to open up in the ground, which you fall -through."))))) - - (if (and (= objnum obj-weight) (= dun-current-room maze-button-room)) - (dun-mprincl "A passageway opens."))) - -;;; Give long description of current room, or an object. - -(defun dun-examine (obj) - (let (objnum) - (setq objnum (dun-objnum-from-args obj)) - (if (eq objnum obj-special) - (dun-describe-room (* dun-current-room -1)) - (if (and (eq objnum obj-computer) - (member obj-pc (nth dun-current-room dun-room-silents))) - (dun-examine '("pc")) - (if (eq objnum nil) - (dun-mprincl "I don't know what that is.") - (if (and (not (member objnum - (nth dun-current-room dun-room-objects))) - (not (and (member obj-jar dun-inventory) - (member objnum dun-jar))) - (not (member objnum - (nth dun-current-room dun-room-silents))) - (not (member objnum dun-inventory))) - (dun-mprincl "I don't see that here.") - (if (>= objnum 0) - (if (and (= objnum obj-bone) - (= dun-current-room marine-life-area) dun-black) - (dun-mprincl -"In this light you can see some writing on the bone. It says: -For an explosive time, go to Fourth St. and Vermont.") - (if (nth objnum dun-physobj-desc) - (dun-mprincl (nth objnum dun-physobj-desc)) - (dun-mprincl "I see nothing special about that."))) - (if (nth (abs objnum) dun-permobj-desc) - (progn - (dun-mprincl (nth (abs objnum) dun-permobj-desc))) - (dun-mprincl "I see nothing special about that."))))))))) - -(defun dun-take (obj) - (setq obj (dun-firstword obj)) - (if (not obj) - (dun-mprincl "You must supply an object.") - (if (string= obj "all") - (let (gotsome) - (if dun-inbus - (dun-mprincl "You can't take anything while on the bus.") - (setq gotsome nil) - (dolist (x (nth dun-current-room dun-room-objects)) - (if (and (>= x 0) (not (= x obj-special))) - (progn - (setq gotsome t) - (dun-mprinc (cadr (nth x dun-objects))) - (dun-mprinc ": ") - (dun-take-object x)))) - (if (not gotsome) - (dun-mprincl "Nothing to take.")))) - (let (objnum) - (setq objnum (cdr (assq (intern obj) dun-objnames))) - (if (eq objnum nil) - (progn - (dun-mprinc "I don't know what that is.") - (dun-mprinc "\n")) - (if (and dun-inbus (not (and (member objnum dun-jar) - (member obj-jar dun-inventory)))) - (dun-mprincl "You can't take anything while on the bus.") - (dun-take-object objnum))))))) - -(defun dun-take-object (objnum) - (if (and (member objnum dun-jar) (member obj-jar dun-inventory)) - (let (newjar) - (dun-mprincl "You remove it from the jar.") - (setq newjar nil) - (dolist (x dun-jar) - (if (not (= x objnum)) - (setq newjar (append newjar (list x))))) - (setq dun-jar newjar) - (setq dun-inventory (append dun-inventory (list objnum)))) - (if (not (member objnum (nth dun-current-room dun-room-objects))) - (if (not (member objnum (nth dun-current-room dun-room-silents))) - (dun-mprinc "I do not see that here.") - (dun-try-take objnum)) - (if (>= objnum 0) - (progn - (if (and (car dun-inventory) - (> (+ (dun-inven-weight) (nth objnum dun-object-lbs)) 11)) - (dun-mprinc "Your load would be too heavy.") - (setq dun-inventory (append dun-inventory (list objnum))) - (dun-remove-obj-from-room dun-current-room objnum) - (dun-mprinc "Taken. ") - (if (and (= objnum obj-towel) (= dun-current-room red-room)) - (dun-mprinc - "Taking the towel reveals a hole in the floor.")))) - (dun-try-take objnum))) - (dun-mprinc "\n"))) - -(defun dun-inven-weight () - (let (total) - (setq total 0) - (dolist (x dun-jar) - (setq total (+ total (nth x dun-object-lbs)))) - (dolist (x dun-inventory) - (setq total (+ total (nth x dun-object-lbs)))) total)) - -;;; We try to take an object that is untakable. Print a message -;;; depending on what it is. - -(defun dun-try-take (_obj) - (dun-mprinc "You cannot take that.")) - -(defun dun-dig (_args) - (if dun-inbus - (dun-mprincl "Digging here reveals nothing.") - (if (not (member 0 dun-inventory)) - (dun-mprincl "You have nothing with which to dig.") - (if (not (nth dun-current-room dun-diggables)) - (dun-mprincl "Digging here reveals nothing.") - (dun-mprincl "I think you found something.") - (dun-replace dun-room-objects dun-current-room - (append (nth dun-current-room dun-room-objects) - (nth dun-current-room dun-diggables))) - (dun-replace dun-diggables dun-current-room nil))))) - -(defun dun-climb (obj) - (let (objnum) - (setq objnum (dun-objnum-from-args obj)) - (cond ((not objnum) - (dun-mprincl "I don't know what that object is.")) - ((and (not (eq objnum obj-special)) - (not (member objnum (nth dun-current-room dun-room-objects))) - (not (member objnum (nth dun-current-room dun-room-silents))) - (not (and (member objnum dun-jar) (member obj-jar dun-inventory))) - (not (member objnum dun-inventory))) - (dun-mprincl "I don't see that here.")) - ((and (eq objnum obj-special) - (not (member obj-tree (nth dun-current-room dun-room-silents)))) - (dun-mprincl "There is nothing here to climb.")) - ((and (not (eq objnum obj-tree)) (not (eq objnum obj-special))) - (dun-mprincl "You can't climb that.")) - (t - (dun-mprincl - "You manage to get about two feet up the tree and fall back down. You -notice that the tree is very unsteady."))))) - -(defun dun-eat (obj) - (let (objnum) - (when (setq objnum (dun-objnum-from-args-std obj)) - (if (not (member objnum dun-inventory)) - (dun-mprincl "You don't have that.") - (if (not (= objnum obj-food)) - (progn - (dun-mprinc "You forcefully shove ") - (dun-mprinc (downcase (cadr (nth objnum dun-objects)))) - (dun-mprincl " down your throat, and start choking.") - (dun-die "choking")) - (dun-mprincl "That tasted horrible.") - (dun-remove-obj-from-inven obj-food)))))) - -(defun dun-put (args) - (let (newargs objnum objnum2 obj) - (setq newargs (dun-firstwordl args)) - (if (not newargs) - (dun-mprincl "You must supply an object") - (setq obj (intern (car newargs))) - (setq objnum (cdr (assq obj dun-objnames))) - (if (not objnum) - (dun-mprincl "I don't know what that object is.") - (if (not (member objnum dun-inventory)) - (dun-mprincl "You don't have that.") - (setq newargs (dun-firstwordl (cdr newargs))) - (setq newargs (dun-firstwordl (cdr newargs))) - (if (not newargs) - (dun-mprincl "You must supply an indirect object.") - (setq objnum2 (cdr (assq (intern (car newargs)) dun-objnames))) - (if (and (eq objnum2 obj-computer) (= dun-current-room pc-area)) - (setq objnum2 obj-pc)) - (if (not objnum2) - (dun-mprincl "I don't know what that indirect object is.") - (if (and (not (member objnum2 - (nth dun-current-room dun-room-objects))) - (not (member objnum2 - (nth dun-current-room dun-room-silents))) - (not (member objnum2 dun-inventory))) - (dun-mprincl "That indirect object is not here.") - (dun-put-objs objnum objnum2))))))))) - -(defun dun-put-objs (obj1 obj2) - (if (and (= obj2 obj-drop) (not dun-nomail)) - (setq obj2 obj-chute)) - - (if (= obj2 obj-disposal) (setq obj2 obj-chute)) - - (if (and (= obj1 obj-cpu) (= obj2 obj-computer)) - (progn - (dun-remove-obj-from-inven obj-cpu) - (setq dun-computer t) - (dun-mprincl -"As you put the CPU board in the computer, it immediately springs to life. -The lights start flashing, and the fans seem to startup.")) - (if (and (= obj1 obj-weight) (= obj2 obj-button)) - (dun-drop '("weight")) - (if (= obj2 obj-jar) ;; Put something in jar - (if (not (member obj1 (list obj-paper obj-diamond obj-emerald - obj-license obj-coins obj-egg - obj-nitric obj-glycerine))) - (dun-mprincl "That will not fit in the jar.") - (dun-remove-obj-from-inven obj1) - (setq dun-jar (append dun-jar (list obj1))) - (dun-mprincl "Done.")) - (if (= obj2 obj-chute) ;; Put something in chute - (progn - (dun-remove-obj-from-inven obj1) - (dun-mprincl -"You hear it slide down the chute and off into the distance.") - (dun-put-objs-in-treas (list obj1))) - (if (= obj2 obj-box) ;; Put key in key box - (if (= obj1 obj-key) - (progn - (dun-mprincl -"As you drop the key, the box begins to shake. Finally it explodes -with a bang. The key seems to have vanished!") - (dun-remove-obj-from-inven obj1) - (dun-replace dun-room-objects computer-room (append - (nth computer-room - dun-room-objects) - (list obj1))) - (dun-remove-obj-from-room dun-current-room obj-box) - (setq dun-key-level (1+ dun-key-level))) - (dun-mprincl "You can't put that in the key box!")) - - (if (and (= obj1 obj-floppy) (= obj2 obj-pc)) - (progn - (setq dun-floppy t) - (dun-remove-obj-from-inven obj1) - (dun-mprincl "Done.")) - - (if (= obj2 obj-urinal) ;; Put object in urinal - (progn - (dun-remove-obj-from-inven obj1) - (dun-replace dun-room-objects urinal (append - (nth urinal dun-room-objects) - (list obj1))) - (dun-mprincl - "You hear it plop down in some water below.")) - (if (= obj2 obj-mail) - (dun-mprincl "The mail chute is locked.") - (if (member obj1 dun-inventory) - (dun-mprincl -"I don't know how to combine those objects. Perhaps you should -just try dropping it.") - (dun-mprincl "You can't put that there."))))))))))) - -(defun dun-type (_args) - (if (not (= dun-current-room computer-room)) - (dun-mprincl "There is nothing here on which you could type.") - (if (not dun-computer) - (dun-mprincl -"You type on the keyboard, but your characters do not even echo.") - (dun-unix-interface)))) - -;;; Various movement directions - -(defun dun-n (_args) - (dun-move north)) - -(defun dun-s (_args) - (dun-move south)) - -(defun dun-e (_args) - (dun-move east)) - -(defun dun-w (_args) - (dun-move west)) - -(defun dun-ne (_args) - (dun-move northeast)) - -(defun dun-se (_args) - (dun-move southeast)) - -(defun dun-nw (_args) - (dun-move northwest)) - -(defun dun-sw (_args) - (dun-move southwest)) - -(defun dun-up (_args) - (dun-move up)) - -(defun dun-down (_args) - (dun-move down)) - -(defun dun-in (_args) - (dun-move in)) - -(defun dun-out (_args) - (dun-move out)) - -(defun dun-go (args) - (if (or (not (car args)) - (eq (dun-doverb dun-ignore dun-verblist (car args) - (cdr (cdr args))) -1)) - (dun-mprinc "I don't understand where you want me to go.\n"))) - -;;; Uses the dungeon-map to figure out where we are going. If the -;;; requested direction yields 255, we know something special is -;;; supposed to happen, or perhaps you can't go that way unless -;;; certain conditions are met. - -(defun dun-move (dir) - (if (and (not (member dun-current-room dun-light-rooms)) - (not (member obj-lamp dun-inventory)) - (not (member obj-lamp (nth dun-current-room dun-room-objects)))) - (progn - (dun-mprinc -"You trip over a grue and fall into a pit and break every bone in your -body.") - (dun-die "a grue")) - (let (newroom) - (setq newroom (nth dir (nth dun-current-room dungeon-map))) - (if (eq newroom -1) - (dun-mprinc "You can't go that way.\n") - (if (eq newroom 255) - (dun-special-move dir) - (setq room -1) - (setq dun-lastdir dir) - (if dun-inbus - (progn - (if (or (< newroom 58) (> newroom 83)) - (dun-mprincl "The bus cannot go this way.") - (dun-mprincl - "The bus lurches ahead and comes to a screeching halt.") - (dun-remove-obj-from-room dun-current-room obj-bus) - (setq dun-current-room newroom) - (dun-replace dun-room-objects newroom - (append (nth newroom dun-room-objects) - (list obj-bus))))) - (setq dun-current-room newroom))))))) - -;;; Movement in this direction causes something special to happen if the -;;; right conditions exist. It may be that you can't go this way unless -;;; you have a key, or a passage has been opened. - -;;; coding note: Each check of the current room is on the same 'if' level, -;;; i.e. there aren't else's. If two rooms next to each other have -;;; specials, and they are connected by specials, this could cause -;;; a problem. Be careful when adding them to consider this, and -;;; perhaps use else's. - -(defun dun-special-move (dir) - (if (= dun-current-room building-front) - (if (not (member obj-key dun-inventory)) - (dun-mprincl "You don't have a key that can open this door.") - (setq dun-current-room old-building-hallway)) - (if (= dun-current-room north-end-of-cave-passage) - (let (combo) - (dun-mprincl -"You must type a 3 digit combination code to enter this room.") - (dun-mprinc "Enter it here: ") - (setq combo (dun-read-line)) - (if (not dun-batch-mode) - (dun-mprinc "\n")) - (if (string= combo dun-combination) - (setq dun-current-room gamma-computing-center) - (dun-mprincl "Sorry, that combination is incorrect.")))) - - (if (= dun-current-room bear-hangout) - (if (member obj-bear (nth bear-hangout dun-room-objects)) - (progn - (dun-mprinc -"The bear is very annoyed that you would be so presumptuous as to try -and walk right by it. He tells you so by tearing your head off. -") - (dun-die "a bear")) - (dun-mprincl "You can't go that way."))) - - (if (= dun-current-room vermont-station) - (progn - (dun-mprincl -"As you board the train it immediately leaves the station. It is a very -bumpy ride. It is shaking from side to side, and up and down. You -sit down in one of the chairs in order to be more comfortable.") - (dun-mprincl -"\nFinally the train comes to a sudden stop, and the doors open, and some -force throws you out. The train speeds away.\n") - (setq dun-current-room museum-station))) - - (if (= dun-current-room old-building-hallway) - (if (and (member obj-key dun-inventory) - (> dun-key-level 0)) - (setq dun-current-room meadow) - (dun-mprincl "You don't have a key that can open this door."))) - - (if (and (= dun-current-room maze-button-room) (= dir northwest)) - (if (member obj-weight (nth maze-button-room dun-room-objects)) - (setq dun-current-room 18) - (dun-mprincl "You can't go that way."))) - - (if (and (= dun-current-room maze-button-room) (= dir up)) - (if (member obj-weight (nth maze-button-room dun-room-objects)) - (dun-mprincl "You can't go that way.") - (setq dun-current-room weight-room))) - - (if (= dun-current-room classroom) - (dun-mprincl "The door is locked.")) - - (if (or (= dun-current-room lakefront-north) - (= dun-current-room lakefront-south)) - (dun-swim nil)) - - (if (= dun-current-room reception-area) - (if (not (= dun-sauna-level 3)) - (setq dun-current-room health-club-front) - (dun-mprincl -"As you exit the building, you notice some flames coming out of one of the -windows. Suddenly, the building explodes in a huge ball of fire. The flames -engulf you, and you burn to death.") - (dun-die "burning"))) - - (if (= dun-current-room red-room) - (if (not (member obj-towel (nth red-room dun-room-objects))) - (setq dun-current-room long-n-s-hallway) - (dun-mprincl "You can't go that way."))) - - (if (and (> dir down) (> dun-current-room gamma-computing-center) - (< dun-current-room museum-lobby)) - (if (not (member obj-bus (nth dun-current-room dun-room-objects))) - (dun-mprincl "You can't go that way.") - (if (= dir in) - (if dun-inbus - (dun-mprincl - "You are already in the bus!") - (if (member obj-license dun-inventory) - (progn - (dun-mprincl - "You board the bus and get in the driver's seat.") - (setq dun-nomail t) - (setq dun-inbus t)) - (dun-mprincl "You are not licensed for this type of vehicle."))) - (if (not dun-inbus) - (dun-mprincl "You are already off the bus!") - (dun-mprincl "You hop off the bus.") - (setq dun-inbus nil)))) - (if (= dun-current-room fifth-oaktree-intersection) - (if (not dun-inbus) - (progn - (dun-mprincl "You fall down the cliff and land on your head.") - (dun-die "a cliff")) - (dun-mprincl -"The bus flies off the cliff, and plunges to the bottom, where it explodes.") - (dun-die "a bus accident"))) - (if (= dun-current-room main-maple-intersection) - (progn - (if (not dun-inbus) - (dun-mprincl "The gate will not open.") - (dun-mprincl -"As the bus approaches, the gate opens and you drive through.") - (dun-remove-obj-from-room main-maple-intersection obj-bus) - (dun-replace dun-room-objects museum-entrance - (append (nth museum-entrance dun-room-objects) - (list obj-bus))) - (setq dun-current-room museum-entrance))))) - (if (= dun-current-room cave-entrance) - (progn - (dun-mprincl -"As you enter the room you hear a rumbling noise. You look back to see -huge rocks sliding down from the ceiling, and blocking your way out.\n") - (setq dun-current-room misty-room))))) - -(defun dun-long (_args) - (setq dun-mode "long")) - -(defun dun-turn (obj) - (let (objnum direction) - (when (setq objnum (dun-objnum-from-args-std obj)) - (if (not (or (member objnum (nth dun-current-room dun-room-objects)) - (member objnum (nth dun-current-room dun-room-silents)))) - (dun-mprincl "I don't see that here.") - (if (not (= objnum obj-dial)) - (dun-mprincl "You can't turn that.") - (setq direction (dun-firstword (cdr obj))) - (if (or (not direction) - (not (or (string= direction "clockwise") - (string= direction "counterclockwise")))) - (dun-mprincl "You must indicate clockwise or counterclockwise.") - (if (string= direction "clockwise") - (setq dun-sauna-level (+ dun-sauna-level 1)) - (setq dun-sauna-level (- dun-sauna-level 1))) - - (if (< dun-sauna-level 0) - (progn - (dun-mprincl - "The dial will not turn further in that direction.") - (setq dun-sauna-level 0)) - (dun-sauna-heat)))))))) - -(defun dun-sauna-heat () - (if (= dun-sauna-level 0) - (dun-mprincl - "The temperature has returned to normal room temperature.")) - (if (= dun-sauna-level 1) - (dun-mprincl "It is now luke warm in here. You are perspiring.")) - (if (= dun-sauna-level 2) - (dun-mprincl "It is pretty hot in here. It is still very comfortable.")) - (if (= dun-sauna-level 3) - (progn - (dun-mprincl -"It is now very hot. There is something very refreshing about this.") - (if (or (member obj-rms dun-inventory) - (member obj-rms (nth dun-current-room dun-room-objects))) - (progn - (dun-mprincl -"You notice the wax on your statuette beginning to melt, until it completely -melts off. You are left with a beautiful diamond!") - (if (member obj-rms dun-inventory) - (progn - (dun-remove-obj-from-inven obj-rms) - (setq dun-inventory (append dun-inventory - (list obj-diamond)))) - (dun-remove-obj-from-room dun-current-room obj-rms) - (dun-replace dun-room-objects dun-current-room - (append (nth dun-current-room dun-room-objects) - (list obj-diamond)))))) - (if (or (member obj-floppy dun-inventory) - (member obj-floppy (nth dun-current-room dun-room-objects))) - (progn - (dun-mprincl -"You notice your floppy disk beginning to melt. As you grab for it, the -disk bursts into flames, and disintegrates.") - (if (member obj-floppy dun-inventory) - (dun-remove-obj-from-inven obj-floppy) - (dun-remove-obj-from-room dun-current-room obj-floppy)))))) - - (if (= dun-sauna-level 4) - (progn - (dun-mprincl -"As the dial clicks into place, you immediately burst into flames.") - (dun-die "burning")))) - -(defun dun-press (obj) - (let (objnum) - (when (setq objnum (dun-objnum-from-args-std obj)) - (if (not (or (member objnum (nth dun-current-room dun-room-objects)) - (member objnum (nth dun-current-room dun-room-silents)))) - (dun-mprincl "I don't see that here.") - (if (not (member objnum (list obj-button obj-switch))) - (progn - (dun-mprinc "You can't ") - (dun-mprinc (car line-list)) - (dun-mprincl " that.")) - (if (= objnum obj-button) - (dun-mprincl -"As you press the button, you notice a passageway open up, but -as you release it, the passageway closes.")) - (if (= objnum obj-switch) - (if dun-black - (progn - (dun-mprincl "The button is now in the off position.") - (setq dun-black nil)) - (dun-mprincl "The button is now in the on position.") - (setq dun-black t)))))))) - -(defun dun-swim (_args) - (if (not (member dun-current-room (list lakefront-north lakefront-south))) - (dun-mprincl "I see no water!") - (if (not (member obj-life dun-inventory)) - (progn - (dun-mprincl -"You dive in the water, and at first notice it is quite cold. You then -start to get used to it as you realize that you never really learned how -to swim.") - (dun-die "drowning")) - (if (= dun-current-room lakefront-north) - (setq dun-current-room lakefront-south) - (setq dun-current-room lakefront-north))))) - - -(defun dun-score (_args) - (if (not dun-endgame) - (let (total) - (setq total (dun-reg-score)) - (dun-mprinc "You have scored ") - (dun-mprinc total) - (dun-mprincl " out of a possible 90 points.") total) - (dun-mprinc "You have scored ") - (dun-mprinc (dun-endgame-score)) - (dun-mprincl " endgame points out of a possible 110.") - (if (= (dun-endgame-score) 110) - (dun-mprincl -"\n\nCongratulations. You have won. The wizard password is ‘moby’")))) - -(defun dun-help (_args) - (dun-mprincl -"Welcome to dunnet (2.02), by Ron Schnell (ronnie@driver-aces.com - @RonnieSchnell). -Here is some useful information (read carefully because there are one -or more clues in here): -- If you have a key that can open a door, you do not need to explicitly - open it. You may just use ‘in’ or walk in the direction of the door. - -- If you have a lamp, it is always lit. - -- You will not get any points until you manage to get treasures to a certain - place. Simply finding the treasures is not good enough. There is more - than one way to get a treasure to the special place. It is also - important that the objects get to the special place *unharmed* and - *untarnished*. You can tell if you have successfully transported the - object by looking at your score, as it changes immediately. Note that - an object can become harmed even after you have received points for it. - If this happens, your score will decrease, and in many cases you can never - get credit for it again. - -- You can save your game with the ‘save’ command, and use restore it - with the ‘restore’ command. - -- There are no limits on lengths of object names. - -- Directions are: north,south,east,west,northeast,southeast,northwest, - southwest,up,down,in,out. - -- These can be abbreviated: n,s,e,w,ne,se,nw,sw,u,d,in,out. - -- If you go down a hole in the floor without an aid such as a ladder, - you probably won't be able to get back up the way you came, if at all. - -- To run this game in batch mode (no Emacs window), use: - emacs -batch -l dunnet -NOTE: This game *should* be run in batch mode! - -If you have questions or comments, please contact ronnie@driver-aces.com -My home page is http://www.driver-aces.com/ronnie.html -")) - -(defun dun-flush (_args) - (if (not (= dun-current-room bathroom)) - (dun-mprincl "I see nothing to flush.") - (dun-mprincl "Whoooosh!!") - (dun-put-objs-in-treas (nth urinal dun-room-objects)) - (dun-replace dun-room-objects urinal nil))) - -(defun dun-piss (_args) - (if (not (= dun-current-room bathroom)) - (dun-mprincl "You can't do that here, don't even bother trying.") - (if (not dun-gottago) - (dun-mprincl "I'm afraid you don't have to go now.") - (dun-mprincl "That was refreshing.") - (setq dun-gottago nil) - (dun-replace dun-room-objects urinal (append - (nth urinal dun-room-objects) - (list obj-URINE)))))) - - -(defun dun-sleep (_args) - (if (not (= dun-current-room bedroom)) - (dun-mprincl -"You try to go to sleep while standing up here, but can't seem to do it.") - (setq dun-gottago t) - (dun-mprincl -"As soon as you start to doze off you begin dreaming. You see images of -workers digging caves, slaving in the humid heat. Then you see yourself -as one of these workers. While no one is looking, you leave the group -and walk into a room. The room is bare except for a horseshoe -shaped piece of stone in the center. You see yourself digging a hole in -the ground, then putting some kind of treasure in it, and filling the hole -with dirt again. After this, you immediately wake up."))) - -(defun dun-break (obj) - (let (objnum) - (if (not (member obj-axe dun-inventory)) - (dun-mprincl "You have nothing you can use to break things.") - (when (setq objnum (dun-objnum-from-args-std obj)) - (if (member objnum dun-inventory) - (progn - (dun-mprincl -"You take the object in your hands and swing the axe. Unfortunately, you miss -the object and slice off your hand. You bleed to death.") - (dun-die "an axe")) - (if (not (or (member objnum (nth dun-current-room dun-room-objects)) - (member objnum - (nth dun-current-room dun-room-silents)))) - (dun-mprincl "I don't see that here.") - (if (= objnum obj-cable) - (progn - (dun-mprincl -"As you break the ethernet cable, everything starts to blur. You collapse -for a moment, then straighten yourself up. -") - (dun-replace dun-room-objects gamma-computing-center - (append - (nth gamma-computing-center dun-room-objects) - dun-inventory)) - (if (member obj-key dun-inventory) - (progn - (setq dun-inventory (list obj-key)) - (dun-remove-obj-from-room - gamma-computing-center obj-key)) - (setq dun-inventory nil)) - (setq dun-current-room computer-room) - (setq dun-ethernet nil) - (dun-mprincl "Connection closed.") - (dun-unix-interface)) - (if (< objnum 0) - (progn - (dun-mprincl "Your axe shatters into a million pieces.") - (dun-remove-obj-from-inven obj-axe)) - (dun-mprincl "Your axe breaks it into a million pieces.") - (dun-remove-obj-from-room dun-current-room objnum))))))))) - -(defun dun-drive (_args) - (if (not dun-inbus) - (dun-mprincl "You cannot drive when you aren't in a vehicle.") - (dun-mprincl "To drive while you are in the bus, just give a direction."))) - -(defun dun-superb (_args) - (setq dun-mode 'dun-superb)) - -(defun dun-reg-score () - (let (total) - (setq total 0) - (dolist (x (nth treasure-room dun-room-objects)) - (setq total (+ total (nth x dun-object-pts)))) - (if (member obj-URINE (nth treasure-room dun-room-objects)) - (setq total 0)) total)) - -(defun dun-endgame-score () - (let (total) - (setq total 0) - (dolist (x (nth endgame-treasure-room dun-room-objects)) - (setq total (+ total (nth x dun-object-pts)))) total)) - -(defun dun-answer (args) - (if (not dun-correct-answer) - (dun-mprincl "I don't believe anyone asked you anything.") - (setq args (car args)) - (if (not args) - (dun-mprincl "You must give the answer on the same line.") - (if (dun-members args dun-correct-answer) - (progn - (dun-mprincl "Correct.") - (if (= dun-lastdir 0) - (setq dun-current-room (1+ dun-current-room)) - (setq dun-current-room (- dun-current-room 1))) - (setq dun-correct-answer nil)) - (dun-mprincl "That answer is incorrect."))))) - -(defun dun-endgame-question () -(if (not dun-endgame-questions) - (progn - (dun-mprincl "Your question is:") - (dun-mprincl "No more questions, just do ‘answer foo’.") - (setq dun-correct-answer '("foo"))) - (let (which i newques) - (setq i 0) - (setq newques nil) - (setq which (random (length dun-endgame-questions))) - (dun-mprincl "Your question is:") - (dun-mprincl (setq dun-endgame-question (car - (nth which - dun-endgame-questions)))) - (setq dun-correct-answer (cdr (nth which dun-endgame-questions))) - (while (< i which) - (setq newques (append newques (list (nth i dun-endgame-questions)))) - (setq i (1+ i))) - (setq i (1+ which)) - (while (< i (length dun-endgame-questions)) - (setq newques (append newques (list (nth i dun-endgame-questions)))) - (setq i (1+ i))) - (setq dun-endgame-questions newques)))) - -(defun dun-power (_args) - (if (not (= dun-current-room pc-area)) - (dun-mprincl "That operation is not applicable here.") - (if (not dun-floppy) - (dun-dos-no-disk) - (dun-dos-interface)))) - -(defun dun-feed (args) - (let (objnum) - (when (setq objnum (dun-objnum-from-args-std args)) - (if (and (= objnum obj-bear) - (member obj-bear (nth dun-current-room dun-room-objects))) - (progn - (if (not (member obj-food dun-inventory)) - (dun-mprincl "You have nothing with which to feed it.") - (dun-drop '("food")))) - (if (not (or (member objnum (nth dun-current-room dun-room-objects)) - (member objnum dun-inventory) - (member objnum (nth dun-current-room dun-room-silents)))) - (dun-mprincl "I don't see that here.") - (dun-mprincl "You cannot feed that.")))))) - - -;;;; -;;;; This section defines various utility functions used -;;;; by dunnet. -;;;; - - -;;; Function which takes a verb and a list of other words. Calls proper -;;; function associated with the verb, and passes along the other words. - -(defun dun-doverb (dun-ignore dun-verblist verb rest) - (if (not verb) - nil - (if (member (intern verb) dun-ignore) - (if (not (car rest)) -1 - (dun-doverb dun-ignore dun-verblist (car rest) (cdr rest))) - (if (not (cdr (assq (intern verb) dun-verblist))) -1 - (setq dun-numcmds (1+ dun-numcmds)) - (funcall (cdr (assq (intern verb) dun-verblist)) rest))))) - - -;;; Function to take a string and change it into a list of lowercase words. - -(defun dun-listify-string (strin) - (let (pos ret-list end-pos) - (setq pos 0) - (setq ret-list nil) - (while (setq end-pos (string-match "[ ,:;]" (substring strin pos))) - (setq end-pos (+ end-pos pos)) - (if (not (= end-pos pos)) - (setq ret-list (append ret-list (list - (downcase - (substring strin pos end-pos)))))) - (setq pos (+ end-pos 1))) ret-list)) - -(defun dun-listify-string2 (strin) - (let (pos ret-list end-pos) - (setq pos 0) - (setq ret-list nil) - (while (setq end-pos (string-match " " (substring strin pos))) - (setq end-pos (+ end-pos pos)) - (if (not (= end-pos pos)) - (setq ret-list (append ret-list (list - (downcase - (substring strin pos end-pos)))))) - (setq pos (+ end-pos 1))) ret-list)) - -(defun dun-replace (list n number) - (rplaca (nthcdr n list) number)) - - -;;; Get the first non-ignored word from a list. - -(defun dun-firstword (list) - (if (not (car list)) - nil - (while (and list (member (intern (car list)) dun-ignore)) - (setq list (cdr list))) - (car list))) - -(defun dun-firstwordl (list) - (if (not (car list)) - nil - (while (and list (member (intern (car list)) dun-ignore)) - (setq list (cdr list))) - list)) - -;;; parse a line passed in as a string Call the proper verb with the -;;; rest of the line passed in as a list. - -(defun dun-vparse (dun-ignore dun-verblist line) - (dun-mprinc "\n") - (setq line-list (dun-listify-string (concat line " "))) - (dun-doverb dun-ignore dun-verblist (car line-list) (cdr line-list))) - -(defun dun-parse2 (dun-ignore dun-verblist line) - (dun-mprinc "\n") - (setq line-list (dun-listify-string2 (concat line " "))) - (dun-doverb dun-ignore dun-verblist (car line-list) (cdr line-list))) - -;;; Read a line, in window mode - -(defun dun-read-line () - (let (line) - (setq line (read-string "")) - (dun-mprinc line) line)) - -;;; Insert something into the window buffer - -(defun dun-minsert (string) - (if (stringp string) - (insert string) - (insert (prin1-to-string string)))) - -;;; Print something out, in window mode - -(defun dun-mprinc (string) - (if (stringp string) - (insert string) - (insert (prin1-to-string string)))) - -;;; In window mode, keep screen from jumping by keeping last line at -;;; the bottom of the screen. - -(defun dun-fix-screen () - (interactive) - (forward-line (- 0 (- (window-height) 2 ))) - (set-window-start (selected-window) (point)) - (goto-char (point-max))) - -;;; Insert something into the buffer, followed by newline. - -(defun dun-minsertl (string) - (dun-minsert string) - (dun-minsert "\n")) - -;;; Print something, followed by a newline. - -(defun dun-mprincl (string) - (dun-mprinc string) - (dun-mprinc "\n")) - -;;; Function which will get an object number given the list of -;;; words in the command, except for the verb. - -(defun dun-objnum-from-args (obj) - (setq obj (dun-firstword obj)) - (if (not obj) - obj-special - (cdr (assq (intern obj) dun-objnames)))) - -(defun dun-objnum-from-args-std (obj) - (let (result) - (if (eq (setq result (dun-objnum-from-args obj)) obj-special) - (dun-mprincl "You must supply an object.")) - (if (eq result nil) - (dun-mprincl "I don't know what that is.")) - (if (eq result obj-special) - nil - result))) - -;;; Take a short room description, and change spaces and slashes to dashes. - -(defun dun-space-to-hyphen (string) - (let (space) - (if (setq space (string-match "[ /]" string)) - (progn - (setq string (concat (substring string 0 space) "-" - (substring string (1+ space)))) - (dun-space-to-hyphen string)) - string))) - -;;; Given a unix style pathname, build a list of path components (recursive) - -(defun dun-get-path (dirstring startlist) - (let (slash) - (if (= (length dirstring) 0) - startlist - (if (string= (substring dirstring 0 1) "/") - (dun-get-path (substring dirstring 1) (append startlist (list "/"))) - (if (not (setq slash (string-match "/" dirstring))) - (append startlist (list dirstring)) - (dun-get-path (substring dirstring (1+ slash)) - (append startlist - (list (substring dirstring 0 slash))))))))) - - -;;; Is a string a member of a string list? - -(defun dun-members (string string-list) - (let (found) - (setq found nil) - (dolist (x string-list) - (if (string= x string) - (setq found t))) found)) - -;;; Function to put objects in the treasure room. Also prints current -;;; score to let user know he has scored. - -(defun dun-put-objs-in-treas (objlist) - (let (oscore newscore) - (setq oscore (dun-reg-score)) - (dun-replace dun-room-objects 0 (append (nth 0 dun-room-objects) objlist)) - (setq newscore (dun-reg-score)) - (if (not (= oscore newscore)) - (dun-score nil)))) - -;;; Load an encrypted file, and eval it. - -(defun dun-load-d (filename) - (let (old-buffer result) - (setq result t) - (setq old-buffer (current-buffer)) - (switch-to-buffer (get-buffer-create "*loadc*")) - (erase-buffer) - (condition-case nil - (insert-file-contents filename) - (error (setq result nil))) - (unless (not result) - (condition-case nil - (dun-rot13) - (error (yank))) - (eval-buffer) - (kill-buffer (current-buffer))) - (switch-to-buffer old-buffer) - result)) - -;;; Functions to remove an object either from a room, or from inventory. - -(defun dun-remove-obj-from-room (room objnum) - (let (newroom) - (setq newroom nil) - (dolist (x (nth room dun-room-objects)) - (if (not (= x objnum)) - (setq newroom (append newroom (list x))))) - (rplaca (nthcdr room dun-room-objects) newroom))) - -(defun dun-remove-obj-from-inven (objnum) - (let (new-inven) - (setq new-inven nil) - (dolist (x dun-inventory) - (if (not (= x objnum)) - (setq new-inven (append new-inven (list x))))) - (setq dun-inventory new-inven))) - -(defun dun-rot13 () - (rot13-region (point-min) (point-max))) - -;;;; -;;;; This section defines the globals that are used in dunnet. -;;;; -;;;; IMPORTANT -;;;; All globals which can change must be saved from 'save-game. Add -;;;; all new globals to bottom of file. - -(setq dun-visited '(27)) -(setq dun-current-room 1) -(setq dun-exitf nil) -(setq dun-badcd nil) -(define-obsolete-variable-alias 'dungeon-mode-map 'dun-mode-map "22.1") -(define-key dun-mode-map "\r" 'dun-parse) -(defvar dungeon-batch-map (make-keymap)) -(if (string= (substring emacs-version 0 2) "18") - (let (n) - (setq n 32) - (while (< 0 (setq n (- n 1))) - (aset dungeon-batch-map n 'dungeon-nil))) - (let (n) - (setq n 32) - (while (< 0 (setq n (- n 1))) - (aset (car (cdr dungeon-batch-map)) n 'dungeon-nil)))) -(define-key dungeon-batch-map "\r" 'exit-minibuffer) -(define-key dungeon-batch-map "\n" 'exit-minibuffer) -(setq dun-computer nil) -(setq dun-floppy nil) -(setq dun-key-level 0) -(setq dun-hole nil) -(setq dun-correct-answer nil) -(setq dun-lastdir 0) -(setq dun-numsaves 0) -(setq dun-jar nil) -(setq dun-dead nil) -(setq room 0) -(setq dun-numcmds 0) -(setq dun-wizard nil) -(setq dun-endgame-question nil) -(setq dun-logged-in nil) -(setq dungeon-mode 'dungeon) -(setq dun-unix-verbs '((ls . dun-ls) (ftp . dun-ftp) (echo . dun-echo) - (exit . dun-uexit) (cd . dun-cd) (pwd . dun-pwd) - (rlogin . dun-rlogin) (ssh . dun-rlogin) - (uncompress . dun-uncompress) (cat . dun-cat))) - -(setq dun-dos-verbs '((dir . dun-dos-dir) (type . dun-dos-type) - (exit . dun-dos-exit) (command . dun-dos-spawn) - (b: . dun-dos-invd) (c: . dun-dos-invd) - (a: . dun-dos-nil))) - - -(setq dun-batch-mode nil) - -(setq dun-cdpath "/usr/toukmond") -(setq dun-cdroom -10) -(setq dun-uncompressed nil) -(setq dun-ethernet t) -(setq dun-restricted - '(dun-room-objects dungeon-map dun-rooms - dun-room-silents dun-combination)) -(setq dun-ftptype 'ascii) -(setq dun-endgame nil) -(setq dun-gottago t) -(setq dun-black nil) +(setq dun-cdpath "/usr/toukmond") +(setq dun-cdroom -10) +(setq dun-uncompressed nil) +(setq dun-ethernet t) +(setq dun-restricted + '(dun-room-objects dungeon-map dun-rooms + dun-room-silents dun-combination)) +(setq dun-ftptype 'ascii) +(setq dun-endgame nil) +(setq dun-gottago t) +(setq dun-black nil) (setq dun-rooms '( ( @@ -1888,593 +594,1892 @@ a hallway leads to the south." "You are in the winner's room. A door leads back to the south." "Winner's room" ;103 ) - ( -"You have reached a dead end. There is a PC on the floor here. Above -it is a sign that reads: - Type the ‘reset’ command to type on the PC. -A hole leads north." - "PC area" ;104 - ) + ( +"You have reached a dead end. There is a PC on the floor here. Above +it is a sign that reads: + Type the ‘reset’ command to type on the PC. +A hole leads north." + "PC area" ;104 + ) +)) + +(setq dun-light-rooms '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 24 25 26 27 28 58 59 + 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 + 77 78 79 80 81 82 83)) + +(setq dun-verblist '((die . dun-die) (ne . dun-ne) (north . dun-n) + (south . dun-s) (east . dun-e) (west . dun-w) + (u . dun-up) (d . dun-down) (i . dun-inven) + (inventory . dun-inven) (look . dun-examine) (n . dun-n) + (s . dun-s) (e . dun-e) (w . dun-w) (se . dun-se) + (nw . dun-nw) (sw . dun-sw) (up . dun-up) + (down . dun-down) (in . dun-in) (out . dun-out) + (go . dun-go) (drop . dun-drop) (southeast . dun-se) + (southwest . dun-sw) (northeast . dun-ne) + (northwest . dun-nw) (save . dun-save-game) + (restore . dun-restore) (long . dun-long) (dig . dun-dig) + (shake . dun-shake) (wave . dun-shake) + (examine . dun-examine) (describe . dun-examine) + (climb . dun-climb) (eat . dun-eat) (put . dun-put) + (type . dun-type) (insert . dun-put) + (score . dun-score) (help . dun-help) (quit . dun-quit) + (read . dun-examine) (verbose . dun-long) + (urinate . dun-piss) (piss . dun-piss) + (flush . dun-flush) (sleep . dun-sleep) (lie . dun-sleep) + (x . dun-examine) (break . dun-break) (drive . dun-drive) + (board . dun-in) (enter . dun-in) (turn . dun-turn) + (press . dun-press) (push . dun-press) (swim . dun-swim) + (on . dun-in) (off . dun-out) (chop . dun-break) + (switch . dun-press) (cut . dun-break) (exit . dun-out) + (leave . dun-out) (reset . dun-power) (flick . dun-press) + (superb . dun-superb) (answer . dun-answer) + (throw . dun-drop) (l . dun-examine) (take . dun-take) + (get . dun-take) (feed . dun-feed))) + +(setq dun-inbus nil) +(setq dun-nomail nil) +(setq dun-ignore '(the to at)) +(setq dun-mode 'moby) +(setq dun-sauna-level 0) + +(defconst north 0) +(defconst south 1) +(defconst east 2) +(defconst west 3) +(defconst northeast 4) +(defconst southeast 5) +(defconst northwest 6) +(defconst southwest 7) +(defconst up 8) +(defconst down 9) +(defconst in 10) +(defconst out 11) + +(setq dungeon-map '( +; no so ea we ne se nw sw up do in ot + ( 96 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;0 + ( -1 -1 2 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;1 + ( -1 -1 3 1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;2 + ( -1 -1 -1 2 4 6 -1 -1 -1 -1 -1 -1 ) ;3 + ( -1 -1 -1 -1 5 -1 -1 3 -1 -1 -1 -1 ) ;4 + ( -1 -1 -1 -1 255 -1 -1 4 -1 -1 255 -1 ) ;5 + ( -1 -1 -1 -1 -1 7 3 -1 -1 -1 -1 -1 ) ;6 + ( -1 -1 -1 -1 -1 255 6 27 -1 -1 -1 -1 ) ;7 + ( 255 5 9 10 -1 -1 -1 5 -1 -1 -1 5 ) ;8 + ( -1 -1 -1 8 -1 -1 -1 -1 -1 -1 -1 -1 ) ;9 + ( -1 -1 8 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;10 + ( -1 8 -1 58 -1 -1 -1 -1 -1 -1 -1 -1 ) ;11 + ( -1 -1 13 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;12 + ( 15 -1 14 12 -1 -1 -1 -1 -1 -1 -1 -1 ) ;13 + ( -1 -1 -1 13 -1 -1 -1 -1 -1 -1 -1 -1 ) ;14 + ( -1 13 16 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;15 + ( -1 -1 -1 15 -1 -1 -1 -1 -1 17 16 -1 ) ;16 + ( -1 -1 17 17 17 17 255 17 255 17 -1 -1 ) ;17 + ( 18 18 18 18 18 -1 18 18 19 18 -1 -1 ) ;18 + ( -1 18 18 19 19 20 19 19 -1 18 -1 -1 ) ;19 + ( -1 -1 -1 18 -1 -1 -1 -1 -1 21 -1 -1 ) ;20 + ( -1 -1 -1 -1 -1 20 22 -1 -1 -1 -1 -1 ) ;21 + ( 18 18 18 18 16 18 23 18 18 18 18 18 ) ;22 + ( -1 255 -1 -1 -1 19 -1 -1 -1 -1 -1 -1 ) ;23 + ( 23 25 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;24 + ( 24 255 -1 -1 -1 -1 -1 -1 -1 -1 255 -1 ) ;25 + (255 28 -1 -1 -1 -1 -1 -1 -1 -1 255 -1 ) ;26 + ( -1 -1 -1 -1 7 -1 -1 -1 -1 -1 -1 -1 ) ;27 + ( 26 255 -1 -1 -1 -1 -1 -1 -1 -1 255 -1 ) ;28 + ( -1 -1 30 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;29 + ( -1 -1 31 29 -1 -1 -1 -1 -1 -1 -1 -1 ) ;30 + ( 32 33 -1 30 -1 -1 -1 -1 -1 -1 -1 -1 ) ;31 + ( -1 31 -1 255 -1 -1 -1 -1 -1 34 -1 -1 ) ;32 + ( 31 -1 -1 -1 -1 -1 -1 -1 -1 35 -1 -1 ) ;33 + ( -1 35 -1 -1 -1 -1 -1 -1 32 37 -1 -1 ) ;34 + ( 34 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;35 + ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;36 + ( -1 -1 -1 -1 -1 -1 -1 38 34 -1 -1 -1 ) ;37 + ( -1 -1 40 41 37 -1 -1 39 -1 -1 -1 -1 ) ;38 + ( -1 -1 -1 -1 38 -1 -1 -1 -1 -1 -1 -1 ) ;39 + ( -1 -1 -1 38 -1 -1 -1 -1 42 -1 -1 -1 ) ;40 + ( -1 -1 38 -1 -1 -1 -1 -1 -1 43 -1 -1 ) ;41 + ( -1 -1 -1 -1 -1 -1 -1 -1 -1 40 -1 -1 ) ;42 + ( 44 -1 46 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;43 + ( -1 43 45 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;44 + ( -1 46 -1 44 -1 -1 -1 -1 -1 -1 -1 -1 ) ;45 + ( 45 -1 -1 43 -1 -1 -1 -1 -1 255 -1 -1 ) ;46 + ( 48 50 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;47 + ( 49 47 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;48 + ( -1 48 -1 -1 -1 -1 -1 -1 52 -1 -1 -1 ) ;49 + ( 47 51 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;50 + ( 50 104 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;51 + ( -1 -1 -1 -1 -1 -1 -1 -1 53 49 -1 -1 ) ;52 + ( -1 -1 -1 -1 -1 -1 -1 -1 54 52 -1 -1 ) ;53 + ( -1 -1 -1 -1 55 -1 -1 -1 -1 53 -1 -1 ) ;54 + ( -1 -1 -1 -1 56 -1 -1 54 -1 -1 -1 54 ) ;55 + ( -1 -1 -1 -1 -1 -1 -1 55 -1 31 -1 -1 ) ;56 + ( -1 -1 32 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;57 + ( 59 -1 11 -1 -1 -1 -1 -1 -1 -1 255 255) ;58 + ( 60 58 63 -1 -1 -1 255 -1 -1 -1 255 255) ;59 + ( 61 59 64 -1 -1 -1 -1 -1 -1 -1 255 255) ;60 + ( 62 60 65 -1 -1 -1 -1 -1 -1 -1 255 255) ;61 + ( -1 61 66 -1 -1 -1 -1 -1 -1 -1 255 255) ;62 + ( 64 -1 67 59 -1 -1 -1 -1 -1 -1 255 255) ;63 + ( 65 63 68 60 -1 -1 -1 -1 -1 -1 255 255) ;64 + ( 66 64 69 61 -1 -1 -1 -1 -1 -1 255 255) ;65 + ( -1 65 70 62 -1 -1 -1 -1 -1 -1 255 255) ;66 + ( 68 -1 71 63 -1 -1 -1 -1 -1 -1 255 255) ;67 + ( 69 67 72 64 -1 -1 -1 -1 -1 -1 255 255) ;68 + ( 70 68 73 65 -1 -1 -1 -1 -1 -1 255 255) ;69 + ( -1 69 74 66 -1 -1 -1 -1 -1 -1 255 255) ;70 + ( 72 -1 75 67 -1 -1 -1 -1 -1 -1 255 255) ;71 + ( 73 71 76 68 -1 -1 -1 -1 -1 -1 255 255) ;72 + ( 74 72 77 69 -1 -1 -1 -1 -1 -1 255 255) ;73 + ( -1 73 78 70 -1 -1 -1 -1 -1 -1 255 255) ;74 + ( 76 -1 79 71 -1 -1 -1 -1 -1 -1 255 255) ;75 + ( 77 75 80 72 -1 -1 -1 -1 -1 -1 255 255) ;76 + ( 78 76 81 73 -1 -1 -1 -1 -1 -1 255 255) ;77 + ( -1 77 82 74 -1 -1 -1 -1 -1 -1 255 255) ;78 + ( 80 -1 -1 75 -1 -1 -1 -1 -1 -1 255 255) ;79 + ( 81 79 255 76 -1 -1 -1 -1 -1 -1 255 255) ;80 + ( 82 80 -1 77 -1 -1 -1 -1 -1 -1 255 255) ;81 + ( -1 81 -1 78 -1 -1 -1 -1 -1 -1 255 255) ;82 + ( 84 -1 -1 -1 -1 59 -1 -1 -1 -1 255 255) ;83 + ( -1 83 85 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;84 + ( 86 -1 87 84 -1 -1 -1 -1 -1 -1 -1 -1 ) ;85 + ( -1 85 88 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;86 + ( 88 -1 -1 85 -1 -1 -1 -1 -1 -1 -1 -1 ) ;87 + ( -1 87 255 86 -1 -1 -1 -1 -1 -1 -1 -1 ) ;88 + ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 255 -1 ) ;89 + ( 91 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;90 + ( 92 90 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;91 + ( -1 91 -1 -1 -1 -1 -1 -1 93 94 -1 -1 ) ;92 + ( -1 -1 -1 88 -1 -1 -1 -1 -1 92 -1 -1 ) ;93 + ( -1 -1 -1 -1 95 -1 -1 -1 92 -1 -1 -1 ) ;94 + ( -1 -1 -1 -1 -1 -1 -1 94 -1 -1 -1 -1 ) ;95 + ( 97 0 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;96 + ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;97 + ( 99 97 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;98 + ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;99 + ( 101 99 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;100 + ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;101 + ( 103 101 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;102 + ( -1 102 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;103 + ( 51 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;104 + ) +; no so ea we ne se nw sw up do in ot +) + + +;;; How the user references *all* objects, permanent and regular. +(setq dun-objnames '( + (shovel . 0) + (lamp . 1) + (cpu . 2) (board . 2) (card . 2) (chip . 2) + (food . 3) + (key . 4) + (paper . 5) (slip . 5) + (rms . 6) (statue . 6) (statuette . 6) (stallman . 6) + (diamond . 7) + (weight . 8) + (life . 9) (preserver . 9) + (bracelet . 10) (emerald . 10) + (gold . 11) + (platinum . 12) + (towel . 13) (beach . 13) + (axe . 14) + (silver . 15) + (license . 16) + (coins . 17) + (egg . 18) + (jar . 19) + (bone . 20) + (acid . 21) (nitric . 21) + (glycerine . 22) + (ruby . 23) + (amethyst . 24) + (mona . 25) + (bill . 26) + (floppy . 27) (disk . 27) + + (boulder . -1) + (tree . -2) (trees . -2) (palm . -2) + (bear . -3) + (bin . -4) (bins . -4) + (cabinet . -5) (computer . -5) (vax . -5) (ibm . -5) + (protoplasm . -6) + (dial . -7) + (button . -8) + (chute . -9) + (painting . -10) + (bed . -11) + (urinal . -12) + (URINE . -13) + (pipes . -14) (pipe . -14) + (box . -15) (slit . -15) + (cable . -16) (ethernet . -16) + (mail . -17) (drop . -17) + (bus . -18) + (gate . -19) + (cliff . -20) + (skeleton . -21) (dinosaur . -21) + (fish . -22) + (tanks . -23) (tank . -23) + (switch . -24) + (blackboard . -25) + (disposal . -26) (garbage . -26) + (ladder . -27) + (subway . -28) (train . -28) + (pc . -29) (drive . -29) (coconut . -30) (coconuts . -30) + (lake . -32) (water . -32) +)) + +(dolist (x dun-objnames) + (let (name) + (setq name (concat "obj-" (prin1-to-string (car x)))) + (eval (list 'defconst (intern name) (cdr x))))) + +(defconst obj-special 255) + +;;; The initial setup of what objects are in each room. +;;; Regular objects have whole numbers lower than 255. +;;; Objects that cannot be taken but might move and are +;;; described during room description are negative. +;;; Stuff that is described and might change are 255, and are +;;; handled specially by 'dun-describe-room. + +(setq dun-room-objects (list nil + + (list obj-shovel) ;; treasure-room + (list obj-boulder) ;; dead-end + nil nil nil + (list obj-food) ;; se-nw-road + (list obj-bear) ;; bear-hangout + nil nil + (list obj-special) ;; computer-room + (list obj-lamp obj-license obj-silver);; meadow + nil nil + (list obj-special) ;; sauna + nil + (list obj-weight obj-life) ;; weight-room + nil nil + (list obj-rms obj-floppy) ;; thirsty-maze + nil nil nil nil nil nil nil + (list obj-emerald) ;; hidden-area + nil + (list obj-gold) ;; misty-room + nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil + (list obj-towel obj-special) ;; red-room + nil nil nil nil nil + (list obj-box) ;; stair-landing + nil nil nil + (list obj-axe) ;; small-crawlspace + nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil + nil nil nil nil nil + (list obj-special) ;; fourth-vermont-intersection + nil nil + (list obj-coins) ;; fifth-oaktree-intersection + nil + (list obj-bus) ;; fifth-sycamore-intersection + nil + (list obj-bone) ;; museum-lobby + nil + (list obj-jar obj-special obj-ruby) ;; marine-life-area + (list obj-nitric) ;; maintenance-room + (list obj-glycerine) ;; classroom + nil nil nil nil nil + (list obj-amethyst) ;; bottom-of-subway-stairs + nil nil + (list obj-special) ;; question-room-1 + nil + (list obj-special) ;; question-room-2 + nil + (list obj-special) ;; question-room-three + nil + (list obj-mona) ;; winner's-room +nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil +nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil +nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil +nil)) + +;;; These are objects in a room that are only described in the +;;; room description. They are permanent. + +(setq dun-room-silents (list nil + (list obj-tree obj-coconut) ;; dead-end + (list obj-tree obj-coconut) ;; e-w-dirt-road + nil nil nil nil nil nil + (list obj-bin) ;; mailroom + (list obj-computer) ;; computer-room + nil nil nil + (list obj-dial) ;; sauna + nil + (list obj-ladder) ;; weight-room + (list obj-button obj-ladder) ;; maze-button-room + nil nil nil + nil nil nil nil + (list obj-lake) ;; lakefront-north + (list obj-lake) ;; lakefront-south + nil + (list obj-chute) ;; cave-entrance + nil nil nil nil nil + (list obj-painting obj-bed) ;; bedroom + (list obj-urinal obj-pipes) ;; bathroom + nil nil nil nil nil nil + (list obj-boulder) ;; horseshoe-boulder-room + nil nil nil nil nil nil nil nil nil nil nil nil nil nil + (list obj-computer obj-cable) ;; gamma-computing-center + (list obj-mail) ;; post-office + (list obj-gate) ;; main-maple-intersection + nil nil nil nil nil nil nil nil nil nil nil nil nil + nil nil nil nil nil nil nil + (list obj-cliff) ;; fifth-oaktree-intersection + nil nil nil + (list obj-dinosaur) ;; museum-lobby + nil + (list obj-fish obj-tanks) ;; marine-life-area + (list obj-switch) ;; maintenance-room + (list obj-blackboard) ;; classroom + (list obj-train) ;; vermont-station + nil nil + (list obj-disposal) ;; north-end-of-n-s-tunnel + nil nil + (list obj-computer) ;; endgame-computer-room + nil nil nil nil nil nil nil nil + (list obj-pc) ;; pc-area + nil nil nil nil nil nil +)) +(setq dun-inventory '(1)) + +;;; Descriptions of objects, as they appear in the room description, and +;;; the inventory. + +(setq dun-objects '( + ("There is a shovel here." "A shovel") ;0 + ("There is a lamp nearby." "A lamp") ;1 + ("There is a CPU card here." "A computer board") ;2 + ("There is some food here." "Some food") ;3 + ("There is a shiny brass key here." "A brass key") ;4 + ("There is a slip of paper here." "A slip of paper") ;5 + ("There is a wax statuette of Richard Stallman here." ;6 + "An RMS statuette") + ("There is a shimmering diamond here." "A diamond") ;7 + ("There is a 10 pound weight here." "A weight") ;8 + ("There is a life preserver here." "A life preserver");9 + ("There is an emerald bracelet here." "A bracelet") ;10 + ("There is a gold bar here." "A gold bar") ;11 + ("There is a platinum bar here." "A platinum bar") ;12 + ("There is a beach towel on the ground here." "A beach towel") + ("There is an axe here." "An axe") ;14 + ("There is a silver bar here." "A silver bar") ;15 + ("There is a bus driver's license here." "A license") ;16 + ("There are some valuable coins here." "Some valuable coins") + ("There is a jewel-encrusted egg here." "A valuable egg") ;18 + ("There is a glass jar here." "A glass jar") ;19 + ("There is a dinosaur bone here." "A bone") ;20 + ("There is a packet of nitric acid here." "Some nitric acid") + ("There is a packet of glycerine here." "Some glycerine") ;22 + ("There is a valuable ruby here." "A ruby") ;23 + ("There is a valuable amethyst here." "An amethyst") ;24 + ("The Mona Lisa is here." "The Mona Lisa") ;25 + ("There is a 100 dollar bill here." "A $100 bill") ;26 + ("There is a floppy disk here." "A floppy disk") ;27 + ) +) + +;;; Weight of objects + +(setq dun-object-lbs + '(2 1 1 1 1 0 2 2 10 3 1 1 1 0 1 1 0 1 1 1 1 0 0 2 2 1 0 0)) +(setq dun-object-pts + '(0 0 0 0 0 0 0 10 0 0 10 10 10 0 0 10 0 10 10 0 0 0 0 10 10 10 10 0)) + + +;;; Unix representation of objects. +(setq dun-objfiles '( + "shovel.o" "lamp.o" "cpu.o" "food.o" "key.o" "paper.o" + "rms.o" "diamond.o" "weight.o" "preserver.o" "bracelet.o" + "gold.o" "platinum.o" "towel.o" "axe.o" "silver.o" "license.o" + "coins.o" "egg.o" "jar.o" "bone.o" "nitric.o" "glycerine.o" + "ruby.o" "amethyst.o" + )) + +;;; These are the descriptions for the negative numbered objects from +;;; dun-room-objects + +(setq dun-perm-objects '( + nil + ("There is a large boulder here.") + nil + ("There is a ferocious bear here!") + nil + nil + ("There is a worthless pile of protoplasm here.") + nil + nil + nil + nil + nil + nil + ("There is a strange smell in this room.") + nil + ( +"There is a box with a slit in it, bolted to the wall here." + ) + nil + nil + ("There is a bus here.") + nil + nil + nil +)) + + +;;; These are the descriptions the user gets when regular objects are +;;; examined. + +(setq dun-physobj-desc '( +"It is a normal shovel with a price tag attached that says $19.99." +"The lamp is hand-crafted by Geppetto." +"The CPU board has a VAX chip on it. It seems to have +2 Megabytes of RAM onboard." +"It looks like some kind of meat. Smells pretty bad." +nil +"The paper says: Don't forget to type ‘help’ for help. Also, remember +this word: ‘worms’" +"The statuette is of the likeness of Richard Stallman, the author of the +famous EMACS editor. You notice that he is not wearing any shoes." +nil +"You observe that the weight is heavy." +"It says S. S. Minnow." +nil +nil +nil +"It has a picture of snoopy on it." +nil +nil +"It has your picture on it!" +"They are old coins from the 19th century." +"It is a valuable Fabrege egg." +"It is a plain glass jar." +nil +nil +nil +nil +nil + ) +) + +;;; These are the descriptions the user gets when non-regular objects +;;; are examined. + +(setq dun-permobj-desc '( + nil +"It is just a boulder. It cannot be moved." +"They are palm trees with a bountiful supply of coconuts in them." +"It looks like a grizzly to me." +"All of the bins are empty. Looking closely you can see that there +are names written at the bottom of each bin, but most of them are +faded away so that you cannot read them. You can only make out three +names: + Jeffrey Collier + Robert Toukmond + Thomas Stock +" + nil +"It is just a garbled mess." +"The dial points to a temperature scale which has long since faded away." +nil +nil +"It is a velvet painting of Elvis Presley. It seems to be nailed to the +wall, and you cannot move it." +"It is a queen sized bed, with a very firm mattress." +"The urinal is very clean compared with everything else in the cave. There +isn't even any rust. Upon close examination you realize that the drain at the +bottom is missing, and there is just a large hole leading down the +pipes into nowhere. The hole is too small for a person to fit in. The +flush handle is so clean that you can see your reflection in it." +nil +nil +"The box has a slit in the top of it, and on it, in sloppy handwriting, is +written: ‘For key upgrade, put key in here.’" +nil +"It says ‘express mail’ on it." +"It is a 35 passenger bus with the company name ‘mobytours’ on it." +"It is a large metal gate that is too big to climb over." +"It is a HIGH cliff." +"Unfortunately you do not know enough about dinosaurs to tell very much about +it. It is very big, though." +"The fish look like they were once quite beautiful." +nil +nil +nil +nil +"It is a normal ladder that is permanently attached to the hole." +"It is a passenger train that is ready to go." +"It is a personal computer that has only one floppy disk drive." + ) +) + +(setq dun-diggables + (list nil nil nil (list obj-cpu) nil nil nil nil nil nil nil + nil nil nil nil nil nil nil nil nil nil ;11-20 + nil nil nil nil nil nil nil nil nil nil ;21-30 + nil nil nil nil nil nil nil nil nil nil ;31-40 + nil (list obj-platinum) nil nil nil nil nil nil nil nil)) + +(setq dun-room-shorts nil) + +(setq dun-endgame-questions '( + ( +"What is your password on the machine called ‘pokey’?" "robert") + ( +"What password did you use during anonymous ftp to gamma?" "foo") + ( +"Excluding the endgame, how many places are there where you can put +treasures for points?" "4" "four") + ( +"What is your login name on the ‘endgame’ machine?" "toukmond" +) + ( +"What is the nearest whole dollar to the price of the shovel?" "20" "twenty") + ( +"What is the name of the bus company serving the town?" "mobytours") + ( +"Give either of the two last names in the mailroom, other than your own." +"collier" "stock") + ( +"What cartoon character is on the towel?" "snoopy") + ( +"What is the last name of the author of EMACS?" "stallman") + ( +"How many megabytes of memory is on the CPU board for the Vax?" "2") + ( +"Which street in town is named after a U.S. state?" "vermont") + ( +"How many pounds did the weight weigh?" "ten" "10") + ( +"Name the STREET which runs right over the subway stop." "fourth" "4" "4th") + ( +"How many corners are there in town (excluding the one with the Post Office)?" + "24" "twentyfour" "twenty-four") + ( +"What type of bear was hiding your key?" "grizzly") + ( +"Name either of the two objects you found by digging." "cpu" "card" "vax" +"board" "platinum") + ( +"What network protocol is used between pokey and gamma?" "tcp/ip" "ip" "tcp") )) -(setq dun-light-rooms '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 24 25 26 27 28 58 59 - 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 - 77 78 79 80 81 82 83)) -(setq dun-verblist '((die . dun-die) (ne . dun-ne) (north . dun-n) - (south . dun-s) (east . dun-e) (west . dun-w) - (u . dun-up) (d . dun-down) (i . dun-inven) - (inventory . dun-inven) (look . dun-examine) (n . dun-n) - (s . dun-s) (e . dun-e) (w . dun-w) (se . dun-se) - (nw . dun-nw) (sw . dun-sw) (up . dun-up) - (down . dun-down) (in . dun-in) (out . dun-out) - (go . dun-go) (drop . dun-drop) (southeast . dun-se) - (southwest . dun-sw) (northeast . dun-ne) - (northwest . dun-nw) (save . dun-save-game) - (restore . dun-restore) (long . dun-long) (dig . dun-dig) - (shake . dun-shake) (wave . dun-shake) - (examine . dun-examine) (describe . dun-examine) - (climb . dun-climb) (eat . dun-eat) (put . dun-put) - (type . dun-type) (insert . dun-put) - (score . dun-score) (help . dun-help) (quit . dun-quit) - (read . dun-examine) (verbose . dun-long) - (urinate . dun-piss) (piss . dun-piss) - (flush . dun-flush) (sleep . dun-sleep) (lie . dun-sleep) - (x . dun-examine) (break . dun-break) (drive . dun-drive) - (board . dun-in) (enter . dun-in) (turn . dun-turn) - (press . dun-press) (push . dun-press) (swim . dun-swim) - (on . dun-in) (off . dun-out) (chop . dun-break) - (switch . dun-press) (cut . dun-break) (exit . dun-out) - (leave . dun-out) (reset . dun-power) (flick . dun-press) - (superb . dun-superb) (answer . dun-answer) - (throw . dun-drop) (l . dun-examine) (take . dun-take) - (get . dun-take) (feed . dun-feed))) +;;;; Mode definitions for interactive mode + +(define-derived-mode dun-mode text-mode "Dungeon" + "Major mode for running dunnet." + (make-local-variable 'scroll-step) + (setq scroll-step 2)) + +(defun dun-parse (_arg) + "Function called when return is pressed in interactive mode to parse line." + (interactive "*p") + (beginning-of-line) + (let ((beg (1+ (point))) + line) + (end-of-line) + (if (and (not (= beg (point))) (not (< (point) beg)) + (string= ">" (buffer-substring (- beg 1) beg))) + (progn + (setq line (downcase (buffer-substring beg (point)))) + (princ line) + (if (eq (dun-vparse dun-ignore dun-verblist line) -1) + (dun-mprinc "I don't understand that.\n"))) + (goto-char (point-max)) + (dun-mprinc "\n"))) + (dun-messages)) + +(defun dun-messages () + (if dun-dead + (text-mode) + (if (eq dungeon-mode 'dungeon) + (progn + (if (not (= room dun-current-room)) + (progn + (dun-describe-room dun-current-room) + (setq room dun-current-room))) + (dun-fix-screen) + (dun-mprinc ">"))))) + + +;;;###autoload +(defun dunnet () + "Switch to *dungeon* buffer and start game." + (interactive) + (switch-to-buffer "*dungeon*") + (dun-mode) + (setq dun-dead nil) + (setq room 0) + (dun-messages)) + +;;;; +;;;; This section contains all of the verbs and commands. +;;;; + +;;; Give long description of room if haven't been there yet. Otherwise +;;; short. Also give long if we were called with negative room number. + +(defun dun-describe-room (room) + (if (and (not (member (abs room) dun-light-rooms)) + (not (member obj-lamp dun-inventory)) + (not (member obj-lamp (nth dun-current-room dun-room-objects)))) + (dun-mprincl "It is pitch dark. You are likely to be eaten by a grue.") + (dun-mprincl (cadr (nth (abs room) dun-rooms))) + (if (and (and (or (member room dun-visited) + (string= dun-mode "dun-superb")) (> room 0)) + (not (string= dun-mode "long"))) + nil + (dun-mprinc (car (nth (abs room) dun-rooms))) + (dun-mprinc "\n")) + (if (not (string= dun-mode "long")) + (if (not (member (abs room) dun-visited)) + (setq dun-visited (append (list (abs room)) dun-visited)))) + (dolist (xobjs (nth dun-current-room dun-room-objects)) + (if (= xobjs obj-special) + (dun-special-object) + (if (>= xobjs 0) + (dun-mprincl (car (nth xobjs dun-objects))) + (if (not (and (= xobjs obj-bus) dun-inbus)) + (progn + (dun-mprincl (car (nth (abs xobjs) dun-perm-objects))))))) + (if (and (= xobjs obj-jar) dun-jar) + (progn + (dun-mprincl "The jar contains:") + (dolist (x dun-jar) + (dun-mprinc " ") + (dun-mprincl (car (nth x dun-objects))))))) + (if (and (member obj-bus (nth dun-current-room dun-room-objects)) dun-inbus) + (dun-mprincl "You are on the bus.")))) + +;;; There is a special object in the room. This object's description, +;;; or lack thereof, depends on certain conditions. + +(defun dun-special-object () + (if (= dun-current-room computer-room) + (if dun-computer + (dun-mprincl +"The panel lights are flashing in a seemingly organized pattern.") + (dun-mprincl "The panel lights are steady and motionless."))) + + (if (and (= dun-current-room red-room) + (not (member obj-towel (nth red-room dun-room-objects)))) + (dun-mprincl "There is a hole in the floor here.")) + + (if (and (= dun-current-room marine-life-area) dun-black) + (dun-mprincl +"The room is lit by a black light, causing the fish, and some of +your objects, to give off an eerie glow.")) + (if (and (= dun-current-room fourth-vermont-intersection) dun-hole) + (progn + (if (not dun-inbus) + (progn + (dun-mprincl "You fall into a hole in the ground.") + (setq dun-current-room vermont-station) + (dun-describe-room vermont-station)) + (progn + (dun-mprincl +"The bus falls down a hole in the ground and explodes.") + (dun-die "burning"))))) + + (if (> dun-current-room endgame-computer-room) + (progn + (if (not dun-correct-answer) + (dun-endgame-question) + (dun-mprincl "Your question is:") + (dun-mprincl dun-endgame-question)))) + + (if (= dun-current-room sauna) + (progn + (dun-mprincl (nth dun-sauna-level '( +"It is normal room temperature in here." +"It is luke warm in here." +"It is comfortably hot in here." +"It is refreshingly hot in here." +"You are dead now."))) + (if (= dun-sauna-level 3) + (progn + (if (or (member obj-rms dun-inventory) + (member obj-rms (nth dun-current-room dun-room-objects))) + (progn + (dun-mprincl +"You notice the wax on your statuette beginning to melt, until it completely +melts off. You are left with a beautiful diamond!") + (if (member obj-rms dun-inventory) + (progn + (dun-remove-obj-from-inven obj-rms) + (setq dun-inventory (append dun-inventory + (list obj-diamond)))) + (dun-remove-obj-from-room dun-current-room obj-rms) + (dun-replace dun-room-objects dun-current-room + (append (nth dun-current-room dun-room-objects) + (list obj-diamond)))))) + (if (or (member obj-floppy dun-inventory) + (member obj-floppy (nth dun-current-room dun-room-objects))) + (progn + (dun-mprincl +"You notice your floppy disk beginning to melt. As you grab for it, the +disk bursts into flames, and disintegrates.") + (dun-remove-obj-from-inven obj-floppy) + (dun-remove-obj-from-room dun-current-room obj-floppy)))))))) + + +(defun dun-die (murderer) + (dun-mprinc "\n") + (if murderer + (dun-mprincl "You are dead.")) + (dun-do-logfile 'dun-die murderer) + (dun-score nil) + (setq dun-dead t)) + +(defun dun-quit (_args) + (dun-die nil)) + +;;; Print every object in player's inventory. Special case for the jar, +;;; as we must also print what is in it. + +(defun dun-inven (_args) + (dun-mprinc "You currently have:") + (dun-mprinc "\n") + (dolist (curobj dun-inventory) + (if curobj + (progn + (dun-mprincl (cadr (nth curobj dun-objects))) + (if (and (= curobj obj-jar) dun-jar) + (progn + (dun-mprincl "The jar contains:") + (dolist (x dun-jar) + (dun-mprinc " ") + (dun-mprincl (cadr (nth x dun-objects)))))))))) + +(defun dun-shake (obj) + (let (objnum) + (when (setq objnum (dun-objnum-from-args-std obj)) + (if (member objnum dun-inventory) + (progn +;;; If shaking anything will do anything, put here. + (dun-mprinc "Shaking ") + (dun-mprinc (downcase (cadr (nth objnum dun-objects)))) + (dun-mprinc " seems to have no effect.") + (dun-mprinc "\n") + ) + (if (and (not (member objnum (nth dun-current-room dun-room-silents))) + (not (member objnum (nth dun-current-room dun-room-objects)))) + (dun-mprincl "I don't see that here.") +;;; Shaking trees can be deadly + (if (= objnum obj-tree) + (progn + (dun-mprinc + "You begin to shake a tree, and notice a coconut begin to fall from the air. +As you try to get your hand up to block it, you feel the impact as it lands +on your head.") + (dun-die "a coconut")) + (if (= objnum obj-bear) + (progn + (dun-mprinc +"As you go up to the bear, it removes your head and places it on the ground.") + (dun-die "a bear")) + (if (< objnum 0) + (dun-mprincl "You cannot shake that.") + (dun-mprincl "You don't have that."))))))))) + + +(defun dun-drop (obj) + (if dun-inbus + (dun-mprincl "You can't drop anything while on the bus.") + (let (objnum) + (when (setq objnum (dun-objnum-from-args-std obj)) + (if (not (member objnum dun-inventory)) + (dun-mprincl "You don't have that.") + (progn + (dun-remove-obj-from-inven objnum) + (dun-replace dun-room-objects dun-current-room + (append (nth dun-current-room dun-room-objects) + (list objnum))) + (dun-mprincl "Done.") + (if (member objnum (list obj-food obj-weight obj-jar)) + (dun-drop-check objnum)))))))) + +;;; Dropping certain things causes things to happen. + +(defun dun-drop-check (objnum) + (if (and (= objnum obj-food) (= room bear-hangout) + (member obj-bear (nth bear-hangout dun-room-objects))) + (progn + (dun-mprincl +"The bear takes the food and runs away with it. He left something behind.") + (dun-remove-obj-from-room dun-current-room obj-bear) + (dun-remove-obj-from-room dun-current-room obj-food) + (dun-replace dun-room-objects dun-current-room + (append (nth dun-current-room dun-room-objects) + (list obj-key))))) + + (if (and (= objnum obj-jar) (member obj-nitric dun-jar) + (member obj-glycerine dun-jar)) + (progn + (dun-mprincl + "As the jar impacts the ground it explodes into many pieces.") + (setq dun-jar nil) + (dun-remove-obj-from-room dun-current-room obj-jar) + (if (= dun-current-room fourth-vermont-intersection) + (progn + (setq dun-hole t) + (setq dun-current-room vermont-station) + (dun-mprincl +"The explosion causes a hole to open up in the ground, which you fall +through."))))) + + (if (and (= objnum obj-weight) (= dun-current-room maze-button-room)) + (dun-mprincl "A passageway opens."))) + +;;; Give long description of current room, or an object. + +(defun dun-examine (obj) + (let (objnum) + (setq objnum (dun-objnum-from-args obj)) + (if (eq objnum obj-special) + (dun-describe-room (* dun-current-room -1)) + (if (and (eq objnum obj-computer) + (member obj-pc (nth dun-current-room dun-room-silents))) + (dun-examine '("pc")) + (if (eq objnum nil) + (dun-mprincl "I don't know what that is.") + (if (and (not (member objnum + (nth dun-current-room dun-room-objects))) + (not (and (member obj-jar dun-inventory) + (member objnum dun-jar))) + (not (member objnum + (nth dun-current-room dun-room-silents))) + (not (member objnum dun-inventory))) + (dun-mprincl "I don't see that here.") + (if (>= objnum 0) + (if (and (= objnum obj-bone) + (= dun-current-room marine-life-area) dun-black) + (dun-mprincl +"In this light you can see some writing on the bone. It says: +For an explosive time, go to Fourth St. and Vermont.") + (if (nth objnum dun-physobj-desc) + (dun-mprincl (nth objnum dun-physobj-desc)) + (dun-mprincl "I see nothing special about that."))) + (if (nth (abs objnum) dun-permobj-desc) + (progn + (dun-mprincl (nth (abs objnum) dun-permobj-desc))) + (dun-mprincl "I see nothing special about that."))))))))) + +(defun dun-take (obj) + (setq obj (dun-firstword obj)) + (if (not obj) + (dun-mprincl "You must supply an object.") + (if (string= obj "all") + (let (gotsome) + (if dun-inbus + (dun-mprincl "You can't take anything while on the bus.") + (setq gotsome nil) + (dolist (x (nth dun-current-room dun-room-objects)) + (if (and (>= x 0) (not (= x obj-special))) + (progn + (setq gotsome t) + (dun-mprinc (cadr (nth x dun-objects))) + (dun-mprinc ": ") + (dun-take-object x)))) + (if (not gotsome) + (dun-mprincl "Nothing to take.")))) + (let (objnum) + (setq objnum (cdr (assq (intern obj) dun-objnames))) + (if (eq objnum nil) + (progn + (dun-mprinc "I don't know what that is.") + (dun-mprinc "\n")) + (if (and dun-inbus (not (and (member objnum dun-jar) + (member obj-jar dun-inventory)))) + (dun-mprincl "You can't take anything while on the bus.") + (dun-take-object objnum))))))) + +(defun dun-take-object (objnum) + (if (and (member objnum dun-jar) (member obj-jar dun-inventory)) + (let (newjar) + (dun-mprincl "You remove it from the jar.") + (setq newjar nil) + (dolist (x dun-jar) + (if (not (= x objnum)) + (setq newjar (append newjar (list x))))) + (setq dun-jar newjar) + (setq dun-inventory (append dun-inventory (list objnum)))) + (if (not (member objnum (nth dun-current-room dun-room-objects))) + (if (not (member objnum (nth dun-current-room dun-room-silents))) + (dun-mprinc "I do not see that here.") + (dun-try-take objnum)) + (if (>= objnum 0) + (progn + (if (and (car dun-inventory) + (> (+ (dun-inven-weight) (nth objnum dun-object-lbs)) 11)) + (dun-mprinc "Your load would be too heavy.") + (setq dun-inventory (append dun-inventory (list objnum))) + (dun-remove-obj-from-room dun-current-room objnum) + (dun-mprinc "Taken. ") + (if (and (= objnum obj-towel) (= dun-current-room red-room)) + (dun-mprinc + "Taking the towel reveals a hole in the floor.")))) + (dun-try-take objnum))) + (dun-mprinc "\n"))) + +(defun dun-inven-weight () + (let (total) + (setq total 0) + (dolist (x dun-jar) + (setq total (+ total (nth x dun-object-lbs)))) + (dolist (x dun-inventory) + (setq total (+ total (nth x dun-object-lbs)))) total)) + +;;; We try to take an object that is untakable. Print a message +;;; depending on what it is. + +(defun dun-try-take (_obj) + (dun-mprinc "You cannot take that.")) + +(defun dun-dig (_args) + (if dun-inbus + (dun-mprincl "Digging here reveals nothing.") + (if (not (member 0 dun-inventory)) + (dun-mprincl "You have nothing with which to dig.") + (if (not (nth dun-current-room dun-diggables)) + (dun-mprincl "Digging here reveals nothing.") + (dun-mprincl "I think you found something.") + (dun-replace dun-room-objects dun-current-room + (append (nth dun-current-room dun-room-objects) + (nth dun-current-room dun-diggables))) + (dun-replace dun-diggables dun-current-room nil))))) + +(defun dun-climb (obj) + (let (objnum) + (setq objnum (dun-objnum-from-args obj)) + (cond ((not objnum) + (dun-mprincl "I don't know what that object is.")) + ((and (not (eq objnum obj-special)) + (not (member objnum (nth dun-current-room dun-room-objects))) + (not (member objnum (nth dun-current-room dun-room-silents))) + (not (and (member objnum dun-jar) (member obj-jar dun-inventory))) + (not (member objnum dun-inventory))) + (dun-mprincl "I don't see that here.")) + ((and (eq objnum obj-special) + (not (member obj-tree (nth dun-current-room dun-room-silents)))) + (dun-mprincl "There is nothing here to climb.")) + ((and (not (eq objnum obj-tree)) (not (eq objnum obj-special))) + (dun-mprincl "You can't climb that.")) + (t + (dun-mprincl + "You manage to get about two feet up the tree and fall back down. You +notice that the tree is very unsteady."))))) + +(defun dun-eat (obj) + (let (objnum) + (when (setq objnum (dun-objnum-from-args-std obj)) + (if (not (member objnum dun-inventory)) + (dun-mprincl "You don't have that.") + (if (not (= objnum obj-food)) + (progn + (dun-mprinc "You forcefully shove ") + (dun-mprinc (downcase (cadr (nth objnum dun-objects)))) + (dun-mprincl " down your throat, and start choking.") + (dun-die "choking")) + (dun-mprincl "That tasted horrible.") + (dun-remove-obj-from-inven obj-food)))))) + +(defun dun-put (args) + (let (newargs objnum objnum2 obj) + (setq newargs (dun-firstwordl args)) + (if (not newargs) + (dun-mprincl "You must supply an object") + (setq obj (intern (car newargs))) + (setq objnum (cdr (assq obj dun-objnames))) + (if (not objnum) + (dun-mprincl "I don't know what that object is.") + (if (not (member objnum dun-inventory)) + (dun-mprincl "You don't have that.") + (setq newargs (dun-firstwordl (cdr newargs))) + (setq newargs (dun-firstwordl (cdr newargs))) + (if (not newargs) + (dun-mprincl "You must supply an indirect object.") + (setq objnum2 (cdr (assq (intern (car newargs)) dun-objnames))) + (if (and (eq objnum2 obj-computer) (= dun-current-room pc-area)) + (setq objnum2 obj-pc)) + (if (not objnum2) + (dun-mprincl "I don't know what that indirect object is.") + (if (and (not (member objnum2 + (nth dun-current-room dun-room-objects))) + (not (member objnum2 + (nth dun-current-room dun-room-silents))) + (not (member objnum2 dun-inventory))) + (dun-mprincl "That indirect object is not here.") + (dun-put-objs objnum objnum2))))))))) + +(defun dun-put-objs (obj1 obj2) + (if (and (= obj2 obj-drop) (not dun-nomail)) + (setq obj2 obj-chute)) + + (if (= obj2 obj-disposal) (setq obj2 obj-chute)) + + (if (and (= obj1 obj-cpu) (= obj2 obj-computer)) + (progn + (dun-remove-obj-from-inven obj-cpu) + (setq dun-computer t) + (dun-mprincl +"As you put the CPU board in the computer, it immediately springs to life. +The lights start flashing, and the fans seem to startup.")) + (if (and (= obj1 obj-weight) (= obj2 obj-button)) + (dun-drop '("weight")) + (if (= obj2 obj-jar) ;; Put something in jar + (if (not (member obj1 (list obj-paper obj-diamond obj-emerald + obj-license obj-coins obj-egg + obj-nitric obj-glycerine))) + (dun-mprincl "That will not fit in the jar.") + (dun-remove-obj-from-inven obj1) + (setq dun-jar (append dun-jar (list obj1))) + (dun-mprincl "Done.")) + (if (= obj2 obj-chute) ;; Put something in chute + (progn + (dun-remove-obj-from-inven obj1) + (dun-mprincl +"You hear it slide down the chute and off into the distance.") + (dun-put-objs-in-treas (list obj1))) + (if (= obj2 obj-box) ;; Put key in key box + (if (= obj1 obj-key) + (progn + (dun-mprincl +"As you drop the key, the box begins to shake. Finally it explodes +with a bang. The key seems to have vanished!") + (dun-remove-obj-from-inven obj1) + (dun-replace dun-room-objects computer-room (append + (nth computer-room + dun-room-objects) + (list obj1))) + (dun-remove-obj-from-room dun-current-room obj-box) + (setq dun-key-level (1+ dun-key-level))) + (dun-mprincl "You can't put that in the key box!")) + + (if (and (= obj1 obj-floppy) (= obj2 obj-pc)) + (progn + (setq dun-floppy t) + (dun-remove-obj-from-inven obj1) + (dun-mprincl "Done.")) + + (if (= obj2 obj-urinal) ;; Put object in urinal + (progn + (dun-remove-obj-from-inven obj1) + (dun-replace dun-room-objects urinal (append + (nth urinal dun-room-objects) + (list obj1))) + (dun-mprincl + "You hear it plop down in some water below.")) + (if (= obj2 obj-mail) + (dun-mprincl "The mail chute is locked.") + (if (member obj1 dun-inventory) + (dun-mprincl +"I don't know how to combine those objects. Perhaps you should +just try dropping it.") + (dun-mprincl "You can't put that there."))))))))))) + +(defun dun-type (_args) + (if (not (= dun-current-room computer-room)) + (dun-mprincl "There is nothing here on which you could type.") + (if (not dun-computer) + (dun-mprincl +"You type on the keyboard, but your characters do not even echo.") + (dun-unix-interface)))) + +;;; Various movement directions + +(defun dun-n (_args) + (dun-move north)) + +(defun dun-s (_args) + (dun-move south)) + +(defun dun-e (_args) + (dun-move east)) + +(defun dun-w (_args) + (dun-move west)) + +(defun dun-ne (_args) + (dun-move northeast)) + +(defun dun-se (_args) + (dun-move southeast)) + +(defun dun-nw (_args) + (dun-move northwest)) + +(defun dun-sw (_args) + (dun-move southwest)) + +(defun dun-up (_args) + (dun-move up)) + +(defun dun-down (_args) + (dun-move down)) + +(defun dun-in (_args) + (dun-move in)) + +(defun dun-out (_args) + (dun-move out)) + +(defun dun-go (args) + (if (or (not (car args)) + (eq (dun-doverb dun-ignore dun-verblist (car args) + (cdr (cdr args))) -1)) + (dun-mprinc "I don't understand where you want me to go.\n"))) + +;;; Uses the dungeon-map to figure out where we are going. If the +;;; requested direction yields 255, we know something special is +;;; supposed to happen, or perhaps you can't go that way unless +;;; certain conditions are met. + +(defun dun-move (dir) + (if (and (not (member dun-current-room dun-light-rooms)) + (not (member obj-lamp dun-inventory)) + (not (member obj-lamp (nth dun-current-room dun-room-objects)))) + (progn + (dun-mprinc +"You trip over a grue and fall into a pit and break every bone in your +body.") + (dun-die "a grue")) + (let (newroom) + (setq newroom (nth dir (nth dun-current-room dungeon-map))) + (if (eq newroom -1) + (dun-mprinc "You can't go that way.\n") + (if (eq newroom 255) + (dun-special-move dir) + (setq room -1) + (setq dun-lastdir dir) + (if dun-inbus + (progn + (if (or (< newroom 58) (> newroom 83)) + (dun-mprincl "The bus cannot go this way.") + (dun-mprincl + "The bus lurches ahead and comes to a screeching halt.") + (dun-remove-obj-from-room dun-current-room obj-bus) + (setq dun-current-room newroom) + (dun-replace dun-room-objects newroom + (append (nth newroom dun-room-objects) + (list obj-bus))))) + (setq dun-current-room newroom))))))) + +;;; Movement in this direction causes something special to happen if the +;;; right conditions exist. It may be that you can't go this way unless +;;; you have a key, or a passage has been opened. + +;;; coding note: Each check of the current room is on the same 'if' level, +;;; i.e. there aren't else's. If two rooms next to each other have +;;; specials, and they are connected by specials, this could cause +;;; a problem. Be careful when adding them to consider this, and +;;; perhaps use else's. + +(defun dun-special-move (dir) + (if (= dun-current-room building-front) + (if (not (member obj-key dun-inventory)) + (dun-mprincl "You don't have a key that can open this door.") + (setq dun-current-room old-building-hallway)) + (if (= dun-current-room north-end-of-cave-passage) + (let (combo) + (dun-mprincl +"You must type a 3 digit combination code to enter this room.") + (dun-mprinc "Enter it here: ") + (setq combo (dun-read-line)) + (if (not dun-batch-mode) + (dun-mprinc "\n")) + (if (string= combo dun-combination) + (setq dun-current-room gamma-computing-center) + (dun-mprincl "Sorry, that combination is incorrect.")))) + + (if (= dun-current-room bear-hangout) + (if (member obj-bear (nth bear-hangout dun-room-objects)) + (progn + (dun-mprinc +"The bear is very annoyed that you would be so presumptuous as to try +and walk right by it. He tells you so by tearing your head off. +") + (dun-die "a bear")) + (dun-mprincl "You can't go that way."))) + + (if (= dun-current-room vermont-station) + (progn + (dun-mprincl +"As you board the train it immediately leaves the station. It is a very +bumpy ride. It is shaking from side to side, and up and down. You +sit down in one of the chairs in order to be more comfortable.") + (dun-mprincl +"\nFinally the train comes to a sudden stop, and the doors open, and some +force throws you out. The train speeds away.\n") + (setq dun-current-room museum-station))) + + (if (= dun-current-room old-building-hallway) + (if (and (member obj-key dun-inventory) + (> dun-key-level 0)) + (setq dun-current-room meadow) + (dun-mprincl "You don't have a key that can open this door."))) + + (if (and (= dun-current-room maze-button-room) (= dir northwest)) + (if (member obj-weight (nth maze-button-room dun-room-objects)) + (setq dun-current-room 18) + (dun-mprincl "You can't go that way."))) + + (if (and (= dun-current-room maze-button-room) (= dir up)) + (if (member obj-weight (nth maze-button-room dun-room-objects)) + (dun-mprincl "You can't go that way.") + (setq dun-current-room weight-room))) + + (if (= dun-current-room classroom) + (dun-mprincl "The door is locked.")) + + (if (or (= dun-current-room lakefront-north) + (= dun-current-room lakefront-south)) + (dun-swim nil)) + + (if (= dun-current-room reception-area) + (if (not (= dun-sauna-level 3)) + (setq dun-current-room health-club-front) + (dun-mprincl +"As you exit the building, you notice some flames coming out of one of the +windows. Suddenly, the building explodes in a huge ball of fire. The flames +engulf you, and you burn to death.") + (dun-die "burning"))) + + (if (= dun-current-room red-room) + (if (not (member obj-towel (nth red-room dun-room-objects))) + (setq dun-current-room long-n-s-hallway) + (dun-mprincl "You can't go that way."))) + + (if (and (> dir down) (> dun-current-room gamma-computing-center) + (< dun-current-room museum-lobby)) + (if (not (member obj-bus (nth dun-current-room dun-room-objects))) + (dun-mprincl "You can't go that way.") + (if (= dir in) + (if dun-inbus + (dun-mprincl + "You are already in the bus!") + (if (member obj-license dun-inventory) + (progn + (dun-mprincl + "You board the bus and get in the driver's seat.") + (setq dun-nomail t) + (setq dun-inbus t)) + (dun-mprincl "You are not licensed for this type of vehicle."))) + (if (not dun-inbus) + (dun-mprincl "You are already off the bus!") + (dun-mprincl "You hop off the bus.") + (setq dun-inbus nil)))) + (if (= dun-current-room fifth-oaktree-intersection) + (if (not dun-inbus) + (progn + (dun-mprincl "You fall down the cliff and land on your head.") + (dun-die "a cliff")) + (dun-mprincl +"The bus flies off the cliff, and plunges to the bottom, where it explodes.") + (dun-die "a bus accident"))) + (if (= dun-current-room main-maple-intersection) + (progn + (if (not dun-inbus) + (dun-mprincl "The gate will not open.") + (dun-mprincl +"As the bus approaches, the gate opens and you drive through.") + (dun-remove-obj-from-room main-maple-intersection obj-bus) + (dun-replace dun-room-objects museum-entrance + (append (nth museum-entrance dun-room-objects) + (list obj-bus))) + (setq dun-current-room museum-entrance))))) + (if (= dun-current-room cave-entrance) + (progn + (dun-mprincl +"As you enter the room you hear a rumbling noise. You look back to see +huge rocks sliding down from the ceiling, and blocking your way out.\n") + (setq dun-current-room misty-room))))) + +(defun dun-long (_args) + (setq dun-mode "long")) + +(defun dun-turn (obj) + (let (objnum direction) + (when (setq objnum (dun-objnum-from-args-std obj)) + (if (not (or (member objnum (nth dun-current-room dun-room-objects)) + (member objnum (nth dun-current-room dun-room-silents)))) + (dun-mprincl "I don't see that here.") + (if (not (= objnum obj-dial)) + (dun-mprincl "You can't turn that.") + (setq direction (dun-firstword (cdr obj))) + (if (or (not direction) + (not (or (string= direction "clockwise") + (string= direction "counterclockwise")))) + (dun-mprincl "You must indicate clockwise or counterclockwise.") + (if (string= direction "clockwise") + (setq dun-sauna-level (+ dun-sauna-level 1)) + (setq dun-sauna-level (- dun-sauna-level 1))) + + (if (< dun-sauna-level 0) + (progn + (dun-mprincl + "The dial will not turn further in that direction.") + (setq dun-sauna-level 0)) + (dun-sauna-heat)))))))) + +(defun dun-sauna-heat () + (if (= dun-sauna-level 0) + (dun-mprincl + "The temperature has returned to normal room temperature.")) + (if (= dun-sauna-level 1) + (dun-mprincl "It is now luke warm in here. You are perspiring.")) + (if (= dun-sauna-level 2) + (dun-mprincl "It is pretty hot in here. It is still very comfortable.")) + (if (= dun-sauna-level 3) + (progn + (dun-mprincl +"It is now very hot. There is something very refreshing about this.") + (if (or (member obj-rms dun-inventory) + (member obj-rms (nth dun-current-room dun-room-objects))) + (progn + (dun-mprincl +"You notice the wax on your statuette beginning to melt, until it completely +melts off. You are left with a beautiful diamond!") + (if (member obj-rms dun-inventory) + (progn + (dun-remove-obj-from-inven obj-rms) + (setq dun-inventory (append dun-inventory + (list obj-diamond)))) + (dun-remove-obj-from-room dun-current-room obj-rms) + (dun-replace dun-room-objects dun-current-room + (append (nth dun-current-room dun-room-objects) + (list obj-diamond)))))) + (if (or (member obj-floppy dun-inventory) + (member obj-floppy (nth dun-current-room dun-room-objects))) + (progn + (dun-mprincl +"You notice your floppy disk beginning to melt. As you grab for it, the +disk bursts into flames, and disintegrates.") + (if (member obj-floppy dun-inventory) + (dun-remove-obj-from-inven obj-floppy) + (dun-remove-obj-from-room dun-current-room obj-floppy)))))) + + (if (= dun-sauna-level 4) + (progn + (dun-mprincl +"As the dial clicks into place, you immediately burst into flames.") + (dun-die "burning")))) + +(defun dun-press (obj) + (let (objnum) + (when (setq objnum (dun-objnum-from-args-std obj)) + (if (not (or (member objnum (nth dun-current-room dun-room-objects)) + (member objnum (nth dun-current-room dun-room-silents)))) + (dun-mprincl "I don't see that here.") + (if (not (member objnum (list obj-button obj-switch))) + (progn + (dun-mprinc "You can't ") + (dun-mprinc (car line-list)) + (dun-mprincl " that.")) + (if (= objnum obj-button) + (dun-mprincl +"As you press the button, you notice a passageway open up, but +as you release it, the passageway closes.")) + (if (= objnum obj-switch) + (if dun-black + (progn + (dun-mprincl "The button is now in the off position.") + (setq dun-black nil)) + (dun-mprincl "The button is now in the on position.") + (setq dun-black t)))))))) + +(defun dun-swim (_args) + (if (not (member dun-current-room (list lakefront-north lakefront-south))) + (dun-mprincl "I see no water!") + (if (not (member obj-life dun-inventory)) + (progn + (dun-mprincl +"You dive in the water, and at first notice it is quite cold. You then +start to get used to it as you realize that you never really learned how +to swim.") + (dun-die "drowning")) + (if (= dun-current-room lakefront-north) + (setq dun-current-room lakefront-south) + (setq dun-current-room lakefront-north))))) + + +(defun dun-score (_args) + (if (not dun-endgame) + (let (total) + (setq total (dun-reg-score)) + (dun-mprinc "You have scored ") + (dun-mprinc total) + (dun-mprincl " out of a possible 90 points.") total) + (dun-mprinc "You have scored ") + (dun-mprinc (dun-endgame-score)) + (dun-mprincl " endgame points out of a possible 110.") + (if (= (dun-endgame-score) 110) + (dun-mprincl +"\n\nCongratulations. You have won. The wizard password is ‘moby’")))) + +(defun dun-help (_args) + (dun-mprincl +"Welcome to dunnet (2.02), by Ron Schnell (ronnie@driver-aces.com - @RonnieSchnell). +Here is some useful information (read carefully because there are one +or more clues in here): +- If you have a key that can open a door, you do not need to explicitly + open it. You may just use ‘in’ or walk in the direction of the door. + +- If you have a lamp, it is always lit. + +- You will not get any points until you manage to get treasures to a certain + place. Simply finding the treasures is not good enough. There is more + than one way to get a treasure to the special place. It is also + important that the objects get to the special place *unharmed* and + *untarnished*. You can tell if you have successfully transported the + object by looking at your score, as it changes immediately. Note that + an object can become harmed even after you have received points for it. + If this happens, your score will decrease, and in many cases you can never + get credit for it again. + +- You can save your game with the ‘save’ command, and use restore it + with the ‘restore’ command. + +- There are no limits on lengths of object names. + +- Directions are: north,south,east,west,northeast,southeast,northwest, + southwest,up,down,in,out. + +- These can be abbreviated: n,s,e,w,ne,se,nw,sw,u,d,in,out. + +- If you go down a hole in the floor without an aid such as a ladder, + you probably won't be able to get back up the way you came, if at all. + +- To run this game in batch mode (no Emacs window), use: + emacs -batch -l dunnet +NOTE: This game *should* be run in batch mode! + +If you have questions or comments, please contact ronnie@driver-aces.com +My home page is http://www.driver-aces.com/ronnie.html +")) + +(defun dun-flush (_args) + (if (not (= dun-current-room bathroom)) + (dun-mprincl "I see nothing to flush.") + (dun-mprincl "Whoooosh!!") + (dun-put-objs-in-treas (nth urinal dun-room-objects)) + (dun-replace dun-room-objects urinal nil))) + +(defun dun-piss (_args) + (if (not (= dun-current-room bathroom)) + (dun-mprincl "You can't do that here, don't even bother trying.") + (if (not dun-gottago) + (dun-mprincl "I'm afraid you don't have to go now.") + (dun-mprincl "That was refreshing.") + (setq dun-gottago nil) + (dun-replace dun-room-objects urinal (append + (nth urinal dun-room-objects) + (list obj-URINE)))))) + + +(defun dun-sleep (_args) + (if (not (= dun-current-room bedroom)) + (dun-mprincl +"You try to go to sleep while standing up here, but can't seem to do it.") + (setq dun-gottago t) + (dun-mprincl +"As soon as you start to doze off you begin dreaming. You see images of +workers digging caves, slaving in the humid heat. Then you see yourself +as one of these workers. While no one is looking, you leave the group +and walk into a room. The room is bare except for a horseshoe +shaped piece of stone in the center. You see yourself digging a hole in +the ground, then putting some kind of treasure in it, and filling the hole +with dirt again. After this, you immediately wake up."))) + +(defun dun-break (obj) + (let (objnum) + (if (not (member obj-axe dun-inventory)) + (dun-mprincl "You have nothing you can use to break things.") + (when (setq objnum (dun-objnum-from-args-std obj)) + (if (member objnum dun-inventory) + (progn + (dun-mprincl +"You take the object in your hands and swing the axe. Unfortunately, you miss +the object and slice off your hand. You bleed to death.") + (dun-die "an axe")) + (if (not (or (member objnum (nth dun-current-room dun-room-objects)) + (member objnum + (nth dun-current-room dun-room-silents)))) + (dun-mprincl "I don't see that here.") + (if (= objnum obj-cable) + (progn + (dun-mprincl +"As you break the ethernet cable, everything starts to blur. You collapse +for a moment, then straighten yourself up. +") + (dun-replace dun-room-objects gamma-computing-center + (append + (nth gamma-computing-center dun-room-objects) + dun-inventory)) + (if (member obj-key dun-inventory) + (progn + (setq dun-inventory (list obj-key)) + (dun-remove-obj-from-room + gamma-computing-center obj-key)) + (setq dun-inventory nil)) + (setq dun-current-room computer-room) + (setq dun-ethernet nil) + (dun-mprincl "Connection closed.") + (dun-unix-interface)) + (if (< objnum 0) + (progn + (dun-mprincl "Your axe shatters into a million pieces.") + (dun-remove-obj-from-inven obj-axe)) + (dun-mprincl "Your axe breaks it into a million pieces.") + (dun-remove-obj-from-room dun-current-room objnum))))))))) + +(defun dun-drive (_args) + (if (not dun-inbus) + (dun-mprincl "You cannot drive when you aren't in a vehicle.") + (dun-mprincl "To drive while you are in the bus, just give a direction."))) + +(defun dun-superb (_args) + (setq dun-mode 'dun-superb)) + +(defun dun-reg-score () + (let (total) + (setq total 0) + (dolist (x (nth treasure-room dun-room-objects)) + (setq total (+ total (nth x dun-object-pts)))) + (if (member obj-URINE (nth treasure-room dun-room-objects)) + (setq total 0)) total)) + +(defun dun-endgame-score () + (let (total) + (setq total 0) + (dolist (x (nth endgame-treasure-room dun-room-objects)) + (setq total (+ total (nth x dun-object-pts)))) total)) + +(defun dun-answer (args) + (if (not dun-correct-answer) + (dun-mprincl "I don't believe anyone asked you anything.") + (setq args (car args)) + (if (not args) + (dun-mprincl "You must give the answer on the same line.") + (if (dun-members args dun-correct-answer) + (progn + (dun-mprincl "Correct.") + (if (= dun-lastdir 0) + (setq dun-current-room (1+ dun-current-room)) + (setq dun-current-room (- dun-current-room 1))) + (setq dun-correct-answer nil)) + (dun-mprincl "That answer is incorrect."))))) + +(defun dun-endgame-question () +(if (not dun-endgame-questions) + (progn + (dun-mprincl "Your question is:") + (dun-mprincl "No more questions, just do ‘answer foo’.") + (setq dun-correct-answer '("foo"))) + (let (which i newques) + (setq i 0) + (setq newques nil) + (setq which (random (length dun-endgame-questions))) + (dun-mprincl "Your question is:") + (dun-mprincl (setq dun-endgame-question (car + (nth which + dun-endgame-questions)))) + (setq dun-correct-answer (cdr (nth which dun-endgame-questions))) + (while (< i which) + (setq newques (append newques (list (nth i dun-endgame-questions)))) + (setq i (1+ i))) + (setq i (1+ which)) + (while (< i (length dun-endgame-questions)) + (setq newques (append newques (list (nth i dun-endgame-questions)))) + (setq i (1+ i))) + (setq dun-endgame-questions newques)))) + +(defun dun-power (_args) + (if (not (= dun-current-room pc-area)) + (dun-mprincl "That operation is not applicable here.") + (if (not dun-floppy) + (dun-dos-no-disk) + (dun-dos-interface)))) + +(defun dun-feed (args) + (let (objnum) + (when (setq objnum (dun-objnum-from-args-std args)) + (if (and (= objnum obj-bear) + (member obj-bear (nth dun-current-room dun-room-objects))) + (progn + (if (not (member obj-food dun-inventory)) + (dun-mprincl "You have nothing with which to feed it.") + (dun-drop '("food")))) + (if (not (or (member objnum (nth dun-current-room dun-room-objects)) + (member objnum dun-inventory) + (member objnum (nth dun-current-room dun-room-silents)))) + (dun-mprincl "I don't see that here.") + (dun-mprincl "You cannot feed that.")))))) + + +;;;; +;;;; This section defines various utility functions used +;;;; by dunnet. +;;;; -(setq dun-inbus nil) -(setq dun-nomail nil) -(setq dun-ignore '(the to at)) -(setq dun-mode 'moby) -(setq dun-sauna-level 0) -(defconst north 0) -(defconst south 1) -(defconst east 2) -(defconst west 3) -(defconst northeast 4) -(defconst southeast 5) -(defconst northwest 6) -(defconst southwest 7) -(defconst up 8) -(defconst down 9) -(defconst in 10) -(defconst out 11) +;;; Function which takes a verb and a list of other words. Calls proper +;;; function associated with the verb, and passes along the other words. -(setq dungeon-map '( -; no so ea we ne se nw sw up do in ot - ( 96 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;0 - ( -1 -1 2 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;1 - ( -1 -1 3 1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;2 - ( -1 -1 -1 2 4 6 -1 -1 -1 -1 -1 -1 ) ;3 - ( -1 -1 -1 -1 5 -1 -1 3 -1 -1 -1 -1 ) ;4 - ( -1 -1 -1 -1 255 -1 -1 4 -1 -1 255 -1 ) ;5 - ( -1 -1 -1 -1 -1 7 3 -1 -1 -1 -1 -1 ) ;6 - ( -1 -1 -1 -1 -1 255 6 27 -1 -1 -1 -1 ) ;7 - ( 255 5 9 10 -1 -1 -1 5 -1 -1 -1 5 ) ;8 - ( -1 -1 -1 8 -1 -1 -1 -1 -1 -1 -1 -1 ) ;9 - ( -1 -1 8 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;10 - ( -1 8 -1 58 -1 -1 -1 -1 -1 -1 -1 -1 ) ;11 - ( -1 -1 13 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;12 - ( 15 -1 14 12 -1 -1 -1 -1 -1 -1 -1 -1 ) ;13 - ( -1 -1 -1 13 -1 -1 -1 -1 -1 -1 -1 -1 ) ;14 - ( -1 13 16 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;15 - ( -1 -1 -1 15 -1 -1 -1 -1 -1 17 16 -1 ) ;16 - ( -1 -1 17 17 17 17 255 17 255 17 -1 -1 ) ;17 - ( 18 18 18 18 18 -1 18 18 19 18 -1 -1 ) ;18 - ( -1 18 18 19 19 20 19 19 -1 18 -1 -1 ) ;19 - ( -1 -1 -1 18 -1 -1 -1 -1 -1 21 -1 -1 ) ;20 - ( -1 -1 -1 -1 -1 20 22 -1 -1 -1 -1 -1 ) ;21 - ( 18 18 18 18 16 18 23 18 18 18 18 18 ) ;22 - ( -1 255 -1 -1 -1 19 -1 -1 -1 -1 -1 -1 ) ;23 - ( 23 25 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;24 - ( 24 255 -1 -1 -1 -1 -1 -1 -1 -1 255 -1 ) ;25 - (255 28 -1 -1 -1 -1 -1 -1 -1 -1 255 -1 ) ;26 - ( -1 -1 -1 -1 7 -1 -1 -1 -1 -1 -1 -1 ) ;27 - ( 26 255 -1 -1 -1 -1 -1 -1 -1 -1 255 -1 ) ;28 - ( -1 -1 30 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;29 - ( -1 -1 31 29 -1 -1 -1 -1 -1 -1 -1 -1 ) ;30 - ( 32 33 -1 30 -1 -1 -1 -1 -1 -1 -1 -1 ) ;31 - ( -1 31 -1 255 -1 -1 -1 -1 -1 34 -1 -1 ) ;32 - ( 31 -1 -1 -1 -1 -1 -1 -1 -1 35 -1 -1 ) ;33 - ( -1 35 -1 -1 -1 -1 -1 -1 32 37 -1 -1 ) ;34 - ( 34 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;35 - ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;36 - ( -1 -1 -1 -1 -1 -1 -1 38 34 -1 -1 -1 ) ;37 - ( -1 -1 40 41 37 -1 -1 39 -1 -1 -1 -1 ) ;38 - ( -1 -1 -1 -1 38 -1 -1 -1 -1 -1 -1 -1 ) ;39 - ( -1 -1 -1 38 -1 -1 -1 -1 42 -1 -1 -1 ) ;40 - ( -1 -1 38 -1 -1 -1 -1 -1 -1 43 -1 -1 ) ;41 - ( -1 -1 -1 -1 -1 -1 -1 -1 -1 40 -1 -1 ) ;42 - ( 44 -1 46 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;43 - ( -1 43 45 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;44 - ( -1 46 -1 44 -1 -1 -1 -1 -1 -1 -1 -1 ) ;45 - ( 45 -1 -1 43 -1 -1 -1 -1 -1 255 -1 -1 ) ;46 - ( 48 50 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;47 - ( 49 47 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;48 - ( -1 48 -1 -1 -1 -1 -1 -1 52 -1 -1 -1 ) ;49 - ( 47 51 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;50 - ( 50 104 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;51 - ( -1 -1 -1 -1 -1 -1 -1 -1 53 49 -1 -1 ) ;52 - ( -1 -1 -1 -1 -1 -1 -1 -1 54 52 -1 -1 ) ;53 - ( -1 -1 -1 -1 55 -1 -1 -1 -1 53 -1 -1 ) ;54 - ( -1 -1 -1 -1 56 -1 -1 54 -1 -1 -1 54 ) ;55 - ( -1 -1 -1 -1 -1 -1 -1 55 -1 31 -1 -1 ) ;56 - ( -1 -1 32 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;57 - ( 59 -1 11 -1 -1 -1 -1 -1 -1 -1 255 255) ;58 - ( 60 58 63 -1 -1 -1 255 -1 -1 -1 255 255) ;59 - ( 61 59 64 -1 -1 -1 -1 -1 -1 -1 255 255) ;60 - ( 62 60 65 -1 -1 -1 -1 -1 -1 -1 255 255) ;61 - ( -1 61 66 -1 -1 -1 -1 -1 -1 -1 255 255) ;62 - ( 64 -1 67 59 -1 -1 -1 -1 -1 -1 255 255) ;63 - ( 65 63 68 60 -1 -1 -1 -1 -1 -1 255 255) ;64 - ( 66 64 69 61 -1 -1 -1 -1 -1 -1 255 255) ;65 - ( -1 65 70 62 -1 -1 -1 -1 -1 -1 255 255) ;66 - ( 68 -1 71 63 -1 -1 -1 -1 -1 -1 255 255) ;67 - ( 69 67 72 64 -1 -1 -1 -1 -1 -1 255 255) ;68 - ( 70 68 73 65 -1 -1 -1 -1 -1 -1 255 255) ;69 - ( -1 69 74 66 -1 -1 -1 -1 -1 -1 255 255) ;70 - ( 72 -1 75 67 -1 -1 -1 -1 -1 -1 255 255) ;71 - ( 73 71 76 68 -1 -1 -1 -1 -1 -1 255 255) ;72 - ( 74 72 77 69 -1 -1 -1 -1 -1 -1 255 255) ;73 - ( -1 73 78 70 -1 -1 -1 -1 -1 -1 255 255) ;74 - ( 76 -1 79 71 -1 -1 -1 -1 -1 -1 255 255) ;75 - ( 77 75 80 72 -1 -1 -1 -1 -1 -1 255 255) ;76 - ( 78 76 81 73 -1 -1 -1 -1 -1 -1 255 255) ;77 - ( -1 77 82 74 -1 -1 -1 -1 -1 -1 255 255) ;78 - ( 80 -1 -1 75 -1 -1 -1 -1 -1 -1 255 255) ;79 - ( 81 79 255 76 -1 -1 -1 -1 -1 -1 255 255) ;80 - ( 82 80 -1 77 -1 -1 -1 -1 -1 -1 255 255) ;81 - ( -1 81 -1 78 -1 -1 -1 -1 -1 -1 255 255) ;82 - ( 84 -1 -1 -1 -1 59 -1 -1 -1 -1 255 255) ;83 - ( -1 83 85 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;84 - ( 86 -1 87 84 -1 -1 -1 -1 -1 -1 -1 -1 ) ;85 - ( -1 85 88 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;86 - ( 88 -1 -1 85 -1 -1 -1 -1 -1 -1 -1 -1 ) ;87 - ( -1 87 255 86 -1 -1 -1 -1 -1 -1 -1 -1 ) ;88 - ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 255 -1 ) ;89 - ( 91 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;90 - ( 92 90 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;91 - ( -1 91 -1 -1 -1 -1 -1 -1 93 94 -1 -1 ) ;92 - ( -1 -1 -1 88 -1 -1 -1 -1 -1 92 -1 -1 ) ;93 - ( -1 -1 -1 -1 95 -1 -1 -1 92 -1 -1 -1 ) ;94 - ( -1 -1 -1 -1 -1 -1 -1 94 -1 -1 -1 -1 ) ;95 - ( 97 0 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;96 - ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;97 - ( 99 97 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;98 - ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;99 - ( 101 99 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;100 - ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;101 - ( 103 101 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;102 - ( -1 102 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;103 - ( 51 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;104 - ) -; no so ea we ne se nw sw up do in ot -) +(defun dun-doverb (dun-ignore dun-verblist verb rest) + (if (not verb) + nil + (if (member (intern verb) dun-ignore) + (if (not (car rest)) -1 + (dun-doverb dun-ignore dun-verblist (car rest) (cdr rest))) + (if (not (cdr (assq (intern verb) dun-verblist))) -1 + (setq dun-numcmds (1+ dun-numcmds)) + (funcall (cdr (assq (intern verb) dun-verblist)) rest))))) + + +;;; Function to take a string and change it into a list of lowercase words. + +(defun dun-listify-string (strin) + (let (pos ret-list end-pos) + (setq pos 0) + (setq ret-list nil) + (while (setq end-pos (string-match "[ ,:;]" (substring strin pos))) + (setq end-pos (+ end-pos pos)) + (if (not (= end-pos pos)) + (setq ret-list (append ret-list (list + (downcase + (substring strin pos end-pos)))))) + (setq pos (+ end-pos 1))) ret-list)) + +(defun dun-listify-string2 (strin) + (let (pos ret-list end-pos) + (setq pos 0) + (setq ret-list nil) + (while (setq end-pos (string-match " " (substring strin pos))) + (setq end-pos (+ end-pos pos)) + (if (not (= end-pos pos)) + (setq ret-list (append ret-list (list + (downcase + (substring strin pos end-pos)))))) + (setq pos (+ end-pos 1))) ret-list)) + +(defun dun-replace (list n number) + (rplaca (nthcdr n list) number)) + + +;;; Get the first non-ignored word from a list. + +(defun dun-firstword (list) + (if (not (car list)) + nil + (while (and list (member (intern (car list)) dun-ignore)) + (setq list (cdr list))) + (car list))) + +(defun dun-firstwordl (list) + (if (not (car list)) + nil + (while (and list (member (intern (car list)) dun-ignore)) + (setq list (cdr list))) + list)) + +;;; parse a line passed in as a string Call the proper verb with the +;;; rest of the line passed in as a list. + +(defun dun-vparse (dun-ignore dun-verblist line) + (dun-mprinc "\n") + (setq line-list (dun-listify-string (concat line " "))) + (dun-doverb dun-ignore dun-verblist (car line-list) (cdr line-list))) + +(defun dun-parse2 (dun-ignore dun-verblist line) + (dun-mprinc "\n") + (setq line-list (dun-listify-string2 (concat line " "))) + (dun-doverb dun-ignore dun-verblist (car line-list) (cdr line-list))) + +;;; Read a line, in window mode + +(defun dun-read-line () + (let (line) + (setq line (read-string "")) + (dun-mprinc line) line)) + +;;; Insert something into the window buffer +(defun dun-minsert (string) + (if (stringp string) + (insert string) + (insert (prin1-to-string string)))) -;;; How the user references *all* objects, permanent and regular. -(setq dun-objnames '( - (shovel . 0) - (lamp . 1) - (cpu . 2) (board . 2) (card . 2) (chip . 2) - (food . 3) - (key . 4) - (paper . 5) (slip . 5) - (rms . 6) (statue . 6) (statuette . 6) (stallman . 6) - (diamond . 7) - (weight . 8) - (life . 9) (preserver . 9) - (bracelet . 10) (emerald . 10) - (gold . 11) - (platinum . 12) - (towel . 13) (beach . 13) - (axe . 14) - (silver . 15) - (license . 16) - (coins . 17) - (egg . 18) - (jar . 19) - (bone . 20) - (acid . 21) (nitric . 21) - (glycerine . 22) - (ruby . 23) - (amethyst . 24) - (mona . 25) - (bill . 26) - (floppy . 27) (disk . 27) +;;; Print something out, in window mode - (boulder . -1) - (tree . -2) (trees . -2) (palm . -2) - (bear . -3) - (bin . -4) (bins . -4) - (cabinet . -5) (computer . -5) (vax . -5) (ibm . -5) - (protoplasm . -6) - (dial . -7) - (button . -8) - (chute . -9) - (painting . -10) - (bed . -11) - (urinal . -12) - (URINE . -13) - (pipes . -14) (pipe . -14) - (box . -15) (slit . -15) - (cable . -16) (ethernet . -16) - (mail . -17) (drop . -17) - (bus . -18) - (gate . -19) - (cliff . -20) - (skeleton . -21) (dinosaur . -21) - (fish . -22) - (tanks . -23) (tank . -23) - (switch . -24) - (blackboard . -25) - (disposal . -26) (garbage . -26) - (ladder . -27) - (subway . -28) (train . -28) - (pc . -29) (drive . -29) (coconut . -30) (coconuts . -30) - (lake . -32) (water . -32) -)) +(defun dun-mprinc (string) + (if (stringp string) + (insert string) + (insert (prin1-to-string string)))) -(dolist (x dun-objnames) - (let (name) - (setq name (concat "obj-" (prin1-to-string (car x)))) - (eval (list 'defconst (intern name) (cdr x))))) +;;; In window mode, keep screen from jumping by keeping last line at +;;; the bottom of the screen. -(defconst obj-special 255) +(defun dun-fix-screen () + (interactive) + (forward-line (- 0 (- (window-height) 2 ))) + (set-window-start (selected-window) (point)) + (goto-char (point-max))) -;;; The initial setup of what objects are in each room. -;;; Regular objects have whole numbers lower than 255. -;;; Objects that cannot be taken but might move and are -;;; described during room description are negative. -;;; Stuff that is described and might change are 255, and are -;;; handled specially by 'dun-describe-room. +;;; Insert something into the buffer, followed by newline. -(setq dun-room-objects (list nil +(defun dun-minsertl (string) + (dun-minsert string) + (dun-minsert "\n")) - (list obj-shovel) ;; treasure-room - (list obj-boulder) ;; dead-end - nil nil nil - (list obj-food) ;; se-nw-road - (list obj-bear) ;; bear-hangout - nil nil - (list obj-special) ;; computer-room - (list obj-lamp obj-license obj-silver);; meadow - nil nil - (list obj-special) ;; sauna - nil - (list obj-weight obj-life) ;; weight-room - nil nil - (list obj-rms obj-floppy) ;; thirsty-maze - nil nil nil nil nil nil nil - (list obj-emerald) ;; hidden-area - nil - (list obj-gold) ;; misty-room - nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil - (list obj-towel obj-special) ;; red-room - nil nil nil nil nil - (list obj-box) ;; stair-landing - nil nil nil - (list obj-axe) ;; small-crawlspace - nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil - nil nil nil nil nil - (list obj-special) ;; fourth-vermont-intersection - nil nil - (list obj-coins) ;; fifth-oaktree-intersection - nil - (list obj-bus) ;; fifth-sycamore-intersection - nil - (list obj-bone) ;; museum-lobby - nil - (list obj-jar obj-special obj-ruby) ;; marine-life-area - (list obj-nitric) ;; maintenance-room - (list obj-glycerine) ;; classroom - nil nil nil nil nil - (list obj-amethyst) ;; bottom-of-subway-stairs - nil nil - (list obj-special) ;; question-room-1 - nil - (list obj-special) ;; question-room-2 - nil - (list obj-special) ;; question-room-three - nil - (list obj-mona) ;; winner's-room -nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil -nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil -nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil -nil)) +;;; Print something, followed by a newline. -;;; These are objects in a room that are only described in the -;;; room description. They are permanent. +(defun dun-mprincl (string) + (dun-mprinc string) + (dun-mprinc "\n")) -(setq dun-room-silents (list nil - (list obj-tree obj-coconut) ;; dead-end - (list obj-tree obj-coconut) ;; e-w-dirt-road - nil nil nil nil nil nil - (list obj-bin) ;; mailroom - (list obj-computer) ;; computer-room - nil nil nil - (list obj-dial) ;; sauna - nil - (list obj-ladder) ;; weight-room - (list obj-button obj-ladder) ;; maze-button-room - nil nil nil - nil nil nil nil - (list obj-lake) ;; lakefront-north - (list obj-lake) ;; lakefront-south - nil - (list obj-chute) ;; cave-entrance - nil nil nil nil nil - (list obj-painting obj-bed) ;; bedroom - (list obj-urinal obj-pipes) ;; bathroom - nil nil nil nil nil nil - (list obj-boulder) ;; horseshoe-boulder-room - nil nil nil nil nil nil nil nil nil nil nil nil nil nil - (list obj-computer obj-cable) ;; gamma-computing-center - (list obj-mail) ;; post-office - (list obj-gate) ;; main-maple-intersection - nil nil nil nil nil nil nil nil nil nil nil nil nil - nil nil nil nil nil nil nil - (list obj-cliff) ;; fifth-oaktree-intersection - nil nil nil - (list obj-dinosaur) ;; museum-lobby - nil - (list obj-fish obj-tanks) ;; marine-life-area - (list obj-switch) ;; maintenance-room - (list obj-blackboard) ;; classroom - (list obj-train) ;; vermont-station - nil nil - (list obj-disposal) ;; north-end-of-n-s-tunnel - nil nil - (list obj-computer) ;; endgame-computer-room - nil nil nil nil nil nil nil nil - (list obj-pc) ;; pc-area - nil nil nil nil nil nil -)) -(setq dun-inventory '(1)) +;;; Function which will get an object number given the list of +;;; words in the command, except for the verb. -;;; Descriptions of objects, as they appear in the room description, and -;;; the inventory. +(defun dun-objnum-from-args (obj) + (setq obj (dun-firstword obj)) + (if (not obj) + obj-special + (cdr (assq (intern obj) dun-objnames)))) -(setq dun-objects '( - ("There is a shovel here." "A shovel") ;0 - ("There is a lamp nearby." "A lamp") ;1 - ("There is a CPU card here." "A computer board") ;2 - ("There is some food here." "Some food") ;3 - ("There is a shiny brass key here." "A brass key") ;4 - ("There is a slip of paper here." "A slip of paper") ;5 - ("There is a wax statuette of Richard Stallman here." ;6 - "An RMS statuette") - ("There is a shimmering diamond here." "A diamond") ;7 - ("There is a 10 pound weight here." "A weight") ;8 - ("There is a life preserver here." "A life preserver");9 - ("There is an emerald bracelet here." "A bracelet") ;10 - ("There is a gold bar here." "A gold bar") ;11 - ("There is a platinum bar here." "A platinum bar") ;12 - ("There is a beach towel on the ground here." "A beach towel") - ("There is an axe here." "An axe") ;14 - ("There is a silver bar here." "A silver bar") ;15 - ("There is a bus driver's license here." "A license") ;16 - ("There are some valuable coins here." "Some valuable coins") - ("There is a jewel-encrusted egg here." "A valuable egg") ;18 - ("There is a glass jar here." "A glass jar") ;19 - ("There is a dinosaur bone here." "A bone") ;20 - ("There is a packet of nitric acid here." "Some nitric acid") - ("There is a packet of glycerine here." "Some glycerine") ;22 - ("There is a valuable ruby here." "A ruby") ;23 - ("There is a valuable amethyst here." "An amethyst") ;24 - ("The Mona Lisa is here." "The Mona Lisa") ;25 - ("There is a 100 dollar bill here." "A $100 bill") ;26 - ("There is a floppy disk here." "A floppy disk") ;27 - ) -) +(defun dun-objnum-from-args-std (obj) + (let (result) + (if (eq (setq result (dun-objnum-from-args obj)) obj-special) + (dun-mprincl "You must supply an object.")) + (if (eq result nil) + (dun-mprincl "I don't know what that is.")) + (if (eq result obj-special) + nil + result))) + +;;; Take a short room description, and change spaces and slashes to dashes. + +(defun dun-space-to-hyphen (string) + (let (space) + (if (setq space (string-match "[ /]" string)) + (progn + (setq string (concat (substring string 0 space) "-" + (substring string (1+ space)))) + (dun-space-to-hyphen string)) + string))) -;;; Weight of objects +;;; Given a unix style pathname, build a list of path components (recursive) -(setq dun-object-lbs - '(2 1 1 1 1 0 2 2 10 3 1 1 1 0 1 1 0 1 1 1 1 0 0 2 2 1 0 0)) -(setq dun-object-pts - '(0 0 0 0 0 0 0 10 0 0 10 10 10 0 0 10 0 10 10 0 0 0 0 10 10 10 10 0)) +(defun dun-get-path (dirstring startlist) + (let (slash) + (if (= (length dirstring) 0) + startlist + (if (string= (substring dirstring 0 1) "/") + (dun-get-path (substring dirstring 1) (append startlist (list "/"))) + (if (not (setq slash (string-match "/" dirstring))) + (append startlist (list dirstring)) + (dun-get-path (substring dirstring (1+ slash)) + (append startlist + (list (substring dirstring 0 slash))))))))) -;;; Unix representation of objects. -(setq dun-objfiles '( - "shovel.o" "lamp.o" "cpu.o" "food.o" "key.o" "paper.o" - "rms.o" "diamond.o" "weight.o" "preserver.o" "bracelet.o" - "gold.o" "platinum.o" "towel.o" "axe.o" "silver.o" "license.o" - "coins.o" "egg.o" "jar.o" "bone.o" "nitric.o" "glycerine.o" - "ruby.o" "amethyst.o" - )) +;;; Is a string a member of a string list? -;;; These are the descriptions for the negative numbered objects from -;;; dun-room-objects +(defun dun-members (string string-list) + (let (found) + (setq found nil) + (dolist (x string-list) + (if (string= x string) + (setq found t))) found)) -(setq dun-perm-objects '( - nil - ("There is a large boulder here.") - nil - ("There is a ferocious bear here!") - nil - nil - ("There is a worthless pile of protoplasm here.") - nil - nil - nil - nil - nil - nil - ("There is a strange smell in this room.") - nil - ( -"There is a box with a slit in it, bolted to the wall here." - ) - nil - nil - ("There is a bus here.") - nil - nil - nil -)) +;;; Function to put objects in the treasure room. Also prints current +;;; score to let user know he has scored. +(defun dun-put-objs-in-treas (objlist) + (let (oscore newscore) + (setq oscore (dun-reg-score)) + (dun-replace dun-room-objects 0 (append (nth 0 dun-room-objects) objlist)) + (setq newscore (dun-reg-score)) + (if (not (= oscore newscore)) + (dun-score nil)))) -;;; These are the descriptions the user gets when regular objects are -;;; examined. +;;; Load an encrypted file, and eval it. -(setq dun-physobj-desc '( -"It is a normal shovel with a price tag attached that says $19.99." -"The lamp is hand-crafted by Geppetto." -"The CPU board has a VAX chip on it. It seems to have -2 Megabytes of RAM onboard." -"It looks like some kind of meat. Smells pretty bad." -nil -"The paper says: Don't forget to type ‘help’ for help. Also, remember -this word: ‘worms’" -"The statuette is of the likeness of Richard Stallman, the author of the -famous EMACS editor. You notice that he is not wearing any shoes." -nil -"You observe that the weight is heavy." -"It says S. S. Minnow." -nil -nil -nil -"It has a picture of snoopy on it." -nil -nil -"It has your picture on it!" -"They are old coins from the 19th century." -"It is a valuable Fabrege egg." -"It is a plain glass jar." -nil -nil -nil -nil -nil - ) -) +(defun dun-load-d (filename) + (let (old-buffer result) + (setq result t) + (setq old-buffer (current-buffer)) + (switch-to-buffer (get-buffer-create "*loadc*")) + (erase-buffer) + (condition-case nil + (insert-file-contents filename) + (error (setq result nil))) + (unless (not result) + (condition-case nil + (dun-rot13) + (error (yank))) + (eval-buffer) + (kill-buffer (current-buffer))) + (switch-to-buffer old-buffer) + result)) -;;; These are the descriptions the user gets when non-regular objects -;;; are examined. +;;; Functions to remove an object either from a room, or from inventory. -(setq dun-permobj-desc '( - nil -"It is just a boulder. It cannot be moved." -"They are palm trees with a bountiful supply of coconuts in them." -"It looks like a grizzly to me." -"All of the bins are empty. Looking closely you can see that there -are names written at the bottom of each bin, but most of them are -faded away so that you cannot read them. You can only make out three -names: - Jeffrey Collier - Robert Toukmond - Thomas Stock -" - nil -"It is just a garbled mess." -"The dial points to a temperature scale which has long since faded away." -nil -nil -"It is a velvet painting of Elvis Presley. It seems to be nailed to the -wall, and you cannot move it." -"It is a queen sized bed, with a very firm mattress." -"The urinal is very clean compared with everything else in the cave. There -isn't even any rust. Upon close examination you realize that the drain at the -bottom is missing, and there is just a large hole leading down the -pipes into nowhere. The hole is too small for a person to fit in. The -flush handle is so clean that you can see your reflection in it." -nil -nil -"The box has a slit in the top of it, and on it, in sloppy handwriting, is -written: ‘For key upgrade, put key in here.’" -nil -"It says ‘express mail’ on it." -"It is a 35 passenger bus with the company name ‘mobytours’ on it." -"It is a large metal gate that is too big to climb over." -"It is a HIGH cliff." -"Unfortunately you do not know enough about dinosaurs to tell very much about -it. It is very big, though." -"The fish look like they were once quite beautiful." -nil -nil -nil -nil -"It is a normal ladder that is permanently attached to the hole." -"It is a passenger train that is ready to go." -"It is a personal computer that has only one floppy disk drive." - ) -) +(defun dun-remove-obj-from-room (room objnum) + (let (newroom) + (setq newroom nil) + (dolist (x (nth room dun-room-objects)) + (if (not (= x objnum)) + (setq newroom (append newroom (list x))))) + (rplaca (nthcdr room dun-room-objects) newroom))) -(setq dun-diggables - (list nil nil nil (list obj-cpu) nil nil nil nil nil nil nil - nil nil nil nil nil nil nil nil nil nil ;11-20 - nil nil nil nil nil nil nil nil nil nil ;21-30 - nil nil nil nil nil nil nil nil nil nil ;31-40 - nil (list obj-platinum) nil nil nil nil nil nil nil nil)) +(defun dun-remove-obj-from-inven (objnum) + (let (new-inven) + (setq new-inven nil) + (dolist (x dun-inventory) + (if (not (= x objnum)) + (setq new-inven (append new-inven (list x))))) + (setq dun-inventory new-inven))) + +(defun dun-rot13 () + (rot13-region (point-min) (point-max))) + +;;;; +;;;; This section sets up the keymaps for interactive and batch dunnet. +;;;; + +(define-obsolete-variable-alias 'dungeon-mode-map 'dun-mode-map "22.1") +(define-key dun-mode-map "\r" 'dun-parse) +(defvar dungeon-batch-map (make-keymap)) +(if (string= (substring emacs-version 0 2) "18") + (let (n) + (setq n 32) + (while (< 0 (setq n (- n 1))) + (aset dungeon-batch-map n 'dungeon-nil))) + (let (n) + (setq n 32) + (while (< 0 (setq n (- n 1))) + (aset (car (cdr dungeon-batch-map)) n 'dungeon-nil)))) +(define-key dungeon-batch-map "\r" 'exit-minibuffer) +(define-key dungeon-batch-map "\n" 'exit-minibuffer) -(setq dun-room-shorts nil) (dolist (x dun-rooms) (setq dun-room-shorts (append dun-room-shorts (list (downcase (dun-space-to-hyphen (cadr x))))))) -(setq dun-endgame-questions '( - ( -"What is your password on the machine called ‘pokey’?" "robert") - ( -"What password did you use during anonymous ftp to gamma?" "foo") - ( -"Excluding the endgame, how many places are there where you can put -treasures for points?" "4" "four") - ( -"What is your login name on the ‘endgame’ machine?" "toukmond" -) - ( -"What is the nearest whole dollar to the price of the shovel?" "20" "twenty") - ( -"What is the name of the bus company serving the town?" "mobytours") - ( -"Give either of the two last names in the mailroom, other than your own." -"collier" "stock") - ( -"What cartoon character is on the towel?" "snoopy") - ( -"What is the last name of the author of EMACS?" "stallman") - ( -"How many megabytes of memory is on the CPU board for the Vax?" "2") - ( -"Which street in town is named after a U.S. state?" "vermont") - ( -"How many pounds did the weight weigh?" "ten" "10") - ( -"Name the STREET which runs right over the subway stop." "fourth" "4" "4th") - ( -"How many corners are there in town (excluding the one with the Post Office)?" - "24" "twentyfour" "twenty-four") - ( -"What type of bear was hiding your key?" "grizzly") - ( -"Name either of the two objects you found by digging." "cpu" "card" "vax" -"board" "platinum") - ( -"What network protocol is used between pokey and gamma?" "tcp/ip" "ip" "tcp") -)) - (let (a) (setq a 0) (dolist (x dun-room-shorts) (eval (list 'defconst (intern x) a)) (setq a (+ a 1)))) - - ;;;; ;;;; This section defines the UNIX emulation functions for dunnet. ;;;;