Mercurial > hg > xemacs-beta

comparison lisp/games/dunnet.el @ 4:b82b59fe008d r19-15b3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b3
author cvs
date Mon, 13 Aug 2007 08:46:56 +0200
parents 376386a54a3c
children 131b0175ea99
comparison
equal deleted inserted replaced
3:30df88044ec6 4:b82b59fe008d
1 ;;; dunnet.el --- Text adventure for Emacs 1 ;;; dunnet.el --- Text adventure for Emacs
2
3 ;; Copyright (C) 1992, 1993 Free Software Foundation, Inc.
2 4
3 ;; Author: Ron Schnell <ronnie@media.mit.edu> 5 ;; Author: Ron Schnell <ronnie@media.mit.edu>
4 ;; Created: 25 Jul 1992 6 ;; Created: 25 Jul 1992
5 ;; Version: 2.0 7 ;; Version: 2.0
6 ;; Keywords: games 8 ;; Keywords: games
7 ;; Copyright (C) 1992, 1993 Free Software Foundation, Inc.
8 9
9 ;; This file is part of XEmacs. 10 ;; This file is part of XEmacs.
10 11
11 ;; XEmacs is free software; you can redistribute it and/or modify it 12 ;; XEmacs is free software; you can redistribute it and/or modify it
12 ;; under the terms of the GNU General Public License as published by 13 ;; under the terms of the GNU General Public License as published by
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 ;; General Public License for more details. 20 ;; General Public License for more details.
20 21
21 ;; You should have received a copy of the GNU General Public License 22 ;; You should have received a copy of the GNU General Public License
22 ;; along with XEmacs; see the file COPYING. If not, write to the Free 23 ;; along with XEmacs; see the file COPYING. If not, write to the Free
23 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
24 25 ;; 02111-1307, USA.
25 ;;; Synched up with: FSF 19.28. 26
27 ;;; Synched up with: FSF 19.34.
26 28
27 ;;; Commentary: 29 ;;; Commentary:
28 30
29 ;; This game can be run in batch mode. To do this, use: 31 ;; This game can be run in batch mode. To do this, use:
30 ;; emacs -batch -l dunnet 32 ;; emacs -batch -l dunnet
31 33
32 ;;; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 34 ;;; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
33 ;;; The log file should be set for your system, and it must 35 ;;; The log file should be set for your system, and it must
34 ;;; be writeable by all. 36 ;;; be writable by all.
35 37
36 38
37 (defvar dun-log-file "/usr/local/dunnet.score" 39 (defvar dun-log-file "/usr/local/dunnet.score"
38 "Name of file to store score information for dunnet.") 40 "Name of file to store score information for dunnet.")
39 41
40 (if nil 42 (if nil
41 (eval-and-compile (setq byte-compile-warnings nil))) 43 (eval-and-compile (setq byte-compile-warnings nil)))
42 44
43 (require 'cl) 45 (eval-when-compile
46 (require 'cl))
44 47
45 ;;;; Mode definitions for interactive mode 48 ;;;; Mode definitions for interactive mode
46 49
47 (defun dun-mode () 50 (defun dun-mode ()
48 "Major mode for running dunnet." 51 "Major mode for running dunnet."
49 (interactive) 52 (interactive)
50 (text-mode) 53 (text-mode)
54 (make-local-variable 'scroll-step)
55 (setq scroll-step 2)
51 (use-local-map dungeon-mode-map) 56 (use-local-map dungeon-mode-map)
52 (setq major-mode 'dungeon-mode) 57 (setq major-mode 'dungeon-mode)
53 (setq mode-name "Dungeon")) 58 (setq mode-name "Dungeon"))
54 59
55 (defun dun-parse (arg) 60 (defun dun-parse (arg)
422 (dun-replace dun-diggables dun-current-room nil))))) 427 (dun-replace dun-diggables dun-current-room nil)))))
423 428
424 (defun dun-climb (obj) 429 (defun dun-climb (obj)
425 (let (objnum) 430 (let (objnum)
426 (setq objnum (dun-objnum-from-args obj)) 431 (setq objnum (dun-objnum-from-args obj))
427 (if (and (not (= objnum obj-special)) 432 (cond ((null objnum)
428 (not (member objnum (nth dun-current-room dun-room-objects))) 433 (dun-mprincl "I don't know that name."))
429 (not (member objnum (nth dun-current-room dun-room-silents))) 434 ((and (not (eq objnum obj-special))
430 (not (member objnum dun-inventory))) 435 (not (member objnum (nth dun-current-room dun-room-objects)))
431 (dun-mprincl "I don't see that here.") 436 (not (member objnum (nth dun-current-room dun-room-silents)))
432 (if (and (= objnum obj-special) 437 (not (member objnum dun-inventory)))
433 (not (member obj-tree (nth dun-current-room dun-room-silents)))) 438 (dun-mprincl "I don't see that here."))
434 (dun-mprincl "There is nothing here to climb.") 439 ((and (eq objnum obj-special)
435 (if (and (not (= objnum obj-tree)) (not (= objnum obj-special))) 440 (not (member obj-tree (nth dun-current-room dun-room-silents))))
436 (dun-mprincl "You can't climb that.") 441 (dun-mprincl "There is nothing here to climb."))
437 (dun-mprincl 442 ((and (not (eq objnum obj-tree)) (not (eq objnum obj-special)))
438 "You manage to get about two feet up the tree and fall back down. You 443 (dun-mprincl "You can't climb that."))
439 notice that the tree is very unsteady.")))))) 444 (t
445 (dun-mprincl
446 "You manage to get about two feet up the tree and fall back down. You
447 notice that the tree is very unsteady.")))))
440 448
441 (defun dun-eat (obj) 449 (defun dun-eat (obj)
442 (let (objnum) 450 (let (objnum)
443 (when (setq objnum (dun-objnum-from-args-std obj)) 451 (when (setq objnum (dun-objnum-from-args-std obj))
444 (if (not (member objnum dun-inventory)) 452 (if (not (member objnum dun-inventory))
787 (dun-sauna-heat)))))))) 795 (dun-sauna-heat))))))))
788 796
789 (defun dun-sauna-heat () 797 (defun dun-sauna-heat ()
790 (if (= dun-sauna-level 0) 798 (if (= dun-sauna-level 0)
791 (dun-mprincl 799 (dun-mprincl
792 "The termperature has returned to normal room termperature.")) 800 "The temperature has returned to normal room temperature."))
793 (if (= dun-sauna-level 1) 801 (if (= dun-sauna-level 1)
794 (dun-mprincl "It is now luke warm in here. You begin to sweat.")) 802 (dun-mprincl "It is now luke warm in here. You begin to sweat."))
795 (if (= dun-sauna-level 2) 803 (if (= dun-sauna-level 2)
796 (dun-mprincl "It is pretty hot in here. It is still very comfortable.")) 804 (dun-mprincl "It is pretty hot in here. It is still very comfortable."))
797 (if (= dun-sauna-level 3) 805 (if (= dun-sauna-level 3)
1339 (setq dun-exitf nil) 1347 (setq dun-exitf nil)
1340 (setq dun-badcd nil) 1348 (setq dun-badcd nil)
1341 (defvar dungeon-mode-map nil) 1349 (defvar dungeon-mode-map nil)
1342 (setq dungeon-mode-map (make-sparse-keymap)) 1350 (setq dungeon-mode-map (make-sparse-keymap))
1343 (define-key dungeon-mode-map "\r" 'dun-parse) 1351 (define-key dungeon-mode-map "\r" 'dun-parse)
1352 ;; XEmacs
1344 (defvar dungeon-batch-map 1353 (defvar dungeon-batch-map
1345 (let ((map (make-keymap)) 1354 (let ((map (make-keymap))
1346 (n 32)) 1355 (n 32))
1347 (while (< 0 (setq n (- n 1))) 1356 (while (< 0 (setq n (- n 1)))
1348 (define-key map (make-string 1 n) 'dungeon-nil)) 1357 (define-key map (make-string 1 n) 'dungeon-nil))
1917 (examine . dun-examine) (describe . dun-examine) 1926 (examine . dun-examine) (describe . dun-examine)
1918 (climb . dun-climb) (eat . dun-eat) (put . dun-put) 1927 (climb . dun-climb) (eat . dun-eat) (put . dun-put)
1919 (type . dun-type) (insert . dun-put) 1928 (type . dun-type) (insert . dun-put)
1920 (score . dun-score) (help . dun-help) (quit . dun-quit) 1929 (score . dun-score) (help . dun-help) (quit . dun-quit)
1921 (read . dun-examine) (verbose . dun-long) 1930 (read . dun-examine) (verbose . dun-long)
1922 (urinate . dun-piss) (piss . dun-piss) 1931 (urinate . dun-piss) (piss . dun-piss) ; censored
1923 (flush . dun-flush) (sleep . dun-sleep) (lie . dun-sleep) 1932 (flush . dun-flush) (sleep . dun-sleep) (lie . dun-sleep)
1924 (x . dun-examine) (break . dun-break) (drive . dun-drive) 1933 (x . dun-examine) (break . dun-break) (drive . dun-drive)
1925 (board . dun-in) (enter . dun-in) (turn . dun-turn) 1934 (board . dun-in) (enter . dun-in) (turn . dun-turn)
1926 (press . dun-press) (push . dun-press) (swim . dun-swim) 1935 (press . dun-press) (push . dun-press) (swim . dun-swim)
1927 (on . dun-in) (off . dun-out) (chop . dun-break) 1936 (on . dun-in) (off . dun-out) (chop . dun-break)
2092 (mona . 25) 2101 (mona . 25)
2093 (bill . 26) 2102 (bill . 26)
2094 (floppy . 27) (disk . 27) 2103 (floppy . 27) (disk . 27)
2095 2104
2096 (boulder . -1) 2105 (boulder . -1)
2097 (tree . -2) (trees . -2) 2106 (tree . -2) (trees . -2) (palm . -2)
2098 (bear . -3) 2107 (bear . -3)
2099 (bin . -4) (bins . -4) 2108 (bin . -4) (bins . -4)
2100 (cabinet . -5) (computer . -5) (vax . -5) (ibm . -5) 2109 (cabinet . -5) (computer . -5) (vax . -5) (ibm . -5)
2101 (protoplasm . -6) 2110 (protoplasm . -6)
2102 (dial . -7) 2111 (dial . -7)
2413 nil nil nil nil nil nil nil nil nil nil ;11-20 2422 nil nil nil nil nil nil nil nil nil nil ;11-20
2414 nil nil nil nil nil nil nil nil nil nil ;21-30 2423 nil nil nil nil nil nil nil nil nil nil ;21-30
2415 nil nil nil nil nil nil nil nil nil nil ;31-40 2424 nil nil nil nil nil nil nil nil nil nil ;31-40
2416 nil (list obj-platinum) nil nil nil nil nil nil nil nil)) 2425 nil (list obj-platinum) nil nil nil nil nil nil nil nil))
2417 2426
2418 (setq scroll-step 2)
2419
2420 (setq dun-room-shorts nil) 2427 (setq dun-room-shorts nil)
2421 (dolist (x dun-rooms) 2428 (dolist (x dun-rooms)
2422 (setq dun-room-shorts 2429 (setq dun-room-shorts
2423 (append dun-room-shorts (list (downcase 2430 (append dun-room-shorts (list (downcase
2424 (dun-space-to-hyphen 2431 (dun-space-to-hyphen
2580 (dun-mprincl "login incorrect") 2587 (dun-mprincl "login incorrect")
2581 (setq dun-logged-in t) 2588 (setq dun-logged-in t)
2582 (dun-mprincl " 2589 (dun-mprincl "
2583 Welcome to Unix\n 2590 Welcome to Unix\n
2584 Please clean up your directories. The filesystem is getting full. 2591 Please clean up your directories. The filesystem is getting full.
2585 Our tcp/ip link to gamma is a little flakey, but seems to work. 2592 Our tcp/ip link to gamma is a little flaky, but seems to work.
2586 The current version of ftp can only send files from the current 2593 The current version of ftp can only send files from the current
2587 directory, and deletes them after they are sent! Be careful. 2594 directory, and deletes them after they are sent! Be careful.
2588 2595
2589 Note: Restricted bourne shell in use.\n"))) 2596 Note: Restricted bourne shell in use.\n")))
2590 (setq dungeon-mode 'dungeon))) 2597 (setq dungeon-mode 'dungeon)))
2868 (setq dun-inventory nil) 2875 (setq dun-inventory nil)
2869 (setq dun-current-room receiving-room) 2876 (setq dun-current-room receiving-room)
2870 (dun-uexit nil)))))))) 2877 (dun-uexit nil))))))))
2871 2878
2872 (defun dun-cd (args) 2879 (defun dun-cd (args)
2873 (let (tcdpath tcdroom path-elemants room-check) 2880 (let (tcdpath tcdroom path-elements room-check)
2874 (if (not (car args)) 2881 (if (not (car args))
2875 (dun-mprincl "Usage: cd <path>") 2882 (dun-mprincl "Usage: cd <path>")
2876 (setq tcdpath dun-cdpath) 2883 (setq tcdpath dun-cdpath)
2877 (setq tcdroom dun-cdroom) 2884 (setq tcdroom dun-cdroom)
2878 (setq dun-badcd nil) 2885 (setq dun-badcd nil)
3327 (fset 'dun-dos-interface 'dun-batch-dos-interface) 3334 (fset 'dun-dos-interface 'dun-batch-dos-interface)
3328 (fset 'dun-unix-interface 'dun-batch-unix-interface) 3335 (fset 'dun-unix-interface 'dun-batch-unix-interface)
3329 (dun-mprinc "\n") 3336 (dun-mprinc "\n")
3330 (setq dun-batch-mode t) 3337 (setq dun-batch-mode t)
3331 (dun-batch-loop)) 3338 (dun-batch-loop))
3339
3340 ;;; dunnet.el ends here