changeset 25143:5decc043e9bf

Initial revision

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/play/5x5.el	Sat Jul 31 16:46:58 1999 +0000
@@ -0,0 +1,518 @@
+;;; 5x5.el -- Simple little puzzle game.
+
+;; Copyright (C) 1999 Free Software Foundationm, Inc.
+
+;; Author: Dave Pearson <[e-mail]>
+;; Maintainer: Dave Pearson <[e-mail]>
+;; Created: 1998-10-03
+;; Version: $Revision: 1.15 $
+;; 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 2, 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; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; 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 starting up the display with colour. gamegrid.el looks
+;;   interesting, perhaps that is the way to go?
+
+;;; Thanks:
+
+;; Ralf Fassel <[e-mail]> for his help and introduction to writing an
+;; emacs mode.
+;;
+;; Pascal Q. Porcupine <[e-mail]> for inspiring the animated
+;; solver.
+
+;; Things we need.
+
+(eval-when-compile
+  (require 'cl))
+
+;; If customize isn't available just use defvar instead.
+(eval-and-compile
+  (unless (fboundp 'defgroup)
+    (defmacro defgroup  (&rest rest) nil)
+    (defmacro defcustom (symbol init docstring &rest rest)
+      `(defvar ,symbol ,init ,docstring))))
+
+;; 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 [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-hooks '5x5-mode-hook)  
+  (setq buffer-read-only t
+        truncate-lines   t)
+  (buffer-disable-undo (current-buffer)))
+
+;;;###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]
+Mutaue 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 (interactive-p) (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))
+    (when (interactive-p)
+      (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-line (+ (* 5x5-y-pos 5x5-y-scale) 2))
+  (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 xor the current and best solution and then
+mutating 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)
+  (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))
+
+(provide '5x5)
+
+;;; 5x5.el ends here