--- /dev/null
+;;; bubbles.el --- Puzzle game for Emacs.
+
+;; Copyright (C) 2007 Free Software Foundation, Inc.
+
+;; This file is NOT part of GNU Emacs.
+
+;; Author: Ulf Jasper <ulf.jasper@web.de>
+;; Filename: bubbles.el
+;; URL: http://ulf.epplejasper.de/
+;; Created: 5. Feb. 2007
+;; Keywords: Games
+;; Time-stamp: "27. August 2007, 19:51:08 (ulf)"
+;; CVS-Version: $Id: bubbles.el,v 1.16 2007-08-27 17:51:29 ulf Exp $
+
+;; ======================================================================
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2 of the License, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, write to the Free Software Foundation,
+;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+
+(defconst bubbles-version "0.4" "Version number of bubbles.el.")
+
+;; ======================================================================
+
+;;; Commentary:
+
+;; Bubbles is a puzzle game. Its goal is to remove as many bubbles as
+;; possible in as few moves as possible.
+
+;; Bubbles is an implementation of the "Same Game", similar to "Same
+;; GNOME" and many others, see http://en.wikipedia.org/wiki/SameGame.
+
+;; Installation
+;; ------------
+
+;; Add the following lines to your Emacs startup file (`~/.emacs').
+;; (add-to-list 'load-path "/path/to/bubbles/")
+;; (autoload 'bubbles "bubbles" "Play Bubbles" t)
+
+;; ======================================================================
+
+;;; History:
+
+;; 0.4 (2007-08-27)
+;; - Allow for undoing last move.
+;; - Bonus for removing all bubbles.
+;; - Speed improvements.
+;; - Animation enhancements.
+;; - Added `bubbles-mode-hook'.
+;; - Fixes: Don't move point.
+;; - New URL.
+
+;; 0.3 (2007-03-11)
+;; - Renamed shift modes and thus names of score files. All
+;; highscores are lost, unless you rename the score files from
+;; bubbles-shift-... to bubbles-...!
+;; - Bugfixes: Check for successful image creation.
+;; Disable menus and counter when game is over.
+;; Tested with GNU Emacs 22.0.93
+
+;; 0.2 (2007-02-24)
+;; - Introduced game themes.
+;; - Introduced graphics themes (changeable while playing).
+;; - Added menu.
+;; - Customization: grid size, colors, chars, shift mode.
+;; - More keybindings.
+;; - Changed shift direction from to-right to to-left.
+;; - Bugfixes: Don't remove single-bubble regions;
+;; Animation glitches fixed.
+;; Tested with GNU Emacs 22.0.93 and 21.4.1.
+
+;; 0.1 (2007-02-11)
+;; Initial release. Tested with GNU Emacs 22.0.93 and 21.4.1.
+
+;; ======================================================================
+
+;;; Code:
+
+(require 'gamegrid)
+(require 'cl)
+
+;; User options
+
+;; Careful with that axe, Eugene! Order does matter in the custom
+;; section below.
+
+(defcustom bubbles-game-theme
+ 'easy
+ "Overall game theme.
+The overall game theme specifies a grid size, a set of colors,
+and a shift mode."
+ :type '(radio (const :tag "Easy" easy)
+ (const :tag "Medium" medium)
+ (const :tag "Difficult" difficult)
+ (const :tag "Hard" hard)
+ (const :tag "User defined" user-defined))
+ :group 'bubbles)
+
+(defun bubbles-set-game-easy ()
+ "Set game theme to 'easy'."
+ (interactive)
+ (setq bubbles-game-theme 'easy)
+ (bubbles))
+
+(defun bubbles-set-game-medium ()
+ "Set game theme to 'medium'."
+ (interactive)
+ (setq bubbles-game-theme 'medium)
+ (bubbles))
+
+(defun bubbles-set-game-difficult ()
+ "Set game theme to 'difficult'."
+ (interactive)
+ (setq bubbles-game-theme 'difficult)
+ (bubbles))
+
+(defun bubbles-set-game-hard ()
+ "Set game theme to 'hard'."
+ (interactive)
+ (setq bubbles-game-theme 'hard)
+ (bubbles))
+
+(defun bubbles-set-game-userdefined ()
+ "Set game theme to 'user-defined'."
+ (interactive)
+ (setq bubbles-game-theme 'user-defined)
+ (bubbles))
+
+(defgroup bubbles nil
+ "Bubbles, a puzzle game."
+ :group 'games)
+
+(defcustom bubbles-graphics-theme
+ 'circles
+ "Graphics theme.
+It is safe to choose a graphical theme. If Emacs cannot display
+images the `ascii' theme will be used."
+ :type '(radio (const :tag "Circles" circles)
+ (const :tag "Squares" squares)
+ (const :tag "Diamonds" diamonds)
+ (const :tag "Balls" balls)
+ (const :tag "Emacs" emacs)
+ (const :tag "ASCII (no images)" ascii))
+ :group 'bubbles)
+
+(defconst bubbles--grid-small '(10 . 10)
+ "Predefined small bubbles grid.")
+
+(defconst bubbles--grid-medium '(15 . 10)
+ "Predefined medium bubbles grid.")
+
+(defconst bubbles--grid-large '(20 . 15)
+ "Predefined large bubbles grid.")
+
+(defconst bubbles--grid-huge '(30 . 20)
+ "Predefined huge bubbles grid.")
+
+(defcustom bubbles-grid-size
+ bubbles--grid-medium
+ "Size of bubbles grid."
+ :type `(radio (const :tag "Small" ,bubbles--grid-small)
+ (const :tag "Medium" ,bubbles--grid-medium)
+ (const :tag "Large" ,bubbles--grid-large)
+ (const :tag "Huge" ,bubbles--grid-huge)
+ (cons :tag "User defined"
+ (integer :tag "Width")
+ (integer :tag "Height")))
+ :group 'bubbles)
+
+(defconst bubbles--colors-2 '("orange" "violet")
+ "Predefined bubbles color list with two colors.")
+
+(defconst bubbles--colors-3 '("lightblue" "palegreen" "pink")
+ "Predefined bubbles color list with three colors.")
+
+(defconst bubbles--colors-4 '("firebrick" "sea green" "steel blue" "chocolate")
+ "Predefined bubbles color list with four colors.")
+
+(defconst bubbles--colors-5 '("firebrick" "sea green" "steel blue"
+ "sandy brown" "bisque3")
+ "Predefined bubbles color list with five colors.")
+
+(defcustom bubbles-colors
+ bubbles--colors-3
+ "List of bubble colors.
+The length of this list determines how many different bubble
+types are present."
+ :type `(radio (const :tag "Red, darkgreen" ,bubbles--colors-2)
+ (const :tag "Red, darkgreen, blue" ,bubbles--colors-3)
+ (const :tag "Red, darkgreen, blue, orange" ,bubbles--colors-4)
+ (const :tag "Red, darkgreen, blue, orange, violet"
+ ,bubbles--colors-5)
+ (repeat :tag "User defined" color))
+ :group 'bubbles)
+
+(defcustom bubbles-chars
+ '(?+ ?O ?# ?X ?. ?* ?& ?ยง)
+ "Characters used for bubbles.
+Note that the actual number of different bubbles is determined by
+the number of colors, see `bubbles-colors'."
+ :type '(repeat character)
+ :group 'bubbles)
+
+(defcustom bubbles-shift-mode
+ 'default
+ "Shift mode.
+Available modes are `shift-default' and`shift-always'."
+ :type '(radio (const :tag "Default" default)
+ (const :tag "Shifter" always)
+ ;;(const :tag "Mega Shifter" 'mega)
+ )
+ :group 'bubbles)
+
+(defcustom bubbles-mode-hook nil
+ "Hook run by Bubbles mode."
+ :group 'bubbles
+ :type 'hook)
+
+(defun bubbles-customize ()
+ "Open customization buffer for bubbles."
+ (interactive)
+ (customize-group 'bubbles))
+
+;; ======================================================================
+;; internal variables
+
+(defvar bubbles--score 0
+ "Current Bubbles score.")
+
+(defvar bubbles--neighbourhood-score 0
+ "Score of active bubbles neighbourhood.")
+
+(defvar bubbles--faces nil
+ "List of currently used faces.")
+
+(defvar bubbles--playing nil
+ "Play status indicator.")
+
+(defvar bubbles--empty-image nil
+ "Image used for removed bubbles (empty grid cells).")
+
+(defvar bubbles--images nil
+ "List of images for bubbles.")
+
+(defvar bubbles--images-ok nil
+ "Indicate whether images have been created successfully.")
+
+(defvar bubbles--col-offset 0
+ "Horizontal offset for centering the bubbles grid.")
+
+(defvar bubbles--row-offset 0
+ "Vertical offset for centering the bubbles grid.")
+
+(defvar bubbles--save-data nil
+ "List containing bubbles save data (SCORE BUFFERCONTENTS).")
+
+(defconst bubbles--image-template-circle
+ "/* XPM */
+static char * dot_xpm[] = {
+\"20 20 2 1\",
+\" c None\",
+\". c #FFFFFF\",
+\" ...... \",
+\" .......... \",
+\" .............. \",
+\" ................ \",
+\" ................ \",
+\" .................. \",
+\" .................. \",
+\"....................\",
+\"....................\",
+\"....................\",
+\"....................\",
+\"....................\",
+\"....................\",
+\" .................. \",
+\" .................. \",
+\" ................ \",
+\" ................ \",
+\" .............. \",
+\" .......... \",
+\" ...... \"};")
+
+(defconst bubbles--image-template-square
+ "/* XPM */
+static char * dot_xpm[] = {
+\"20 20 2 1\",
+\"0 c None\",
+\"1 c #FFFFFF\",
+\"00000000000000000000\",
+\"01111111111111111110\",
+\"01111111111111111110\",
+\"01111111111111111110\",
+\"01111111111111111110\",
+\"01111111111111111110\",
+\"01111111111111111110\",
+\"01111111111111111110\",
+\"01111111111111111110\",
+\"01111111111111111110\",
+\"01111111111111111110\",
+\"01111111111111111110\",
+\"01111111111111111110\",
+\"01111111111111111110\",
+\"01111111111111111110\",
+\"01111111111111111110\",
+\"01111111111111111110\",
+\"01111111111111111110\",
+\"01111111111111111110\",
+\"00000000000000000000\"};")
+
+(defconst bubbles--image-template-diamond
+ "/* XPM */
+static char * dot_xpm[] = {
+\"20 20 2 1\",
+\"0 c None\",
+\"1 c #FFFFFF\",
+\"00000000011000000000\",
+\"00000000111100000000\",
+\"00000001111110000000\",
+\"00000011111111000000\",
+\"00000111111111100000\",
+\"00001111111111110000\",
+\"00011111111111111000\",
+\"00111111111111111100\",
+\"01111111111111111110\",
+\"11111111111111111111\",
+\"01111111111111111110\",
+\"00111111111111111100\",
+\"00011111111111111000\",
+\"00001111111111110000\",
+\"00000111111111100000\",
+\"00000011111111000000\",
+\"00000001111110000000\",
+\"00000000111100000000\",
+\"00000000011000000000\",
+\"00000000000000000000\"};")
+
+(defconst bubbles--image-template-emacs
+ "/* XPM */
+static char * emacs_24_xpm[] = {
+\"24 24 129 2\",
+\" c None\",
+\". c #837DA4\",
+\"+ c #807AA0\",
+\"@ c #9894B2\",
+\"# c #CCCAD9\",
+\"$ c #C2C0D2\",
+\"% c #B6B3C9\",
+\"& c #A19DB9\",
+\"* c #8681A5\",
+\"= c #7D779B\",
+\"- c #B6B3C7\",
+\"; c #ABA7BE\",
+\"> c #9792AF\",
+\", c #AAA6BD\",
+\"' c #CBC9D7\",
+\") c #AAA7BE\",
+\"! c #908BAA\",
+\"~ c #797397\",
+\"{ c #948FAC\",
+\"] c #9A95B1\",
+\"^ c #EBEAEF\",
+\"/ c #F1F1F5\",
+\"( c #BCB9CB\",
+\"_ c #A9A5BD\",
+\": c #757093\",
+\"< c #918DA9\",
+\"[ c #DDDBE4\",
+\"} c #FFFFFF\",
+\"| c #EAE9EF\",
+\"1 c #A7A4BA\",
+\"2 c #716C8F\",
+\"3 c #8D89A5\",
+\"4 c #9C98B1\",
+\"5 c #DBDAE3\",
+\"6 c #A4A1B7\",
+\"7 c #6E698A\",
+\"8 c #8B87A1\",
+\"9 c #928EA7\",
+\"0 c #C5C3D1\",
+\"a c #F8F8F9\",
+\"b c #CCCAD6\",
+\"c c #A29FB4\",
+\"d c #6A6585\",
+\"e c #88849D\",
+\"f c #B5B2C2\",
+\"g c #F0F0F3\",
+\"h c #E1E0E6\",
+\"i c #A5A2B5\",
+\"j c #A09DB1\",
+\"k c #676281\",
+\"l c #85819A\",
+\"m c #9591A7\",
+\"n c #E1E0E5\",
+\"o c #F0EFF2\",
+\"p c #B3B0C0\",
+\"q c #9D9AAE\",
+\"r c #635F7C\",
+\"s c #827F96\",
+\"t c #9997AA\",
+\"u c #F7F7F9\",
+\"v c #C8C7D1\",
+\"w c #89869D\",
+\"x c #9B99AB\",
+\"y c #5F5B78\",
+\"z c #7F7C93\",
+\"A c #CFCDD6\",
+\"B c #B7B5C2\",
+\"C c #9996A9\",
+\"D c #5C5873\",
+\"E c #7A778D\",
+\"F c #F5F5F6\",
+\"G c #8E8C9E\",
+\"H c #7D798F\",
+\"I c #58546F\",
+\"J c #6C6981\",
+\"K c #D5D4DB\",
+\"L c #F5F4F6\",
+\"M c #9794A5\",
+\"N c #625F78\",
+\"O c #79768C\",
+\"P c #55516A\",
+\"Q c #605C73\",
+\"R c #CAC9D1\",
+\"S c #EAE9EC\",
+\"T c #B4B3BE\",
+\"U c #777488\",
+\"V c #514E66\",
+\"W c #DEDEE2\",
+\"X c #F4F4F5\",
+\"Y c #9D9BA9\",
+\"Z c #747185\",
+\"` c #4E4B62\",
+\" . c #DEDDE1\",
+\".. c #A6A5B0\",
+\"+. c #716F81\",
+\"@. c #4A475D\",
+\"#. c #A4A3AE\",
+\"$. c #F4F3F5\",
+\"%. c #777586\",
+\"&. c #6E6C7D\",
+\"*. c #464358\",
+\"=. c #514E62\",
+\"-. c #B9B8C0\",
+\";. c #D1D0D5\",
+\">. c #747282\",
+\",. c #6B6979\",
+\"'. c #434054\",
+\"). c #5A5769\",
+\"!. c #D0CFD4\",
+\"~. c #5B5869\",
+\"{. c #696676\",
+\"]. c #403D50\",
+\"^. c #DBDADE\",
+\"/. c #F3F3F4\",
+\"(. c #646271\",
+\"_. c #666473\",
+\":. c #3D3A4C\",
+\"<. c #555362\",
+\"[. c #9E9DA6\",
+\"}. c #9E9CA5\",
+\"|. c #646170\",
+\"1. c #393647\",
+\"2. c #514E5D\",
+\"3. c #83818C\",
+\"4. c #A8A7AE\",
+\"5. c #E6E6E8\",
+\"6. c #DAD9DC\",
+\"7. c #353343\",
+\"8. c #32303E\",
+\" . . . . . . . . . . . . . . . . . . \",
+\" + @ # $ % % % % % % % % % % % % % % & * + + \",
+\" = - ; > > > > > > > > , ' ) > > > > > > ! = \",
+\"~ ~ { { { { { { { { { { { ] ^ / ( { { { { _ ~ ~ \",
+\": : < < < < < < < < < < < < [ } } | < < < 1 : : \",
+\"2 2 3 3 3 3 3 3 3 3 3 3 4 5 } } } 5 3 3 3 6 2 2 \",
+\"7 7 8 8 8 8 8 8 8 8 9 0 a } } } b 8 8 8 8 c 7 7 \",
+\"d d e e e e e e e f g } } } h i e e e e e j d d \",
+\"k k l l l l l m n } } } o p l l l l l l l q k k \",
+\"r r s s s s t u } } } v w s s s s s s s s x r r \",
+\"y y z z z z A } } } B z z z z z z z z z z C y y \",
+\"D D D D D D E F } } G D D D D D D D D D D H D D \",
+\"I I I I I I I J K } L M N I I I I I I I I O I I \",
+\"P P P P P P Q R } } } S T P P P P P P P P U P P \",
+\"V V V V V V W } } X Y V V V V V V V V V V Z V V \",
+\"` ` ` ` ` ` .} } ..` ` ` ` ` ` ` ` ` ` ` +.` ` \",
+\"@.@.@.@.@.@.@.#.$.$.%.@.@.@.@.@.@.@.@.@.@.&.@.@.\",
+\"*.*.*.*.*.*.*.*.=.-.} ;.>.*.*.*.*.*.*.*.*.,.*.*.\",
+\"'.'.'.'.'.'.'.'.'.'.).!.} !.~.'.'.'.'.'.'.{.'.'.\",
+\"].].].].].].].].].].].].^.} /.(.].].].].]._.].].\",
+\":.:.:.:.:.:.:.:.:.:.<.[./.} } }.:.:.:.:.:.|.:.:.\",
+\" 1.1.1.1.1.1.1.1.2.3.4.5.6.3.1.1.1.1.1.1.1.1. \",
+\" 7.7.7.7.7.7.7.7.7.7.7.7.7.7.7.7.7.7.7.7.7.7. \",
+\" 8.8.8.8.8.8.8.8.8.8.8.8.8.8.8.8.8.8. \"};")
+
+(defconst bubbles--image-template-ball
+ "/* XPM */
+static char * dot3d_xpm[] = {
+\"20 20 190 2\",
+\" c None\",
+\". c #F9F6F6\",
+\"+ c #D6D0D0\",
+\"@ c #BFBBBB\",
+\"# c #AAA4A4\",
+\"$ c #ABAAAB\",
+\"% c #A8A8A8\",
+\"& c #A29D9D\",
+\"* c #B5B2B2\",
+\"= c #CDC9C9\",
+\"- c #D7D0D0\",
+\"; c #B3AFAF\",
+\"> c #B5B5B5\",
+\", c #B7B7B7\",
+\"' c #B8B8B8\",
+\") c #B6B6B6\",
+\"! c #B3B3B3\",
+\"~ c #AFAFAF\",
+\"{ c #A9A9A9\",
+\"] c #A2A2A2\",
+\"^ c #9C9A9A\",
+\"/ c #C9C5C5\",
+\"( c #FDFBFB\",
+\"_ c #C3BCBC\",
+\": c #BBBBBB\",
+\"< c #C0C0C0\",
+\"[ c #C3C2C2\",
+\"} c #C3C3C3\",
+\"| c #C2C2C2\",
+\"1 c #BEBEBE\",
+\"2 c #B9B9B9\",
+\"3 c #B2B2B2\",
+\"4 c #ABAAAA\",
+\"5 c #999999\",
+\"6 c #ACA7A7\",
+\"7 c #C2BBBB\",
+\"8 c #C5C5C5\",
+\"9 c #CACBCB\",
+\"0 c #CECECE\",
+\"a c #CFCFCF\",
+\"b c #CDCDCD\",
+\"c c #C8C9C9\",
+\"d c #9F9F9F\",
+\"e c #959595\",
+\"f c #A9A5A5\",
+\"g c #D5CFCE\",
+\"h c #BDBDBD\",
+\"i c #C6C6C6\",
+\"j c #D5D5D5\",
+\"k c #D9D9D9\",
+\"l c #DADADA\",
+\"m c #D8D8D8\",
+\"n c #D2D2D2\",
+\"o c #CBCBCB\",
+\"p c #A4A4A5\",
+\"q c #9A9A9A\",
+\"r c #8F8F8F\",
+\"s c #C3BFBF\",
+\"t c #AFACAB\",
+\"u c #CCCCCC\",
+\"v c #D6D6D6\",
+\"w c #DEDEDE\",
+\"x c #E4E4E4\",
+\"y c #E5E5E5\",
+\"z c #E2E2E2\",
+\"A c #DBDBDB\",
+\"B c #C9C8C8\",
+\"C c #A8A9A8\",
+\"D c #9D9E9D\",
+\"E c #929292\",
+\"F c #8A8888\",
+\"G c #D3CECE\",
+\"H c #B0B0B0\",
+\"I c #D1D1D1\",
+\"J c #DCDCDC\",
+\"K c #E6E6E6\",
+\"L c #EEEEEE\",
+\"M c #F1F1F0\",
+\"N c #EBEBEB\",
+\"O c #D7D7D8\",
+\"P c #ABABAB\",
+\"Q c #A0A0A0\",
+\"R c #949494\",
+\"S c #898989\",
+\"T c #C0BDBD\",
+\"U c #B9B6B6\",
+\"V c #B1B1B1\",
+\"W c #BCBCBC\",
+\"X c #C8C8C8\",
+\"Y c #D3D3D3\",
+\"Z c #DFDFDE\",
+\"` c #EAEAEA\",
+\" . c #F5F5F5\",
+\".. c #FAFAFA\",
+\"+. c #F1F1F1\",
+\"@. c #CECFCF\",
+\"#. c #ACACAC\",
+\"$. c #A1A1A1\",
+\"%. c #8A8A8A\",
+\"&. c #9B9999\",
+\"*. c #C7C7C7\",
+\"=. c #DDDDDD\",
+\"-. c #E8E8E8\",
+\";. c #F2F2F2\",
+\">. c #898A89\",
+\",. c #7A7878\",
+\"'. c #AEAEAE\",
+\"). c #C4C4C4\",
+\"!. c #CBCBCA\",
+\"~. c #AAAAAA\",
+\"{. c #939393\",
+\"]. c #888888\",
+\"^. c #7C7C7C\",
+\"/. c #AAAAAB\",
+\"(. c #BFBFBF\",
+\"_. c #C9C9C9\",
+\":. c #DFDEDF\",
+\"<. c #A6A6A6\",
+\"[. c #9B9B9B\",
+\"}. c #909191\",
+\"|. c #858586\",
+\"1. c #797979\",
+\"2. c #989494\",
+\"3. c #A5A6A5\",
+\"4. c #B9B9B8\",
+\"5. c #C1C1C1\",
+\"6. c #CFCFCE\",
+\"7. c #979797\",
+\"8. c #8D8D8D\",
+\"9. c #828282\",
+\"0. c #747171\",
+\"a. c #ADAAAA\",
+\"b. c #A9A8A9\",
+\"c. c #B8B9B9\",
+\"d. c #A5A5A5\",
+\"e. c #9C9C9C\",
+\"f. c #7E7E7D\",
+\"g. c #929191\",
+\"h. c #C9C4C4\",
+\"i. c #989898\",
+\"j. c #ADADAD\",
+\"k. c #9D9D9D\",
+\"l. c #8C8C8C\",
+\"m. c #787878\",
+\"n. c #B8B6B6\",
+\"o. c #939191\",
+\"p. c #A5A5A6\",
+\"q. c #ABABAA\",
+\"r. c #A8A8A9\",
+\"s. c #A3A3A3\",
+\"t. c #858585\",
+\"u. c #757474\",
+\"v. c #C5C1C1\",
+\"w. c #969696\",
+\"x. c #9B9B9C\",
+\"y. c #A4A4A4\",
+\"z. c #9E9E9E\",
+\"A. c #939394\",
+\"B. c #7D7D7D\",
+\"C. c #747474\",
+\"D. c #B7B5B5\",
+\"E. c #A5A1A1\",
+\"F. c #919191\",
+\"G. c #9A9999\",
+\"H. c #838383\",
+\"I. c #757575\",
+\"J. c #939090\",
+\"K. c #A29E9E\",
+\"L. c #868686\",
+\"M. c #8D8D8C\",
+\"N. c #8E8E8E\",
+\"O. c #8D8D8E\",
+\"P. c #8B8C8C\",
+\"Q. c #848485\",
+\"R. c #7F7F80\",
+\"S. c #7A7A7A\",
+\"T. c #737373\",
+\"U. c #929090\",
+\"V. c #828080\",
+\"W. c #818181\",
+\"X. c #808080\",
+\"Y. c #7E7E7E\",
+\"Z. c #737272\",
+\"`. c #B7B4B4\",
+\" + c #BCBABA\",
+\".+ c #959494\",
+\"++ c #747172\",
+\"@+ c #767676\",
+\"#+ c #6F6D6D\",
+\"$+ c #8F8E8E\",
+\" . + @ # $ % & * = . \",
+\" - ; > , ' ) ! ~ { ] ^ / \",
+\" ( _ > : < [ } | 1 2 3 4 ] 5 6 ( \",
+\" 7 ) 1 8 9 0 a b c | : 3 { d e f \",
+\" g ! h i 0 j k l m n o | 2 ~ p q r s \",
+\". t ' | u v w x y z A n B 1 ! C D E F . \",
+\"G H : i I J K L M N z O b | ) P Q R S T \",
+\"U V W X Y Z ` ...+.y l @.} ' #.$.e %.&.\",
+\"& H W *.n =.-.;. .L x k 0 [ , #.Q e >.,.\",
+\"] '.2 ).a k z -.` K w j !.< > ~.d {.].^.\",
+\"d /.> (._.I k =.:.J v 0 8 : V <.[.}.|.1.\",
+\"2.3.~ 4.5._.6.n Y I u i 1 > P $.7.8.9.0.\",
+\"a.d b.V c.(.).*.X i | h ) '.d.e.E ].f.g.\",
+\"h.i.$.C ~ > 2 W W : ' ! j.d.k.e l.9.m.n.\",
+\". o.i.d p.q.'.H V H j.r.s.k.e 8.t.^.u.. \",
+\" v.r w.x.Q s.d.d.y.] z.5 A.8.t.B.C.D. \",
+\" E.l.F.e i.G.q 5 7.{.r %.H.^.I.J. \",
+\" ( K.L.%.M.N.N.O.P.S Q.R.S.T.U.( \",
+\" @ V.W.H.H.9.X.Y.S.I.Z.`. \",
+\" . +.+++@+C.#+$+D.. \"};")
+
+;; ======================================================================
+;; Functions
+
+(defsubst bubbles--grid-width ()
+ "Return the grid width for the current game theme."
+ (car (case bubbles-game-theme
+ ('easy
+ bubbles--grid-small)
+ ('medium
+ bubbles--grid-medium)
+ ('difficult
+ bubbles--grid-large)
+ ('hard
+ bubbles--grid-huge)
+ ('user-defined
+ bubbles-grid-size))))
+
+(defsubst bubbles--grid-height ()
+ "Return the grid height for the current game theme."
+ (cdr (case bubbles-game-theme
+ ('easy
+ bubbles--grid-small)
+ ('medium
+ bubbles--grid-medium)
+ ('difficult
+ bubbles--grid-large)
+ ('hard
+ bubbles--grid-huge)
+ ('user-defined
+ bubbles-grid-size))))
+
+(defsubst bubbles--colors ()
+ "Return the color list for the current game theme."
+ (case bubbles-game-theme
+ ('easy
+ bubbles--colors-2)
+ ('medium
+ bubbles--colors-3)
+ ('difficult
+ bubbles--colors-4)
+ ('hard
+ bubbles--colors-5)
+ ('user-defined
+ bubbles-colors)))
+
+(defsubst bubbles--shift-mode ()
+ "Return the shift mode for the current game theme."
+ (case bubbles-game-theme
+ ('easy
+ 'default)
+ ('medium
+ 'default)
+ ('difficult
+ 'always)
+ ('hard
+ 'always)
+ ('user-defined
+ bubbles-shift-mode)))
+
+(defun bubbles-save-settings ()
+ "Save current customization settings."
+ (interactive)
+ (custom-set-variables
+ (list 'bubbles-game-theme `(quote ,bubbles-game-theme) t)
+ (list 'bubbles-graphics-theme `(quote ,bubbles-graphics-theme) t))
+ (customize-save-customized))
+
+(defsubst bubbles--empty-char ()
+ "The character used for removed bubbles (empty grid cells)."
+ ? )
+
+(defun bubbles-set-graphics-theme-ascii ()
+ "Set graphics theme to `ascii'."
+ (interactive)
+ (setq bubbles-graphics-theme 'ascii)
+ (bubbles--update-faces-or-images))
+
+(defun bubbles-set-graphics-theme-circles ()
+ "Set graphics theme to `circles'."
+ (interactive)
+ (setq bubbles-graphics-theme 'circles)
+ (bubbles--initialize-images)
+ (bubbles--update-faces-or-images))
+
+(defun bubbles-set-graphics-theme-squares ()
+ "Set graphics theme to `squares'."
+ (interactive)
+ (setq bubbles-graphics-theme 'squares)
+ (bubbles--initialize-images)
+ (bubbles--update-faces-or-images))
+
+(defun bubbles-set-graphics-theme-diamonds ()
+ "Set graphics theme to `diamonds'."
+ (interactive)
+ (setq bubbles-graphics-theme 'diamonds)
+ (bubbles--initialize-images)
+ (bubbles--update-faces-or-images))
+
+(defun bubbles-set-graphics-theme-balls ()
+ "Set graphics theme to `balls'."
+ (interactive)
+ (setq bubbles-graphics-theme 'balls)
+ (bubbles--initialize-images)
+ (bubbles--update-faces-or-images))
+
+(defun bubbles-set-graphics-theme-emacs ()
+ "Set graphics theme to `emacs'."
+ (interactive)
+ (setq bubbles-graphics-theme 'emacs)
+ (bubbles--initialize-images)
+ (bubbles--update-faces-or-images))
+
+;; bubbles mode map
+(defvar bubbles-mode-map
+ (make-keymap 'bubbles-mode-map))
+(define-key bubbles-mode-map "q" 'bubbles-quit)
+(define-key bubbles-mode-map "\n" 'bubbles-plop)
+(define-key bubbles-mode-map " " 'bubbles-plop)
+(define-key bubbles-mode-map [double-down-mouse-1] 'bubbles-plop)
+(define-key bubbles-mode-map [mouse-2] 'bubbles-plop)
+(define-key bubbles-mode-map "\C-m" 'bubbles-plop)
+(define-key bubbles-mode-map "u" 'bubbles-undo)
+(define-key bubbles-mode-map "p" 'previous-line)
+(define-key bubbles-mode-map "n" 'next-line)
+(define-key bubbles-mode-map "f" 'forward-char)
+(define-key bubbles-mode-map "b" 'backward-char)
+
+
+;; game theme menu
+(defvar bubbles-game-theme-menu (make-sparse-keymap "Game Theme"))
+(define-key bubbles-game-theme-menu [bubbles-set-game-userdefined]
+ (list 'menu-item "User defined" 'bubbles-set-game-userdefined
+ :button '(:radio . (eq bubbles-game-theme 'user-defined))))
+(define-key bubbles-game-theme-menu [bubbles-set-game-hard]
+ (list 'menu-item "Hard" 'bubbles-set-game-hard
+ :button '(:radio . (eq bubbles-game-theme 'hard))))
+(define-key bubbles-game-theme-menu [bubbles-set-game-difficult]
+ (list 'menu-item "Difficult" 'bubbles-set-game-difficult
+ :button '(:radio . (eq bubbles-game-theme 'difficult))))
+(define-key bubbles-game-theme-menu [bubbles-set-game-medium]
+ (list 'menu-item "Medium" 'bubbles-set-game-medium
+ :button '(:radio . (eq bubbles-game-theme 'medium))))
+(define-key bubbles-game-theme-menu [bubbles-set-game-easy]
+ (list 'menu-item "Easy" 'bubbles-set-game-easy
+ :button '(:radio . (eq bubbles-game-theme 'easy))))
+
+;; graphics theme menu
+(defvar bubbles-graphics-theme-menu (make-sparse-keymap "Graphics Theme"))
+(define-key bubbles-graphics-theme-menu [bubbles-set-graphics-theme-ascii]
+ (list 'menu-item "ASCII" 'bubbles-set-graphics-theme-ascii
+ :button '(:radio . (eq bubbles-graphics-theme 'ascii))))
+(define-key bubbles-graphics-theme-menu [bubbles-set-graphics-theme-emacs]
+ (list 'menu-item "Emacs" 'bubbles-set-graphics-theme-emacs
+ :button '(:radio . (eq bubbles-graphics-theme 'emacs))))
+(define-key bubbles-graphics-theme-menu [bubbles-set-graphics-theme-balls]
+ (list 'menu-item "Balls" 'bubbles-set-graphics-theme-balls
+ :button '(:radio . (eq bubbles-graphics-theme 'balls))))
+(define-key bubbles-graphics-theme-menu [bubbles-set-graphics-theme-diamonds]
+ (list 'menu-item "Diamonds" 'bubbles-set-graphics-theme-diamonds
+ :button '(:radio . (eq bubbles-graphics-theme 'diamonds))))
+(define-key bubbles-graphics-theme-menu [bubbles-set-graphics-theme-squares]
+ (list 'menu-item "Squares" 'bubbles-set-graphics-theme-squares
+ :button '(:radio . (eq bubbles-graphics-theme 'squares))))
+(define-key bubbles-graphics-theme-menu [bubbles-set-graphics-theme-circles]
+ (list 'menu-item "Circles" 'bubbles-set-graphics-theme-circles
+ :button '(:radio . (eq bubbles-graphics-theme 'circles))))
+
+;; menu
+(defvar bubbles-menu (make-sparse-keymap "Bubbles"))
+(define-key bubbles-menu [bubbles-quit]
+ (list 'menu-item "Quit" 'bubbles-quit))
+(define-key bubbles-menu [bubbles]
+ (list 'menu-item "New game" 'bubbles))
+(define-key bubbles-menu [bubbles-separator-1]
+ '("--"))
+(define-key bubbles-menu [bubbles-save-settings]
+ (list 'menu-item "Save all settings" 'bubbles-save-settings))
+(define-key bubbles-menu [bubbles-customize]
+ (list 'menu-item "Edit all settings" 'bubbles-customize))
+(define-key bubbles-menu [bubbles-game-theme-menu]
+ (list 'menu-item "Game Theme" bubbles-game-theme-menu))
+(define-key bubbles-menu [bubbles-graphics-theme-menu]
+ (list 'menu-item "Graphics Theme" bubbles-graphics-theme-menu
+ :enable 'bubbles--playing))
+(define-key bubbles-menu [bubbles-separator-2]
+ '("--"))
+(define-key bubbles-menu [bubbles-undo]
+ (list 'menu-item "Undo last move" 'bubbles-undo
+ :enable '(and bubbles--playing bubbles--save-data)))
+
+;; bind menu to mouse
+(define-key bubbles-mode-map [down-mouse-3] bubbles-menu)
+;; Put menu in menu-bar
+(define-key bubbles-mode-map [menu-bar Bubbles]
+ (cons "Bubbles" bubbles-menu))
+
+(defun bubbles-mode ()
+ "Major mode for playing bubbles.
+\\{bubbles-mode-map}"
+ (kill-all-local-variables)
+ (use-local-map bubbles-mode-map)
+ (setq major-mode 'bubbles-mode)
+ (setq mode-name "Bubbles")
+ (setq buffer-read-only t)
+ (buffer-enable-undo)
+ (add-hook 'post-command-hook 'bubbles--mark-neighbourhood t t)
+ (run-hooks 'bubbles-mode-hook))
+
+;;;###autoload
+(defun bubbles ()
+ "Play Bubbles game."
+ (interactive)
+ (switch-to-buffer (get-buffer-create "*bubbles*"))
+ (when (or (not bubbles--playing)
+ (y-or-n-p "Start new game? "))
+ (setq bubbles--save-data nil)
+ (setq bubbles--playing t)
+ (bubbles--initialize)))
+
+(defun bubbles-quit ()
+ "Quit Bubbles."
+ (interactive)
+ (message "bubbles-quit")
+ (bury-buffer))
+
+(defun bubbles--compute-offsets ()
+ "Update horizontal and vertical offsets for centering the bubbles grid.
+Set `bubbles--col-offset' and `bubbles--row-offset'."
+ (cond ((and (display-images-p)
+ bubbles--images-ok
+ (not (eq bubbles-graphics-theme 'ascii))
+ (fboundp 'window-inside-pixel-edges))
+ ;; compute offset in units of pixels
+ (let ((bubbles--image-size
+ (car (image-size (car bubbles--images) t))))
+ (setq bubbles--col-offset
+ (list
+ (max 0 (/ (- (nth 2 (window-inside-pixel-edges))
+ (nth 0 (window-inside-pixel-edges))
+ (* ( + bubbles--image-size 2) ;; margin
+ (bubbles--grid-width))) 2))))
+ (setq bubbles--row-offset
+ (list
+ (max 0 (/ (- (nth 3 (window-inside-pixel-edges))
+ (nth 1 (window-inside-pixel-edges))
+ (* (+ bubbles--image-size 1) ;; margin
+ (bubbles--grid-height))) 2))))))
+ (t
+ ;; compute offset in units of chars
+ (setq bubbles--col-offset
+ (max 0 (/ (- (window-width)
+ (bubbles--grid-width)) 2)))
+ (setq bubbles--row-offset
+ (max 0 (/ (- (window-height)
+ (bubbles--grid-height) 2) 2))))))
+
+(defun bubbles--remove-overlays ()
+ "Remove all overlays."
+ (if (fboundp 'remove-overlays)
+ (remove-overlays)))
+
+(defun bubbles--initialize ()
+ "Initialize Bubbles game."
+ (bubbles--initialize-faces)
+ (bubbles--initialize-images)
+ (bubbles--remove-overlays)
+
+ (switch-to-buffer (get-buffer-create "*bubbles*"))
+ (bubbles--compute-offsets)
+ (let ((inhibit-read-only t))
+ (set-buffer-modified-p nil)
+ (erase-buffer)
+ (insert " ")
+ (add-text-properties
+ (point-min) (point) (list 'intangible t 'display
+ (cons 'space
+ (list :height bubbles--row-offset))))
+ (insert "\n")
+ (let ((max-char (length (bubbles--colors))))
+ (dotimes (i (bubbles--grid-height))
+ (let ((p (point)))
+ (insert " ")
+ (add-text-properties
+ p (point) (list 'intangible t
+ 'display (cons 'space
+ (list :width
+ bubbles--col-offset)))))
+ (dotimes (j (bubbles--grid-width))
+ (let* ((index (random max-char))
+ (char (nth index bubbles-chars)))
+ (insert char)
+ (add-text-properties (1- (point)) (point) (list 'index index))))
+ (insert "\n"))
+ (insert "\n ")
+ (add-text-properties
+ (1- (point)) (point) (list 'intangible t 'display
+ (cons 'space
+ (list :width bubbles--col-offset)))))
+ (put-text-property (point-min) (point-max) 'pointer 'arrow))
+ (bubbles-mode)
+ (bubbles--reset-score)
+ (bubbles--update-faces-or-images)
+ (bubbles--goto 0 0))
+
+(defun bubbles--initialize-faces ()
+ "Prepare faces for playing `bubbles'."
+ (copy-face 'default 'bubbles--highlight-face)
+ (set-face-background 'bubbles--highlight-face "#8080f4")
+ (when (display-color-p)
+ (setq bubbles--faces
+ (mapcar (lambda (color)
+ (let ((fname (intern (format "bubbles--face-%s" color))))
+ (unless (facep fname)
+ (copy-face 'default fname)
+ (set-face-foreground fname color))
+ fname))
+ (bubbles--colors)))))
+
+(defsubst bubbles--row (pos)
+ "Return row of point POS."
+ (save-excursion
+ (goto-char pos)
+ (beginning-of-line)
+ (1- (count-lines (point-min) (point)))))
+
+(defsubst bubbles--col (pos)
+ "Return column of point POS."
+ (save-excursion
+ (goto-char pos)
+ (1- (current-column))))
+
+(defun bubbles--goto (row col)
+ "Move point to bubble at coordinates ROW and COL."
+ (if (or (< row 0)
+ (< col 0)
+ (>= row (bubbles--grid-height))
+ (>= col (bubbles--grid-width)))
+ ;; Error! return nil
+ nil
+ ;; go
+ (goto-char (point-min))
+ (forward-line (1+ row))
+ (forward-char (1+ col))
+ (point)))
+
+(defun bubbles--char-at (row col)
+ "Return character at bubble ROW and COL."
+ (save-excursion
+ (if (bubbles--goto row col)
+ (char-after (point))
+ nil)))
+
+(defun bubbles--mark-direct-neighbours (row col char)
+ "Mark direct neighbours of bubble at ROW COL with same CHAR."
+ (save-excursion
+ (let ((count 0))
+ (when (and (bubbles--goto row col)
+ (eq char (char-after (point)))
+ (not (get-text-property (point) 'active)))
+ (add-text-properties (point) (1+ (point))
+ '(active t face 'bubbles--highlight-face))
+ (setq count (+ 1
+ (bubbles--mark-direct-neighbours row (1+ col) char)
+ (bubbles--mark-direct-neighbours row (1- col) char)
+ (bubbles--mark-direct-neighbours (1+ row) col char)
+ (bubbles--mark-direct-neighbours (1- row) col char))))
+ count)))
+
+(defun bubbles--mark-neighbourhood (&optional pos)
+ "Mark neighbourhood of point.
+Use optional parameter POS instead of point if given."
+ (when bubbles--playing
+ (unless pos (setq pos (point)))
+ (condition-case err
+ (let ((char (char-after pos))
+ (inhibit-read-only t)
+ (row (bubbles--row (point)))
+ (col (bubbles--col (point))))
+ (add-text-properties (point-min) (point-max)
+ '(face default active nil))
+ (let ((count 0))
+ (when (and row col (not (eq char (bubbles--empty-char))))
+ (setq count (bubbles--mark-direct-neighbours row col char))
+ (unless (> count 1)
+ (add-text-properties (point-min) (point-max)
+ '(face default active nil))
+ (setq count 0)))
+ (bubbles--update-neighbourhood-score count))
+ (put-text-property (point-min) (point-max) 'pointer 'arrow)
+ (bubbles--update-faces-or-images)
+ (sit-for 0))
+ (error (message "Bubbles: Internal error %s" err)))))
+
+(defun bubbles--neighbourhood-available ()
+ "Return t if another valid neighbourhood is available."
+ (catch 'found
+ (save-excursion
+ (dotimes (i (bubbles--grid-height))
+ (dotimes (j (bubbles--grid-width))
+ (let ((c (bubbles--char-at i j)))
+ (if (and (not (eq c (bubbles--empty-char)))
+ (or (eq c (bubbles--char-at (1+ i) j))
+ (eq c (bubbles--char-at i (1+ j)))))
+ (throw 'found t)))))
+ nil)))
+
+(defun bubbles--count ()
+ "Count remaining bubbles."
+ (let ((count 0))
+ (save-excursion
+ (dotimes (i (bubbles--grid-height))
+ (dotimes (j (bubbles--grid-width))
+ (let ((c (bubbles--char-at i j)))
+ (if (not (eq c (bubbles--empty-char)))
+ (setq count (1+ count)))))))
+ count))
+
+(defun bubbles--reset-score ()
+ "Reset bubbles score."
+ (setq bubbles--neighbourhood-score 0
+ bubbles--score 0)
+ (bubbles--update-score))
+
+(defun bubbles--update-score ()
+ "Calculate and display new bubble score."
+ (setq bubbles--score (+ bubbles--score bubbles--neighbourhood-score))
+ (bubbles--show-scores))
+
+(defun bubbles--update-neighbourhood-score (size)
+ "Calculate and display score of active neighbourhood from its SIZE."
+ (if (> size 1)
+ (setq bubbles--neighbourhood-score (expt (- size 1) 2))
+ (setq bubbles--neighbourhood-score 0))
+ (bubbles--show-scores))
+
+(defun bubbles--show-scores ()
+ "Display current scores."
+ (save-excursion
+ (goto-char (or (next-single-property-change (point-min) 'status)
+ (point-max)))
+ (let ((inhibit-read-only t)
+ (pos (point)))
+ (delete-region (point) (point-max))
+ (insert (format "Selected: %4d\n" bubbles--neighbourhood-score))
+ (insert " ")
+ (add-text-properties (1- (point)) (point)
+ (list 'intangible t 'display
+ (cons 'space
+ (list :width bubbles--col-offset))))
+ (insert (format "Score: %4d" bubbles--score))
+ (put-text-property pos (point) 'status t))))
+
+(defun bubbles--game-over ()
+ "Finish bubbles game."
+ (bubbles--update-faces-or-images)
+ (setq bubbles--playing nil
+ bubbles--save-data nil)
+ ;; add bonus if all bubbles were removed
+ (when (= 0 (bubbles--count))
+ (setq bubbles--score (+ bubbles--score (* (bubbles--grid-height)
+ (bubbles--grid-width))))
+ (bubbles--show-scores))
+ ;; Game over message
+ (goto-char (point-max))
+ (let* ((inhibit-read-only t))
+ (insert "\n ")
+ (add-text-properties (1- (point)) (point)
+ (list 'intangible t 'display
+ (cons 'space
+ (list :width bubbles--col-offset))))
+ (insert "Game Over!"))
+ ;; save score
+ (gamegrid-add-score (format "bubbles-%s-%d-%d-%d-scores"
+ (symbol-name (bubbles--shift-mode))
+ (length (bubbles--colors))
+ (bubbles--grid-width) (bubbles--grid-height))
+ bubbles--score))
+
+(defun bubbles-plop ()
+ "Remove active bubbles region."
+ (interactive)
+ (when (and bubbles--playing
+ (> bubbles--neighbourhood-score 0))
+ (setq bubbles--save-data (list bubbles--score (buffer-string)))
+ (setq buffer-undo-list '(apply bubbles-undo . nil))
+ (let ((inhibit-read-only t))
+ ;; blank out current neighbourhood
+ (let ((row (bubbles--row (point)))
+ (col (bubbles--col (point))))
+ (goto-char (point-max))
+ (while (not (bobp))
+ (backward-char)
+ (while (get-text-property (point) 'active)
+ (delete-char 1)
+ (insert (bubbles--empty-char))
+ (add-text-properties (1- (point)) (point) (list 'removed t
+ 'index -1))))
+ (bubbles--goto row col))
+ ;; show new score
+ (bubbles--update-score)
+ ;; update display and wait
+ (bubbles--update-faces-or-images)
+ (sit-for 0)
+ (sleep-for 0.2)
+ (discard-input)
+ ;; drop down
+ (let ((something-dropped nil))
+ (save-excursion
+ (dotimes (i (bubbles--grid-height))
+ (dotimes (j (bubbles--grid-width))
+ (bubbles--goto i j)
+ (while (get-text-property (point) 'removed)
+ (setq something-dropped (or (bubbles--shift 'top i j)
+ something-dropped))))))
+ ;; update display and wait
+ (bubbles--update-faces-or-images)
+ (when something-dropped
+ (sit-for 0)))
+ (discard-input)
+ ;; shift to left
+ (put-text-property (point-min) (point-max) 'removed nil)
+ (save-excursion
+ (goto-char (point-min))
+ (let ((removed-string (format "%c" (bubbles--empty-char))))
+ (while (search-forward removed-string nil t)
+ (put-text-property (1- (point)) (point) 'removed t))))
+ (let ((shifted nil))
+ (cond ((eq (bubbles--shift-mode) 'always)
+ (save-excursion
+ (dotimes (i (bubbles--grid-height))
+ (dotimes (j (bubbles--grid-width))
+ (bubbles--goto i j)
+ (while (get-text-property (point) 'removed)
+ (setq shifted (or (bubbles--shift 'right i j) shifted))))))
+ (bubbles--update-faces-or-images)
+ (sleep-for 0.5))
+ (t ;; default shift-mode
+ (save-excursion
+ (dotimes (j (bubbles--grid-width))
+ (bubbles--goto (1- (bubbles--grid-height)) j)
+ (let ((shifted-cols 0))
+ (while (get-text-property (point) 'removed)
+ (setq shifted-cols (1+ shifted-cols))
+ (bubbles--shift 'right (1- (bubbles--grid-height)) j))
+ (dotimes (k shifted-cols)
+ (let ((i (- (bubbles--grid-height) 2)))
+ (while (>= i 0)
+ (setq shifted (or (bubbles--shift 'right i j) shifted))
+ (setq i (1- i))))))))))
+ (when shifted
+ ;;(sleep-for 0.5)
+ (bubbles--update-faces-or-images)
+ (sit-for 0)))
+ (put-text-property (point-min) (point-max) 'removed nil)
+ (unless (bubbles--neighbourhood-available)
+ (bubbles--game-over)))))
+
+(defun bubbles-undo ()
+ "Undo last move."
+ (interactive)
+ (when bubbles--save-data
+ (let ((inhibit-read-only t)
+ (pos (point)))
+ (erase-buffer)
+ (insert (cadr bubbles--save-data))
+ (bubbles--update-faces-or-images)
+ (setq bubbles--score (car bubbles--save-data))
+ (goto-char pos))))
+
+(defun bubbles--shift (from row col)
+ "Move bubbles FROM one side to position ROW COL.
+Return t if new char is non-empty."
+ (save-excursion
+ (when (bubbles--goto row col)
+ (let ((char-org (char-after (point)))
+ (char-new (bubbles--empty-char))
+ (removed nil)
+ (trow row)
+ (tcol col)
+ (index -1))
+ (cond ((eq from 'top)
+ (setq trow (1- row)))
+ ((eq from 'left)
+ (setq tcol (1- col)))
+ ((eq from 'right)
+ (setq tcol (1+ col))))
+ (save-excursion
+ (when (bubbles--goto trow tcol)
+ (setq char-new (char-after (point)))
+ (setq removed (get-text-property (point) 'removed))
+ (setq index (get-text-property (point) 'index))
+ (bubbles--shift from trow tcol)))
+ (insert char-new)
+ (delete-char 1)
+ (add-text-properties (1- (point)) (point) (list 'index index
+ 'removed removed))
+ (not (eq char-new (bubbles--empty-char)))))))
+
+(defun bubbles--initialize-images ()
+ "Prepare images for playing `bubbles'."
+ (when (and (display-images-p)
+ (not (eq bubbles-graphics-theme 'ascii)))
+ (let ((template (case bubbles-graphics-theme
+ ('circles bubbles--image-template-circle)
+ ('balls bubbles--image-template-ball)
+ ('squares bubbles--image-template-square)
+ ('diamonds bubbles--image-template-diamond)
+ ('emacs bubbles--image-template-emacs))))
+ (setq bubbles--empty-image
+ (create-image (replace-regexp-in-string
+ "^\"\\(.*\\)\t.*c .*\",$"
+ "\"\\1\tc #FFFFFF\"," template)
+ 'xpm t
+ ;;:mask 'heuristic
+ :margin '(2 . 1)))
+ (setq bubbles--images
+ (mapcar (lambda (color)
+ (let* ((rgb (color-values color))
+ (red (nth 0 rgb))
+ (green (nth 1 rgb))
+ (blue (nth 2 rgb)))
+ (with-temp-buffer
+ (insert template)
+ (goto-char (point-min))
+ (re-search-forward
+ "^\"[0-9]+ [0-9]+ \\(.*?\\) .*\",$" nil t)
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^\"\\(.*\\)\t.*c \\(#.*\\)\",$" nil t)
+ (let* ((crgb (color-values (match-string 2)))
+ (r (nth 0 crgb))
+ (g (nth 1 crgb))
+ (b (nth 2 crgb))
+ (brightness (/ (+ r g b) 3.0 256 256))
+ (val (sin (* brightness (/ pi 2))))
+ (rr (* red val))
+ (gg (* green val))
+ (bb (* blue val))
+ ;;(rr (/ (+ red r) 2))
+ ;;(gg (/ (+ green g) 2))
+ ;;(bb (/ (+ blue b) 2))
+ (color (format "#%02x%02x%02x"
+ (/ rr 256) (/ gg 256)
+ (/ bb 256))))
+ (replace-match (format "\"\\1\tc %s\","
+ (upcase color)))))
+ (create-image (buffer-string) 'xpm t
+ :margin '(2 . 1)
+ ;;:mask 'heuristic
+ ))))
+ (bubbles--colors))))
+ ;; check images
+ (setq bubbles--images-ok bubbles--empty-image)
+ (mapc (lambda (elt)
+ (setq bubbles--images-ok (and bubbles--images-ok elt)))
+ bubbles--images)))
+
+(defun bubbles--update-faces-or-images ()
+ "Update faces and/or images, depending on graphics mode."
+ (bubbles--set-faces)
+ (bubbles--show-images))
+
+(defun bubbles--set-faces ()
+ "Update faces in the bubbles buffer."
+ (unless (and (display-images-p)
+ bubbles--images-ok
+ (not (eq bubbles-graphics-theme 'ascii)))
+ (when (display-color-p)
+ (save-excursion
+ (let ((inhibit-read-only t))
+ (dotimes (i (bubbles--grid-height))
+ (dotimes (j (bubbles--grid-width))
+ (bubbles--goto i j)
+ (let* ((index (get-text-property (point) 'index))
+ (face (nth index bubbles--faces))
+ (fg-col (face-foreground face)))
+ (when (get-text-property (point) 'active)
+ (set-face-foreground 'bubbles--highlight-face "#ff0000")
+ (setq face 'bubbles--highlight-face))
+ (put-text-property (point) (1+ (point))
+ 'face face)))))))))
+
+(defun bubbles--show-images ()
+ "Update images in the bubbles buffer."
+ (bubbles--remove-overlays)
+ (if (and (display-images-p)
+ bubbles--images-ok
+ (not (eq bubbles-graphics-theme 'ascii)))
+ (save-excursion
+ (goto-char (point-min))
+ (forward-line 1)
+ (let ((inhibit-read-only t)
+ char)
+ (dotimes (i (bubbles--grid-height))
+ (dotimes (j (bubbles--grid-width))
+ (forward-char 1)
+ (let ((index (get-text-property (point) 'index)))
+ (let ((img bubbles--empty-image))
+ (if (>= index 0)
+ (setq img (nth index bubbles--images)))
+ (put-text-property (point) (1+ (point))
+ 'display (cons img nil)))))
+ (forward-line 1))))
+ (save-excursion
+ (let ((inhibit-read-only t))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let ((disp-prop (get-text-property (point) 'display)))
+ (if (and (listp disp-prop)
+ (listp (car disp-prop))
+ (eq (caar disp-prop) 'image))
+ (put-text-property (point) (1+ (point)) 'display nil))
+ (forward-char 1)))
+ (put-text-property (point-min) (point-max) 'pointer 'arrow)))))
+
+(provide 'bubbles)
+
+;;; bubbles.el ends here
projects / emacs.git / commitdiff