Mercurial > emacs
view lisp/play/5x5.el @ 105829:328150f0cf76
* url-util.el (url-insert-entities-in-string):
* url-nfs.el (url-nfs-unescape):
* url-ldap.el (url-ldap):
* url-imap.el (url-imap):
* url-cid.el (url-cid-gnus, url-cid): Use with-current-buffer.
* erc.el (erc-display-line-1, erc-process-away):
* erc-truncate.el (erc-truncate-buffer-to-size):
Use with-current-buffer.
* term/ns-win.el (ns-scroll-bar-move, ns-face-at-pos):
* play/mpuz.el (mpuz-create-buffer):
* play/landmark.el (lm-prompt-for-move, lm-print-wts, lm-print-smell)
(lm-print-y,s,noise, lm-print-w0, lm-init):
* play/gomoku.el (gomoku-prompt-for-move):
* play/fortune.el (fortune-in-buffer):
* play/dissociate.el (dissociated-press):
* play/decipher.el (decipher-adjacency-list, decipher-display-regexp)
(decipher-analyze-buffer, decipher-stats-buffer,decipher-stats-buffer):
* mail/supercite.el (sc-eref-show):
* mail/smtpmail.el (smtpmail-send-it):
* mail/rmailsum.el (rmail-summary-next-labeled-message)
(rmail-summary-previous-labeled-message, rmail-summary-wipe)
(rmail-summary-undelete-many, rmail-summary-rmail-update)
(rmail-summary-goto-msg, rmail-summary-expunge)
(rmail-summary-get-new-mail, rmail-summary-search-backward)
(rmail-summary-add-label, rmail-summary-output-menu)
(rmail-summary-output-body):
* mail/rfc822.el (rfc822-addresses):
* mail/reporter.el (reporter-dump-variable, reporter-dump-state):
* mail/mailpost.el (post-mail-send-it):
* mail/hashcash.el (hashcash-generate-payment):
* mail/feedmail.el (feedmail-run-the-queue)
(feedmail-queue-send-edit-prompt-help-first)
(feedmail-send-it-immediately, feedmail-give-it-to-buffer-eater)
(feedmail-deduce-address-list):
* eshell/esh-ext.el (eshell-remote-command):
* eshell/em-unix.el (eshell-occur-mode-mouse-goto):
* emulation/viper-util.el (viper-glob-unix-files, viper-save-setting)
(viper-wildcard-to-regexp, viper-glob-mswindows-files)
(viper-save-string-in-file, viper-valid-marker):
* emulation/viper-keym.el (viper-toggle-key):
* emulation/viper-ex.el (ex-expand-filsyms, viper-get-ex-file)
(ex-edit, ex-global, ex-mark, ex-next-related-buffer, ex-quit)
(ex-get-inline-cmd-args, ex-tag, ex-command, ex-compile):
* emulation/viper-cmd.el (viper-exec-form-in-vi)
(viper-exec-form-in-emacs, viper-brac-function):
* emulation/viper.el (viper-delocalize-var):
* emulation/vip.el (vip-mode, vip-get-ex-token, vip-ex, vip-get-ex-pat)
(vip-get-ex-command, vip-get-ex-opt-gc, vip-get-ex-buffer)
(vip-get-ex-count, vip-get-ex-file, ex-edit, ex-global, ex-mark)
(ex-map, ex-unmap, ex-quit, ex-read, ex-tag, ex-command):
* emulation/vi.el (vi-switch-mode, vi-ex-cmd):
* emulation/edt.el (edt-electric-helpify):
* emulation/cua-rect.el (cua--rectangle-aux-replace):
* emulation/cua-gmrk.el (cua--insert-at-global-mark)
(cua--delete-at-global-mark, cua--copy-rectangle-to-global-mark)
(cua-indent-to-global-mark-column):
* calendar/diary-lib.el (calendar-mark-1):
* calendar/cal-hebrew.el (calendar-hebrew-mark-date-pattern):
Use with-current-buffer.
* emulation/viper.el (viper-delocalize-var): Use dolist.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Tue, 03 Nov 2009 02:04:29 +0000 |
parents | bd2966850aac |
children | 1d1d5d9bd884 |
line wrap: on
line source
;;; 5x5.el --- simple little puzzle game ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, ;; 2008, 2009 Free Software Foundation, Inc. ;; Author: Dave Pearson <davep@davep.org> ;; Maintainer: Dave Pearson <davep@davep.org> ;; Created: 1998-10-03 ;; Keywords: games puzzles ;; This file is part of GNU Emacs. ;; GNU Emacs 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. ;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>. ;;; Commentary: ;; The aim of 5x5 is to fill in all the squares. If you need any more of an ;; explanation you probably shouldn't play the game. ;;; TODO: ;; o The code for updating the grid needs to be re-done. At the moment it ;; simply re-draws the grid every time a move is made. ;; ;; o Look into tarting up the display with color. gamegrid.el looks ;; interesting, perhaps that is the way to go? ;;; Thanks: ;; Ralf Fassel <ralf@akutech.de> for his help and introduction to writing an ;; emacs mode. ;; ;; Pascal Q. Porcupine <joshagam@cs.nmsu.edu> for inspiring the animated ;; solver. ;;; Code: ;; Things we need. (eval-when-compile (require 'cl)) ;; Customize options. (defgroup 5x5 nil "5x5 - Silly little puzzle game." :group 'games :prefix "5x5-") (defcustom 5x5-grid-size 5 "Size of the playing area." :type 'integer :group '5x5) (defcustom 5x5-x-scale 4 "X scaling factor for drawing the grid." :type 'integer :group '5x5) (defcustom 5x5-y-scale 3 "Y scaling factor for drawing the grid." :type 'integer :group '5x5) (defcustom 5x5-animate-delay .01 "Delay in seconds when animating a solution crack." :type 'number :group '5x5) (defcustom 5x5-hassle-me t "Should 5x5 ask you when you want to do a destructive operation?" :type 'boolean :group '5x5) (defcustom 5x5-mode-hook nil "Hook run on starting 5x5." :type 'hook :group '5x5) ;; Non-customize variables. (defvar 5x5-grid nil "5x5 grid contents.") (defvar 5x5-x-pos 2 "X position of cursor.") (defvar 5x5-y-pos 2 "Y position of cursor.") (defvar 5x5-moves 0 "Moves made.") (defvar 5x5-cracking nil "Are we in cracking mode?") (defvar 5x5-buffer-name "*5x5*" "Name of the 5x5 play buffer.") (defvar 5x5-mode-map nil "Local keymap for the 5x5 game.") ;; Keymap. (unless 5x5-mode-map (let ((map (make-sparse-keymap))) (suppress-keymap map t) (define-key map "?" #'describe-mode) (define-key map "\r" #'5x5-flip-current) (define-key map " " #'5x5-flip-current) (define-key map [up] #'5x5-up) (define-key map [down] #'5x5-down) (define-key map [left] #'5x5-left) (define-key map [tab] #'5x5-right) (define-key map [right] #'5x5-right) (define-key map [(control a)] #'5x5-bol) (define-key map [(control e)] #'5x5-eol) (define-key map [(control p)] #'5x5-up) (define-key map [(control n)] #'5x5-down) (define-key map [(control b)] #'5x5-left) (define-key map [(control f)] #'5x5-right) (define-key map [home] #'5x5-bol) (define-key map [end] #'5x5-eol) (define-key map [prior] #'5x5-first) (define-key map [next] #'5x5-last) (define-key map "r" #'5x5-randomize) (define-key map [(control c) (control r)] #'5x5-crack-randomly) (define-key map [(control c) (control c)] #'5x5-crack-mutating-current) (define-key map [(control c) (control b)] #'5x5-crack-mutating-best) (define-key map [(control c) (control x)] #'5x5-crack-xor-mutate) (define-key map "n" #'5x5-new-game) (define-key map "q" #'5x5-quit-game) (setq 5x5-mode-map map))) ;; Menu definition. (easy-menu-define 5x5-mode-menu 5x5-mode-map "5x5 menu." '("5x5" ["New game" 5x5-new-game t] ["Random game" 5x5-randomize t] ["Quit game" 5x5-quit-game t] "---" ["Crack randomly" 5x5-crack-randomly t] ["Crack mutating current" 5x5-crack-mutating-current t] ["Crack mutating best" 5x5-crack-mutating-best t] ["Crack with xor mutate" 5x5-crack-xor-mutate t])) ;; Gameplay functions. (put '5x5-mode 'mode-class 'special) (defun 5x5-mode () "A mode for playing `5x5'. The key bindings for 5x5-mode are: \\{5x5-mode-map}" (kill-all-local-variables) (use-local-map 5x5-mode-map) (setq major-mode '5x5-mode mode-name "5x5") (run-mode-hooks '5x5-mode-hook) (setq buffer-read-only t truncate-lines t) (buffer-disable-undo)) ;;;###autoload (defun 5x5 (&optional size) "Play 5x5. The object of 5x5 is very simple, by moving around the grid and flipping squares you must fill the grid. 5x5 keyboard bindings are: \\<5x5-mode-map> Flip \\[5x5-flip-current] Move up \\[5x5-up] Move down \\[5x5-down] Move left \\[5x5-left] Move right \\[5x5-right] Start new game \\[5x5-new-game] New game with random grid \\[5x5-randomize] Random cracker \\[5x5-crack-randomly] Mutate current cracker \\[5x5-crack-mutating-current] Mutate best cracker \\[5x5-crack-mutating-best] Mutate xor cracker \\[5x5-crack-xor-mutate] Quit current game \\[5x5-quit-game]" (interactive "P") (setq 5x5-cracking nil) (when size (setq 5x5-grid-size size)) (switch-to-buffer 5x5-buffer-name) (if (or (not 5x5-grid) (not (= 5x5-grid-size (length (aref 5x5-grid 0))))) (5x5-new-game)) (5x5-draw-grid (list 5x5-grid)) (5x5-position-cursor) (5x5-mode)) (defun 5x5-new-game () "Start a new game of `5x5'." (interactive) (when (if (called-interactively-p 'interactive) (5x5-y-or-n-p "Start a new game? ") t) (setq 5x5-x-pos (/ 5x5-grid-size 2) 5x5-y-pos (/ 5x5-grid-size 2) 5x5-moves 0 5x5-grid (5x5-make-move (5x5-make-new-grid) 5x5-y-pos 5x5-x-pos)) (5x5-draw-grid (list 5x5-grid)) (5x5-position-cursor))) (defun 5x5-quit-game () "Quit the current game of `5x5'." (interactive) (kill-buffer 5x5-buffer-name)) (defun 5x5-make-new-grid () "Create and return a new `5x5' grid structure." (let ((grid (make-vector 5x5-grid-size nil))) (loop for y from 0 to (1- 5x5-grid-size) do (aset grid y (make-vector 5x5-grid-size nil))) grid)) (defun 5x5-cell (grid y x) "Return the value of the cell in GRID at location X,Y." (aref (aref grid y) x)) (defun 5x5-set-cell (grid y x value) "Set the value of cell X,Y in GRID to VALUE." (aset (aref grid y) x value)) (defun 5x5-flip-cell (grid y x) "Flip the value of cell X,Y in GRID." (5x5-set-cell grid y x (not (5x5-cell grid y x)))) (defun 5x5-copy-grid (grid) "Make a new copy of GRID." (let ((copy (5x5-make-new-grid))) (loop for y from 0 to (1- 5x5-grid-size) do (loop for x from 0 to (1- 5x5-grid-size) do (5x5-set-cell copy y x (5x5-cell grid y x)))) copy)) (defun 5x5-make-move (grid row col) "Make a move on GRID at row ROW and column COL." (5x5-flip-cell grid row col) (if (> row 0) (5x5-flip-cell grid (1- row) col)) (if (< row (- 5x5-grid-size 1)) (5x5-flip-cell grid (1+ row) col)) (if (> col 0) (5x5-flip-cell grid row (1- col))) (if (< col (- 5x5-grid-size 1)) (5x5-flip-cell grid row (1+ col))) grid) (defun 5x5-row-value (row) "Get the \"on-value\" for grid row ROW." (loop for y from 0 to (1- 5x5-grid-size) sum (if (aref row y) 1 0))) (defun 5x5-grid-value (grid) "Get the \"on-value\" for grid GRID." (loop for y from 0 to (1- 5x5-grid-size) sum (5x5-row-value (aref grid y)))) (defun 5x5-draw-grid-end () "Draw the top/bottom of the grid." (insert "+") (loop for x from 0 to (1- 5x5-grid-size) do (insert "-" (make-string 5x5-x-scale ?-))) (insert "-+ ")) (defun 5x5-draw-grid (grids) "Draw the grids GRIDS into the current buffer." (let ((buffer-read-only nil)) (erase-buffer) (loop for grid in grids do (5x5-draw-grid-end)) (insert "\n") (loop for y from 0 to (1- 5x5-grid-size) do (loop for lines from 0 to (1- 5x5-y-scale) do (loop for grid in grids do (loop for x from 0 to (1- 5x5-grid-size) do (insert (if (zerop x) "| " " ") (make-string 5x5-x-scale (if (5x5-cell grid y x) ?# ?.)))) (insert " | ")) (insert "\n"))) (loop for grid in grids do (5x5-draw-grid-end)) (insert "\n") (insert (format "On: %d Moves: %d" (5x5-grid-value (car grids)) 5x5-moves)))) (defun 5x5-position-cursor () "Position the cursor on the grid." (goto-char (point-min)) (forward-line (1+ (* 5x5-y-pos 5x5-y-scale))) (goto-char (+ (point) (* 5x5-x-pos 5x5-x-scale) (+ 5x5-x-pos 1) 1))) (defun 5x5-made-move () "Keep track of how many moves have been made." (incf 5x5-moves)) (defun 5x5-make-random-grid () "Make a random grid." (let ((grid (5x5-make-new-grid))) (loop for y from 0 to (1- 5x5-grid-size) do (loop for x from 0 to (1- 5x5-grid-size) do (if (zerop (random 2)) (5x5-flip-cell grid y x)))) grid)) ;; Cracker functions. ;;;###autoload (defun 5x5-crack-randomly () "Attempt to crack 5x5 using random solutions." (interactive) (5x5-crack #'5x5-make-random-solution)) ;;;###autoload (defun 5x5-crack-mutating-current () "Attempt to crack 5x5 by mutating the current solution." (interactive) (5x5-crack #'5x5-make-mutate-current)) ;;;###autoload (defun 5x5-crack-mutating-best () "Attempt to crack 5x5 by mutating the best solution." (interactive) (5x5-crack #'5x5-make-mutate-best)) ;;;###autoload (defun 5x5-crack-xor-mutate () "Attempt to crack 5x5 by xoring the current and best solution. Mutate the result." (interactive) (5x5-crack #'5x5-make-xor-with-mutation)) ;;;###autoload (defun 5x5-crack (breeder) "Attempt to find a solution for 5x5. 5x5-crack takes the argument BREEDER which should be a function that takes two parameters, the first will be a grid vector array that is the current solution and the second will be the best solution so far. The function should return a grid vector array that is the new solution." (interactive "aBreeder function: ") (5x5) (setq 5x5-cracking t) (let* ((best-solution (5x5-make-random-grid)) (current-solution best-solution) (best-result (5x5-make-new-grid)) (current-result (5x5-make-new-grid)) (target (* 5x5-grid-size 5x5-grid-size))) (while (and (< (5x5-grid-value best-result) target) (not (input-pending-p))) (setq current-result (5x5-play-solution current-solution best-solution)) (if (> (5x5-grid-value current-result) (5x5-grid-value best-result)) (setq best-solution current-solution best-result current-result)) (setq current-solution (funcall breeder (5x5-copy-grid current-solution) (5x5-copy-grid best-solution))))) (setq 5x5-cracking nil)) (defun 5x5-make-random-solution (&rest ignore) "Make a random solution." (5x5-make-random-grid)) (defun 5x5-make-mutate-current (current best) "Mutate the current solution." (5x5-mutate-solution current)) (defun 5x5-make-mutate-best (current best) "Mutate the best solution." (5x5-mutate-solution best)) (defun 5x5-make-xor-with-mutation (current best) "Xor current and best solution then mutate the result." (let ((xored (5x5-make-new-grid))) (loop for y from 0 to (1- 5x5-grid-size) do (loop for x from 0 to (1- 5x5-grid-size) do (5x5-set-cell xored y x (5x5-xor (5x5-cell current y x) (5x5-cell best y x))))) (5x5-mutate-solution xored))) (defun 5x5-mutate-solution (solution) "Randomly flip bits in the solution." (loop for y from 0 to (1- 5x5-grid-size) do (loop for x from 0 to (1- 5x5-grid-size) do (if (= (random (/ (* 5x5-grid-size 5x5-grid-size) 2)) (/ (/ (* 5x5-grid-size 5x5-grid-size) 2) 2)) (5x5-flip-cell solution y x)))) solution) (defun 5x5-play-solution (solution best) "Play a solution on an empty grid. This destroys the current game in progress because it is an animated attempt." (5x5-new-game) (let ((inhibit-quit t)) (loop for y from 0 to (1- 5x5-grid-size) do (loop for x from 0 to (1- 5x5-grid-size) do (setq 5x5-y-pos y 5x5-x-pos x) (if (5x5-cell solution y x) (5x5-flip-current)) (5x5-draw-grid (list 5x5-grid solution best)) (5x5-position-cursor) (sit-for 5x5-animate-delay)))) 5x5-grid) ;; Keyboard response functions. (defun 5x5-flip-current () "Make a move on the current cursor location." (interactive) (setq 5x5-grid (5x5-make-move 5x5-grid 5x5-y-pos 5x5-x-pos)) (5x5-made-move) (unless 5x5-cracking (5x5-draw-grid (list 5x5-grid))) (5x5-position-cursor) (when (= (5x5-grid-value 5x5-grid) (* 5x5-grid-size 5x5-grid-size)) (beep) (message "You win!"))) (defun 5x5-up () "Move up." (interactive) (unless (zerop 5x5-y-pos) (decf 5x5-y-pos) (5x5-position-cursor))) (defun 5x5-down () "Move down." (interactive) (unless (= 5x5-y-pos (1- 5x5-grid-size)) (incf 5x5-y-pos) (5x5-position-cursor))) (defun 5x5-left () "Move left." (interactive) (unless (zerop 5x5-x-pos) (decf 5x5-x-pos) (5x5-position-cursor))) (defun 5x5-right () "Move right." (interactive) (unless (= 5x5-x-pos (1- 5x5-grid-size)) (incf 5x5-x-pos) (5x5-position-cursor))) (defun 5x5-bol () "Move to beginning of line." (interactive) (setq 5x5-x-pos 0) (5x5-position-cursor)) (defun 5x5-eol () "Move to end of line." (interactive) (setq 5x5-x-pos (1- 5x5-grid-size)) (5x5-position-cursor)) (defun 5x5-first () "Move to the first cell." (interactive) (setq 5x5-x-pos 0 5x5-y-pos 0) (5x5-position-cursor)) (defun 5x5-last () "Move to the last cell." (interactive) (setq 5x5-x-pos (1- 5x5-grid-size) 5x5-y-pos (1- 5x5-grid-size)) (5x5-position-cursor)) (defun 5x5-randomize () "Randomize the grid." (interactive) (when (5x5-y-or-n-p "Start a new game with a random grid? ") (setq 5x5-x-pos (/ 5x5-grid-size 2) 5x5-y-pos (/ 5x5-grid-size 2) 5x5-moves 0 5x5-grid (5x5-make-random-grid)) (unless 5x5-cracking (5x5-draw-grid (list 5x5-grid))) (5x5-position-cursor))) ;; Support functions (defun 5x5-xor (x y) "Boolean exclusive-or of X and Y." (and (or x y) (not (and x y)))) (defun 5x5-y-or-n-p (prompt) "5x5 wrapper for `y-or-n-p' which respects the `5x5-hassle-me' setting." (if 5x5-hassle-me (y-or-n-p prompt) t)) (random t) (provide '5x5) ;; arch-tag: ec4dabd5-572d-41ea-b48c-ec5ce0d68fa9 ;;; 5x5.el ends here