(declare (unit rooms))

(define room-table (make-hash-table))
(define (room-table-ref key)
  (hash-table-ref room-table key))
(define (room-table-set! key value)
  (hash-table-set! room-table key value))

(define current-room-key 'red-room)
(define (current-room)
  (room-table-ref current-room-key))
(define (current-room-set! key)
  (set! current-room-key key))

(define (room symbol name description . exits)
  (let ((exits-table (make-hash-table))
        (commands-table (make-hash-table equal?)))
    (map (lambda (exit) (hash-table-set! exits-table (car exit) (cadr exit))) exits)
    (let ((result
      (match-lambda
        ('name name)
        ('description description)
        ('exits exits-table)
        ('north (hash-table-ref/default exits-table 'north '()))
        ('south (hash-table-ref/default exits-table 'south '()))
        ('east (hash-table-ref/default exits-table 'east '()))
        ('west (hash-table-ref/default exits-table 'west '()))
        ('up (hash-table-ref/default exits-table 'up '()))
        ('down (hash-table-ref/default exits-table 'down '()))
        ('commands commands-table)
        ('command (lambda (command) (hash-table-ref/default commands-table command '())))
        (other (signal (exn type))))))
      (unless (null? symbol)
        (room-table-set! symbol result))
      result)))

(define (room-add-command room command proc)
  (hash-table-set! ((if (symbol? room) (room-table-ref room) room) 'commands) command proc))

(room
  'red-room
  "The Red Room"
  "This room is full of red things."
  '(north blue-room)
  '(west bat-country))

(room
  'blue-room
  "The Blue Room"
  "This room is full of blue things."
  '(south red-room))

(room
  'bat-country
  "Bat Country"
  "This room is full of bats!"
  '(east red-room))

(room-add-command 'bat-country "stop"
  (lambda (words)
    (display "You can't stop here.")
    (newline)))