INCLUDE "stdproc.adl";

/* Object properties specific to this scenario */

BITPROP
	BROKEN;		// The window can be broken



/* Locations in this scenario */

NOUN
    room1,
    room2;

room1(LIGHT) = TRUE;
room2(LIGHT) = TRUE;



/* The vocabulary for this scenario */

ADJEC
    sun,
    red,
    blue;

NOUN
    wall,
    floor,
    sun window(room2),
    door(room1),
    red ball(room1),
    blue ball(room1);

PREP
    against;

hard = red;	wooden = red;
soft = blue;	foamy = blue;
sunwindow = sun window;
bounce = throw;




/* Location descriptions */

room1(LDESC) = Proc()
{
    "You are in your bedroom.  All of your really FUN toys have been ";
    "put away, out of your reach.  There is another room to the east.\n";
}
room1(SDESC) = Proc() {"Bedroom\n";}

room2(LDESC) = Proc()
{
    "You are in the nursery.  A pretty yellow sunbeam is shining on the ";
    "floor.  There is another room to the west.\n";
}
room2(SDESC) = Proc() {"Nursery\n";}




/* Transition routines */
cg = Proc() {"You can't go that way.\n";}

room1(ACTION) = Proc()
{
    $miss(cg,cg,0,cg,cg,cg,cg,cg,cg,cg);
    $hit($ME,0,0,room2,0,0,0,0,0,0,0);
}

room2(ACTION) = Proc()
{
    $miss(cg,cg,cg,0,cg,cg,cg,cg,cg,cg);
    $hit($ME,0,0,0,room1,0,0,0,0,0,0);
}



/* Object specific routines */

BallAct = Proc(Obj)				// ACTION rout for balls
{
    If (Verb == throw) {
	If (Dobj != Obj) {
	    /* We're the iobj; don't perform an action */
	    $exit(0);
	}
	If (Iobj != wall) {
	    "You throw the ball at the floor, where it bounces a few ";
	    "times, then is still.\n";
	}
        Else {
	    "The ball sails through the air, then bounces off the wall ";
	    "onto the floor.\n";
	}
	$move(Dobj, $loc($ME));
	$exit(1);
    }
}

red ball(LDESC) = Proc() {"There is a hard, wooden red ball here.\n";}
red ball(SDESC) = Proc() {"a red ball";}
red ball(ACTION) = Proc() { BallAct( <red ball> ); }

blue ball(LDESC) = Proc() {"There is a soft, foamy blue ball here.\n";}
blue ball(SDESC) = Proc() {"a blue ball";}
blue ball(ACTION) = Proc() { BallAct( <blue ball> ); }


NoAct =	Proc(Obj)			// ACTION rout for wall and floor
{
    If ((Verb != throw) | (Iobj != Obj)) {
	Silly();
    }
}

wall(NOTAKE) = TRUE;
wall(ACTION) = Proc() { NoAct(wall); }

floor(NOTAKE) = TRUE;
floor(ACTION) = Proc() { NoAct(floor); }


sun window(NOTAKE) = TRUE;
sun window(LDESC) = Proc()
{
    "There is a large sun window here";
    If (<sun window>.BROKEN)
	", shattered into a thousand pieces!\n";
    Else
	".\n";
}
sun window(SDESC) = Proc()
{
    If (<sun window>.BROKEN)
	"a broken window";
    Else
	"a sun window";
}
sun window(ACTION) = Proc()
{
    If ((Verb == throw) & (Iobj == <sun window>)) {
	If (Dobj == <red ball>) {
	    "The red ball sails through the window, shattering it!\n";
	    $move(<red ball>, $ALL);
	    <sun window>.BROKEN = TRUE;
	    $exit(1);
        }
	Else If (Dobj == <blue ball>) {
	    If (<sun window>.BROKEN) {
		"The blue ball sails through the broken window!\n";
		$move(<blue ball>, $ALL);
	    }
            Else {
		"The blue ball bounces harmlessly off the window.\n";
		$move(<blue ball>, room2);
	    }
	    $exit(1);
	}
        Else {
	     Silly();
	}
    }
    Else If (Verb == open) {
	"You can't open a sun window!\n";
	$exit(1);
    }
    Else If (Verb == take) {
	Silly();
    }
}


door(NOTAKE) = TRUE;
door(LDESC) = Proc() { "There is a closed door here.\n"; }
door(SDESC) = Proc() { "a door"; }
door(ACTION) = Proc()
{
    If ((Verb == throw) & (Iobj == door)) {
	"The ", $name(Dobj), " bounces harmlessly off of the door.\n";
	$exit(1);
    }
    Else If (Verb == open) {
	"The doorknob is too high for you to reach.\n";
	$exit(1);
    }
    Else If (Verb == take) {
	Silly();
    }
}




/* Scenario dependant routines */

Parent = Proc()				// The parent fuse
{
    If ($loc($ME) == room1)
	"Suddenly, the door to your bedroom opens! ";
    Else
	"You hear the door in your bedroom opening! ";
    
    "Your parents enter the room. ";
    IF (<sun window>.BROKEN)
	"Daddy notices the broken window, and turns a funny red color. ",
	"\"I see that you haven't learned your lesson, dear,\" says ",
	"Mommy.  \"I'm afraid that you will have to stay in here for ",
	"at least another hour! ",
	"Mommy and Daddy leave you alone again.  Let's see what other ",
	"fun things there are to do around here...\n";
    ELSE
	"\"Have you learned your lesson, kiddo?\" asks Daddy.  Seeing ",
	"your cute little face seems to have charmed them!  You're off ",
	"the hook!  Mommy and Daddy take you out to see \"The Care ",
	"Bears Eat New York\", and you live happily ever after.\n";
    $spec(QUIT);
}


VAR
    Rand[ 10 ];

(Rand + 0) = "You wonder if the blue ball will bounce off of the window.\n";
(Rand + 1) = "You wonder if the red ball will bounce off of the window.\n" ;
(Rand + 2) = "You find a piece of lint on the floor, and eat it.  Yum!\n" ;
(Rand + 3) = "You can hear Kitty meowing outside.\n" ;
(Rand + 4) = "You hear Mommy singing in the kitchen.\n" ;
(Rand + 5) = "You practice making disgusting noises.  THPPP!  ZZZKKK!\n" ;
(Rand + 6) = "You hear Daddy hit his head on the garage door.\n" ;
(Rand + 7) = "You lick the wall, to see what it tastes like.\n" ;
(Rand + 8) = "You pretend that you're an airplane.  Zoom!\n" ;
(Rand + 9) = "You make spider shadows with your hands.\n";

Random = Proc()			// Random message daemon
{
    Var which;

    $incturn();			// Increment the turn counter
    $move(wall, $loc($ME));	// Move the wall to my current location
    $move(floor, $loc($ME));	// Move the floor to my current location
    which = $rand(20);
    If (which == 1) {
	If ($loc(<blue ball>) != $ALL) {
	    $say(Rand[0]);
        }
    }
    Else If (which == 2) {
	If ($loc(<red ball>) != $ALL) {
	    $say(Rand[1]);
	}
    }
    Else If (which <= 10) {
	$say(Rand[which - 1]);
    }
}

NOUN	ME(room1);			/* The main actor in this play */

(Indent) = TRUE;			/* Indent object descriptions */

START = Proc()
{
    "\n\n\n\n",			// A few newlines for good measure
    "It all started so innocently!  Kitty asked you for a haircut, ",
    "so you took Daddy's neato electric razor, and gave her a Mohawk. ",
    "Unfortunately, Mommy and Daddy didn't think it was so neat, and ",
    "they stuck you in here for a fifteen minute time out period...\n\n";

    StdInit(ME);			// Initialize standard
    $sdem(Random);			// Set up the random message daemon
    $sfus(ME, Parent, 15);		// Set up mommy and daddy
    $define("both", "red,blue");	// Set up "both" to work
    $define("balls", "ball");		// with the balls
}

/* Dwimming routines */

DWIMI = Proc(Obj) { Return Dwimmer(Obj); }
DWIMD = Proc(Obj) { Return Dwimmer(Obj); }