From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Dieter Deyke Newsgroups: gmane.emacs.devel Subject: [PATCH] elpa/packages/sokoban/sokoban.el Date: Sun, 09 Jul 2017 15:36:27 +0200 Message-ID: <87bmotlokk.fsf@deyke2> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1499607447 11741 195.159.176.226 (9 Jul 2017 13:37:27 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Sun, 9 Jul 2017 13:37:27 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.0.50 (gnu/linux) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Sun Jul 09 15:37:23 2017 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dUCOn-0002it-Vk for ged-emacs-devel@m.gmane.org; Sun, 09 Jul 2017 15:37:22 +0200 Original-Received: from localhost ([::1]:36268 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dUCOt-0003Ux-AK for ged-emacs-devel@m.gmane.org; Sun, 09 Jul 2017 09:37:27 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:51691) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dUCOG-0003Ur-Lz for emacs-devel@gnu.org; Sun, 09 Jul 2017 09:36:50 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dUCOD-0000SM-4F for emacs-devel@gnu.org; Sun, 09 Jul 2017 09:36:48 -0400 Original-Received: from [195.159.176.226] (port=45337 helo=blaine.gmane.org) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1dUCOC-0000Rc-P4 for emacs-devel@gnu.org; Sun, 09 Jul 2017 09:36:45 -0400 Original-Received: from list by blaine.gmane.org with local (Exim 4.84_2) (envelope-from ) id 1dUCO5-0000Z8-JO for emacs-devel@gnu.org; Sun, 09 Jul 2017 15:36:37 +0200 X-Injected-Via-Gmane: http://gmane.org/ Original-Lines: 357 Original-X-Complaints-To: usenet@blaine.gmane.org Cancel-Lock: sha1:l4wmPYt3nK0GHd5QqwAqJnjeLBg= X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] [fuzzy] X-Received-From: 195.159.176.226 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:216363 Archived-At: --=-=-= Content-Type: text/plain 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? --=-=-= Content-Type: text/plain Content-Disposition: inline; filename=patch --- /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 ;; Maintainer: Dieter Deyke -;; 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) --=-=-= Content-Type: text/plain -- Dieter Deyke mailto:dieter.deyke@gmail.com Get my Gnupg key: gpg --keyserver keys.gnupg.net --recv-keys B116EA20 --=-=-=--