rendered paste body(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)))