;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; MAZE

(define (make-empty-maze width height)
  (let ((vec (make-vector (* width height) 'empty)))
    (list 'maze width height vec)))
(define (get-height maze) (caddr maze))
(define (get-width maze) (cadr maze))
(define (get-vector maze) (cadddr maze))
(define (get-index x y maze) (+ x (* y (get-width maze))))
   ;; x and y should be between 0 and width-1, 0 height-1
(define (empty-cell? x y maze) 
  (eq? 'empty (vector-ref (get-vector maze) (get-index x y maze))))
(define (path-cell? x y maze) 
  (eq? 'path (vector-ref (get-vector maze) (get-index x y maze))))
(define (set-full-cell! x y maze)
  (vector-set! (get-vector maze) (get-index x y maze) 'full))
(define (set-empty-cell! x y maze)
  (vector-set! (get-vector maze) (get-index x y maze) 'empty))
(define (set-path-cell! x y maze)
  (vector-set! (get-vector maze) (get-index x y maze) 'path))

(define (display-maze maze)
  (let ((width (get-width maze)) (height (get-height maze)))
    (define (helper x y)
      (cond ((>= y height) (newline))
            ((>= x width) (newline) (helper 0 (+ 1 y)))
            (else (cond ((empty-cell? x y maze) (display " "))
                        ((path-cell? x y maze) (display "X"))
                        (else (display "o")))
                  (helper (+ 1 x) y))))
    (helper 0 0)))
(define (make-boundary! maze)
 (let ((width (get-width maze)) (height (get-height maze)))
   (define (make-horizontal! x)
     (if (< x width) (begin (set-full-cell! x 0 maze)
                            (set-full-cell! x (- height 1) maze)
                            (make-horizontal! (+ x 1)))))
   (define (make-vertical! y)
     (if (< y height) (begin (set-full-cell! 0 y maze)
                             (set-full-cell! (- width 1) y maze)
                             (make-vertical! (+ y 1)))))
   (make-horizontal! 0)
   (make-vertical! 0)))

(define (make-random-walls! n maze)
 (let ((width (get-width maze)) (height (get-height maze)))
  (define (helper k)
    (if (< k n) (begin
                  (set-full-cell! (random width) (random height) maze)
                  (helper (+ 1 k)))))
   (helper 0)))
(define (make-compliant! maze)
 (let ((width (get-width maze)) (height (get-height maze)))
   (set-empty-cell! 1 1 maze)
   (set-empty-cell! (- width 2) (- height 2) maze)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PATH

(define (make-empty-path) ())
(define (add-step x y path) (cons (cons x y) path))
(define (get-last-x path) (caar path))
(define (get-last-y path) (cdar path))
(define (rest path) (cdr path))
(define (empty-path? path) (null? path))

(define (embed-path-in-maze! path maze)
  (if (not (empty-path? path))
      (begin
        (set-path-cell! (get-last-x path) (get-last-y path) maze)
        (embed-path-in-maze! (rest path) maze))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; STATE
(define (make-state path maze) (cons path maze))
(define (get-path state) (car state))
(define (get-maze state) (cdr state))

(define (make-initial-state maze)
  (let ((path (make-empty-path)))
    (make-state 
     (add-step (- (get-width maze) 2) (- (get-height maze) 2) path)
     maze)))

(define (next-moves state)
  (let* ((path (get-path state)) 
         (maze (get-maze state))
         (x (get-last-x path))
         (y (get-last-y path))
         (tentative (list (cons (+ 1 x) y)
                          (cons x (+ 1 y))
                          (cons (- x 1) y)
                          (cons x (- y 1)))))
    (map (lambda(p)(make-state (add-step (car p) (cdr p) path) maze)) 
         (filter (lambda(p)(empty-cell? (car p) (cdr p) maze)) tentative))))

(define (done-with-maze? state)
  (let* ((path (get-path state))) 
    ;(display path) (newline)
    (and (= (get-last-x path) 1)
         (= (get-last-y path) 1))))

  
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;  SEARCH

(define (search start-state done? succ-fn merge-fn)
  (define (search1 queue)
    (if (null? queue)
        #f
        (let ((current (car queue)))
          (if (done? current)
              current
              (search1
               (merge-fn (succ-fn current)
                         (cdr queue)))))))
  (search1 (list start-state)))

(define (solve maze)
  (let ((state
         (search (make-initial-state maze) done-with-maze? next-moves 
                 (lambda(x y)(append y x)))))
    (if state (get-path state) (error "no maze solution found"))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; FUN

(define maze (make-empty-maze 8 8))
(make-boundary! maze)
(make-random-walls! 10 maze)
(make-compliant! maze)
(display-maze maze)
(define path (solve maze))
(embed-path-in-maze! path maze)
(display-maze maze)