Commits

Steven! Ragnarök committed a6101b8

Define the rest of the functions for our Adventure.

Comments (0)

Files changed (1)

wizards-adventure.lisp

                         (garden ( you are in a beautiful garden.
                                       there is a well front of you.))
                         (attic (you are in the attic.
-                                    there is a giant welding torch in the corner.))))
+                                    there is a giant welding torch in
+                                    the corner.))))
+
 (defparameter *edges* '((living-room (garden west door)
                                      (attic upstairs ladder))
                         (garden (living-room east door))
                         (attic (living-room downstairs ladder))))
 
+(defparameter *objects* '(whiskey bucket frog chain))
+
+(defparameter *object-locations* '((whiskey living-room)
+                                   (bucket living-room)
+                                   (chain garden)
+                                   (frog garden)))
+
+(defparameter *location* 'living-room)
+
 (defun describe-location (location nodes)
   (cadr (assoc location nodes)))
 
 (defun describe-paths (location edges)
   (apply #'append (mapcar #'describe-path (cdr (assoc location edges)))))
 
+(defun objects-at (loc objs obj-locs)
+  (labels ((at-loc-p (obj)
+             (eq (cadr (assoc obj obj-locs)) loc)))
+    (remove-if-not #'at-loc-p objs)))
+
+(defun describe-objects (loc objs obj-loc)
+  (labels ((describe-obj (obj)
+             `(you see a ,obj on the floor.)))
+    (apply #'append (mapcar #'describe-obj (objects-at loc objs obj-loc)))))
+
+(defun look ()
+  (append (describe-location *location* *nodes*)
+          (describe-paths *location* *edges*)
+          (describe-objects *location* *objects* *object-locations*)))
+
+(defun walk (direction)
+  (let ((next (find direction
+                   (cdr (assoc *location* *edges*))
+                   :key #'cadr)))
+    (if next
+      (progn (setf *location* (car next))
+             (look))
+      '(you cannot go that way.))))
+
+(defun pickup (object)
+  (cond ((member object
+                  (objects-at *location* *objects* *object-locations*))
+         (push (list object 'body) *object-locations*)
+         `(you are now carrying the ,object))
+        (t '(you cannot get that.))))
+
+(defun inventory ()
+  (cons 'items- (objects-at 'body *objects* *object-locations*)))
+