[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bubbles.el 0.3
|
From: |
Ulf Jasper |
|
Subject: |
bubbles.el 0.3 |
|
Date: |
Sun, 11 Mar 2007 20:08:17 +0100 |
This is version 0.3 of bubbles.el, a puzzle game for Emacs.
Changes since version 0.2:
- 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.
It has been tested with GNU Emacs 22.0.93
Enjoy!
ulf
;;; bubbles.el --- Puzzle game for Emacs.
;; Copyright (C) 2007 Ulf Jasper
;; This file is NOT part of GNU Emacs.
;; Author: Ulf Jasper <address@hidden>
;; Filename: bubbles.el
;; URL: http://de.geocities.com/ulf_jasper/emacs
;; Created: 5. Feb. 2007
;; Keywords: Games
;; Time-stamp: "11. März 2007, 17:58:00 (ulf)"
;; CVS-Version: $Id: bubbles.el,v 1.10 2007-03-11 19:06:06 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.3" "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 line to your Emacs startup file (`~/.emacs').
;; (add-to-list 'load-path "/path/to/bubbles/")
;; (autoload 'bubbles "bubbles" "Play Bubbles" t)
;; ======================================================================
;;; History:
;; 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 '("red" "green2" "lightblue" "orange")
"Predefined bubbles color list with four colors.")
(defconst bubbles--colors-5 '("red" "darkgreen" "blue" "orange" "violet")
"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)
(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.")
(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 \",
\"` ` ` ` ` ` .} } ..` ` ` ` ` ` ` ` ` ` ` +.` ` \",
\"@address@hidden@address@hidden@address@hidden@address@hidden@address@hidden@address@hidden@address@hidden@address@hidden@.&address@hidden@.\",
\"*.*.*.*.*.*.*.*.=.-.} ;.>.*.*.*.*.*.*.*.*.,.*.*.\",
\"'.'.'.'.'.'.'.'.'.'.).!.} !.~.'.'.'.'.'.'.{.'.'.\",
\"].].].].].].].].].].].].^.} /.(.].].].].]._.].].\",
\":.:.:.:.:.:.:.:.:.:.<.[./.} } }.:.:.:.:.:.|.:.:.\",
\" 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.`. \",
\" . address@hidden \"};")
;; ======================================================================
;; 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--set-faces)
(bubbles--show-images))
(defun bubbles-set-graphics-theme-circles ()
"Set graphics theme to `circles'."
(interactive)
(setq bubbles-graphics-theme 'circles)
(bubbles--set-faces)
(bubbles--initialize-images)
(bubbles--show-images))
(defun bubbles-set-graphics-theme-squares ()
"Set graphics theme to `squares'."
(interactive)
(setq bubbles-graphics-theme 'squares)
(bubbles--set-faces)
(bubbles--initialize-images)
(bubbles--show-images))
(defun bubbles-set-graphics-theme-diamonds ()
"Set graphics theme to `diamonds'."
(interactive)
(setq bubbles-graphics-theme 'diamonds)
(bubbles--set-faces)
(bubbles--initialize-images)
(bubbles--show-images))
(defun bubbles-set-graphics-theme-balls ()
"Set graphics theme to `balls'."
(interactive)
(setq bubbles-graphics-theme 'balls)
(bubbles--set-faces)
(bubbles--initialize-images)
(bubbles--show-images))
(defun bubbles-set-graphics-theme-emacs ()
"Set graphics theme to `emacs'."
(interactive)
(setq bubbles-graphics-theme 'emacs)
(bubbles--set-faces)
(bubbles--initialize-images)
(bubbles--show-images))
;; bubbles mode map
(defvar bubbles-mode-map
(make-sparse-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 "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))
:enable 'bubbles--playing))
(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))
:enable 'bubbles--playing))
(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))
:enable 'bubbles--playing))
(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))
:enable 'bubbles--playing))
(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))
:enable 'bubbles--playing))
;; 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))
:enable 'bubbles--playing))
(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))
:enable 'bubbles--playing))
(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))
:enable 'bubbles--playing))
(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))
:enable 'bubbles--playing))
(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))
:enable 'bubbles--playing))
(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))
:enable 'bubbles--playing))
;; 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-game-theme-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
:enable 'bubbles--playing))
(define-key bubbles-menu [bubbles-graphics-theme-menu]
(list 'menu-item "Graphics Theme" bubbles-graphics-theme-menu
:enable 'bubbles--playing))
;; 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)
;;(setq buffer-undo-list t)
(add-hook 'post-command-hook 'bubbles--mark-neighbourhood t t))
;;;###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--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--initialize ()
"Initialize Bubbles game."
(bubbles--initialize-faces)
(bubbles--initialize-images)
(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 'row -1 'col -1
'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 'row i 'col -1
'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 'row i 'col j 'index index))))
(insert "\n"))
(insert "\n ")
(add-text-properties
(1- (point)) (point) (list 'intangible t 'row -1 'col -1
'display
(cons 'space
(list :width bubbles--col-offset))))))
(bubbles-mode)
(bubbles--reset-score)
(bubbles--set-faces)
(bubbles--show-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 "#00ff00")
(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)))))
(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))
(let ((r (or (get-text-property (point) 'row) -1))
(c (or (get-text-property (point) 'col) -1)))
(while (< r row)
(forward-line 1)
(setq r (or (get-text-property (point) 'row) r)))
(setq c (or (get-text-property (point) 'col) -1))
(while (< c col)
(forward-char 1)
(setq c (or (get-text-property (point) 'col) c))))
(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)))
(put-text-property (point) (1+ (point)) 'active t)
(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 (get-text-property (point) 'row))
(col (get-text-property (point) 'col)))
(add-text-properties (point-min) (point-max) '(face default
active nil))
(when (and row col (not (eq char (bubbles--empty-char))))
(let ((count (bubbles--mark-direct-neighbours row col char)))
(if (> count 1)
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(if (get-text-property (point) 'active)
(put-text-property (point) (1+ (point))
'face 'bubbles--highlight-face))
(forward-char))))
(bubbles--update-neighbourhood-score count)))
(bubbles--set-faces)
(bubbles--show-images))
(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--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 'row -1 'col -1
'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."
(setq bubbles--playing nil)
(goto-char (point-max))
(let* ((inhibit-read-only t))
(insert "\n ")
(add-text-properties (1- (point)) (point)
(list 'intangible t 'row -1 'col -1
'display
(cons 'space
(list :width bubbles--col-offset))))
(insert "Game Over!"))
(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))
(let ((inhibit-read-only t))
;; blank out current neighbourhood
(save-excursion
(goto-char (point-max))
(while (not (bobp))
(backward-char)
(while (get-text-property (point) 'active)
(let ((row (get-text-property (point) 'row))
(col (get-text-property (point) 'col)))
(delete-char 1)
(insert (bubbles--empty-char))
(add-text-properties (1- (point)) (point) (list 'removed t
'row row
'col col
'index -1))))))
;; show new score
(bubbles--update-score)
;; update display and wait
(bubbles--set-faces)
(bubbles--show-images)
(sit-for 0)
(sleep-for 0.5)
(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
(when something-dropped
(bubbles--set-faces)
(bubbles--show-images)
(sit-for 0)))
(sleep-for 0.5)
(discard-input)
;; shift to left
(put-text-property (point-min) (point-max) 'removed nil)
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(if (eq (char-after (point)) (bubbles--empty-char))
(put-text-property (point) (1+ (point)) 'removed t))
(forward-char 1)))
(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)
(bubbles--shift 'right i j))))))
(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)
(bubbles--shift 'right i j)
(setq i (1- i))))))))))
(put-text-property (point-min) (point-max) 'removed nil)
(bubbles--set-faces)
(bubbles--show-images)
(unless (bubbles--neighbourhood-available)
(bubbles--game-over)))))
(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 'row row 'col col
'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--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)))
(unless (eq (get-text-property (point) 'face)
'bubbles--highlight-face)
(put-text-property (point) (1+ (point))
'face (nth index bubbles--faces)))))))))))
(defun bubbles--show-images ()
"Update images in the bubbles buffer."
(if (and (display-images-p)
bubbles--images-ok
(not (eq bubbles-graphics-theme 'ascii)))
(save-excursion
(let ((inhibit-read-only t)
char)
(dotimes (i (bubbles--grid-height))
(dotimes (j (bubbles--grid-width))
(bubbles--goto i j)
(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))))))))
(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)))))))
(provide 'bubbles)
;;; bubbles.el ends here
- bubbles.el 0.3,
Ulf Jasper <=