lac : 32d428bfe849b03fa8542dfda10ff1a2bd095b75

     1: (defmacro defspel (&rest rest) `(defmacro ,@rest))
     2: (define *objects* '(whiskey-bottle bucket frog chain))
     3: (define *map* '((living-room (you are in the living-room of a wizards house. there is a wizard snoring loudly on the couch.)
     4:                            (west door garden)  
     5:                            (upstairs stairway attic))
     6:               (garden (you are in a beautiful garden. there is a well in front of you.)
     7:                       (east door living-room))
     8:               (attic (you are in the attic of the wizards house. there is a giant welding torch in the corner.)
     9:                      (downstairs stairway living-room))))
    10: 
    11: (define *object-locations* '((whiskey-bottle living-room)
    12:                            (bucket living-room)
    13:                            (chain garden)
    14:                            (frog garden)))
    15: (define *location* 'living-room)
    16: 
    17: (defun describe-location (location map)
    18:   (second (assq location map)))
    19: 
    20: (defun describe-path (path)
    21:   `(there is a ,(second path) going ,(first path) from here.))
    22: 
    23: (defun describe-paths (location map)
    24:   (apply append (mapcar describe-path (cddr (assq location map)))))
    25: 
    26: (defun is-at (obj loc obj-loc)
    27:   (eq (second (assq obj obj-loc)) loc))
    28: 
    29: (defun describe-floor (loc objs obj-loc)
    30:   (apply append (mapcar (lambda (x)
    31: 			  `(you see a ,x on the floor.))
    32: 			(remove-if-not (lambda (x)
    33: 					 (is-at x loc obj-loc))
    34: 				       objs))))
    35: 
    36: (defun look ()
    37:   (append (describe-location *location* *map*)
    38:           (describe-paths *location* *map*)
    39:           (describe-floor *location* *objects* *object-locations*)))
    40: 
    41: (defun walk-direction (direction)
    42:   (let ((next (assq direction (cddr (assq *location* *map*)))))
    43:     (cond (next (setq *location* (third next)) (look))
    44: 	    (t '(you cant go that way.)))))
    45: 
    46: (defspel walk (direction)
    47:   `(walk-direction ',direction))
    48: 
    49: (defun pickup-object (object)
    50:   (cond ((is-at object *location* *object-locations*) 
    51: 	 (push (list object 'body) *object-locations*)
    52: 	 `(you are now carrying the ,object))
    53: 	(t '(you cannot get that.))))
    54: 
    55: (defspel pickup (object)
    56:   `(pickup-object ',object))
    57: 
    58: (defun inventory ()
    59:   (remove-if-not (lambda (x)
    60: 		      (is-at x 'body *object-locations*))
    61: 		  *objects*))
    62: 
    63: (defun have (object)
    64:   (member object (inventory)))
    65: 
    66: (define *chain-welded* nil)
    67: 
    68: (defspel game-action (command subj obj place &rest rest)
    69:   `(defspel ,command (subject object)
    70:      `(cond ((and (eq *location* ',',place)
    71:                   (eq ',subject ',',subj)
    72:                   (eq ',object ',',obj)
    73:                   (have ',',subj))
    74:              ,@',rest)
    75:             (t '(i cant ,',command like that.)))))
    76: 
    77: (game-action weld chain bucket attic
    78:              (cond ((and (have 'bucket) (setq *chain-welded* 't))
    79:                     '(the chain is now securely welded to the bucket.))
    80:                    (t '(you do not have a bucket.))))
    81: 
    82: (game-action dunk bucket well garden
    83:              (cond (*chain-welded* (define *bucket-filled* 't) '(the bucket is now full of water))
    84:                    (t '(the water level is too low to reach.))))
    85: 
    86: (game-action splash bucket wizard living-room
    87:              (cond ((not *bucket-filled*) '(the bucket has nothing in it.))
    88:                    ((have 'frog) '(the wizard awakens and sees that you stole his frog. 
    89:                                    he is so upset he banishes you to the 
    90:                                    netherworlds- you lose! the end.))
    91:                    (t '(the wizard awakens from his slumber and greets you warmly. 
    92:                         he hands you the magic low-carb donut- you win! the end.))))