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