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 ****/
