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