1 ;;; 5x5.el -- Simple little puzzle game.
3 ;; Copyright (C) 1999,2000 Free Software Foundation, Inc.
5 ;; Author: Dave Pearson <davep@davep.org>
6 ;; Maintainer: Dave Pearson <davep@davep.org>
8 ;; Keywords: games puzzles
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
29 ;; The aim of 5x5 is to fill in all the squares. If you need any more of an
30 ;; explanation you probably shouldn't play the game.
34 ;; o The code for updating the grid needs to be re-done. At the moment it
35 ;; simply re-draws the grid every time a move is made.
37 ;; o Look into tarting up the display with colour. gamegrid.el looks
38 ;; interesting, perhaps that is the way to go?
42 ;; Ralf Fassel <ralf@akutech.de> for his help and introduction to writing an
45 ;; Pascal Q. Porcupine <joshagam@cs.nmsu.edu> for inspiring the animated
53 ;; If customize isn't available just use defvar instead.
55 (unless (fboundp 'defgroup
)
56 (defmacro defgroup
(&rest rest
) nil
)
57 (defmacro defcustom
(symbol init docstring
&rest rest
)
58 `(defvar ,symbol
,init
,docstring
))))
63 "5x5 - Silly little puzzle game."
67 (defcustom 5x5-grid-size
5
68 "*Size of the playing area."
72 (defcustom 5x5-x-scale
4
73 "*X scaling factor for drawing the grid."
77 (defcustom 5x5-y-scale
3
78 "*Y scaling factor for drawing the grid."
82 (defcustom 5x5-animate-delay
.01
83 "*Delay in seconds when animating a solution crack."
87 (defcustom 5x5-hassle-me t
88 "*Should 5x5 ask you when you want to do a destructive operation?"
92 (defcustom 5x5-mode-hook nil
93 "*Hook run on starting 5x5."
97 ;; Non-customize variables.
100 "5x5 grid contents.")
103 "X position of cursor.")
106 "Y position of cursor.")
111 (defvar 5x5-cracking nil
112 "Are we in cracking mode?")
114 (defvar 5x5-buffer-name
"*5x5*"
115 "Name of the 5x5 play buffer.")
117 (defvar 5x5-mode-map nil
118 "Local keymap for the 5x5 game.")
123 (let ((map (make-sparse-keymap)))
124 (suppress-keymap map t
)
125 (define-key map
"?" #'describe-mode
)
126 (define-key map
"\r" #'5x5-flip-current
)
127 (define-key map
" " #'5x5-flip-current
)
128 (define-key map
[up] #'5x5-up)
129 (define-key map [down] #'5x5-down)
130 (define-key map [left] #'5x5-left)
131 (define-key map [tab] #'5x5-right)
132 (define-key map [right] #'5x5-right)
133 (define-key map [(control a)] #'5x5-bol)
134 (define-key map [(control e)] #'5x5-eol)
135 (define-key map [(control p)] #'5x5-up)
136 (define-key map [(control n)] #'5x5-down)
137 (define-key map [(control b)] #'5x5-left)
138 (define-key map [(control f)] #'5x5-right)
139 (define-key map [home] #'5x5-bol)
140 (define-key map [end] #'5x5-eol)
141 (define-key map [prior] #'5x5-first)
142 (define-key map [next] #'5x5-last)
143 (define-key map "r" #'5x5-randomize)
144 (define-key map [(control c) (control r)] #'5x5-crack-randomly)
145 (define-key map [(control c) (control c)] #'5x5-crack-mutating-current)
146 (define-key map [(control c) (control b)] #'5x5-crack-mutating-best)
147 (define-key map [(control c) (control x)] #'5x5-crack-xor-mutate)
148 (define-key map "n" #'5x5-new-game)
149 (define-key map "q" #'5x5-quit-game)
150 (setq 5x5-mode-map map)))
154 (easy-menu-define 5x5-mode-menu 5x5-mode-map "5x5 menu."
156 ["New game" 5x5-new-game t]
157 ["Random game" 5x5-randomize t]
158 ["Quit game" 5x5-quit-game t]
160 ["Crack randomly" 5x5-crack-randomly t]
161 ["Crack mutating current" 5x5-crack-mutating-current t]
162 ["Crack mutating best" 5x5-crack-mutating-best t]
163 ["Crack with xor mutate" 5x5-crack-xor-mutate t]))
165 ;; Gameplay functions.
167 (put '5x5-mode 'mode-class 'special)
170 "A mode for playing `5x5'
172 The key bindings for 5x5-mode are:
175 (kill-all-local-variables)
176 (use-local-map 5x5-mode-map)
177 (setq major-mode '5x5-mode
179 (run-hooks '5x5-mode-hook)
180 (setq buffer-read-only t
182 (buffer-disable-undo (current-buffer)))
185 (defun 5x5 (&optional size)
188 The object of 5x5 is very simple, by moving around the grid and flipping
189 squares you must fill the grid.
191 5x5 keyboard bindings are:
193 Flip \\[5x5-flip-current]
195 Move down \\[5x5-down]
196 Move left \\[5x5-left]
197 Move right \\[5x5-right]
198 Start new game \\[5x5-new-game]
199 New game with random grid \\[5x5-randomize]
200 Random cracker \\[5x5-crack-randomly]
201 Mutate current cracker \\[5x5-crack-mutating-current]
202 Mutate best cracker \\[5x5-crack-mutating-best]
203 Mutate xor cracker \\[5x5-crack-xor-mutate]
204 Quit current game \\[5x5-quit-game]"
207 (setq 5x5-cracking nil)
209 (setq 5x5-grid-size size))
210 (switch-to-buffer 5x5-buffer-name)
211 (if (or (not 5x5-grid) (not (= 5x5-grid-size (length (aref 5x5-grid 0)))))
213 (5x5-draw-grid (list 5x5-grid))
214 (5x5-position-cursor)
217 (defun 5x5-new-game ()
218 "Start a new game of `5x5'."
220 (when (if (interactive-p) (5x5-y-or-n-p "Start a new game? ") t)
221 (setq 5x5-x-pos (/ 5x5-grid-size 2)
222 5x5-y-pos (/ 5x5-grid-size 2)
224 5x5-grid (5x5-make-move (5x5-make-new-grid) 5x5-y-pos 5x5-x-pos))
225 (when (interactive-p)
226 (5x5-draw-grid (list 5x5-grid))
227 (5x5-position-cursor))))
229 (defun 5x5-quit-game ()
230 "Quit the current game of `5x5'."
232 (kill-buffer 5x5-buffer-name))
234 (defun 5x5-make-new-grid ()
235 "Create and return a new `5x5' grid structure."
236 (let ((grid (make-vector 5x5-grid-size nil)))
237 (loop for y from 0 to (1- 5x5-grid-size) do
238 (aset grid y (make-vector 5x5-grid-size nil)))
241 (defun 5x5-cell (grid y x)
242 "Return the value of the cell in GRID at location X,Y."
243 (aref (aref grid y) x))
245 (defun 5x5-set-cell (grid y x value)
246 "Set the value of cell X,Y in GRID to VALUE."
247 (aset (aref grid y) x value))
249 (defun 5x5-flip-cell (grid y x)
250 "Flip the value of cell X,Y in GRID."
251 (5x5-set-cell grid y x (not (5x5-cell grid y x))))
253 (defun 5x5-copy-grid (grid)
254 "Make a new copy of GRID."
255 (let ((copy (5x5-make-new-grid)))
256 (loop for y from 0 to (1- 5x5-grid-size) do
257 (loop for x from 0 to (1- 5x5-grid-size) do
258 (5x5-set-cell copy y x (5x5-cell grid y x))))
261 (defun 5x5-make-move (grid row col)
262 "Make a move on GRID at row ROW and column COL."
263 (5x5-flip-cell grid row col)
265 (5x5-flip-cell grid (1- row) col))
266 (if (< row (- 5x5-grid-size 1))
267 (5x5-flip-cell grid (1+ row) col))
269 (5x5-flip-cell grid row (1- col)))
270 (if (< col (- 5x5-grid-size 1))
271 (5x5-flip-cell grid row (1+ col)))
274 (defun 5x5-row-value (row)
275 "Get the \"on-value\" for grid row ROW."
276 (loop for y from 0 to (1- 5x5-grid-size) sum (if (aref row y) 1 0)))
278 (defun 5x5-grid-value (grid)
279 "Get the \"on-value\" for grid GRID."
280 (loop for y from 0 to (1- 5x5-grid-size) sum (5x5-row-value (aref grid y))))
282 (defun 5x5-draw-grid-end ()
283 "Draw the top/bottom of the grid"
285 (loop for x from 0 to (1- 5x5-grid-size) do
286 (insert "-" (make-string 5x5-x-scale ?-)))
289 (defun 5x5-draw-grid (grids)
290 "Draw the grids GRIDS into the current buffer."
291 (let ((buffer-read-only nil))
293 (loop for grid in grids do (5x5-draw-grid-end))
295 (loop for y from 0 to (1- 5x5-grid-size) do
296 (loop for lines from 0 to (1- 5x5-y-scale) do
297 (loop for grid in grids do
298 (loop for x from 0 to (1- 5x5-grid-size) do
299 (insert (if (zerop x) "| " " ")
300 (make-string 5x5-x-scale
301 (if (5x5-cell grid y x) ?# ?.))))
304 (loop for grid in grids do (5x5-draw-grid-end))
306 (insert (format "On: %d Moves: %d" (5x5-grid-value (car grids)) 5x5-moves))))
308 (defun 5x5-position-cursor ()
309 "Position the cursor on the grid."
310 (goto-line (+ (* 5x5-y-pos 5x5-y-scale) 2))
311 (goto-char (+ (point) (* 5x5-x-pos 5x5-x-scale) (+ 5x5-x-pos 1) 1)))
313 (defun 5x5-made-move ()
314 "Keep track of how many moves have been made."
317 (defun 5x5-make-random-grid ()
318 "Make a random grid."
319 (let ((grid (5x5-make-new-grid)))
320 (loop for y from 0 to (1- 5x5-grid-size) do
321 (loop for x from 0 to (1- 5x5-grid-size) do
322 (if (zerop (random 2))
323 (5x5-flip-cell grid y x))))
326 ;; Cracker functions.
329 (defun 5x5-crack-randomly ()
330 "Attempt to crack 5x5 using random solutions."
332 (5x5-crack #'5x5-make-random-solution))
335 (defun 5x5-crack-mutating-current ()
336 "Attempt to crack 5x5 by mutating the current solution."
338 (5x5-crack #'5x5-make-mutate-current))
341 (defun 5x5-crack-mutating-best ()
342 "Attempt to crack 5x5 by mutating the best solution."
344 (5x5-crack #'5x5-make-mutate-best))
347 (defun 5x5-crack-xor-mutate ()
348 "Attempt to crack 5x5 by xor the current and best solution and then
349 mutating the result."
351 (5x5-crack #'5x5-make-xor-with-mutation))
354 (defun 5x5-crack (breeder)
355 "Attempt to find a solution for 5x5.
357 5x5-crack takes the argument BREEDER which should be a function that takes
358 two parameters, the first will be a grid vector array that is the current
359 solution and the second will be the best solution so far. The function
360 should return a grid vector array that is the new solution."
362 (interactive "aBreeder function: ")
364 (setq 5x5-cracking t)
365 (let* ((best-solution (5x5-make-random-grid))
366 (current-solution best-solution)
367 (best-result (5x5-make-new-grid))
368 (current-result (5x5-make-new-grid))
369 (target (* 5x5-grid-size 5x5-grid-size)))
370 (while (and (< (5x5-grid-value best-result) target)
371 (not (input-pending-p)))
372 (setq current-result (5x5-play-solution current-solution best-solution))
373 (if (> (5x5-grid-value current-result) (5x5-grid-value best-result))
374 (setq best-solution current-solution
375 best-result current-result))
376 (setq current-solution (funcall breeder
377 (5x5-copy-grid current-solution)
378 (5x5-copy-grid best-solution)))))
379 (setq 5x5-cracking nil))
381 (defun 5x5-make-random-solution (&rest ignore)
382 "Make a random solution."
383 (5x5-make-random-grid))
385 (defun 5x5-make-mutate-current (current best)
386 "Mutate the current solution."
387 (5x5-mutate-solution current))
389 (defun 5x5-make-mutate-best (current best)
390 "Mutate the best solution."
391 (5x5-mutate-solution best))
393 (defun 5x5-make-xor-with-mutation (current best)
394 "xor current and best solution then mutate the result."
395 (let ((xored (5x5-make-new-grid)))
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 (5x5-set-cell xored y x
399 (5x5-xor (5x5-cell current y x)
400 (5x5-cell best y x)))))
401 (5x5-mutate-solution xored)))
403 (defun 5x5-mutate-solution (solution)
404 "Randomly flip bits in the solution."
405 (loop for y from 0 to (1- 5x5-grid-size) do
406 (loop for x from 0 to (1- 5x5-grid-size) do
407 (if (= (random (/ (* 5x5-grid-size 5x5-grid-size) 2))
408 (/ (/ (* 5x5-grid-size 5x5-grid-size) 2) 2))
409 (5x5-flip-cell solution y x))))
412 (defun 5x5-play-solution (solution best)
413 "Play a solution on an empty grid. This destroys the current game in
414 progress because it is an animated attempt."
416 (let ((inhibit-quit t))
417 (loop for y from 0 to (1- 5x5-grid-size) do
418 (loop for x from 0 to (1- 5x5-grid-size) do
421 (if (5x5-cell solution y x)
423 (5x5-draw-grid (list 5x5-grid solution best))
424 (5x5-position-cursor)
425 (sit-for 5x5-animate-delay))))
428 ;; Keyboard response functions.
430 (defun 5x5-flip-current ()
431 "Make a move on the current cursor location."
433 (setq 5x5-grid (5x5-make-move 5x5-grid 5x5-y-pos 5x5-x-pos))
436 (5x5-draw-grid (list 5x5-grid)))
437 (5x5-position-cursor)
438 (when (= (5x5-grid-value 5x5-grid) (* 5x5-grid-size 5x5-grid-size))
440 (message "You win!")))
445 (unless (zerop 5x5-y-pos)
447 (5x5-position-cursor)))
452 (unless (= 5x5-y-pos (1- 5x5-grid-size))
454 (5x5-position-cursor)))
459 (unless (zerop 5x5-x-pos)
461 (5x5-position-cursor)))
466 (unless (= 5x5-x-pos (1- 5x5-grid-size))
468 (5x5-position-cursor)))
471 "Move to beginning of line."
474 (5x5-position-cursor))
477 "Move to end of line."
479 (setq 5x5-x-pos (1- 5x5-grid-size))
480 (5x5-position-cursor))
483 "Move to the first cell."
487 (5x5-position-cursor))
490 "Move to the last cell."
492 (setq 5x5-x-pos (1- 5x5-grid-size)
493 5x5-y-pos (1- 5x5-grid-size))
494 (5x5-position-cursor))
496 (defun 5x5-randomize ()
497 "Randomize the grid."
499 (when (5x5-y-or-n-p "Start a new game with a random grid? ")
500 (setq 5x5-x-pos (/ 5x5-grid-size 2)
501 5x5-y-pos (/ 5x5-grid-size 2)
503 5x5-grid (5x5-make-random-grid))
505 (5x5-draw-grid (list 5x5-grid)))
506 (5x5-position-cursor)))
511 "Boolean exclusive-or of X and Y."
512 (and (or x y) (not (and x y))))
514 (defun 5x5-y-or-n-p (prompt)
515 "5x5 wrapper for y-or-n-p which respects the 5x5-hassle-me setting."