Mercurial > emacs
annotate lisp/play/bubbles.el @ 84033:52ef29977fe9
Move to ../doc/lispref
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Thu, 06 Sep 2007 04:14:59 +0000 |
parents | bb20f4e17041 |
children | 94bc57977861 |
rev | line source |
---|---|
82921 | 1 ;;; bubbles.el --- Puzzle game for Emacs. |
2 | |
3 ;; Copyright (C) 2007 Free Software Foundation, Inc. | |
4 | |
5 ;; Author: Ulf Jasper <ulf.jasper@web.de> | |
6 ;; URL: http://ulf.epplejasper.de/ | |
7 ;; Created: 5. Feb. 2007 | |
82922
16c56e4babd8
Comments munging; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
82921
diff
changeset
|
8 ;; Keywords: games |
82921 | 9 |
82922
16c56e4babd8
Comments munging; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
82921
diff
changeset
|
10 ;; This file is part of GNU Emacs. |
82921 | 11 |
82922
16c56e4babd8
Comments munging; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
82921
diff
changeset
|
12 ;; GNU Emacs is free software; you can redistribute it and/or modify |
82921 | 13 ;; it under the terms of the GNU General Public License as published by |
82922
16c56e4babd8
Comments munging; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
82921
diff
changeset
|
14 ;; the Free Software Foundation; either version 3, or (at your option) |
16c56e4babd8
Comments munging; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
82921
diff
changeset
|
15 ;; any later version. |
82921 | 16 |
82922
16c56e4babd8
Comments munging; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
82921
diff
changeset
|
17 ;; GNU Emacs is distributed in the hope that it will be useful, |
16c56e4babd8
Comments munging; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
82921
diff
changeset
|
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
16c56e4babd8
Comments munging; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
82921
diff
changeset
|
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
16c56e4babd8
Comments munging; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
82921
diff
changeset
|
20 ;; GNU General Public License for more details. |
82921 | 21 |
22 ;; You should have received a copy of the GNU General Public License | |
82922
16c56e4babd8
Comments munging; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
82921
diff
changeset
|
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
16c56e4babd8
Comments munging; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
82921
diff
changeset
|
24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
16c56e4babd8
Comments munging; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
82921
diff
changeset
|
25 ;; Boston, MA 02110-1301, USA. |
82921 | 26 |
27 ;;; Commentary: | |
28 | |
29 ;; Bubbles is a puzzle game. Its goal is to remove as many bubbles as | |
30 ;; possible in as few moves as possible. | |
31 | |
32 ;; Bubbles is an implementation of the "Same Game", similar to "Same | |
82922
16c56e4babd8
Comments munging; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
82921
diff
changeset
|
33 ;; GNOME" and many others, see <http://en.wikipedia.org/wiki/SameGame>. |
82921 | 34 |
35 ;; Installation | |
36 ;; ------------ | |
37 | |
38 ;; Add the following lines to your Emacs startup file (`~/.emacs'). | |
39 ;; (add-to-list 'load-path "/path/to/bubbles/") | |
40 ;; (autoload 'bubbles "bubbles" "Play Bubbles" t) | |
41 | |
42 ;; ====================================================================== | |
43 | |
44 ;;; History: | |
45 | |
46 ;; 0.4 (2007-08-27) | |
47 ;; - Allow for undoing last move. | |
48 ;; - Bonus for removing all bubbles. | |
49 ;; - Speed improvements. | |
50 ;; - Animation enhancements. | |
51 ;; - Added `bubbles-mode-hook'. | |
52 ;; - Fixes: Don't move point. | |
53 ;; - New URL. | |
54 | |
55 ;; 0.3 (2007-03-11) | |
56 ;; - Renamed shift modes and thus names of score files. All | |
57 ;; highscores are lost, unless you rename the score files from | |
58 ;; bubbles-shift-... to bubbles-...! | |
59 ;; - Bugfixes: Check for successful image creation. | |
60 ;; Disable menus and counter when game is over. | |
61 ;; Tested with GNU Emacs 22.0.93 | |
62 | |
63 ;; 0.2 (2007-02-24) | |
64 ;; - Introduced game themes. | |
65 ;; - Introduced graphics themes (changeable while playing). | |
66 ;; - Added menu. | |
67 ;; - Customization: grid size, colors, chars, shift mode. | |
68 ;; - More keybindings. | |
69 ;; - Changed shift direction from to-right to to-left. | |
70 ;; - Bugfixes: Don't remove single-bubble regions; | |
71 ;; Animation glitches fixed. | |
72 ;; Tested with GNU Emacs 22.0.93 and 21.4.1. | |
73 | |
74 ;; 0.1 (2007-02-11) | |
75 ;; Initial release. Tested with GNU Emacs 22.0.93 and 21.4.1. | |
76 | |
77 ;; ====================================================================== | |
78 | |
79 ;;; Code: | |
80 | |
82922
16c56e4babd8
Comments munging; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
82921
diff
changeset
|
81 (defconst bubbles-version "0.4" "Version number of bubbles.el.") |
16c56e4babd8
Comments munging; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
82921
diff
changeset
|
82 |
82921 | 83 (require 'gamegrid) |
84 (require 'cl) | |
85 | |
86 ;; User options | |
87 | |
88 ;; Careful with that axe, Eugene! Order does matter in the custom | |
89 ;; section below. | |
90 | |
91 (defcustom bubbles-game-theme | |
92 'easy | |
93 "Overall game theme. | |
94 The overall game theme specifies a grid size, a set of colors, | |
95 and a shift mode." | |
96 :type '(radio (const :tag "Easy" easy) | |
97 (const :tag "Medium" medium) | |
98 (const :tag "Difficult" difficult) | |
99 (const :tag "Hard" hard) | |
100 (const :tag "User defined" user-defined)) | |
101 :group 'bubbles) | |
102 | |
103 (defun bubbles-set-game-easy () | |
104 "Set game theme to 'easy'." | |
105 (interactive) | |
106 (setq bubbles-game-theme 'easy) | |
107 (bubbles)) | |
108 | |
109 (defun bubbles-set-game-medium () | |
110 "Set game theme to 'medium'." | |
111 (interactive) | |
112 (setq bubbles-game-theme 'medium) | |
113 (bubbles)) | |
114 | |
115 (defun bubbles-set-game-difficult () | |
116 "Set game theme to 'difficult'." | |
117 (interactive) | |
118 (setq bubbles-game-theme 'difficult) | |
119 (bubbles)) | |
120 | |
121 (defun bubbles-set-game-hard () | |
122 "Set game theme to 'hard'." | |
123 (interactive) | |
124 (setq bubbles-game-theme 'hard) | |
125 (bubbles)) | |
126 | |
127 (defun bubbles-set-game-userdefined () | |
128 "Set game theme to 'user-defined'." | |
129 (interactive) | |
130 (setq bubbles-game-theme 'user-defined) | |
131 (bubbles)) | |
132 | |
133 (defgroup bubbles nil | |
134 "Bubbles, a puzzle game." | |
135 :group 'games) | |
136 | |
137 (defcustom bubbles-graphics-theme | |
138 'circles | |
139 "Graphics theme. | |
140 It is safe to choose a graphical theme. If Emacs cannot display | |
141 images the `ascii' theme will be used." | |
142 :type '(radio (const :tag "Circles" circles) | |
143 (const :tag "Squares" squares) | |
144 (const :tag "Diamonds" diamonds) | |
145 (const :tag "Balls" balls) | |
146 (const :tag "Emacs" emacs) | |
147 (const :tag "ASCII (no images)" ascii)) | |
148 :group 'bubbles) | |
149 | |
150 (defconst bubbles--grid-small '(10 . 10) | |
151 "Predefined small bubbles grid.") | |
152 | |
153 (defconst bubbles--grid-medium '(15 . 10) | |
154 "Predefined medium bubbles grid.") | |
155 | |
156 (defconst bubbles--grid-large '(20 . 15) | |
157 "Predefined large bubbles grid.") | |
158 | |
159 (defconst bubbles--grid-huge '(30 . 20) | |
160 "Predefined huge bubbles grid.") | |
161 | |
162 (defcustom bubbles-grid-size | |
163 bubbles--grid-medium | |
164 "Size of bubbles grid." | |
165 :type `(radio (const :tag "Small" ,bubbles--grid-small) | |
166 (const :tag "Medium" ,bubbles--grid-medium) | |
167 (const :tag "Large" ,bubbles--grid-large) | |
168 (const :tag "Huge" ,bubbles--grid-huge) | |
169 (cons :tag "User defined" | |
170 (integer :tag "Width") | |
171 (integer :tag "Height"))) | |
172 :group 'bubbles) | |
173 | |
174 (defconst bubbles--colors-2 '("orange" "violet") | |
175 "Predefined bubbles color list with two colors.") | |
176 | |
177 (defconst bubbles--colors-3 '("lightblue" "palegreen" "pink") | |
178 "Predefined bubbles color list with three colors.") | |
179 | |
180 (defconst bubbles--colors-4 '("firebrick" "sea green" "steel blue" "chocolate") | |
181 "Predefined bubbles color list with four colors.") | |
182 | |
183 (defconst bubbles--colors-5 '("firebrick" "sea green" "steel blue" | |
184 "sandy brown" "bisque3") | |
185 "Predefined bubbles color list with five colors.") | |
186 | |
187 (defcustom bubbles-colors | |
188 bubbles--colors-3 | |
189 "List of bubble colors. | |
190 The length of this list determines how many different bubble | |
191 types are present." | |
192 :type `(radio (const :tag "Red, darkgreen" ,bubbles--colors-2) | |
193 (const :tag "Red, darkgreen, blue" ,bubbles--colors-3) | |
194 (const :tag "Red, darkgreen, blue, orange" ,bubbles--colors-4) | |
195 (const :tag "Red, darkgreen, blue, orange, violet" | |
196 ,bubbles--colors-5) | |
197 (repeat :tag "User defined" color)) | |
198 :group 'bubbles) | |
199 | |
200 (defcustom bubbles-chars | |
201 '(?+ ?O ?# ?X ?. ?* ?& ?§) | |
202 "Characters used for bubbles. | |
203 Note that the actual number of different bubbles is determined by | |
204 the number of colors, see `bubbles-colors'." | |
205 :type '(repeat character) | |
206 :group 'bubbles) | |
207 | |
208 (defcustom bubbles-shift-mode | |
209 'default | |
210 "Shift mode. | |
211 Available modes are `shift-default' and`shift-always'." | |
212 :type '(radio (const :tag "Default" default) | |
213 (const :tag "Shifter" always) | |
214 ;;(const :tag "Mega Shifter" 'mega) | |
215 ) | |
216 :group 'bubbles) | |
217 | |
218 (defcustom bubbles-mode-hook nil | |
219 "Hook run by Bubbles mode." | |
220 :group 'bubbles | |
221 :type 'hook) | |
222 | |
223 (defun bubbles-customize () | |
224 "Open customization buffer for bubbles." | |
225 (interactive) | |
226 (customize-group 'bubbles)) | |
227 | |
228 ;; ====================================================================== | |
229 ;; internal variables | |
230 | |
231 (defvar bubbles--score 0 | |
232 "Current Bubbles score.") | |
233 | |
234 (defvar bubbles--neighbourhood-score 0 | |
235 "Score of active bubbles neighbourhood.") | |
236 | |
237 (defvar bubbles--faces nil | |
238 "List of currently used faces.") | |
239 | |
240 (defvar bubbles--playing nil | |
241 "Play status indicator.") | |
242 | |
243 (defvar bubbles--empty-image nil | |
244 "Image used for removed bubbles (empty grid cells).") | |
245 | |
246 (defvar bubbles--images nil | |
247 "List of images for bubbles.") | |
248 | |
249 (defvar bubbles--images-ok nil | |
250 "Indicate whether images have been created successfully.") | |
251 | |
252 (defvar bubbles--col-offset 0 | |
253 "Horizontal offset for centering the bubbles grid.") | |
254 | |
255 (defvar bubbles--row-offset 0 | |
256 "Vertical offset for centering the bubbles grid.") | |
257 | |
258 (defvar bubbles--save-data nil | |
259 "List containing bubbles save data (SCORE BUFFERCONTENTS).") | |
260 | |
261 (defconst bubbles--image-template-circle | |
262 "/* XPM */ | |
263 static char * dot_xpm[] = { | |
264 \"20 20 2 1\", | |
265 \" c None\", | |
266 \". c #FFFFFF\", | |
267 \" ...... \", | |
268 \" .......... \", | |
269 \" .............. \", | |
270 \" ................ \", | |
271 \" ................ \", | |
272 \" .................. \", | |
273 \" .................. \", | |
274 \"....................\", | |
275 \"....................\", | |
276 \"....................\", | |
277 \"....................\", | |
278 \"....................\", | |
279 \"....................\", | |
280 \" .................. \", | |
281 \" .................. \", | |
282 \" ................ \", | |
283 \" ................ \", | |
284 \" .............. \", | |
285 \" .......... \", | |
286 \" ...... \"};") | |
287 | |
288 (defconst bubbles--image-template-square | |
289 "/* XPM */ | |
290 static char * dot_xpm[] = { | |
291 \"20 20 2 1\", | |
292 \"0 c None\", | |
293 \"1 c #FFFFFF\", | |
294 \"00000000000000000000\", | |
295 \"01111111111111111110\", | |
296 \"01111111111111111110\", | |
297 \"01111111111111111110\", | |
298 \"01111111111111111110\", | |
299 \"01111111111111111110\", | |
300 \"01111111111111111110\", | |
301 \"01111111111111111110\", | |
302 \"01111111111111111110\", | |
303 \"01111111111111111110\", | |
304 \"01111111111111111110\", | |
305 \"01111111111111111110\", | |
306 \"01111111111111111110\", | |
307 \"01111111111111111110\", | |
308 \"01111111111111111110\", | |
309 \"01111111111111111110\", | |
310 \"01111111111111111110\", | |
311 \"01111111111111111110\", | |
312 \"01111111111111111110\", | |
313 \"00000000000000000000\"};") | |
314 | |
315 (defconst bubbles--image-template-diamond | |
316 "/* XPM */ | |
317 static char * dot_xpm[] = { | |
318 \"20 20 2 1\", | |
319 \"0 c None\", | |
320 \"1 c #FFFFFF\", | |
321 \"00000000011000000000\", | |
322 \"00000000111100000000\", | |
323 \"00000001111110000000\", | |
324 \"00000011111111000000\", | |
325 \"00000111111111100000\", | |
326 \"00001111111111110000\", | |
327 \"00011111111111111000\", | |
328 \"00111111111111111100\", | |
329 \"01111111111111111110\", | |
330 \"11111111111111111111\", | |
331 \"01111111111111111110\", | |
332 \"00111111111111111100\", | |
333 \"00011111111111111000\", | |
334 \"00001111111111110000\", | |
335 \"00000111111111100000\", | |
336 \"00000011111111000000\", | |
337 \"00000001111110000000\", | |
338 \"00000000111100000000\", | |
339 \"00000000011000000000\", | |
340 \"00000000000000000000\"};") | |
341 | |
342 (defconst bubbles--image-template-emacs | |
343 "/* XPM */ | |
344 static char * emacs_24_xpm[] = { | |
345 \"24 24 129 2\", | |
346 \" c None\", | |
347 \". c #837DA4\", | |
348 \"+ c #807AA0\", | |
349 \"@ c #9894B2\", | |
350 \"# c #CCCAD9\", | |
351 \"$ c #C2C0D2\", | |
352 \"% c #B6B3C9\", | |
353 \"& c #A19DB9\", | |
354 \"* c #8681A5\", | |
355 \"= c #7D779B\", | |
356 \"- c #B6B3C7\", | |
357 \"; c #ABA7BE\", | |
358 \"> c #9792AF\", | |
359 \", c #AAA6BD\", | |
360 \"' c #CBC9D7\", | |
361 \") c #AAA7BE\", | |
362 \"! c #908BAA\", | |
363 \"~ c #797397\", | |
364 \"{ c #948FAC\", | |
365 \"] c #9A95B1\", | |
366 \"^ c #EBEAEF\", | |
367 \"/ c #F1F1F5\", | |
368 \"( c #BCB9CB\", | |
369 \"_ c #A9A5BD\", | |
370 \": c #757093\", | |
371 \"< c #918DA9\", | |
372 \"[ c #DDDBE4\", | |
373 \"} c #FFFFFF\", | |
374 \"| c #EAE9EF\", | |
375 \"1 c #A7A4BA\", | |
376 \"2 c #716C8F\", | |
377 \"3 c #8D89A5\", | |
378 \"4 c #9C98B1\", | |
379 \"5 c #DBDAE3\", | |
380 \"6 c #A4A1B7\", | |
381 \"7 c #6E698A\", | |
382 \"8 c #8B87A1\", | |
383 \"9 c #928EA7\", | |
384 \"0 c #C5C3D1\", | |
385 \"a c #F8F8F9\", | |
386 \"b c #CCCAD6\", | |
387 \"c c #A29FB4\", | |
388 \"d c #6A6585\", | |
389 \"e c #88849D\", | |
390 \"f c #B5B2C2\", | |
391 \"g c #F0F0F3\", | |
392 \"h c #E1E0E6\", | |
393 \"i c #A5A2B5\", | |
394 \"j c #A09DB1\", | |
395 \"k c #676281\", | |
396 \"l c #85819A\", | |
397 \"m c #9591A7\", | |
398 \"n c #E1E0E5\", | |
399 \"o c #F0EFF2\", | |
400 \"p c #B3B0C0\", | |
401 \"q c #9D9AAE\", | |
402 \"r c #635F7C\", | |
403 \"s c #827F96\", | |
404 \"t c #9997AA\", | |
405 \"u c #F7F7F9\", | |
406 \"v c #C8C7D1\", | |
407 \"w c #89869D\", | |
408 \"x c #9B99AB\", | |
409 \"y c #5F5B78\", | |
410 \"z c #7F7C93\", | |
411 \"A c #CFCDD6\", | |
412 \"B c #B7B5C2\", | |
413 \"C c #9996A9\", | |
414 \"D c #5C5873\", | |
415 \"E c #7A778D\", | |
416 \"F c #F5F5F6\", | |
417 \"G c #8E8C9E\", | |
418 \"H c #7D798F\", | |
419 \"I c #58546F\", | |
420 \"J c #6C6981\", | |
421 \"K c #D5D4DB\", | |
422 \"L c #F5F4F6\", | |
423 \"M c #9794A5\", | |
424 \"N c #625F78\", | |
425 \"O c #79768C\", | |
426 \"P c #55516A\", | |
427 \"Q c #605C73\", | |
428 \"R c #CAC9D1\", | |
429 \"S c #EAE9EC\", | |
430 \"T c #B4B3BE\", | |
431 \"U c #777488\", | |
432 \"V c #514E66\", | |
433 \"W c #DEDEE2\", | |
434 \"X c #F4F4F5\", | |
435 \"Y c #9D9BA9\", | |
436 \"Z c #747185\", | |
437 \"` c #4E4B62\", | |
438 \" . c #DEDDE1\", | |
439 \".. c #A6A5B0\", | |
440 \"+. c #716F81\", | |
441 \"@. c #4A475D\", | |
442 \"#. c #A4A3AE\", | |
443 \"$. c #F4F3F5\", | |
444 \"%. c #777586\", | |
445 \"&. c #6E6C7D\", | |
446 \"*. c #464358\", | |
447 \"=. c #514E62\", | |
448 \"-. c #B9B8C0\", | |
449 \";. c #D1D0D5\", | |
450 \">. c #747282\", | |
451 \",. c #6B6979\", | |
452 \"'. c #434054\", | |
453 \"). c #5A5769\", | |
454 \"!. c #D0CFD4\", | |
455 \"~. c #5B5869\", | |
456 \"{. c #696676\", | |
457 \"]. c #403D50\", | |
458 \"^. c #DBDADE\", | |
459 \"/. c #F3F3F4\", | |
460 \"(. c #646271\", | |
461 \"_. c #666473\", | |
462 \":. c #3D3A4C\", | |
463 \"<. c #555362\", | |
464 \"[. c #9E9DA6\", | |
465 \"}. c #9E9CA5\", | |
466 \"|. c #646170\", | |
467 \"1. c #393647\", | |
468 \"2. c #514E5D\", | |
469 \"3. c #83818C\", | |
470 \"4. c #A8A7AE\", | |
471 \"5. c #E6E6E8\", | |
472 \"6. c #DAD9DC\", | |
473 \"7. c #353343\", | |
474 \"8. c #32303E\", | |
475 \" . . . . . . . . . . . . . . . . . . \", | |
476 \" + @ # $ % % % % % % % % % % % % % % & * + + \", | |
477 \" = - ; > > > > > > > > , ' ) > > > > > > ! = \", | |
478 \"~ ~ { { { { { { { { { { { ] ^ / ( { { { { _ ~ ~ \", | |
479 \": : < < < < < < < < < < < < [ } } | < < < 1 : : \", | |
480 \"2 2 3 3 3 3 3 3 3 3 3 3 4 5 } } } 5 3 3 3 6 2 2 \", | |
481 \"7 7 8 8 8 8 8 8 8 8 9 0 a } } } b 8 8 8 8 c 7 7 \", | |
482 \"d d e e e e e e e f g } } } h i e e e e e j d d \", | |
483 \"k k l l l l l m n } } } o p l l l l l l l q k k \", | |
484 \"r r s s s s t u } } } v w s s s s s s s s x r r \", | |
485 \"y y z z z z A } } } B z z z z z z z z z z C y y \", | |
486 \"D D D D D D E F } } G D D D D D D D D D D H D D \", | |
487 \"I I I I I I I J K } L M N I I I I I I I I O I I \", | |
488 \"P P P P P P Q R } } } S T P P P P P P P P U P P \", | |
489 \"V V V V V V W } } X Y V V V V V V V V V V Z V V \", | |
490 \"` ` ` ` ` ` .} } ..` ` ` ` ` ` ` ` ` ` ` +.` ` \", | |
491 \"@.@.@.@.@.@.@.#.$.$.%.@.@.@.@.@.@.@.@.@.@.&.@.@.\", | |
492 \"*.*.*.*.*.*.*.*.=.-.} ;.>.*.*.*.*.*.*.*.*.,.*.*.\", | |
493 \"'.'.'.'.'.'.'.'.'.'.).!.} !.~.'.'.'.'.'.'.{.'.'.\", | |
494 \"].].].].].].].].].].].].^.} /.(.].].].].]._.].].\", | |
495 \":.:.:.:.:.:.:.:.:.:.<.[./.} } }.:.:.:.:.:.|.:.:.\", | |
496 \" 1.1.1.1.1.1.1.1.2.3.4.5.6.3.1.1.1.1.1.1.1.1. \", | |
497 \" 7.7.7.7.7.7.7.7.7.7.7.7.7.7.7.7.7.7.7.7.7.7. \", | |
498 \" 8.8.8.8.8.8.8.8.8.8.8.8.8.8.8.8.8.8. \"};") | |
499 | |
500 (defconst bubbles--image-template-ball | |
501 "/* XPM */ | |
502 static char * dot3d_xpm[] = { | |
503 \"20 20 190 2\", | |
504 \" c None\", | |
505 \". c #F9F6F6\", | |
506 \"+ c #D6D0D0\", | |
507 \"@ c #BFBBBB\", | |
508 \"# c #AAA4A4\", | |
509 \"$ c #ABAAAB\", | |
510 \"% c #A8A8A8\", | |
511 \"& c #A29D9D\", | |
512 \"* c #B5B2B2\", | |
513 \"= c #CDC9C9\", | |
514 \"- c #D7D0D0\", | |
515 \"; c #B3AFAF\", | |
516 \"> c #B5B5B5\", | |
517 \", c #B7B7B7\", | |
518 \"' c #B8B8B8\", | |
519 \") c #B6B6B6\", | |
520 \"! c #B3B3B3\", | |
521 \"~ c #AFAFAF\", | |
522 \"{ c #A9A9A9\", | |
523 \"] c #A2A2A2\", | |
524 \"^ c #9C9A9A\", | |
525 \"/ c #C9C5C5\", | |
526 \"( c #FDFBFB\", | |
527 \"_ c #C3BCBC\", | |
528 \": c #BBBBBB\", | |
529 \"< c #C0C0C0\", | |
530 \"[ c #C3C2C2\", | |
531 \"} c #C3C3C3\", | |
532 \"| c #C2C2C2\", | |
533 \"1 c #BEBEBE\", | |
534 \"2 c #B9B9B9\", | |
535 \"3 c #B2B2B2\", | |
536 \"4 c #ABAAAA\", | |
537 \"5 c #999999\", | |
538 \"6 c #ACA7A7\", | |
539 \"7 c #C2BBBB\", | |
540 \"8 c #C5C5C5\", | |
541 \"9 c #CACBCB\", | |
542 \"0 c #CECECE\", | |
543 \"a c #CFCFCF\", | |
544 \"b c #CDCDCD\", | |
545 \"c c #C8C9C9\", | |
546 \"d c #9F9F9F\", | |
547 \"e c #959595\", | |
548 \"f c #A9A5A5\", | |
549 \"g c #D5CFCE\", | |
550 \"h c #BDBDBD\", | |
551 \"i c #C6C6C6\", | |
552 \"j c #D5D5D5\", | |
553 \"k c #D9D9D9\", | |
554 \"l c #DADADA\", | |
555 \"m c #D8D8D8\", | |
556 \"n c #D2D2D2\", | |
557 \"o c #CBCBCB\", | |
558 \"p c #A4A4A5\", | |
559 \"q c #9A9A9A\", | |
560 \"r c #8F8F8F\", | |
561 \"s c #C3BFBF\", | |
562 \"t c #AFACAB\", | |
563 \"u c #CCCCCC\", | |
564 \"v c #D6D6D6\", | |
565 \"w c #DEDEDE\", | |
566 \"x c #E4E4E4\", | |
567 \"y c #E5E5E5\", | |
568 \"z c #E2E2E2\", | |
569 \"A c #DBDBDB\", | |
570 \"B c #C9C8C8\", | |
571 \"C c #A8A9A8\", | |
572 \"D c #9D9E9D\", | |
573 \"E c #929292\", | |
574 \"F c #8A8888\", | |
575 \"G c #D3CECE\", | |
576 \"H c #B0B0B0\", | |
577 \"I c #D1D1D1\", | |
578 \"J c #DCDCDC\", | |
579 \"K c #E6E6E6\", | |
580 \"L c #EEEEEE\", | |
581 \"M c #F1F1F0\", | |
582 \"N c #EBEBEB\", | |
583 \"O c #D7D7D8\", | |
584 \"P c #ABABAB\", | |
585 \"Q c #A0A0A0\", | |
586 \"R c #949494\", | |
587 \"S c #898989\", | |
588 \"T c #C0BDBD\", | |
589 \"U c #B9B6B6\", | |
590 \"V c #B1B1B1\", | |
591 \"W c #BCBCBC\", | |
592 \"X c #C8C8C8\", | |
593 \"Y c #D3D3D3\", | |
594 \"Z c #DFDFDE\", | |
595 \"` c #EAEAEA\", | |
596 \" . c #F5F5F5\", | |
597 \".. c #FAFAFA\", | |
598 \"+. c #F1F1F1\", | |
599 \"@. c #CECFCF\", | |
600 \"#. c #ACACAC\", | |
601 \"$. c #A1A1A1\", | |
602 \"%. c #8A8A8A\", | |
603 \"&. c #9B9999\", | |
604 \"*. c #C7C7C7\", | |
605 \"=. c #DDDDDD\", | |
606 \"-. c #E8E8E8\", | |
607 \";. c #F2F2F2\", | |
608 \">. c #898A89\", | |
609 \",. c #7A7878\", | |
610 \"'. c #AEAEAE\", | |
611 \"). c #C4C4C4\", | |
612 \"!. c #CBCBCA\", | |
613 \"~. c #AAAAAA\", | |
614 \"{. c #939393\", | |
615 \"]. c #888888\", | |
616 \"^. c #7C7C7C\", | |
617 \"/. c #AAAAAB\", | |
618 \"(. c #BFBFBF\", | |
619 \"_. c #C9C9C9\", | |
620 \":. c #DFDEDF\", | |
621 \"<. c #A6A6A6\", | |
622 \"[. c #9B9B9B\", | |
623 \"}. c #909191\", | |
624 \"|. c #858586\", | |
625 \"1. c #797979\", | |
626 \"2. c #989494\", | |
627 \"3. c #A5A6A5\", | |
628 \"4. c #B9B9B8\", | |
629 \"5. c #C1C1C1\", | |
630 \"6. c #CFCFCE\", | |
631 \"7. c #979797\", | |
632 \"8. c #8D8D8D\", | |
633 \"9. c #828282\", | |
634 \"0. c #747171\", | |
635 \"a. c #ADAAAA\", | |
636 \"b. c #A9A8A9\", | |
637 \"c. c #B8B9B9\", | |
638 \"d. c #A5A5A5\", | |
639 \"e. c #9C9C9C\", | |
640 \"f. c #7E7E7D\", | |
641 \"g. c #929191\", | |
642 \"h. c #C9C4C4\", | |
643 \"i. c #989898\", | |
644 \"j. c #ADADAD\", | |
645 \"k. c #9D9D9D\", | |
646 \"l. c #8C8C8C\", | |
647 \"m. c #787878\", | |
648 \"n. c #B8B6B6\", | |
649 \"o. c #939191\", | |
650 \"p. c #A5A5A6\", | |
651 \"q. c #ABABAA\", | |
652 \"r. c #A8A8A9\", | |
653 \"s. c #A3A3A3\", | |
654 \"t. c #858585\", | |
655 \"u. c #757474\", | |
656 \"v. c #C5C1C1\", | |
657 \"w. c #969696\", | |
658 \"x. c #9B9B9C\", | |
659 \"y. c #A4A4A4\", | |
660 \"z. c #9E9E9E\", | |
661 \"A. c #939394\", | |
662 \"B. c #7D7D7D\", | |
663 \"C. c #747474\", | |
664 \"D. c #B7B5B5\", | |
665 \"E. c #A5A1A1\", | |
666 \"F. c #919191\", | |
667 \"G. c #9A9999\", | |
668 \"H. c #838383\", | |
669 \"I. c #757575\", | |
670 \"J. c #939090\", | |
671 \"K. c #A29E9E\", | |
672 \"L. c #868686\", | |
673 \"M. c #8D8D8C\", | |
674 \"N. c #8E8E8E\", | |
675 \"O. c #8D8D8E\", | |
676 \"P. c #8B8C8C\", | |
677 \"Q. c #848485\", | |
678 \"R. c #7F7F80\", | |
679 \"S. c #7A7A7A\", | |
680 \"T. c #737373\", | |
681 \"U. c #929090\", | |
682 \"V. c #828080\", | |
683 \"W. c #818181\", | |
684 \"X. c #808080\", | |
685 \"Y. c #7E7E7E\", | |
686 \"Z. c #737272\", | |
687 \"`. c #B7B4B4\", | |
688 \" + c #BCBABA\", | |
689 \".+ c #959494\", | |
690 \"++ c #747172\", | |
691 \"@+ c #767676\", | |
692 \"#+ c #6F6D6D\", | |
693 \"$+ c #8F8E8E\", | |
694 \" . + @ # $ % & * = . \", | |
695 \" - ; > , ' ) ! ~ { ] ^ / \", | |
696 \" ( _ > : < [ } | 1 2 3 4 ] 5 6 ( \", | |
697 \" 7 ) 1 8 9 0 a b c | : 3 { d e f \", | |
698 \" g ! h i 0 j k l m n o | 2 ~ p q r s \", | |
699 \". t ' | u v w x y z A n B 1 ! C D E F . \", | |
700 \"G H : i I J K L M N z O b | ) P Q R S T \", | |
701 \"U V W X Y Z ` ...+.y l @.} ' #.$.e %.&.\", | |
702 \"& H W *.n =.-.;. .L x k 0 [ , #.Q e >.,.\", | |
703 \"] '.2 ).a k z -.` K w j !.< > ~.d {.].^.\", | |
704 \"d /.> (._.I k =.:.J v 0 8 : V <.[.}.|.1.\", | |
705 \"2.3.~ 4.5._.6.n Y I u i 1 > P $.7.8.9.0.\", | |
706 \"a.d b.V c.(.).*.X i | h ) '.d.e.E ].f.g.\", | |
707 \"h.i.$.C ~ > 2 W W : ' ! j.d.k.e l.9.m.n.\", | |
708 \". o.i.d p.q.'.H V H j.r.s.k.e 8.t.^.u.. \", | |
709 \" v.r w.x.Q s.d.d.y.] z.5 A.8.t.B.C.D. \", | |
710 \" E.l.F.e i.G.q 5 7.{.r %.H.^.I.J. \", | |
711 \" ( K.L.%.M.N.N.O.P.S Q.R.S.T.U.( \", | |
712 \" @ V.W.H.H.9.X.Y.S.I.Z.`. \", | |
713 \" . +.+++@+C.#+$+D.. \"};") | |
714 | |
715 ;; ====================================================================== | |
716 ;; Functions | |
717 | |
718 (defsubst bubbles--grid-width () | |
719 "Return the grid width for the current game theme." | |
720 (car (case bubbles-game-theme | |
721 ('easy | |
722 bubbles--grid-small) | |
723 ('medium | |
724 bubbles--grid-medium) | |
725 ('difficult | |
726 bubbles--grid-large) | |
727 ('hard | |
728 bubbles--grid-huge) | |
729 ('user-defined | |
730 bubbles-grid-size)))) | |
731 | |
732 (defsubst bubbles--grid-height () | |
733 "Return the grid height for the current game theme." | |
734 (cdr (case bubbles-game-theme | |
735 ('easy | |
736 bubbles--grid-small) | |
737 ('medium | |
738 bubbles--grid-medium) | |
739 ('difficult | |
740 bubbles--grid-large) | |
741 ('hard | |
742 bubbles--grid-huge) | |
743 ('user-defined | |
744 bubbles-grid-size)))) | |
745 | |
746 (defsubst bubbles--colors () | |
747 "Return the color list for the current game theme." | |
748 (case bubbles-game-theme | |
749 ('easy | |
750 bubbles--colors-2) | |
751 ('medium | |
752 bubbles--colors-3) | |
753 ('difficult | |
754 bubbles--colors-4) | |
755 ('hard | |
756 bubbles--colors-5) | |
757 ('user-defined | |
758 bubbles-colors))) | |
759 | |
760 (defsubst bubbles--shift-mode () | |
761 "Return the shift mode for the current game theme." | |
762 (case bubbles-game-theme | |
763 ('easy | |
764 'default) | |
765 ('medium | |
766 'default) | |
767 ('difficult | |
768 'always) | |
769 ('hard | |
770 'always) | |
771 ('user-defined | |
772 bubbles-shift-mode))) | |
773 | |
774 (defun bubbles-save-settings () | |
775 "Save current customization settings." | |
776 (interactive) | |
777 (custom-set-variables | |
778 (list 'bubbles-game-theme `(quote ,bubbles-game-theme) t) | |
779 (list 'bubbles-graphics-theme `(quote ,bubbles-graphics-theme) t)) | |
780 (customize-save-customized)) | |
781 | |
782 (defsubst bubbles--empty-char () | |
783 "The character used for removed bubbles (empty grid cells)." | |
784 ? ) | |
785 | |
786 (defun bubbles-set-graphics-theme-ascii () | |
787 "Set graphics theme to `ascii'." | |
788 (interactive) | |
789 (setq bubbles-graphics-theme 'ascii) | |
790 (bubbles--update-faces-or-images)) | |
791 | |
792 (defun bubbles-set-graphics-theme-circles () | |
793 "Set graphics theme to `circles'." | |
794 (interactive) | |
795 (setq bubbles-graphics-theme 'circles) | |
796 (bubbles--initialize-images) | |
797 (bubbles--update-faces-or-images)) | |
798 | |
799 (defun bubbles-set-graphics-theme-squares () | |
800 "Set graphics theme to `squares'." | |
801 (interactive) | |
802 (setq bubbles-graphics-theme 'squares) | |
803 (bubbles--initialize-images) | |
804 (bubbles--update-faces-or-images)) | |
805 | |
806 (defun bubbles-set-graphics-theme-diamonds () | |
807 "Set graphics theme to `diamonds'." | |
808 (interactive) | |
809 (setq bubbles-graphics-theme 'diamonds) | |
810 (bubbles--initialize-images) | |
811 (bubbles--update-faces-or-images)) | |
812 | |
813 (defun bubbles-set-graphics-theme-balls () | |
814 "Set graphics theme to `balls'." | |
815 (interactive) | |
816 (setq bubbles-graphics-theme 'balls) | |
817 (bubbles--initialize-images) | |
818 (bubbles--update-faces-or-images)) | |
819 | |
820 (defun bubbles-set-graphics-theme-emacs () | |
821 "Set graphics theme to `emacs'." | |
822 (interactive) | |
823 (setq bubbles-graphics-theme 'emacs) | |
824 (bubbles--initialize-images) | |
825 (bubbles--update-faces-or-images)) | |
826 | |
827 ;; bubbles mode map | |
828 (defvar bubbles-mode-map | |
829 (make-keymap 'bubbles-mode-map)) | |
830 (define-key bubbles-mode-map "q" 'bubbles-quit) | |
831 (define-key bubbles-mode-map "\n" 'bubbles-plop) | |
832 (define-key bubbles-mode-map " " 'bubbles-plop) | |
833 (define-key bubbles-mode-map [double-down-mouse-1] 'bubbles-plop) | |
834 (define-key bubbles-mode-map [mouse-2] 'bubbles-plop) | |
835 (define-key bubbles-mode-map "\C-m" 'bubbles-plop) | |
836 (define-key bubbles-mode-map "u" 'bubbles-undo) | |
837 (define-key bubbles-mode-map "p" 'previous-line) | |
838 (define-key bubbles-mode-map "n" 'next-line) | |
839 (define-key bubbles-mode-map "f" 'forward-char) | |
840 (define-key bubbles-mode-map "b" 'backward-char) | |
841 | |
842 | |
843 ;; game theme menu | |
844 (defvar bubbles-game-theme-menu (make-sparse-keymap "Game Theme")) | |
845 (define-key bubbles-game-theme-menu [bubbles-set-game-userdefined] | |
846 (list 'menu-item "User defined" 'bubbles-set-game-userdefined | |
847 :button '(:radio . (eq bubbles-game-theme 'user-defined)))) | |
848 (define-key bubbles-game-theme-menu [bubbles-set-game-hard] | |
849 (list 'menu-item "Hard" 'bubbles-set-game-hard | |
850 :button '(:radio . (eq bubbles-game-theme 'hard)))) | |
851 (define-key bubbles-game-theme-menu [bubbles-set-game-difficult] | |
852 (list 'menu-item "Difficult" 'bubbles-set-game-difficult | |
853 :button '(:radio . (eq bubbles-game-theme 'difficult)))) | |
854 (define-key bubbles-game-theme-menu [bubbles-set-game-medium] | |
855 (list 'menu-item "Medium" 'bubbles-set-game-medium | |
856 :button '(:radio . (eq bubbles-game-theme 'medium)))) | |
857 (define-key bubbles-game-theme-menu [bubbles-set-game-easy] | |
858 (list 'menu-item "Easy" 'bubbles-set-game-easy | |
859 :button '(:radio . (eq bubbles-game-theme 'easy)))) | |
860 | |
861 ;; graphics theme menu | |
862 (defvar bubbles-graphics-theme-menu (make-sparse-keymap "Graphics Theme")) | |
863 (define-key bubbles-graphics-theme-menu [bubbles-set-graphics-theme-ascii] | |
864 (list 'menu-item "ASCII" 'bubbles-set-graphics-theme-ascii | |
865 :button '(:radio . (eq bubbles-graphics-theme 'ascii)))) | |
866 (define-key bubbles-graphics-theme-menu [bubbles-set-graphics-theme-emacs] | |
867 (list 'menu-item "Emacs" 'bubbles-set-graphics-theme-emacs | |
868 :button '(:radio . (eq bubbles-graphics-theme 'emacs)))) | |
869 (define-key bubbles-graphics-theme-menu [bubbles-set-graphics-theme-balls] | |
870 (list 'menu-item "Balls" 'bubbles-set-graphics-theme-balls | |
871 :button '(:radio . (eq bubbles-graphics-theme 'balls)))) | |
872 (define-key bubbles-graphics-theme-menu [bubbles-set-graphics-theme-diamonds] | |
873 (list 'menu-item "Diamonds" 'bubbles-set-graphics-theme-diamonds | |
874 :button '(:radio . (eq bubbles-graphics-theme 'diamonds)))) | |
875 (define-key bubbles-graphics-theme-menu [bubbles-set-graphics-theme-squares] | |
876 (list 'menu-item "Squares" 'bubbles-set-graphics-theme-squares | |
877 :button '(:radio . (eq bubbles-graphics-theme 'squares)))) | |
878 (define-key bubbles-graphics-theme-menu [bubbles-set-graphics-theme-circles] | |
879 (list 'menu-item "Circles" 'bubbles-set-graphics-theme-circles | |
880 :button '(:radio . (eq bubbles-graphics-theme 'circles)))) | |
881 | |
882 ;; menu | |
883 (defvar bubbles-menu (make-sparse-keymap "Bubbles")) | |
884 (define-key bubbles-menu [bubbles-quit] | |
885 (list 'menu-item "Quit" 'bubbles-quit)) | |
886 (define-key bubbles-menu [bubbles] | |
887 (list 'menu-item "New game" 'bubbles)) | |
888 (define-key bubbles-menu [bubbles-separator-1] | |
889 '("--")) | |
890 (define-key bubbles-menu [bubbles-save-settings] | |
891 (list 'menu-item "Save all settings" 'bubbles-save-settings)) | |
892 (define-key bubbles-menu [bubbles-customize] | |
893 (list 'menu-item "Edit all settings" 'bubbles-customize)) | |
894 (define-key bubbles-menu [bubbles-game-theme-menu] | |
895 (list 'menu-item "Game Theme" bubbles-game-theme-menu)) | |
896 (define-key bubbles-menu [bubbles-graphics-theme-menu] | |
897 (list 'menu-item "Graphics Theme" bubbles-graphics-theme-menu | |
898 :enable 'bubbles--playing)) | |
899 (define-key bubbles-menu [bubbles-separator-2] | |
900 '("--")) | |
901 (define-key bubbles-menu [bubbles-undo] | |
902 (list 'menu-item "Undo last move" 'bubbles-undo | |
903 :enable '(and bubbles--playing bubbles--save-data))) | |
904 | |
905 ;; bind menu to mouse | |
906 (define-key bubbles-mode-map [down-mouse-3] bubbles-menu) | |
907 ;; Put menu in menu-bar | |
908 (define-key bubbles-mode-map [menu-bar Bubbles] | |
909 (cons "Bubbles" bubbles-menu)) | |
910 | |
911 (defun bubbles-mode () | |
912 "Major mode for playing bubbles. | |
913 \\{bubbles-mode-map}" | |
914 (kill-all-local-variables) | |
915 (use-local-map bubbles-mode-map) | |
916 (setq major-mode 'bubbles-mode) | |
917 (setq mode-name "Bubbles") | |
918 (setq buffer-read-only t) | |
919 (buffer-enable-undo) | |
920 (add-hook 'post-command-hook 'bubbles--mark-neighbourhood t t) | |
921 (run-hooks 'bubbles-mode-hook)) | |
922 | |
923 ;;;###autoload | |
924 (defun bubbles () | |
925 "Play Bubbles game." | |
926 (interactive) | |
927 (switch-to-buffer (get-buffer-create "*bubbles*")) | |
928 (when (or (not bubbles--playing) | |
929 (y-or-n-p "Start new game? ")) | |
930 (setq bubbles--save-data nil) | |
931 (setq bubbles--playing t) | |
932 (bubbles--initialize))) | |
933 | |
934 (defun bubbles-quit () | |
935 "Quit Bubbles." | |
936 (interactive) | |
937 (message "bubbles-quit") | |
938 (bury-buffer)) | |
939 | |
940 (defun bubbles--compute-offsets () | |
941 "Update horizontal and vertical offsets for centering the bubbles grid. | |
942 Set `bubbles--col-offset' and `bubbles--row-offset'." | |
943 (cond ((and (display-images-p) | |
944 bubbles--images-ok | |
945 (not (eq bubbles-graphics-theme 'ascii)) | |
946 (fboundp 'window-inside-pixel-edges)) | |
947 ;; compute offset in units of pixels | |
948 (let ((bubbles--image-size | |
949 (car (image-size (car bubbles--images) t)))) | |
950 (setq bubbles--col-offset | |
951 (list | |
952 (max 0 (/ (- (nth 2 (window-inside-pixel-edges)) | |
953 (nth 0 (window-inside-pixel-edges)) | |
954 (* ( + bubbles--image-size 2) ;; margin | |
955 (bubbles--grid-width))) 2)))) | |
956 (setq bubbles--row-offset | |
957 (list | |
958 (max 0 (/ (- (nth 3 (window-inside-pixel-edges)) | |
959 (nth 1 (window-inside-pixel-edges)) | |
960 (* (+ bubbles--image-size 1) ;; margin | |
961 (bubbles--grid-height))) 2)))))) | |
962 (t | |
963 ;; compute offset in units of chars | |
964 (setq bubbles--col-offset | |
965 (max 0 (/ (- (window-width) | |
966 (bubbles--grid-width)) 2))) | |
967 (setq bubbles--row-offset | |
968 (max 0 (/ (- (window-height) | |
969 (bubbles--grid-height) 2) 2)))))) | |
970 | |
971 (defun bubbles--remove-overlays () | |
972 "Remove all overlays." | |
973 (if (fboundp 'remove-overlays) | |
974 (remove-overlays))) | |
975 | |
976 (defun bubbles--initialize () | |
977 "Initialize Bubbles game." | |
978 (bubbles--initialize-faces) | |
979 (bubbles--initialize-images) | |
980 (bubbles--remove-overlays) | |
981 | |
982 (switch-to-buffer (get-buffer-create "*bubbles*")) | |
983 (bubbles--compute-offsets) | |
984 (let ((inhibit-read-only t)) | |
985 (set-buffer-modified-p nil) | |
986 (erase-buffer) | |
987 (insert " ") | |
988 (add-text-properties | |
989 (point-min) (point) (list 'intangible t 'display | |
990 (cons 'space | |
991 (list :height bubbles--row-offset)))) | |
992 (insert "\n") | |
993 (let ((max-char (length (bubbles--colors)))) | |
994 (dotimes (i (bubbles--grid-height)) | |
995 (let ((p (point))) | |
996 (insert " ") | |
997 (add-text-properties | |
998 p (point) (list 'intangible t | |
999 'display (cons 'space | |
1000 (list :width | |
1001 bubbles--col-offset))))) | |
1002 (dotimes (j (bubbles--grid-width)) | |
1003 (let* ((index (random max-char)) | |
1004 (char (nth index bubbles-chars))) | |
1005 (insert char) | |
1006 (add-text-properties (1- (point)) (point) (list 'index index)))) | |
1007 (insert "\n")) | |
1008 (insert "\n ") | |
1009 (add-text-properties | |
1010 (1- (point)) (point) (list 'intangible t 'display | |
1011 (cons 'space | |
1012 (list :width bubbles--col-offset))))) | |
1013 (put-text-property (point-min) (point-max) 'pointer 'arrow)) | |
1014 (bubbles-mode) | |
1015 (bubbles--reset-score) | |
1016 (bubbles--update-faces-or-images) | |
1017 (bubbles--goto 0 0)) | |
1018 | |
1019 (defun bubbles--initialize-faces () | |
1020 "Prepare faces for playing `bubbles'." | |
1021 (copy-face 'default 'bubbles--highlight-face) | |
1022 (set-face-background 'bubbles--highlight-face "#8080f4") | |
1023 (when (display-color-p) | |
1024 (setq bubbles--faces | |
1025 (mapcar (lambda (color) | |
1026 (let ((fname (intern (format "bubbles--face-%s" color)))) | |
1027 (unless (facep fname) | |
1028 (copy-face 'default fname) | |
1029 (set-face-foreground fname color)) | |
1030 fname)) | |
1031 (bubbles--colors))))) | |
1032 | |
1033 (defsubst bubbles--row (pos) | |
1034 "Return row of point POS." | |
1035 (save-excursion | |
1036 (goto-char pos) | |
1037 (beginning-of-line) | |
1038 (1- (count-lines (point-min) (point))))) | |
1039 | |
1040 (defsubst bubbles--col (pos) | |
1041 "Return column of point POS." | |
1042 (save-excursion | |
1043 (goto-char pos) | |
1044 (1- (current-column)))) | |
1045 | |
1046 (defun bubbles--goto (row col) | |
1047 "Move point to bubble at coordinates ROW and COL." | |
1048 (if (or (< row 0) | |
1049 (< col 0) | |
1050 (>= row (bubbles--grid-height)) | |
1051 (>= col (bubbles--grid-width))) | |
1052 ;; Error! return nil | |
1053 nil | |
1054 ;; go | |
1055 (goto-char (point-min)) | |
1056 (forward-line (1+ row)) | |
1057 (forward-char (1+ col)) | |
1058 (point))) | |
1059 | |
1060 (defun bubbles--char-at (row col) | |
1061 "Return character at bubble ROW and COL." | |
1062 (save-excursion | |
1063 (if (bubbles--goto row col) | |
1064 (char-after (point)) | |
1065 nil))) | |
1066 | |
1067 (defun bubbles--mark-direct-neighbours (row col char) | |
1068 "Mark direct neighbours of bubble at ROW COL with same CHAR." | |
1069 (save-excursion | |
1070 (let ((count 0)) | |
1071 (when (and (bubbles--goto row col) | |
1072 (eq char (char-after (point))) | |
1073 (not (get-text-property (point) 'active))) | |
1074 (add-text-properties (point) (1+ (point)) | |
1075 '(active t face 'bubbles--highlight-face)) | |
1076 (setq count (+ 1 | |
1077 (bubbles--mark-direct-neighbours row (1+ col) char) | |
1078 (bubbles--mark-direct-neighbours row (1- col) char) | |
1079 (bubbles--mark-direct-neighbours (1+ row) col char) | |
1080 (bubbles--mark-direct-neighbours (1- row) col char)))) | |
1081 count))) | |
1082 | |
1083 (defun bubbles--mark-neighbourhood (&optional pos) | |
1084 "Mark neighbourhood of point. | |
1085 Use optional parameter POS instead of point if given." | |
1086 (when bubbles--playing | |
1087 (unless pos (setq pos (point))) | |
1088 (condition-case err | |
1089 (let ((char (char-after pos)) | |
1090 (inhibit-read-only t) | |
1091 (row (bubbles--row (point))) | |
1092 (col (bubbles--col (point)))) | |
1093 (add-text-properties (point-min) (point-max) | |
1094 '(face default active nil)) | |
1095 (let ((count 0)) | |
1096 (when (and row col (not (eq char (bubbles--empty-char)))) | |
1097 (setq count (bubbles--mark-direct-neighbours row col char)) | |
1098 (unless (> count 1) | |
1099 (add-text-properties (point-min) (point-max) | |
1100 '(face default active nil)) | |
1101 (setq count 0))) | |
1102 (bubbles--update-neighbourhood-score count)) | |
1103 (put-text-property (point-min) (point-max) 'pointer 'arrow) | |
1104 (bubbles--update-faces-or-images) | |
1105 (sit-for 0)) | |
1106 (error (message "Bubbles: Internal error %s" err))))) | |
1107 | |
1108 (defun bubbles--neighbourhood-available () | |
1109 "Return t if another valid neighbourhood is available." | |
1110 (catch 'found | |
1111 (save-excursion | |
1112 (dotimes (i (bubbles--grid-height)) | |
1113 (dotimes (j (bubbles--grid-width)) | |
1114 (let ((c (bubbles--char-at i j))) | |
1115 (if (and (not (eq c (bubbles--empty-char))) | |
1116 (or (eq c (bubbles--char-at (1+ i) j)) | |
1117 (eq c (bubbles--char-at i (1+ j))))) | |
1118 (throw 'found t))))) | |
1119 nil))) | |
1120 | |
1121 (defun bubbles--count () | |
1122 "Count remaining bubbles." | |
1123 (let ((count 0)) | |
1124 (save-excursion | |
1125 (dotimes (i (bubbles--grid-height)) | |
1126 (dotimes (j (bubbles--grid-width)) | |
1127 (let ((c (bubbles--char-at i j))) | |
1128 (if (not (eq c (bubbles--empty-char))) | |
1129 (setq count (1+ count))))))) | |
1130 count)) | |
1131 | |
1132 (defun bubbles--reset-score () | |
1133 "Reset bubbles score." | |
1134 (setq bubbles--neighbourhood-score 0 | |
1135 bubbles--score 0) | |
1136 (bubbles--update-score)) | |
1137 | |
1138 (defun bubbles--update-score () | |
1139 "Calculate and display new bubble score." | |
1140 (setq bubbles--score (+ bubbles--score bubbles--neighbourhood-score)) | |
1141 (bubbles--show-scores)) | |
1142 | |
1143 (defun bubbles--update-neighbourhood-score (size) | |
1144 "Calculate and display score of active neighbourhood from its SIZE." | |
1145 (if (> size 1) | |
1146 (setq bubbles--neighbourhood-score (expt (- size 1) 2)) | |
1147 (setq bubbles--neighbourhood-score 0)) | |
1148 (bubbles--show-scores)) | |
1149 | |
1150 (defun bubbles--show-scores () | |
1151 "Display current scores." | |
1152 (save-excursion | |
1153 (goto-char (or (next-single-property-change (point-min) 'status) | |
1154 (point-max))) | |
1155 (let ((inhibit-read-only t) | |
1156 (pos (point))) | |
1157 (delete-region (point) (point-max)) | |
1158 (insert (format "Selected: %4d\n" bubbles--neighbourhood-score)) | |
1159 (insert " ") | |
1160 (add-text-properties (1- (point)) (point) | |
1161 (list 'intangible t 'display | |
1162 (cons 'space | |
1163 (list :width bubbles--col-offset)))) | |
1164 (insert (format "Score: %4d" bubbles--score)) | |
1165 (put-text-property pos (point) 'status t)))) | |
1166 | |
1167 (defun bubbles--game-over () | |
1168 "Finish bubbles game." | |
1169 (bubbles--update-faces-or-images) | |
1170 (setq bubbles--playing nil | |
1171 bubbles--save-data nil) | |
1172 ;; add bonus if all bubbles were removed | |
1173 (when (= 0 (bubbles--count)) | |
1174 (setq bubbles--score (+ bubbles--score (* (bubbles--grid-height) | |
1175 (bubbles--grid-width)))) | |
1176 (bubbles--show-scores)) | |
1177 ;; Game over message | |
1178 (goto-char (point-max)) | |
1179 (let* ((inhibit-read-only t)) | |
1180 (insert "\n ") | |
1181 (add-text-properties (1- (point)) (point) | |
1182 (list 'intangible t 'display | |
1183 (cons 'space | |
1184 (list :width bubbles--col-offset)))) | |
1185 (insert "Game Over!")) | |
1186 ;; save score | |
1187 (gamegrid-add-score (format "bubbles-%s-%d-%d-%d-scores" | |
1188 (symbol-name (bubbles--shift-mode)) | |
1189 (length (bubbles--colors)) | |
1190 (bubbles--grid-width) (bubbles--grid-height)) | |
1191 bubbles--score)) | |
1192 | |
1193 (defun bubbles-plop () | |
1194 "Remove active bubbles region." | |
1195 (interactive) | |
1196 (when (and bubbles--playing | |
1197 (> bubbles--neighbourhood-score 0)) | |
1198 (setq bubbles--save-data (list bubbles--score (buffer-string))) | |
1199 (setq buffer-undo-list '(apply bubbles-undo . nil)) | |
1200 (let ((inhibit-read-only t)) | |
1201 ;; blank out current neighbourhood | |
1202 (let ((row (bubbles--row (point))) | |
1203 (col (bubbles--col (point)))) | |
1204 (goto-char (point-max)) | |
1205 (while (not (bobp)) | |
1206 (backward-char) | |
1207 (while (get-text-property (point) 'active) | |
1208 (delete-char 1) | |
1209 (insert (bubbles--empty-char)) | |
1210 (add-text-properties (1- (point)) (point) (list 'removed t | |
1211 'index -1)))) | |
1212 (bubbles--goto row col)) | |
1213 ;; show new score | |
1214 (bubbles--update-score) | |
1215 ;; update display and wait | |
1216 (bubbles--update-faces-or-images) | |
1217 (sit-for 0) | |
1218 (sleep-for 0.2) | |
1219 (discard-input) | |
1220 ;; drop down | |
1221 (let ((something-dropped nil)) | |
1222 (save-excursion | |
1223 (dotimes (i (bubbles--grid-height)) | |
1224 (dotimes (j (bubbles--grid-width)) | |
1225 (bubbles--goto i j) | |
1226 (while (get-text-property (point) 'removed) | |
1227 (setq something-dropped (or (bubbles--shift 'top i j) | |
1228 something-dropped)))))) | |
1229 ;; update display and wait | |
1230 (bubbles--update-faces-or-images) | |
1231 (when something-dropped | |
1232 (sit-for 0))) | |
1233 (discard-input) | |
1234 ;; shift to left | |
1235 (put-text-property (point-min) (point-max) 'removed nil) | |
1236 (save-excursion | |
1237 (goto-char (point-min)) | |
1238 (let ((removed-string (format "%c" (bubbles--empty-char)))) | |
1239 (while (search-forward removed-string nil t) | |
1240 (put-text-property (1- (point)) (point) 'removed t)))) | |
1241 (let ((shifted nil)) | |
1242 (cond ((eq (bubbles--shift-mode) 'always) | |
1243 (save-excursion | |
1244 (dotimes (i (bubbles--grid-height)) | |
1245 (dotimes (j (bubbles--grid-width)) | |
1246 (bubbles--goto i j) | |
1247 (while (get-text-property (point) 'removed) | |
1248 (setq shifted (or (bubbles--shift 'right i j) shifted)))))) | |
1249 (bubbles--update-faces-or-images) | |
1250 (sleep-for 0.5)) | |
1251 (t ;; default shift-mode | |
1252 (save-excursion | |
1253 (dotimes (j (bubbles--grid-width)) | |
1254 (bubbles--goto (1- (bubbles--grid-height)) j) | |
1255 (let ((shifted-cols 0)) | |
1256 (while (get-text-property (point) 'removed) | |
1257 (setq shifted-cols (1+ shifted-cols)) | |
1258 (bubbles--shift 'right (1- (bubbles--grid-height)) j)) | |
1259 (dotimes (k shifted-cols) | |
1260 (let ((i (- (bubbles--grid-height) 2))) | |
1261 (while (>= i 0) | |
1262 (setq shifted (or (bubbles--shift 'right i j) shifted)) | |
1263 (setq i (1- i)))))))))) | |
1264 (when shifted | |
1265 ;;(sleep-for 0.5) | |
1266 (bubbles--update-faces-or-images) | |
1267 (sit-for 0))) | |
1268 (put-text-property (point-min) (point-max) 'removed nil) | |
1269 (unless (bubbles--neighbourhood-available) | |
1270 (bubbles--game-over))))) | |
1271 | |
1272 (defun bubbles-undo () | |
1273 "Undo last move." | |
1274 (interactive) | |
1275 (when bubbles--save-data | |
1276 (let ((inhibit-read-only t) | |
1277 (pos (point))) | |
1278 (erase-buffer) | |
1279 (insert (cadr bubbles--save-data)) | |
1280 (bubbles--update-faces-or-images) | |
1281 (setq bubbles--score (car bubbles--save-data)) | |
1282 (goto-char pos)))) | |
1283 | |
1284 (defun bubbles--shift (from row col) | |
1285 "Move bubbles FROM one side to position ROW COL. | |
1286 Return t if new char is non-empty." | |
1287 (save-excursion | |
1288 (when (bubbles--goto row col) | |
1289 (let ((char-org (char-after (point))) | |
1290 (char-new (bubbles--empty-char)) | |
1291 (removed nil) | |
1292 (trow row) | |
1293 (tcol col) | |
1294 (index -1)) | |
1295 (cond ((eq from 'top) | |
1296 (setq trow (1- row))) | |
1297 ((eq from 'left) | |
1298 (setq tcol (1- col))) | |
1299 ((eq from 'right) | |
1300 (setq tcol (1+ col)))) | |
1301 (save-excursion | |
1302 (when (bubbles--goto trow tcol) | |
1303 (setq char-new (char-after (point))) | |
1304 (setq removed (get-text-property (point) 'removed)) | |
1305 (setq index (get-text-property (point) 'index)) | |
1306 (bubbles--shift from trow tcol))) | |
1307 (insert char-new) | |
1308 (delete-char 1) | |
1309 (add-text-properties (1- (point)) (point) (list 'index index | |
1310 'removed removed)) | |
1311 (not (eq char-new (bubbles--empty-char))))))) | |
1312 | |
1313 (defun bubbles--initialize-images () | |
1314 "Prepare images for playing `bubbles'." | |
1315 (when (and (display-images-p) | |
1316 (not (eq bubbles-graphics-theme 'ascii))) | |
1317 (let ((template (case bubbles-graphics-theme | |
1318 ('circles bubbles--image-template-circle) | |
1319 ('balls bubbles--image-template-ball) | |
1320 ('squares bubbles--image-template-square) | |
1321 ('diamonds bubbles--image-template-diamond) | |
1322 ('emacs bubbles--image-template-emacs)))) | |
1323 (setq bubbles--empty-image | |
1324 (create-image (replace-regexp-in-string | |
1325 "^\"\\(.*\\)\t.*c .*\",$" | |
1326 "\"\\1\tc #FFFFFF\"," template) | |
1327 'xpm t | |
1328 ;;:mask 'heuristic | |
1329 :margin '(2 . 1))) | |
1330 (setq bubbles--images | |
1331 (mapcar (lambda (color) | |
1332 (let* ((rgb (color-values color)) | |
1333 (red (nth 0 rgb)) | |
1334 (green (nth 1 rgb)) | |
1335 (blue (nth 2 rgb))) | |
1336 (with-temp-buffer | |
1337 (insert template) | |
1338 (goto-char (point-min)) | |
1339 (re-search-forward | |
1340 "^\"[0-9]+ [0-9]+ \\(.*?\\) .*\",$" nil t) | |
1341 (goto-char (point-min)) | |
1342 (while (re-search-forward | |
1343 "^\"\\(.*\\)\t.*c \\(#.*\\)\",$" nil t) | |
1344 (let* ((crgb (color-values (match-string 2))) | |
1345 (r (nth 0 crgb)) | |
1346 (g (nth 1 crgb)) | |
1347 (b (nth 2 crgb)) | |
1348 (brightness (/ (+ r g b) 3.0 256 256)) | |
1349 (val (sin (* brightness (/ pi 2)))) | |
1350 (rr (* red val)) | |
1351 (gg (* green val)) | |
1352 (bb (* blue val)) | |
1353 ;;(rr (/ (+ red r) 2)) | |
1354 ;;(gg (/ (+ green g) 2)) | |
1355 ;;(bb (/ (+ blue b) 2)) | |
1356 (color (format "#%02x%02x%02x" | |
1357 (/ rr 256) (/ gg 256) | |
1358 (/ bb 256)))) | |
1359 (replace-match (format "\"\\1\tc %s\"," | |
1360 (upcase color))))) | |
1361 (create-image (buffer-string) 'xpm t | |
1362 :margin '(2 . 1) | |
1363 ;;:mask 'heuristic | |
1364 )))) | |
1365 (bubbles--colors)))) | |
1366 ;; check images | |
1367 (setq bubbles--images-ok bubbles--empty-image) | |
1368 (mapc (lambda (elt) | |
1369 (setq bubbles--images-ok (and bubbles--images-ok elt))) | |
1370 bubbles--images))) | |
1371 | |
1372 (defun bubbles--update-faces-or-images () | |
1373 "Update faces and/or images, depending on graphics mode." | |
1374 (bubbles--set-faces) | |
1375 (bubbles--show-images)) | |
1376 | |
1377 (defun bubbles--set-faces () | |
1378 "Update faces in the bubbles buffer." | |
1379 (unless (and (display-images-p) | |
1380 bubbles--images-ok | |
1381 (not (eq bubbles-graphics-theme 'ascii))) | |
1382 (when (display-color-p) | |
1383 (save-excursion | |
1384 (let ((inhibit-read-only t)) | |
1385 (dotimes (i (bubbles--grid-height)) | |
1386 (dotimes (j (bubbles--grid-width)) | |
1387 (bubbles--goto i j) | |
1388 (let* ((index (get-text-property (point) 'index)) | |
1389 (face (nth index bubbles--faces)) | |
1390 (fg-col (face-foreground face))) | |
1391 (when (get-text-property (point) 'active) | |
1392 (set-face-foreground 'bubbles--highlight-face "#ff0000") | |
1393 (setq face 'bubbles--highlight-face)) | |
1394 (put-text-property (point) (1+ (point)) | |
1395 'face face))))))))) | |
1396 | |
1397 (defun bubbles--show-images () | |
1398 "Update images in the bubbles buffer." | |
1399 (bubbles--remove-overlays) | |
1400 (if (and (display-images-p) | |
1401 bubbles--images-ok | |
1402 (not (eq bubbles-graphics-theme 'ascii))) | |
1403 (save-excursion | |
1404 (goto-char (point-min)) | |
1405 (forward-line 1) | |
1406 (let ((inhibit-read-only t) | |
1407 char) | |
1408 (dotimes (i (bubbles--grid-height)) | |
1409 (dotimes (j (bubbles--grid-width)) | |
1410 (forward-char 1) | |
1411 (let ((index (get-text-property (point) 'index))) | |
1412 (let ((img bubbles--empty-image)) | |
1413 (if (>= index 0) | |
1414 (setq img (nth index bubbles--images))) | |
1415 (put-text-property (point) (1+ (point)) | |
1416 'display (cons img nil))))) | |
1417 (forward-line 1)))) | |
1418 (save-excursion | |
1419 (let ((inhibit-read-only t)) | |
1420 (goto-char (point-min)) | |
1421 (while (not (eobp)) | |
1422 (let ((disp-prop (get-text-property (point) 'display))) | |
1423 (if (and (listp disp-prop) | |
1424 (listp (car disp-prop)) | |
1425 (eq (caar disp-prop) 'image)) | |
1426 (put-text-property (point) (1+ (point)) 'display nil)) | |
1427 (forward-char 1))) | |
1428 (put-text-property (point-min) (point-max) 'pointer 'arrow))))) | |
1429 | |
1430 (provide 'bubbles) | |
1431 | |
82929 | 1432 ;; arch-tag: 2cd7237a-b0ad-400d-a7fd-75f676dceb70 |
82921 | 1433 ;;; bubbles.el ends here |