⟦c407aa10f⟧

TextFile

OLDLOC = 27;		{ Previous location of an actor }
MYNAME = 26;		{ Name of an actor }

VAR
    NumAct,		{ Number of active actors }
    InitAct[ 5 ],	{ Initial array of actors }
    Rooms[ 4 ],		{ Initial array of rooms }
    Actors[ 5 ];	{ List of active actors }

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

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)
	    )
	)
    )
    {$spec 11 %1 %4}
    ($setg ($plus Actors @NumAct) %2)
    ($setg NumAct ($plus @NumAct 1))
;

{ (Tell foo msg1 msg ... ) - prints msg on foo's tty }
Tell =
LOCAL i;
    {$spec 12 %1}
    ($say ($prop %1 MYNAME) ": ")
    ($setg i 2)
    (WHILE ($le @i %0) DO
	($say ($arg @i))
	($setg i ($plus @i 1))
    )
    {$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 }
	    {$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 }
	    {$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))
    )
    {$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)))
	)
	($say "Enter actor's tty (<cr> if none): ")
	($setg tty ($read))
	($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 *** }
DataMuseum.dk

DKUUG/EUUG Conference tapes

⟦c407aa10f⟧ TextFile

Derivation

TextFile
