From: Tino Calancha <tino.calancha@gmail.com>
To: Emacs developers <emacs-devel@gnu.org>
Cc: Tino Calancha <tino.calancha@gmail.com>
Subject: Minesweeper game for Emacs
Date: Mon, 6 Nov 2017 21:10:14 +0900 (JST) [thread overview]
Message-ID: <alpine.DEB.2.20.1711062108560.17869@calancha-pc> (raw)
[-- Attachment #1: Type: text/plain, Size: 24738 bytes --]
Hi,
this is an elisp version of the classical minesweeper game.
Is of any interest to include this in Emacs? Or should go
to ELPA instead?
Thank you
Tino
--8<-----------------------------cut here---------------start------------->8---
;;; mines.el --- Minesweeper game -*- lexical-binding: t -*-
;; Copyright (C) 2017 Tino Calancha
;; Author: Tino Calancha <tino.calancha@gmail.com>
;; Maintainer: Tino Calancha <tino.calancha@gmail.com>
;; Created: 2017-10-28
;; Keywords: games
;; Version: 1.0
;; Package-Requires: ((emacs "24.3") (cl-lib "0.5"))
;; url: https://github.com/calancha/Minesweeper
;; This file is NOT part of GNU Emacs.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This is an elisp implementation of the classical minesweeper game.
;; The target is localize all hidden mines (bombs) in a rectangular board
;; without detonating them. You reveal the content of a cell with the
;; command `mines-dig'.
;;
;; 1. Cells with a bomb contain the character 'x'; if you call `mines-dig'
;; in these cells then you lost the game.
;; 2. Cells without bomb at distance 1 from any cell with a mine
;; contain a number: the number of bombs at distance 1 from this cell.
;; If you reveal the content of this cell, then this number is shown.
;;
;; 3. Cells without a bomb at distance > 1 from any bomb contain '@'.
;; If you reveal the content of this cell, then '@' is shown and
;; all adjacent cells are recursively revealed.
;;
;;
;; If you think that an uncovered cell has a mine, you might flag it
;; with `mines-flag-cell'; if you call this command again in the same
;; cell the cell is unflagged. This is useful to visualize your
;; progress in the game.
;;
;; The game is completed once all mine-free cells are revealed, that is,
;; when the only uncovered cells equals the number of hidden mines.
;;
;;; Code:
(require 'gamegrid)
(require 'cl-lib)
(require 'cookie1) ; For `cookie-shuffle-vector'.
;;; Internal variables.
(defgroup mines nil
"Play minessweeper."
:group 'games
:prefix "mines-")
(defcustom mines-protect-first-move t
"Non-nil avoid game over in the first cell revealed."
:type 'boolean
:version "27.1")
(defcustom mines-mode-hook nil
"Hook run by mines mode."
:type 'hook
:group 'mines
:version "27.1")
(defvar mines-uncover-cell-char ?.
"Char to display uncover cells.")
(defvar mines-flagged-cell-char ?!
"Char to display flagged cells as maybe having a mine.")
(defvar mines-empty-cell-char ?@
"Char to display a cell without mine nor numbers.")
(defvar mines-empty-cell-mine ?x
"Char to display a cell with a mine.")
(defvar mines-buffer nil "Buffer where play minesweeper.")
(defvar mines-start-pos 2 "Initial prompt position.")
(defvar mines-number-mines 10 "Number of mines.")
(defvar mines-number-rows 8 "Nmber of rows.")
(defvar mines-number-cols 8 "Number of columns.")
(defvar mines-number-cells (* mines-number-rows mines-number-cols)
"Number of cells.")
(defcustom mines-difficulty-level 'easy
"Level of difficulty.
If `easy' we have 8 columns x 8 columns and 10 mines.
If `medium' we have 16 columns x 16 columns and 40 mines.
If `hard' we have 30 columns x 16 columns and 99 mines.
If `custom' then ask user for these numbers."
:type '(choice (const :tag "Easy" easy)
(const :tag "Medium" medium)
(const :tag "Hard" hard)
(const :tag "Custom" custom))
:group 'games
:set (lambda (sym val)
(if (not (eq val 'custom))
(set sym val)
(setq mines-number-cols (read-number "Number of columns: ")
mines-number-rows (read-number "Number of rows: ")
mines-number-mines (read-number "Number of mines: "))
(set sym val)))
:version "27.1")
(defvar mines-grid (make-vector mines-number-cells nil)
"Game configuration.")
(defvar mines-state (make-vector mines-number-cells nil)
"Game state.")
(defvar mines-mine-positions nil "Mine positions.")
(defvar mines-gap-positions nil "Empty cell positions.")
(defvar mines-init-time nil "Initial time of the game.")
(defvar mines-end-time nil "End time of the game.")
(defvar mines-undone-neighbours nil
"List of uncovered neighbours for the current cell.")
(defvar-local mines-game-over nil
"Non-nil if the game in current buffer has ended.")
(defmacro mines-init (cond1 cond2 cond3 cond4 &rest body)
(declare (debug (form form form form &rest body)))
`(progn
(cond (,cond1
(setq mines-number-cols 8
mines-number-rows 8
mines-number-mines 10
mines-difficulty-level 'easy))
(,cond2
(setq mines-number-cols 16
mines-number-rows 16
mines-number-mines 40
mines-difficulty-level 'medium))
(,cond3
(setq mines-number-cols 30
mines-number-rows 16
mines-number-mines 99
mines-difficulty-level 'hard))
(,cond4 (setq mines-difficulty-level 'custom) ,@body))
(setq mines-number-cells (* mines-number-rows mines-number-cols))))
;;; Moving.
(defun mines-index-2-matrix (idx)
"Translate 1-D array index into 2-D matrix indices."
(let* ((col (% idx mines-number-cols))
(row (/ idx mines-number-cols)))
(list row col)))
(defun mines-matrix-2-index (row col)
"Translate 2-D matrix indices into 1-D array index."
(+ col (* row mines-number-cols)))
(defun mines-get-neighbours (idx)
"Return cell neighbour indices for cell at IDX."
(let* ((row-col (mines-index-2-matrix idx))
(row (car row-col))
(col (cadr row-col))
res)
(cl-flet ((add-fn (to-row)
(or (= row to-row) (push (list to-row col) res))
(and (< col (1- mines-number-cols))
(push (list to-row (1+ col)) res))
(or (zerop col) (push (list to-row (1- col)) res))))
(progn
(add-fn row) ; Horizontal neighburs.
(unless (zerop row) (add-fn (1- row))) ; Up neighbours.
(when (< row (1- mines-number-rows)) ; Below neighbours.
(add-fn (1+ row)))))
(mapcar (lambda (x) (mines-matrix-2-index (car x) (cadr x))) res)))
(defun mines-goto (idx)
"Move to cell at IDX."
(goto-char 1)
(let ((cidx (mines-current-pos)))
(ignore-errors
(while (not (= cidx idx))
(goto-char (next-single-property-change (point) 'idx))
(setq cidx (mines-current-pos)))
(goto-char (1+ (point))))))
(defun mines-go-right ()
"Move 1 cell to the right."
(interactive)
(if (= (point) (point-max))
(progn
(forward-line -1)
(goto-char (1+ (point))))
(let* ((idx (mines-current-pos))
(row-col (mines-index-2-matrix idx))
(row (car row-col))
(col (cadr row-col)))
(if (= col (1- mines-number-cols))
(mines-goto (apply #'mines-matrix-2-index (list row 0)))
(mines-goto (1+ (mines-current-pos)))))))
(defun mines-go-left ()
"Move 1 cell to the left."
(interactive)
(if (= (point) (point-max))
(goto-char (1- (point)))
(let* ((idx (mines-current-pos))
(row-col (mines-index-2-matrix idx))
(row (car row-col))
(col (cadr row-col)))
(if (zerop col)
(mines-goto (apply #'mines-matrix-2-index
(list row (1- mines-number-cols))))
(mines-goto (1- (mines-current-pos)))))))
(defun mines-go-down ()
"Move to the cell under the current one."
(interactive)
(if (= (point) (point-max))
(goto-char mines-start-pos)
(let* ((idx (mines-current-pos))
(row-col (mines-index-2-matrix idx))
(row (car row-col))
(col (cadr row-col)))
(if (= row (1- mines-number-rows))
(mines-goto (apply #'mines-matrix-2-index (list 0 col)))
(mines-goto (apply #'mines-matrix-2-index (list (1+ row) col)))))))
(defun mines-go-up ()
"Move to the cell over the current one."
(interactive)
(if (= (point) (point-max))
(progn
(forward-line -1)
(goto-char (1+ (point))))
(let* ((idx (mines-current-pos))
(row-col (mines-index-2-matrix idx))
(row (car row-col))
(col (cadr row-col)))
(if (zerop row)
(mines-goto (apply #'mines-matrix-2-index (list (1- mines-number-rows) col)))
(mines-goto (apply #'mines-matrix-2-index (list (1- row) col)))))))
;;; Main Functions.
(defun mines--find-pos (elt vec)
(let ((pos 0) res)
(while (setq pos
(cl-position-if
(lambda (x)
(cond ((null elt)
;; Check if the cell is empty or flagged.
(or (null x) (eq mines-flagged-cell-char x)))
(t (eq elt x))))
vec :start pos))
(push pos res)
(cl-incf pos))
(nreverse res)))
(defun mines-start ()
"Set mine positions for a new game."
;; Erase vector.
(setq mines-grid (make-vector mines-number-cells nil))
(setq mines-state (make-vector mines-number-cells nil))
(let ((numbers (append
(cookie-shuffle-vector
(vconcat (number-sequence 0 (1- mines-number-cells)))) nil)))
(dotimes (_ mines-number-mines)
(aset mines-grid (pop numbers) t))
(setq mines-mine-positions (mines--find-pos t mines-grid))))
(defun mines--near-bombs (i j)
(let ((numb 0))
;; Horizontal neighbours.
(when (> j 0)
(and (aref mines-grid (mines-matrix-2-index i (1- j))) (cl-incf numb)))
(when (< j (1- mines-number-cols))
(and (aref mines-grid (mines-matrix-2-index i (1+ j))) (cl-incf numb)))
;; Previous row neighbours.
(when (> i 0)
(and (aref mines-grid (mines-matrix-2-index (1- i) j)) (cl-incf numb))
(when (> j 0)
(and (aref mines-grid (mines-matrix-2-index (1- i) (1- j))) (cl-incf numb)))
(when (< j (1- mines-number-cols))
(and (aref mines-grid (mines-matrix-2-index (1- i) (1+ j))) (cl-incf numb))))
;; Next row neighbours.
(when (< i (1- mines-number-rows))
(and (aref mines-grid (mines-matrix-2-index (1+ i) j)) (cl-incf numb))
(when (> j 0)
(and (aref mines-grid (mines-matrix-2-index (1+ i) (1- j))) (cl-incf numb)))
(when (< j (1- mines-number-cols))
(and (aref mines-grid (mines-matrix-2-index (1+ i) (1+ j))) (cl-incf numb))))
numb))
(defun mines-set-numbers ()
"Set numbers for cells adjacent to cells with bombs."
(let ((tmp-grid (copy-sequence mines-grid)))
(dotimes (i mines-number-rows)
(dotimes (j mines-number-cols)
(let ((idx (mines-matrix-2-index i j)))
(unless (aref mines-grid idx)
(let ((numb (mines--near-bombs i j)))
(unless (zerop numb) (aset tmp-grid idx numb)))))))
(setq mines-grid tmp-grid)))
(defun mines-list-game-conditions ()
"Return number of rows, columns and mines for current game."
(interactive)
(when (mines-mines-mode-p)
(let ((rows mines-number-rows)
(cols mines-number-cols)
(mines mines-number-mines))
(message "%d rows x %d columns with %d mines"
rows cols mines)
(list rows cols mines))))
(defun mines--insert (elt idx &optional props null-str flag-or-unflag)
(let* ((face nil)
(str (cond ((null elt)
(if (null null-str)
(format " %c " mines-uncover-cell-char)
;; Uncover all its uncovered neighbours.
(save-excursion
(dolist (x (mines-get-neighbours idx))
(mines-goto x)
(unless (get-text-property (point) 'done)
(push x mines-undone-neighbours))))
(format " %s " null-str)))
((eq flag-or-unflag 'unflag)
(format " %c " mines-uncover-cell-char))
((and (memq 'flag props) (eq flag-or-unflag 'flag))
(setq face 'warning)
(format " %c " mines-flagged-cell-char))
((integerp elt) (format " %d " elt))
(t (format " %c " mines-empty-cell-mine))))
(pos (point))
(inhibit-read-only t))
(if face
(insert (propertize str 'font-lock-face face))
(insert str))
(when (= (cadr (mines-index-2-matrix idx)) (1- mines-number-cols))
(backward-delete-char 1)
(insert "\n"))
(add-text-properties pos (point) props)
(goto-char (1+ (point)))))
(defun mines-show ()
"Display the board for a new game."
(with-current-buffer (or (and (buffer-live-p mines-buffer) mines-buffer)
(setq mines-buffer (get-buffer-create "*Mines*")))
(read-only-mode 1)
(setq mines-game-over nil)
(let ((inhibit-read-only t))
(erase-buffer)
(unless (derived-mode-p 'mines-mode)
(mines-mode))
(dotimes (i mines-number-rows)
(dotimes (j mines-number-cols)
(let* ((idx (+ (* i mines-number-cols) j))
(elt (aref mines-state idx))
(pos (point)))
(mines--insert elt idx)
(put-text-property pos (point) 'idx idx)
(when (= j (1- mines-number-cols))
(delete-char -1)
(insert "\n"))
(put-text-property (1- (point)) (point) 'idx idx))))))
(display-buffer mines-buffer '(display-buffer-same-window))
(set-window-point (get-buffer-window mines-buffer) mines-start-pos))
(defun mines-current-pos ()
"Return the index of the cell at point."
(get-text-property (point) 'idx))
(defun mines--show-all ()
"Show all mines after game over."
(dolist (to mines-mine-positions)
(save-excursion
(mines-goto to)
;; Drop all flags before show the mines; that drop the flag faces.
(when (eq (following-char) mines-flagged-cell-char)
(mines--update-cell to mines-uncover-cell-char 'unflag))
(mines-dig 'show-mines))))
(defun mines-game-over ()
"Offer play a new game after uncover a bomb."
(let ((inhibit-read-only t))
(put-text-property (point) (1+ (point)) 'face 'error)
(mines--show-all)
(if (yes-or-no-p "Game over! Play again? ")
(mines)
(setq mines-game-over t))))
(defun mines-game-completed ()
(setq mines-end-time (current-time))
(let* ((score (time-to-seconds
(time-subtract mines-end-time mines-init-time)))
(elapsed-time (format-seconds "%Y, %D, %H, %M, %z%S"
score)))
;; save score
(gamegrid-add-score (format "mines-rows-%d-cols-%d-mines-%d-scores"
mines-number-rows
mines-number-cols
mines-number-mines)
score)
(message (format "Well done %s, you have completed it in %s!"
user-login-name elapsed-time))))
(defun mines-flag-cell ()
"Flag current cell as having a mine.
If called again then unflag it."
(interactive)
(let* ((idx (mines-current-pos))
(done (get-text-property (point) 'done))
(flagged (get-text-property (point) 'flag)))
(unless idx (user-error "Wrong position!"))
(unless done
(cond (flagged
(mines--update-cell idx mines-uncover-cell-char 'unflag))
(t (mines--update-cell idx mines-flagged-cell-char 'flag))))))
(defun mines--update-cell (idx elt &optional flag-or-unflag)
(if (zerop idx)
(goto-char 1)
(goto-char (previous-single-property-change (point) 'idx)))
(let ((to (or (next-single-property-change (point) 'idx) (point-max)))
(prop (append (text-properties-at (point))
(if flag-or-unflag
`(flag ,(eq flag-or-unflag 'flag))
'(done t))))
(inhibit-read-only t))
(when (eq flag-or-unflag 'unflag)
(setq prop `(idx ,idx)))
;; If unflagging, then remove additional text properties.
(when (eq flag-or-unflag 'unflag)
(remove-text-properties (point) to '(font-lock-face flag)))
(delete-region (point) to)
(mines--insert elt idx prop (string mines-empty-cell-char) flag-or-unflag)
(unless flag-or-unflag (aset mines-state idx '@))
(mines-goto idx)))
(defun mines-dig (&optional show-mines)
"Reveal the content of the cell at point."
(interactive)
(when (mines-mines-mode-p)
(if mines-game-over
(user-error "Current game is over. Try `%s' to start a new one."
(substitute-command-keys "\\[mines\]"))
(skip-chars-forward "[:blank:]") ; Set point in the center of the cell.
(cl-labels ((uncover-fn
()
(let ((idx (mines-current-pos))
(inhibit-read-only t)
(done (get-text-property (point) 'done)))
(cond ((null idx) (user-error "Wrong position!"))
(done nil) ; Already updated.
(t
(let ((elt (aref mines-grid idx)))
;; Don't end the game in the first trial when
;; `mines-protect-first-move' is non-nil.
(when (and (eq elt t) mines-protect-first-move (mines-first-move-p))
(let ((ok-pos (cl-position-if-not (lambda (x) (eq t x)) mines-grid)))
(message "Avoided game over in the first move")
;; Update mine positions.
(setf (nth (cl-position idx mines-mine-positions)
mines-mine-positions) ok-pos)
;; We must update `mines-grid' further: the neighbour cells
;; to IDX must show now a lower number of near bombs; the
;; cells near the new position of the bomb must increase their
;; numbers.
(setq mines-grid (make-vector mines-number-cells nil))
;; Add the mine positions.
(dolist (pos mines-mine-positions)
(aset mines-grid pos t))
;; Update the numbers on neighbour cells.
(mines-set-numbers)
;; Update current element.
(setq elt (aref mines-grid idx))))
;; If the cell is flagged ask for confirmation.
(if (and (not show-mines) (eq (following-char) mines-flagged-cell-char))
(if (yes-or-no-p "This cell is flagged as having a bomb. Uncover it? ")
(progn ; Unflag first.
(mines--update-cell idx mines-uncover-cell-char 'unflag)
(mines--update-cell idx elt))
(message "OK, canceled"))
(mines--update-cell idx elt))
;; Check for end of game.
(cond ((and (not show-mines) (eq elt t))
;; We lost the game; show all the mines.
(mines-game-over))
(t
(when (and (not show-mines) (mines-end-p))
(mines-game-completed))))))))))
(uncover-fn)
(when mines-undone-neighbours
(while mines-undone-neighbours
(let ((to (pop mines-undone-neighbours)))
(save-excursion
(mines-goto to)
(uncover-fn)))))))))
;;;###autoload
(defun mines (&optional arg)
"Play the minesweeper game.
Called with a prefix prompt for the difficulty level.
The target of the game is discover which cells contain mines.
You reveal the content of the mine at point with \\[mines-dig\].
1. If you look at one cell containing a mine you lost.
2. A cell without a mine having N neighbour cells containing mines
shows N when you look at it.
3. A cell without a mine and without neighbour cells having mines
shows the character `@' when you look at it; all adjacent cells
are recursively revealed.
For instance, following is a possible configuration:
@ @ @ @ @
1 2 2 1 @
1 x x 1 @
1 2 2 1 @
@ @ @ @ @
You can move between cells using the arrow keys, or using vi
or emacs keystrokes (↑↓→←) = (kjlh) = (pnfb).
You can flag a cell as having a mine with \\[mines-flag-cell\]; if you
call this command again, the cell is unflagged."
(interactive
(let* ((prefix current-prefix-arg)
(choice (and prefix
(read-multiple-choice "Choose difficulty level: "
'((?e "Easy" "8 columns x 8 rows and 10 mines")
(?m "Medium" "16 columns x 16 rows and 40 mines")
(?h "Hard" "30 columns x 16 rows and 99 mines")
(?c "Custom" "C columns x R rows and M mines"))))))
(when choice
(mines-init (eq ?e (car choice))
(eq ?m (car choice))
(eq ?h (car choice))
(eq ?c (car choice))
(setq mines-number-cols (read-number "Number of columns: ")
mines-number-rows (read-number "Number of rows: ")
mines-number-mines (read-number "Number of mines: "))))
(list prefix)))
(unless arg
(mines-init (eq mines-difficulty-level 'easy)
(eq mines-difficulty-level 'medium)
(eq mines-difficulty-level 'hard)
t))
(setq mines-init-time (current-time))
(mines-start)
(mines-set-numbers)
(mines-show))
(define-derived-mode mines-mode special-mode "mines"
(let ((map mines-mode-map))
(define-key map [right] 'mines-go-right)
(define-key map "f" 'mines-go-right)
(define-key map "l" 'mines-go-right)
(define-key map [left] 'mines-go-left)
(define-key map "b" 'mines-go-left)
(define-key map "h" 'mines-go-left)
(define-key map "p" 'mines-go-up)
(define-key map "k" 'mines-go-up)
(define-key map [up] 'mines-go-up)
(define-key map [down] 'mines-go-down)
(define-key map "n" 'mines-go-down)
(define-key map "j" 'mines-go-down)
(define-key map "x" 'mines-dig)
(define-key map "c" 'mines-dig)
;; (define-key map "a" 'mines-flag-cell)
(define-key map "1" 'mines-flag-cell)
(define-key map "m" 'mines-flag-cell)
(define-key map "r" 'mines))
"Major mode for playing Minesweeper.")
;;; Predicates
(defun mines-mines-mode-p ()
"Return non-nil if the current buffer is in `mines-mode'."
(derived-mode-p 'mines-mode))
(defun mines-end-p ()
"Return non-nil when the game is completed."
(equal mines-mine-positions (mines--find-pos nil mines-state)))
(defun mines-first-move-p ()
"Return non-nil if any cell has been revealed yet."
(cl-every 'null mines-state))
(provide 'mines)
;;; mines.el ends here
--8<-----------------------------cut here---------------end--------------->8---
next reply other threads:[~2017-11-06 12:10 UTC|newest]
Thread overview: 3+ messages / expand[flat|nested] mbox.gz Atom feed top
2017-11-06 12:10 Tino Calancha [this message]
2017-11-06 14:59 ` Minesweeper game for Emacs Stefan Monnier
2017-11-06 19:58 ` John Wiegley
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=alpine.DEB.2.20.1711062108560.17869@calancha-pc \
--to=tino.calancha@gmail.com \
--cc=emacs-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).