#lang racket/base

; A generic maze generator
; Generate a 2d-array whose cell indicate if they are linked to their neighbours

(require
  racket/list
  "../collection/2d-array.rkt"
  )

(provide
  ; maze cell
  maze-cell-distance-from-start
  maze-cell-linked-up?
  maze-cell-linked-down?
  maze-cell-linked-left?
  maze-cell-linked-right?
  maze-cell-dead-end?
  ; maze
  make-maze
  )

; Cell structure in maze
(struct maze-cell
  (linked-directions ; Directions for which the cell is connected to other cells, as a hash. The directions are symbolic values 'up, 'down, 'left, 'right
   distance-from-start ; Distance of the cell to the starting cell, #f if cell is not (yet) part of the maze
   ))

; Make an initial maze-cell
(define (make-maze-cell)
  (maze-cell
    (make-immutable-hash)
    #f))

; Add a direction and return a new maze-cell
(define (maze-cell-add-link cl dir [linked? #t])
  (maze-cell
    (hash-set (maze-cell-linked-directions cl) dir linked?)
    (maze-cell-distance-from-start cl)))

; Change the distance and return a new maze-cell
(define (maze-cell-set-distance cl dist)
  (maze-cell
    (maze-cell-linked-directions cl)
    dist))

; Linked to the cell above ?
(define (maze-cell-linked-up? cl)
  (hash-ref (maze-cell-linked-directions cl) 'up #f))

; Linked to the cell below ?
(define (maze-cell-linked-down? cl)
  (hash-ref (maze-cell-linked-directions cl) 'down #f))

; Linked to the cell left of it ?
(define (maze-cell-linked-left? cl)
  (hash-ref (maze-cell-linked-directions cl) 'left #f))

; Linked to the cell right of it ?
(define (maze-cell-linked-right? cl)
  (hash-ref (maze-cell-linked-directions cl) 'right #f))

; From a maze-cell, return the list of still available direction
(define (maze-cell-available-directions cl)
  (filter
    (lambda (x)
      (not (hash-has-key? (maze-cell-linked-directions cl) x)))
    '(up down left right)))

; A cell is a dead-end if it has exactly one link
(define (maze-cell-dead-end? cl)
  (eq? 1
    (foldl
      (lambda (x res)
        (+ res
           (if (hash-ref (maze-cell-linked-directions cl) x #f)
               1
               0)))
      0
      '(up down left right))))

; Return the offset of a given direction
(define (direction-offset dir)
  (case dir
    ((up) '(0 . -1))
    ((down) '(0 . 1))
    ((left) '(-1 . 0))
    ((right) '(1 . 0))
    (else (error "Invalid direction:" dir))))

; Return the opposite direction of a given direction
(define (direction-opposite dir)
  (case dir
    ((up) 'down)
    ((down) 'up)
    ((left) 'right)
    ((right) 'left)
    (else (error "Invalid direction:" dir))))

; Carving procedure
; Arguments:
; - maze: a 2d-array of maze-cell
; - i: horizontal position of the cell to check
; - j: vertical position of the cell to check
; - next-dirs: the list of possible directions from the current cell
; - loop?: if loops are allowed or not
(define (carve-maze! maze i j next-dirs loop?)
  ; If there is a next direction to check
  (when (not (null? next-dirs))
    (define dir (car next-dirs))
    (define offset (direction-offset dir))
    (define cell (2d-array-ref maze i j))
    (define ni (+ i (car offset)))
    (define nj (+ j (cdr offset)))
    (cond
      ; The next cell is inside the area and not visited
      ( (and (2d-array-inside? maze ni nj)
             (not (maze-cell-distance-from-start (2d-array-ref maze ni nj))))
        ; Carve
        ; Update current cell
        (2d-array-set! maze i j (maze-cell-add-link cell dir))
        ; Update next cell
        (define ncell
          (maze-cell-add-link
            (maze-cell-set-distance
              (2d-array-ref maze ni nj)
              (+ 1 (maze-cell-distance-from-start cell)))
            (direction-opposite dir)))
        (2d-array-set! maze ni nj ncell)
        ; Start again from the new position
        (carve-maze! maze ni nj (shuffle (maze-cell-available-directions ncell)) loop?))
      ; If we allow loop, maybe carve, but don't start again from next cell
      ( (and (2d-array-inside? maze ni nj) loop? (< (random 20) 1))
        (define ncell (2d-array-ref maze ni nj))
        ; Update current cell
        (2d-array-set! maze i j (maze-cell-add-link cell dir))
        ; Update next cell
        (2d-array-set! maze ni nj (maze-cell-add-link ncell (direction-opposite dir))))
      )
    ; Continue on next direction
    (carve-maze! maze i j (cdr next-dirs) loop?)))

; Make a maze
(define (make-maze width height [loop? #f])
  (define maze (make-2d-array width height (make-maze-cell)))
  ; Start at a random position
  (define i (random width))
  (define j (random height))
  (define cell (maze-cell-set-distance (make-maze-cell) 0))
  (2d-array-set! maze i j cell)
  ; Carve
  (carve-maze! maze i j (shuffle (maze-cell-available-directions cell)) loop?)
  ; Return the maze
  maze)
