;;;-*- Mode: Lisp; Package: blaarnog -*-
(defpackage blaarnog)
(in-package :blaarnog)
(export '(save-chris))
#|
After you load this file, in order
To use the code in this package, you must first be in
the blaarnog package, to do this, type:

(in-package :blaarnog)

Then call the save-chris function below with *maze1* and
then again with *maze2* as arguments.
|#

(defun save-chris (maze)
  (setq *maze-array* (make-array (list (length maze) (length (car maze)))
                                 :initial-contents maze))
  (cl-user::graphsearch (make-state :posx 1 :posy 1 :length 0) 
                        #'expand #'goalp #'lessp #'result))

(defvar *maze1*
  '((1 1 1 1 1 1 1 1 1 1)
    (1 0 1 0 0 0 1 0 0 1)
    (1 0 1 0 1 0 1 0 1 1)
    (1 0 0 0 1 0 1 0 1 1)
    (1 1 1 0 1 0 0 0 0 1)
    (1 0 0 0 1 1 1 1 0 1)
    (1 0 1 0 0 0 0 0 0 1)
    (1 0 1 1 1 1 0 1 0 1)
    (1 0 0 0 0 0 0 1 0 1)
    (1 1 1 1 1 1 1 1 1 1)))

(defvar *maze2*
  '((1 1 1 1 1 1 1 1 1 1)
    (1 0 0 0 1 0 0 0 1 1)
    (1 0 1 0 0 0 1 0 1 1)
    (1 0 0 0 1 0 0 0 1 1)
    (1 0 1 0 0 0 1 0 1 1)
    (1 0 0 0 1 0 0 0 1 1)
    (1 0 1 0 0 0 1 0 1 1)
    (1 0 0 0 1 0 0 0 0 1)
    (1 1 1 1 1 1 1 1 0 1)
    (1 1 1 1 1 1 1 1 1 1)))

(defvar *maze-array* nil)

(defstruct (state) parent posx posy length move)

(defvar *goal-state* (make-state :posx 8 :posy 8))

(defun expand (state lessp-fn)
  ;; Note that no sort is necessary here since the lessp function for this
  ;; domain sorts by path length, and all the children of a single state
  ;; will have the same path length.
  (declare (ignore lessp-fn))
  (format t "(~a,~a:~a) " (state-posx state) (state-posy state) (state-length state))
  (loop with parent = (state-parent state)
        with length = (1+ (state-length state))
        for dir in '(up down left right)
        for x = (+ (state-posx state)
                   (case dir (up -1) (down 1) (t 0)))
        for y = (+ (state-posy state)
                   (case dir (left -1) (right 1) (t 0)))
        when (and (zerop (aref *maze-array* x y))  ;; when there is an opening
                  (not (AND parent                 ;; and we aren't going backward 
                            (= x (state-posx parent))
                            (= y (state-posy parent)))))
        collect (make-state :parent state :posx x :posy y :length length :move dir)))
  
(defun goalp (state)
  (and (= (state-posx state) (state-posx *goal-state*))
       (= (state-posy state) (state-posy *goal-state*))))

(defun lessp (state1 state2)
  (< (state-length state1) (state-length state2)))

(defun result (state)
  (cond ((state-parent state)
         (result (state-parent state))
         (format t "~a: (~a,~a)~%" (state-move state) (state-posx state) (state-posy state)))
        ((format t "~%~%Begin:~%"))))