INCLUDE "stdproc.adl"; /* Include the standard package */
/* The following are Object properties */
BITPROP
BROKEN, /* Is the robot damaged? */
TOLD; /* Have I told the robot something? */
PROPERTY
BSTATE; /* 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, MyDie, 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 ) = Proc()
{
"You are in a large room which is illuminated by a bright ",
"red glow. Exits lie to the east and south.\n";
}
Redrm( SDESC ) = Proc() {Return Header("Red room", $arg(0));}
Redrm( LIGHT ) = TRUE;
Greenrm( LDESC ) = Proc()
{
"You are in a smallish room which is illuminated by a pleasant ",
"green glow. The only exit is to the west.\n";
}
Greenrm( SDESC ) = Proc() {Return Header("Green room", $arg(0));}
Greenrm( LIGHT ) = TRUE;
Bluerm( LDESC ) = Proc()
{
"You are in a tiny room which is barely illuminated by a ";
"dim blue glow. There is an exit to the north,";
If (button.BSTATE == B_LIT) {
" 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 {
" and you seem to make out something on the floor.";
If (button.BSTATE)
" A button on the wall is flashing urgently.";
Else
" There is a button on the wall.";
}
" Above the button is a sign that reads:\n\n",
" DANGER!\n\n",
" HIGH VOLTAGE!\n\n";
}
Bluerm( SDESC ) = Proc()
{
If ($arg(0)) Return "Blue room";
"Blue room.\n";
}
Bluerm( LIGHT ) = TRUE;
Cellar( LDESC ) = Proc()
{
"You are in the cellar. Far above you can be seen a dim blue light.";
If (door.OPENED)
" An open door leads to the north.\n";
Else
" You can barely see the outline of a door to the north.\n";
}
Cellar( SDESC ) = Proc() { Return Header("Cellar", $arg(0)); }
Cellar( LIGHT ) = TRUE;
Endrm( LDESC ) = Proc()
{
"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";
Score = Score + 25;
Skore();
$spec(QUIT);
}
Endrm( LIGHT ) = TRUE;
/* Verbs */
VERB
score,
push,
shout;
tell = TELLER;
say = tell;
press = push;
feel = touch;
yell = shout;
/* Verb routines */
tell( PREACT ) = Proc()
{
If (Iobj != robot) {
/* The only logical thing to talk to is the robot */
Sayer
("Talking to yourself is said to be a sign of impending insanity");
}
Else If (Dobj >= 0) {
/* You must say strings */
Sayer("You must put what you want to say in quotes");
}
Else If ($loc(robot) != $loc(me)) {
/* The robot must be in the same place as the player */
If (Myself()) "You don't see the robot here.\n";
}
Else {
/* Everything is OK. Add 25 points to the score */
If (!robot.TOLD) {
Score = Score + 25;
robot.TOLD = TRUE;
}
$exit(0);
}
$exit(1);
}
tell( ACTION ) = Proc()
{
/* Tell the player that we heard him */
"\"Sure thing, Boss.\"\n";
/* Delete the old action */
$delact(robot);
/* Add the new action - a non-interactive actor */
$actor(robot, Dobj, FALSE);
}
shout( PREACT ) = Proc()
{
If (Iobj & (Iobj != robot)) {
/* Shouting at things other than the robot */
"AAARRRGGGHHH!\n";
}
Else If (Dobj >= 0) {
/* Shouting things other than strings */
"EEEYYYAAAHHH!\n";
}
Else If (robot.BROKEN) {
"There is no response.\n";
}
Else {
/* Shouting at the robot - same as telling the robot */
If (!robot.TOLD) {
Score = Score + 25;
robot.TOLD = TRUE;
}
$exit(0);
}
$exit(1);
}
shout( ACTION ) = Proc()
{
/* Tell the player we heard them */
If ($loc(robot) != $loc(me)) "In the distance you hear the words, ";
"\"Sure thing, Boss\"\n";
/* Delete the old robot action */
$delact(robot);
/* Add the new robot action */
$actor(robot, Dobj, FALSE);
}
push( PREACT ) = Proc()
{
/* Expect a plain direct object */
Expect(ONE_OBJ|PLAIN_OBJ, NO_OBJ);
CheckAvail();
}
push( ACTION ) = Proc()
{
Sayer("That doesn't seem to do anything");
$exit(1);
}
score(PREACT) = Proc()
{
/* Score can accept no objects */
Expect(NO_OBJ, NO_OBJ);
Skore();
$exit(1);
}
/* Object properties */
button( SDESC ) = Proc()
{
IF (button.BSTATE == B_OFF)
"a button";
Else If (button.BSTATE == B_FLASH)
"an urgently flashing button";
Else
"a brightly lit button";
}
button( ACTION ) = Proc()
{
If (Myself() & ((Verb == push)|(Verb == take)|(Verb == touch))) {
/* The player tried to do something with the button */
"As you reach for the button, a 10,000,000 volt bolt of lightning ";
"arcs toward your finger, disintegrating you upon impact.\n";
MyDie();
}
Else If ((Verb == push) & (button.BSTATE == B_OFF)) {
/* The robot pushed the button */
button.BSTATE = B_FLASH;
Score = Score + 50;
$sfus(me, Lifter, 4);
$exit(1);
}
Else If (Verb == take) {
/* Can't take the button */
Skip = TRUE;
}
}
SimpleRobot = "I am just a simple robot";
robot( LDESC ) = Proc() {"There is a robot here.\n";}
robot( SDESC ) = Proc() {"a robot";}
robot( ACTION ) = Proc()
{
If (Myself()) {
/* I'm doing something with the robot */
If (Verb == tell) {
If (robot.BROKEN) {
"There is no response.\n";
$exit(1);
}
}
Else If (Verb == take) {
"The robot weighs at least 500 pounds!\n";
$exit(1);
}
}
Else If ($phase() == 2) {
/* This is being called as the Actor ACTION */
ActAction();
If ( (Verb != push) & (Verb != go) &
(Verb != wait) & (Verb != take) &
((Verb < north) | (Verb > down)))
{
/* The robot has a VERY simple vocabulary */
Sayer(SimpleRobot);
$delact(robot);
$exit(1);
}
}
Else If (Verb == take) {
/* The robot is trying to take itself */
Sayer("Mmmph! Akkk!! GGGGRR!! No can do. Sorry");
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 = Proc()
{
If ($phase() == 2) {
/* This is the Actor ACTION - call standard's actor action */
ActAction();
}
Else If (Verb == take) {
Sayer("I thought you would never ask");
Skip = TRUE;
}
}
/* We break hatch( SDESC ) out into a named routine because
the hatch isn't visible until after Lifter has executed */
HatchSD = Proc() {"an open hatch";}
HatchMSG = "The hatch doesn't budge";
hatch( ACTION ) = Proc()
{
If (Verb == take) {
/* Can't take the hatch */
Sayer(HatchMSG);
Skip = TRUE;
}
Else If ((Verb == open) | (Verb == push)) {
/* Can't open or push it, either */
Sayer(HatchMSG);
$exit(1);
}
}
hatch( OPENS ) = TRUE;
hatch( NOTAKE ) = TRUE;
door( SDESC ) = Proc() {"a door";}
door( ACTION ) = Proc()
{
If (Verb == take) {
"You can't take a door!\n";
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 ) = Proc()
{
$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 ) = Proc()
{
$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 ) = Proc()
{
$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 ) = Proc()
{
$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 = Proc()
{
Return ($ME == me);
}
/* Sayer(str) - Says a string with appropriate quoting, depending
on whether the robot or the player is doing the saying. */
Sayer = Proc(str)
{
If (Myself()) {
"", str, ".\n";
}
Else If ($loc(robot) == $loc(me)) {
"\"", str, ", Boss.\"\n";
}
Else {
"You hear a muffled voice in the distance.\n";
}
}
/* NoGo() - "You can't go that way" */
NoGo = Proc()
{
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 = Proc(str, arg0)
{
If (!arg0) {
$say(str, ".\n");
}
Return str;
}
RobMov = Proc()
{
If (!Myself() & ($loc(robot) == $loc(me))) {
"The robot exits to the ";
If (Verb == e)
"east";
Else If (Verb == w)
"west";
Else If (Verb == s)
"south";
/* The robot can't be seen leaving to the north */
".\n";
}
}
RobEntr = Proc()
{
If (!Myself() & ($loc(robot) == $loc(me))) {
If (Verb == north)
"The robot enters from the south.\n";
Else If (Verb == east)
"The robot enters from the west.\n";
Else If (Verb == west)
"The robot enters from the east.\n";
/* The robot can't enter from the north in this scenario */
}
}
DoorCk = Proc()
{
If (!door.OPENED) {
"The door seems to be closed.\n";
$exit(1);
}
}
TrapCk = Proc() { If (button.BSTATE != B_LIT) NoGo(); }
/* BlueCk() - make sure that only one actor is in the blue room
at one time. */
BlueCk = Proc()
{
If (($loc(me) == Bluerm) | ($loc(robot) == Bluerm)) {
If (Myself())
"The room is too small for both you and the robot to fit.\n";
$exit(1);
}
Else If (!Myself() & (button.BSTATE == B_LIT)) {
RobMov();
"You hear a loud CRASH! in the distance.\n";
Score = Score - 10;
robot.BROKEN = TRUE;
$move(robot, Bluerm);
$delact(robot);
$exit(1);
}
RobMov();
}
/* MyDie() - kill off the player */
MyDie = Proc()
{
Score = Score - 50;
Skore();
Die();
}
/* Lifter() - Lift the hatch, possibly killing the robot or
the player */
Lifter = Proc()
{
IF ($loc(me) == Bluerm) {
"All of a sudden, the floor lifts up, and you are crushed between it ",
"and the wall! ";
MyDie();
}
Else {
"In the distance, you hear a loud CRASH!\n";
If ($loc(robot) == Bluerm) {
Score = Score - 10;
robot.BROKEN = TRUE;
$delact(robot);
}
}
hatch.SDESC = HatchSD;
button.BSTATE = B_LIT;
Bluerm.SEEN = FALSE;
}
/* Prompt - print the status line and a prompt */
PROMPT = Proc()
{
$spec(HEADER, $sdesc($loc($ME))(1), Score, $turns());
"> ";
}
/* Increment - increment the turn counter */
INCREMENT = Proc()
{
If (Myself()) {
/* 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 = Proc()
{
"You have scored ", $str(Score),
" out of a possible 100 in ", $str($turns()), " moves.\n";
}
/* Dwimming routines */
DWIMI = Proc() {Dwimmer($arg(1));}
DWIMD = Proc() {Dwimmer($arg(1));}
START = Proc()
{
$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 ****/