From: Dieter Deyke <dieter.deyke@gmail.com>
To: emacs-devel@gnu.org
Subject: [PATCH] elpa/packages/sokoban/sokoban.el
Date: Tue, 25 Jul 2017 13:36:10 +0200 [thread overview]
Message-ID: <87tw20hhp1.fsf@deyke2> (raw)
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
next reply other threads:[~2017-07-25 11:36 UTC|newest]
Thread overview: 20+ messages / expand[flat|nested] mbox.gz Atom feed top
2017-07-25 11:36 Dieter Deyke [this message]
2017-07-25 14:24 ` [PATCH] elpa/packages/sokoban/sokoban.el Stefan Monnier
-- 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-16 14:14 Dieter Deyke
2017-07-16 16:01 ` Stefan Monnier
2017-07-16 16:57 ` Dieter Deyke
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
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
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87tw20hhp1.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 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).