#lang racket/base

; Yggdrasil room generator: fill undefined
; This generator replaces undefined in an area with walls and paths

(require
  "cell.rkt"
  "../../base-generation/random.rkt"
  "../../collection/2d-array.rkt")

(provide
  yggdrasil-undefined-fill)

; Many changes are based on local cells, and their neighbours

; Create an array on neighbours (a 3×3 2d-array)
; Only the type of cell is needed for the algorithms
; Out of area blocks are considered walls
(define (make-neighbours area i j)
  (build-2d-array 3 3
    (lambda (x y)
      (if (2d-array-inside? area (+ x (- i 1)) (+ y (- j 1)))
          (yggdrasil-cell-type (2d-array-ref area (+ x (- i 1)) (+ y (- j 1))))
          'wall))))

; Check if the given neighbours are all of the given type
(define (neighbours-all? neigh type poslst)
  (andmap
    (lambda (x) (eq? type (2d-array-ref neigh (car x) (cdr x))))
    poslst))

; Check if one of the given neighbours is of the given type
(define (neighbours-any? neigh type poslst)
  (ormap
    (lambda (x) (eq? type (2d-array-ref neigh (car x) (cdr x))))
    poslst))

; Change an undefined cell into something else depending on their neighbours
; Take an area and position and returns the new cell
(define (change-undefined area i j)
  (define cell (2d-array-ref area i j))
  (define neighbours (make-neighbours area i j))
  (cond
    ; If cell is defined, return it
    ((yggdrasil-cell-defined? cell)
      cell)
    ; Cases that lead to a path
    ( (or
        ; If 3 wall in one corner
        ; # # $
        ; # . $
        ; $ $ $
        (neighbours-all? neighbours 'wall '((0 . 0) (0 . 1) (1 . 0)))
        (neighbours-all? neighbours 'wall '((2 . 0) (2 . 1) (1 . 0)))
        (neighbours-all? neighbours 'wall '((0 . 2) (0 . 1) (1 . 2)))
        (neighbours-all? neighbours 'wall '((2 . 2) (2 . 1) (1 . 2)))
        ; If 3 wall on one side, and one at any position of the opposite side
        ; # # #
        ; $ . $
        ; # $ $
        (and
          (neighbours-all? neighbours 'wall '((0 . 0) (0 . 1) (0 . 2)))
          (neighbours-any? neighbours 'wall '((2 . 0) (2 . 1) (2 . 2))))
        (and
          (neighbours-all? neighbours 'wall '((0 . 0) (1 . 0) (2 . 0)))
          (neighbours-any? neighbours 'wall '((0 . 2) (1 . 2) (2 . 2))))
        (and
          (neighbours-all? neighbours 'wall '((2 . 0) (2 . 1) (2 . 2)))
          (neighbours-any? neighbours 'wall '((0 . 0) (0 . 1) (0 . 2))))
        (and
          (neighbours-all? neighbours 'wall '((0 . 2) (1 . 2) (2 . 2)))
          (neighbours-any? neighbours 'wall '((0 . 0) (1 . 0) (2 . 0))))
        )
      ; Path
      (get-yggdrasil-cell 'path))
    ; Cases that lead to a wall
    ( (or
        ; If one corner has a path surrounded by wall => wall
        ; . # $
        ; # # $
        ; $ $ $
        (and (neighbours-all? neighbours 'wall '((0 . 1) (1 . 0))) (neighbours-all? neighbours 'path '((0 . 0))))
        (and (neighbours-all? neighbours 'wall '((0 . 1) (1 . 2))) (neighbours-all? neighbours 'path '((0 . 2))))
        (and (neighbours-all? neighbours 'wall '((2 . 1) (1 . 0))) (neighbours-all? neighbours 'path '((2 . 0))))
        (and (neighbours-all? neighbours 'wall '((2 . 1) (1 . 2))) (neighbours-all? neighbours 'path '((2 . 2))))
        )
      ; Wall
      (get-yggdrasil-cell 'wall))
    ; Else, return the cell
    (#t
      cell)
    ))

; Compute all possible new wall positions
; A wall can only be placed on an undefined directly adjacent to a wall
(define (get-next-walls area)
  (2d-array-fold/indexes
    area
    '()
    (lambda (val i j res)
      (define neighbours (make-neighbours area i j))
      (cond
        ; Do not add if cell is defined
        ((yggdrasil-cell-defined? val)
          res)
        ; Do not add if there is a wall adjacent and in an opposite corner.
        ((or (neighbours-all? neighbours 'wall '((0 . 1) (2 . 0)))
              (neighbours-all? neighbours 'wall '((0 . 1) (2 . 2)))
              (neighbours-all? neighbours 'wall '((1 . 0) (0 . 2)))
              (neighbours-all? neighbours 'wall '((1 . 0) (2 . 2)))
              (neighbours-all? neighbours 'wall '((1 . 2) (2 . 0)))
              (neighbours-all? neighbours 'wall '((1 . 2) (0 . 0)))
              (neighbours-all? neighbours 'wall '((2 . 1) (0 . 2)))
              (neighbours-all? neighbours 'wall '((2 . 1) (0 . 0))))
          res)
        ; Add if there is a wall adjacent
        ((neighbours-any? neighbours 'wall '((0 . 1) (1 . 0) (2 . 1) (1 . 2)))
          (cons (cons i j) res))
        ; Add if there no wall at all among the neighbours
        ((not (neighbours-any? neighbours 'wall '((0 . 0) (0 . 1) (0 . 2) (1 . 0) (1 . 2) (2 . 0) (2 . 1) (2 . 2))))
          (cons (cons i j) res))
        ; Else do not add
        (#t
          res)))))

; Dig walls and doors or paths between disconnected areas
; Returns the area, modified if needed
(define (dig-walls area)
  ; Passage. Each cell is considered a path if
  ; - it's a path without a feature
  ; - it's a wall with a feature
  (define (passage? cell)
    (or (and (eq? 'path (yggdrasil-cell-type cell)) (not (yggdrasil-cell-feature cell)))
        (and (eq? 'wall (yggdrasil-cell-type cell)) (yggdrasil-cell-feature cell))))
  ; Create a 2d-array with the following values:
  ; Each passage is replaced with 1
  ; Each non-passage is replaced with -1
  (define path-mask
    (build-2d-array
      (2d-array-width area)
      (2d-array-height area)
      (lambda (i j)
        (if (passage? (2d-array-ref area i j)) 1 -1))))
  ; Flood & dig
  (define (flood-dig x y)
    ; Flood fill the path-mask with 0 at the given position
    (2d-array-flood-fill! path-mask x y 0 eq?)
    ; Find all walls between two paths that have different values in the mask
    (define walls-to-dig
      (2d-array-fold/indexes
        area
        (list)
        (lambda (cell i j res)
          (cond
            ((and
              (yggdrasil-cell-wall? cell)
              ; Between two paths with different values
              (or
                ; Horizontally
                (and
                  (2d-array-inside? area (- i 1) j)
                  (2d-array-inside? area (+ i 1) j)
                  (yggdrasil-cell-path? (2d-array-ref area (- i 1) j))
                  (yggdrasil-cell-path? (2d-array-ref area (+ i 1) j))
                  (not (eq? (2d-array-ref path-mask (- i 1) j)
                            (2d-array-ref path-mask (+ i 1) j))))
                ; Vertically
                (and
                  (2d-array-inside? area i (- j 1))
                  (2d-array-inside? area i (+ j 1))
                  (yggdrasil-cell-path? (2d-array-ref area i (- j 1)))
                  (yggdrasil-cell-path? (2d-array-ref area i (+ j 1)))
                  (not (eq? (2d-array-ref path-mask i (- j 1))
                            (2d-array-ref path-mask i (+ j 1)))))
                ))
             (cons (cons i j) res))
            ; Else, skip
            (#t
              res)))))
    ; If there is such a wall
    (when (not (null? walls-to-dig))
      ; Take one
      (define pos (random:from-list walls-to-dig))
      ; Replace it by a door or a path
      (2d-array-set! area (car pos) (cdr pos)
        (if (random:boolean)
            (get-yggdrasil-cell 'door)
            (get-yggdrasil-cell 'path)))
      ; Change its path-mask to 1
      (2d-array-set! path-mask (car pos) (cdr pos) 1)
      ; Repeat the process from that new position
      (flood-dig (car pos) (cdr pos))))
  ; Flood-dig from 0,0
  (flood-dig 0 0)
  ; Return the modified area
  area)

; Add events inside dead-ends
(define (add-events area)
  (2d-array-map/indexes
    area
    (lambda (cell i j)
      ; Compute the number of adjacent walls
      (define nb-adjacent-walls
        (foldl
          (lambda (pos res)
            (cond
              ((or (not (2d-array-inside? area (car pos) (cdr pos)))
                   (yggdrasil-cell-wall? (2d-array-ref area (car pos) (cdr pos))))
               (+ 1 res))
              (#t
                res)))
          0
          (list (cons (- i 1) j) (cons (+ i 1) j)
                (cons i (- j 1)) (cons i (+ j 1)))))
      ; If cell is a path and the number of adjacent walls is 3, transform into an event, at random
      (cond
        ((and
          (yggdrasil-cell-path? cell)
          (eq? 3 nb-adjacent-walls))
          (get-yggdrasil-cell 'event))
        (#t
          cell)))))

; Function to change undefined into paths or wall within an area.
(define (yggdrasil-undefined-fill area)
  ; Get all possible new wall positions
  (define next-walls (get-next-walls area))
  (cond
    ; If there is a possible wall,
    ; - choose one position,
    ; - place a wall,
    ; - remove all combinations that leads to a path or a wall,
    ; - and repeat the process
    ((not (null? next-walls))
     (define wall-pos (random:from-list next-walls))
     (2d-array-set! area (car wall-pos) (cdr wall-pos) (get-yggdrasil-cell 'wall))
     (yggdrasil-undefined-fill
       (2d-array-map/indexes
        area
        (lambda (cell i j)
          ; If the cell is defined, return it directly, else change it
          (if (yggdrasil-cell-defined? cell)
              cell
              (change-undefined area i j))))))
    ; Else, replace all the undefined left with paths
    (#t
      (add-events
        (dig-walls
          (2d-array-map area
            (lambda (cell)
              (if (yggdrasil-cell-defined? cell)
                cell
                (get-yggdrasil-cell 'path)))))))
    ))
