HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
scheme interaction mode
[bpt/emacs.git] / lisp / play / bubbles.el
CommitLineData
c38e0c97 1;;; bubbles.el --- Puzzle game for Emacs -*- coding: utf-8 -*-
a79b55e5 2
ba318903 3;; Copyright (C) 2007-2014 Free Software Foundation, Inc.
a79b55e5 4
a79b55e5 5;; Author: Ulf Jasper <ulf.jasper@web.de>
a79b55e5
TTN		 6;; URL: http://ulf.epplejasper.de/
7;; Created: 5. Feb. 2007
2f123a54 8;; Keywords: games
a79b55e5 9
2f123a54 10;; This file is part of GNU Emacs.
a79b55e5 11
b1fc2b50 12;; GNU Emacs is free software: you can redistribute it and/or modify
a79b55e5 13;; it under the terms of the GNU General Public License as published by
b1fc2b50
GM		 14;; the Free Software Foundation, either version 3 of the License, or
15;; (at your option) any later version.
a79b55e5 16
2f123a54
TTN		 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.
a79b55e5
TTN		 21
22;; You should have received a copy of the GNU General Public License
b1fc2b50 23;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
a79b55e5
TTN		 24
25;;; Commentary:
26
27;; Bubbles is a puzzle game. Its goal is to remove as many bubbles as
28;; possible in as few moves as possible.
29
30;; Bubbles is an implementation of the "Same Game", similar to "Same
2f123a54 31;; GNOME" and many others, see <http://en.wikipedia.org/wiki/SameGame>.
a79b55e5
TTN		 32
33;; Installation
34;; ------------
35
865fe16f 36;; Add the following lines to your init file:
a79b55e5
TTN		 37;; (add-to-list 'load-path "/path/to/bubbles/")
38;; (autoload 'bubbles "bubbles" "Play Bubbles" t)
39
40;; ======================================================================
41
42;;; History:
43
a4fcacde
TTN		 44;; 0.5 (2007-09-14)
45;; - Minor bugfixes.
46
a79b55e5
TTN		 47;; 0.4 (2007-08-27)
48;; - Allow for undoing last move.
49;; - Bonus for removing all bubbles.
50;; - Speed improvements.
51;; - Animation enhancements.
52;; - Added `bubbles-mode-hook'.
53;; - Fixes: Don't move point.
54;; - New URL.
55
56;; 0.3 (2007-03-11)
57;; - Renamed shift modes and thus names of score files. All
3ed8598c 58;; high scores are lost, unless you rename the score files from
a79b55e5
TTN		 59;; bubbles-shift-... to bubbles-...!
60;; - Bugfixes: Check for successful image creation.
61;; Disable menus and counter when game is over.
62;; Tested with GNU Emacs 22.0.93
63
64;; 0.2 (2007-02-24)
65;; - Introduced game themes.
66;; - Introduced graphics themes (changeable while playing).
67;; - Added menu.
68;; - Customization: grid size, colors, chars, shift mode.
69;; - More keybindings.
70;; - Changed shift direction from to-right to to-left.
71;; - Bugfixes: Don't remove single-bubble regions;
72;; Animation glitches fixed.
73;; Tested with GNU Emacs 22.0.93 and 21.4.1.
74
75;; 0.1 (2007-02-11)
76;; Initial release. Tested with GNU Emacs 22.0.93 and 21.4.1.
77
78;; ======================================================================
79
80;;; Code:
81
a4fcacde 82(defconst bubbles-version "0.5" "Version number of bubbles.el.")
2f123a54 83
a79b55e5 84(require 'gamegrid)
a79b55e5
TTN		 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.
94The overall game theme specifies a grid size, a set of colors,
95and 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.
140It is safe to choose a graphical theme. If Emacs cannot display
141images 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.
190The length of this list determines how many different bubble
191types 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
c38e0c97 201 '(?+ ?O ?# ?X ?. ?* ?& ?ยง)
a79b55e5
TTN		 202 "Characters used for bubbles.
203Note that the actual number of different bubbles is determined by
204the number of colors, see `bubbles-colors'."
205 :type '(repeat character)
206 :group 'bubbles)
207
208(defcustom bubbles-shift-mode
209 'default
210 "Shift mode.
e73da129 211Available modes are `shift-default' and `shift-always'."
a79b55e5
TTN		 212 :type '(radio (const :tag "Default" default)
213 (const :tag "Shifter" always)
9c61f806 214 ;;(const :tag "Mega Shifter" mega)
a79b55e5
TTN		 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
4fa51741 234(defvar bubbles--neighborhood-score 0
a7c29764 235 "Score of active bubbles neighborhood.")
a79b55e5
TTN		 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 */
263static 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 */
290static 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 */
317static 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 */
344static 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 */
502static 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."
a464a6c7
SM		 720 (car (pcase bubbles-game-theme
721 (`easy
a79b55e5 722 bubbles--grid-small)
a464a6c7 723 (`medium
a79b55e5 724 bubbles--grid-medium)
a464a6c7 725 (`difficult
a79b55e5 726 bubbles--grid-large)
a464a6c7 727 (`hard
a79b55e5 728 bubbles--grid-huge)
a464a6c7 729 (`user-defined
a79b55e5
TTN		 730 bubbles-grid-size))))
731
732(defsubst bubbles--grid-height ()
733 "Return the grid height for the current game theme."
a464a6c7
SM		 734 (cdr (pcase bubbles-game-theme
735 (`easy
a79b55e5 736 bubbles--grid-small)
a464a6c7 737 (`medium
a79b55e5 738 bubbles--grid-medium)
a464a6c7 739 (`difficult
a79b55e5 740 bubbles--grid-large)
a464a6c7 741 (`hard
a79b55e5 742 bubbles--grid-huge)
a464a6c7 743 (`user-defined
a79b55e5
TTN		 744 bubbles-grid-size))))
745
746(defsubst bubbles--colors ()
747 "Return the color list for the current game theme."
a464a6c7
SM		 748 (pcase bubbles-game-theme
749 (`easy
a79b55e5 750 bubbles--colors-2)
a464a6c7 751 (`medium
a79b55e5 752 bubbles--colors-3)
a464a6c7 753 (`difficult
a79b55e5 754 bubbles--colors-4)
a464a6c7 755 (`hard
a79b55e5 756 bubbles--colors-5)
a464a6c7 757 (`user-defined
a79b55e5
TTN		 758 bubbles-colors)))
759
760(defsubst bubbles--shift-mode ()
761 "Return the shift mode for the current game theme."
a464a6c7
SM		 762 (pcase bubbles-game-theme
763 (`easy
a79b55e5 764 'default)
a464a6c7 765 (`medium
a79b55e5 766 'default)
a464a6c7 767 (`difficult
a79b55e5 768 'always)
a464a6c7 769 (`hard
a79b55e5 770 'always)
a464a6c7 771 (`user-defined
a79b55e5
TTN		 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)."
e73da129 784 ?\s)
a79b55e5
TTN		 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
a79b55e5 827;; game theme menu
a4fcacde
TTN		 828(defvar bubbles-game-theme-menu
829 (let ((menu (make-sparse-keymap "Game Theme")))
830 (define-key menu [bubbles-set-game-userdefined]
831 (list 'menu-item "User defined" 'bubbles-set-game-userdefined
832 :button '(:radio . (eq bubbles-game-theme 'user-defined))))
833 (define-key menu [bubbles-set-game-hard]
834 (list 'menu-item "Hard" 'bubbles-set-game-hard
835 :button '(:radio . (eq bubbles-game-theme 'hard))))
836 (define-key menu [bubbles-set-game-difficult]
837 (list 'menu-item "Difficult" 'bubbles-set-game-difficult
838 :button '(:radio . (eq bubbles-game-theme 'difficult))))
839 (define-key menu [bubbles-set-game-medium]
840 (list 'menu-item "Medium" 'bubbles-set-game-medium
841 :button '(:radio . (eq bubbles-game-theme 'medium))))
842 (define-key menu [bubbles-set-game-easy]
843 (list 'menu-item "Easy" 'bubbles-set-game-easy
844 :button '(:radio . (eq bubbles-game-theme 'easy))))
845 menu)
846 "Map for bubbles game theme menu.")
a79b55e5
TTN		 847
848;; graphics theme menu
a4fcacde
TTN		 849(defvar bubbles-graphics-theme-menu
850 (let ((menu (make-sparse-keymap "Graphics Theme")))
851 (define-key menu [bubbles-set-graphics-theme-ascii]
852 (list 'menu-item "ASCII" 'bubbles-set-graphics-theme-ascii
853 :button '(:radio . (eq bubbles-graphics-theme 'ascii))))
854 (define-key menu [bubbles-set-graphics-theme-emacs]
855 (list 'menu-item "Emacs" 'bubbles-set-graphics-theme-emacs
856 :button '(:radio . (eq bubbles-graphics-theme 'emacs))))
857 (define-key menu [bubbles-set-graphics-theme-balls]
858 (list 'menu-item "Balls" 'bubbles-set-graphics-theme-balls
859 :button '(:radio . (eq bubbles-graphics-theme 'balls))))
860 (define-key menu [bubbles-set-graphics-theme-diamonds]
861 (list 'menu-item "Diamonds" 'bubbles-set-graphics-theme-diamonds
862 :button '(:radio . (eq bubbles-graphics-theme 'diamonds))))
863 (define-key menu [bubbles-set-graphics-theme-squares]
864 (list 'menu-item "Squares" 'bubbles-set-graphics-theme-squares
865 :button '(:radio . (eq bubbles-graphics-theme 'squares))))
866 (define-key menu [bubbles-set-graphics-theme-circles]
867 (list 'menu-item "Circles" 'bubbles-set-graphics-theme-circles
868 :button '(:radio . (eq bubbles-graphics-theme 'circles))))
869 menu)
870 "Map for bubbles graphics theme menu.")
a79b55e5
TTN		 871
872;; menu
a4fcacde
TTN		 873(defvar bubbles-menu
874 (let ((menu (make-sparse-keymap "Bubbles")))
875 (define-key menu [bubbles-quit]
876 (list 'menu-item "Quit" 'bubbles-quit))
877 (define-key menu [bubbles]
878 (list 'menu-item "New game" 'bubbles))
879 (define-key menu [bubbles-separator-1]
880 '("--"))
881 (define-key menu [bubbles-save-settings]
882 (list 'menu-item "Save all settings" 'bubbles-save-settings))
883 (define-key menu [bubbles-customize]
884 (list 'menu-item "Edit all settings" 'bubbles-customize))
885 (define-key menu [bubbles-game-theme-menu]
886 (list 'menu-item "Game Theme" bubbles-game-theme-menu))
887 (define-key menu [bubbles-graphics-theme-menu]
888 (list 'menu-item "Graphics Theme" bubbles-graphics-theme-menu
889 :enable 'bubbles--playing))
890 (define-key menu [bubbles-separator-2]
891 '("--"))
892 (define-key menu [bubbles-undo]
893 (list 'menu-item "Undo last move" 'bubbles-undo
894 :enable '(and bubbles--playing (listp buffer-undo-list))))
895 menu)
896 "Map for bubbles menu.")
897
898;; bubbles mode map
899(defvar bubbles-mode-map
900 (let ((map (make-sparse-keymap 'bubbles-mode-map)))
901;; (suppress-keymap map t)
902 (define-key map "q" 'bubbles-quit)
903 (define-key map "\n" 'bubbles-plop)
904 (define-key map " " 'bubbles-plop)
905 (define-key map [double-down-mouse-1] 'bubbles-plop)
906 (define-key map [mouse-2] 'bubbles-plop)
907 (define-key map "\C-m" 'bubbles-plop)
908 (define-key map "u" 'bubbles-undo)
909 (define-key map "p" 'previous-line)
910 (define-key map "n" 'next-line)
911 (define-key map "f" 'forward-char)
912 (define-key map "b" 'backward-char)
913 ;; bind menu to mouse
914 (define-key map [down-mouse-3] bubbles-menu)
915 ;; Put menu in menu-bar
916 (define-key map [menu-bar Bubbles] (cons "Bubbles" bubbles-menu))
917 map)
918 "Mode map for bubbles.")
a79b55e5 919
e73da129 920(define-derived-mode bubbles-mode nil "Bubbles"
a79b55e5
TTN		 921 "Major mode for playing bubbles.
922\\{bubbles-mode-map}"
121656e9
JB		 923 (setq buffer-read-only t
924 show-trailing-whitespace nil)
a4fcacde 925 (buffer-disable-undo)
a4fcacde
TTN		 926 (force-mode-line-update)
927 (redisplay)
4fa51741 928 (add-hook 'post-command-hook 'bubbles--mark-neighborhood t t))
a79b55e5
TTN		 929
930;;;###autoload
931(defun bubbles ()
b74d9506
CY		 932 "Play Bubbles game.
933\\<bubbles-mode-map>
934The goal is to remove all bubbles with as few moves as possible.
935\\[bubbles-plop] on a bubble removes that bubble and all
936connected bubbles of the same color. Unsupported bubbles fall
937down, and columns that do not contain any bubbles suck the
938columns on its right towards the left.
939
940\\[bubbles-set-game-easy] sets the difficulty to easy.
941\\[bubbles-set-game-medium] sets the difficulty to medium.
942\\[bubbles-set-game-difficult] sets the difficulty to difficult.
943\\[bubbles-set-game-hard] sets the difficulty to hard."
a79b55e5
TTN		 944 (interactive)
945 (switch-to-buffer (get-buffer-create "*bubbles*"))
946 (when (or (not bubbles--playing)
947 (y-or-n-p "Start new game? "))
948 (setq bubbles--save-data nil)
949 (setq bubbles--playing t)
950 (bubbles--initialize)))
951
952(defun bubbles-quit ()
953 "Quit Bubbles."
954 (interactive)
955 (message "bubbles-quit")
956 (bury-buffer))
957
aa360da1
GM		 958(declare-function image-size "image.c" (spec &optional pixels frame))
959
a79b55e5
TTN		 960(defun bubbles--compute-offsets ()
961 "Update horizontal and vertical offsets for centering the bubbles grid.
962Set `bubbles--col-offset' and `bubbles--row-offset'."
963 (cond ((and (display-images-p)
964 bubbles--images-ok
965 (not (eq bubbles-graphics-theme 'ascii))
966 (fboundp 'window-inside-pixel-edges))
967 ;; compute offset in units of pixels
968 (let ((bubbles--image-size
969 (car (image-size (car bubbles--images) t))))
970 (setq bubbles--col-offset
971 (list
972 (max 0 (/ (- (nth 2 (window-inside-pixel-edges))
973 (nth 0 (window-inside-pixel-edges))
974 (* ( + bubbles--image-size 2) ;; margin
975 (bubbles--grid-width))) 2))))
976 (setq bubbles--row-offset
977 (list
978 (max 0 (/ (- (nth 3 (window-inside-pixel-edges))
979 (nth 1 (window-inside-pixel-edges))
980 (* (+ bubbles--image-size 1) ;; margin
981 (bubbles--grid-height))) 2))))))
982 (t
983 ;; compute offset in units of chars
984 (setq bubbles--col-offset
985 (max 0 (/ (- (window-width)
986 (bubbles--grid-width)) 2)))
987 (setq bubbles--row-offset
988 (max 0 (/ (- (window-height)
989 (bubbles--grid-height) 2) 2))))))
990
991(defun bubbles--remove-overlays ()
992 "Remove all overlays."
993 (if (fboundp 'remove-overlays)
994 (remove-overlays)))
995
996(defun bubbles--initialize ()
997 "Initialize Bubbles game."
998 (bubbles--initialize-faces)
999 (bubbles--initialize-images)
1000 (bubbles--remove-overlays)
1001
1002 (switch-to-buffer (get-buffer-create "*bubbles*"))
1003 (bubbles--compute-offsets)
1004 (let ((inhibit-read-only t))
1005 (set-buffer-modified-p nil)
1006 (erase-buffer)
1007 (insert " ")
cf10b349
SM		 1008 (put-text-property (point-min) (point)
1009 'display
1010 (cons 'space (list :height bubbles--row-offset)))
a79b55e5
TTN		 1011 (insert "\n")
1012 (let ((max-char (length (bubbles--colors))))
1013 (dotimes (i (bubbles--grid-height))
1014 (let ((p (point)))
1015 (insert " ")
cf10b349
SM		 1016 (put-text-property p (point)
1017 'display
1018 (cons 'space (list :width bubbles--col-offset))))
a79b55e5
TTN		 1019 (dotimes (j (bubbles--grid-width))
1020 (let* ((index (random max-char))
1021 (char (nth index bubbles-chars)))
1022 (insert char)
1023 (add-text-properties (1- (point)) (point) (list 'index index))))
1024 (insert "\n"))
1025 (insert "\n ")
cf10b349
SM		 1026 (put-text-property (1- (point)) (point)
1027 'display
1028 (cons 'space (list :width bubbles--col-offset))))
a79b55e5
TTN		 1029 (put-text-property (point-min) (point-max) 'pointer 'arrow))
1030 (bubbles-mode)
1031 (bubbles--reset-score)
1032 (bubbles--update-faces-or-images)
a4fcacde
TTN		 1033 (bubbles--goto 0 0)
1034 (setq buffer-undo-list t)
1035 (force-mode-line-update)
1036 (redisplay))
a79b55e5
TTN		 1037
1038(defun bubbles--initialize-faces ()
1039 "Prepare faces for playing `bubbles'."
1040 (copy-face 'default 'bubbles--highlight-face)
1041 (set-face-background 'bubbles--highlight-face "#8080f4")
1042 (when (display-color-p)
1043 (setq bubbles--faces
1044 (mapcar (lambda (color)
1045 (let ((fname (intern (format "bubbles--face-%s" color))))
1046 (unless (facep fname)
1047 (copy-face 'default fname)
1048 (set-face-foreground fname color))
1049 fname))
1050 (bubbles--colors)))))
1051
1052(defsubst bubbles--row (pos)
1053 "Return row of point POS."
1054 (save-excursion
1055 (goto-char pos)
1056 (beginning-of-line)
1057 (1- (count-lines (point-min) (point)))))
1058
1059(defsubst bubbles--col (pos)
1060 "Return column of point POS."
1061 (save-excursion
1062 (goto-char pos)
1063 (1- (current-column))))
1064
1065(defun bubbles--goto (row col)
1066 "Move point to bubble at coordinates ROW and COL."
1067 (if (or (< row 0)
1068 (< col 0)
1069 (>= row (bubbles--grid-height))
1070 (>= col (bubbles--grid-width)))
1071 ;; Error! return nil
1072 nil
1073 ;; go
1074 (goto-char (point-min))
1075 (forward-line (1+ row))
1076 (forward-char (1+ col))
1077 (point)))
1078
1079(defun bubbles--char-at (row col)
1080 "Return character at bubble ROW and COL."
1081 (save-excursion
1082 (if (bubbles--goto row col)
1083 (char-after (point))
1084 nil)))
1085
4fa51741 1086(defun bubbles--mark-direct-neighbors (row col char)
a7c29764 1087 "Mark direct neighbors of bubble at ROW COL with same CHAR."
a79b55e5
TTN		 1088 (save-excursion
1089 (let ((count 0))
1090 (when (and (bubbles--goto row col)
1091 (eq char (char-after (point)))
1092 (not (get-text-property (point) 'active)))
1093 (add-text-properties (point) (1+ (point))
1094 '(active t face 'bubbles--highlight-face))
1095 (setq count (+ 1
4fa51741
PE		 1096 (bubbles--mark-direct-neighbors row (1+ col) char)
1097 (bubbles--mark-direct-neighbors row (1- col) char)
1098 (bubbles--mark-direct-neighbors (1+ row) col char)
1099 (bubbles--mark-direct-neighbors (1- row) col char))))
a79b55e5
TTN		 1100 count)))
1101
4fa51741 1102(defun bubbles--mark-neighborhood (&optional pos)
a7c29764 1103 "Mark neighborhood of point.
a79b55e5
TTN		 1104Use optional parameter POS instead of point if given."
1105 (when bubbles--playing
1106 (unless pos (setq pos (point)))
30213927
GM		 1107 (with-demoted-errors "Bubbles: Internal error %s"
1108 (let ((char (char-after pos))
1109 (inhibit-read-only t)
1110 (row (bubbles--row (point)))
1111 (col (bubbles--col (point))))
1112 (add-text-properties (point-min) (point-max)
1113 '(face default active nil))
1114 (let ((count 0))
1115 (when (and row col (not (eq char (bubbles--empty-char))))
4fa51741 1116 (setq count (bubbles--mark-direct-neighbors row col char))
30213927
GM		 1117 (unless (> count 1)
1118 (add-text-properties (point-min) (point-max)
1119 '(face default active nil))
1120 (setq count 0)))
4fa51741 1121 (bubbles--update-neighborhood-score count))
30213927
GM		 1122 (put-text-property (point-min) (point-max) 'pointer 'arrow)
1123 (bubbles--update-faces-or-images)
1124 (sit-for 0)))))
a79b55e5 1125
4fa51741 1126(defun bubbles--neighborhood-available ()
a7c29764 1127 "Return t if another valid neighborhood is available."
a79b55e5
TTN		 1128 (catch 'found
1129 (save-excursion
1130 (dotimes (i (bubbles--grid-height))
1131 (dotimes (j (bubbles--grid-width))
1132 (let ((c (bubbles--char-at i j)))
1133 (if (and (not (eq c (bubbles--empty-char)))
1134 (or (eq c (bubbles--char-at (1+ i) j))
1135 (eq c (bubbles--char-at i (1+ j)))))
1136 (throw 'found t)))))
1137 nil)))
1138
1139(defun bubbles--count ()
1140 "Count remaining bubbles."
1141 (let ((count 0))
1142 (save-excursion
1143 (dotimes (i (bubbles--grid-height))
1144 (dotimes (j (bubbles--grid-width))
1145 (let ((c (bubbles--char-at i j)))
1146 (if (not (eq c (bubbles--empty-char)))
1147 (setq count (1+ count)))))))
1148 count))
1149
1150(defun bubbles--reset-score ()
1151 "Reset bubbles score."
4fa51741 1152 (setq bubbles--neighborhood-score 0
a79b55e5
TTN		 1153 bubbles--score 0)
1154 (bubbles--update-score))
1155
1156(defun bubbles--update-score ()
e73da129 1157 "Calculate and display new bubbles score."
4fa51741 1158 (setq bubbles--score (+ bubbles--score bubbles--neighborhood-score))
a79b55e5
TTN		 1159 (bubbles--show-scores))
1160
4fa51741 1161(defun bubbles--update-neighborhood-score (size)
a7c29764 1162 "Calculate and display score of active neighborhood from its SIZE."
a79b55e5 1163 (if (> size 1)
4fa51741
PE		 1164 (setq bubbles--neighborhood-score (expt (- size 1) 2))
1165 (setq bubbles--neighborhood-score 0))
a79b55e5
TTN		 1166 (bubbles--show-scores))
1167
1168(defun bubbles--show-scores ()
1169 "Display current scores."
1170 (save-excursion
1171 (goto-char (or (next-single-property-change (point-min) 'status)
1172 (point-max)))
1173 (let ((inhibit-read-only t)
1174 (pos (point)))
1175 (delete-region (point) (point-max))
4fa51741 1176 (insert (format "Selected: %4d\n" bubbles--neighborhood-score))
a79b55e5 1177 (insert " ")
cf10b349
SM		 1178 (put-text-property (1- (point)) (point)
1179 'display
1180 (cons 'space (list :width bubbles--col-offset)))
a79b55e5
TTN		 1181 (insert (format "Score: %4d" bubbles--score))
1182 (put-text-property pos (point) 'status t))))
1183
1184(defun bubbles--game-over ()
1185 "Finish bubbles game."
1186 (bubbles--update-faces-or-images)
1187 (setq bubbles--playing nil
1188 bubbles--save-data nil)
1189 ;; add bonus if all bubbles were removed
1190 (when (= 0 (bubbles--count))
1191 (setq bubbles--score (+ bubbles--score (* (bubbles--grid-height)
1192 (bubbles--grid-width))))
1193 (bubbles--show-scores))
1194 ;; Game over message
1195 (goto-char (point-max))
1196 (let* ((inhibit-read-only t))
1197 (insert "\n ")
cf10b349
SM		 1198 (put-text-property (1- (point)) (point)
1199 'display
1200 (cons 'space (list :width bubbles--col-offset)))
a79b55e5
TTN		 1201 (insert "Game Over!"))
1202 ;; save score
1203 (gamegrid-add-score (format "bubbles-%s-%d-%d-%d-scores"
1204 (symbol-name (bubbles--shift-mode))
1205 (length (bubbles--colors))
1206 (bubbles--grid-width) (bubbles--grid-height))
1207 bubbles--score))
1208
1209(defun bubbles-plop ()
1210 "Remove active bubbles region."
1211 (interactive)
1212 (when (and bubbles--playing
4fa51741 1213 (> bubbles--neighborhood-score 0))
a79b55e5 1214 (setq bubbles--save-data (list bubbles--score (buffer-string)))
a79b55e5 1215 (let ((inhibit-read-only t))
4fa51741 1216 ;; blank out current neighborhood
a79b55e5
TTN		 1217 (let ((row (bubbles--row (point)))
1218 (col (bubbles--col (point))))
1219 (goto-char (point-max))
1220 (while (not (bobp))
1221 (backward-char)
1222 (while (get-text-property (point) 'active)
1223 (delete-char 1)
1224 (insert (bubbles--empty-char))
1225 (add-text-properties (1- (point)) (point) (list 'removed t
1226 'index -1))))
1227 (bubbles--goto row col))
1228 ;; show new score
1229 (bubbles--update-score)
1230 ;; update display and wait
1231 (bubbles--update-faces-or-images)
1232 (sit-for 0)
1233 (sleep-for 0.2)
1234 (discard-input)
1235 ;; drop down
1236 (let ((something-dropped nil))
1237 (save-excursion
1238 (dotimes (i (bubbles--grid-height))
1239 (dotimes (j (bubbles--grid-width))
1240 (bubbles--goto i j)
1241 (while (get-text-property (point) 'removed)
1242 (setq something-dropped (or (bubbles--shift 'top i j)
1243 something-dropped))))))
1244 ;; update display and wait
1245 (bubbles--update-faces-or-images)
1246 (when something-dropped
1247 (sit-for 0)))
1248 (discard-input)
1249 ;; shift to left
1250 (put-text-property (point-min) (point-max) 'removed nil)
1251 (save-excursion
1252 (goto-char (point-min))
1253 (let ((removed-string (format "%c" (bubbles--empty-char))))
1254 (while (search-forward removed-string nil t)
1255 (put-text-property (1- (point)) (point) 'removed t))))
1256 (let ((shifted nil))
1257 (cond ((eq (bubbles--shift-mode) 'always)
1258 (save-excursion
1259 (dotimes (i (bubbles--grid-height))
1260 (dotimes (j (bubbles--grid-width))
1261 (bubbles--goto i j)
1262 (while (get-text-property (point) 'removed)
a4fcacde
TTN		 1263 (setq shifted (or (bubbles--shift 'right i j)
1264 shifted))))))
a79b55e5
TTN		 1265 (bubbles--update-faces-or-images)
1266 (sleep-for 0.5))
1267 (t ;; default shift-mode
1268 (save-excursion
1269 (dotimes (j (bubbles--grid-width))
1270 (bubbles--goto (1- (bubbles--grid-height)) j)
1271 (let ((shifted-cols 0))
1272 (while (get-text-property (point) 'removed)
1273 (setq shifted-cols (1+ shifted-cols))
1274 (bubbles--shift 'right (1- (bubbles--grid-height)) j))
1275 (dotimes (k shifted-cols)
1276 (let ((i (- (bubbles--grid-height) 2)))
1277 (while (>= i 0)
a4fcacde
TTN		 1278 (setq shifted (or (bubbles--shift 'right i j)
1279 shifted))
a79b55e5
TTN		 1280 (setq i (1- i))))))))))
1281 (when shifted
1282 ;;(sleep-for 0.5)
1283 (bubbles--update-faces-or-images)
1284 (sit-for 0)))
1285 (put-text-property (point-min) (point-max) 'removed nil)
4fa51741 1286 (unless (bubbles--neighborhood-available)
a4fcacde
TTN		 1287 (bubbles--game-over)))
1288 ;; undo
1289 (setq buffer-undo-list '((apply bubbles-undo . nil)))
1290 (force-mode-line-update)
1291 (redisplay)))
a79b55e5
TTN		 1292
1293(defun bubbles-undo ()
1294 "Undo last move."
1295 (interactive)
1296 (when bubbles--save-data
1297 (let ((inhibit-read-only t)
1298 (pos (point)))
1299 (erase-buffer)
1300 (insert (cadr bubbles--save-data))
1301 (bubbles--update-faces-or-images)
1302 (setq bubbles--score (car bubbles--save-data))
a4fcacde
TTN		 1303 (goto-char pos))
1304 (setq buffer-undo-list t)
1305 (force-mode-line-update)
1306 (redisplay)))
a79b55e5
TTN		 1307
1308(defun bubbles--shift (from row col)
1309 "Move bubbles FROM one side to position ROW COL.
1310Return t if new char is non-empty."
1311 (save-excursion
1312 (when (bubbles--goto row col)
121656e9 1313 (let ((char-new (bubbles--empty-char))
a79b55e5
TTN		 1314 (removed nil)
1315 (trow row)
1316 (tcol col)
1317 (index -1))
1318 (cond ((eq from 'top)
1319 (setq trow (1- row)))
1320 ((eq from 'left)
1321 (setq tcol (1- col)))
1322 ((eq from 'right)
1323 (setq tcol (1+ col))))
1324 (save-excursion
1325 (when (bubbles--goto trow tcol)
1326 (setq char-new (char-after (point)))
1327 (setq removed (get-text-property (point) 'removed))
1328 (setq index (get-text-property (point) 'index))
1329 (bubbles--shift from trow tcol)))
1330 (insert char-new)
1331 (delete-char 1)
1332 (add-text-properties (1- (point)) (point) (list 'index index
1333 'removed removed))
1334 (not (eq char-new (bubbles--empty-char)))))))
1335
1336(defun bubbles--initialize-images ()
1337 "Prepare images for playing `bubbles'."
1338 (when (and (display-images-p)
1339 (not (eq bubbles-graphics-theme 'ascii)))
a464a6c7
SM		 1340 (let ((template (pcase bubbles-graphics-theme
1341 (`circles bubbles--image-template-circle)
1342 (`balls bubbles--image-template-ball)
1343 (`squares bubbles--image-template-square)
1344 (`diamonds bubbles--image-template-diamond)
1345 (`emacs bubbles--image-template-emacs))))
a79b55e5
TTN		 1346 (setq bubbles--empty-image
1347 (create-image (replace-regexp-in-string
1348 "^\"\\(.*\\)\t.*c .*\",$"
45169e8d 1349 "\"\\1\tc None\"," template)
a79b55e5
TTN		 1350 'xpm t
1351 ;;:mask 'heuristic
1352 :margin '(2 . 1)))
1353 (setq bubbles--images
1354 (mapcar (lambda (color)
1355 (let* ((rgb (color-values color))
1356 (red (nth 0 rgb))
1357 (green (nth 1 rgb))
1358 (blue (nth 2 rgb)))
1359 (with-temp-buffer
1360 (insert template)
1361 (goto-char (point-min))
1362 (re-search-forward
1363 "^\"[0-9]+ [0-9]+ \\(.*?\\) .*\",$" nil t)
1364 (goto-char (point-min))
1365 (while (re-search-forward
1366 "^\"\\(.*\\)\t.*c \\(#.*\\)\",$" nil t)
1367 (let* ((crgb (color-values (match-string 2)))
1368 (r (nth 0 crgb))
1369 (g (nth 1 crgb))
1370 (b (nth 2 crgb))
1371 (brightness (/ (+ r g b) 3.0 256 256))
9e0d4f9e 1372 (val (sin (* brightness (/ float-pi 2))))
a79b55e5
TTN		 1373 (rr (* red val))
1374 (gg (* green val))
1375 (bb (* blue val))
1376 ;;(rr (/ (+ red r) 2))
1377 ;;(gg (/ (+ green g) 2))
1378 ;;(bb (/ (+ blue b) 2))
1379 (color (format "#%02x%02x%02x"
1380 (/ rr 256) (/ gg 256)
1381 (/ bb 256))))
1382 (replace-match (format "\"\\1\tc %s\","
1383 (upcase color)))))
1384 (create-image (buffer-string) 'xpm t
1385 :margin '(2 . 1)
1386 ;;:mask 'heuristic
1387 ))))
1388 (bubbles--colors))))
1389 ;; check images
1390 (setq bubbles--images-ok bubbles--empty-image)
1391 (mapc (lambda (elt)
1392 (setq bubbles--images-ok (and bubbles--images-ok elt)))
1393 bubbles--images)))
1394
1395(defun bubbles--update-faces-or-images ()
1396 "Update faces and/or images, depending on graphics mode."
1397 (bubbles--set-faces)
1398 (bubbles--show-images))
1399
1400(defun bubbles--set-faces ()
1401 "Update faces in the bubbles buffer."
1402 (unless (and (display-images-p)
1403 bubbles--images-ok
1404 (not (eq bubbles-graphics-theme 'ascii)))
1405 (when (display-color-p)
1406 (save-excursion
1407 (let ((inhibit-read-only t))
1408 (dotimes (i (bubbles--grid-height))
1409 (dotimes (j (bubbles--grid-width))
1410 (bubbles--goto i j)
121656e9
JB		 1411 (let ((face (nth (get-text-property (point) 'index)
1412 bubbles--faces)))
a79b55e5
TTN		 1413 (when (get-text-property (point) 'active)
1414 (set-face-foreground 'bubbles--highlight-face "#ff0000")
1415 (setq face 'bubbles--highlight-face))
1416 (put-text-property (point) (1+ (point))
1417 'face face)))))))))
1418
1419(defun bubbles--show-images ()
1420 "Update images in the bubbles buffer."
1421 (bubbles--remove-overlays)
1422 (if (and (display-images-p)
1423 bubbles--images-ok
1424 (not (eq bubbles-graphics-theme 'ascii)))
1425 (save-excursion
1426 (goto-char (point-min))
1427 (forward-line 1)
121656e9 1428 (let ((inhibit-read-only t))
a79b55e5
TTN		 1429 (dotimes (i (bubbles--grid-height))
1430 (dotimes (j (bubbles--grid-width))
1431 (forward-char 1)
a4fcacde 1432 (let ((index (or (get-text-property (point) 'index) -1)))
a79b55e5
TTN		 1433 (let ((img bubbles--empty-image))
1434 (if (>= index 0)
1435 (setq img (nth index bubbles--images)))
1436 (put-text-property (point) (1+ (point))
1437 'display (cons img nil)))))
1438 (forward-line 1))))
1439 (save-excursion
1440 (let ((inhibit-read-only t))
1441 (goto-char (point-min))
1442 (while (not (eobp))
1443 (let ((disp-prop (get-text-property (point) 'display)))
1444 (if (and (listp disp-prop)
1445 (listp (car disp-prop))
1446 (eq (caar disp-prop) 'image))
1447 (put-text-property (point) (1+ (point)) 'display nil))
1448 (forward-char 1)))
1449 (put-text-property (point-min) (point-max) 'pointer 'arrow)))))
1450
1451(provide 'bubbles)
1452
1453;;; bubbles.el ends here
Unnamed repository; edit this file 'description' to name the repository.