⟦ad44ae862⟧

TextFile

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:\n\n"
"		DANGER!\n\n"
"	     HIGH VOLTAGE!\n\n"
	)
;
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 ***}
DataMuseum.dk

DKUUG/EUUG Conference tapes

⟦ad44ae862⟧ TextFile

Derivation

TextFile
