unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* [PATCH] elpa/packages/sokoban/sokoban.el
@ 2017-07-16 14:14 Dieter Deyke
  2017-07-16 16:01 ` Stefan Monnier
  0 siblings, 1 reply; 20+ messages in thread
From: Dieter Deyke @ 2017-07-16 14:14 UTC (permalink / raw)
  To: emacs-devel

Determine sokoban-width and sokoban-height dynamically

This avoids hard-coding sokoban-width and sokoban-height by scanning the
level file and finding the correct values dynamically.

diff --git a/sokoban.el b/sokoban.el
index 3ac1b6e..d29b134 100644
--- a/sokoban.el
+++ b/sokoban.el
@@ -4,7 +4,7 @@
 
 ;; Author: Glynn Clements <glynn.clements@xemacs.org>
 ;; Maintainer: Dieter Deyke <dieter.deyke@gmail.com>
-;; Version: 1.4.2
+;; Version: 1.4.3
 ;; Created: 1997-09-11
 ;; Keywords: games
 ;; Package-Type: multi
@@ -71,8 +71,6 @@
 
 (defvar sokoban-buffer-name "*Sokoban*")
 
-(defvar sokoban-temp-buffer-name " Sokoban-tmp")
-
 (defvar sokoban-level-file
   (if (fboundp 'locate-data-file)
       (locate-data-file "sokoban.levels")
@@ -84,14 +82,14 @@
               (and (file-exists-p file) file))
 	(expand-file-name "sokoban.levels" data-directory))))
 
-(defvar sokoban-width 27)
-(defvar sokoban-height 20)
+(defvar sokoban-width)
+(defvar sokoban-height)
 
-(defvar sokoban-buffer-width sokoban-width)
-(defvar sokoban-buffer-height (+ 4 sokoban-height))
+(defvar sokoban-buffer-width)
+(defvar sokoban-buffer-height)
 
-(defvar sokoban-score-x 0)
-(defvar sokoban-score-y (1+ sokoban-height))
+(defvar sokoban-score-x)
+(defvar sokoban-score-y)
 
 (defvar sokoban-level-data nil)
 
@@ -542,6 +540,28 @@ static char * player_on_target_xpm[] = {
     (if (fboundp 'read-only-mode)
         (read-only-mode 1)
       (setq buffer-read-only t))
+
+    (setq sokoban-width 1
+          sokoban-height 1)
+    (goto-char (point-min))
+    (re-search-forward sokoban-level-regexp nil t)
+    (forward-char)
+    (let (r)
+      (while (not (eobp))
+        (while (looking-at sokoban-comment-regexp)
+	  (forward-line))
+        (setq r 0)
+        (while (not (or (eobp)
+		        (looking-at sokoban-comment-regexp)))
+          (incf r)
+          (setq sokoban-height (max sokoban-height r)
+                sokoban-width (max sokoban-width (- (line-end-position) (line-beginning-position))))
+	  (forward-line))))
+    (setq sokoban-buffer-width sokoban-width
+          sokoban-buffer-height (+ 4 sokoban-height)
+          sokoban-score-x 0
+          sokoban-score-y (1+ sokoban-height))
+
     (goto-char (point-min))
     (re-search-forward sokoban-level-regexp nil t)
     (forward-char)
@@ -823,8 +843,7 @@ static char * player_on_target_xpm[] = {
   (sokoban-draw-score))
 
 (defun sokoban-next-level ()
-  (incf sokoban-level)
-  (sokoban-restart-level))
+  (sokoban-goto-level (1+ sokoban-level)))
 
 (defun sokoban-goto-level (level)
   "Jump to a specified LEVEL."
@@ -915,4 +934,3 @@ sokoban-mode keybindings:
 (provide 'sokoban)
 
 ;;; sokoban.el ends here
-

-- 
Dieter Deyke
mailto:dieter.deyke@gmail.com
Get my Gnupg key:
gpg --keyserver keys.gnupg.net --recv-keys B116EA20




^ permalink raw reply related	[flat|nested] 20+ messages in thread
* [PATCH] elpa/packages/sokoban/sokoban.el
@ 2019-02-12 12:30 Dieter Deyke
  0 siblings, 0 replies; 20+ messages in thread
From: Dieter Deyke @ 2019-02-12 12:30 UTC (permalink / raw)
  To: emacs-devel


OK to commit this?

===== Commit message: =====

* sokoban/sokoban.el: Add save/load capability

===== Patch: =====

diff --git a/sokoban.el b/sokoban.el
index 57aab47..128d59a 100644
--- a/sokoban.el
+++ b/sokoban.el
@@ -4,7 +4,7 @@

 ;; Author: Glynn Clements <glynn.clements@xemacs.org>
 ;; Maintainer: Dieter Deyke <dieter.deyke@gmail.com>
-;; Version: 1.4.7
+;; Version: 1.4.8
 ;; Comment: While we set lexical-binding, it currently doesn't make use
 ;;          of closures, which is why it can still work in Emacs-23.1.
 ;; Package-Requires: ((emacs "23.1") (cl-lib "0.5"))
@@ -509,6 +509,8 @@ static char * player_on_target_xpm[] = {
     (define-key map "r"	'sokoban-restart-level)
     (define-key map "g"	'sokoban-goto-level)
     (define-key map "F"	'fit-frame-to-buffer)
+    (define-key map "s"	'sokoban-save)
+    (define-key map "l"	'sokoban-load)

     (define-key map [left]	'sokoban-move-left)
     (define-key map [right]	'sokoban-move-right)
@@ -868,12 +870,58 @@ static char * player_on_target_xpm[] = {
   (setq sokoban-level 0)
   (sokoban-next-level))

+(defvar sokoban-grid-state)
+
+(defconst sokoban-state-variables '(
+                                    sokoban-level
+                                    sokoban-level-map
+                                    sokoban-targets
+                                    sokoban-x
+                                    sokoban-y
+                                    sokoban-moves
+                                    sokoban-pushes
+                                    sokoban-done
+                                    sokoban-undo-list
+                                    sokoban-grid-state
+                                    ))
+(defun sokoban-save (filename)
+  "Save current Sokoban state."
+  (interactive "FSave file: ")
+  (let ((buf (current-buffer)))
+    (setq sokoban-grid-state nil)
+    (dotimes (y sokoban-height)
+      (dotimes (x sokoban-width)
+        (push (gamegrid-get-cell x y) sokoban-grid-state)))
+    (setq sokoban-grid-state (reverse sokoban-grid-state))
+    (with-temp-file filename
+      (dolist (var sokoban-state-variables)
+        (print
+         (with-current-buffer buf (eval var))
+         (current-buffer))))))
+
+(defun sokoban-load (filename)
+  "Restore saved Sokoban state."
+  (interactive "fLoad file: ")
+  (let ((buf (current-buffer)))
+    (with-temp-buffer
+      (insert-file-contents filename)
+      (goto-char (point-min))
+      (dolist (var sokoban-state-variables)
+        (let ((value (read (current-buffer))))
+          (with-current-buffer buf (set var value))))))
+  (dotimes (y sokoban-height)
+    (dotimes (x sokoban-width)
+      (gamegrid-set-cell x y (pop sokoban-grid-state))))
+  (sokoban-draw-score))
+
 (easy-menu-define sokoban-popup-menu nil "Popup menu for Sokoban mode."
   '("Sokoban Commands"
     ["Restart this level" sokoban-restart-level]
     ["Start new game" sokoban-start-game]
     ["Go to specific level" sokoban-goto-level]
-    ["Fit frame to buffer" fit-frame-to-buffer]))
+    ["Fit frame to buffer" fit-frame-to-buffer]
+    ["Save current state" sokoban-save]
+    ["Restore saved state" sokoban-load]))
 (define-key sokoban-mode-map [down-mouse-3] sokoban-popup-menu)

 (define-derived-mode sokoban-mode special-mode "Sokoban"
@@ -903,6 +951,8 @@ sokoban-mode keybindings:
 \\[sokoban-restart-level]	Restarts the current level
 \\[sokoban-goto-level]	Jumps to a specified level
 \\[fit-frame-to-buffer]	Fit frame to buffer
+\\[sokoban-save]	Save current state
+\\[sokoban-load]	Restore saved state
 \\[sokoban-move-left]	Move one square to the left
 \\[sokoban-move-right]	Move one square to the right
 \\[sokoban-move-up]	Move one square up

--
Dieter Deyke
mailto:dieter.deyke@gmail.com
Get my Gnupg key:
gpg --keyserver keys.gnupg.net --recv-keys B116EA20




^ permalink raw reply related	[flat|nested] 20+ messages in thread
* [PATCH] elpa/packages/sokoban/sokoban.el
@ 2019-02-07 10:51 Dieter Deyke
  2019-02-07 12:53 ` Clément Pit-Claudel
  2019-02-07 14:56 ` Stefan Monnier
  0 siblings, 2 replies; 20+ messages in thread
From: Dieter Deyke @ 2019-02-07 10:51 UTC (permalink / raw)
  To: emacs-devel

===== Commit message: =====

* sokoban.el: Switch to lexical-binding

Switch to lexical-binding

Unrelated additional changes:

- Do not make variables buffer-local for easier debugging

===== Patch: =====

diff --git a/sokoban.el b/sokoban.el
index 4698450..f4a3369 100644
--- a/sokoban.el
+++ b/sokoban.el
@@ -1,10 +1,10 @@
-;;; sokoban.el --- Implementation of Sokoban for Emacs.
+;;; sokoban.el --- Implementation of Sokoban for Emacs. -*- lexical-binding: t -*-
 
-;; Copyright (C) 1998, 2013, 2017 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2013, 2017, 2019 Free Software Foundation, Inc.
 
 ;; Author: Glynn Clements <glynn.clements@xemacs.org>
 ;; Maintainer: Dieter Deyke <dieter.deyke@gmail.com>
-;; Version: 1.4.6
+;; Version: 1.4.7
 ;; Package-Requires: ((emacs "23.1"))
 ;; Created: 1997-09-11
 ;; Keywords: games
@@ -82,18 +82,7 @@
               (and (file-exists-p file) file))
 	(expand-file-name "sokoban.levels" data-directory))))
 
-(defvar sokoban-width)
-(defvar sokoban-height)
-
-(defvar sokoban-buffer-width)
-(defvar sokoban-buffer-height)
-
-(defvar sokoban-score-x)
-(defvar sokoban-score-y)
-
-(defvar sokoban-level-data nil)
-
-(defconst sokoban-state-filename (locate-user-emacs-file "sokoban-state"))
+(defvar sokoban-state-filename (locate-user-emacs-file "sokoban-state"))
 
 ;; ;;;;;;;;;;;;; constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -477,28 +466,24 @@ static char * player_on_target_xpm[] = {
 
 ;; ;;;;;;;;;;;;; variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(defvar sokoban-width)
+(defvar sokoban-height)
+(defvar sokoban-buffer-width)
+(defvar sokoban-buffer-height)
+(defvar sokoban-score-x)
+(defvar sokoban-score-y)
+(defvar sokoban-level-data nil)
 (defvar sokoban-level 0)
-(make-variable-buffer-local 'sokoban-level)
 (defvar sokoban-level-map nil)
-(make-variable-buffer-local 'sokoban-level-map)
 (defvar sokoban-targets 0)
-(make-variable-buffer-local 'sokoban-targets)
 (defvar sokoban-x 0)
-(make-variable-buffer-local 'sokoban-x)
 (defvar sokoban-y 0)
-(make-variable-buffer-local 'sokoban-y)
 (defvar sokoban-moves 0)
-(make-variable-buffer-local 'sokoban-moves)
 (defvar sokoban-pushes 0)
-(make-variable-buffer-local 'sokoban-pushes)
 (defvar sokoban-done 0)
-(make-variable-buffer-local 'sokoban-done)
 (defvar sokoban-mouse-x 0)
-(make-variable-buffer-local 'sokoban-mouse-x)
 (defvar sokoban-mouse-y 0)
-(make-variable-buffer-local 'sokoban-mouse-y)
 (defvar sokoban-undo-list nil)
-(make-variable-buffer-local 'sokoban-undo-list)
 
 ;; ;;;;;;;;;;;;; keymaps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -650,7 +635,7 @@ static char * player_on_target_xpm[] = {
   (let ((y sokoban-score-y))
     (dolist (string (list (format "Moves:  %05d" sokoban-moves)
 			  (format "Pushes: %05d" sokoban-pushes)
-			  (format "Done:   %d/%d"
+			  (format "Done:   %d/%d "
 				  sokoban-done
 				  sokoban-targets)))
       (let* ((len (length string)))
@@ -762,9 +747,8 @@ static char * player_on_target_xpm[] = {
 			(incf sokoban-done))
 		    (sokoban-add-push dx dy)
 		    (cond ((= sokoban-done sokoban-targets)
-                           (let ((level sokoban-level))
-                             (with-temp-file sokoban-state-filename
-                               (print level (current-buffer))))
+                           (with-temp-file sokoban-state-filename
+                             (print sokoban-level (current-buffer)))
 			   (sit-for 3)
 			   (sokoban-next-level))))))))))
 

-- 
Dieter Deyke
mailto:dieter.deyke@gmail.com
Get my Gnupg key:
gpg --keyserver keys.gnupg.net --recv-keys B116EA20




^ permalink raw reply related	[flat|nested] 20+ messages in thread
* [PATCH] elpa/packages/sokoban/sokoban.el
@ 2017-07-25 11:36 Dieter Deyke
  2017-07-25 14:24 ` Stefan Monnier
  0 siblings, 1 reply; 20+ messages in thread
From: Dieter Deyke @ 2017-07-25 11:36 UTC (permalink / raw)
  To: emacs-devel

Commit message:

* sokoban.el: Add support for level data in xml format

Add support for level data in xml format as found on
http://www.sourcecode.se/sokoban/levels

Unrelated additional changes:

- add key binding 'F' to fit frame to buffer

- show the number of levels available in level file

Patch:

diff --git a/sokoban.el b/sokoban.el
index 2ebe7b4..0908209 100644
--- a/sokoban.el
+++ b/sokoban.el
@@ -4,7 +4,7 @@

 ;; Author: Glynn Clements <glynn.clements@xemacs.org>
 ;; Maintainer: Dieter Deyke <dieter.deyke@gmail.com>
-;; Version: 1.4.4
+;; Version: 1.4.5
 ;; Created: 1997-09-11
 ;; Keywords: games
 ;; Package-Type: multi
@@ -57,6 +57,7 @@
   (require 'cl))

 (require 'gamegrid)
+(require 'xml)

 ;; ;;;;;;;;;;;;; customization variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

@@ -508,6 +509,7 @@ static char * player_on_target_xpm[] = {
     (define-key map "n"	'sokoban-start-game)
     (define-key map "r"	'sokoban-restart-level)
     (define-key map "g"	'sokoban-goto-level)
+    (define-key map "F"	'fit-frame-to-buffer)

     (define-key map [left]	'sokoban-move-left)
     (define-key map [right]	'sokoban-move-right)
@@ -536,11 +538,20 @@ static char * player_on_target_xpm[] = {

 (defun sokoban-init-level-data ()
   (setq sokoban-level-data nil)
-  (with-current-buffer (find-file-noselect sokoban-level-file)
-    (if (fboundp 'read-only-mode)
-        (read-only-mode 1)
-      (setq buffer-read-only t))
-
+  (with-temp-buffer
+    (insert-file-contents sokoban-level-file)
+    (goto-char (point-min))
+    (if (looking-at "<\\?xml version=")
+        (let ((n 0) (tree (xml-parse-region)))
+          (erase-buffer)
+          (dolist (SokobanLevels tree)
+            (dolist (LevelCollection (xml-get-children SokobanLevels 'LevelCollection))
+              (dolist (Level (xml-get-children LevelCollection 'Level))
+                (incf n)
+                (insert (format ";LEVEL %d\n" n))
+                (dolist (L (xml-get-children Level 'L))
+                  (insert (car (xml-node-children L)))
+                  (insert "\n")))))))
     (setq sokoban-width 15 ; need at least 15 for score display
           sokoban-height 1)
     (goto-char (point-min))
@@ -567,21 +578,21 @@ static char * player_on_target_xpm[] = {
     (forward-char)
     (while (not (eobp))
       (while (looking-at sokoban-comment-regexp)
-	(forward-line))
+        (forward-line))
       (let ((data (make-vector sokoban-height nil))
 	    (fmt (format "%%-%ds" sokoban-width)))
-	(dotimes (y sokoban-height)
+        (dotimes (y sokoban-height)
 	  (cond ((or (eobp)
 		     (looking-at sokoban-comment-regexp))
-		 (aset data y (format fmt "")))
-		(t
-		 (let ((start (point))
+	         (aset data y (format fmt "")))
+	        (t
+	         (let ((start (point))
                        (end (line-end-position)))
                    (aset data
                          y
                          (format fmt (buffer-substring start end)))
                    (goto-char (1+ end))))))
-	(push data sokoban-level-data)))
+        (push data sokoban-level-data)))
     (kill-buffer (current-buffer))
     (setq sokoban-level-data (nreverse sokoban-level-data))))

@@ -651,8 +662,8 @@ static char * player_on_target_xpm[] = {
 			     y (aref string x))))
       (incf y)))
   (setq mode-line-format
-	(format "Sokoban:   Level: %3d   Moves: %05d   Pushes: %05d   Done: %d/%d"
-		sokoban-level sokoban-moves sokoban-pushes
+	(format "Sokoban:   Level: %d/%d   Moves: %05d   Pushes: %05d   Done: %d/%d"
+		sokoban-level (length sokoban-level-data) sokoban-moves sokoban-pushes
 		sokoban-done sokoban-targets))
   (force-mode-line-update))

@@ -870,7 +881,8 @@ static char * player_on_target_xpm[] = {
     '("Sokoban Commands"
       ["Restart this level" sokoban-restart-level]
       ["Start new game" sokoban-start-game]
-      ["Go to specific level" sokoban-goto-level]))
+      ["Go to specific level" sokoban-goto-level]
+      ["Fit frame to buffer" fit-frame-to-buffer]))
   (define-key sokoban-mode-map [down-mouse-3] sokoban-popup-menu))

 (define-derived-mode sokoban-mode special-mode "Sokoban"
@@ -884,8 +896,8 @@ sokoban-mode keybindings:
           '("Sokoban Commands"
             ["Restart this level" sokoban-restart-level]
             ["Start new game" sokoban-start-game]
-            ["Go to specific level" sokoban-goto-level])))
-
+            ["Go to specific level" sokoban-goto-level]
+            ["Fit frame to buffer" fit-frame-to-buffer])))
   (set (make-local-variable 'gamegrid-use-glyphs) sokoban-use-glyphs)
   (set (make-local-variable 'gamegrid-use-color) sokoban-use-color)
   (set (make-local-variable 'gamegrid-font) sokoban-font)

-- 
Dieter Deyke
mailto:dieter.deyke@gmail.com
Get my Gnupg key:
gpg --keyserver keys.gnupg.net --recv-keys B116EA20




^ permalink raw reply related	[flat|nested] 20+ messages in thread
* [PATCH] elpa/packages/sokoban/sokoban.el
@ 2017-07-09 13:36 Dieter Deyke
  2017-07-09 14:15 ` Eli Zaretskii
  0 siblings, 1 reply; 20+ messages in thread
From: Dieter Deyke @ 2017-07-09 13:36 UTC (permalink / raw)
  To: emacs-devel

[-- 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

^ permalink raw reply	[flat|nested] 20+ messages in thread
end of thread, other threads:[~2019-02-12 12:30 UTC | newest]

Thread overview: 20+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2017-07-16 14:14 [PATCH] elpa/packages/sokoban/sokoban.el Dieter Deyke
2017-07-16 16:01 ` Stefan Monnier
2017-07-16 16:57   ` Dieter Deyke
  -- strict thread matches above, loose matches on Subject: below --
2019-02-12 12:30 Dieter Deyke
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
2017-07-25 11:36 Dieter Deyke
2017-07-25 14:24 ` Stefan Monnier
2017-07-09 13:36 Dieter Deyke
2017-07-09 14:15 ` Eli Zaretskii
2017-07-09 14:34   ` Dieter Deyke
2017-07-09 14:52     ` Eli Zaretskii
2017-07-11 15:17       ` Stefan Monnier

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).