;;; To play the puzzle use command below.  Requires a file named 8puz.dat
; that looks like 
;(8 4 5 3 b 7 2 1 6)
; without the semicolon on the line.  Try different starting configurations,
; which are given by the line in the file 8puz.dat as shown above. A second
; example is:
; (3 8 b 7 2 1 5 4 6)
; To run type the command below. Good luck.
; (play (node-puzzle (read-init)))
; The goal state is:
;  1 | 2 | 3
;  8 |   | 4
;  7 | 6 | 5
; Note in the above b=blank= 
; Or for some assignments it is.
;  1 | 2 | 3
;  4 | 5 | 6
;  7 | 8 |  

; Created by Larry Hall 10/5/93.

(defvar *node-num* 0)

(defstruct node
  puzzle
  fvalue
  gvalue
  pointer
  blank-pos
  move)
 
(setq desired-position
  (make-array '(8) :initial-contents '((0 0) (0  1) (0 2) (1 2) 
                                       (2 2) (2 1) (2 0) (1 0))))

(defun read-init ()
 (with-open-file (*input-stream* "8puz.dat"
                 :direction :input)
   (setq x (read *input-stream*)))
 (let ((i 0)
       (j 0)
       (start-node (make-node)))
  (setf (node-puzzle start-node) (make-array '(3 3)) )
  (setf (node-move start-node) 'initial) ; how state obtained
  (dolist (el x start-node)
    (if (equal el 'b)
      (progn (setf (node-blank-pos start-node) (list i j))
             (setf (aref (node-puzzle start-node) i j) -1))  ; the blank notation.
        (setf (aref (node-puzzle start-node) i j) el))
      (setq j (+ j 1))
      (if (= j 3) (progn (setq j 0)   (setq i (+ i 1)))))
))


(defun play (puzzle)
  (do  ((i 0 (+ i 1))
       )
      ((= i 3) )
  (do ((j 0 (+ j 1)))
      ((= j 3))
  (if (<  (aref puzzle i j) 0)
   (setq blank-pos (list i j)))))
(loop
(print-puz puzzle) (terpri)

 (princ "Please enter a move (u,l,r,d or q for quit): ")
 (setq move (read))
 (cond ((equal move 'q) (return 'done))
       ((equal move 'u) (progn (setf (aref puzzle (car blank-pos)
                                           (cadr blank-pos))
                           (aref puzzle (-  (car blank-pos) 1) 
                                           (cadr blank-pos)))
                       (setf (aref puzzle (-  (car blank-pos) 1) 
                                           (cadr blank-pos)) -1)
                        (rplaca blank-pos (- (car blank-pos) 1))))
       ((equal move 'd) (progn (setf (aref puzzle (car blank-pos)
                                           (cadr blank-pos))
                           (aref puzzle (+ 1 (car blank-pos)) 
                                           (cadr blank-pos)))
                       (setf (aref puzzle (+  (car blank-pos) 1) 
                                           (cadr blank-pos)) -1)
                        (rplaca blank-pos (+ (car blank-pos) 1))))
       ((equal move 'l) (progn (setf (aref puzzle (car blank-pos)
                                           (cadr blank-pos))
                                   (aref puzzle (car blank-pos)
                                          (- (cadr blank-pos) 1)))
                               (setf (aref puzzle (car blank-pos)
                                          (- (cadr blank-pos) 1)) -1)
                        (rplaca (cdr blank-pos) (- (cadr blank-pos) 1))))
       ((equal move 'r) (progn (setf (aref puzzle (car blank-pos)
                                           (cadr blank-pos))
                                   (aref puzzle (car blank-pos)
                                          (+ (cadr blank-pos) 1)))
                               (setf (aref puzzle (car blank-pos)
                                          (+ (cadr blank-pos) 1)) -1)
                        (rplaca (cdr blank-pos) (+ (cadr blank-pos) 1))))
)))



(defun print-puz (n)
  (do  ((i 0 (+ i 1))
       )
      ((= i 3) )
(terpri)
  (do ((j 0 (+ j 1)))
      ((= j 3))
 (if (> (aref n i j) 0)
 (princ (aref n i j)) (princ " "))
 (princ "  "))))