AAL sources (2 of 8)

[Jonathan Amsterdam]

;;; -*- Mode: LISP; Syntax: Common-lisp; Package: USER; Base: 10 -*-

;;; A sample adventure in AAL.

;;; First, basic stuff you'd find in every adventure.

;;; Some conventions: objects are AT locations, player is CARRYING things,
;;; things can be IN other things.

;;; The transitive closure of the IN relation.
(rules ((within *x *y) <- (in *x *y))
       ((within *x *y) <- (in *x *z) (within *z *y)))

;;; Something is HERE if it's at this location, or being carried by the player,
;;; or in something that's at this location or being carried.
(rule (here *x) <- (or (at *x *loc)
		       (carrying player *x)
		       (and (or (at *y *loc) (carrying player *y)) (within *x *y))))

;;; Moving something from one loc to another.
(rule (move *object *location) <- (at *object *cur-loc)
				  (do (not (at *object *cur-loc))
				      (at *object *location)))

;;; Prints out all the things that are at the current location.
(rule (loc-contents) <- (do
			  (every *x (and (at *x *loc) (not (eql *x player)))
				 (query (desc *x *d))
				 ("There is a ~a here." *d))))
		    

(rules ((describe *object) <- (description *object *desc)
			      (display *desc))
       ((describe *object) <- (do "I can't tell you anything more.")))

(rule (drop *object) <- (do (not (carrying player *object))
			    (at *object *loc)))

(rule (inventory) <- (or (and (carrying player *x)
			      (every *y (carrying player *y) (display *y)))
			 (display "You're not carrying anything.")))

;;; Print out info about new loc whenever the player moves.
(when-asserted (at player *location) -> (set *loc *location)
					(lisp (terpri))
					(((been-to player *loc) -> ("You're in ~a." *loc))
					 (-> (describe *loc) (been-to player *loc)))
					(loc-contents))


(feature movement
  (actions-order *loc *command)
  (requires ((exit *loc self *) "You can't go that way.")))

(command (n north) movement)
(command (s south) movement)
(command (e east) movement)
(command (w west) movement)
(command ne movement)
(command se movement)
(command nw movement)
(command sw movement)
(command (u up) movement)
(command (d down) movement)

(command take (take *obj)
  (requires ((here *obj) "I see no ~a." *obj)
	    ((not (carrying player *obj)) "You already have the ~a!" *obj)
	    ((at *obj *loc) "The ~a is inside something else." *obj)
	    ((not (fixed *obj)) "That object can't be taken."))
  (carrying player *obj)
  (not (at *obj *loc))
  "Taken.")

(feature fixed)  ;; Fixed things can't be taken.

(command drop (drop *obj)
  (requires ((carrying player *obj) "You don't have the ~a." *obj))
  (drop *obj)
  "Dropped.")

;;; This command is different from the above rule.  The command makes sure that
;;; the object to be described is present.
(command describe (describe *obj)
  (((here *obj) -> (describe *obj))
   (-> ("I see no ~a" *obj))))
	
(command look
  (describe *loc)
  (loc-contents))

;;; We have to say "query" here because of the way a command form is parsed--it
;;; thinks the list (inventory) is the syntax specification.  The problem is
;;; too much syntactic sugar.

(command inventory
  (query (inventory)))

(command invent
  (inventory))

(command time
  (display *tick))

(command score
  (display-score))

(command quit
  (end-game))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; The test game.


(loc the-first-room
"You are in a small, gloomy room lit by an unseen source above you.
The walls and floor are smooth, hard and dark, like obsidian.  Exits
lead west and south."
  (contains whistle)
  (exits
   (w the-second-room)
   (s "You have wandered around and wound up back where you started.")))

(loc the-second-room
"You are in a vast chamber of ice and rock.  Fiery torches in the walls 
provide an eerie light.  There is a passageway south and another exit to
the north."
  (contains monster)
  (exits
   (s the-first-room)
   (n ((alive monster) -> "The monster won't let you pass.")
      v-room)))

(loc v-room "the victory room"
"You are in an incredibly beautiful room.  Hordes of attractive attendants
are catering to your every whim, and why shouldn't they?  You WON THE GAME!!"
)

;;; This timer ends the game as soon as the player enters the v-room.
(timer (before each turn
	       ((at player v-room) -> (end-game))))

(command blow
	(blow *obj)
	(requires ((carrying player *obj) "You don't have the ~a" *obj))
	"You can't blow that!")

(command (throw hurl chuck)
	(throw *instr at *obj)
	(requires ((carrying player *instr) "You're not carrying the ~a." *instr)
		  ((here *obj) "I see no ~a here." *obj))
	(drop *instr)
	"Thrown.")

(obj monster fixed
     (description "It is one hairy mother of a monster!")
     (initially (alive monster))
     (score 10 ((not (alive monster)) -> 10))
     (command throw *obj
   	     ((alive monster) -> ("The monster destroys the ~a." *instr)
				 (destroy *instr))))

(when-retracted (alive monster) -> (description monster "It is one dead monster.")
				   (desc monster "dead monster"))

(obj whistle
     (command blow *obj
	     "The whistle emits a piercing screech."
	     ((at monster *loc) (alive monster) -> 
	      "The monster's eyes bug out--wider--wider--and then, ~
		finally, close forever."
	      (not (alive monster)))))


(obj gold "precious gold nugget"
     (initially (at gold the-first-room))
     (score 2 ((carrying player gold) -> 2)))

(when-asserted  (in water bottle) -> (description bottle "There's some water in it."))
(when-retracted (in water bottle) -> (description bottle "The bottle is empty."))

(obj bottle
     (command throw *instr
	      "The bottle makes a funny noise when you throw it..."
	      (continue))
     (initially (at bottle the-first-room)
		(in water bottle)))

(command drink (drink *obj)
	 (requires ((here *obj) "I see no ~a." *obj))
	 "You can't drink that.")



;;; The following stuff is just for illustration; it doesn't play any role in
;;; the game.

;;; Objects can have local variables.
(feature (resource n name)
  (var (*quantity n)
       (*name name)))

(obj water (resource 2 "gallon")
     (command drink *obj
       (requires ((in water bottle) "The water's not in the bottle.")
		 ((carrying player bottle) "You're not carrying the bottle."))
       "Yummm!"
       (dec *quantity)
       ((zerop *quantity) -> (destroy water) "That was the last of the water.")))

(command how (how much *obj)
	 (requires ((here *obj) "I see no ~a" *obj)
		   ((resource *obj * *) "It doesn't make sense to ask how much of that"))
    (let *q (value *obj *quantity))
    (let *n (value *obj *name))
    (((= *q 1) -> ("There is now ~d ~a of ~a." *q *n *obj))
     (-> ("There are now ~d ~as of ~a." *q *n *obj))))


(command increase (increase *obj *amount)
	 (inc (*obj *quantity)))

(command decrease (decrease *obj *amount)
	 (dec (*obj *quantity)))

(command suggest
  ;; This illustrates the choose action.
  (choose *x (at *x *loc))
  ("How about ~a?" *x))

(command choose (choose exit)
	 ;; Another example of the choose action.
	 (choose *exit (exit *loc *exit *))
	 ;; The choose just binds *exit, so we have to query to find out the
	 ;; destination. 
	 (query (exit *loc *exit *dest))
	 ("How about ~a, which goes to ~a?" *exit *dest))

(timer (after turn 5
	      "That's five turns you've blown!"))


(initially (at player the-first-room))