(setq *print-circle* t)

(setq *room* '#1=(CURRENT (LIVING-ROOM LAMP) 
                  (LADDER (ATTIC APPLE ORANGE) #1#)
                  (DOOR (GARDEN) #1#)))
(print *room*)

(defvar *vowels* '(#\a #\e #\i #\o #\u))

(defun look ()
 (let ((string-location (format nil "~(~a~)" (caadr *room*)))
       (exits (mapcar 'car (cddr *room*)))
       (items (cdadr *room*)))
  (format t "I am in a~@[n~1*~] ~a~%"
         (find (char string-location 0) *vowels*)
         string-location)
  (format t "~[No items~;One item: ~:;Items: ~] ~@[~a~]~%"
         (length items) items)
  (format t "Exits to: ~a~%" exits)))

(defun traverse (edge)
 (let ((destination (assoc edge (cddr *room*))))
  (cond (destination
         (rplaca *room* edge)
         (setq *room* destination)
         (rplaca *room* 'current))
        ((null destination) 
         (format t "~a not found~%" edge))))
 (look))

(defvar *inventories* '((1 . ())))

(defun take (item-name &optional (player 1))
 (symbol-macrolet 
        ((inventory (cdr (assoc player *inventories*)))
         (room-contents (cdadr *room*)))
  (let ((item (find item-name room-contents)))
   (if (not item) (format t "I can't take ~a~%" item-name)
    (unwind-protect (push item inventory)
     (setf room-contents (delete item room-contents)))))))

(defun taken (&optional (player 1))
 (cdr (assoc player *inventories*)))

(defun untake (item-name &optional (player 1))
 (symbol-macrolet 
        ((inventory (cdr (assoc player *inventories*)))
         (room-contents (cdadr *room*)))
  (if (find item-name inventory)
   (unwind-protect (push item-name room-contents)
    (setf inventory (delete item-name inventory)))
   (format t "I can't drop ~a~%" item-name))))