Mercurial > hg > xemacs-beta

comparison lisp/games/dunnet.el @ 70:131b0175ea99 r20-0b30

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