canCarveAt: aPoint
    ^ ((board at: aPoint) = #wall)
        and: [ ((board at: aPoint + (0 @ 1)) = #wall)
            and: [ ((board at: aPoint + (0 @ -1)) = #wall)
                and: [ ((board at: aPoint + (1 @ 0)) = #wall)
                    and: [ ((board at: aPoint + (-1 @ 0)) = #wall) ] ] ] ]

canCarveAt: aPoint towards: aDirection
    ^ ((board at: aPoint + aDirection ifAbsent: [ #none ]) = #wall)
        and: [ (board at: aPoint + (aDirection * 2) ifAbsent: [ #none ]) = #wall ]

carve: aNumber towards: aDirection at: aPoint
    | newPosition |

    newPosition := aPoint.

    aNumber timesRepeat: [
        newPosition := newPosition + aDirection.
        board at: newPosition put: #floor ].

    ^ newPosition

carveFromStack: aStack
    | top position dir |

    top := aStack last.
    position := top key.
    dir := top value remove: top value atRandom.

    top value ifEmpty: [ aStack removeLast ].
    ((board at: position + dir ifAbsent: [ #none ]) = #wall)
        and: [ self canCarveAt: position towards: dir ]
            ifTrue: [
                | newPosition newDirs |

                newPosition := self carve: 2 towards: dir at: position.
                newDirs := self directions remove: (dir * -1); yourself.
                aStack add: newPosition -> newDirs ]

generatePassageAt: aPoint
    | stack |

    stack := Array with: aPoint -> self directions.
    board at: aPoint put: #floor.

    [ stack notEmpty ] whileTrue: [ self carveFromStack: stack ]

generatePassages
    (self container origin y + 1 to: self container corner y by: 2)
        do: [ : y |
            (self container origin x + 1 to: self container corner x by: 2)
                do: [ :x |
                    (self canCarveAt: x@y)
                        ifTrue: [ self generatePassageAt: x@y ] ] ]