From: Dieter Deyke <dieter.deyke@gmail.com>
To: emacs-devel@gnu.org
Subject: [PATCH] elpa/packages/sokoban/sokoban.el
Date: Sun, 09 Jul 2017 15:36:27 +0200 [thread overview]
Message-ID: <87bmotlokk.fsf@deyke2> (raw)
[-- Attachment #1: Type: text/plain, Size: 211 bytes --]
Hi,
I would like to patch elpa/packages/sokoban/sokoban.el to change the
player and block color if on a target field. This makes it much easier
to see if a block is already correctly placed or not.
Comments?
[-- Attachment #2: patch --]
[-- Type: text/plain, Size: 10484 bytes --]
--- /home/deyke/elpa/packages/sokoban/sokoban.el 2017-07-08 15:12:07.623777314 +0200
+++ ./sokoban.el 2017-07-09 14:59:13.914946896 +0200
@@ -4,7 +4,7 @@
;; Author: Glynn Clements <glynn.clements@xemacs.org>
;; Maintainer: Dieter Deyke <dieter.deyke@gmail.com>
-;; Version: 1.4.1
+;; Version: 1.4.2
;; Created: 1997-09-11
;; Keywords: games
;; Package-Type: multi
@@ -46,6 +46,7 @@
;; restore sokoban-level when game is started
;; Modified: 2017-05-27, allow for player to start on a target,
;; allow for wider and higher levels
+;; Modified: 2017-07-09, change player and block color if on target
;; Tested with XEmacs 20.3/4/5 and Emacs 19.34
@@ -149,7 +150,7 @@
\"32 32 3 1\",
\" c None\",
\". c black\",
-\"X c yellow\",
+\"X c green\",
\" \",
\" \",
\" \",
@@ -268,6 +269,48 @@
};
")
+(defconst sokoban-block-on-target-xpm "\
+/* XPM */
+static char * block_on_target_xpm[] = {
+\"32 32 3 1\",
+\" c None\",
+\". c black\",
+\"X c green\",
+\"............................. \",
+\".XXXXXXXXXXXXXXXXXXXXXXXXXXX. \",
+\".XXXXXXXXXXXXXXXXXXXXXXXXXXX.. \",
+\".XXXXXXXXXXXXXXXXXXXXXXXXXXX.. \",
+\".XXXXXXXXXXXXXXXXXXXXXXXXXXX.X. \",
+\".XXXXXXXXXXXXXXXXXXXXXXXXXXX.X. \",
+\".XXXXXXXXXXXXXXXXXXXXXXXXXXX.XX.\",
+\".XXXXXXXXXXXXXXXXXXXXXXXXXXX.XX.\",
+\".XXXXXXXXXXXXXXXXXXXXXXXXXXX.XX.\",
+\".XXXXXXXXXXXXXXXXXXXXXXXXXXX.XX.\",
+\".XXXXXXXXXXXXXXXXXXXXXXXXXXX.XX.\",
+\".XXXXXXXXXXXXXXXXXXXXXXXXXXX.XX.\",
+\".XXXXXXXXXXXXXXXXXXXXXXXXXXX.XX.\",
+\".XXXXXXXXXXXXXXXXXXXXXXXXXXX.XX.\",
+\".XXXXXXXXXXXXXXXXXXXXXXXXXXX.XX.\",
+\".XXXXXXXXXXXXXXXXXXXXXXXXXXX.XX.\",
+\".XXXXXXXXXXXXXXXXXXXXXXXXXXX.XX.\",
+\".XXXXXXXXXXXXXXXXXXXXXXXXXXX.XX.\",
+\".XXXXXXXXXXXXXXXXXXXXXXXXXXX.XX.\",
+\".XXXXXXXXXXXXXXXXXXXXXXXXXXX.XX.\",
+\".XXXXXXXXXXXXXXXXXXXXXXXXXXX.XX.\",
+\".XXXXXXXXXXXXXXXXXXXXXXXXXXX.XX.\",
+\".XXXXXXXXXXXXXXXXXXXXXXXXXXX.XX.\",
+\".XXXXXXXXXXXXXXXXXXXXXXXXXXX.XX.\",
+\".............................XX.\",
+\".XXXXXXXXXXXXXXXXXXXXXXXXXXX.XX.\",
+\" .XXXXXXXXXXXXXXXXXXXXXXXXXXX.X.\",
+\" .XXXXXXXXXXXXXXXXXXXXXXXXXXX.X.\",
+\" .XXXXXXXXXXXXXXXXXXXXXXXXXXX..\",
+\" .XXXXXXXXXXXXXXXXXXXXXXXXXXX..\",
+\" .XXXXXXXXXXXXXXXXXXXXXXXXXXX.\",
+\" .............................\",
+};
+")
+
(defconst sokoban-player-xpm "\
/* XPM */
static char * player_xpm[] = {
@@ -310,6 +353,49 @@
};
")
+(defconst sokoban-player-on-target-xpm "\
+/* XPM */
+static char * player_on_target_xpm[] = {
+\"32 32 4 1\",
+\" c None\",
+\"o c white\",
+\". c black\",
+\"X c green\",
+\" \",
+\" \",
+\" \",
+\" oooooooo \",
+\" o......o \",
+\" o.oooooo.o \",
+\" .o.oooooo.o. \",
+\" o.oooooooo.o \",
+\" o.o..oo..o.o \",
+\" o.oooooooo.o \",
+\" .. oo.o....o.oo .. \",
+\" .X.oo..oo..oo..oo.X. \",
+\" .XXo....o..o....oXX. \",
+\" .XXo.o..o..o..o.oXX. \",
+\" .XXo.o...oo...o.oXX. \",
+\" .Xo.oo........oo.oX. \",
+\" .Xo.oo........oo.oX. \",
+\" .o.ooo........ooo.o. \",
+\" .o.ooo........ooo.o. \",
+\" .o.ooo........ooo.o. \",
+\" .Xo.oo........oo.oX. \",
+\" ..o.oo........oo.o.. \",
+\" o.o..........o.o \",
+\" o............o \",
+\" o..........o \",
+\" .o........o. \",
+\" o.o.oooo.o.o \",
+\" o.....oo.....o \",
+\" o......oo......o \",
+\" o.......oo.......o \",
+\" o..o..o..oo.oo..o..o \",
+\" oooooooooooooooooooo \",
+};
+")
+
(defconst sokoban-floor ?\&)
;; note - space character in level file is also allowed to indicate floor
(defconst sokoban-target ?\.)
@@ -365,6 +451,17 @@
(((glyph color-x) [1 0 0])
(color-tty "red"))))
+(defvar sokoban-block-on-target-options
+ `(((glyph
+ [xpm :data ,sokoban-block-on-target-xpm])
+ ((mono-x mono-tty emacs-tty) ?\O)
+ (t ?\040))
+ ((color-x color-x)
+ (mono-x grid-x)
+ (color-tty color-tty))
+ (((glyph color-x) [1 0 0])
+ (color-tty "red"))))
+
(defvar sokoban-player-options
`(((glyph
[xpm :data ,sokoban-player-xpm])
@@ -375,6 +472,16 @@
(((glyph color-x) [0 1 0])
(color-tty "green"))))
+(defvar sokoban-player-on-target-options
+ `(((glyph
+ [xpm :data ,sokoban-player-on-target-xpm])
+ (t ?\*))
+ ((color-x color-x)
+ (mono-x grid-x)
+ (color-tty color-tty))
+ (((glyph color-x) [0 1 0])
+ (color-tty "green"))))
+
;; ;;;;;;;;;;;;; variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar sokoban-level 0)
@@ -477,8 +584,12 @@
sokoban-wall-options)
((= c sokoban-block)
sokoban-block-options)
+ ((= c sokoban-block-on-target)
+ sokoban-block-on-target-options)
((= c sokoban-player)
sokoban-player-options)
+ ((= c sokoban-player-on-target)
+ sokoban-player-on-target-options)
(t
'(nil nil nil)))))
options))
@@ -490,23 +601,15 @@
(dotimes (x sokoban-width)
(let ((c (aref (aref sokoban-level-map y) x)))
(cond
- ((or (= c sokoban-target)
- (= c sokoban-player-on-target))
+ ((or (eq c sokoban-target)
+ (eq c sokoban-player-on-target))
(incf sokoban-targets))
- ((= c sokoban-block-on-target)
+ ((eq c sokoban-block-on-target)
(incf sokoban-targets)
(incf sokoban-done))
((= c ?\040) ;; treat space characters in level file as floor
(aset (aref sokoban-level-map y) x sokoban-floor)))))))
-(defun sokoban-get-floor (x y)
- (let ((c (aref (aref sokoban-level-map y) x)))
- (if (or (= c sokoban-target)
- (= c sokoban-block-on-target)
- (= c sokoban-player-on-target))
- sokoban-target
- sokoban-floor)))
-
(defun sokoban-init-buffer ()
(gamegrid-init-buffer sokoban-buffer-width
sokoban-buffer-height
@@ -514,15 +617,10 @@
(dotimes (y sokoban-height)
(dotimes (x sokoban-width)
(let ((c (aref (aref sokoban-level-map y) x)))
- (if (= c sokoban-player)
+ (if (or (eq c sokoban-player)
+ (eq c sokoban-player-on-target))
(setq sokoban-x x
sokoban-y y))
- (if (= c sokoban-player-on-target)
- (setq sokoban-x x
- sokoban-y y
- c sokoban-player))
- (if (= c sokoban-block-on-target)
- (setq c sokoban-block))
(gamegrid-set-cell x y c)))))
(defun sokoban-draw-score ()
@@ -554,6 +652,30 @@
(incf sokoban-pushes)
(sokoban-draw-score))
+(defun sokoban-targetp (x y)
+ (let ((c (aref (aref sokoban-level-map y) x)))
+ (or (eq c sokoban-target)
+ (eq c sokoban-block-on-target)
+ (eq c sokoban-player-on-target))))
+
+(defun sokoban-set-floor (x y)
+ (gamegrid-set-cell x y
+ (if (sokoban-targetp x y)
+ sokoban-target
+ sokoban-floor)))
+
+(defun sokoban-set-player (x y)
+ (gamegrid-set-cell x y
+ (if (sokoban-targetp x y)
+ sokoban-player-on-target
+ sokoban-player)))
+
+(defun sokoban-set-block (x y)
+ (gamegrid-set-cell x y
+ (if (sokoban-targetp x y)
+ sokoban-block-on-target
+ sokoban-block)))
+
(defun sokoban-undo ()
"Undo previous Sokoban change."
(interactive)
@@ -566,26 +688,23 @@
(dy (nth 2 entry)))
(cond ((eq type 'push)
(let* ((x (+ sokoban-x dx))
- (y (+ sokoban-y dy))
- (c (sokoban-get-floor x y)))
- (gamegrid-set-cell x y c)
- (if (eq c sokoban-target)
+ (y (+ sokoban-y dy)))
+ (sokoban-set-floor x y)
+ (if (sokoban-targetp x y)
(decf sokoban-done))
- (gamegrid-set-cell sokoban-x sokoban-y sokoban-block)
- (setq c (sokoban-get-floor sokoban-x sokoban-y))
- (if (eq c sokoban-target)
+ (sokoban-set-block sokoban-x sokoban-y)
+ (if (sokoban-targetp sokoban-x sokoban-y)
(incf sokoban-done)))
(setq sokoban-x (- sokoban-x dx))
(setq sokoban-y (- sokoban-y dy))
- (gamegrid-set-cell sokoban-x sokoban-y sokoban-player)
+ (sokoban-set-player sokoban-x sokoban-y)
(decf sokoban-pushes)
(decf sokoban-moves))
((eq type 'move)
- (let ((c (sokoban-get-floor sokoban-x sokoban-y)))
- (gamegrid-set-cell sokoban-x sokoban-y c))
+ (sokoban-set-floor sokoban-x sokoban-y)
(setq sokoban-x (- sokoban-x dx))
(setq sokoban-y (- sokoban-y dy))
- (gamegrid-set-cell sokoban-x sokoban-y sokoban-player)
+ (sokoban-set-player sokoban-x sokoban-y)
(decf sokoban-moves))
(t
(message "Invalid entry in sokoban-undo-list")))
@@ -597,33 +716,26 @@
(c (gamegrid-get-cell x y)))
(cond ((or (eq c sokoban-floor)
(eq c sokoban-target))
- (gamegrid-set-cell sokoban-x
- sokoban-y
- (sokoban-get-floor sokoban-x
- sokoban-y))
+ (sokoban-set-floor sokoban-x sokoban-y)
(setq sokoban-x x
sokoban-y y)
- (gamegrid-set-cell sokoban-x
- sokoban-y
- sokoban-player)
+ (sokoban-set-player sokoban-x sokoban-y)
(sokoban-add-move dx dy))
- ((eq c sokoban-block)
+ ((or (eq c sokoban-block)
+ (eq c sokoban-block-on-target))
(let* ((xx (+ x dx))
(yy (+ y dy))
(cc (gamegrid-get-cell xx yy)))
(cond ((or (eq cc sokoban-floor)
(eq cc sokoban-target))
- (if (eq (sokoban-get-floor x y) sokoban-target)
+ (if (sokoban-targetp x y)
(decf sokoban-done))
- (gamegrid-set-cell xx yy sokoban-block)
- (gamegrid-set-cell x y sokoban-player)
- (gamegrid-set-cell sokoban-x
- sokoban-y
- (sokoban-get-floor sokoban-x
- sokoban-y))
+ (sokoban-set-block xx yy)
+ (sokoban-set-player x y)
+ (sokoban-set-floor sokoban-x sokoban-y)
(setq sokoban-x x
sokoban-y y)
- (if (eq (sokoban-get-floor xx yy) sokoban-target)
+ (if (sokoban-targetp xx yy)
(incf sokoban-done))
(sokoban-add-push dx dy)
(cond ((= sokoban-done sokoban-targets)
[-- Attachment #3: Type: text/plain, Size: 118 bytes --]
--
Dieter Deyke
mailto:dieter.deyke@gmail.com
Get my Gnupg key:
gpg --keyserver keys.gnupg.net --recv-keys B116EA20
next reply other threads:[~2017-07-09 13:36 UTC|newest]
Thread overview: 20+ messages / expand[flat|nested] mbox.gz Atom feed top
2017-07-09 13:36 Dieter Deyke [this message]
2017-07-09 14:15 ` [PATCH] elpa/packages/sokoban/sokoban.el Eli Zaretskii
2017-07-09 14:34 ` Dieter Deyke
2017-07-09 14:52 ` Eli Zaretskii
2017-07-11 15:17 ` Stefan Monnier
-- strict thread matches above, loose matches on Subject: below --
2017-07-16 14:14 Dieter Deyke
2017-07-16 16:01 ` Stefan Monnier
2017-07-16 16:57 ` Dieter Deyke
2017-07-25 11:36 Dieter Deyke
2017-07-25 14:24 ` Stefan Monnier
2019-02-07 10:51 Dieter Deyke
2019-02-07 12:53 ` Clément Pit-Claudel
2019-02-07 14:42 ` Eli Zaretskii
2019-02-07 15:57 ` Dieter Deyke
2019-02-07 16:08 ` Clément Pit-Claudel
2019-02-07 16:11 ` Dieter Deyke
2019-02-07 16:55 ` Andreas Schwab
2019-02-08 3:34 ` Stefan Monnier
2019-02-07 14:56 ` Stefan Monnier
2019-02-12 12:30 Dieter Deyke
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87bmotlokk.fsf@deyke2 \
--to=dieter.deyke@gmail.com \
--cc=emacs-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.