From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Matt Hodges Newsgroups: gmane.emacs.devel Subject: puzzle.el. Date: Sat, 17 Jul 2004 12:55:47 +0100 Sender: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Message-ID: <87llhizw3g.fsf@dugong.chemistry.nottingham.ac.uk> Reply-To: Matt Hodges NNTP-Posting-Host: deer.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: sea.gmane.org 1090065593 29763 80.91.224.253 (17 Jul 2004 11:59:53 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Sat, 17 Jul 2004 11:59:53 +0000 (UTC) Original-X-From: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Sat Jul 17 13:59:45 2004 Return-path: Original-Received: from quimby.gnus.org ([80.91.224.244]) by deer.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 1Blnqz-0007Cs-00 for ; Sat, 17 Jul 2004 13:59:45 +0200 Original-Received: from lists.gnu.org ([199.232.76.165]) by quimby.gnus.org with esmtp (Exim 3.35 #1 (Debian)) id 1Blnqy-0001zw-00 for ; Sat, 17 Jul 2004 13:59:44 +0200 Original-Received: from localhost ([127.0.0.1] helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.33) id 1BlntY-0001ZW-Js for emacs-devel@quimby.gnus.org; Sat, 17 Jul 2004 08:02:24 -0400 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.33) id 1Blnsh-0001KL-U3 for emacs-devel@gnu.org; Sat, 17 Jul 2004 08:01:32 -0400 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.33) id 1Blnsc-0001Ht-B6 for emacs-devel@gnu.org; Sat, 17 Jul 2004 08:01:29 -0400 Original-Received: from [199.232.76.173] (helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.33) id 1Blnsb-0001Hb-6u for emacs-devel@gnu.org; Sat, 17 Jul 2004 08:01:25 -0400 Original-Received: from [137.205.128.8] (helo=mail-relay-2.warwick.ac.uk) by monty-python.gnu.org with esmtp (Exim 4.34) id 1Blnpd-0003wr-7D for emacs-devel@gnu.org; Sat, 17 Jul 2004 07:58:21 -0400 Original-Received: from localhost (localhost [127.0.0.1]) by mail-relay-2.csv.warwick.ac.uk (8.12.11/8.12.9) with ESMTP id i6HBwJOV018755; Sat, 17 Jul 2004 12:58:19 +0100 (BST) Original-Received: from mail-relay-2.csv.warwick.ac.uk ([127.0.0.1]) by localhost (campion [127.0.0.1]) (amavisd-new, port 10024) with LMTP id 17327-77-3; Sat, 17 Jul 2004 12:58:18 +0100 (BST) Original-Received: from dugong.chemistry.nottingham.ac.uk (host-10-4-4-153.in-addr.warwickpiazza.net [10.4.4.153]) by mail-relay-2.csv.warwick.ac.uk (8.12.11/8.12.9) with ESMTP id i6HBu9fg018243; Sat, 17 Jul 2004 12:56:09 +0100 (BST) Original-Received: from matt by dugong.chemistry.nottingham.ac.uk with local (Exim 4.34) id 1BlnnA-0001os-1F; Sat, 17 Jul 2004 12:55:48 +0100 Original-To: emacs-devel@gnu.org X-Virus-Scanned: by amavisd-new at warwick.ac.uk X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Xref: main.gmane.org gmane.emacs.devel:25789 X-Report-Spam: http://spam.gmane.org/gmane.emacs.devel:25789 --=-=-= After playing around with insert-sliced-image, I wrote a slide puzzle program (see attached). If the number of image slices is too large, Emacs can crash in the redisplay code. Evaluating the following: (let ((puzzle-max-rows-columns 25) (puzzle-rows 25) (puzzle-columns 25)) (fset 'puzzle-randomize (lambda ())) (puzzle)) leads to a segmentation fault, and the following backtrace: #0 0x080aaa21 in display_line (it=0xbfffe490) at xdisp.c:14527 #1 0x080a5e48 in try_window (window=141168948, pos={charpos = -1073748848, bytepos = 1}) at xdisp.c:12219 #2 0x080a56c4 in redisplay_window (window=141168948, just_this_one_p=0) at xdisp.c:11861 #3 0x080a1833 in redisplay_window_0 (window=2761) at xdisp.c:10587 #4 0x08189a54 in internal_condition_case_1 (bfun=0x80a1800 , arg=141168948, handlers=138528965, hfun=0x80a17e0 ) at eval.c:1376 #5 0x080a17de in redisplay_windows (window=141168948) at xdisp.c:10566 #6 0x080a0949 in redisplay_internal (preserve_echo_area=0) at xdisp.c:10151 #7 0x0809f802 in redisplay () at xdisp.c:9385 #8 0x08129a65 in read_char (commandflag=1, nmaps=2, maps=0xbffff3ec, prev_event=138502161, used_mouse_menu=0xbffff428) at keyboard.c:2518 #9 0x08130553 in read_key_sequence (keybuf=0xbffff550, bufsize=30, prompt=138502161, dont_downcase_last=0, can_return_switch_frame=1, fix_current_buffer=1) at keyboard.c:8810 #10 0x08126593 in command_loop_1 () at keyboard.c:1512 #11 0x0818994e in internal_condition_case (bfun=0x81263d0 , handlers=138563089, hfun=0x8125e90 ) at eval.c:1335 #12 0x081261fe in command_loop_2 () at keyboard.c:1293 #13 0x0818948b in internal_catch (tag=2761, func=0x81261d0 , arg=138502161) at eval.c:1096 #14 0x081261a3 in command_loop () at keyboard.c:1272 #15 0x08125c14 in recursive_edit_1 () at keyboard.c:978 #16 0x08125d51 in Frecursive_edit () at keyboard.c:1039 #17 0x08124410 in main (argc=5, argv=0xbffffc04) at emacs.c:1687 In the code, I create a blank image with the following: (create-image "" 'xpm nil :width (/ width puzzle-columns) :height (/ height puzzle-rows)) which does what I want, but complains with: Cannot find image file `' which seems fair enough. Is there a better way to do this? On an unrelated note, I find the doc string for random to be confusing: With positive integer argument n, return random number in interval [0,n). Does this really mean between 0 and (n - 1)? The info documentation is clearer: If LIMIT is a positive integer, the value is chosen to be nonnegative and less than LIMIT. Thanks for any feedback on these issues. Matt --=-=-= Content-Type: application/emacs-lisp Content-Disposition: attachment; filename=puzzle.el Content-Description: slide puzzle. ;;; puzzle.el --- slide puzzle for Emacs ;;; Copyright (C) 2004 Matthew P. Hodges ;; Author: Matthew P. Hodges ;; Version: $Id: puzzle.el,v 1.1 2004/07/17 09:42:30 matt Exp $ ;; puzzle.el is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published ;; by the Free Software Foundation; either version 2, or (at your ;; option) any later version. ;; puzzle.el is distributed in the hope that it will be useful, but ;; WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;; General Public License for more details. ;;; Commentary: ;; ;; Slide puzzle for Emacs. Start with M-x puzzle RET. Press ? for ;; help. ;;; Code: (defgroup puzzle nil "Puzzle game for Emacs." :group 'games) ;; Customizable variables (defcustom puzzle-rows 4 "Number of puzzle rows." :group 'puzzle :type 'integer) (defcustom puzzle-columns 4 "Number of puzzle columns." :group 'puzzle :type 'integer) (defcustom puzzle-max-rows-columns 10 "Maximum number of puzzle rows and columns." :group 'puzzle :type 'integer) (defcustom puzzle-shuffle-factor 5 "Affects the degree to which the puzzle is shuffled. Multiplies `puzzle-rows' and `puzzle-columns'." :group 'puzzle :type 'integer) ;; Other variables (defvar puzzle-image-file (concat data-directory "splash.xpm") "File to use for puzzle.") (defvar puzzle-image-string nil "Propertized string holding puzzle image.") (defvar puzzle-image-width nil "Width of puzzle image (in pixels).") (defvar puzzle-image-height nil "Height of puzzle image (in pixels).") ;; Constants (defconst puzzle-image-slice-string "slice " "Arbitrary string used by `insert-sliced-image'.") ;; Faces ;; Faces (defface puzzle-blank-face '((((class color)) (:inherit default :inverse-video t))) "Face used for the blank puzzle piece. Useful if the `puzzle-image-file' image is transparent." :group 'puzzle) ;; Entry point ;;;###autoload (defun puzzle () "Puzzle game for Emacs." (interactive) (unless (buffer-live-p (get-buffer "*puzzle*")) (get-buffer-create "*puzzle*")) (set-buffer "*puzzle*") (puzzle-mode) (puzzle-restart) (set-window-buffer (selected-window) "*puzzle*")) ;; Commands (defun puzzle-restart () "Initialize puzzle buffer." (interactive) (unless (equal major-mode 'puzzle-mode) (error "Not in Puzzle buffer")) (let ((inhibit-read-only t)) (puzzle-check-status) (puzzle-insert-image) (puzzle-randomize) (set-buffer-modified-p nil))) (defun puzzle-move-piece () "Move piece at point." (interactive) (unless (equal major-mode 'puzzle-mode) (error "Not in Puzzle buffer")) (when (puzzle-move-valid-p) (puzzle-move-piece-internal) (when (puzzle-solved-p) (message "Puzzle solved!")))) (defun puzzle-mouse-move-piece (event) "Move piece selected by mouse EVENT." (interactive "e") (mouse-set-point event) (puzzle-move-piece)) (defun puzzle-random-move () "Do random move of puzzle piece." (interactive) (unless (equal major-mode 'puzzle-mode) (error "Not in Puzzle buffer")) (let (coords row column valid-posns) (setq coords (puzzle-point-to-coords (puzzle-blank-position))) (setq row (car coords) column (cdr coords)) (setq valid-posns (delete nil (mapcar (lambda (row-col) (setq row (car row-col) col (cdr row-col)) (puzzle-coords-to-point row col)) `((,row . ,(1- column)) ;; Left (,row . ,(1+ column)) ;; Right (,(1- row) . ,column) ;; Above (,(1+ row) . ,column) ;; Below )))) (goto-char (elt valid-posns (random (length valid-posns)))) (puzzle-move-piece-internal))) (defun puzzle-random-moves () "Perform continuous random moves until the puzzle is solved. This can take a very large number of moves even for a 3x3 puzzle." (interactive) (unless (equal major-mode 'puzzle-mode) (error "Not in Puzzle buffer")) (let ((moves 0)) (while (and (not (puzzle-solved-p)) (not (input-pending-p))) (puzzle-random-move) (setq moves (1+ moves)) (sit-for 0.05)) (if (puzzle-solved-p) (message "Puzzle solved after %d moves" moves) (discard-input) (message "Puzzle unsolved after %d moves" moves)))) (defun puzzle-quit () "Quit the Puzzle buffer." (interactive) (when (equal major-mode 'puzzle-mode) (quit-window t))) (defun puzzle-show-solution () "Temporarily show puzzle solution." (interactive) (cond ((puzzle-solved-p) (message "Puzzle solved!")) (t (let ((char (car (rassoc 'puzzle-show-solution puzzle-mode-map)))) (save-restriction (narrow-to-region (point-min) (point-min)) (momentary-string-display puzzle-image-string (point-min) char "Press key to continue.")) (discard-input))))) (defun puzzle-more-pieces () "Increase the number of puzzle rows and columns by one." (interactive) (when (< puzzle-rows puzzle-max-rows-columns) (setq puzzle-rows (1+ puzzle-rows) puzzle-columns (1+ puzzle-columns)) (puzzle-restart))) (defun puzzle-fewer-pieces () "Decrease the number of puzzle rows and columns by one." (interactive) (when (> puzzle-rows 2) (setq puzzle-rows (1- puzzle-rows) puzzle-columns (1- puzzle-columns)) (puzzle-restart))) (defun puzzle-change-image (filename) "Set FILENAME as new `puzzle-image-file'." (interactive "fNew image file: ") (setq puzzle-image-file filename) (puzzle-restart)) ;; Functions (defun puzzle-check-status () "Check required features and some puzzle variables." (cond ((featurep 'xemacs) (error "XEmacs not supported")) ((not (featurep 'image)) (error "Images not supported")) ((not (fboundp 'insert-sliced-image)) (error "Sliced images not supported")) ((and puzzle-image-file (not (image-type-available-p (image-type-from-file-header puzzle-image-file)))) (error "Unsupported image type for %s" puzzle-image-file))) (setq puzzle-rows (max puzzle-rows 2)) (setq puzzle-rows (min puzzle-rows puzzle-max-rows-columns)) (setq puzzle-columns (max puzzle-columns 2)) (setq puzzle-columns (min puzzle-columns puzzle-max-rows-columns))) (defun puzzle-insert-image () "Insert image from `puzzle-image-file'." (let ((inhibit-read-only t) (counter 0) (length (length puzzle-image-slice-string)) (image (create-image puzzle-image-file nil nil))) (erase-buffer) (insert-sliced-image image puzzle-image-slice-string nil puzzle-rows puzzle-columns) (goto-char (point-min)) (puzzle-insert-blank-image (car (image-size image t)) (cdr (image-size image t))) (setq puzzle-image-string (buffer-string)) (save-excursion (while (< counter (* puzzle-rows puzzle-columns)) (add-text-properties (point) (1+ (point)) `(puzzle-index ,counter)) (forward-char length) (and (eolp) (forward-char 1)) (setq counter (1+ counter)))))) (defun puzzle-insert-blank-image (width height) "Put blank image slice (WIDTH by HEIGHT pixels) at point." (let ((length (length puzzle-image-slice-string))) (save-excursion (insert-image (create-image "" 'xpm nil :width (/ width puzzle-columns) :height (/ height puzzle-rows)) puzzle-image-slice-string) (delete-char length))) (add-text-properties (point) (1+ (point)) '(puzzle-blank t face puzzle-blank-face))) (defun puzzle-blank-position () "Get the position of the blank puzzle piece." (let ((posn (next-single-char-property-change (point-min) 'puzzle-blank))) ;; If the blank square is at the beginning of the buffer, we will ;; have skipped past the start of the 'puzzle-blank property (when (= posn 2) (setq posn 1)) posn)) (defun puzzle-coords-to-point (row column) "Return the position in the Puzzle buffer for ROW and COLUMN. If ROW and COLUMN and not valid return nil." (let ((length (length puzzle-image-slice-string))) (if (or (< row 0) (> row (1- puzzle-rows)) (< column 0) (> column (1- puzzle-columns))) nil (+ (* row (1+ (* puzzle-columns length))) (* column length) 1)))) (defun puzzle-point-to-coords (posn) "Return the puzzle row and column at POSN." (let ((length (length puzzle-image-slice-string)) row column) (save-excursion (goto-char posn) (setq row (count-lines (point-min) (line-beginning-position)) column (/ (- posn (line-beginning-position)) length))) (cons row column))) (defun puzzle-randomize () "Randomize puzzle." (let ((steps (* puzzle-shuffle-factor puzzle-rows puzzle-columns)) (count 0)) (while (< count steps) (puzzle-random-move) (setq count (1+ count))))) (defun puzzle-move-piece-internal () "Move piece at point." (let ((length (length puzzle-image-slice-string)) (index (get-text-property (point) 'puzzle-index)) (blankp (get-text-property (point) 'puzzle-blank)) (blank-posn (puzzle-blank-position)) (inhibit-read-only t)) (when (and index (not blankp)) (transpose-regions (point) (+ (point) length) blank-posn (+ blank-posn length)) (set-window-start (selected-window) (point-min))))) (defun puzzle-move-valid-p () "Return t if we can move puzzle piece at point." (let* ((coords (puzzle-point-to-coords (point))) (row (car coords)) (column (cdr coords)) posn) (cond ((get-text-property (point) 'puzzle-blank) nil) ;; Left ((and (setq posn (puzzle-coords-to-point row (1- column))) (get-text-property posn 'puzzle-blank))) ;; Right ((and (setq posn (puzzle-coords-to-point row (1+ column))) (get-text-property posn 'puzzle-blank))) ;; Up ((and (setq posn (puzzle-coords-to-point (1- row) column)) (get-text-property posn 'puzzle-blank))) ;; Down ((and (setq posn (puzzle-coords-to-point (1+ row) column)) (get-text-property posn 'puzzle-blank)))))) (defun puzzle-solved-p () "Return t if the puzzle has been solved." (let ((solved t) this last) (save-excursion (goto-char (point-min)) (setq last (get-text-property (point) 'puzzle-index)) (forward-char 1) (catch 'not-solved (while (and (goto-char (next-single-char-property-change (point) 'puzzle-index)) (not (eobp))) (setq this (get-text-property (point) 'puzzle-index)) (if (< this last) (throw 'not-solved (setq solved nil)) (forward-char 1) (setq last this))))) solved)) ;; Mode settings (defvar puzzle-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "1") 'delete-other-windows) (define-key map (kbd "c") 'puzzle-change-image) (define-key map (kbd "q") 'puzzle-quit) (define-key map (kbd "r") 'puzzle-restart) (define-key map (kbd "m") 'puzzle-random-move) (define-key map (kbd "M") 'puzzle-random-moves) (define-key map (kbd "s") 'puzzle-show-solution) (define-key map (kbd "+") 'puzzle-more-pieces) (define-key map (kbd "-") 'puzzle-fewer-pieces) (define-key map (kbd "?") 'describe-mode) (define-key map (kbd "RET") 'puzzle-move-piece) (define-key map (kbd "") 'puzzle-mouse-move-piece) map) "Keymap for puzzle mode.") ;; Menus (defvar puzzle-menu nil "Menu to use for `puzzle-mode'.") (easy-menu-define puzzle-menu puzzle-mode-map "Puzzle Menu" '("Puzzle" "---" ["Move piece" puzzle-move-piece t] ["Random move" puzzle-random-move t] ["Random moves" puzzle-random-moves t] ["Show solution" puzzle-show-solution t] "---" ["Restart" puzzle-restart t] ["Change image" puzzle-change-image t] ["More pieces" puzzle-more-pieces t] ["Fewer pieces" puzzle-fewer-pieces t] "---" ["Quit" puzzle-quit t])) (defun puzzle-mode () "Major mode for controlling the *puzzle* buffer. \\{puzzle-mode-map}" (kill-all-local-variables) (use-local-map puzzle-mode-map) (setq major-mode 'puzzle-mode) (setq mode-name "Puzzle") (setq buffer-read-only t buffer-undo-list t truncate-lines t) (run-hooks 'puzzle-mode-hook)) (provide 'puzzle) (provide 'puzzle) ;;; puzzle.el ends here --=-=-= Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Disposition: inline _______________________________________________ Emacs-devel mailing list Emacs-devel@gnu.org http://lists.gnu.org/mailman/listinfo/emacs-devel --=-=-=--