Download
(provide 'eight-puzzle)
(eval-when-compile
(require 'cl))
(defvar eight-puzzle-goal "012345678" "The state to reach")
(defvar eight-puzzle-display " 12345678"
"String to display. You can set like \" abcdefgh\"")
(defvar eight-puzzle-use-image nil
"Use image or not")
(defvar eight-puzzle-pics-path
"~/.8puzzle/")
(defvar eight-puzzle-pics-name "x")
(defvar eight-puzzle-image-sets '("a" "x" "l")
"A set of pictures used to display")
(defvar eight-puzzle-offsets '[(0 . 1) (1 . 0) (0 . -1) (-1 . 0)]
"Directions to move")
(defvar eight-puzzle-state "012345678" "Current state")
(defvar eight-puzzle-buffer-name "*8-puzzle*")
(defvar eight-puzzle-mode-hook nil "Hook run before enter eight-puzzle-mode")
(defvar eight-puzzle-mode-map nil
"Local keymap for the eight puzzle game.")
(unless eight-puzzle-mode-map
(let ((map (make-sparse-keymap)))
(suppress-keymap map t)
(define-key map [left] 'eight-puzzle-left)
(define-key map [right] 'eight-puzzle-right)
(define-key map [up] 'eight-puzzle-up)
(define-key map [down] 'eight-puzzle-down)
(define-key map "h" 'eight-puzzle-left)
(define-key map "l" 'eight-puzzle-right)
(define-key map "k" 'eight-puzzle-up)
(define-key map "j" 'eight-puzzle-down)
(define-key map "r" 'eight-puzzle-restart)
(define-key map "q" 'eight-puzzle-quit)
(define-key map "s" 'eight-puzzle-show-state)
(define-key map "c" 'eight-puzzle-change-image)
(define-key map "t" 'eight-puzzle-toggle-image)
(setq eight-puzzle-mode-map map)))
(defun eight-puzzle-shuffle-string (str)
(let ((len (length str)))
(dotimes (pos len)
(eight-puzzle-swap-char str pos (random len)))
str))
(defun eight-puzzle-restart ()
(interactive)
(let ((even (eight-puzzle-evenp eight-puzzle-goal)))
(while (progn
(eight-puzzle-shuffle-string eight-puzzle-state)
(not (equal (eight-puzzle-evenp eight-puzzle-state)
even))))
(eight-puzzle-display-state)))
(defun eight-puzzle-evenp (str)
(let* ((count 0)
(pos (string-match "0" str))
(str (concat (substring str 0 pos)
(substring str (1+ pos))))
i j)
(dotimes (i 7)
(setq j (1+ i))
(while (< j 8)
(if (> (aref str i)
(aref str j))
(setq count (1+ count)))
(setq j (1+ j))))
(= (mod count 2) 0)))
(defun eight-puzzle-swap-char (str pos1 pos2)
(let (tmp)
(setq tmp (aref str pos1))
(aset str pos1 (aref str pos2))
(aset str pos2 tmp)
str))
(defun eight-puzzle-display-state ()
(let ((len (length eight-puzzle-state))
(pics (concat eight-puzzle-pics-path eight-puzzle-pics-name))
idx)
(setq buffer-read-only nil)
(erase-buffer)
(dotimes (pos len)
(setq idx (- (aref eight-puzzle-state pos) ?0))
(insert
(if eight-puzzle-use-image
(propertize (format "[%c]" (aref eight-puzzle-display idx))
'display `(image
:type png
:file ,(format "%s%d.png" pics idx)
:ascent center
:relief 1
:margin 1))
(format "[%c]" (aref eight-puzzle-display idx)))
(if (= (mod (+ pos 1) 3) 0)
"\n" "")))
(insert "\n")
(if eight-puzzle-use-image
(insert-image (create-image (concat pics ".png") 'png nil :relief 1)))
(setq buffer-read-only t)
(goto-char (point-min))
(re-search-forward (format "[%c]" (aref eight-puzzle-display 0)))
(goto-char
(if eight-puzzle-use-image
(1- (match-beginning 0))
(match-beginning 0)))))
(defun eight-puzzle-gap-pos ()
(let* ((pos (string-match "0" eight-puzzle-state))
(col (mod pos 3))
(row (/ pos 3)))
(cons row col)))
(defun eight-puzzle-index (pos)
(+ (* 3 (car pos)) (cdr pos)))
(defun eight-puzzle-check-pos (pos)
(and (and (> (car pos) -1)
(< (car pos) 3))
(and (> (cdr pos) -1)
(< (cdr pos) 3))))
(defun eight-puzzle-move (dir)
(let* ((gap-pos (eight-puzzle-gap-pos))
(new-pos (cons (+ (car gap-pos)
(car (aref eight-puzzle-offsets dir)))
(+ (cdr gap-pos)
(cdr (aref eight-puzzle-offsets dir))))))
(if (eight-puzzle-check-pos new-pos)
(progn
(eight-puzzle-swap-char eight-puzzle-state
(eight-puzzle-index gap-pos)
(eight-puzzle-index new-pos))
(eight-puzzle-display-state)
(if (eight-puzzle-goalp)
(if (y-or-n-p "You did it! Start again ")
(eight-puzzle-restart)
(eight-puzzle-quit)))))))
(defun eight-puzzle-left ()
(interactive)
(eight-puzzle-move 0))
(defun eight-puzzle-up ()
(interactive)
(eight-puzzle-move 1))
(defun eight-puzzle-right ()
(interactive)
(eight-puzzle-move 2))
(defun eight-puzzle-down ()
(interactive)
(eight-puzzle-move 3))
(defun eight-puzzle-goalp ()
(equal eight-puzzle-state eight-puzzle-goal))
(defun eight-puzzle-mode ()
" A mode for playing `eight-puzzle'
The key bindings for eight-puzzle-mode are:
\\{eight-puzzle-mode-map}
"
(kill-all-local-variables)
(use-local-map eight-puzzle-mode-map)
(setq major-mode 'eight-puzzle-mode
mode-name "8-puzzle")
(run-hooks 'eight-puzzle-mode-hook)
(setq buffer-read-only t
truncate-lines t)
(buffer-disable-undo (current-buffer)))
(defun eight-puzzle ()
"Move the num to position like this:
[ ][1][2]
[3][4][5]
[6][7][8]
"
(interactive)
(switch-to-buffer eight-puzzle-buffer-name)
(eight-puzzle-mode)
(eight-puzzle-restart))
(defun eight-puzzle-quit ()
(interactive)
(kill-buffer (current-buffer)))
(defun eight-puzzle-show-state ()
(interactive)
(message "%s\n%s" eight-puzzle-state
eight-puzzle-goal))
(defun eight-puzzle-toggle-image (&optional arg)
(interactive "P")
(or arg (setq arg 0))
(cond ((> arg 0)
(setq eight-puzzle-use-image t))
((< arg 0)
(setq eight-puzzle-use-image nil))
((= arg 0)
(setq eight-puzzle-use-image
(not eight-puzzle-use-image))))
(clear-image-cache)
(eight-puzzle-display-state))
(defun eight-puzzle-change-image (name)
(interactive
(list (completing-read
"name: "
eight-puzzle-image-sets)))
(setq eight-puzzle-pics-name name)
(clear-image-cache)
(eight-puzzle-display-state))