1 ;;; 5x5.el --- simple little puzzle game
3 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
4 ;; 2008, 2009, 2010 Free Software Foundation, Inc.
6 ;; Author: Dave Pearson <davep@davep.org>
7 ;; Maintainer: Dave Pearson <davep@davep.org>
9 ;; Keywords: games puzzles
11 ;; This file is part of GNU Emacs.
13 ;; GNU Emacs is free software: you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation, either version 3 of the License, or
16 ;; (at your option) any later version.
18 ;; GNU Emacs is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
28 ;; The aim of 5x5 is to fill in all the squares. If you need any more of an
29 ;; explanation you probably shouldn't play the game.
33 ;; o The code for updating the grid needs to be re-done. At the moment it
34 ;; simply re-draws the grid every time a move is made.
36 ;; o Look into tarting up the display with color. gamegrid.el looks
37 ;; interesting, perhaps that is the way to go?
41 ;; Ralf Fassel <ralf@akutech.de> for his help and introduction to writing an
44 ;; Pascal Q. Porcupine <joshagam@cs.nmsu.edu> for inspiring the animated
57 "5x5 - Silly little puzzle game."
61 (defcustom 5x5-grid-size
5
62 "Size of the playing area."
66 (defcustom 5x5-x-scale
4
67 "X scaling factor for drawing the grid."
71 (defcustom 5x5-y-scale
3
72 "Y scaling factor for drawing the grid."
76 (defcustom 5x5-animate-delay
.01
77 "Delay in seconds when animating a solution crack."
81 (defcustom 5x5-hassle-me t
82 "Should 5x5 ask you when you want to do a destructive operation?"
86 (defcustom 5x5-mode-hook nil
87 "Hook run on starting 5x5."
91 ;; Non-customize variables.
97 "X position of cursor.")
100 "Y position of cursor.")
105 (defvar 5x5-cracking nil
106 "Are we in cracking mode?")
108 (defvar 5x5-buffer-name
"*5x5*"
109 "Name of the 5x5 play buffer.")
112 (let ((map (make-sparse-keymap)))
113 (suppress-keymap map t
)
114 (define-key map
"?" #'describe-mode
)
115 (define-key map
"\r" #'5x5-flip-current
)
116 (define-key map
" " #'5x5-flip-current
)
117 (define-key map
[up] #'5x5-up)
118 (define-key map [down] #'5x5-down)
119 (define-key map [left] #'5x5-left)
120 (define-key map [tab] #'5x5-right)
121 (define-key map [right] #'5x5-right)
122 (define-key map [(control a)] #'5x5-bol)
123 (define-key map [(control e)] #'5x5-eol)
124 (define-key map [(control p)] #'5x5-up)
125 (define-key map [(control n)] #'5x5-down)
126 (define-key map [(control b)] #'5x5-left)
127 (define-key map [(control f)] #'5x5-right)
128 (define-key map [home] #'5x5-bol)
129 (define-key map [end] #'5x5-eol)
130 (define-key map [prior] #'5x5-first)
131 (define-key map [next] #'5x5-last)
132 (define-key map "r" #'5x5-randomize)
133 (define-key map [(control c) (control r)] #'5x5-crack-randomly)
134 (define-key map [(control c) (control c)] #'5x5-crack-mutating-current)
135 (define-key map [(control c) (control b)] #'5x5-crack-mutating-best)
136 (define-key map [(control c) (control x)] #'5x5-crack-xor-mutate)
137 (define-key map "n" #'5x5-new-game)
138 (define-key map "q" #'5x5-quit-game)
140 "Local keymap for the 5x5 game.")
144 (easy-menu-define 5x5-mode-menu 5x5-mode-map "5x5 menu."
146 ["New game" 5x5-new-game t]
147 ["Random game" 5x5-randomize t]
148 ["Quit game" 5x5-quit-game t]
150 ["Crack randomly" 5x5-crack-randomly t]
151 ["Crack mutating current" 5x5-crack-mutating-current t]
152 ["Crack mutating best" 5x5-crack-mutating-best t]
153 ["Crack with xor mutate" 5x5-crack-xor-mutate t]))
155 ;; Gameplay functions.
157 (put '5x5-mode 'mode-class 'special)
160 "A mode for playing `5x5'.
162 The key bindings for 5x5-mode are:
165 (kill-all-local-variables)
166 (use-local-map 5x5-mode-map)
167 (setq major-mode '5x5-mode
169 (run-mode-hooks '5x5-mode-hook)
170 (setq buffer-read-only t
172 (buffer-disable-undo))
175 (defun 5x5 (&optional size)
178 The object of 5x5 is very simple, by moving around the grid and flipping
179 squares you must fill the grid.
181 5x5 keyboard bindings are:
183 Flip \\[5x5-flip-current]
185 Move down \\[5x5-down]
186 Move left \\[5x5-left]
187 Move right \\[5x5-right]
188 Start new game \\[5x5-new-game]
189 New game with random grid \\[5x5-randomize]
190 Random cracker \\[5x5-crack-randomly]
191 Mutate current cracker \\[5x5-crack-mutating-current]
192 Mutate best cracker \\[5x5-crack-mutating-best]
193 Mutate xor cracker \\[5x5-crack-xor-mutate]
194 Quit current game \\[5x5-quit-game]"
197 (setq 5x5-cracking nil)
199 (setq 5x5-grid-size size))
200 (switch-to-buffer 5x5-buffer-name)
201 (if (or (not 5x5-grid) (not (= 5x5-grid-size (length (aref 5x5-grid 0)))))
203 (5x5-draw-grid (list 5x5-grid))
204 (5x5-position-cursor)
207 (defun 5x5-new-game ()
208 "Start a new game of `5x5'."
210 (when (if (called-interactively-p 'interactive)
211 (5x5-y-or-n-p "Start a new game? ") t)
212 (setq 5x5-x-pos (/ 5x5-grid-size 2)
213 5x5-y-pos (/ 5x5-grid-size 2)
215 5x5-grid (5x5-make-move (5x5-make-new-grid) 5x5-y-pos 5x5-x-pos))
216 (5x5-draw-grid (list 5x5-grid))
217 (5x5-position-cursor)))
219 (defun 5x5-quit-game ()
220 "Quit the current game of `5x5'."
222 (kill-buffer 5x5-buffer-name))
224 (defun 5x5-make-new-grid ()
225 "Create and return a new `5x5' grid structure."
226 (let ((grid (make-vector 5x5-grid-size nil)))
227 (loop for y from 0 to (1- 5x5-grid-size) do
228 (aset grid y (make-vector 5x5-grid-size nil)))
231 (defun 5x5-cell (grid y x)
232 "Return the value of the cell in GRID at location X,Y."
233 (aref (aref grid y) x))
235 (defun 5x5-set-cell (grid y x value)
236 "Set the value of cell X,Y in GRID to VALUE."
237 (aset (aref grid y) x value))
239 (defun 5x5-flip-cell (grid y x)
240 "Flip the value of cell X,Y in GRID."
241 (5x5-set-cell grid y x (not (5x5-cell grid y x))))
243 (defun 5x5-copy-grid (grid)
244 "Make a new copy of GRID."
245 (let ((copy (5x5-make-new-grid)))
246 (loop for y from 0 to (1- 5x5-grid-size) do
247 (loop for x from 0 to (1- 5x5-grid-size) do
248 (5x5-set-cell copy y x (5x5-cell grid y x))))
251 (defun 5x5-make-move (grid row col)
252 "Make a move on GRID at row ROW and column COL."
253 (5x5-flip-cell grid row col)
255 (5x5-flip-cell grid (1- row) col))
256 (if (< row (- 5x5-grid-size 1))
257 (5x5-flip-cell grid (1+ row) col))
259 (5x5-flip-cell grid row (1- col)))
260 (if (< col (- 5x5-grid-size 1))
261 (5x5-flip-cell grid row (1+ col)))
264 (defun 5x5-row-value (row)
265 "Get the \"on-value\" for grid row ROW."
266 (loop for y from 0 to (1- 5x5-grid-size) sum (if (aref row y) 1 0)))
268 (defun 5x5-grid-value (grid)
269 "Get the \"on-value\" for grid GRID."
270 (loop for y from 0 to (1- 5x5-grid-size) sum (5x5-row-value (aref grid y))))
272 (defun 5x5-draw-grid-end ()
273 "Draw the top/bottom of the grid."
275 (loop for x from 0 to (1- 5x5-grid-size) do
276 (insert "-" (make-string 5x5-x-scale ?-)))
279 (defun 5x5-draw-grid (grids)
280 "Draw the grids GRIDS into the current buffer."
281 (let ((buffer-read-only nil))
283 (loop for grid in grids do (5x5-draw-grid-end))
285 (loop for y from 0 to (1- 5x5-grid-size) do
286 (loop for lines from 0 to (1- 5x5-y-scale) do
287 (loop for grid in grids do
288 (loop for x from 0 to (1- 5x5-grid-size) do
289 (insert (if (zerop x) "| " " ")
290 (make-string 5x5-x-scale
291 (if (5x5-cell grid y x) ?# ?.))))
294 (loop for grid in grids do (5x5-draw-grid-end))
296 (insert (format "On: %d Moves: %d" (5x5-grid-value (car grids)) 5x5-moves))))
298 (defun 5x5-position-cursor ()
299 "Position the cursor on the grid."
300 (goto-char (point-min))
301 (forward-line (1+ (* 5x5-y-pos 5x5-y-scale)))
302 (goto-char (+ (point) (* 5x5-x-pos 5x5-x-scale) (+ 5x5-x-pos 1) 1)))
304 (defun 5x5-made-move ()
305 "Keep track of how many moves have been made."
308 (defun 5x5-make-random-grid ()
309 "Make a random grid."
310 (let ((grid (5x5-make-new-grid)))
311 (loop for y from 0 to (1- 5x5-grid-size) do
312 (loop for x from 0 to (1- 5x5-grid-size) do
313 (if (zerop (random 2))
314 (5x5-flip-cell grid y x))))
317 ;; Cracker functions.
320 (defun 5x5-crack-randomly ()
321 "Attempt to crack 5x5 using random solutions."
323 (5x5-crack #'5x5-make-random-solution))
326 (defun 5x5-crack-mutating-current ()
327 "Attempt to crack 5x5 by mutating the current solution."
329 (5x5-crack #'5x5-make-mutate-current))
332 (defun 5x5-crack-mutating-best ()
333 "Attempt to crack 5x5 by mutating the best solution."
335 (5x5-crack #'5x5-make-mutate-best))
338 (defun 5x5-crack-xor-mutate ()
339 "Attempt to crack 5x5 by xoring the current and best solution.
342 (5x5-crack #'5x5-make-xor-with-mutation))
345 (defun 5x5-crack (breeder)
346 "Attempt to find a solution for 5x5.
348 5x5-crack takes the argument BREEDER which should be a function that takes
349 two parameters, the first will be a grid vector array that is the current
350 solution and the second will be the best solution so far. The function
351 should return a grid vector array that is the new solution."
353 (interactive "aBreeder function: ")
355 (setq 5x5-cracking t)
356 (let* ((best-solution (5x5-make-random-grid))
357 (current-solution best-solution)
358 (best-result (5x5-make-new-grid))
359 (current-result (5x5-make-new-grid))
360 (target (* 5x5-grid-size 5x5-grid-size)))
361 (while (and (< (5x5-grid-value best-result) target)
362 (not (input-pending-p)))
363 (setq current-result (5x5-play-solution current-solution best-solution))
364 (if (> (5x5-grid-value current-result) (5x5-grid-value best-result))
365 (setq best-solution current-solution
366 best-result current-result))
367 (setq current-solution (funcall breeder
368 (5x5-copy-grid current-solution)
369 (5x5-copy-grid best-solution)))))
370 (setq 5x5-cracking nil))
372 (defun 5x5-make-random-solution (&rest ignore)
373 "Make a random solution."
374 (5x5-make-random-grid))
376 (defun 5x5-make-mutate-current (current best)
377 "Mutate the current solution."
378 (5x5-mutate-solution current))
380 (defun 5x5-make-mutate-best (current best)
381 "Mutate the best solution."
382 (5x5-mutate-solution best))
384 (defun 5x5-make-xor-with-mutation (current best)
385 "Xor current and best solution then mutate the result."
386 (let ((xored (5x5-make-new-grid)))
387 (loop for y from 0 to (1- 5x5-grid-size) do
388 (loop for x from 0 to (1- 5x5-grid-size) do
389 (5x5-set-cell xored y x
390 (5x5-xor (5x5-cell current y x)
391 (5x5-cell best y x)))))
392 (5x5-mutate-solution xored)))
394 (defun 5x5-mutate-solution (solution)
395 "Randomly flip bits in the solution."
396 (loop for y from 0 to (1- 5x5-grid-size) do
397 (loop for x from 0 to (1- 5x5-grid-size) do
398 (if (= (random (/ (* 5x5-grid-size 5x5-grid-size) 2))
399 (/ (/ (* 5x5-grid-size 5x5-grid-size) 2) 2))
400 (5x5-flip-cell solution y x))))
403 (defun 5x5-play-solution (solution best)
404 "Play a solution on an empty grid. This destroys the current game
405 in progress because it is an animated attempt."
407 (let ((inhibit-quit t))
408 (loop for y from 0 to (1- 5x5-grid-size) do
409 (loop for x from 0 to (1- 5x5-grid-size) do
412 (if (5x5-cell solution y x)
414 (5x5-draw-grid (list 5x5-grid solution best))
415 (5x5-position-cursor)
416 (sit-for 5x5-animate-delay))))
419 ;; Keyboard response functions.
421 (defun 5x5-flip-current ()
422 "Make a move on the current cursor location."
424 (setq 5x5-grid (5x5-make-move 5x5-grid 5x5-y-pos 5x5-x-pos))
427 (5x5-draw-grid (list 5x5-grid)))
428 (5x5-position-cursor)
429 (when (= (5x5-grid-value 5x5-grid) (* 5x5-grid-size 5x5-grid-size))
431 (message "You win!")))
436 (unless (zerop 5x5-y-pos)
438 (5x5-position-cursor)))
443 (unless (= 5x5-y-pos (1- 5x5-grid-size))
445 (5x5-position-cursor)))
450 (unless (zerop 5x5-x-pos)
452 (5x5-position-cursor)))
457 (unless (= 5x5-x-pos (1- 5x5-grid-size))
459 (5x5-position-cursor)))
462 "Move to beginning of line."
465 (5x5-position-cursor))
468 "Move to end of line."
470 (setq 5x5-x-pos (1- 5x5-grid-size))
471 (5x5-position-cursor))
474 "Move to the first cell."
478 (5x5-position-cursor))
481 "Move to the last cell."
483 (setq 5x5-x-pos (1- 5x5-grid-size)
484 5x5-y-pos (1- 5x5-grid-size))
485 (5x5-position-cursor))
487 (defun 5x5-randomize ()
488 "Randomize the grid."
490 (when (5x5-y-or-n-p "Start a new game with a random grid? ")
491 (setq 5x5-x-pos (/ 5x5-grid-size 2)
492 5x5-y-pos (/ 5x5-grid-size 2)
494 5x5-grid (5x5-make-random-grid))
496 (5x5-draw-grid (list 5x5-grid)))
497 (5x5-position-cursor)))
502 "Boolean exclusive-or of X and Y."
503 (and (or x y) (not (and x y))))
505 (defun 5x5-y-or-n-p (prompt)
506 "5x5 wrapper for `y-or-n-p' which respects the `5x5-hassle-me' setting."
515 ;; arch-tag: ec4dabd5-572d-41ea-b48c-ec5ce0d68fa9