;;; bubbles.el --- Puzzle game for Emacs.;; Copyright (C) 2007, 2008 Free Software Foundation, Inc.;; Author: Ulf Jasper <ulf.jasper@web.de>;; URL: http://ulf.epplejasper.de/;; Created: 5. Feb. 2007;; Keywords: games;; This file is part of GNU Emacs.;; GNU Emacs 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 3 of the License, or;; (at your option) any later version.;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.;;; 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.5 (2007-09-14);; - Minor bugfixes.;; 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:(defconst bubbles-version "0.5" "Version number of bubbles.el.")(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 displayimages 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 bubbletypes 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 bythe 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 neighborhood.")(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));; game theme menu(defvar bubbles-game-theme-menu (let ((menu (make-sparse-keymap "Game Theme"))) (define-key menu [bubbles-set-game-userdefined] (list 'menu-item "User defined" 'bubbles-set-game-userdefined :button '(:radio . (eq bubbles-game-theme 'user-defined)))) (define-key menu [bubbles-set-game-hard] (list 'menu-item "Hard" 'bubbles-set-game-hard :button '(:radio . (eq bubbles-game-theme 'hard)))) (define-key menu [bubbles-set-game-difficult] (list 'menu-item "Difficult" 'bubbles-set-game-difficult :button '(:radio . (eq bubbles-game-theme 'difficult)))) (define-key menu [bubbles-set-game-medium] (list 'menu-item "Medium" 'bubbles-set-game-medium :button '(:radio . (eq bubbles-game-theme 'medium)))) (define-key menu [bubbles-set-game-easy] (list 'menu-item "Easy" 'bubbles-set-game-easy :button '(:radio . (eq bubbles-game-theme 'easy)))) menu) "Map for bubbles game theme menu.");; graphics theme menu(defvar bubbles-graphics-theme-menu (let ((menu (make-sparse-keymap "Graphics Theme"))) (define-key menu [bubbles-set-graphics-theme-ascii] (list 'menu-item "ASCII" 'bubbles-set-graphics-theme-ascii :button '(:radio . (eq bubbles-graphics-theme 'ascii)))) (define-key menu [bubbles-set-graphics-theme-emacs] (list 'menu-item "Emacs" 'bubbles-set-graphics-theme-emacs :button '(:radio . (eq bubbles-graphics-theme 'emacs)))) (define-key menu [bubbles-set-graphics-theme-balls] (list 'menu-item "Balls" 'bubbles-set-graphics-theme-balls :button '(:radio . (eq bubbles-graphics-theme 'balls)))) (define-key menu [bubbles-set-graphics-theme-diamonds] (list 'menu-item "Diamonds" 'bubbles-set-graphics-theme-diamonds :button '(:radio . (eq bubbles-graphics-theme 'diamonds)))) (define-key menu [bubbles-set-graphics-theme-squares] (list 'menu-item "Squares" 'bubbles-set-graphics-theme-squares :button '(:radio . (eq bubbles-graphics-theme 'squares)))) (define-key menu [bubbles-set-graphics-theme-circles] (list 'menu-item "Circles" 'bubbles-set-graphics-theme-circles :button '(:radio . (eq bubbles-graphics-theme 'circles)))) menu) "Map for bubbles graphics theme menu.");; menu(defvar bubbles-menu (let ((menu (make-sparse-keymap "Bubbles"))) (define-key menu [bubbles-quit] (list 'menu-item "Quit" 'bubbles-quit)) (define-key menu [bubbles] (list 'menu-item "New game" 'bubbles)) (define-key menu [bubbles-separator-1] '("--")) (define-key menu [bubbles-save-settings] (list 'menu-item "Save all settings" 'bubbles-save-settings)) (define-key menu [bubbles-customize] (list 'menu-item "Edit all settings" 'bubbles-customize)) (define-key menu [bubbles-game-theme-menu] (list 'menu-item "Game Theme" bubbles-game-theme-menu)) (define-key menu [bubbles-graphics-theme-menu] (list 'menu-item "Graphics Theme" bubbles-graphics-theme-menu :enable 'bubbles--playing)) (define-key menu [bubbles-separator-2] '("--")) (define-key menu [bubbles-undo] (list 'menu-item "Undo last move" 'bubbles-undo :enable '(and bubbles--playing (listp buffer-undo-list)))) menu) "Map for bubbles menu.");; bubbles mode map(defvar bubbles-mode-map (let ((map (make-sparse-keymap 'bubbles-mode-map)));; (suppress-keymap map t) (define-key map "q" 'bubbles-quit) (define-key map "\n" 'bubbles-plop) (define-key map " " 'bubbles-plop) (define-key map [double-down-mouse-1] 'bubbles-plop) (define-key map [mouse-2] 'bubbles-plop) (define-key map "\C-m" 'bubbles-plop) (define-key map "u" 'bubbles-undo) (define-key map "p" 'previous-line) (define-key map "n" 'next-line) (define-key map "f" 'forward-char) (define-key map "b" 'backward-char) ;; bind menu to mouse (define-key map [down-mouse-3] bubbles-menu) ;; Put menu in menu-bar (define-key map [menu-bar Bubbles] (cons "Bubbles" bubbles-menu)) map) "Mode map for bubbles.")(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-disable-undo) (setq buffer-undo-list t) (force-mode-line-update) (redisplay) (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))(declare-function image-size "image.c" (spec &optional pixels frame))(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) (setq buffer-undo-list t) (force-mode-line-update) (redisplay))(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 neighbors 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 neighborhood 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 neighborhood 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 neighborhood 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))) (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))) ;; undo (setq buffer-undo-list '((apply bubbles-undo . nil))) (force-mode-line-update) (redisplay)))(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)) (setq buffer-undo-list t) (force-mode-line-update) (redisplay)))(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 None\"," 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 (or (get-text-property (point) 'index) -1))) (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);; arch-tag: 2cd7237a-b0ad-400d-a7fd-75f676dceb70;;; bubbles.el ends here
