home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
rtsi.com
/
2014.01.www.rtsi.com.tar
/
www.rtsi.com
/
OS9
/
OSK
/
EFFO
/
forum3.lzh
/
SAMPLES
/
DEMOS
/
multi.adl
< prev
next >
Wrap
Text File
|
1987-09-25
|
10KB
|
418 lines
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 *** }