Mercurial > emacs
changeset 82921:d6f5e792bbb2
Initial revision
| author | Thien-Thi Nguyen <ttn@gnuvola.org> |
|---|---|
| date | Mon, 27 Aug 2007 18:49:42 +0000 |
| parents | 3c376ca07deb |
| children | 16c56e4babd8 |
| files | lisp/play/bubbles.el |
| diffstat | 1 files changed, 1438 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/play/bubbles.el Mon Aug 27 18:49:42 2007 +0000 @@ -0,0 +1,1438 @@ +;;; 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