Coverage report: /Users/mohacker/src/yurrriq/land-of-lisp/src/wizard5.lisp

KindCoveredAll%
expression8989100.0
branch22100.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 (in-package :cl-user)
2
 (defpackage lol.wizard5
3
   (:use :cl)
4
   (:export :look
5
            :walk
6
            :pickup
7
            :inventory
8
            :game-repl))
9
 (in-package :lol.wizard5)
10
 
11
 
12
 (defparameter *nodes*
13
   '((living-room (you are in the living room.
14
                   a wizard is snoring loudly on the couch.))
15
     (garden      (you are in a beautiful garden.
16
                   there is a well in front of you.))
17
     (attic       (you are in the attic.
18
                   there is a giant welding torch in the corner.))))
19
 
20
 (defparameter *edges*
21
   '((living-room (garden west door)
22
                  (attic upstairs ladder))
23
     (garden      (living-room east door))
24
     (attic       (living-room downstairs ladder))))
25
 
26
 (defparameter *objects* '(whiskey bucket frog chain))
27
 
28
 (defparameter *object-locations*
29
   '((whiskey living-room)
30
     (bucket living-room)
31
     (chain garden)
32
     (frog garden)))
33
 
34
 (defparameter *location* 'living-room)
35
 
36
 
37
 (defun describe-location (location nodes)
38
   (cadr (assoc location nodes)))
39
 
40
 
41
 (defun describe-path (edge)
42
   `(there is a ,(caddr edge) going ,(cadr edge) from here.))
43
 
44
 
45
 (defun describe-paths (location edges)
46
   (apply #'append (mapcar #'describe-path (cdr (assoc location edges)))))
47
 
48
 
49
 (defun objects-at (loc objs obj-locs)
50
   (labels ((at-loc-p (obj)
51
              (eq (cadr (assoc obj obj-locs)) loc)))
52
     (remove-if-not #'at-loc-p objs)))
53
 
54
 
55
 (defun describe-objects (loc objs obj-loc)
56
   (labels ((describe-obj (obj)
57
              `(you see a ,obj on the floor.)))
58
     (apply #'append
59
            (mapcar #'describe-obj
60
                    (objects-at loc objs obj-loc)))))
61
 
62
 
63
 (defun look ()
64
   (append (describe-location *location* *nodes*)
65
           (describe-paths *location* *edges*)
66
           (describe-objects *location* *objects* *object-locations*)))
67
 
68
 
69
 (defun walk (direction)
70
   (let ((next (find direction
71
                     (cdr (assoc *location* *edges*))
72
                     :key #'cadr)))
73
     (if next
74
         (progn (setf *location* (car next))
75
                (look))
76
         '(you cannot go that way.))))
77
 
78
 
79
 (defun pickup (object)
80
   (if (member object (objects-at *location* *objects* *object-locations*))
81
       (progn (push (list object 'body) *object-locations*)
82
              `(you are now carrying the ,object))
83
       '(you cannot get that.)))
84
 
85
 
86
 (defun inventory ()
87
   (cons 'items- (objects-at 'body *objects* *object-locations*)))