diff options
Diffstat (limited to 'lisp/play')
-rw-r--r-- | lisp/play/5x5.el | 1 | ||||
-rw-r--r-- | lisp/play/bubbles.el | 82 | ||||
-rw-r--r-- | lisp/play/cookie1.el | 6 | ||||
-rw-r--r-- | lisp/play/dunnet.el | 1 | ||||
-rw-r--r-- | lisp/play/fortune.el | 2 | ||||
-rw-r--r-- | lisp/play/gamegrid.el | 232 | ||||
-rw-r--r-- | lisp/play/gametree.el | 3 | ||||
-rw-r--r-- | lisp/play/gomoku.el | 28 | ||||
-rw-r--r-- | lisp/play/hanoi.el | 2 | ||||
-rw-r--r-- | lisp/play/tetris.el | 1 |
10 files changed, 236 insertions, 122 deletions
diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el index e13a3c9a252..28748cc3514 100644 --- a/lisp/play/5x5.el +++ b/lisp/play/5x5.el @@ -3,7 +3,6 @@ ;; Copyright (C) 1999-2019 Free Software Foundation, Inc. ;; Author: Dave Pearson <davep@davep.org> -;; Maintainer: Dave Pearson <davep@davep.org> ;; Created: 1998-10-03 ;; Keywords: games puzzles diff --git a/lisp/play/bubbles.el b/lisp/play/bubbles.el index 8d161775ffd..239fbe4e07c 100644 --- a/lisp/play/bubbles.el +++ b/lisp/play/bubbles.el @@ -1,4 +1,4 @@ -;;; bubbles.el --- Puzzle game for Emacs +;;; bubbles.el --- Puzzle game for Emacs -*- lexical-binding:t -*- ;; Copyright (C) 2007-2019 Free Software Foundation, Inc. @@ -144,8 +144,7 @@ images the `ascii' theme will be used." (const :tag "Diamonds" diamonds) (const :tag "Balls" balls) (const :tag "Emacs" emacs) - (const :tag "ASCII (no images)" ascii)) - :group 'bubbles) + (const :tag "ASCII (no images)" ascii))) (defconst bubbles--grid-small '(10 . 10) "Predefined small bubbles grid.") @@ -168,8 +167,7 @@ images the `ascii' theme will be used." (const :tag "Huge" ,bubbles--grid-huge) (cons :tag "User defined" (integer :tag "Width") - (integer :tag "Height"))) - :group 'bubbles) + (integer :tag "Height")))) (defconst bubbles--colors-2 '("orange" "violet") "Predefined bubbles color list with two colors.") @@ -194,16 +192,14 @@ types are present." (const :tag "Red, darkgreen, blue, orange" ,bubbles--colors-4) (const :tag "Red, darkgreen, blue, orange, violet" ,bubbles--colors-5) - (repeat :tag "User defined" color)) - :group 'bubbles) + (repeat :tag "User defined" color))) (defcustom bubbles-chars '(?+ ?O ?# ?X ?. ?* ?& ?ยง) "Characters used for bubbles. Note that the actual number of different bubbles is determined by the number of colors, see `bubbles-colors'." - :type '(repeat character) - :group 'bubbles) + :type '(repeat character)) (defcustom bubbles-shift-mode 'default @@ -212,12 +208,10 @@ Available modes are `shift-default' and `shift-always'." :type '(radio (const :tag "Default" default) (const :tag "Shifter" always) ;;(const :tag "Mega Shifter" mega) - ) - :group 'bubbles) + )) (defcustom bubbles-mode-hook nil "Hook run by Bubbles mode." - :group 'bubbles :type 'hook) (defun bubbles-customize () @@ -718,57 +712,57 @@ static char * dot3d_xpm[] = { (defsubst bubbles--grid-width () "Return the grid width for the current game theme." (car (pcase bubbles-game-theme - (`easy + ('easy bubbles--grid-small) - (`medium + ('medium bubbles--grid-medium) - (`difficult + ('difficult bubbles--grid-large) - (`hard + ('hard bubbles--grid-huge) - (`user-defined + ('user-defined bubbles-grid-size)))) (defsubst bubbles--grid-height () "Return the grid height for the current game theme." (cdr (pcase bubbles-game-theme - (`easy + ('easy bubbles--grid-small) - (`medium + ('medium bubbles--grid-medium) - (`difficult + ('difficult bubbles--grid-large) - (`hard + ('hard bubbles--grid-huge) - (`user-defined + ('user-defined bubbles-grid-size)))) (defsubst bubbles--colors () "Return the color list for the current game theme." (pcase bubbles-game-theme - (`easy + ('easy bubbles--colors-2) - (`medium + ('medium bubbles--colors-3) - (`difficult + ('difficult bubbles--colors-4) - (`hard + ('hard bubbles--colors-5) - (`user-defined + ('user-defined bubbles-colors))) (defsubst bubbles--shift-mode () "Return the shift mode for the current game theme." (pcase bubbles-game-theme - (`easy + ('easy 'default) - (`medium + ('medium 'default) - (`difficult + ('difficult 'always) - (`hard + ('hard 'always) - (`user-defined + ('user-defined bubbles-shift-mode))) (defun bubbles-save-settings () @@ -898,7 +892,7 @@ static char * dot3d_xpm[] = { ;; bubbles mode map (defvar bubbles-mode-map (let ((map (make-sparse-keymap 'bubbles-mode-map))) -;; (suppress-keymap map t) + ;; (suppress-keymap map t) (define-key map "q" 'bubbles-quit) (define-key map "\n" 'bubbles-plop) (define-key map " " 'bubbles-plop) @@ -925,7 +919,7 @@ static char * dot3d_xpm[] = { (buffer-disable-undo) (force-mode-line-update) (redisplay) - (add-hook 'post-command-hook 'bubbles--mark-neighborhood t t)) + (add-hook 'post-command-hook #'bubbles--mark-neighborhood t t)) ;;;###autoload (defun bubbles () @@ -1004,14 +998,14 @@ Set `bubbles--col-offset' and `bubbles--row-offset'." (list bubbles--row-offset)))) (insert "\n") (let ((max-char (length (bubbles--colors)))) - (dotimes (i (bubbles--grid-height)) + (dotimes (_ (bubbles--grid-height)) (let ((p (point))) (insert " ") (put-text-property p (point) 'display (cons 'space (list :width (list bubbles--col-offset))))) - (dotimes (j (bubbles--grid-width)) + (dotimes (_ (bubbles--grid-width)) (let* ((index (random max-char)) (char (nth index bubbles-chars))) (insert char) @@ -1268,7 +1262,7 @@ Use optional parameter POS instead of point if given." (while (get-text-property (point) 'removed) (setq shifted-cols (1+ shifted-cols)) (bubbles--shift 'right (1- (bubbles--grid-height)) j)) - (dotimes (k shifted-cols) + (dotimes (_ shifted-cols) (let ((i (- (bubbles--grid-height) 2))) (while (>= i 0) (setq shifted (or (bubbles--shift 'right i j) @@ -1334,11 +1328,11 @@ Return t if new char is non-empty." (when (and (display-images-p) (not (eq bubbles-graphics-theme 'ascii))) (let ((template (pcase bubbles-graphics-theme - (`circles bubbles--image-template-circle) - (`balls bubbles--image-template-ball) - (`squares bubbles--image-template-square) - (`diamonds bubbles--image-template-diamond) - (`emacs bubbles--image-template-emacs)))) + ('circles bubbles--image-template-circle) + ('balls bubbles--image-template-ball) + ('squares bubbles--image-template-square) + ('diamonds bubbles--image-template-diamond) + ('emacs bubbles--image-template-emacs)))) (setq bubbles--empty-image (create-image (replace-regexp-in-string "^\"\\(.*\\)\t.*c .*\",$" @@ -1422,8 +1416,8 @@ Return t if new char is non-empty." (goto-char (point-min)) (forward-line 1) (let ((inhibit-read-only t)) - (dotimes (i (bubbles--grid-height)) - (dotimes (j (bubbles--grid-width)) + (dotimes (_ (bubbles--grid-height)) + (dotimes (_ (bubbles--grid-width)) (forward-char 1) (let ((index (or (get-text-property (point) 'index) -1))) (let ((img bubbles--empty-image)) diff --git a/lisp/play/cookie1.el b/lisp/play/cookie1.el index 165b86d037c..e461b37e362 100644 --- a/lisp/play/cookie1.el +++ b/lisp/play/cookie1.el @@ -125,7 +125,8 @@ and subsequent calls on the same file won't go to disk." (setq phrase-file (cookie-check-file phrase-file)) (let ((sym (intern-soft phrase-file cookie-cache))) (and sym (not (equal (symbol-function sym) - (nth 5 (file-attributes phrase-file)))) + (file-attribute-modification-time + (file-attributes phrase-file)))) (yes-or-no-p (concat phrase-file " has changed. Read new contents? ")) (setq sym nil)) @@ -133,7 +134,8 @@ and subsequent calls on the same file won't go to disk." (symbol-value sym) (setq sym (intern phrase-file cookie-cache)) (if startmsg (message "%s" startmsg)) - (fset sym (nth 5 (file-attributes phrase-file))) + (fset sym (file-attribute-modification-time + (file-attributes phrase-file))) (let (result) (with-temp-buffer (insert-file-contents (expand-file-name phrase-file)) diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el index 49e2b877d4d..0a9ab37d198 100644 --- a/lisp/play/dunnet.el +++ b/lisp/play/dunnet.el @@ -2349,7 +2349,6 @@ for a moment, then straighten yourself up.\n") ;;;; 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") diff --git a/lisp/play/fortune.el b/lisp/play/fortune.el index 4488bb9c6ec..3c057f41497 100644 --- a/lisp/play/fortune.el +++ b/lisp/play/fortune.el @@ -313,6 +313,8 @@ Optional FILE is a fortune file from which a cookie will be selected." (with-temp-buffer (let ((fortune-buffer-name (current-buffer))) (fortune-in-buffer t file) + ;; Avoid trailing newline. + (if (bolp) (delete-char -1)) (message "%s" (buffer-string))))) ;;;###autoload diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el index 7999194207b..54eeafd2b53 100644 --- a/lisp/play/gamegrid.el +++ b/lisp/play/gamegrid.el @@ -1,4 +1,4 @@ -;;; gamegrid.el --- library for implementing grid-based games on Emacs +;;; gamegrid.el --- library for implementing grid-based games on Emacs -*- lexical-binding:t -*- ;; Copyright (C) 1997-1998, 2001-2019 Free Software Foundation, Inc. @@ -86,49 +86,157 @@ directory will be used.") (defvar gamegrid-mono-x-face nil) (defvar gamegrid-mono-tty-face nil) -;; ;;;;;;;;;;;;; constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defvar gamegrid-glyph-height-mm 7.0 + "Desired glyph height in mm.") -(defconst gamegrid-glyph-height 16) +;; ;;;;;;;;;;;;; glyph generation ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defconst gamegrid-xpm "\ +(defun gamegrid-calculate-glyph-size () + "Calculate appropriate glyph size in pixels based on display resolution. +Return a multiple of 8 no less than 16." + (if (and (display-pixel-height) (display-mm-height)) + (let* ((y-pitch (/ (display-pixel-height) (float (display-mm-height)))) + (pixels (* y-pitch gamegrid-glyph-height-mm)) + (rounded (* (floor (/ (+ pixels 4) 8)) 8))) + (max 16 rounded)) + 16)) + +;; Example of glyph in XPM format: +;; +;; /* XPM */ +;; static char *noname[] = { +;; /* width height ncolors chars_per_pixel */ +;; \"16 16 3 1\", +;; /* colors */ +;; \"+ s col1\", +;; \". s col2\", +;; \"- s col3\", +;; /* pixels */ +;; \"---------------+\", +;; \"--------------++\", +;; \"--............++\", +;; \"--............++\", +;; \"--............++\", +;; \"--............++\", +;; \"--............++\", +;; \"--............++\", +;; \"--............++\", +;; \"--............++\", +;; \"--............++\", +;; \"--............++\", +;; \"--............++\", +;; \"--............++\", +;; \"-+++++++++++++++\", +;; \"++++++++++++++++\" +;; }; + +(defun gamegrid-xpm () + "Generate the XPM format image used for each square." + (let* ((glyph-pixel-count (gamegrid-calculate-glyph-size)) + (border-pixel-count (/ glyph-pixel-count 8)) + (center-pixel-count (- glyph-pixel-count (* border-pixel-count 2)))) + (with-temp-buffer + (insert (format "\ /* XPM */ static char *noname[] = { /* width height ncolors chars_per_pixel */ -\"16 16 3 1\", +\"%s %s 3 1\", /* colors */ \"+ s col1\", \". s col2\", \"- s col3\", /* pixels */ -\"---------------+\", -\"--------------++\", -\"--............++\", -\"--............++\", -\"--............++\", -\"--............++\", -\"--............++\", -\"--............++\", -\"--............++\", -\"--............++\", -\"--............++\", -\"--............++\", -\"--............++\", -\"--............++\", -\"-+++++++++++++++\", -\"++++++++++++++++\" -}; -" - "XPM format image used for each square") - -(defvar gamegrid-xbm "\ +" glyph-pixel-count glyph-pixel-count)) + + (dotimes (row border-pixel-count) + (let ((edge-pixel-count (+ row 1))) + (insert "\"") + (dotimes (_ (- glyph-pixel-count edge-pixel-count)) (insert "-")) + (dotimes (_ edge-pixel-count) (insert "+")) + (insert "\",\n"))) + + (let ((middle (format "\"%s%s%s\",\n" + (make-string border-pixel-count ?-) + (make-string center-pixel-count ?.) + (make-string border-pixel-count ?+)))) + (dotimes (_ center-pixel-count) (insert middle))) + + (dotimes (row border-pixel-count) + (let ((edge-pixel-count (- border-pixel-count row 1))) + (insert "\"") + (dotimes (_ edge-pixel-count) (insert "-")) + (dotimes (_ (- glyph-pixel-count edge-pixel-count)) (insert "+")) + (insert "\"") + (if (/= row (1- border-pixel-count)) + (insert ",\n") + (insert "\n};\n")))) + (buffer-string)))) + +;; Example of glyph in XBM format: +;; +;; /* gamegrid XBM */ +;; #define gamegrid_width 16 +;; #define gamegrid_height 16 +;; static unsigned char gamegrid_bits[] = { +;; 0xff, 0xff, 0xff, 0x7f, 0xff, 0x3f, 0xaf, 0x0a, 0x57, 0x15, 0xaf, 0x0a, +;; 0x57, 0x15, 0xaf, 0x0a, 0x57, 0x15, 0xaf, 0x0a, 0x57, 0x15, 0xaf, 0x0a, +;; 0x57, 0x15, 0x07, 0x00, 0x03, 0x00, 0x01, 0x00 }; + +(defun gamegrid-xbm () + "Generate XBM format image used for each square." + (let* ((glyph-pixel-count (gamegrid-calculate-glyph-size)) + (border-pixel-count (1- (/ glyph-pixel-count 4))) + (center-pixel-count (- glyph-pixel-count (* 2 border-pixel-count)))) + (with-temp-buffer + (insert (format "\ /* gamegrid XBM */ -#define gamegrid_width 16 -#define gamegrid_height 16 +#define gamegrid_width %s +#define gamegrid_height %s static unsigned char gamegrid_bits[] = { - 0xff, 0xff, 0xff, 0x7f, 0xff, 0x3f, 0xaf, 0x0a, 0x57, 0x15, 0xaf, 0x0a, - 0x57, 0x15, 0xaf, 0x0a, 0x57, 0x15, 0xaf, 0x0a, 0x57, 0x15, 0xaf, 0x0a, - 0x57, 0x15, 0x07, 0x00, 0x03, 0x00, 0x01, 0x00 };" - "XBM format image used for each square.") +" glyph-pixel-count glyph-pixel-count)) + (dotimes (row border-pixel-count) + (gamegrid-insert-xbm-bits + (concat (make-string (- glyph-pixel-count row) ?1) + (make-string row ?0))) + (insert ", \n")) + + (let* ((left-border (make-string border-pixel-count ?1)) + (right-border (make-string border-pixel-count ?0)) + (even-line (apply 'concat + (append (list left-border) + (make-list (/ center-pixel-count 2) "10") + (list right-border)))) + (odd-line (apply 'concat + (append (list left-border) + (make-list (/ center-pixel-count 2) "01") + (list right-border))))) + (dotimes (row center-pixel-count) + (gamegrid-insert-xbm-bits (if (eq (logand row 1) 1) odd-line even-line)) + (insert ", \n"))) + + (dotimes (row border-pixel-count) + (let ((edge-pixel-count (- border-pixel-count row))) + (gamegrid-insert-xbm-bits + (concat (make-string edge-pixel-count ?1) + (make-string (- glyph-pixel-count edge-pixel-count) ?0)))) + (if (/= row (1- border-pixel-count)) + (insert ", \n") + (insert " };\n"))) + (buffer-string)))) + +(defun gamegrid-insert-xbm-bits (str) + "Convert binary to hex and insert in current buffer. +STR should be a string composed of 1s and 0s and be a multiple of +8 in length. Divide it into 8 bit bytes, reverse the order of +each, convert them to hex and insert them in comma separated C +format." + (let ((byte-count (/ (length str) 8))) + (dotimes (i byte-count) + (let* ((byte (reverse (substring str (* i 8) (+ (* i 8) 8)))) + (value (string-to-number byte 2))) + (insert (format "0x%02x" value)) + (unless (= i (1- byte-count)) + (insert ", ")))))) ;; ;;;;;;;;;;;;;;;; miscellaneous functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -210,31 +318,31 @@ static unsigned char gamegrid_bits[] = { (let ((data (gamegrid-match-spec-list data-spec-list)) (color (gamegrid-match-spec-list color-spec-list))) (pcase data - (`color-x + ('color-x (gamegrid-make-color-x-face color)) - (`grid-x + ('grid-x (unless gamegrid-grid-x-face (setq gamegrid-grid-x-face (gamegrid-make-grid-x-face))) gamegrid-grid-x-face) - (`mono-x + ('mono-x (unless gamegrid-mono-x-face (setq gamegrid-mono-x-face (gamegrid-make-mono-x-face))) gamegrid-mono-x-face) - (`color-tty + ('color-tty (gamegrid-make-color-tty-face color)) - (`mono-tty + ('mono-tty (unless gamegrid-mono-tty-face (setq gamegrid-mono-tty-face (gamegrid-make-mono-tty-face))) gamegrid-mono-tty-face)))) (defun gamegrid-colorize-glyph (color) - (find-image `((:type xpm :data ,gamegrid-xpm + (find-image `((:type xpm :data ,(gamegrid-xpm) :ascent center :color-symbols (("col1" . ,(gamegrid-color color 0.6)) ("col2" . ,(gamegrid-color color 0.8)) ("col3" . ,(gamegrid-color color 1.0)))) - (:type xbm :data ,gamegrid-xbm + (:type xbm :data ,(gamegrid-xbm) :ascent center :foreground ,(gamegrid-color color 1.0) :background ,(gamegrid-color color 0.5))))) @@ -376,7 +484,7 @@ static unsigned char gamegrid_bits[] = { (buffer-read-only nil)) (erase-buffer) (setq gamegrid-buffer-start (point)) - (dotimes (i height) + (dotimes (_ height) (insert line)) ;; Adjust the height of the default face to the height of the ;; images. Unlike XEmacs, Emacs doesn't allow making the default @@ -449,7 +557,7 @@ On non-POSIX systems Emacs searches for FILE in the directory specified by the variable `temporary-file-directory'. If necessary, FILE is created there." (pcase system-type - ((or `ms-dos `windows-nt) + ((or 'ms-dos 'windows-nt) (gamegrid-add-score-insecure file score)) (_ (gamegrid-add-score-with-update-game-score file score)))) @@ -457,8 +565,8 @@ FILE is created there." ;; On POSIX systems there are four cases to distinguish: -;; 1. FILE is an absolute filename. Then it should be a file in -;; temporary file directory. This is the way, +;; 1. FILE is an absolute filename or "update-game-score" does not exist. +;; Then FILE should be a file in a temporary file directory. This is how ;; `gamegrid-add-score' was supposed to be used in the past and ;; is covered here for backward-compatibility. ;; @@ -475,21 +583,18 @@ FILE is created there." ;; update FILE. This is for the case that a user has installed ;; a game on her own. ;; -;; 4. "update-game-score" does not exist or is not setgid/setuid. -;; Create/update FILE in the user's home directory, without -;; using "update-game-score". There is presumably no shared -;; game directory. +;; 4. "update-game-score" is not setgid/setuid. Use it to +;; create/update FILE in the user's home directory. There is +;; presumably no shared game directory. (defvar gamegrid-shared-game-dir) (defun gamegrid-add-score-with-update-game-score (file score) - (let ((gamegrid-shared-game-dir - (not (zerop (logand (or (file-modes - (expand-file-name "update-game-score" - exec-directory)) - 0) - #o6000))))) - (cond ((file-name-absolute-p file) + (let* ((update-game-score-modes + (file-modes (expand-file-name "update-game-score" exec-directory))) + (gamegrid-shared-game-dir + (not (zerop (logand #o6000 (or update-game-score-modes 0)))))) + (cond ((or (not update-game-score-modes) (file-name-absolute-p file)) (gamegrid-add-score-insecure file score)) ((and gamegrid-shared-game-dir (file-exists-p (expand-file-name file shared-game-score-directory))) @@ -499,12 +604,23 @@ FILE is created there." (expand-file-name file shared-game-score-directory) score)) ;; Else: Add the score to a score file in the user's home ;; directory. - (t + (gamegrid-shared-game-dir + ;; If gamegrid-shared-game-dir is non-nil the + ;; "update-gamescore" program is setuid, so don't use it. (unless (file-exists-p (directory-file-name gamegrid-user-score-file-directory)) (make-directory gamegrid-user-score-file-directory t)) (gamegrid-add-score-insecure file score - gamegrid-user-score-file-directory))))) + gamegrid-user-score-file-directory)) + (t + (unless (file-exists-p + (directory-file-name gamegrid-user-score-file-directory)) + (make-directory gamegrid-user-score-file-directory t)) + (let ((f (expand-file-name file + gamegrid-user-score-file-directory))) + (unless (file-exists-p f) + (write-region "" nil f nil 'silent nil 'excl)) + (gamegrid-add-score-with-update-game-score-1 file f score)))))) (defun gamegrid-add-score-with-update-game-score-1 (file target score) (let ((default-directory "/") @@ -547,6 +663,7 @@ FILE is created there." (revert-buffer nil t nil) (display-buffer buf)) (find-file-read-only target)) + (view-mode) (goto-char (point-min)) (search-forward (concat (int-to-string score) " " (user-login-name) " " @@ -575,7 +692,8 @@ FILE is created there." (forward-line gamegrid-score-file-length) (delete-region (point) (point-max)) (setq buffer-read-only t) - (save-buffer))) + (save-buffer) + (view-mode))) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/lisp/play/gametree.el b/lisp/play/gametree.el index d92914d9118..c0226c85ce1 100644 --- a/lisp/play/gametree.el +++ b/lisp/play/gametree.el @@ -586,8 +586,7 @@ shogi, etc.) players, it is a slightly modified version of Outline mode. \\{gametree-mode-map}" (auto-fill-mode 0) - (make-local-variable 'write-contents-hooks) - (add-hook 'write-contents-hooks 'gametree-save-and-hack-layout)) + (add-hook 'write-contents-functions 'gametree-save-and-hack-layout nil t)) ;;;; Goodies for mousing users (defun gametree-mouse-break-line-here (event) diff --git a/lisp/play/gomoku.el b/lisp/play/gomoku.el index b16938a56d0..6d5553b3202 100644 --- a/lisp/play/gomoku.el +++ b/lisp/play/gomoku.el @@ -656,48 +656,48 @@ that DVAL has been added on SQUARE." ((eq result 'emacs-won) (setq gomoku-number-of-emacs-wins (1+ gomoku-number-of-emacs-wins)) (cond ((< gomoku-number-of-moves 20) - "This was a REALLY QUICK win.") + "I won... I hope you like the game as you get better.") (gomoku-human-refused-draw "I won... Too bad you refused my offer of a draw!") (gomoku-human-took-back - "I won... Taking moves back will not help you!") + "I won... It's OK to take back more moves next time.") ((not gomoku-emacs-played-first) - "I won... Playing first did not help you much!") + "I won... Use C-c C-b to take back a move on second thought.") ((and (zerop gomoku-number-of-human-wins) (zerop gomoku-number-of-draws) (> gomoku-number-of-emacs-wins 1)) - "I'm becoming tired of winning...") + "I won... It might be time take a break before trying again.") ("I won."))) ((eq result 'human-won) (setq gomoku-number-of-human-wins (1+ gomoku-number-of-human-wins)) (concat "OK, you won this one." (cond (gomoku-human-took-back - " I, for one, never take my moves back...") + " For a bigger challenge, play without taking moves back.") (gomoku-emacs-played-first - ".. so what?") - (" Now, let me play first just once.")))) + " Congratulations!") + (" For a bigger challenge, let me play first.")))) ((eq result 'human-resigned) (setq gomoku-number-of-emacs-wins (1+ gomoku-number-of-emacs-wins)) - "So you resign. That's just one more win for me.") + "I see that you resigned. Better luck next time.") ((eq result 'nobody-won) (setq gomoku-number-of-draws (1+ gomoku-number-of-draws)) (concat "This is a draw. " (cond (gomoku-human-took-back - "I, for one, never take my moves back...") + " For a bigger challenge, try without taking moves back.") (gomoku-emacs-played-first - "Just chance, I guess.") - ("Now, let me play first just once.")))) + "Wow, that was a long game. We both played well.") + (" For a bigger challenge, let me play first.")))) ((eq result 'draw-agreed) (setq gomoku-number-of-draws (1+ gomoku-number-of-draws)) (concat "Draw agreed. " (cond (gomoku-human-took-back - "I, for one, never take my moves back...") + " For a bigger challenge, try without taking moves back.") (gomoku-emacs-played-first - "You were lucky.") - ("Now, let me play first just once.")))) + "Good game.") + (" For a bigger challenge, let me play first.")))) ((eq result 'crash-game) "Sorry, I have been interrupted and cannot resume that game..."))) (gomoku-display-statistics) diff --git a/lisp/play/hanoi.el b/lisp/play/hanoi.el index 635e4a95bc3..d762290f0da 100644 --- a/lisp/play/hanoi.el +++ b/lisp/play/hanoi.el @@ -381,7 +381,7 @@ BITS must be of length nrings. Start at START-TIME." (cl-loop for elapsed = (- (float-time) start-time) while (< elapsed hanoi-move-period) with tick-period = (/ (float hanoi-move-period) total-ticks) - for tick = (ceiling (/ elapsed tick-period)) do + for tick = (ceiling elapsed tick-period) do (hanoi-ring-to-pos ring (funcall tick-to-pos tick)) (hanoi-sit-for (- (* tick tick-period) elapsed))) (cl-loop for tick from 1 to total-ticks by 2 do diff --git a/lisp/play/tetris.el b/lisp/play/tetris.el index 1e0681d7ff1..a797a26d597 100644 --- a/lisp/play/tetris.el +++ b/lisp/play/tetris.el @@ -277,6 +277,7 @@ each one of its four blocks.") (defvar tetris-null-map (let ((map (make-sparse-keymap 'tetris-null-map))) (define-key map "n" 'tetris-start-game) + (define-key map "q" 'quit-window) map)) ;; ;;;;;;;;;;;;;;;; game functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |