ADL Scenario Source Code

    PROPERTY
    	OLDLOC,		{ Previous location of an actor }
    	MYNAME;		{ Name of an actor }

    VAR
        DoTTY,		{ Should we do the $spec 11 and $spec 12 stuff? }
        NumAct,		{ Number of active actors }
        InitAct[ 5 ],	{ Initial array of actors }
        Rooms[ 4 ],		{ Initial array of rooms }
        Actors[ 5 ];	{ List of active actors }

    (DoTTY)=1;

    VERB
        north, south, east, west,
        northeast, southeast, northwest, southwest,
        up, down, quit, take, drop;

    n = north;
    s = south;
    e = east;
    w = west;
    ne = northeast;
    se = southeast;
    nw = northwest;
    sw = southwest;
    u = up;
    d = down;

    ROUTINE
        Transit, EnterDir, LeaveDir,
        Looker, Prompter, SetActor,
        Tell, Broadcast, ActAction,
        ActLdesc, CG;

    ARTICLE
        the, a, an;

    { Locations in the dungeon }

    NOUN
        room1, room2, room3, room4;

    (Rooms+0) = room1;
    (Rooms+1) = room2;
    (Rooms+2) = room3;
    (Rooms+3) = room4;

    { Actors in the dungeon }
    NOUN
        actor1,
        actor2,
        actor3,
        actor4,
        actor5;

    (InitAct + 0) = actor1;
    (InitAct + 1) = actor2;
    (InitAct + 2) = actor3;
    (InitAct + 3) = actor4;
    (InitAct + 4) = actor5;

    { Objects in the dungeon }
    NOUN
        foo( room1 ),
        bar( room2 ),
        bletch( room3 ),
        ack( room4 );

    { Location properties }

    room1( LDESC ) = ($say "Room 1.  Exits to the east and south.\n");
    room1( ACTION ) =
        ($hit .ME	0  room3 room2 0  0  0  0  0  0  0)
        ($miss	CG 0     0     CG CG CG CG CG CG CG)
        (Transit @Verb)
    ;

    room2( LDESC ) = ($say "Room 2.  Exits to the west and south.\n");
    room2( ACTION ) =
        ($hit .ME	0  room4 0  room1 0  0  0  0  0  0)
        ($miss	CG 0     CG 0     CG CG CG CG CG CG)
        (Transit @Verb)
    ;

    room3( LDESC ) = ($say "Room 3.  Exits to the east and north.\n");
    room3( ACTION ) =
        ($hit .ME	room1 0  room4 0  0  0  0  0  0  0)
        ($miss	0     CG 0     CG CG CG CG CG CG CG)
        (Transit @Verb)
    ;

    room4( LDESC ) = ($say "Room 4.  Exits to the west and north.\n");
    room4( ACTION ) =
        ($hit .ME	room2 0  0  room3 0  0  0  0  0  0)
        ($miss	0     CG CG 0     CG CG CG CG CG CG)
        (Transit @Verb)
    ;

    { Object properties }

    foo( LDESC ) = ($say "There is a foo here.\n");
    bar( LDESC ) = ($say "There is a bar here.\n");
    bletch( LDESC ) = ($say "There is a bletch here.\n");
    ack( LDESC ) = ($say "There is an ack here.\n");

    { Verb properties }

    take( PREACT ) =
        (IF ($or ($ne @Iobj 0) ($lt @Dobj 0)) THEN
    	($say "I don't understand that.\n")
    	($exit 1)
         ELSEIF ($eq @Dobj 0) THEN
    	($say "You must tell me what to take!\n")
    	($exit 1)
         ELSEIF ($ne ($loc @Dobj) ($loc .ME)) THEN
    	($say "You don't see that here.\n")
    	($exit 1)
         ELSEIF ($ne ($prop @Dobj MYNAME) 0) THEN
    	($say "You can't take " ($prop @Dobj MYNAME) "!\n")
    	($exit 1)
        )
    ;
    take( ACTION ) =
        ($say ($name @Dobj) " - taken\n")
        (Broadcast ($prop .ME MYNAME) " takes the " ($name @Dobj) "\n")
        ($move @Dobj .ME)
    ;

    drop( PREACT ) =
        (IF ($or ($ne @Iobj 0) ($lt @Dobj 0)) THEN
    	($say "I don't understand that.\n")
    	($exit 1)
         ELSEIF ($eq @Dobj 0) THEN
    	($say "You must tell me what to drop!\n")
    	($exit 1)
         ELSEIF ($ne ($loc @Dobj) .ME) THEN
    	($say "You don't have that.\n")
    	($exit 1)
        )
    ;
    drop( ACTION ) =
        ($say ($name @Dobj) " - dropped\n")
        (Broadcast ($prop .ME MYNAME) " drops the " ($name @Dobj) "\n")
        ($move @Dobj ($loc .ME))
    ;

    quit( PREACT ) =
    LOCAL i, obj1, obj2;
        (Broadcast ($prop .ME MYNAME) " disappears in a puff of smoke!\n")
        ($setg obj1 ($cont .ME))
        (WHILE @obj1 DO
    	($setg obj2 ($link @obj1))
    	($move @obj1 .ALL)
    	($setg obj1 @obj2)
        )
        ($setg i 0)
        ($setg obj1 ($global ($plus Actors @i)))
        (WHILE ($ne @obj1 .ME) DO
    	($setg i ($plus @i 1))
    	($setg obj1 ($global ($plus @Actors @i)))
        )
        ($setg NumAct ($minus @NumAct 1))
        (IF ($le @NumAct 0) THEN
    	($say "Goodbye!\n")
    	($spec 3)
        )
        (WHILE ($lt @i @NumAct) DO
    	($setg ($plus Actors @i) ($global ($plus Actors ($plus @i 1))))
    	($setg i ($plus @i 1))
        )
        ($move .ME .ALL)
        ($delact .ME)
        ($exit 1)
    ;

    { Utility routines }

    Prompter =
        ($say "\n" ($prop .ME MYNAME) ": ")
    ;

    CG = ($say "You can't go that way.\n") ($exit 1);

    EnterDir =
        (IF ($eq %1 north) THEN
    	($val " from the south")
         ELSEIF ($eq %1 south) THEN
    	($val " from the north")
         ELSEIF ($eq %1 east) THEN
    	($val " from the west")
         ELSEIF ($eq %1 west) THEN
    	($val " from the east")
         ELSEIF ($eq %1 northeast) THEN
    	($val " from the southwest")
         ELSEIF ($eq %1 southeast) THEN
    	($val " from the northwest")
         ELSEIF ($eq %1 northwest) THEN
    	($val " from the southeast")
         ELSEIF ($eq %1 southwest) THEN
    	($val " from the northeast")
         ELSEIF ($eq %1 up) THEN
    	($val " from below")
         ELSEIF ($eq %1 down) THEN
    	($val " from above")
         ELSE
    	($val "")
        )
    ;

    LeaveDir =
        (IF ($eq %1 north) THEN
    	($val " to the north")
         ELSEIF ($eq %1 south) THEN
    	($val " to the south")
         ELSEIF ($eq %1 east) THEN
    	($val " to the east")
         ELSEIF ($eq %1 west) THEN
    	($val " to the west")
         ELSEIF ($eq %1 northeast) THEN
    	($val " to the northeast")
         ELSEIF ($eq %1 southeast) THEN
    	($val " to the southeast")
         ELSEIF ($eq %1 northwest) THEN
    	($val " to the northwest")
         ELSEIF ($eq %1 southwest) THEN
    	($val " to the southwest")
         ELSEIF ($eq %1 up) THEN
    	($val ", going up")
         ELSEIF ($eq %1 down) THEN
    	($val ", going down")
         ELSE
    	($val "")
        )
    ;

    ActLdesc =
        ($say ($prop %1 MYNAME) " is here.\n")
    ;

    ActAction =
        ($setp .ME OLDLOC ($loc .ME))
        { Other stuff, as appropriate }
    ;

    Looker =
    LOCAL obj;
        { Pretty standard stuff, nothing unusual.  Note that
          the TTY is set up by ADL, not by this program }
        ($say "\n" ($prop .ME MYNAME) " sees:\n")
        ( ($ldesc ($loc .ME)) )
        ($setg obj ($cont ($loc .ME)))
        (WHILE @obj DO
    	(IF ($ne @obj .ME) THEN
    	    ( ($ldesc @obj) @obj )
    	)
    	($setg obj ($link @obj))
        )
    ;

    { (SetActor "name" actor loc tty) Sets up an actor with a tty }
    SetActor =
        ($actor %2 0 1)
        ($move %2 %3)
        ($setp %2 OLDLOC %3)
        ($setp %2 LDESC ActLdesc)
        ($setp %2 ACTION ActAction)
        ($setp %2 MYNAME
    	($savestr
    	    ($cat
    		($chr ($minus ($ord %1) 32))
    		($subs %1 1 0)
    	    )
    	)
        )
        { Initialize this actor's TTY }
        (IF ($and ($ne ($leng %4) 0) @DoTTY) THEN ($spec 11 %2 %4))
        ($setg ($plus Actors @NumAct) %2)
        ($setg NumAct ($plus @NumAct 1))
    ;

    { (Tell foo msg1 msg ... ) - prints msg on foo's tty }
    Tell =
    LOCAL i;
        (IF @DoTTY THEN ($spec 12 %1))
        ($say ($prop %1 MYNAME) ": ")
        ($setg i 2)
        (WHILE ($le @i %0) DO
    	($say ($arg @i))
    	($setg i ($plus @i 1))
        )
        (IF @DoTTY THEN ($spec 12 .ME))
    ;

    { (Broadcast msg msg ... ) - prints messages to everybody where I am }
    Broadcast =
    LOCAL i, j, him;
        { Check those actors who have already acted }
        ($setg i ($minus @NumAct 1))
        ($setg him ($global ($plus Actors @i)))
        (WHILE ($ne @him .ME) DO
    	(IF ($and	($eq ($loc @him) ($loc .ME))
    			($eq ($prop @him OLDLOC) ($loc .ME)) )
    	 THEN
    	    { He was and still is in the room }
    	    (IF @DoTTY THEN ($spec 12 @him))
    	    ($say ($prop @him MYNAME) ": ")
    	    ($setg j 1)
    	    (WHILE ($le @j %0) DO
    		($say ($arg @j))
    		($setg j ($plus @j 1))
    	    )
    	)
    	($setg i ($minus @i 1))
    	($setg him ($global ($plus Actors @i)))
        )

        { Check the rest of the actors }
        ($setg i ($minus @i 1))
        (WHILE ($ge @i 0) DO
    	($setg him ($global ($plus Actors @i)))
    	(IF ($eq ($loc @him) ($loc .ME)) THEN
    	    { He is in the room with me }
    	    (IF @DoTTY THEN ($spec 12 @him))
    	    ($say ($prop @him MYNAME) ": ")
    	    ($setg j 1)
    	    (WHILE ($le @j %0) DO
    		($say ($arg @j))
    		($setg j ($plus @j 1))
    	    )
    	)
    	($setg i ($minus @i 1))
        )
        (IF @DoTTY THEN ($spec 12 .ME))
    ;

    { Transit - a routine to be called in every room ACTION }

    Transit =
    LOCAL
        HisOld,
        MyOld,
        HisNew,
        MyNew,
        MyName,
        Him,
        I;

        ($setg MyOld ($prop .ME OLDLOC))
        ($setg MyNew ($loc .ME))
        ($setg MyName ($prop .ME MYNAME))

        (IF ($eq @MyOld @MyNew) THEN
    	{ I didn't move }
    	($return 0)
        )

        { Examine those actors who have already acted }
        ($setg I ($minus @NumAct 1))
        ($setg Him ($global ($plus Actors @I)))
        (WHILE ($ne @Him .ME) DO
    	($setg HisOld ($prop @Him OLDLOC))
    	($setg HisNew ($loc @Him))
    	(IF	($and	($eq @MyOld @HisOld) ($eq @HisOld @HisNew))	THEN
    	    (Tell @Him @MyName " left" (LeaveDir %1) ".\n")
    	 ELSEIF	($and	($eq @MyOld @HisOld) ($eq @MyNew @HisNew))	THEN
    	    (Tell @Him @MyName " followed you" (EnterDir %1) ".\n")
    	 ELSEIF	($and	($eq @MyOld @HisNew) ($ne @HisOld @HisNew))	THEN
    	    (Tell @Him @MyName " left" (LeaveDir %1) " as you entered.\n")
    	 ELSEIF	($and	($eq @MyNew @HisNew) ($eq @HisOld @HisNew))	THEN
    	    (Tell @Him @MyName " entered" (EnterDir %1) ".\n")
    	 ELSEIF	($and	($eq @MyNew @HisNew) ($ne @HisOld @HisNew)
    			($ne @MyOld @HisOld))
    	 THEN
    	    (Tell @Him @MyName " enters" (EnterDir %1) " as you enter.\n")
    	)
    	($setg I ($minus @I 1))
    	($setg Him ($global ($plus Actors @I)))
        )

        { Examine those actors who haven't already acted }
        ($setg I ($minus @I 1))
        (WHILE ($ge @I 0) DO
    	($setg Him ($global ($plus Actors @I)))
    	($setg HisNew ($loc @Him))
    	(IF	($eq @MyOld @HisNew)	THEN
    	    (Tell @Him @MyName " left" (LeaveDir %1) ".\n")
    	 ELSEIF	($eq @MyNew @HisNew)	THEN
    	    (Tell @Him @MyName " entered" (EnterDir %1) ".\n")
    	)
    	($setg I ($minus @I 1))
        )
    ;

    START =
    LOCAL i, num, name, rnum, actor, tty;
        ($sdem Looker)
        ($prompt Prompter)
        ($setv	north south east west
    		northeast southeast northwest southwest up down )
        ($say "How many actors? (1-5): ")
        ($setg num ($num ($read)))
        (IF ($or ($lt @num 1) ($gt @num 5)) THEN
    	($say "Bad number of actors.\n")
    	($spec 3)
        )
        ($setg i 0)
        (WHILE ($lt @i @num) DO
    	($say "Enter actor " ($str ($plus @i 1)) "'s name (all lowercase): ")
    	($setg name ($read))
    	($setg rnum 0)
    	(WHILE ($or ($lt @rnum 1) ($gt @rnum 4)) DO
    	    ($say "Enter actor's room number (1-4): ")
    	    ($setg rnum ($num ($read)))
    	)
    	(IF @DoTTY THEN
    	    ($say "Enter actor's tty (<cr> if none): ")
    	    ($setg tty ($read))
    	 ELSE
    	    ($setg tty "")
    	)
    	($setg actor ($global ($plus InitAct @i)))
    	($define @name ($name @actor))
    	($setg rnum ($global ($plus Rooms ($minus @rnum 1))))
    	(SetActor @name @actor @rnum @tty)
    	($setg i ($plus @i 1))
        )
    ;

    { *** EOF multi.adl *** }