Contents | Index | < Browse | Browse >

Appendix 2 - A scenario with multiple Actors

     The following ADL program demonstrates both the use  of
the  standard  package and the use of multiple actors.	This
is the scenario	which generated	the script at the  beginning
of this	document.


INCLUDE	"standard.adl";		{ Include the standard package }


{ The following	are Object properties }

BROKEN	=  1;		{ Is the robot damaged?	}
TOLD	=  2;		{ Have I told the robot	something? }
BSTATE	= 17;		{ State	of the button }
	B_OFF	=  0;	{ Button is off	}
	B_FLASH	=  1;	{ Button is flashing }
	B_LIT	=  2;	{ Button is lit	}


{ Global variables }

VAR
	RobSave[ 6 ],	{ Saved	sentence for the robot }
	Score;		{ Current score	}


{ Utility routines }

ROUTINE
	NoGo,	Sayer,	Myself,	Lifter,
	DoorCk,	TrapCk,	RobMov,	BlueCk,
	Header,	Die,	Skore,	RobEntr,
	HatchSD;


{ Locations in the dungeon }

NOUN
	Redrm,		Bluerm,
	Greenrm,	Cellar,
	Endrm;


{ Immovable objects }

NOUN
	button(	Bluerm ),
	door( Cellar ),
	hatch( Bluerm );


{ Objects which	may become actors }

NOUN
	me( Redrm ),
	robot( Greenrm );

me( NOTAKE ) = TRUE;


{ Room descriptions }

Redrm( LDESC ) =
	($say
"You are in a large room which is illuminated by a bright
red glow.  Exits lie to	the east and south.n"
	)
;
Redrm( SDESC ) = ($return (Header "Red room" %0));
Redrm( LIGHT ) = TRUE;


Greenrm( LDESC ) =
	($say
"You are in a smallish room which is illuminated by a pleasant
green glow.  The only exit is to the west.n"
	)
;
Greenrm( SDESC ) = ($return (Header "Green room" %0));
Greenrm( LIGHT ) = TRUE;


Bluerm(	LDESC )	=
	($say
"You are in a tiny room	which is barely	illuminated by a
dim blue glow.	There is an exit to the	north,"
	)
	(IF ($eq ($prop	button BSTATE) B_LIT) THEN
		($say
" and most of the floor	has tilted up to reveal	a hatch	leading
down into blackness.  A	button on the wall is glowing brightly."
		)
	 ELSE
		($say "	and you	seem to	make out something on the floor.")
		(IF ($prop button BSTATE) THEN
			($say "	 A button on the wall is flashing urgently.")
		 ELSE
			($say "	 There is a button on the wall.")
		)
	)
	($say
"  Above the button is a sign that reads:nn"
"		DANGER!nn"
"	     HIGH VOLTAGE!nn"
	)
;
Bluerm(	SDESC )	=
	(IF %0 THEN ($return "Blue room"))
	($say "Blue room.n")
;
Bluerm(	LIGHT )	= TRUE;


Cellar(	LDESC )	=
	($say
"You are in the	cellar.	 Far above you can be seen a dim
blue light."
	)
	(IF ($prop door	OPENED)	THEN
		($say
"  An open door	leads to the north.n"
		)
	 ELSE
		($say
"  You can barely see the outline of a door to the north.n"
		)
	)
;
Cellar(	SDESC )	=
    ($return (Header "Cellar" %0))
;
Cellar(	LIGHT )	= TRUE;


Endrm( LDESC ) =
	($say
"You exit from the dark	cellar into a land filled with singing birds,
blooming flowers, flowing streams, and bright blue skies.  In other words,
you have finished this game!n"
	)
	($setg Score ($plus @Score 25))
	(Skore)
	($spec 3)
;
Endrm( LIGHT ) = TRUE;


{ Verbs	}

VERB
	score,
	push,
	shout;

tell = TELLER;
say = tell;
press =	push;
feel = touch;
yell = shout;


{ Verb routines	}

tell( PREACT ) =
	(IF ($ne @Iobj robot) THEN
		{ The only logical thing to talk to is the robot }
		(Sayer
"Talking to yourself is	said to	be a sign of impending insanity"
		)
	 ELSEIF	($ge @Dobj 0) THEN
		{ You must say strings }
		(Sayer
"You must put what you want to say in quotes"
		)
	 ELSEIF	($ne ($loc robot) ($loc	me)) THEN
		{ The robot must be in the same	place as the player }
		(IF (Myself) THEN
			($say "You don't see the robot here.n")
		)
	 ELSE
		{ Everything is	OK.  Add 25 points to the score	}
		(IF ($not ($prop robot TOLD)) THEN
			($setg Score ($plus @Score 25))
			($setp robot TOLD TRUE)
		)
		($exit 0)
	)
	($exit 1)
;
tell( ACTION ) =
	{ Tell the player that we heard	him }
	($say ""Sure thing, Boss."n")

	{ Delete the old action	}
	($delact robot)

	{ Add the new action - a non-interactive actor }
	($actor	robot @Dobj FALSE)
;


shout( PREACT )	=
	(IF	($and @Iobj ($ne @Iobj robot)) THEN
		{ Shouting at things other than	the robot }
		($say "AAARRRGGGHHH!n")
	 ELSEIF	($ge @Dobj 0) THEN
		{ Shouting things other	than strings }
		($say "EEEYYYAAAHHH!n")
	 ELSEIF	($prop robot BROKEN) THEN
		($say "There is	no response.n")
	 ELSE
		{ Shouting at the robot	- same as telling the robot }
		(IF ($not ($prop robot TOLD)) THEN
			($setg Score ($plus @Score 25))
			($setp robot TOLD TRUE)
		)
		($exit 0)
	)
	($exit 1)
;
shout( ACTION )	=
	{ Tell the player we heard him }
	(IF ($ne ($loc robot) ($loc me)) THEN
		($say "In the distance you hear	the words, ")
	)
	($say ""Sure thing, Boss"n")

	{ Delete the old robot action }
	($delact robot)

	{ Add the new robot action }
	($actor	robot @Dobj FALSE)
;


push( PREACT ) =
	{ Expect a plain direct	object }
	(Expect	($or ONE_OBJ PLAIN_OBJ)	NO_OBJ)
	(CheckAvail)
;
push( ACTION ) =
	(Sayer "That doesn't seem to do	anything")
	($exit 1)
;


score(PREACT) =
	{ Score	can accept no objects }
	(Expect	NO_OBJ NO_OBJ)
	(Skore)
	($exit 1)
;


{ Object properties }

button(	SDESC )	=
	(IF ($eq ($prop	button BSTATE) B_OFF) THEN
		($say "a button")
	 ELSEIF	($eq ($prop button BSTATE) B_FLASH) THEN
		($say "an urgently flashing button")
	 ELSE
		($say "a brightly lit button")
	)
;
button(	ACTION ) =
	(IF ($and	(Myself)
			($or	($eq @Verb push)
				($eq @Verb take)
				($eq @Verb touch)
			)
		)
	 THEN
		{ The player tried to do something with	the button }
		($say
"As you	reach for the button, a	10,000,000 volt	bolt of	lightning
arcs toward your finger, disintegrating	you upon impact.n"
		)
		(Die)
	 ELSEIF	($and ($eq @Verb push) ($eq ($prop button BSTATE) B_OFF)) THEN
		{ The robot pushed the button }
		($setp button BSTATE B_FLASH)
		($setg Score ($plus @Score 50))
		($sfus me Lifter 4)
		($exit 1)
	 ELSEIF	($eq @Verb take) THEN
		{ Can't	take the button	}
		($setg Skip TRUE)
	)
;


SimpleRobot = "I am just a simple robot";
robot( LDESC ) = ($say "There is a robot here.n");
robot( SDESC ) = ($say "a robot");
robot( ACTION )	=
	(IF (Myself) THEN
		{ I'm doing something with the robot }
		(IF ($eq @Verb tell) THEN
			(IF ($prop robot BROKEN) THEN
				($say "There is	no response.n")
				($exit 1)
			)
		 ELSEIF	($eq @Verb take) THEN
			($say "The robot weighs	at least 500 pounds!n")
			($exit 1)
		)
	 ELSEIF	($eq ($phase) 2) THEN
		{ This is being	called as the Actor ACTION }
		(ActAction)
		(IF ($and	($ne @Verb push)
				($ne @Verb go)
				($ne @Verb wait)
				($ne @Verb take)
				($or ($lt @Verb	north) ($gt @Verb down)))
		 THEN
			{ The robot has	a VERY simple vocabulary }
			(Sayer SimpleRobot)
			($delact robot)
			($exit 1)
		)
	 ELSEIF	($eq @Verb take) THEN
		{ The robot is trying to take itself }
		(Sayer "Mmmph!	Akkk!!	GGGGRR!!  No can do.  Sorry")
		($setg Skip TRUE)
	 ELSE
		{ The robot is doing something to itself }
		(Sayer SimpleRobot)
		($delact robot)
		($exit 1)
	)
;
robot( SAVESENT	) = RobSave;



{	We break me( ACTION ) out into a named routine because
	StdInit	overwrites that	property and we	need to	restore	it	}

MeAct =
	(IF ($eq ($phase) 2) THEN
		{ This is the Actor ACTION - call standard's actor action }
		(ActAction)
	 ELSEIF	($eq @Verb take) THEN
		(Sayer "I thought you would never ask")
		($setg Skip TRUE)
	)
;


{	We break hatch(	SDESC )	out into a named routine because
	the hatch isn't	visible	until after Lifter has executed		}

HatchSD	= ($say	"an open hatch");
HatchMSG = "The	hatch doesn't budge";
hatch( ACTION )	=
	(IF ($eq @Verb take) THEN
		{ Can't	take the hatch }
		(Sayer HatchMSG)
		($setg Skip TRUE)
	 ELSEIF	($or ($eq @Verb	open) ($eq @Verb push))	THEN
		{ Can't	open or	push it, either	}
		(Sayer HatchMSG)
		($exit 1)
	)
;
hatch( OPENS ) = TRUE;
hatch( NOTAKE )	= TRUE;


door( SDESC ) =	($say "a door");
door( ACTION ) =
	(IF ($eq @Verb take) THEN
		($say "You can't take a	door!n")
		($setg Skip TRUE)
	)
;
door( OPENS ) =	TRUE;


{	Transition routines.  Note that	RobMov is used in $miss.
	This produces the 'The robot exits to the <direction>
	messages.  The calls to	RobEntr	produce	the messages like
	'The robot enters from the <direction>.		}

Bluerm(	ACTION ) =
	($miss RobMov NoGo NoGo	NoGo NoGo TrapCk 0 0 0 0)
	($hit .ME Redrm	0 0 0 0	Cellar 0 0 0 0)
	(RobEntr)
;


Redrm( ACTION )	=
	($miss NoGo BlueCk RobMov NoGo NoGo NoGo 0 0 0 0)
	($hit .ME 0 Bluerm Greenrm 0 0 0 0 0 0 0)
	(RobEntr)
;


Greenrm( ACTION	) =
	($miss NoGo NoGo NoGo RobMov NoGo NoGo 0 0 0 0)
	($hit .ME 0 0 0	Redrm 0	0 0 0 0	0)
	(RobEntr)
;


Cellar(	ACTION ) =
	($miss DoorCk NoGo NoGo	NoGo BlueCk NoGo 0 0 0 0)
	($hit .ME Endrm	0 0 0 Bluerm 0 0 0 0 0)
	(RobEntr)
;


{ Routines }

{ (Myself) - returns 1 if "me" is the current actor; 0 otherwise }
Myself =
	($return ($eq .ME me))
;


{	(Sayer str) - Says a string with appropriate quoting, depending
	on whether the robot or	the player is doing the	saying.		}
Sayer =
	(IF (Myself) THEN
		($say %1 ".n")
	 ELSEIF	($eq ($loc robot) ($loc	me)) THEN
		($say """ %1 ", Boss."n")
	 ELSE
		($say "You hear	a muffled voice	in the distance.n")
	)
;


{	(NoGo) - "You can't go that way"	}
NoGo =
	(Sayer "You can't go that way")
	($exit 1)
;


{	(Header	str arg0) - To accomplish the printing of header lines,
	each location SDESC need to return a string if a parameter is
	passed to it.  By doing	($return (Header <sdesc> %0)), we can
	centralize the saying/returning	decision.	}
Header =
	(IF ($not %2) THEN
		($say %1 ".n")
	)
	($return %1)
;


RobMov =
	(IF ($and ($not	(Myself)) ($eq ($loc robot) ($loc me)))	THEN
		($say
			"The robot exits to the	"
			(IF ($eq @Verb e) THEN
				($val "east")
			 ELSEIF	($eq @Verb w) THEN
				($val "west")
			 ELSEIF	($eq @Verb s) THEN
				($val "south")
			 { The robot can't be seen leaving to the north	}
			)
			".n"
		)
	)
;


RobEntr	=
	(IF ($and ($not	(Myself)) ($eq ($loc robot ) ($loc me))) THEN
		($say
			(IF ($eq @Verb north) THEN
				($val "The robot enters	from the south.n")
			 ELSEIF	($eq @Verb east) THEN
				($val "The robot enters	from the west.n")
			 ELSEIF	($eq @Verb west) THEN
				($val "The robot enters	from the east.n")
			 { The robot can't enter from the north	in
			   this	scenario }
			)
		)
	)
;


DoorCk =
	(IF ($not ($prop door OPENED)) THEN
		($say "The door	seems to be closed.n")
		($exit 1)
	)
;


TrapCk =
	(IF ($ne ($prop	button BSTATE) B_LIT) THEN
		(NoGo)
	)
;


{	(BlueCk) - make	sure that only one actor is in the blue	room
	at one time.	}
BlueCk =
	(IF ($or ($eq ($loc me)	Bluerm)	($eq ($loc robot) Bluerm)) THEN
		(IF (Myself) THEN
			($say
"The room is too small for both	you and	the robot to fit.n"
			)
		)
		($exit 1)
	 ELSEIF	($and ($not (Myself)) ($eq ($prop button BSTATE) B_LIT)) THEN
		(RobMov)
		($say "You hear	a loud CRASH! in the distance.n")
		($setg Score ($minus @Score 10))
		($setp robot BROKEN TRUE)
		($move robot Bluerm)
		($delact robot)
		($exit 1)
	)
	(RobMov)
;


{	(Die) -	kill off the player	}
Die =
	($setg Score ($minus @Score 50))
	(Skore)
	($say "Do you wish to restart the game?	")
	(IF ($yorn) THEN
		($spec 2)
	 ELSE
		($spec 3)
	)
;


{	(Lifter) - Lift	the hatch, possibly killing the	robot or
	the player	}
Lifter =
	(IF ($eq ($loc me) Bluerm) THEN
		($say
"All of	a sudden, the floor lifts up, and you are crushed between it
and the	wall!  "
		)
		(Die)
	 ELSE
		($say "In the distance,	you hear a loud	CRASH!n")
		(IF ($eq ($loc robot) Bluerm) THEN
			($setg Score ($minus @Score 10))
			($setp robot BROKEN TRUE)
			($delact robot)
		)
	)
	($setp hatch SDESC HatchSD)
	($setp button BSTATE B_LIT)
	($setp Bluerm SEEN FALSE)
;


{	Prompt - print the status line and a prompt	}
PROMPT =
	($spec 9 (($sdesc ($loc	.ME)) 1) @Score	($turns))
	($say "> ")
;


{	Increment - increment the turn counter	}
INCREMENT =
	(IF (Myself) THEN
		{ We only want to increment once per turn }
		($incturn)
	 ELSE
		{ We don't want	Looker executing for the robot }
		($exit 0)
	)
;


{	(Skore)	- print	out the	current	score.	}
Skore =
	($say	"You have scored " ($str @Score)
		" out of a possible 100	in " ($str ($turns)) " moves.n")
;


{	Dwimming routines	}
DWIMI =	(Dwimmer %1);
DWIMD =	(Dwimmer %1);

START =
	($spec MARGIN 69)	{ Set the screen to 69 wide }
	($sdem INCREMENT)	{ Turn counter increment }
	(StdInit me)		{ Initialize standard }
	($setp me ACTION MeAct)	{ Restore me( ACTION ) }
	($setv n s e w u d 0 0 0 0)	{ Use our own transition vector	}
	($prompt PROMPT)	{ and our own prompter }
	($setg Indent TRUE)	{ Indent the object descriptions }
;

{*** EOF actdemo.adl ***}