Miscellany

(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)))