games-request@tekred.TEK.COM (08/05/87)
Submitted by: cunniff%hpda@hplabs.HP.COM (Ross Cunniff)
Comp.sources.games: Volume 2, Issue 22
Archive-name: adl/Part05
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of archive 5 (of 11)."
# Contents: adlrun/rtdict.c samples/aard/locales.adl
# samples/standard.adl
# Wrapped by billr@tekred on Tue Aug 4 16:27:41 1987
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f adlrun/rtdict.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"adlrun/rtdict.c\"
else
echo shar: Extracting \"adlrun/rtdict.c\" \(4936 characters\)
sed "s/^X//" >adlrun/rtdict.c <<'END_OF_adlrun/rtdict.c'
X#include <stdio.h>
X#include "adltypes.h"
X#include "adlprog.h"
X
Xstruct data { /* Structure of the data in the dictionary */
X int16
X type, val, first;
X};
X
Xstruct letter {
X char
X let_name; /* Name of this letter */
X struct data
X *let_val; /* Value of this token */
X struct letter
X *next, /* Next letter on this level */
X *child; /* Next level */
X};
X
X
Xstatic struct letter
X *trie; /* The dictionary */
X
Xchar
X *malloc();
X
X /***************************************************************\
X * *
X * new_letter( let ) - allocate a new letter for the *
X * trie, initializing the letter to let. *
X * *
X \***************************************************************/
X
Xstatic struct letter *
Xnew_letter( let )
Xchar
X let;
X{
X struct letter
X *temp;
X
X temp = (struct letter *)malloc( sizeof( struct letter ) );
X if( temp == (struct letter *)0 )
X error( 27 ); /* Out of memory */
X temp->let_name = let;
X temp->let_val = (struct data *)0;
X temp->next = temp->child = (struct letter *)0;
X return temp;
X}
X
X
Xinsertkey( name, type, val, first )
Xchar
X *name;
Xint16
X type, val, first;
X{
X struct letter
X **t,
X *temp;
X int16
X done = 0,
X retval;
X
X t = ≜
X while( !done ) {
X temp = *t;
X
X /* Find the first letter in the name */
X while( (temp != (struct letter *)0) && (temp->let_name != *name) )
X temp = temp->next;
X
X if( temp == (struct letter *)0 ) {
X /* This letter wasn't in the trie, so put it there. */
X temp = new_letter( *name );
X temp->next = *t;
X *t = temp;
X }
X
X if( name[ 1 ] == '\0' ) {
X /* We are at the end of the string. Insert it */
X if( temp->let_val != (struct data *)0 )
X /* This name already defined. */
X retval = 0;
X else {
X temp->let_val = (struct data *)malloc( sizeof( struct data ) );
X if( temp->let_val == (struct data *)0 )
X error( 27 ); /* Out of memory */
X temp->let_val->type = type;
X temp->let_val->val = val;
X temp->let_val->first = first;
X retval = 1;
X }
X done = 1;
X }
X else {
X /* We have more letters to go. Recursively insert them. */
X name++;
X t = &temp->child;
X }
X }
X return retval;
X}
X
X
Xint16
Xlookup( name, val )
Xchar
X *name;
Xint16
X *val;
X{
X int16
X retval,
X done = 0;
X struct letter
X *t;
X
X name[ LENGTH ] = '\0'; /* Trim the name */
X t = trie;
X while( !done ) {
X /* Find the first letter in the name */
X while( (t != (struct letter *)0) && (t->let_name != *name) )
X t = t->next;
X
X if( t == (struct letter *)0 ) {
X /* This letter wasn't in the trie. Return failure. */
X retval = -1;
X done = 1;
X }
X else if( name[ 1 ] == '\0' ) {
X /* We are at the end of the string. See if we have data. */
X if( t->let_val != (struct data *)0 ) {
X *val = t->let_val->val;
X retval = t->let_val->type;
X done = 1;
X }
X else {
X /* No data. Check for abbreviation. */
X for( t = t->child; !done; t = t->child ) {
X if( t == (struct letter *)0 ) {
X /* We should never get here, but... */
X retval = -2;
X done = 1;
X }
X else if( t->next != (struct letter *)0 ) {
X /* There are other strings beginning with s */
X retval = -2;
X done = 1;
X }
X else if( t->let_val != (struct data *)0 ) {
X /* There is data. See if there is more string. */
X if( t->child != (struct letter *)0 ) {
X /* Whoops - this is a substring. */
X retval = -2;
X done = 1;
X }
X else {
X /* Aha! An abbreviation! */
X *val = t->let_val->val;
X retval = t->let_val->type;
X done = 1;
X }
X }
X }
X }
X }
X else {
X /* We have more letters to go. Recursively check them */
X name++;
X t = t->child;
X }
X }
X return retval;
X}
X
X
Xstatic
Xsearch_dict( t, s, proc )
Xstruct letter
X *t;
Xchar
X *s;
Xint
X (*proc)();
X{
X int16
X len;
X
X len = strlen( s );
X while( t != (struct letter *)0 ) {
X s[ len ] = t->let_name;
X s[ len + 1 ] = '\0';
X if( t->let_val != (struct data *)0 )
X if( (*proc)( s, t->let_val ) != 0 )
X return 1;
X if( search_dict( t->child, s, proc ) != 0 )
X return 1;
X t = t->next;
X }
X return 0;
X}
X
X
Xstatic int16
X find_type,
X find_val;
X
Xstatic int
Xfinder( name, dat )
Xchar
X *name;
Xstruct data
X *dat;
X{
X if( (dat->type == find_type) && (dat->val == find_val) && dat->first )
X return 1;
X else
X return 0;
X}
X
X
Xchar *
Xfindone( type, val )
Xint16
X type,
X val;
X{
X static char
X buff[ 80 ];
X
X find_type = type; find_val = val;
X buff[ 0 ] = 0;
X if( !search_dict( trie, buff, finder ) )
X buff[ 0 ] = 0;
X return buff;
X}
X
X
Xread_symtab( fd, dir )
Xint
X fd;
Xstruct adldir
X *dir;
X{
X int
X i, j;
X struct symbol
X symb;
X
X lseek( fd, dir->ptr, 0 );
X for( i = 0; i < NUMSYM; i++ ) {
X read( fd, &symb, sizeof( struct symbol ) );
X for( j = 0; j < strlen( symb.name ); j++ )
X symb.name[ j ] ^= CODE_CHAR;
X insertkey( symb.name, symb.type, symb.val, symb.first );
X }
X}
X
X/*** EOF rtdict.c ***/
END_OF_adlrun/rtdict.c
if test 4936 -ne `wc -c <adlrun/rtdict.c`; then
echo shar: \"adlrun/rtdict.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f samples/aard/locales.adl -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"samples/aard/locales.adl\"
else
echo shar: Extracting \"samples/aard/locales.adl\" \(20706 characters\)
sed "s/^X//" >samples/aard/locales.adl <<'END_OF_samples/aard/locales.adl'
X{*** ROOM DESCRIPTIONS ***}
XSayer =
X (IF ($not %2) THEN
X ($say %1 "\n")
X )
X ($return %1)
X;
XDARK_STR = "Dark";
X
Xmrm1(LDESC) =
X ($say
X"You are standing outside the north entrance of a large
Xbrick building. Inscribed above the doorway, appear the
Xtext: 'AARDVARK'S MUSEUM -- GATEWAY TO ADVENTURELAND'.\n"
X )
X;
Xmrm1(SDESC) =
X ($return (Sayer "Museum entrance" %0))
X;
X
X
Xmrm2(LDESC) =
X ($say
X"You are in a large rotunda of an old museum. Doors lead
Xto the north, south, east, and west, and a narrow stairway
Xin the north-east corner of the room leads down.\n"
X )
X;
Xmrm2(SDESC) =
X ($return (Sayer "Museum rotunda" %0))
X;
X
X
Xmrm3(LDESC) =
X ($say
X"You are in a dimly lit room containing an empty display case.
XA portion of a vandalized sign above the case reads:
X'ARTIFACTS OF ANCIENT INDIA -- Several of these items,
Xincluding the sacred rhinoceros horn, the deadly ...'.
XThe rest of the sign is unreadable. "
X )
X (IF ($prop paper signed) THEN
X ($say
X"Through the door to the west, you can see part of the rotunda
Xof the museum. To the east, there is a stone archway.\n")
X ELSE
X ($say
X"To the west, you can look through a large door into the rotunda
Xof the museum. On the east wall of the hall there is an outline
Xof an arch.\n"
X )
X )
X;
Xmrm3(SDESC) =
X ($return (Sayer "East wing of the museum" %0))
X;
X
X
Xmrm4(LDESC) =
X ($say
X"You are in a non-descript room with absolutely
Xnothing in it. A hollow voice says ''This room is unavailable for use at this
Xtime. Please leave through the doorway to your north.''\n"
X )
X;
Xmrm4(SDESC) =
X ($return (Sayer "Closed room" %0))
X;
X
X
Xmrm5(LDESC) =
X ($say
X"You are standing before a large empty display case in a poorly
Xlit basement-like room. Encircling the room high on the walls appear the text
X''HALL OF PREHISTORY.'' A stairway leads up, and in the south wall, there is
Xa small hole"
X )
X ($move hole ($loc .ME))
X (IF ($not ($prop paper signed)) THEN
X ($say " covered by a grate.\n")
X ELSE
X ($say ".\n")
X )
X;
Xmrm5(SDESC) =
X ($move hole ($loc .ME))
X ($return (Sayer "Hall of Prehistory" %0))
X;
X
X
Xmrm6(LDESC) =
X ($say
X"You are wandering through a dense forest past twisted birch trees
Xrising toward the sky in contorted agony. Enormous skeletons of burned
Xout sycamores are scattered throughout the area, and gnarled stumps of"
X" once proud oak trees make the appearance of the forest even more
Xdisturbing. Nothing is stirring, a pall of death seems to hang over the
Xforest like a blanket, and you can't seem to figure out which direction"
X" is which.\n"
X )
X;
Xmrm6(SDESC) =
X ($return (Sayer "You are lost in the forest" %0))
X;
X
X
Xirm1(LDESC) =
X ($say
X"You are at the top of a highly ornate spiral stairway.
XA wing of the museum can be seen to the west. The room is moist
Xand damp, and the scent of cumin and saffron fills the air.\n"
X )
X;
Xirm1(SDESC) =
X ($return (Sayer "Top of spiral stairway" %0))
X;
X
X
Xirm2(LDESC) =
X ($say
X"You are in an east-west passage at the bottom of
Xa spiral stairway. A slight breeze blows from east to west.\n"
X )
X;
Xirm2(SDESC) =
X ($return (Sayer "Bottom of spiral stairway" %0))
X;
X
X
Xirm3(LDESC) =
X ($say
X"You are standing in a deserted Indian marketplace.
XAlthough it seems to have once been a bustling area,
Xthere is very little left here. Most of the vacant
Xbooths form an alley running north, and a small path
Xgoes east.\n"
X )
X;
Xirm3(SDESC) =
X ($return (Sayer "Marketplace" %0))
X;
X
X
Xirm4(LDESC) =
X ($say
X"You are in a small kitchen adjoining the marketplace.
XMost of the furniture in the room has been broken, and all
Xof the pottery once used for cooking has been stolen. In the
Xnorth-west corner, there is a tandoori oven. A door to the
Xsouth leads back out to the marketplace, and a trap-door
Xleads down to what appears to be a murky basement.\n"
X )
X;
Xirm4(SDESC) =
X ($return (Sayer "Kitchen" %0))
X;
X
X
Xirm5(LDESC) =
X ($say
X"You are in a cellar which apparently has been used to
Xstore spices. Empty racks line all the walls of the room,
Xand everything in the room seems to be blanketed in a thin
Xlayer of dust. An unreachable hole appears in the ceiling
Xand exits lead to the north, south, and east.\n"
X )
X ($move hole ($loc .ME))
X;
Xirm5(SDESC) =
X ($move hole ($loc .ME))
X ($return (Sayer "Spice cellar" %0))
X;
X
X
Xirm6(LDESC) =
X ($say
X"You are in a small cave-like room apparently once used
Xfor the cultivation of mushrooms. You find the smell of
Xthis room slightly displeasing. There are exits to the
Xsouth and west, and there is a small hole in the
Xnorth wall, through which you can see a long vertical
Xshaft with jagged sides.\n"
X )
X ($move shaft ($loc .ME))
X ($move hole ($loc .ME))
X;
Xirm6(SDESC) =
X ($move shaft ($loc .ME))
X ($move hole ($loc .ME))
X ($return (Sayer "Mushroom room" %0))
X;
X
X
Xirm7(LDESC) =
X ($say
X"You are in an abandoned warehouse-like room which,
Xthough once used for storage, is now predominantly full of
Xrubble. Exits lead to the north and east.\n"
X )
X;
Xirm7(SDESC) =
X ($return (Sayer "Warehouse" %0))
X;
X
X
Xirm8(LDESC) =
X ($say
X"You are standing on a rocky beach on the west bank
Xof a slow-moving subterranean river. Several large
Xcrocodiles are lazily sleeping at the north end of the river.
XA path leads to the west.\n"
X )
X ($move river irm8)
X ($move crocodiles irm8)
X;
Xirm8(SDESC) =
X ($move river irm8)
X ($move crocodiles irm8)
X ($return (Sayer "West bank of river" %0))
X;
X
X
Xirm9(LDESC) =
X ($say
X"You are on a sandy beach on the east bank of a crocodile
Xinfested river. A roughly hewn stairway in the rock leads up
Xfar beyond your range of vision.\n"
X )
X ($move river irm9)
X ($move crocodiles irm9)
X;
Xirm9(SDESC) =
X ($move river irm9)
X ($move crocodiles irm9)
X ($return (Sayer "East bank of river" %0))
X;
X
X
Xirm10(LDESC) =
X ($say
X"You are in a room containing an enormous statue of
XMara, Hindu goddess and consort to Vishnu. Passages lead
Xto the east, west, and south, and a roughly hewn stairway
Xseems to go down to an area further underground.\n"
X )
X ($move statue ($loc .ME))
X;
Xirm10(SDESC) =
X ($move statue ($loc .ME))
X ($return (Sayer "In front of Mara's statue" %0))
X;
X
X
Xirm11(LDESC) =
X ($say
X"You are standing in front of a gigantic statue of the
XHindu god Vishnu. Passages lead north and south, and it appears
Xthat you can squeeze through a narrow crack in the western wall.\n"
X )
X ($move crack ($loc .ME))
X ($move statue ($loc .ME))
X;
Xirm11(SDESC) =
X ($move crack ($loc .ME))
X ($move statue ($loc .ME))
X ($return (Sayer "In front of Vishnu's statue" %0))
X;
X
X
Xirm12(LDESC) =
X ($say
X"You are in a room containing an enormous statue of
XLakshmi, Hindu goddess and consort to Vishnu. "
X )
X ($move statue ($loc .ME))
X (IF ($prop statue tlakst) THEN
X ($say
X"Passages lead to the east and north, and on the west wall
Xthere is a hole large enough to crawl through.\n"
X )
X ($move hole ($loc .ME))
X ELSE
X ($say "Passages lead to the north and east.\n")
X )
X;
Xirm12(SDESC) =
X (IF ($prop statue tlakst) THEN
X ($move hole ($loc .ME))
X )
X ($move statue ($loc .ME))
X ($return (Sayer "In front of Lakshmi's statue" %0))
X;
X
X
Xirm13(LDESC) =
X ($say
X"You are in what would appear to be a totally man-made
Xcave. The walls are covered with bamboo shafts cut and
Xtied together to form a very complex lattice pattern.
XAn extremely narrow passage leads east, and there is a
Xlarge door to the south.\n"
X )
X;
Xirm13(SDESC) =
X ($return (Sayer "Bamboo Room" %0))
X;
X
X
Xirm14(LDESC) =
X ($say
X"You are in a small room with a very low ceiling. The
Xonly exit is to the east.\n"
X )
X;
Xirm14(SDESC) =
X ($return (Sayer "Flat Room" %0))
X;
X
X
Xirm15(LDESC) =
X ($say
X"You are standing in the center of a large dome-like
Xroom. Exits lead to the north, east, and west, and around the perimeter of
Xthe room appear the words 'ABRACADABRA -- VARUNA SUCKS COCONUTS.'\n"
X )
X;
Xirm15(SDESC) =
X ($return (Sayer "Inside Dome" %0))
X;
X
X
Xirm16(LDESC) =
X ($say
X"You are at the base of a tall naturally formed shaft.
XOn all sides, you are surrounded by gigantic basalt columns
Xtowering above you in a serpentine manner, like great
Xlikenesses of Vasuki himself. Passages lead to the north,
Xeast, and west, and above you appears a small ledge.\n"
X )
X ($move shaft ($loc .ME))
X;
Xirm16(SDESC) =
X ($move shaft ($loc .ME))
X ($return (Sayer "Vertical Shaft" %0))
X;
X
X
Xirm17(LDESC) =
X ($say
X"You are on a small ledge high above the base of a large
Xshaft. There is a rope seemingly standing rigid allowing you to
Xclimb down, but the climb above you seems quite dificult.\n"
X )
X ($move shaft ($loc .ME))
X;
Xirm17(SDESC) =
X ($move shaft ($loc .ME))
X ($return (Sayer "On small ledge" %0))
X;
X
X
Xirm18(LDESC) =
X ($say
X"You are in a small room which smells strongly of
Xincense. Stone archways lead to the south, and east, and
Xa smaller passage leads to the west. You also hear some
Xchanting and Sitar music in the background.\n"
X )
X;
Xirm18(SDESC) =
X ($return (Sayer "Incense room" %0))
X;
X
X
Xirm19(LDESC) =
X ($say
X"You are at the holy well of Varuna, the water god. The well is in the
Xmiddle of the room, leading straight down into some water far below.
XLegend has it that those who climb down into the well suffer a fate
Xworse than death, so it is advisable not to go down. In the
Xceiling, there is a round hole"
X )
X ($move hole ($loc .ME))
X (IF ($prop rupees wellbt) THEN
X ($say
X" and the water in the well appears to have
Xbeen disturbed recently.\n"
X )
X ELSE
X ($say ".\n")
X )
X;
Xirm19(SDESC) =
X ($move hole ($loc .ME))
X ($return (Sayer "Varuna's well" %0))
X;
X
X
Xirm20(LDESC) =
X ($say
X"You are at the entrance to Siva's temple. A passage leads back to the west, "
X )
X (IF ($prop monkey fedmky) THEN
X ($say
X"and a crack in a huge stone slab allows one to proceed east.\n"
X )
X ($move crack ($loc .ME))
X ELSE
X ($say
X"but the entrance to the temple is blocked by a huge stone slab.\n"
X )
X )
X;
Xirm20(SDESC) =
X (IF ($prop monkey fedmky) THEN
X ($move crack ($loc .ME))
X )
X ($return (Sayer "Entrance to Siva's temple" %0))
X;
X
X
Xirm21(LDESC) =
X ($say
X"You are standing in front of Siva's altar, a small stone slab in front of
Xa large monolith. The exit is to the west.\n"
X )
X;
Xirm21(SDESC) =
X ($return (Sayer "Siva's Altar" %0))
X;
X
X
Xirm22(LDESC) =
X ($say
X"You are standing at the top of a six-foot deep snake pit. The walls of the
Xroom are covered with bas relief figures of cobras, kraits, and other
Xmiscellaneous elapids. Exits lead to the west and south, through archways
Xringed by pythons carved into the rock.\n"
X )
X;
Xirm22(SDESC) =
X ($return (Sayer "Top of Snake pit" %0))
X;
X
X
Xirm23(LDESC) =
X ($say
X"You are at the bottom of a snake pit. The only direction it appears you
Xcan go is back out.\n"
X )
X;
Xirm23(SDESC) =
X ($return (Sayer "Bottom of snake pit" %0))
X;
X
X
Xprm1(LDESC) =
X (darkq)
X ($say
X"You are in the north-south corridor of an ancient paleolithic cave. Its
Xlow ceiling is covered with paintings of wild game which have faded due to
Xthe passing of time.\n"
X )
X;
Xprm1(SDESC) =
X (IF ($and ($ne %0 0) (darkq 1)) THEN
X ($return DARK_STR)
X )
X (darkq)
X ($return (Sayer "North-south corridor." %0))
X;
X
X
Xprm2(LDESC) =
X ($say
X"You are standing on a ledge above the floor of a subterranean canyon
Xrunning east-west. Shafts of sunlight penetrate through cracks in the
Xceiling high above, washing the room with an alabaster murkiness;
Xcasting shadows on the weathered rocks which have lain undisturbed
Xfor countless centuries. A small crawlway leads north, and there is a
Xshort, stout pole sticking out of the ground."
X )
X (IF ($not ($prop rope rtied)) THEN
X ($say "\n")
X ELSE
X ($move rope ($loc .ME))
X ($say
X" A section of rope is tied
Xaround the pole, with the other end hanging down into the canyon.\n"
X )
X )
X;
Xprm2(SDESC) =
X (IF ($prop rope rtied) THEN
X ($move rope ($loc .ME))
X )
X ($return (Sayer "Above East-west canyon." %0))
X;
X
X
Xprm3(LDESC) =
X ($say
X"You are at the bottom of a canyon running east-west. The passage to the
Xeast is blocked by rubble, so it appears that the only direction you can
Xgo is west. A rope dangles down from above.\n"
X )
X ($move rope ($loc .ME))
X;
Xprm3(SDESC) =
X ($move rope ($loc .ME))
X ($return (Sayer "East end of canyon." %0))
X;
X
X
Xprm4(LDESC) =
X ($say
X"You are standing in front of a limestone cavern, the entrance of which looks
Xlike a gaping mouth of a grotesque monster. It appears that you can enter
Xthe cave to your south, or go either direction in the east-west canyon in which
Xyou are standing.\n"
X )
X;
Xprm4(SDESC) =
X ($return (Sayer "Entrance to limestone cavern." %0))
X;
X
X
Xprm5(LDESC) =
X (darkq)
X ($say
X"You are in a very narrow room which probably was once much larger.
XHowever, it appears that a recent cave-in has closed off much of the
Xroom to the east. To your north, there is a corridor which apparently
Xleads back out, and in the eastern wall, there is a hole which you can
Xprobably crawl through.\n"
X )
X ($move hole ($loc .ME))
X;
Xprm5(SDESC) =
X ($move hole ($loc .ME))
X (IF ($and ($ne %0 0) (darkq 1)) THEN
X ($return DARK_STR)
X )
X (darkq)
X ($return (Sayer "Narrow room in cave." %0))
X;
X
X
Xprm6(LDESC) =
X (darkq)
X (IF ($prop smilo stond) THEN
X ($say
X"You are standing above an empty shallow pit. There is a small hole in the
Xwest wall of the room you are in.\n"
X )
X ELSE
X ($say
X"You are standing above a shallow pit which is empty except for a
Xlarge smilodon (sabre-tooth tiger) which is growling at you menacingly.
XThe only other direction it looks like you can go is back out through a
Xsmall hole in the rubble forming the west wall of the room you are in.\n"
X )
X )
X ($move hole ($loc .ME))
X;
Xprm6(SDESC) =
X ($move hole ($loc .ME))
X (IF ($and ($ne %0 0) (darkq 1)) THEN
X ($return DARK_STR)
X )
X (darkq)
X ($return (Sayer "Above shallow pit" %0))
X;
X
X
Xprm7(LDESC) =
X (darkq)
X ($say
X"You are standing on the loose gravel of a shallow pit. An exit leads
Xsouth, and above you, there is a small ledge which you can climb up to.\n"
X )
X;
Xprm7(SDESC) =
X (IF ($and ($ne %0 0) (darkq 1)) THEN
X ($return DARK_STR)
X )
X (darkq)
X ($return (Sayer "In shallow pit" %0))
X;
X
X
Xprm8(LDESC) =
X (darkq)
X ($say
X"You are standing near the west rim of sheer cliff which drops down into a deep
Xalmost bottomless abyss. A passage leads north"
X )
X (IF ($prop trogl killd) THEN
X ($say ".\n")
X ELSE
X ($say
X" and there is an angry
Xtroglodyte here holding a large gold nugget under his arm.\n"
X )
X )
X;
Xprm8(SDESC) =
XLOCAL foo;
X (IF ($and ($ne %0 0) (darkq 1)) THEN
X ($return DARK_STR)
X )
X (darkq)
X ($setg foo (Sayer "West rim of canyon" %0))
X (IF ($and ($not ($prop trogl killd)) ($eq %0 0)) THEN
X ($say "There is an angry troglodyte holding a gold nugget here.\n")
X )
X ($return @foo)
X;
X
X
Xprm9(LDESC) =
X ($say
X"You are at the junction of two canyons. The larger one runs east-west
Xand the smaller one runs north.\n"
X )
X;
Xprm9(SDESC) =
X ($return (Sayer "Canyon junction" %0))
X;
X
X
Xprm10(LDESC) =
X ($say
X"You are standing on a shale slab tilted from west to east at about a
Xforty-five degree angle. At the east end of the slab, there is a short
Xdrop into what appears to be a lake. Above you and to the west, it appears
Xthat there is some more explorable terrain, and the canyon leads back to
Xto the south. The air is quite warm, and there is a slight scent similar
Xto asphalt in the air.\n"
X )
X;
Xprm10(SDESC) =
X ($return (Sayer "On shale slab" %0))
X;
X
X
Xprm11(LDESC) =
X ($say
X"You are standing in the south end of a short canyon running north-south.
XThe ground below your feet is littered with flakes of a dark rock, which
Xseems to comprise most of the surrounding canyon walls. There is a path to
Xyour north, and a steep slope down and to the east.\n"
X )
X;
Xprm11(SDESC) =
X ($return (Sayer "Canyon full of rubble" %0))
X;
X
X
Xprm12(LDESC) =
X ($say
X"You are standing in the north end of a short canyon. The ground is
Xcovered with a thin film of oil which apppears to be seeping out of
Xa crack in the earth. The only apparent direction you can go is south.\n"
X )
X ($move crack ($loc .ME))
X;
Xprm12(SDESC) =
X ($move crack ($loc .ME))
X ($return (Sayer "Oily end of canyon" %0))
X;
X
X
Xprm13(LDESC) =
X ($say
X"You are standing in what was once a tributary into the now-extinct river
Xwhich formed the large canyon in this area. There is a streambed running
Xto the south, and you can also go east and west.\n"
X )
X;
Xprm13(SDESC) =
X ($return (Sayer "End of dry river bed" %0))
X;
X
X
Xprm14(LDESC) =
X ($say
X"You are standing in a narrow north-south canyon with a river bed running
Xdown the middle of it. There is a semicirular shaped hole at the base of
Xthe eastern wall.\n"
X )
X ($move hole ($loc .ME))
X;
Xprm14(SDESC) =
X ($move hole ($loc .ME))
X ($return (Sayer "In narrow part of river bed" %0))
X;
X
X
Xprm15(LDESC) =
X ($say
X"You are at the base of three water-eroded cliffs to your south, east and
Xwest. It appears that a U-shaped waterfall once flowed into this area, and
Xexited out to the north.\n"
X )
X;
Xprm15(SDESC) =
X ($return (Sayer "Below dried waterfall" %0))
X;
X
X
Xprm16(LDESC) =
X ($say
X"You are in a section of the canyon where much of the rock appears to be
Xprimarily sandstone. Water has apparently flowed out of a cave to your
Xnorth into three-foot wide crack in the ground. A substantial amount of
Xrubble blocks your way west, and the rest of the canyon winds east.\n"
X )
X ($move crack ($loc .ME))
X;
Xprm16(SDESC) =
X ($move crack ($loc .ME))
X ($return (Sayer "Sandstone area" %0))
X;
X
X
Xprm17(LDESC) =
X (darkq)
X ($say
X"You are standing in front of the freshly dug gravesite of a Nearderthal
Xhunter. There is an exit to your south, and it seems that more of the
Xcave can be explored to the north. "
X )
X (IF ($and ($prop spear tooky) ($not ($prop spear abrad))) THEN
X ($say "However, a large amount of rubble blocks that path.\n")
X ELSE
X ($say "\n")
X )
X;
Xprm17(SDESC) =
X (IF ($and ($ne %0 0) (darkq 1)) THEN
X ($return DARK_STR)
X )
X (darkq)
X ($return (Sayer "Neanderthal's gravesite" %0))
X;
X
X
Xprm18(LDESC) =
X (darkq)
X ($say
X"You are in a narrow room of a north-south running cave. A large cairn of
Xprehistoric cave bear skulls is piled high in one corner of the room.
XThere are exits to the north and south.\n"
X )
X;
Xprm18(SDESC) =
X (IF ($and ($ne %0 0) (darkq 1)) THEN
X ($return DARK_STR)
X )
X (darkq)
X ($return (Sayer "In front of cave bear cairn" %0))
X;
X
X
Xprm19(LDESC) =
X (darkq)
X ($say
X"You are in a large cavern room with a high ceiling. Cracks in the walls
Xlead in all directions but none of them seem to lead anywhere. There are
Xhowever, two major paths to the north and the south.\n"
X )
X;
Xprm19(SDESC) =
X (IF ($and ($ne %0 0) (darkq 1)) THEN
X ($return DARK_STR)
X )
X (darkq)
X ($return (Sayer "Large Cavern room" %0))
X;
X
X
Xprm20(LDESC) =
X (darkq)
X ($say
X"You are in a room which was the site of a recent cave-in. It appears to
Xbe futile to go any other direction except south.\n"
X )
X;
Xprm20(SDESC) =
X (IF ($and ($ne %0 0) (darkq 1)) THEN
X ($return DARK_STR)
X )
X (darkq)
X ($return (Sayer "Cave-in site" %0))
X;
X
X
Xprm21(LDESC) =
X ($say
X"You are in a crack in the earth which seems to have been formed by an ancient
Xearthquake. Various strata in the rock of different darkness seem to indicate
Xthat much time has passed since the formation of the rock at the lower end of
Xthis crack. It seems that you can chimney up back out of the crack, or climb
Xfurther down into it.\n"
X )
X ($move crack ($loc .ME))
X;
Xprm21(SDESC) =
X ($move crack ($loc .ME))
X ($return (Sayer "In large crack" %0))
X;
X
X
Xprm22(LDESC) =
X ($say
X"You are standing on a narrow ledge about twenty-five feet above the ground.
XAside from going back up, the only other direction you can go is to step off
Xthe ledge to the west into the mouth of the large Tyranosaurus Rex waiting to
Xswallow you whole.\n"
X )
X;
Xprm22(SDESC) =
X ($return (Sayer "On ledge in front of Tyranosaurus Rex" %0))
X;
X
X
Xprm23(LDESC) =
X ($say
X"You are standing inside the mouth of a Tyranosaurus Rex, whose jaws are
Xbeing held open by a spear wedged length-wise in his mouth. Various pieces
Xof former adventurers can be found among the six-inch long teeth here.
XYou can step back out of the Tyranosaur onto the small ledge, or go
Xfurther down into the Tyranosaur and get digested.\n"
X )
X;
Xprm23(SDESC) =
X ($return (Sayer "Inside mouth of Tyranosaur" %0))
X;
X
X{*** EOF locales.adl ***}
END_OF_samples/aard/locales.adl
if test 20706 -ne `wc -c <samples/aard/locales.adl`; then
echo shar: \"samples/aard/locales.adl\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f samples/standard.adl -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"samples/standard.adl\"
else
echo shar: Extracting \"samples/standard.adl\" \(26676 characters\)
sed "s/^X//" >samples/standard.adl <<'END_OF_samples/standard.adl'
XMESSAGE "\n standard.adl - version 3.1 - June 20, 1987\n" ;
XMESSAGE " Copyright (c) 1986, 1987 by Ross Cunniff\n" ;
XMESSAGE " Consult \"The ADL Programmer's Reference Manual\" for\n";
XMESSAGE " information on using standard.adl\n\n" ;
X{
X standard.adl - a set of ADL definitions intended to make
X ADL programs conform to the standard set in the document
X "ADL Player's Handbook" by Brengle and Cunniff. standard.adl
X should be portable to all ADL implementations, and should
X work elegantly and efficiently, encouraging its use by programmers.
X The following is the "interface" to standard.adl. It tells
X what is defined in this file.
X}
X
X
X{ *** Boolean Object Properties *** }
X
XSEEN = 16; { I've been here / seen this }
XOPENS = 15; { This can be opened }
XLOCKS = 14; { This can be locked }
XOPENED = 13; { This is opened }
XLOCKED = 12; { This is locked }
XTRANS = 11; { This is transparent }
XLIGHT = 10; { This gives off light }
XFLAME = 9; { This is on fire }
XNOTAKE = 8; { Ignore this object for "take" }
X
X{ The other 6 boolean properties are available to the user. }
X
X
X{ *** Integer Object Properties *** }
X
XAllLink = 29; { Link for objects used with "take" and "drop" }
XSAVESENT = 28; { First VAR in a sentence save area }
X
X{ The other 11 integer properties are available to the user }
X
X
X
X{ *** Useful Constants *** }
X
XTRUE = 1;
XFALSE = 0;
XNULL = 0;
X
X
X
X{ *** Flags for Expect *** }
X
XNO_OBJ = 1; { It is valid to have no objects }
XONE_OBJ = 2; { It is valid to have one object }
XMULT_OBJ = 4; { It is valid to have multiple objects }
XSTR_OBJ = 8; { It is valid to have string objects }
XPLAIN_OBJ = 16; { It is valid to have normal objects }
X
X
X
X{ *** $spec commands *** }
X
XDEBUG = 1;
XRESTART = 2;
XQUIT = 3;
XSAVE = 4;
XRESTORE = 5;
XEXEC = 6;
XPRESERVE= 7;
XSCRIPT = 8;
XHEADER = 9;
XMARGIN = 10;
X
X
X
X{ *** Global Variables *** }
X
XVAR
X First, { Is the current Dobj the first in the Dobj list? }
X AllSeen, { Did the player type "all" in this sentence? }
X MultList, { Head ptr of the multiple object list }
X MyConj, { Records where "but" has been seen }
X NumSeen, { Number of Dobj's seen by "take" or "drop" so far }
X IobjSave, { Save for the Iobj (for TAKE and DROP) }
X Skip, { Should TorDACT skip this object? }
X Scripting, { Are we writing a script file? }
X
X Conts, { Have we already printed out "You can see:"? }
X Indent, { Indent outer object descriptions? }
X
X LastVerb, { The Verb from the previous sentence }
X LastNumd, { The Numd from the previous sentence }
X LastConj, { The Conj from the previous sentence }
X LastDobj, { The Dobj from the previous sentence }
X LastPrep, { The Prep from the previous sentence }
X LastIobj, { The Iobj from the previous sentence }
X
X Dark, { Is it dark? }
X MyLoc, { My last location }
X Verbose; { Does the player want verbose output? }
X
X
X(First) = TRUE;
X(MyLoc) = -1; { Look on the first turn }
X
X
X
X{ *** Prepositions *** }
X
XPREP
X with, to, into, at, under, from, off, on;
X
Xin = into;
X
X
X
X{ *** Articles *** }
X
XARTICLE
X the, a, an;
X
X
X
X{ *** Useful routines *** }
X
XROUTINE
X StdInit, { (StdInit actor) Standard game with actor playing }
X Reach, { (Reach Obj Where) True IFF I can reach Obj in Where }
X See, { (See Obj Where) True IFF I can see Obj in Where }
X Lit, { (LitP) True IFF something is lit or burning }
X Describe, { (Describe depth obj rout) Describe obj }
X Avail, { (Avail Obj) Is Obj available? }
X CheckAvail, { (CheckAvail) check availability of Dobj and Iobj }
X Expect, { (Expect DobjFlags IobjFlags) Check the form }
X Preact, { Standard verb preact }
X Looker, { Looking daemon }
X Prompter, { User prompt }
X ActAction, { Standard actor ACTION }
X SaveSentence, { (SaveSentence) - save the value of the curr. sent. }
X TakeAct, { User defined take action }
X DropAct, { User defined drop action }
X Dwimmer; { (Dwimmer Obj) - is Obj the one I want? }
X
X
X
X{ *** Objects *** }
X
XNOUN
X all, { Used only in sentences with take and drop }
X it; { Refers to the last Dobj or Iobj typed }
X
X
X{ *** Verbs - NOTE: do not change the PREACT or ACTION of any of these
X without carefully considering the consequences *** }
X
XVERB
X n, s, e, w,
X ne, se, nw, sw,
X up, down,
X enter, exit,
X get, put, take, drop,
X wear, remove,
X verbose, terse,
X open, close,
X lock, unlock,
X move, break, rub, touch,
X throw, read, burn,
X examine, look, inventory,
X quit, restart,
X save, restore, script,
X turn, douse, light,
X wait, again, go;
X
X
X{ Verb equivalences }
X
Xg = again;
Xz = wait;
Xl = look;
Xu = up;
Xd = down;
Xnorth = n;
Xsouth = s;
Xeast = e;
Xwest = w;
Xnortheast = ne;
Xnorthwest = nw;
Xsoutheast = se;
Xsouthwest = sw;
Xput on = wear;
Xtake off = remove;
Xturn on = light;
Xturn off = douse;
Xlook at = examine;
X
X
XMESSAGE "Done with Standard Interface - proceeding to Utility Routines\n";
X
X
X
X{ (StdInit actor) - initializes the ACTION routine of actor, sets
X up the prompter, and sets up the looking daemon. }
X
XStdInit =
X ($setp %1 ACTION ActAction)
X ($setp %1 NOTAKE TRUE)
X ($setp %1 SAVESENT LastVerb)
X ($actor %1 NULL TRUE)
X ($prompt Prompter)
X ($sdem Looker)
X ($setv n s e w ne se nw sw u d)
X;
X
X
X
X{ (FindIt obj) - figure out what an 'it' in a player's sentence refers
X to }
X
XItConfused = "I can't seem to figure out what you mean by 'it'.\n";
XFindIt =
XLOCAL
X SavePlace, { The value of .ME(SAVESENT) }
X LastDobj, { The last DIRECT OBJECT typed }
X LastIobj, { The last INDIRECT OBJECT typed }
X LastNumd; { The previous NUMBER OF DIRECT OBJECTS typed }
X
X { Retrieve the pertinent info from SAVESENT }
X ($setg SavePlace ($prop .ME SAVESENT))
X (IF ($not @SavePlace) THEN
X ($say ItConfused)
X ($exit 1)
X )
X ($setg LastNumd ($global ($plus @SavePlace 1)))
X ($setg LastDobj ($global ($plus @SavePlace 3)))
X ($setg LastIobj ($global ($plus @SavePlace 5)))
X
X (IF ($or ($lt @LastDobj 0) ($lt @LastIobj 0) ($gt @LastNumd 1)) THEN
X ($say ItConfused)
X ($exit 1)
X )
X (IF ($and ($ne @LastDobj 0) ($eq @LastIobj 0)) THEN
X ($setg %1 @LastDobj)
X ELSEIF ($and ($ne @LastIobj 0) ($eq @LastDobj 0)) THEN
X ($setg %1 @LastIobj)
X ELSE
X ($say ItConfused)
X ($exit 1)
X )
X;
X
X
X
X{ ActAction - the default Actor Action }
X
XActAction =
XLOCAL SavePlace;
X (IF ($eq @Verb again) THEN
X ($setg SavePlace ($prop .ME SAVESENT))
X (IF ($not @SavePlace) THEN
X ($say "I can't do that.\n")
X ($exit 1)
X )
X (IF ($or @Dobj @Iobj) THEN
X ($say "You may not use objects with 'again'.\n")
X ($exit 1)
X )
X (IF ($gt ($global ($plus @SavePlace 1)) 1) THEN
X ($say "You can't use 'again' with multiple direct objects.\n")
X ($exit 1)
X )
X ($setg Verb ($global @SavePlace))
X ($setg Numd ($global ($plus @SavePlace 1)))
X ($setg Conj ($global ($plus @SavePlace 2)))
X ($setg Dobj ($global ($plus @SavePlace 3)))
X ($setg Prep ($global ($plus @SavePlace 4)))
X ($setg Iobj ($global ($plus @SavePlace 5)))
X ($exit 0)
X )
X (IF ($and ($eq @Dobj it) ($ne @Iobj it)) THEN
X (FindIt Dobj)
X ELSEIF ($and ($eq @Iobj it) ($ne @Dobj it)) THEN
X (FindIt Iobj)
X ELSEIF ($or ($eq @Iobj it) ($eq @Iobj it)) THEN
X ($say "You may only use the word 'it' once in a sentence.\n")
X ($exit 1)
X )
X (SaveSentence)
X;
X
X
X
X
X{ (CheckAvail) - checks to see whether the objects named by the
X player are indeed available }
X
XCheckAvail =
X (IF ($gt ($dobj) 0) THEN
X (Avail ($dobj))
X )
X (IF ($gt ($iobj) 0) THEN
X (Avail ($iobj))
X )
X;
X
X
X
X{ (Expect DobjFlags IobjFlags) - Checks for a valid sentence }
X
XExpect =
X { Check the number of direct objects }
X (IF ($eq @Numd 0) THEN
X (IF ($not ($and %1 NO_OBJ)) THEN
X ($say "You must tell me what to " ($vname @Verb) ".\n")
X ($exit 3)
X )
X ELSEIF ($and ($eq @Numd 1) ($ne @Dobj all)) THEN
X (IF ($and ($not ($and %1 MULT_OBJ))
X ($not ($and %1 ONE_OBJ)) )
X THEN
X ($say "You may not use a direct object with "
X ($vname @Verb) ".\n")
X ($exit 1)
X )
X ELSE
X (IF ($not ($and %1 MULT_OBJ)) THEN
X ($say "You may not use multiple direct objects with "
X ($vname @Verb) ".\n")
X ($exit 1)
X )
X )
X
X { Check the number of Indirect objects }
X (IF ($and ($eq @Iobj 0) ($not ($and %2 NO_OBJ))) THEN
X ($say "How would you like to do that?\n")
X ($exit 3)
X ELSEIF ($and ($ne @Iobj 0) ($not ($and %2 ONE_OBJ))) THEN
X ($say "You may not use an indirect object with "
X ($vname @Verb) ".\n")
X ($exit 1)
X )
X
X { Check the type of the objects }
X (IF ($or ($and ($lt @Dobj 0) ($not ($and %1 STR_OBJ)))
X ($and ($lt @Iobj 0) ($not ($and %2 STR_OBJ))) )
X THEN
X ($say "You may not use strings with " ($vname @Verb) ".\n")
X ($exit 1)
X )
X (IF ($or ($and ($gt @Dobj 0) ($not ($and %1 PLAIN_OBJ)))
X ($and ($gt @Iobj 0) ($not ($and %2 PLAIN_OBJ))) )
X THEN
X ($say "You must use strings with " ($vname @Verb) ".\n")
X ($exit 1)
X )
X;
X
X
X
X{ Preact - the default verb Preact }
XPreact =
X (Expect ($or ONE_OBJ PLAIN_OBJ) ($or NO_OBJ ONE_OBJ PLAIN_OBJ))
X (CheckAvail)
X;
X
X
X
X{ (Visible List Propno) - returns 1 IFF an object is visible on List that
X has a nonzero prop Propno }
X
XVisible =
X (IF ($not %1) THEN { Null list }
X ($return FALSE)
X ELSEIF ($prop %1 %2) THEN { This one is it! }
X ($return TRUE)
X ELSEIF ($or ($prop %1 OPENED) ($prop %1 TRANS)) THEN { Look inside }
X (IF (Visible ($cont %1) %2) THEN
X ($return TRUE)
X )
X )
X ($return (Visible ($link %1) %2)) { See if siblings satisfy Visible }
X;
X
X
X
X{ (Reach Obj Loc) - returns 1 IFF Obj == Loc, or can (recursively) be
X reached via the Loc }
X
XReach =
X (IF ($not %2) THEN { Null list }
X ($return FALSE)
X ELSEIF ($eq %1 %2) THEN { This is the one! }
X ($return TRUE)
X ELSEIF ($prop %2 OPENED) THEN { Still explore inside }
X (IF (Reach %1 ($cont %2)) THEN
X ($return TRUE)
X )
X )
X ($return (Reach %1 ($link %2))) { See if siblings can reach }
X;
X
X
X
X{ (See Obj Loc) - returns 1 IFF the Obj == Loc, or can be reached
X via the Loc (similar to Reach, above) }
X
XSee =
X (IF @Dark THEN { Can't see in a dark room! }
X ($return FALSE)
X ELSEIF ($not %2) THEN { Null list }
X ($return FALSE)
X ELSEIF ($eq %1 %2) THEN { This is the one! }
X ($return TRUE)
X ELSEIF ($or ($prop %2 TRANS) { Still explore inside }
X ($prop %2 OPENED))
X THEN
X (IF (See %1 ($cont %2)) THEN
X ($return TRUE)
X )
X )
X ($return (See %1 ($link %2))) { See whether siblings can see }
X;
X
X
X
X{ (Avail Obj) - returns 1 IFF I can see Obj or I can reach Obj,
X performs a ($exit 1) otherwise }
X
XAvail =
X (IF ($not %1) THEN { Null object }
X ($say "The what?\n")
X ($exit 1)
X ELSEIF ($not ($or (See %1 ($cont ($loc .ME))) (See %1 ($cont .ME)))) THEN
X ($say "I can't see that item here.\n")
X ($exit 1)
X ELSEIF ($not ($or (Reach %1 ($cont ($loc .ME))) (Reach %1 ($cont .ME))))
X THEN
X ($say "I can't get at that item.\n")
X ($exit 1)
X )
X ($return TRUE)
X;
X
X
X
X{ (Lit Room) - returns TRUE IFF Room is lit }
X
XLit =
X (IF ($prop %1 LIGHT) THEN { Intrinsically lit }
X ($return TRUE)
X ELSEIF ($or (Visible ($cont %1) LIGHT) (Visible ($cont %1) FLAME)) THEN
X ($return TRUE) { I can see a light }
X ELSEIF ($or (Visible ($cont .ME) LIGHT) (Visible ($cont .ME) FLAME)) THEN
X ($return TRUE) { I have a light }
X ELSE
X ($return FALSE)
X )
X;
X
X
X
X{ (Next global) - sets global to point to the sibling of the object
X pointed to by global }
X
XNext =
X ($setg %1 ($link ($global %1)))
X;
X
X
X
X{ (Blank n) - Type 2*n blanks }
X
XBlank =
XLOCAL i;
X (IF ($not @Indent) THEN ($return 0))
X ($setg i %1)
X (WHILE @i DO
X ($say " ")
X ($setg i ($minus @i 1))
X )
X;
X
X
X
X{ (Describe Level Obj Rout) - Describes Obj using Rout (which is a ROUTINE that
X returns a ROUTINE that describes Obj, typically $sdesc or $ldesc),
X and also describes the contents of Obj }
X
XDescribe =
X (IF ($not %2) THEN { Null list }
X ($return 0)
X ELSEIF ($not %1) THEN { Level 0 == This is a room. Check lighting }
X ($setg Conts FALSE)
X (IF (Lit %2) THEN
X ($setg Dark FALSE) { Can't be dark in a lit room! }
X ((%3 %2)) { Talk about the room }
X (IF ($not @Dark) THEN
X (Describe 1 ($cont %2) %3) { Talk about its contents }
X )
X ELSE
X ($say "It's mighty dark in here!\n")
X ($setg Dark TRUE)
X )
X ELSE { Level > 0 == This is a list of objs }
X (IF (%3 %2) THEN { Talk (only) about the visible }
X (IF ($and ($eq %3 $sdesc) ($not @Conts)) THEN
X (Blank ($minus %1 1))
X ($say "You can see:\n")
X )
X ($setg Conts TRUE)
X (Blank %1) { Indent }
X ((%3 %2)) { Blurb the object }
X (IF ($cont %2) THEN { something inside it...}
X (IF ($or ($prop %2 OPENED) ($prop %2 TRANS)) THEN
X (IF ($eq %3 $ldesc) THEN
X (Blank %1)
X ($say "It contains:\n")
X ELSE
X ($say ", containing\n")
X )
X ($setp %2 SEEN TRUE)
X (Describe ($plus %1 1) ($cont %2) $sdesc)
X {Short descs for conts}
X ELSEIF ($eq %3 $sdesc) THEN
X ($say "\n")
X )
X ELSEIF ($eq %3 $sdesc) THEN
X ($say "\n")
X )
X )
X (Describe %1 ($link %2) %3)
X )
X;
X
X
X
X{ (SaveSentence) - save the value of the current sentence }
X
XSaveSentence =
XLOCAL SavePlace;
X ($setg SavePlace ($prop .ME SAVESENT))
X (IF ($not @SavePlace) THEN
X ($return 0)
X )
X ($setg @SavePlace @Verb)
X ($setg ($plus @SavePlace 1) @Numd)
X ($setg ($plus @SavePlace 2) @Conj)
X ($setg ($plus @SavePlace 3) @Dobj)
X ($setg ($plus @SavePlace 4) @Prep)
X ($setg ($plus @SavePlace 5) @Iobj)
X;
X
X
X
X{ (Prompter) - print out a user prompt. Usually only mentioned
X in ($prompt Prompter) in START }
X
XPrompter =
X ($say "> ")
X;
X
X
X
X{ (Looker) - The standard Looking daemon. Usually only mentioned
X in START. }
X
XLooker =
X ($setp .ME TRANS FALSE)
X ($setg MyConj FALSE)
X ($setg First TRUE)
X ($setg IobjSave NULL)
X ($setg AllSeen FALSE)
X (IF ($ne @MyLoc ($loc .ME)) THEN
X (IF ($and ($not @Verbose) ($prop ($loc .ME) SEEN)) THEN
X (Describe 0 ($loc .ME) $sdesc)
X ELSE
X (($sdesc ($loc .ME)))
X (Describe 0 ($loc .ME) $ldesc)
X ($setp ($loc .ME) SEEN TRUE)
X )
X (IF @Dark THEN
X ($setp ($loc .ME) SEEN FALSE)
X )
X ($setg MyLoc ($loc .ME))
X )
X ($setp .ME TRANS TRUE)
X ($setp .ME OPENED TRUE)
X;
X
X
X
X{
X The following are routines relating to sentence constructions such
X as "take all but rock and cow. drop all but sword."
X}
X
X
X{ (DelList Obj) -- Deletes Obj from the list of multiple direct objects }
X
XDelList =
XLOCAL Curr;
X (IF ($eq %1 all) THEN
X { The player typed something like "take all but all" }
X ($say "I don't understand that.\n")
X ($exit 1)
X )
X ($setg Curr @MultList)
X (IF ($eq @Curr %1) THEN
X { Delete the head of the list }
X ($setg MultList ($prop @Curr AllLink))
X ELSE
X { It's somewhere in the middle of the list }
X (WHILE @Curr DO
X (IF ($eq ($prop @Curr AllLink) %1) THEN
X ($setp @Curr AllLink ($prop ($prop @Curr AllLink) AllLink))
X ($return 0)
X )
X ($setg Curr ($prop @Curr AllLink))
X )
X { If we make it here, %1 wasn't on the list to begin with. }
X ($say "You see no " ($name %1) " here.\n")
X ($exit 1)
X )
X;
X
X
X
X{ (AddList Obj) -- Adds Obj to the list of multiple direct objects }
X
XAddList =
X (IF ($eq %1 all) THEN
X { The player typed something like "Take rock and all" }
X ($say "I don't understand that.\n")
X ($exit 1)
X )
X ($setp %1 AllLink @MultList)
X ($setg MultList %1)
X;
X
X
X
X{ (InitList Where) -- Adds each object contained in Where to MultList }
X
XInitList =
XLOCAL Curr;
X ($setg MultList NULL)
X ($setg AllSeen TRUE)
X ($setg Curr %1)
X (WHILE @Curr DO
X (IF ($not ($prop @Curr NOTAKE)) THEN
X ($setp @Curr AllLink @MultList)
X ($setg MultList @Curr)
X )
X (Next Curr)
X )
X;
X
X
X
X{ (Mover Where String) - Moves each object on MultList to Where, printing
X String as it does so. }
X
XMover =
X (IF ($not @MultList) THEN
X ($say "There is nothing to " ($vname @Verb) ".\n")
X ($exit 1)
X )
X (WHILE @MultList DO
X ($setg Dobj @MultList)
X ($setg Iobj @IobjSave)
X ($setg Skip FALSE)
X (($action @Dobj)) { Call the ACTION routines }
X (IF ($not @Skip) THEN
X (($action @Iobj)) { for the Dobj and Iobj }
X )
X (IF ($not @Skip) THEN { Call the ACTIONs for the verb }
X (IF ($eq @Verb take) THEN
X (TakeAct)
X ELSE {Verb == drop}
X (DropAct)
X )
X )
X (IF ($not @Skip) THEN
X ($move @Dobj %1) { Do the moving }
X ($say " " ($name @Dobj) " - " %2 "\n")
X )
X ($setg MultList ($prop @MultList AllLink))
X )
X;
X
X
X
X{ (CheckLoc Obj Where) - Checks whethere Obj can be seen on Where
X and can be reached on Where }
X
XCheckLoc =
X (IF ($not (See %1 %2)) THEN
X (IF ($eq %2 ($cont .ME)) THEN
X ($say "You have no " ($name %1) ".\n")
X ELSE
X ($say "You see no " ($name %1) " here.\n")
X )
X ($exit 1)
X ELSEIF ($not (Reach %1 %2)) THEN
X ($say "You can't reach the " ($name %1) ".\n")
X ($exit 1)
X )
X;
X
X
X
X{ (TorDPRE Where) -- Uses Where as the context for a multiple
X direct object (with "all" as a possible object) list. }
X
XTorDPRE =
X (IF ($not @First) THEN
X { The MultList is initialized }
X (IF @Conj THEN
X (IF ($not @AllSeen) THEN
X { The player typed something like "take a, b but c" }
X ($say "I don't understand that.\n")
X ($exit 1)
X )
X ($setg MyConj TRUE)
X )
X (IF @MyConj THEN { We have seen "but" in the sentence }
X (DelList @Dobj) { so delete this object from the list }
X ELSE { We have NOT seen "but" }
X (CheckLoc @Dobj %1) { See if the object is in the right place }
X (AddList @Dobj) { If so, add the object to the mult list }
X )
X ELSE { The MultList is NOT initialized, but
X there are objects in the sentence }
X (IF ($eq @Dobj all) THEN
X (InitList %1) { The direct obj. is all, so set the MultList
X to the cont of the loc of .ME }
X ELSE { The dir obj. is NOT all, so set MultList to }
X (CheckLoc @Dobj %1) { be the direct object. }
X ($setg MultList @Dobj)
X ($setp @Dobj AllLink NULL)
X )
X ($setg First FALSE)
X ($setg MyConj FALSE)
X ($setg NumSeen 1)
X )
X ($setg Dobj 0) { We will call the ACTION routines later... }
X;
X
X
X
X{ (TorDACT Where String) -- Moves all objects on the multlist to Where
X (using Mover) if all of the objects have been seen; otherwise it waits.
X String is the past participle of $verb. (e.g. "taken", "dropped" }
X
XTorDACT =
X (IF ($le @Numd @NumSeen) THEN
X (Mover %1 %2)
X ELSE
X ($setg NumSeen ($plus @NumSeen 1))
X )
X;
X
X
X
XMESSAGE "Done with Utility Routines. Begin predefined verbs.\n";
X
X
X
X{ The following objects are for things like "go north" }
XNOUN
X n DIR, s DIR, e DIR, w DIR,
X ne DIR, se DIR, nw DIR, sw DIR,
X u DIR, d DIR;
X
X{ We keep them in this array for PORTABLE referencing }
XVAR
X _DirArray[ 10 ];
X
X(_DirArray+0) = n DIR;
X(_DirArray+1) = s DIR;
X(_DirArray+2) = e DIR;
X(_DirArray+3) = w DIR;
X(_DirArray+4) = ne DIR;
X(_DirArray+5) = se DIR;
X(_DirArray+6) = nw DIR;
X(_DirArray+7) = sw DIR;
X(_DirArray+8) = u DIR;
X(_DirArray+9) = d DIR;
X
Xgo( PREACT ) =
XLOCAL i;
X (Expect ($or ONE_OBJ PLAIN_OBJ) NO_OBJ)
X { Try to find the Dobj in the list of Directions }
X ($setg i 0)
X (WHILE ($lt @i 10) DO
X (IF ($eq ($global ($plus _DirArray @i)) ($dobj)) THEN
X { We found it. Set the Verb and Dobj appropriately }
X ($setg Verb ($minus 0 ($modif ($dobj))))
X ($setg Dobj 0)
X (($vprop ($verb) PREACT))
X ($return 0)
X )
X ($setg i ($plus @i 1))
X )
X
X { If we get here, we didn't find the Dobj }
X ($say "Huh?\n")
X ($exit 1)
X;
X
X
XSilly =
X ($say "That's silly!\n")
X ($exit 1)
X;
X
X
X_MeanMsg = "What do you mean by \"";
XNOVERB( PREACT ) =
X (IF ($gt @Dobj 0) THEN
X ($say "What do you want to do with the " ($name @Dobj) "?\n")
X ($exit 3)
X ELSEIF ($lt @Dobj 0) THEN
X ($say _MeanMsg @Dobj "\"?\n")
X ($exit 3)
X ELSEIF ($lt @Dobj 0) THEN
X ($say _MeanMsg @Dobj "\"?\n")
X ($exit 3)
X ELSEIF ($gt @Iobj 0) THEN
X ($say "What to you want to do " ($pname @Prep) " the "
X ($name @Iobj) "?\n")
X ($exit 3)
X ELSEIF ($lt @Iobj 0) THEN
X ($say _MeanMsg @Iobj "\"?\n")
X ($exit 3)
X ELSE
X ($say "I beg your pardon?\n")
X ($exit 1)
X )
X;
X
Xwait( PREACT ) =
X (Expect NO_OBJ NO_OBJ)
X ($say "Time passes...\n")
X ($exit 1)
X;
X
Xwear( PREACT ) = Preact;
Xwear( ACTION ) = Silly;
X
Xremove( PREACT ) = Preact;
Xremove( ACTION ) = Silly;
X
Xverbose( PREACT ) = (Expect NO_OBJ NO_OBJ);
Xverbose( ACTION ) =
X ($say "Maximum verbosity.\n")
X ($setg Verbose TRUE)
X;
X
Xterse( PREACT ) = (Expect NO_OBJ NO_OBJ);
Xterse( ACTION ) =
X ($say "Minimum verbosity.\n")
X ($setg Verbose FALSE)
X;
X
X
Xtake( PREACT ) =
X (Expect ($or ONE_OBJ MULT_OBJ PLAIN_OBJ) ($or NO_OBJ ONE_OBJ PLAIN_OBJ))
X ($setp .ME OPENED TRUE)
X ($setp .ME TRANS TRUE)
X (IF @Iobj THEN
X (IF ($prop @Iobj OPENED) THEN
X (TorDPRE ($cont @Iobj) "take")
X ELSE
X ($say "You can't reach into the " ($name @Iobj) "\n")
X ($exit 1)
X )
X ELSE
X (TorDPRE ($cont ($loc .ME)) "take")
X )
X;
Xtake( ACTION ) =
X (TorDACT .ME "taken")
X;
X
Xdrop( PREACT ) =
X (Expect ($or ONE_OBJ MULT_OBJ PLAIN_OBJ) ($or NO_OBJ ONE_OBJ PLAIN_OBJ))
X (IF @Iobj THEN
X ($setg IobjSave @Iobj)
X ($setg Iobj 0)
X )
X (TorDPRE ($cont .ME) "drop")
X;
Xdrop( ACTION ) =
X (IF @IobjSave THEN
X (TorDACT @IobjSave "dropped")
X ELSE
X (TorDACT ($loc .ME) "dropped")
X )
X;
X
X
Xput( PREACT ) =
X ($setg Verb drop)
X (($vprop drop PREACT))
X;
Xget( PREACT ) =
X ($setg Verb take)
X (($vprop take PREACT))
X;
X
X
Xopen( PREACT ) = Preact;
Xopen( ACTION ) =
X (IF ($not ($prop ($dobj) OPENS)) THEN
X ($say "I don't know how to open that!\n")
X ($exit 1)
X ELSEIF ($and ($prop ($dobj) LOCKS) ($prop ($dobj) LOCKED)) THEN
X ($say "I can't open it, it's locked!\n")
X ($exit 1)
X ELSEIF ($prop ($dobj) OPENED) THEN
X ($say "It's already open!\n")
X ($exit 1)
X ELSE
X ($setp ($dobj) OPENED TRUE)
X (IF ($and ($ne ($cont ($dobj)) 0) ($not ($prop ($dobj) TRANS))) THEN
X ($say "Opening the " ($name @Dobj) " reveals:\n")
X (Describe 1 ($cont ($dobj)) $sdesc)
X ELSE
X ($say "Opened.\n")
X )
X )
X;
X
X
Xclose( PREACT ) = Preact;
Xclose( ACTION ) =
X (IF ($not ($prop ($dobj) OPENS)) THEN
X ($say "I don't know how to close that!\n")
X ($exit 1)
X ELSEIF ($not ($prop ($dobj) OPENED)) THEN
X ($say "It's already closed!\n")
X ($exit 1)
X ELSE
X ($setp ($dobj) OPENED FALSE)
X ($say "Closed.\n")
X )
X;
X
X
XLockact =
X (IF ($prop ($dobj) LOCKS) THEN
X ($say "Hm, you don't seem to have the right key.\n")
X ELSE
X ($say "I don't know how to lock or unlock such a thing.\n")
X )
X;
X
Xlock( PREACT ) = Preact;
Xlock( ACTION ) = Lockact;
X
Xunlock( PREACT) = Preact;
Xunlock( ACTION ) = Lockact;
X
X
Xmove( PREACT ) = Preact;
Xmove( ACTION ) = ($say "Nothing seems to happen.\n");
X
X
Xbreak( PREACT ) = Preact;
Xbreak( ACTION ) = ($say "It seems to be unbreakable.\n");
X
X
Xtouch( PREACT ) = Preact;
Xtouch( ACTION ) =
X ($say "Touching the " ($name ($dobj)) " doesn't seem too useful.\n")
X;
X
Xrub( PREACT ) = Preact;
Xrub( ACTION ) =
X ($say "Nothing happens when you rub the " ($name ($dobj)) ".\n")
X;
X
X
Xthrow( PREACT ) = Preact;
Xthrow( ACTION ) =
X ($move ($dobj) ($loc .ME))
X ($say "Thrown.\n")
X;
X
X
Xturn( PREACT ) = Preact;
Xturn( ACTION ) = Silly;
X
Xlight( PREACT ) = Preact;
Xlight( ACTION ) = Silly;
X
Xdouse( PREACT ) = Preact;
Xdouse( ACTION ) = Silly;
X
Xread( PREACT ) =
X (Expect ($or ONE_OBJ PLAIN_OBJ) ($or NO_OBJ ONE_OBJ PLAIN_OBJ))
X (IF ($not ($or (See ($dobj) ($cont .ME)) (See ($dobj) ($cont ($loc .ME)))))
X THEN
X ($say "You don't see that here.\n")
X ($exit 1)
X )
X;
Xread( ACTION ) = ($say "It doesn't have anything on it to read.\n");
X
X
Xburn( PREACT ) = Preact;
Xburn( ACTION ) =
X ($say "That doesn't seem to work.\n")
X;
X
X
Xexamine( PREACT ) = Preact;
Xexamine( ACTION ) =
X ($say "You see nothing special about the " ($name @Dobj) ".\n")
X;
X
X
Xlook( PREACT ) =
X (Expect NO_OBJ ($or NO_OBJ ONE_OBJ PLAIN_OBJ))
X (CheckAvail)
X;
Xlook( ACTION ) =
X (Describe 0 ($loc .ME) $ldesc)
X;
X
X
Xinventory( PREACT ) = (Expect NO_OBJ NO_OBJ);
Xinventory( ACTION ) =
X (IF ($not ($cont .ME)) THEN
X ($say "You are empty-handed.\n")
X ($exit 1)
X )
X ($setp .ME SEEN TRUE)
X ($say "You are carrying:\n")
X ($setg Conts TRUE)
X (Describe 1 ($cont .ME) $sdesc)
X;
X
X
Xquit( PREACT ) = (Expect NO_OBJ NO_OBJ);
Xquit( ACTION ) =
X ($say "Are you sure that you want to quit? ")
X (IF ($yorn) THEN
X ($spec QUIT)
X )
X;
X
X
Xsave( PREACT ) = (Expect NO_OBJ NO_OBJ);
Xsave( ACTION ) =
XLOCAL s;
X ($setg MyLoc -1)
X ($setp ($loc .ME) SEEN FALSE)
X ($say "Save to which file? ")
X ($setg s ($read))
X (IF ($leng @s) THEN
X (IF ($spec SAVE @s) THEN
X ($say "Save succeeded.\n")
X ELSE
X ($say "Save failed.\n")
X )
X )
X ($setp ($loc .ME) SEEN TRUE)
X ($setg MyLoc ($loc .ME))
X;
X
X
Xrestore( PREACT ) = (Expect NO_OBJ NO_OBJ);
Xrestore( ACTION ) =
XLOCAL s;
X ($say "Restore from which file? ")
X ($setg s ($read))
X (IF ($leng @s) THEN
X ($spec RESTORE @s)
X { If we make it to this point, the restore didn't happen }
X ($say "Restore failed.\n")
X )
X;
X
X
Xrestart( PREACT ) = (Expect NO_OBJ NO_OBJ);
Xrestart( ACTION ) =
X ($say "Are you sure that you want to restart? ")
X (IF ($yorn) THEN
X ($spec RESTART)
X )
X;
X
X
Xscript( PREACT ) = (Expect NO_OBJ NO_OBJ);
Xscript( ACTION ) =
XLOCAL s;
X (IF @Scripting THEN
X ($spec SCRIPT 0)
X ($say "Scripting turned off.\n")
X ($setg Scripting FALSE)
X ELSE
X ($say "Script to which file? ")
X ($setg s ($read))
X (IF ($leng @s) THEN
X ($say "Scripting turned on.\n")
X ($spec SCRIPT @s)
X ($setg Scripting TRUE)
X )
X )
X;
X
X
XMESSAGE "Done initializing verb routines. Starting Dwimmer.\n" ;
X
X
X{ (Dwimmer Obj) - returns 1 if the object is "possibly the one the
X user meant." Returns 0 otherwise. }
X
XDwimmer =
XLOCAL
X Trans,
X Opened,
X CanSee,
X i;
X
X (IF ($eq ($verb) go) THEN
X { Try to find %1 in the list of Directions }
X ($setg i 0)
X (WHILE ($lt @i 10) DO
X (IF ($eq ($global ($plus _DirArray @i)) %1) THEN
X { We found it! }
X ($return TRUE)
X )
X ($setg i ($plus @i 1))
X )
X { If we get here, we didn't find it. }
X ($return 0)
X ELSEIF ($eq ($verb) take) THEN
X { We don't want to look at stuff .ME is already carrying }
X ($setg Trans ($prop .ME TRANS))
X ($setg Opened ($prop .ME OPENED))
X ($setp .ME TRANS FALSE)
X ($setp .ME OPENED FALSE)
X ($setg CanSee (See %1 ($cont ($loc .ME))))
X ($setp .ME TRANS @Trans)
X ($setp .ME OPENED @Opened)
X ($return @CanSee)
X ELSEIF ($eq ($verb) drop) THEN
X { We need to be transparent }
X ($setg Trans ($prop .ME TRANS))
X ($setg CanSee (See %1 ($cont .ME)))
X ($setp .ME TRANS @Trans)
X ($return @CanSee)
X ELSE
X { This is the default case - it works pretty well }
X ($return ($or (See %1 ($cont .ME)) (See %1 ($cont ($loc .ME)))))
X )
X;
X
X{*** EOF standard.adl ***}
END_OF_samples/standard.adl
if test 26676 -ne `wc -c <samples/standard.adl`; then
echo shar: \"samples/standard.adl\" unpacked with wrong size!
fi
# end of overwriting check
fi
echo shar: End of archive 5 \(of 11\).
cp /dev/null ark5isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 10 11 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have unpacked all 11 archives.
rm -f ark[1-9]isdone ark[1-9][0-9]isdone
echo Making adl.doc
(cd man; cat doc.aa doc.ab doc.ac >adl.doc; rm doc.a[a-c])
else
echo You still need to unpack the following archives:
echo " " ${MISSING}
fi
## End of shell aCanSeX ($sah