-;;; bubbles.el --- Puzzle game for Emacs
+;;; bubbles.el --- Puzzle game for Emacs -*- coding: utf-8 -*-
-;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2014 Free Software Foundation, Inc.
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; URL: http://ulf.epplejasper.de/
;; Installation
;; ------------
-;; Add the following lines to your Emacs startup file (`~/.emacs').
+;; Add the following lines to your init file:
;; (add-to-list 'load-path "/path/to/bubbles/")
;; (autoload 'bubbles "bubbles" "Play Bubbles" t)
(defconst bubbles-version "0.5" "Version number of bubbles.el.")
(require 'gamegrid)
-(eval-when-compile (require 'cl)) ; for 'case
;; User options
:group 'bubbles)
(defcustom bubbles-chars
- '(?+ ?O ?# ?X ?. ?* ?& ?§)
+ '(?+ ?O ?# ?X ?. ?* ?& ?§)
"Characters used for bubbles.
Note that the actual number of different bubbles is determined by
the number of colors, see `bubbles-colors'."
Available modes are `shift-default' and `shift-always'."
:type '(radio (const :tag "Default" default)
(const :tag "Shifter" always)
- ;;(const :tag "Mega Shifter" 'mega)
+ ;;(const :tag "Mega Shifter" mega)
)
:group 'bubbles)
(defvar bubbles--score 0
"Current Bubbles score.")
-(defvar bubbles--neighbourhood-score 0
+(defvar bubbles--neighborhood-score 0
"Score of active bubbles neighborhood.")
(defvar bubbles--faces nil
(defsubst bubbles--grid-width ()
"Return the grid width for the current game theme."
- (car (case bubbles-game-theme
- (easy
+ (car (pcase bubbles-game-theme
+ (`easy
bubbles--grid-small)
- (medium
+ (`medium
bubbles--grid-medium)
- (difficult
+ (`difficult
bubbles--grid-large)
- (hard
+ (`hard
bubbles--grid-huge)
- (user-defined
+ (`user-defined
bubbles-grid-size))))
(defsubst bubbles--grid-height ()
"Return the grid height for the current game theme."
- (cdr (case bubbles-game-theme
- (easy
+ (cdr (pcase bubbles-game-theme
+ (`easy
bubbles--grid-small)
- (medium
+ (`medium
bubbles--grid-medium)
- (difficult
+ (`difficult
bubbles--grid-large)
- (hard
+ (`hard
bubbles--grid-huge)
- (user-defined
+ (`user-defined
bubbles-grid-size))))
(defsubst bubbles--colors ()
"Return the color list for the current game theme."
- (case bubbles-game-theme
- (easy
+ (pcase bubbles-game-theme
+ (`easy
bubbles--colors-2)
- (medium
+ (`medium
bubbles--colors-3)
- (difficult
+ (`difficult
bubbles--colors-4)
- (hard
+ (`hard
bubbles--colors-5)
- (user-defined
+ (`user-defined
bubbles-colors)))
(defsubst bubbles--shift-mode ()
"Return the shift mode for the current game theme."
- (case bubbles-game-theme
- (easy
+ (pcase bubbles-game-theme
+ (`easy
'default)
- (medium
+ (`medium
'default)
- (difficult
+ (`difficult
'always)
- (hard
+ (`hard
'always)
- (user-defined
+ (`user-defined
bubbles-shift-mode)))
(defun bubbles-save-settings ()
(buffer-disable-undo)
(force-mode-line-update)
(redisplay)
- (add-hook 'post-command-hook 'bubbles--mark-neighbourhood t t))
+ (add-hook 'post-command-hook 'bubbles--mark-neighborhood t t))
;;;###autoload
(defun bubbles ()
(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))))
+ (put-text-property (point-min) (point)
+ '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)))))
+ (put-text-property p (point)
+ 'display
+ (cons 'space (list :width bubbles--col-offset))))
(dotimes (j (bubbles--grid-width))
(let* ((index (random max-char))
(char (nth index bubbles-chars)))
(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 (1- (point)) (point)
+ 'display
+ (cons 'space (list :width bubbles--col-offset))))
(put-text-property (point-min) (point-max) 'pointer 'arrow))
(bubbles-mode)
(bubbles--reset-score)
(char-after (point))
nil)))
-(defun bubbles--mark-direct-neighbours (row col char)
+(defun bubbles--mark-direct-neighbors (row col char)
"Mark direct neighbors of bubble at ROW COL with same CHAR."
(save-excursion
(let ((count 0))
(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))))
+ (bubbles--mark-direct-neighbors row (1+ col) char)
+ (bubbles--mark-direct-neighbors row (1- col) char)
+ (bubbles--mark-direct-neighbors (1+ row) col char)
+ (bubbles--mark-direct-neighbors (1- row) col char))))
count)))
-(defun bubbles--mark-neighbourhood (&optional pos)
+(defun bubbles--mark-neighborhood (&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)))))
+ (with-demoted-errors "Bubbles: Internal error %s"
+ (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-neighbors row col char))
+ (unless (> count 1)
+ (add-text-properties (point-min) (point-max)
+ '(face default active nil))
+ (setq count 0)))
+ (bubbles--update-neighborhood-score count))
+ (put-text-property (point-min) (point-max) 'pointer 'arrow)
+ (bubbles--update-faces-or-images)
+ (sit-for 0)))))
-(defun bubbles--neighbourhood-available ()
+(defun bubbles--neighborhood-available ()
"Return t if another valid neighborhood is available."
(catch 'found
(save-excursion
(defun bubbles--reset-score ()
"Reset bubbles score."
- (setq bubbles--neighbourhood-score 0
+ (setq bubbles--neighborhood-score 0
bubbles--score 0)
(bubbles--update-score))
(defun bubbles--update-score ()
"Calculate and display new bubbles score."
- (setq bubbles--score (+ bubbles--score bubbles--neighbourhood-score))
+ (setq bubbles--score (+ bubbles--score bubbles--neighborhood-score))
(bubbles--show-scores))
-(defun bubbles--update-neighbourhood-score (size)
+(defun bubbles--update-neighborhood-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))
+ (setq bubbles--neighborhood-score (expt (- size 1) 2))
+ (setq bubbles--neighborhood-score 0))
(bubbles--show-scores))
(defun bubbles--show-scores ()
(let ((inhibit-read-only t)
(pos (point)))
(delete-region (point) (point-max))
- (insert (format "Selected: %4d\n" bubbles--neighbourhood-score))
+ (insert (format "Selected: %4d\n" bubbles--neighborhood-score))
(insert " ")
- (add-text-properties (1- (point)) (point)
- (list 'intangible t 'display
- (cons 'space
- (list :width bubbles--col-offset))))
+ (put-text-property (1- (point)) (point)
+ 'display
+ (cons 'space (list :width bubbles--col-offset)))
(insert (format "Score: %4d" bubbles--score))
(put-text-property pos (point) 'status t))))
(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))))
+ (put-text-property (1- (point)) (point)
+ 'display
+ (cons 'space (list :width bubbles--col-offset)))
(insert "Game Over!"))
;; save score
(gamegrid-add-score (format "bubbles-%s-%d-%d-%d-scores"
"Remove active bubbles region."
(interactive)
(when (and bubbles--playing
- (> bubbles--neighbourhood-score 0))
+ (> bubbles--neighborhood-score 0))
(setq bubbles--save-data (list bubbles--score (buffer-string)))
(let ((inhibit-read-only t))
- ;; blank out current neighbourhood
+ ;; blank out current neighborhood
(let ((row (bubbles--row (point)))
(col (bubbles--col (point))))
(goto-char (point-max))
(bubbles--update-faces-or-images)
(sit-for 0)))
(put-text-property (point-min) (point-max) 'removed nil)
- (unless (bubbles--neighbourhood-available)
+ (unless (bubbles--neighborhood-available)
(bubbles--game-over)))
;; undo
(setq buffer-undo-list '((apply bubbles-undo . nil)))
"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))))
+ (let ((template (pcase 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 .*\",$"