ADL Scenario Source Code

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