;;; 5x5.el --- simple little puzzle game;; Copyright (C) 1999,2000 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 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 tarting up the display with colour. 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));; 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 [(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-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 flippingsquares 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 (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)) (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.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 takestwo parameters, the first will be a grid vector array that is the currentsolution and the second will be the best solution so far. The functionshould 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 inprogress 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))(provide '5x5);;; arch-tag: ec4dabd5-572d-41ea-b48c-ec5ce0d68fa9;;; 5x5.el ends here