(declare (unit commands)) (define (get-command command) (let ((room-command (((current-room) 'command) command))) (if (null? room-command) (command-table command) room-command))) (define command-table (match-lambda ("look" command-look) ("l" command-look) ; Navigation ("north" command-north) ("n" command-north) ("south" command-south) ("s" command-south) ("east" command-east) ("e" command-east) ("west" command-west) ("w" command-west) ("up" command-up) ("u" command-up) ("down" command-down) ("d" command-down) ; Huh?!? ("rake" command-rake) (other (command-unknown other)))) (define command-look (lambda (words) (display ((current-room) 'name)) (display " < ") (map (lambda (i) (unless (null? ((current-room) (car i))) (display (cdr i))(display " "))) '((north . "n") (south . "s") (east . "e") (west . "w") (up . "u") (down . "d"))) (display ">")(newline) (display ((current-room) 'description))(newline))) (define (command-direction direction) (lambda (words) (let ((exit ((current-room) direction)) (str (symbol->string direction))) (if (null? exit) (begin (map display `("You can't go " ,str ".")) (newline)) (begin (map display `("You move " ,str ".")) (newline) (current-room-set! exit) (command-look '())))))) (define command-north (command-direction 'north)) (define command-south (command-direction 'south)) (define command-east (command-direction 'east)) (define command-west (command-direction 'west)) (define command-up (command-direction 'up)) (define command-down (command-direction 'down)) (define command-rake (lambda (words) (display "Do that in the command line.") (newline))) (define (command-unknown command) (lambda (words) (map display `("I don't know how to '" ,command "'.")) (newline)))