games-request@tekred.TEK.COM (08/05/87)
Submitted by: cunniff%hpda@hplabs.HP.COM (Ross Cunniff)
Comp.sources.games: Volume 2, Issue 24
Archive-name: adl/Part07
#! /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 7 (of 11)."
# Contents: adlcomp/adllex.c adlrun/rtparse.c samples/aard/transit.adl
# samples/demos/multi.adl samples/mpu/routines.adl
# samples/mpu/transit.adl
# Wrapped by billr@tekred on Tue Aug 4 16:27:44 1987
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f adlcomp/adllex.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"adlcomp/adllex.c\"
else
echo shar: Extracting \"adlcomp/adllex.c\" \(8789 characters\)
sed "s/^X//" >adlcomp/adllex.c <<'END_OF_adlcomp/adllex.c'
X /***************************************************************\
X * *
X * adllex.c - Lexical anylizer for adlcomp. *
X * Copyright 1987 by Ross Cunniff. *
X * *
X \***************************************************************/
X
X#include <ctype.h>
X#include <stdio.h>
X
X#include "adltypes.h"
X#include "adldef.h"
X#include "vstring.h"
X#include "adlprog.h"
X#include "adlcomp.h"
X
X/* adlchr( c ) is TRUE iff c is a valid character in a token */
X
X#define adlchr( c ) ( \
X isalnum( c ) || \
X ( c == '_' ) || \
X ( c == '%' ) || \
X ( c == '$' ) || \
X ( c == '.' ) || \
X ( c == '-' ) \
X )
X
X/* */
X
X/***************************************************************\
X* *
X* Global variables *
X* *
X\***************************************************************/
X
Xchar token[ 512 ], /* Last token read */
X *EOFMSG = "Unexpected EOF.\n"; /* Message for EOF */
X
Xint16 t_val, /* Value of last token read */
X t_type, /* Type of last token read */
X numerr = 0, /* Number of errors encountered */
X numwarn = 0, /* Number of warnings encountered */
X numline = 1; /* Number of lines read */
X
Xextern
Xint16 debugging, /* Are we generating FILE and LINE code? */
X inrout, /* Are we inside a routine definition? */
X filenum; /* Current file number. */
X
XFILE *infile; /* Current input file */
Xchar inname[ 512 ]; /* Name of current input file */
X
X/* */
X
X /***************************************************************\
X * *
X * lexer() - return the next input token from the input *
X * stream in the form of a value and a type. *
X * *
X \***************************************************************/
X
Xlexer()
X{
X int16 t;
X
X if( gettoken( token ) == EOF ) {
X /* We reached the end of file. */
X t_type = EOF;
X return;
X }
X
X if( isnumber( token ) ) {
X /* This token is a constant number. */
X t_val = atoi( token );
X t_type = CONST;
X return;
X }
X
X else if( adlchr( *token ) ) {
X if( *token == '%' ) {
X /* This token should be an argument number */
X if( !isnumber( token + 1 ) )
X error( "Illegal argument number.\n" );
X t_val = atoi( token + 1 );
X t_type = ARGUMENT;
X return;
X }
X
X /* This token should be an identifier. */
X if( !adlident( token ) )
X error( "Illegal token.\n" );
X
X t = lookup( token, &t_val, 0 );
X if( t >= 0 ) {
X /* This token has already been declared. */
X t_type = t;
X return;
X }
X else {
X /* This token has not previously been declared */
X t_type = UNDECLARED;
X return;
X }
X }
X
X else if( *token == '"' ) {
X /* This token is a compile time string */
X t_val = newstr( token + 1 );
X t_type = STRING;
X return;
X }
X
X else {
X /* This token is punctuation */
X t_type = *token;
X return;
X }
X}
X
X/* */
X
X /***************************************************************\
X * *
X * gettoken( s ) - returns the next token from infile in *
X * s. A token is a number, an identifier, a string, *
X * or punctuation. *
X * *
X \***************************************************************/
X
Xgettoken( s )
Xchar *s;
X{
X int ch;
X int count = 0;
X
X ch = eatwhite(); /* Get rid of unneeded white space */
X
X if( ch == '"' )
X /* Get a string */
X return getstring( s );
X
X else {
X /* Get an identifier, number, or argument. */
X while( adlchr( ch ) ) {
X count++;
X *s++ = ch;
X ch = mygetc();
X }
X if( count ) {
X /* We read more than one character. */
X if( ch != EOF )
X /* We read a character which should be read later */
X ch = myunget( ch );
X }
X else
X *s++ = ch;
X *s = '\0';
X return ch;
X } /* else */
X} /* gettoken */
X
X/* */
X
X /***************************************************************\
X * *
X * eatwhite() - eats up white space and comments from *
X * the infile. *
X * *
X \***************************************************************/
X
Xeatwhite()
X{
X int ch;
X char s[ 512 ];
X
X for( ch = mygetc();
X (ch == ' ')||(ch == '\t')||(ch == '{')||(ch == '\n');
X ch = mygetc() ) {
X if( ch == '{' ) {
X for( ch = mygetc(); (ch != '}'); ch = mygetc() ) {
X /* Eat up the comment */
X if( ch == EOF )
X fatal( EOFMSG );
X else if( ch == '"' )
X /* Don't allow quoted comments to confuse us */
X ch = getstring( s );
X } /* for */
X } /* if */
X } /* for */
X return ch;
X}
X
X/* */
X
X /***************************************************************\
X * *
X * getstring( s ) - reads a quoted string from the infile, *
X * approprately transforming escape sequences, and returns *
X * the string in s. *
X * *
X \***************************************************************/
X
Xgetstring( s )
Xchar *s;
X{
X int ch, n;
X
X n = 0;
X *s++ = '"';
X for( ch = mygetc(); (ch != '"'); ch = mygetc() ) {
X if( ++n == 511 )
X error( "String too long.\n" );
X if( ch == '\\' ) {
X if( (ch = getescape()) == EOF )
X fatal( EOFMSG );
X if( n < 511 )
X *s++ = ch;
X }
X else if( ch == EOF )
X fatal( EOFMSG );
X else {
X if( ch == '\n' )
X ch = ' ';
X if( n < 511 )
X *s++ = ch;
X }
X }
X *s = '\0';
X if( ch == EOF )
X return EOF;
X else
X return ' ';
X} /* getstring */
X
X
X /***************************************************************\
X * *
X * getescape() - reads an escape sequence such as \n or *
X * \b or \033 from the infile and returns the translated *
X * character.
X * *
X \***************************************************************/
X
Xgetescape()
X{
X int t, ch;
X int count;
X
X ch = mygetc();
X if( isdigit( ch ) ) {
X count = 1;
X t = ch - '0';
X while( isdigit( ch = mygetc() ) && (count++ <= 3) )
X t = t * '\010' + ch - '0';
X if( ch != EOF )
X ch = myunget( ch );
X }
X else
X switch( ch ) {
X case 'n' : t = '\n'; break;
X case 't' : t = '\t'; break;
X case 'b' : t = '\b'; break;
X case 'r' : t = '\r'; break;
X case 'f' : t = '\f'; break;
X case '\\' : t = '\\'; break;
X default : t = ch;
X } /* switch */
X return t;
X}
X
X/* */
X
X /***************************************************************\
X * *
X * Token type query routines. These two routines verify *
X * whether a token is of the appropriate type. They are: *
X * *
X * isnumber( s ) - TRUE iff s is a decimal number *
X * adlident( s ) - TRUE iff s is a legal ADL ident *
X * *
X \***************************************************************/
X
Xisnumber( s )
Xchar *s;
X{
X if( *s == '-' ) /* Skip initial '-' */
X s++;
X while( *s )
X if( !isdigit( *s ) )
X return 0;
X else
X s++;
X return 1;
X}
X
X
Xadlident( s )
Xchar *s;
X{
X if( (*s == '$') || (*s == '.') || (*s == '_') || (*s == '-') )
X s++;
X if( !isalpha( *s ) )
X return 0;
X s++;
X while( *s )
X if( !(isalnum( *s ) || (*s == '_') || (*s == '-')) )
X return 0;
X else
X s++;
X return 1;
X}
X
X/* */
X
X /***************************************************************\
X * *
X * These routines handle the actual i/o with the infile. *
X * They keep track of the current line number. They are: *
X * *
X * mygetc() - return the next char from infile *
X * myunget( c ) - push c back into the infile *
X * *
X \***************************************************************/
X
Xmygetc()
X{
X int result;
X int breaker();
X
X result = getc( infile );
X if( result == '\n' ) {
X checkbreak( breaker ); /* Check for ^C */
X numline++;
X emit_file();
X }
X return result;
X}
X
X
Xmyunget( c )
Xint c;
X{
X if( c == '\n' )
X numline--;
X return ungetc( c, infile );
X}
X
X
X /***************************************************************\
X * *
X * emit_file() - if debugging mode is set, and we are *
X * compiling a routine, emit the file number and line *
X * number into the code space, for better error tracking. *
X * *
X \***************************************************************/
X
Xemit_file()
X{
X if( debugging && inrout ) {
X newcode( FILEN, filenum );
X newcode( LINEN, numline );
X }
X}
X
X/* */
X
X /***************************************************************\
X * *
X * The following routines are here to hide the details *
X * implementation of the input files from the routines *
X * which use the lexer. The routines are: *
X * *
X * open_input( name ) - open the infile *
X * close_input() - close the infile *
X * save_input( &buf ) - save the infile *
X * restore_input( buf ) - restore the infile *
X * *
X \***************************************************************/
X
Xopen_input( name )
Xchar *name;
X{
X infile = fopen( name, "r" );
X if( infile == (FILE *)NULL )
X return 0;
X else
X return 1;
X}
X
X
Xclose_input()
X{
X fclose( infile );
X}
X
X
Xsave_input( buffer )
Xchar **buffer;
X{
X *buffer = (char *)infile;
X}
X
X
Xrestore_input( buffer )
Xchar *buffer;
X{
X infile = (FILE *)buffer;
X}
X
X/*** EOF adllex.c ***/
END_OF_adlcomp/adllex.c
if test 8789 -ne `wc -c <adlcomp/adllex.c`; then
echo shar: \"adlcomp/adllex.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f adlrun/rtparse.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"adlrun/rtparse.c\"
else
echo shar: Extracting \"adlrun/rtparse.c\" \(8946 characters\)
sed "s/^X//" >adlrun/rtparse.c <<'END_OF_adlrun/rtparse.c'
X#include <stdio.h>
X
X#include "adltypes.h"
X#include "adlprog.h"
X#include "adldef.h"
X#include "adlrun.h"
X
X#define FIN 100 /* Final state */
X#define XXX -100 /* Default action in action table */
X#define ERR -100 /* Error state in transit table */
X
Xint16
X state, /* Current state for finite state machine */
X Tnoun, /* Temporary storage for current noun. */
X Tmod, /* Temporary storage for current adjective. */
X P1, P2, /* Temporary storage for prepositions */
X C1; /* Temporary storage for the last CONJ typed. */
Xchar
X kludge[ SLEN ], /* Static area for s */
X s_str[ SLEN ]; /* End-of-string save for TELLER */
X
X
Xint16 trantab[ 15 ][ 10 ] = {
X/*
X * Transit table for state machine
X *
X * NOUN
X * PREP VERB STR ADJ NOUN SYN ART CONJ "," SEP
X */
X/* 0 */ { 4, 1, 2, 12, 12, 12, 12, ERR, ERR, FIN },
X/* 1 */ { 4, 2, 2, 2, 2, 2, 2, ERR, ERR, FIN },
X/* 2 */ { 4, 3, 3, 3, 3, 3, 3, 5, 5, FIN },
X/* 3 */ { 11, ERR, ERR, ERR, ERR, ERR, ERR, 6, 6, FIN },
X/* 4 */ { 9, 7, 7, 7, 7, 7, 7, ERR, ERR, FIN },
X/* 5 */ { ERR, 8, 8, 8, 8, 8, 8, 5, 5, ERR },
X/* 6 */ { ERR, 3, 3, 3, 3, 3, 3, 6, 6, ERR },
X/* 7 */ { 9, ERR, ERR, ERR, ERR, ERR, ERR, ERR, ERR, FIN },
X/* 8 */ { 4, ERR, ERR, ERR, ERR, ERR, ERR, 5, 5, FIN },
X/* 9 */ { ERR, 10, 10, 10, 10, 10, 10, ERR, ERR, FIN },
X/*10 */ { 11, ERR, ERR, ERR, ERR, ERR, ERR, ERR, ERR, FIN },
X/*11 */ { ERR, ERR, ERR, ERR, ERR, ERR, ERR, ERR, ERR, FIN },
X/*12 */ { 4, 3, 3, 3, 3, 3, 3, 5, 13, FIN },
X/*13 */ { ERR, 14, 14, 8, 8, 8, 8, ERR, ERR, ERR },
X/*14 */ { ERR, ERR, ERR, ERR, ERR, ERR, ERR, ERR, ERR, FIN } };
X
Xint16 actions[ 15 ][ 10 ] = {
X/*
X * Action table for state machine
X * NOUN
X * PREP VERB STR ADJ NOUN SYN ART CONJ "," SEP
X */
X/* 0 */ { 2, 0, 1, 1, 1, 1, 1, 500, 500, XXX },
X/* 1 */ { 3, 1, 1, 1, 1, 1, 1, 501, 501, XXX },
X/* 2 */ { 7, 5, 5, 5, 5, 5, 5, 6, 6, 4 },
X/* 3 */ { 2, 502, 502, 502, 502, 502, 502, 8, 8, XXX },
X/* 4 */ { 9, 1, 1, 1, 1, 1, 1, 501, 501, 10 },
X/* 5 */ { 501, 11, 11, 11, 11, 11, 11, 8, 8, 501 },
X/* 6 */ { 501, 11, 11, 11, 11, 11, 11, 8, 8, 501 },
X/* 7 */ { 13, 502, 502, 502, 502, 502, 502, 502, 502, 12 },
X/* 8 */ { 2, 502, 502, 502, 502, 502, 502, 8, 8, XXX },
X/* 9 */ { 501, 15, 15, 15, 15, 15, 15, 501, 501, 14 },
X/*10 */ { 2, 502, 502, 502, 502, 502, 502, 502, 502, XXX },
X/*11 */ { 503, 503, 503, 503, 503, 503, 503, 503, 503, 10 },
X/*12 */ { 7, 5, 5, 5, 5, 5, 5, 6, 16, 4 },
X/*13 */ { 501, 19, 18, 17, 17, 17, 17, 501, 501, 501 },
X/*14 */ { 503, 503, 503, 503, 503, 503, 503, 503, 503, XXX } };
X
Xstatic
Xp_error( n )
Xint
X n;
X{
X char
X str[ 200 ];
X
X switch( n ) {
X case -3 :
X sprintf( str,
X "I got confused trying to expand \"%s\" to \"%s\"\n",
X s, xp );
X break;
X case -2 :
X sprintf( str, "\"%s\" is not a valid abbreviation.\n", s );
X break;
X case -1 :
X sprintf( str, "I don't know the word \"%s\".\n", s );
X break;
X case 500 :
X sprintf( str, "\"%s\" is not a verb.\n", s );
X break;
X case 501 :
X sprintf( str, "\"%s\" is not part of a noun phrase.\n", s );
X break;
X case 502 :
X sprintf( str, "\"%s\" is not a preposition.\n", s );
X break;
X case 503 :
X sprintf( str, "End of sentence expected.\n" );
X break;
X case 504 :
X sprintf( str, "Illegal multiple word verb phrase.\n" );
X break;
X case 505 :
X sprintf( str, "Too many direct objects.\n" );
X break;
X case 506 :
X sprintf( str, "Illegal multiple word preposition.\n" );
X break;
X default :
X sprintf( str, "I don't understand that.\n", n );
X }
X sayer( str );
X state = ERR;
X}
X
X
Xstatic
XGet_Noun()
X{
X Tmod = 0;
X Tnoun = 0;
X
X /* Check to see whether the object is a string */
X if( t_type == STRING ) {
X Tnoun = t_val;
X return 1;
X }
X
X /* The object is not a string. Find a noun phrase */
X
X /* Skip the article */
X if( t_type == ART )
X gettoken( 0 );
X
X /* Check to see whether we have a full-fledged object. */
X if( t_type == NOUN_SYN ) {
X Tnoun = objspace[ t_val ].noun;
X Tmod = objspace[ t_val ].adj;
X return 1;
X }
X
X /* Check for a modifier (adjective or verb) */
X if( t_type == ADJEC ) {
X Tmod = t_val;
X gettoken( 0 );
X }
X else if( t_type == VERB ) {
X Tmod = -t_val;
X gettoken( 0 );
X }
X
X /* Check for the noun */
X if( t_type == NOUN ) {
X Tnoun = t_val;
X return 1;
X }
X
X if( t_type < 0 ) {
X p_error( t_type ); /* Dictionary error */
X return 0;
X }
X else if( (Tmod == 0) && (Tnoun == 0) ) {
X p_error( 501 ); /* S is not a noun. */
X return 0;
X }
X else {
X read_t = 0; /* Skip the next token */
X return 1; /* Found adjective, but no noun, */
X } /* so we'll leave it up to the dwimmer to figure
X it out */
X}
X
X
XFind_PP( Prep1, Mod, Noun, Prep2 )
X{
X int16
X i,
X obj;
X
X if( Noun || Mod ) {
X if( (obj = noun_exists( Mod, Noun )) < 0 )
X return -1;
X }
X else
X obj = 0;
X for( i = 0; i < NUMPP; i++ )
X if( prepspace[ i ].first == Prep &&
X prepspace[ i ].obj == obj &&
X prepspace[ i ].last == t_val )
X {
X return prepspace[ i ].val;
X }
X return -1;
X}
X
X
XFind_VP( verb, prep )
Xint16
X verb, prep;
X{
X int16
X i;
X
X for( i = 0; i < NUMVS; i++ )
X if( (verb == verbsyn[ i ].vrb) && (prep == verbsyn[ i ].prp) )
X return verbsyn[ i ].val;
X return -1;
X}
X
X
XPerform_Action( which )
Xint
X which;
X{
X int16
X x; /* Temporary used for lookups */
X
X switch( which ) {
X case 0 :
X Verb = t_val;
X break;
X case 1 :
X Get_Noun();
X break;
X case 2 :
X P1 = t_val;
X break;
X case 3 :
X if( (x = Find_VP( Verb, t_val )) >= 0 ) {
X Verb = x;
X state = 1;
X }
X else
X P1 = t_val;
X break;
X case 4 :
X Dmod[ 0 ] = Tmod; Dnoun[ 0 ] = Tnoun; Conj[ 0 ] = 0;
X NumDobj = 1;
X break;
X case 5 :
X Imod = Tmod; Inoun = Tnoun;
X Get_Noun();
X Dmod[ 0 ] = Tmod; Dnoun[ 0 ] = Tnoun; Conj[ 0 ] = 0;
X NumDobj = 1;
X break;
X case 6 :
X Dmod[ 0 ] = Tmod; Dnoun[ 0 ] = Tnoun; Conj[ 1 ] = t_val;
X NumDobj = 1;
X break;
X case 7 :
X Dmod[ 0 ] = Tmod; Dnoun[ 0 ] = Tnoun; Conj[ 0 ] = 0;
X NumDobj = 1;
X P1 = t_val;
X break;
X case 8 :
X Conj[ NumDobj ] = t_val;
X break;
X case 9 :
X P2 = t_val; Tmod = Tnoun = 0;
X break;
X case 10 :
X if( (x = Find_VP( Verb, P1 )) >= 0 )
X Verb = x;
X else
X p_error( 504 ); /* Illegal verb phrase */
X break;
X case 11 :
X if( NumDobj >= NUMDO ) {
X p_error( 505 ); /* Too many direct objects */
X break;
X }
X Get_Noun();
X Dmod[ NumDobj ] = Tmod; Dnoun[ NumDobj ] = Tnoun;
X NumDobj++;
X break;
X case 12 :
X Imod = Tmod; Inoun = Tnoun;
X Prep = P1;
X break;
X case 13 :
X P2 = t_val;
X break;
X case 14 :
X if( (Tnoun != 0) || (Tmod != 0) ) {
X Imod = Tmod; Inoun = Tnoun; Prep = P1;
X if( (x = Find_VP( Verb, P2 )) >= 0 )
X Verb = x;
X else
X p_error( 504 ); /* Illegal verb phrase */
X }
X else {
X if( (x = Find_PP( P1, Tmod, Tnoun, P2 )) >= 0 ) {
X P1 = x;
X if( (x = Find_VP( Verb, P1 )) >= 0 )
X Verb = x;
X else
X p_error( 504 ); /* Illegal verb phrase */
X }
X else
X p_error( 506 ); /* Illegal prep phrase */
X }
X break;
X case 15 :
X if( (x = Find_PP( P1, Tmod, Tnoun, P2)) >= 0 )
X Prep = x;
X else {
X p_error( 506 ); /* Illegal prep phrase */
X break;
X }
X Get_Noun();
X Imod = Tmod; Inoun = Tnoun;
X break;
X case 16 :
X C1 = t_val;
X strcpy( s_str, PSTRING );
X break;
X case 17 :
X Dmod[ 0 ] = Tmod; Dnoun[ 0 ] = Tnoun; Conj[ 0 ] = 0;
X Conj[ 1 ] = C1;
X Get_Noun();
X Dmod[ 1 ] = Tmod; Dnoun[ 1 ] = Tnoun; NumDobj = 2;
X break;
X case 18 :
X Imod = Tmod; Inoun = Tnoun;
X Dmod[ 0 ] = 0; Dnoun[ 0 ] = t_val; NumDobj = 1;
X Verb = _TELLER;
X break;
X case 19 :
X Imod = Tmod; Inoun = Tnoun;
X Dmod[ 0 ] = 0; Dnoun[ 0 ] = newtstr( s_str ); NumDobj = 1;
X Verb = _TELLER;
X *PSTRING = '\0';
X break;
X }
X}
X
X
Xinitvars()
X{
X int
X i;
X
X read_t = 1;
X state = 1; /* Initial state */
X s = kludge;
X NumDobj = Prep = Iobj = Inoun = Imod = Verb = 0;
X for( i=0; i < NUMDO; i++ )
X Dobj[ i ] = Conj[ i ] = Dnoun[ i ] = Dmod[ i ] = 0;
X}
X
X
Xparse()
X{
X int16
X done,
X act;
X
X done = 0; read_t = 1; state = 0;
X s = kludge; Tmod = Tnoun = P1 = P2 = C1 = 0;
X while( !done ) {
X gettoken( 0 );
X if( t_type < 0 )
X p_error( t_type ); /* Dictionary error */
X else {
X act = actions[ state ][ t_type - MIN_RT ];
X state = trantab[ state ][ t_type - MIN_RT ];
X if( state == ERR )
X p_error( act );
X else
X Perform_Action( act );
X }
X if( state == FIN )
X done = 2;
X else if( state == ERR )
X done = 1;
X } /* while */
X return done - 1;
X} /* parse */
X
X/*** EOF rtparse.c ***/
END_OF_adlrun/rtparse.c
if test 8946 -ne `wc -c <adlrun/rtparse.c`; then
echo shar: \"adlrun/rtparse.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f samples/aard/transit.adl -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"samples/aard/transit.adl\"
else
echo shar: Extracting \"samples/aard/transit.adl\" \(10696 characters\)
sed "s/^X//" >samples/aard/transit.adl <<'END_OF_samples/aard/transit.adl'
X{*** FUNNY TRANSITION ROUTINES ***}
X
Xexitg =
X ($say "Oh dear, you seem to have gotten yourself killed.\n")
X (skore)
X (ratng)
X (ratnx)
X (IF ($not ($prop .ME debug)) THEN
X ($spec QUIT)
X )
X;
X
X
Xem3 =
X (IF ($not ($prop paper signed)) THEN
X (cg)
X ($return 0)
X )
X ($move .ME irm1)
X;
X
X
Xei8 =
X (IF ($eq ($loc spices) .ME) THEN
X ($say
X"The savory blend of spices and human wakes up the sleeping crocodiles who
Xdecide to have you for breakfast.\n"
X )
X (exitg)
X ELSEIF ($eq ($loc rupees) .ME) THEN
X ($say
X"The weight of the coins pulls you underwater and you eventually drown.\n"
X )
X (exitg)
X ELSE
X ($say
X"You manage to get across the river, just as the crocodiles
Xbegin to stir.\n"
X )
X ($move .ME irm9)
X )
X;
X
X
Xwi12 =
X (IF ($not ($prop statue tlakst)) THEN
X (cg)
X ($return 0)
X )
X ($move .ME irm14)
X;
X
X
Xui16 =
X (IF ($not ($prop rope ropstf)) THEN
X (cg)
X ($return 0)
X )
X ($say "You scramble up the rope and get to the ledge.\n")
X ($move .ME irm17)
X;
X
X
Xui17 =
X ($say "Are you a rock climber? \n")
X (IF ($not ($yorn)) THEN
X ($say "Then you better not try it.\n")
X ($return 0)
X )
X ($say "That climb is rated 5.11. Do you still want to try it?\n")
X (IF ($not ($yorn)) THEN
X ($say "Wise move.\n")
X ($return 0)
X )
X ($say
X"Half way up, you fall off a 1/32 inch wide ledge and
Xplummet to your death.\n"
X )
X (exitg)
X;
X
X
Xdi19 =
X ($say
X"You magically get transported to the corner of Westwood and
XBroxton, where you are forced to spend the rest of eternity surrounded by
XHari-Krishna freaks. (That'll teach you not to believe legends.)\n"
X )
X ($spec QUIT)
X;
X
X
Xei20 =
X (IF ($not ($prop monkey fedmky)) THEN
X (cg)
X ($return 0)
X )
X ($move .ME irm21)
X;
X
X
Xwi21 =
X (IF ($eq ($loc peel) irm20) THEN
X ($say
X"As you leave the temple, you slip on a banana peel and break your neck.\n"
X )
X (exitg)
X )
X ($move .ME irm20)
X;
X
X
Xdi22 =
X (IF ($eq ($loc cobra) irm22) THEN
X ($say
X"The cobra takes a bite at your unprotected leg and injects an
Xunhealthy dose of neurotoxin. You start to lose your senses, your
Xcognitive abilities, an yer rekcogiskdfsdk.\n"
X )
X (exitg)
X )
X ($move .ME irm23)
X;
X
X
Xsm5 =
X (IF ($not ($prop paper signed)) THEN
X ($say "You bumped into the grate.\n")
X ($return 0)
X )
X ($move .ME prm1)
X;
X
X
Xdp2 =
X (IF ($eq ($prop rope rtied) 0) THEN
X ($say "It is too dangerous to climb down without a rope.\n")
X ($return 0)
X )
X (IF ($and ($eq ($loc lamp) .ME) ($prop lamp LIGHT)) THEN
X ($say
X"Half-way down the rope, the carbide lamp burns through the
Xrope above you and you plummet to your death.\n"
X )
X (exitg)
X )
X ($say "You climb down the rope without any problems.\n")
X ($move .ME prm3)
X;
X
X
Xep5 =
X (IF ($eq ($loc spear) .ME) THEN
X ($say "You can't fit the spear you are carrying through that crack.\n")
X ($exit 1)
X )
X ($move .ME prm6)
X;
X
X
Xep8 =
X ($say
X"You fall off the cliff and plummet several hundred feet to your
Xdeath.\n"
X )
X (exitg)
X;
X
X
Xdp6 =
X (IF ($not ($prop smilo stond)) THEN
X ($say
X"As soon as you reach the bottom of the pit, the sabre-tooth
Xtiger tears you to shreads.\n"
X )
X (exitg)
X )
X ($move .ME prm7)
X;
X
X
Xep10 =
X ($say
X"You fall into the lake, which actually turns out to be a
Xtar-pit covered with a thin layer of rain water. You eventually sink and
Xget fossilized.\n"
X )
X (exitg)
X;
X
X
Xep11 =
X (IF ($not ($prop feet wiped)) THEN
X ($move .ME prm10)
X ($exit 1)
X )
X ($say
X"As you walk down the slab, your feet slip and you tumble
Xoff the slab.\n"
X )
X (ep10)
X;
X
X
Xsp12 =
X ($say "You find your feet to be quite slippery as you walk.\n")
X ($setp feet wiped 1)
X ($move .ME prm11)
X;
X
X
Xsp14 =
X (IF ($not ($prop mammoth blokd)) THEN
X ($say "The mammoth keeps you from going that way.\n")
X ($exit 1)
X )
X ($move .ME prm15)
X;
X
X
Xnp17 =
X (IF ($and ($eq ($prop spear tooky) 1) ($eq ($prop spear abrad) 0)) THEN
X ($say "The rubble keeps you from going in that direction.\n")
X ($exit 1)
X )
X ($move .ME prm18)
X;
X
X
Xnp19 =
X (IF ($not ($prop bear hitbr)) THEN
X ($say "The bear keeps you from going that direction.\n")
X ($exit 1)
X )
X ($move .ME prm20)
X;
X
X
Xwp22 =
X (IF ($eq ($loc spear) .ME) THEN
X ($say
X"The spear that you were carrying lodges in the tyranosaur's mouth.\n"
X )
X ($move spear prm23)
X ($move .ME prm23)
X )
X (IF ($eq ($loc spear) prm23) THEN
X ($move .ME prm23)
X )
X (IF ($and ($ne ($loc spear) .ME) ($ne ($loc spear) prm23)) THEN
X ($say "The tyranosaur crushes you in his jaws and then swallows you.\n")
X (exitg)
X )
X;
X
X
Xdp23 =
X ($say
X"You slide down the gullet of the tyranosaur and get
Xdigested alive.\n"
X )
X (exitg)
X;
X
X
Xdm6 =
X ($say
X"After wandering around in the forest for a while, you eventually
Xfind your way out.\n"
X )
X ($move .ME mrm1)
X;
X
X
Xdarkq =
X (IF ($not (Lit ($loc .ME))) THEN
X (IF %0 THEN
X ($return 1)
X )
X ($say "It is too dark to see anything in here.\n")
X ($exit 0)
X )
X ($return 0)
X;
X
X
Xdarkt =
X (IF ($not (Lit ($loc .ME))) THEN
X (IF ($pct 50) THEN
X ($say
X"While stumbling around in the darkness, you trip and impale yourself on a
Xstalagmite.\n"
X )
X (exitg)
X )
X )
X;
X
X
Xonlmp =
X (IF ($ne ($loc lamp) .ME) THEN
X ($say "You don't have the lamp with you.\n")
X ($exit 1)
X )
X (IF ($not ($prop lamp LIGHT)) THEN
X ($say "A blue flame now flickers out of the lantern.\n")
X ($setp lamp LIGHT 1)
X ($exit 1)
X )
X;
X
X
X{*** TRANSITIONS ***}
X
Xmrm1(ACTION) =
X ($hit .ME mrm6 mrm2 mrm6 mrm6 0 0 mrm2 0 0 0)
X ($miss 0 0 0 0 cg cg 0 dumdir 0 0)
X;
X
X
Xmrm2(ACTION) =
X ($hit .ME mrm1 mrm4 mrm3 mrm4 0 mrm5 0 0 0 0)
X ($miss 0 0 0 0 cg 0 dumdir dumdir 0 0)
X;
X
X
Xmrm3(ACTION) =
X ($hit .ME 0 0 0 mrm2 0 0 0 0 0 0)
X ($miss cg cg em3 0 cg cg dumdir dumdir 0 0)
X;
X
X
Xmrm4(ACTION) =
X ($hit .ME mrm2 0 0 0 0 0 0 mrm2 0 0)
X ($miss 0 cg cg cg cg cg cg 0 0 0)
X;
X
X
Xmrm5(ACTION) =
X ($hit .ME 0 0 0 0 mrm2 0 0 0 0 0)
X ($miss cg sm5 cg cg 0 cg dumdir dumdir 0 0)
X;
X
X
Xmrm6(ACTION) =
X ($hit .ME 0 0 0 0 0 0 0 0 0 0)
X ($miss dm6 dm6 dm6 dm6 cg cg dumdir dm6 0 0)
X;
X
X
Xirm1(ACTION) =
X ($hit .ME 0 0 0 mrm3 0 irm2 0 0 0 0)
X ($miss cg cg cg 0 cg 0 dumdir dumdir 0 0)
X;
X
X
Xirm2(ACTION) =
X ($hit .ME 0 0 irm10 irm3 irm1 0 0 0 0 0)
X ($miss cg cg 0 0 0 cg dumdir dumdir 0 0)
X;
X
X
Xirm3(ACTION) =
X ($hit .ME irm4 0 irm2 0 0 0 0 0 0 0)
X ($miss 0 cg 0 cg cg cg dumdir dumdir 0 0)
X;
X
X
Xirm4(ACTION) =
X ($hit .ME 0 irm3 0 0 0 irm5 0 irm3 0 0)
X ($miss cg 0 cg cg cg 0 dumdir 0 0 0)
X;
X
X
Xirm5(ACTION) =
X ($hit .ME irm6 irm7 irm8 0 0 0 0 0 0 0)
X ($miss 0 0 0 cg tohigh cg dumdir dumdir 0 0)
X;
X
X
Xirm6(ACTION) =
X ($hit .ME 0 irm5 0 irm7 0 0 0 0 0 0)
X ($miss tosml 0 cg 0 cg cg dumdir dumdir 0 0)
X;
X
X
Xirm7(ACTION) =
X ($hit .ME irm5 0 irm6 0 0 0 0 0 0 0)
X ($miss 0 cg 0 cg cg cg dumdir dumdir 0 0)
X;
X
X
Xirm8(ACTION) =
X ($hit .ME 0 0 0 irm5 0 0 0 irm5 0 0)
X ($miss cg cg ei8 0 cg cg dumdir 0 0 0)
X;
X
X
Xirm9(ACTION) =
X ($hit .ME 0 0 0 irm8 irm10 0 0 irm10 0 0)
X ($miss cg cg cg 0 0 cg dumdir 0 0 0)
X;
X
X
Xirm10(ACTION) =
X ($hit .ME 0 irm11 irm22 irm2 0 irm9 0 0 0 0)
X ($miss cg 0 0 0 cg 0 dumdir dumdir 0 0)
X;
X
X
Xirm11(ACTION) =
X ($hit .ME irm10 irm12 0 irm13 0 0 0 0 0 0)
X ($miss 0 0 cg 0 cg cg cg cg 0 0)
X;
X
X
Xirm12(ACTION) =
X ($hit .ME irm11 0 irm15 0 0 0 0 0 0 0)
X ($miss 0 cg 0 wi12 cg cg dumdir dumdir 0 0)
X;
X
X
Xirm13(ACTION) =
X ($hit .ME 0 irm15 irm11 0 0 0 0 0 0 0)
X ($miss cg 0 0 cg cg cg dumdir dumdir 0 0)
X;
X
X
Xirm14(ACTION) =
X ($hit .ME 0 0 irm12 0 0 0 0 irm12 0 0)
X ($miss cg cg 0 cg cg cg dumdir 0 0 0)
X;
X
X
Xirm15(ACTION) =
X ($hit .ME irm13 0 irm16 irm12 0 0 0 0 0 0)
X ($miss 0 cg 0 0 cg cg dumdir dumdir 0 0)
X;
X
X
Xirm16(ACTION) =
X ($hit .ME irm22 0 irm18 irm15 0 0 0 0 0 0)
X ($miss 0 cg 0 0 ui16 cg dumdir dumdir 0 0)
X;
X
X
Xirm17(ACTION) =
X ($hit .ME 0 0 0 0 0 irm16 0 0 0 0)
X ($miss cg cg cg cg ui17 0 dumdir dumdir 0 0)
X;
X
X
Xirm18(ACTION) =
X ($hit .ME 0 irm19 irm20 irm16 0 0 0 0 0 0)
X ($miss cg 0 0 0 cg cg dumdir dumdir 0 0)
X;
X
X
Xirm19(ACTION) =
X ($hit .ME irm18 0 0 0 0 0 0 irm18 0 0)
X ($miss 0 cg cg tosml cg di19 dumdir 0 0 0)
X;
X
X
Xirm20(ACTION) =
X ($hit .ME 0 0 0 irm18 0 0 0 0 0 0)
X ($miss cg cg ei20 0 cg cg dumdir dumdir 0 0)
X;
X
X
Xirm21(ACTION) =
X ($miss cg cg cg wi21 cg cg dumdir wi21 0 0)
X;
X
X
Xirm22(ACTION) =
X ($hit .ME 0 irm16 0 irm10 0 0 0 0 0 0)
X ($miss cg 0 cg 0 cg di22 di22 cg 0 0)
X;
X
X
Xirm23(ACTION) =
X ($hit .ME 0 0 0 0 irm22 0 0 irm22 0 0)
X ($miss cg cg cg cg 0 cg dumdir 0 0 0)
X;
X
X
Xprm1(ACTION) =
X (darkt)
X ($hit .ME mrm5 prm2 0 0 0 0 0 0 0 0)
X ($miss 0 0 cg cg cg cg dumdir dumdir 0 0)
X;
X
X
Xprm2(ACTION) =
X ($hit .ME prm1 0 0 0 0 0 0 0 0 0)
X ($miss 0 cg cg cg cg dp2 dumdir dumdir 0 0)
X;
X
X
Xprm3(ACTION) =
X ($hit .ME 0 0 0 prm4 prm2 0 0 0 0 0)
X ($miss cg cg cg 0 0 cg dumdir dumdir 0 0)
X;
X
X
Xprm4(ACTION) =
X ($hit .ME 0 prm5 prm3 prm9 0 0 prm5 0 0 0)
X ($miss cg 0 0 0 cg cg 0 dumdir 0 0)
X;
X
X
Xprm5(ACTION) =
X (darkt)
X ($hit .ME prm4 0 0 0 0 0 0 prm4 0 0)
X ($miss 0 cg ep5 cg cg cg dumdir 0 0 0)
X;
X
X
Xprm6(ACTION) =
X (darkt)
X ($hit .ME 0 0 0 prm5 0 0 0 0 0 0)
X ($miss cg cg cg 0 cg dp6 dumdir dumdir 0 0)
X;
X
X
Xprm7(ACTION) =
X (darkt)
X ($hit .ME 0 prm8 0 0 prm6 0 0 0 0 0)
X ($miss cg 0 cg cg 0 cg dumdir dumdir 0 0)
X;
X
X
Xprm8(ACTION) =
X (darkt)
X ($hit .ME prm7 0 0 0 0 0 0 0 0 0)
X ($miss 0 cg ep8 cg cg cg dumdir dumdir 0 0)
X;
X
X
Xprm9(ACTION) =
X ($hit .ME prm10 0 prm4 prm13 0 0 0 0 0 0)
X ($miss 0 cg 0 0 cg cg dumdir dumdir 0 0)
X;
X
X
Xprm10(ACTION) =
X ($hit .ME 0 prm9 0 prm11 prm11 0 0 0 0 0)
X ($miss cg 0 ep10 0 0 cg dumdir dumdir 0 0)
X;
X
X
Xprm11(ACTION) =
X ($hit .ME prm12 0 0 0 0 0 0 0 0 0)
X ($miss 0 cg ep11 cg cg ep11 dumdir dumdir 0 0)
X;
X
X
Xprm12(ACTION) =
X ($miss cg sp12 cg cg cg cg dumdir dumdir 0 0)
X;
X
X
Xprm13(ACTION) =
X ($hit .ME 0 prm14 prm9 prm16 0 0 0 0 0 0)
X ($miss cg 0 0 0 cg cg dumdir dumdir 0 0)
X;
X
X
Xprm14(ACTION) =
X ($hit .ME prm13 0 0 0 0 0 0 0 0 0)
X ($miss 0 sp14 tosml cg cg cg dumdir dumdir 0 0)
X;
X
X
Xprm15(ACTION) =
X ($hit .ME prm14 0 0 0 0 0 0 0 0 0)
X ($miss 0 cg cg cg cg cg dumdir dumdir 0 0)
X;
X
X
Xprm16(ACTION) =
X ($hit .ME prm17 0 prm13 0 0 prm21 0 0 0 0)
X ($miss 0 cg 0 cg cg 0 dumdir dumdir 0 0)
X;
X
X
Xprm17(ACTION) =
X ($hit .ME 0 prm16 0 0 0 0 0 0 0 0)
X ($miss np17 0 cg cg cg cg dumdir dumdir 0 0)
X;
X
X
Xprm18(ACTION) =
X ($hit .ME prm19 prm17 0 0 0 0 0 0 0 0)
X ($miss 0 0 cg cg cg cg dumdir dumdir 0 0)
X;
X
X
Xprm19(ACTION) =
X ($hit .ME 0 prm18 0 0 0 0 0 0 0 0)
X ($miss np19 0 cg cg cg cg dumdir dumdir 0 0)
X;
X
X
Xprm20(ACTION) =
X ($hit .ME 0 prm19 0 0 0 0 0 prm19 0 0)
X ($miss cg 0 cg cg cg cg dumdir 0 0 0)
X;
X
X
Xprm21(ACTION) =
X ($hit .ME 0 0 0 0 prm16 prm22 0 0 0 0)
X ($miss cg cg cg cg 0 0 dumdir dumdir 0 0)
X;
X
X
Xprm22(ACTION) =
X ($hit .ME 0 0 0 0 prm21 0 0 0 0 0)
X ($miss cg cg cg wp22 0 cg dumdir dumdir 0 0)
X;
X
X
Xprm23(ACTION) =
X ($hit .ME 0 0 prm22 0 0 0 0 prm22 0 0)
X ($miss cg cg 0 cg cg dp23 dumdir 0 0 0)
X;
END_OF_samples/aard/transit.adl
if test 10696 -ne `wc -c <samples/aard/transit.adl`; then
echo shar: \"samples/aard/transit.adl\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f samples/demos/multi.adl -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"samples/demos/multi.adl\"
else
echo shar: Extracting \"samples/demos/multi.adl\" \(9893 characters\)
sed "s/^X//" >samples/demos/multi.adl <<'END_OF_samples/demos/multi.adl'
XOLDLOC = 27; { Previous location of an actor }
XMYNAME = 26; { Name of an actor }
X
XVAR
X NumAct, { Number of active actors }
X InitAct[ 5 ], { Initial array of actors }
X Rooms[ 4 ], { Initial array of rooms }
X Actors[ 5 ]; { List of active actors }
X
XVERB
X north, south, east, west,
X northeast, southeast, northwest, southwest,
X up, down, quit, take, drop;
X
XROUTINE
X Transit, EnterDir, LeaveDir,
X Looker, Prompter, SetActor,
X Tell, Broadcast, ActAction,
X ActLdesc, CG;
X
XARTICLE
X the, a, an;
X
X{ Locations in the dungeon }
X
XNOUN
X room1, room2, room3, room4;
X
X(Rooms+0) = room1;
X(Rooms+1) = room2;
X(Rooms+2) = room3;
X(Rooms+3) = room4;
X
X{ Actors in the dungeon }
XNOUN
X actor1,
X actor2,
X actor3,
X actor4,
X actor5;
X
X(InitAct + 0) = actor1;
X(InitAct + 1) = actor2;
X(InitAct + 2) = actor3;
X(InitAct + 3) = actor4;
X(InitAct + 4) = actor5;
X
X{ Objects in the dungeon }
XNOUN
X foo( room1 ),
X bar( room2 ),
X bletch( room3 ),
X ack( room4 );
X
X
X{ Location properties }
X
Xroom1( LDESC ) = ($say "Room 1. Exits to the east and south.\n");
Xroom1( ACTION ) =
X ($hit .ME 0 room3 room2 0 0 0 0 0 0 0)
X ($miss CG 0 0 CG CG CG CG CG CG CG)
X (Transit @Verb)
X;
X
Xroom2( LDESC ) = ($say "Room 2. Exits to the west and south.\n");
Xroom2( ACTION ) =
X ($hit .ME 0 room4 0 room1 0 0 0 0 0 0)
X ($miss CG 0 CG 0 CG CG CG CG CG CG)
X (Transit @Verb)
X;
X
Xroom3( LDESC ) = ($say "Room 3. Exits to the east and north.\n");
Xroom3( ACTION ) =
X ($hit .ME room1 0 room4 0 0 0 0 0 0 0)
X ($miss 0 CG 0 CG CG CG CG CG CG CG)
X (Transit @Verb)
X;
X
Xroom4( LDESC ) = ($say "Room 4. Exits to the west and north.\n");
Xroom4( ACTION ) =
X ($hit .ME room2 0 0 room3 0 0 0 0 0 0)
X ($miss 0 CG CG 0 CG CG CG CG CG CG)
X (Transit @Verb)
X;
X
X
X{ Object properties }
X
Xfoo( LDESC ) = ($say "There is a foo here.\n");
Xbar( LDESC ) = ($say "There is a bar here.\n");
Xbletch( LDESC ) = ($say "There is a bletch here.\n");
Xack( LDESC ) = ($say "There is an ack here.\n");
X
X
X
X{ Verb properties }
X
Xtake( PREACT ) =
X (IF ($or ($ne @Iobj 0) ($lt @Dobj 0)) THEN
X ($say "I don't understand that.\n")
X ($exit 1)
X ELSEIF ($eq @Dobj 0) THEN
X ($say "You must tell me what to take!\n")
X ($exit 1)
X ELSEIF ($ne ($loc @Dobj) ($loc .ME)) THEN
X ($say "You don't see that here.\n")
X ($exit 1)
X ELSEIF ($ne ($prop @Dobj MYNAME) 0) THEN
X ($say "You can't take " ($prop @Dobj MYNAME) "!\n")
X ($exit 1)
X )
X;
Xtake( ACTION ) =
X ($say ($name @Dobj) " - taken\n")
X (Broadcast ($prop .ME MYNAME) " takes the " ($name @Dobj) "\n")
X ($move @Dobj .ME)
X;
X
Xdrop( PREACT ) =
X (IF ($or ($ne @Iobj 0) ($lt @Dobj 0)) THEN
X ($say "I don't understand that.\n")
X ($exit 1)
X ELSEIF ($eq @Dobj 0) THEN
X ($say "You must tell me what to drop!\n")
X ($exit 1)
X ELSEIF ($ne ($loc @Dobj) .ME) THEN
X ($say "You don't have that.\n")
X ($exit 1)
X )
X;
Xdrop( ACTION ) =
X ($say ($name @Dobj) " - dropped\n")
X (Broadcast ($prop .ME MYNAME) " drops the " ($name @Dobj) "\n")
X ($move @Dobj ($loc .ME))
X;
X
X
Xquit( PREACT ) =
XLOCAL i, obj1, obj2;
X (Broadcast ($prop .ME MYNAME) " disappears in a puff of smoke!\n")
X ($setg obj1 ($cont .ME))
X (WHILE @obj1 DO
X ($setg obj2 ($link @obj1))
X ($move @obj1 .ALL)
X ($setg obj1 @obj2)
X )
X ($setg i 0)
X ($setg obj1 ($global ($plus Actors @i)))
X (WHILE ($ne @obj1 .ME) DO
X ($setg i ($plus @i 1))
X ($setg obj1 ($global ($plus @Actors @i)))
X )
X ($setg NumAct ($minus @NumAct 1))
X (IF ($le @NumAct 0) THEN
X ($say "Goodbye!\n")
X ($spec 3)
X )
X (WHILE ($lt @i @NumAct) DO
X ($setg ($plus Actors @i) ($global ($plus Actors ($plus @i 1))))
X ($setg i ($plus @i 1))
X )
X ($move .ME .ALL)
X ($delact .ME)
X ($exit 1)
X;
X
X{ Utility routines }
X
XPrompter =
X ($say "\n" ($prop .ME MYNAME) ": ")
X;
X
X
XCG = ($say "You can't go that way.\n") ($exit 1);
X
XEnterDir =
X (IF ($eq %1 north) THEN
X ($val " from the south")
X ELSEIF ($eq %1 south) THEN
X ($val " from the north")
X ELSEIF ($eq %1 east) THEN
X ($val " from the west")
X ELSEIF ($eq %1 west) THEN
X ($val " from the east")
X ELSEIF ($eq %1 northeast) THEN
X ($val " from the southwest")
X ELSEIF ($eq %1 southeast) THEN
X ($val " from the northwest")
X ELSEIF ($eq %1 northwest) THEN
X ($val " from the southeast")
X ELSEIF ($eq %1 southwest) THEN
X ($val " from the northeast")
X ELSEIF ($eq %1 up) THEN
X ($val " from below")
X ELSEIF ($eq %1 down) THEN
X ($val " from above")
X ELSE
X ($val "")
X )
X;
X
XLeaveDir =
X (IF ($eq %1 north) THEN
X ($val " to the north")
X ELSEIF ($eq %1 south) THEN
X ($val " to the south")
X ELSEIF ($eq %1 east) THEN
X ($val " to the east")
X ELSEIF ($eq %1 west) THEN
X ($val " to the west")
X ELSEIF ($eq %1 northeast) THEN
X ($val " to the northeast")
X ELSEIF ($eq %1 southeast) THEN
X ($val " to the southeast")
X ELSEIF ($eq %1 northwest) THEN
X ($val " to the northwest")
X ELSEIF ($eq %1 southwest) THEN
X ($val " to the southwest")
X ELSEIF ($eq %1 up) THEN
X ($val ", going up")
X ELSEIF ($eq %1 down) THEN
X ($val ", going down")
X ELSE
X ($val "")
X )
X;
X
XActLdesc =
X ($say ($prop %1 MYNAME) " is here.\n")
X;
X
XActAction =
X ($setp .ME OLDLOC ($loc .ME))
X { Other stuff, as appropriate }
X;
X
XLooker =
XLOCAL obj;
X { Pretty standard stuff, nothing unusual. Note that
X the TTY is set up by ADL, not by this program }
X ($say "\n" ($prop .ME MYNAME) " sees:\n")
X ( ($ldesc ($loc .ME)) )
X ($setg obj ($cont ($loc .ME)))
X (WHILE @obj DO
X (IF ($ne @obj .ME) THEN
X ( ($ldesc @obj) @obj )
X )
X ($setg obj ($link @obj))
X )
X;
X
X{ (SetActor "name" actor loc tty) Sets up an actor with a tty }
XSetActor =
X ($actor %2 0 1)
X ($move %2 %3)
X ($setp %2 OLDLOC %3)
X ($setp %2 LDESC ActLdesc)
X ($setp %2 ACTION ActAction)
X ($setp %2 MYNAME
X ($savestr
X ($cat
X ($chr ($minus ($ord %1) 32))
X ($subs %1 1 0)
X )
X )
X )
X {$spec 11 %1 %4}
X ($setg ($plus Actors @NumAct) %2)
X ($setg NumAct ($plus @NumAct 1))
X;
X
X{ (Tell foo msg1 msg ... ) - prints msg on foo's tty }
XTell =
XLOCAL i;
X {$spec 12 %1}
X ($say ($prop %1 MYNAME) ": ")
X ($setg i 2)
X (WHILE ($le @i %0) DO
X ($say ($arg @i))
X ($setg i ($plus @i 1))
X )
X {$spec 12 .ME}
X;
X
X{ (Broadcast msg msg ... ) - prints messages to everybody where I am }
XBroadcast =
XLOCAL i, j, him;
X { Check those actors who have already acted }
X ($setg i ($minus @NumAct 1))
X ($setg him ($global ($plus Actors @i)))
X (WHILE ($ne @him .ME) DO
X (IF ($and ($eq ($loc @him) ($loc .ME))
X ($eq ($prop @him OLDLOC) ($loc .ME)) )
X THEN
X { He was and still is in the room }
X {$spec 12 @him}
X ($say ($prop @him MYNAME) ": ")
X ($setg j 1)
X (WHILE ($le @j %0) DO
X ($say ($arg @j))
X ($setg j ($plus @j 1))
X )
X )
X ($setg i ($minus @i 1))
X ($setg him ($global ($plus Actors @i)))
X )
X
X { Check the rest of the actors }
X ($setg i ($minus @i 1))
X (WHILE ($ge @i 0) DO
X ($setg him ($global ($plus Actors @i)))
X (IF ($eq ($loc @him) ($loc .ME)) THEN
X { He is in the room with me }
X {$spec 12 @him}
X ($say ($prop @him MYNAME) ": ")
X ($setg j 1)
X (WHILE ($le @j %0) DO
X ($say ($arg @j))
X ($setg j ($plus @j 1))
X )
X )
X ($setg i ($minus @i 1))
X )
X {$spec 12 .ME}
X;
X
X{ Transit - a routine to be called in every room ACTION }
X
XTransit =
XLOCAL
X HisOld,
X MyOld,
X HisNew,
X MyNew,
X MyName,
X Him,
X I;
X
X ($setg MyOld ($prop .ME OLDLOC))
X ($setg MyNew ($loc .ME))
X ($setg MyName ($prop .ME MYNAME))
X
X (IF ($eq @MyOld @MyNew) THEN
X { I didn't move }
X ($return 0)
X )
X
X { Examine those actors who have already acted }
X ($setg I ($minus @NumAct 1))
X ($setg Him ($global ($plus Actors @I)))
X (WHILE ($ne @Him .ME) DO
X ($setg HisOld ($prop @Him OLDLOC))
X ($setg HisNew ($loc @Him))
X (IF ($and ($eq @MyOld @HisOld) ($eq @HisOld @HisNew)) THEN
X (Tell @Him @MyName " left" (LeaveDir %1) ".\n")
X ELSEIF ($and ($eq @MyOld @HisOld) ($eq @MyNew @HisNew)) THEN
X (Tell @Him @MyName " followed you" (EnterDir %1) ".\n")
X ELSEIF ($and ($eq @MyOld @HisNew) ($ne @HisOld @HisNew)) THEN
X (Tell @Him @MyName " left" (LeaveDir %1) " as you entered.\n")
X ELSEIF ($and ($eq @MyNew @HisNew) ($eq @HisOld @HisNew)) THEN
X (Tell @Him @MyName " entered" (EnterDir %1) ".\n")
X ELSEIF ($and ($eq @MyNew @HisNew) ($ne @HisOld @HisNew)
X ($ne @MyOld @HisOld))
X THEN
X (Tell @Him @MyName " enters" (EnterDir %1) " as you enter.\n")
X )
X ($setg I ($minus @I 1))
X ($setg Him ($global ($plus Actors @I)))
X )
X
X { Examine those actors who haven't already acted }
X ($setg I ($minus @I 1))
X (WHILE ($ge @I 0) DO
X ($setg Him ($global ($plus Actors @I)))
X ($setg HisNew ($loc @Him))
X (IF ($eq @MyOld @HisNew) THEN
X (Tell @Him @MyName " left" (LeaveDir %1) ".\n")
X ELSEIF ($eq @MyNew @HisNew) THEN
X (Tell @Him @MyName " entered" (EnterDir %1) ".\n")
X )
X ($setg I ($minus @I 1))
X )
X;
X
X
XSTART =
XLOCAL i, num, name, rnum, actor, tty;
X ($sdem Looker)
X ($prompt Prompter)
X ($setv north south east west
X northeast southeast northwest southwest up down )
X ($say "How many actors? (1-5): ")
X ($setg num ($num ($read)))
X (IF ($or ($lt @num 1) ($gt @num 5)) THEN
X ($say "Bad number of actors.\n")
X ($spec 3)
X )
X ($setg i 0)
X (WHILE ($lt @i @num) DO
X ($say "Enter actor " ($str ($plus @i 1)) "'s name (all lowercase): ")
X ($setg name ($read))
X ($setg rnum 0)
X (WHILE ($or ($lt @rnum 1) ($gt @rnum 4)) DO
X ($say "Enter actor's room number (1-4): ")
X ($setg rnum ($num ($read)))
X )
X ($say "Enter actor's tty (<cr> if none): ")
X ($setg tty ($read))
X ($setg actor ($global ($plus InitAct @i)))
X ($define @name ($name @actor))
X ($setg rnum ($global ($plus Rooms ($minus @rnum 1))))
X (SetActor @name @actor @rnum @tty)
X ($setg i ($plus @i 1))
X )
X;
X
X{ *** EOF multi.adl *** }
END_OF_samples/demos/multi.adl
if test 9893 -ne `wc -c <samples/demos/multi.adl`; then
echo shar: \"samples/demos/multi.adl\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f samples/mpu/routines.adl -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"samples/mpu/routines.adl\"
else
echo shar: Extracting \"samples/mpu/routines.adl\" \(2653 characters\)
sed "s/^X//" >samples/mpu/routines.adl <<'END_OF_samples/mpu/routines.adl'
XLOOK =
X (IF ($and @GOVERB ($not @GO)) THEN
X (cg)
X )
X ($setg GOVERB FALSE)
X ($setg GO FALSE)
X (IF @IncFlag THEN
X ($incturn)
X )
X ($setg IncFlag TRUE)
X;
X
X
XPROMPT =
X ($spec 9 (($sdesc ($loc .ME)) 1) @SCORE ($turns))
X ($say "> ")
X;
X
X
XGrowX =
X (IF ($prop %1 SHRNK) THEN
X ($setp %1 SHRNK FALSE)
X (IF ($cont %1) THEN
X (GrowX ($cont %1))
X )
X (IF ($link %1) THEN
X (GrowX ($link %1))
X )
X )
X;
X
X
XGrow =
X (IF ($prop .ME SHRNK) THEN
X ($setp .ME SHRNK FALSE)
X (IF ($cont .ME) THEN
X (GrowX ($cont .ME))
X )
X )
X;
X
X
XShrnX =
X (IF ($not ($prop %1 SHRNK)) THEN
X ($setp %1 SHRNK TRUE)
X (IF ($cont %1) THEN
X (ShrnX ($cont %1))
X )
X (IF ($link %1) THEN
X (ShrnX ($link %1))
X )
X ELSE
X ($say "You hear a tiny POP as the " ($name %1)" vanishes completely!\n")
X (IF ($link %1) THEN
X (ShrnX ($link %1))
X )
X ($move %1 .ALL)
X )
X;
X
X
XShrink =
X (IF ($not ($prop .ME SHRNK)) THEN
X ($setp .ME SHRNK TRUE)
X (IF ($cont .ME) THEN
X (ShrnX ($cont .ME))
X )
X )
X;
X
XWzTgl = { Toggle the Wizard flag }
X ($setg Wizrd ($not @Wizrd))
X (IF @Wizrd THEN
X ($say
X"You hear a low rumble of thunder, shaking the very ground on
Xwhich you stand. Suddenly, there is a blazing flash of light!!
XYou are unharmed, but feal great power flowing in your body.\n"
X )
X ELSE
X ($say "Your wizardly powers unceremoniously fade away.\n")
X )
X;
X
X
XTakeAct =
X (IF ($eq ($prop @Dobj WEIGH) CAPAC) THEN
X ($say "You can't move ")
X (($sdesc @Dobj))
X ($say ".\n")
X ($exit 1)
X ELSEIF ($and ($prop .ME SHRNK) ($not ($prop @Dobj SHRNK))) THEN
X ($say "Right now, the " ($name @Dobj)
X " is too big for you to deal with.\n")
X ($exit 1)
X ELSEIF ($gt ($plus ($prop .ME HAS) ($prop @Dobj WEIGH))
X ($prop .ME HOLDS)
X )
X THEN
X ($say "You can't carry that much more!\n")
X ($exit 1)
X ELSE
X ($setp .ME HAS ($plus ($prop .ME HAS) ($prop @Dobj WEIGH)))
X )
X;
X
X
XDropAct =
X ($setp .ME HAS ($minus ($prop .ME HAS) ($prop @Dobj WEIGH)))
X (IF ($eq ($loc .ME) cel13) THEN
X (IF ($not ($prop cel13 HOLED)) THEN
X (IF ($gt ($prop @Dobj WEIGH) 75) THEN
X ($say "The " ($name @Dobj)
X " breaks through the ice and sinks!\n")
X ($setp cel13 HOLED TRUE)
X ($move hole cel13)
X ($move @Dobj .ALL)
X ($setg Skip TRUE)
X ELSE
X ($say "The ice chips a bit, but does not break.\n")
X )
X )
X ELSEIF ($eq ($loc .ME) cel19) THEN
X (IF ($not ($prop goblet FREED)) THEN
X (IF ($gt ($prop @Dobj WEIGH) 75) THEN
X ($say "The " ($name @Dobj))
X ($say " cracks the ice, and the goblet is freed!\n")
X ($setp goblet FREED TRUE)
X ELSE
X ($say "The ice chips a bit, but does not break.\n")
X )
X )
X )
X;
END_OF_samples/mpu/routines.adl
if test 2653 -ne `wc -c <samples/mpu/routines.adl`; then
echo shar: \"samples/mpu/routines.adl\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f samples/mpu/transit.adl -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"samples/mpu/transit.adl\"
else
echo shar: Extracting \"samples/mpu/transit.adl\" \(10052 characters\)
sed "s/^X//" >samples/mpu/transit.adl <<'END_OF_samples/mpu/transit.adl'
X{*** TRANSITIONS ***}
XHitms =
X (IF ($eq ($verb) %1) THEN
X (IF %2 THEN
X ($move .ME %2)
X ($setg GO TRUE)
X )
X (IF %3 THEN
X (($arg 3))
X )
X )
X;
X
XSynvb =
X (IF ($eq ($verb) %1) THEN
X ($setg Verb %2)
X )
X;
X
Xroad1(ACTION) =
X (Hitms n gard1 0)
X (Hitms s gard2 0)
X (Hitms e road2 0)
X (Hitms w road3 0)
X;
X
Xroad2(ACTION) =
X (Hitms n gard1 0)
X (Hitms s gard2 0)
X (Hitms e road6 0)
X (Hitms w road1 0)
X;
X
XDropKill =
X ($say "The drop would kill you.\n")
X ($setg MyLoc ($loc .ME))
X ($setg GO TRUE)
X;
X
Xroad3(ACTION) =
X (Hitms n 0 DropKill)
X (Hitms s 0 DropKill)
X (Hitms e road1 0)
X (Hitms w road7 Entr7)
X;
X
Xroad4(ACTION) =
X (Hitms n farm1 0)
X (Hitms s road6 0)
X (Hitms e frst1 0)
X (Hitms w gard1 0)
X;
X
Xroad5(ACTION) =
X (Hitms n road6 0)
X (Hitms s town1 0)
X (Hitms e frst1 0)
X (Hitms w gard2 0)
X;
X
Xroad6(ACTION) =
X (Hitms n road4 0)
X (Hitms s road5 0)
X (Hitms e frst1 0)
X (Hitms w road2 0)
X;
X
Xroad7(ACTION) =
X ($miss Tress Tress East7 West7 0 0 0 0 0 0)
X;
X
XEast7 =
X ($setg GO TRUE)
X (IF ($not @HWY7) THEN
X ($move .ME road3)
X ELSE
X (Dump7 ($cont road7))
X ($setg HWY7 ($minus @HWY7 1))
X (Get7 ($cont Roadx))
X )
X;
X
XWest7 =
X ($setg GO TRUE)
X (Dump7 ($cont road7))
X ($setg HWY7 ($plus @HWY7 1))
X (Get7 ($cont Roadx))
X;
X
XDump7 =
X (IF ($link %1) THEN
X (Dump7 ($link %1)) { start at bottom }
X )
X (IF ($ne %1 .ME) THEN { Everything else leaves }
X ($setp %1 RDLOC @HWY7) { Retain its location on HWY 7 }
X ($move %1 Roadx) { Put it in the box }
X )
X;
X
XGet7 =
X (IF %1 THEN
X (Get7 ($link %1))
X (IF ($eq ($prop %1 RDLOC) @HWY7) THEN
X ($move %1 road7)
X )
X )
X;
X
XEntr7 =
X (Dump7 ($cont road7))
X ($setg HWY7 0)
X (Get7 ($cont Roadx))
X;
X
Xgard1(ACTION) =
X (Hitms n gard1 0)
X (Hitms s road1 0)
X (Hitms e gard1 0)
X (Hitms w gard1 0)
X;
X
Xgard2(ACTION) =
X (Hitms n road1 0)
X (Hitms s gard2 0)
X (Hitms e gard2 0)
X (Hitms w gard2 0)
X;
X
XFLeave =
X (IF ($pct 20) THEN
X ($move .ME road6)
X )
X ($setg GO TRUE)
X;
X
Xfrst1(ACTION) =
X ($miss FLeave FLeave FLeave FLeave FLeave FLeave FLeave FLeave 0 0)
X;
X
Xfarm1 (ACTION) =
X (Synvb enter north)
X (Hitms n farm2 0)
X (Hitms s road4 0)
X (Hitms e farm3 0)
X (Hitms w farm4 0)
X (Hitms ne farm3 0)
X (Hitms nw farm4 0)
X;
X
Xfarm2 (ACTION) =
X (Synvb out s)
X (Synvb enter n)
X (Synvb east up)
X (Hitms n farm6 0)
X (Hitms s farm1 0)
X (Hitms up farm7 0)
X;
X
Xfarm3 (ACTION) =
X (Hitms n farm5 0)
X (Hitms s farm1 0)
X (Hitms e frst1 0)
X (Hitms nw farm5 0)
X (Hitms sw farm1 0)
X;
X
Xfarm4 (ACTION) =
X (Hitms n farm5 0)
X (Hitms s farm1 0)
X (Hitms w gard1 0)
X (Hitms ne farm5 0)
X (Hitms se farm1 0)
X;
X
Xfarm5 (ACTION) =
X (Hitms e farm3 0)
X (Hitms w farm4 0)
X (Hitms se farm3 0)
X (Hitms sw farm4 0)
X;
X
Xfarm6 (ACTION) =
X (Hitms out farm2 0)
X (Hitms s farm2 0)
X;
X
Xfarm7 (ACTION) =
X (Hitms e farm2 0)
X (Hitms d farm2 PanL)
X;
X
X
Xtown1 (ACTION) =
X (Hitms n road5 0)
X (Hitms s town2 0)
X (Hitms e town3 0)
X (Hitms w town4 0)
X;
X
Xtown2 (ACTION) =
X (Hitms n town1 0)
X (Hitms e town5 0)
X (Hitms w town6 0)
X;
X
Xtown3 (ACTION) =
X (Hitms out town1 0)
X (Hitms w town1 0)
X;
X
Xtown4 (ACTION) =
X (Hitms e town1 0)
X (Hitms out town1 0)
X;
X
Xtown5 (ACTION) =
X (Hitms w town2 0)
X (Hitms out town2 0)
X;
X
Xtown6 (ACTION) =
X (Hitms e town2 0)
X (Hitms out town2 0)
X;
X
X
Xcel01 (ACTION) =
X (Hitms n cel02 0)
X (Hitms w cel04 0)
X (Hitms u farm7 0)
X;
X
Xcel02 (ACTION) =
X (Hitms n cel05 0)
X (Hitms s cel01 0)
X (Hitms e cel20 0)
X;
X
Xcel20(ACTION) =
X (Hitms w cel02 0)
X;
X
Xcel03 (ACTION) =
X (Hitms s cel05 0)
X (IF ($not ($prop dragon KILLED)) THEN
X (Hitms w cel13 0)
X (Hitms ne cel09 0)
X (Hitms d cel09 0)
X )
X;
X
Xcel04 (ACTION) =
X (Synvb down north)
X (Hitms n cel10 0)
X (Hitms e cel01 0)
X (Hitms w cel08 0)
X;
X
X
XMV56= ($setg Cel6x 5);
XMV76= ($setg Cel6x 7);
XMV67=
X (IF ($and ($ne @Cel6x 7) ($prop dragon AWAKE) ($not ($prop dragon KILLED)))
X THEN
X ($say "The ice dragon blocks your attempt to cross!\n\n")
X ELSE
X ($move .ME cel07)
X )
X ($setg GO TRUE) { short circuit default error message }
X;
X
XMV65=
X (IF ($and ($ne @Cel6x 5) ($prop dragon AWAKE) ($not ($prop dragon KILLED)))
X THEN
X ($say "The ice dragon blocks your attempt to leave!\n")
X ELSE
X ($move .ME cel05)
X )
X ($setg GO TRUE) { short circuit default error message }
X;
X
X
Xcel05 (ACTION) =
X (Hitms n cel03 0)
X (Hitms s cel02 0)
X (Hitms ne cel06 MV56)
X;
X
Xcel06 (ACTION) =
X (Hitms e 0 MV67)
X (Hitms sw 0 MV65)
X (IF ($and ($not ($prop dragon KILLED))
X ($prop dragon AWAKE)
X ($eq ($loc .ME) cel06) {still here}
X )
X THEN
X ($setg MyLoc -1)
X )
X;
X
Xcel07 (ACTION) =
X (Synvb out west)
X (Hitms w cel06 MV76)
X;
X
XThirst =
X (IF ($eq ($loc .ME) desert) THEN
X ($say "The blazing sun is too much for you, I'm afraid.\n")
X (die)
X )
X;
X
XMove08 =
X (IF @RBTouch THEN
X (IF ($prop dragon KILLED) THEN
X ($move .ME field)
X ELSE
X ($move .ME desert)
X ($sfus .ME Thirst 10)
X )
X ELSE
X ($say "You bump your nose against the painting.\n")
X ($setg MyLoc ($loc .ME))
X )
X ($setg GO TRUE)
X;
X
Xcel08 (ACTION) =
X (Hitms e cel04 0)
X (Hitms w 0 Move08)
X;
X
XSlippery =
X ($say "The waterfall is to slick for you to climb.\n")
X ($setg MyLoc ($loc .ME))
X ($setg GO TRUE)
X;
X
XCrackEntr =
X ($say "You slip through the crack in the waterfall.\n")
X;
X
XGet21 =
X LOCAL t, t1;
X ($setg t ($cont riverx))
X (WHILE @t DO
X (IF ($eq ($prop @t Loc21) @RiverLoc) THEN
X ($setg t1 ($link @t))
X ($move @t cel21)
X ($setg t @t1)
X ELSE
X (Next t)
X )
X )
X;
X
XDump21 =
X LOCAL t, t1;
X ($setg t ($cont cel21))
X (WHILE @t DO
X (IF ($ne @t .ME) THEN
X ($setp @t Loc21 @RiverLoc)
X ($setg t1 ($link @t))
X ($move @t riverx)
X ($setg t @t1)
X ELSE
X (Next t)
X )
X )
X;
X
XEntr21 =
X ($setg RiverLoc 1)
X (Get21)
X;
X
Xcel09 (ACTION) =
X (Hitms n cel21 Entr21)
X (Hitms u 0 Slippery)
X (Hitms s cel18 CrackEntr)
X;
X
XMove11 =
X (IF ($prop dragon KILLED) THEN
X (IF ($not ($prop wetsuit WORN)) THEN
X ($say "The pit is full of water!!!\n")
X ELSE
X ($say "That water looks mighty dangerous. Are you sure? ")
X (IF ($yorn) THEN
X ($say
X"You leap into the pit and are immediately grabbed by a mighty
Xcurrent which pulls you down, down, down... Soon the pressure
Xbecomes too great for you to breathe, and the last thing you
Xremember is feeling somewhat like an elephant's footstool.\n"
X )
X (die)
X )
X )
X ($setg MyLoc ($loc .ME))
X ELSE
X ($move .ME cel11)
X )
X ($setg GO TRUE)
X;
X
Xcel10 (ACTION) =
X (Synvb up s)
X (Hitms s cel04 0)
X (Hitms d 0 Move11)
X;
X
Xcel11 (ACTION) =
X (IF ($and @GOVERB ($not ($prop [clear crystal] LIGHT))) THEN
X ($say
X"You trip and fall into a pit that you were unable to see in the dark!\n"
X )
X (die)
X )
X (Hitms e cel12 0)
X (Hitms w cel16 0)
X;
X
Xcel12 (ACTION) =
X (Hitms w cel11 0)
X;
X
XWaterEntr =
X (IF ($gt ($prop .ME HAS) ($prop globe WEIGH)) THEN
X (IF ($not ($prop wetsuit WORN)) THEN
X ($say
X"Whatever you're carrying drags you down into the icy waters!\n"
X )
X (die)
X )
X )
X;
X
Xcel13 (ACTION) =
X (IF ($eq ($verb) down) THEN
X (IF ($prop cel13 HOLED) THEN
X (WaterEntr)
X ($say "You plunge into the icy waters!\n")
X ($move .ME cel14)
X ($setg GO TRUE)
X ($exit 1)
X )
X )
X (Hitms e cel03 0)
X (Hitms w cel19 0)
X;
X
XDrown =
X (IF ($or ($eq ($loc .ME) cel14) ($eq ($loc .ME) cel17)) THEN
X (IF ($not ($prop wetsuit WORN)) THEN
X ($say
X"You can't hold your breath any longer. The last thing you
Xfeel is the odd sensation of water entering your lungs.\n"
X )
X (die)
X )
X )
X;
X
Xcel14 (ACTION) =
X (IF ($eq ($verb) up) THEN
X (IF ($prop cel13 HOLED) THEN
X ($say "You pop out through a hole in the ice!\n")
X ($move .ME cel13)
X ($setg GO TRUE)
X ($exit 1)
X ELSE
X ($say "You are blocked by an icy roof above!\n")
X )
X )
X (Hitms w cel15 0)
X (Hitms e cel17 0)
X ($sfus .ME Drown 1)
X;
X
Xcel15(ACTION) =
X (Synvb up south)
X (Synvb enter e)
X (Hitms e cel14 WaterEntr)
X (Hitms s cel16 0)
X;
X
Xcel16(ACTION) =
X (Synvb down north)
X (Hitms n cel15 0)
X (Hitms e cel11 0)
X;
X
Xcel17(ACTION) =
X (Hitms ne cel18 0)
X (Hitms w cel14 0)
X ($sfus .ME Drown 1)
X;
X
XSwim =
X ($say "You dive into the icy waters.\n")
X (WaterEntr)
X;
X
Xcel18(ACTION) =
X (Synvb enter sw)
X (Hitms n cel09 0)
X (Hitms sw cel17 Swim)
X;
X
Xcel19(ACTION) =
X (Hitms e cel13 0)
X;
X
XNorth21 =
X (Dump21)
X ($setg RiverLoc ($plus @RiverLoc 1))
X ($setg GO TRUE)
X ($setp cel21 SEEN FALSE)
X (Get21)
X;
X
XSouth21 =
X (Dump21)
X ($setg GO TRUE)
X ($setg RiverLoc ($minus @RiverLoc 1))
X ($setp cel21 SEEN FALSE)
X (IF ($not @RiverLoc) THEN
X ($move .ME cel09)
X ELSE
X (Get21)
X )
X;
X
XCantClimb =
X ($say "The sides of the river bed are too steep for you to climb.\n")
X ($setg MyLoc ($loc .ME))
X ($setg GO TRUE)
X;
X
XGrateThere =
X ($say "The grate blocks your attempt to move that way.\n")
X ($setg MyLoc ($loc .ME))
X ($setg GO TRUE)
X;
X
Xcel21(ACTION) =
X (IF ($eq @RiverLoc GRATELOC) THEN
X ($miss South21 GrateThere CantClimb CantClimb 0 0 0 0 0 0)
X ELSEIF ($eq @RiverLoc BEND1LOC) THEN
X ($miss CantClimb South21 CantClimb North21 0 0 0 0 0 0)
X ELSEIF ($and ($gt @RiverLoc BEND1LOC) ($lt @RiverLoc BEND2LOC)) THEN
X ($miss CantClimb CantClimb South21 North21 0 0 0 0 0 0)
X ELSEIF ($eq @RiverLoc BEND2LOC) THEN
X ($miss CantClimb North21 South21 CantClimb 0 0 0 0 0 0)
X ELSEIF ($gt @RiverLoc BEND2LOC) THEN
X ($miss South21 North21 CantClimb CantClimb 0 0 0 0 0 0)
X ELSE { RiverLoc < BEND1LOC }
X ($miss North21 South21 CantClimb CantClimb 0 0 0 0 0 0)
X )
X;
X
Xdesert(ACTION) =
X (Hitms n desert 0)
X (Hitms s desert 0)
X (Hitms e desert 0)
X (Hitms w desert 0)
X (Hitms ne desert 0)
X (Hitms nw desert 0)
X (Hitms se desert 0)
X (Hitms sw desert 0)
X;
X
Xfield(ACTION) =
X (Hitms n 0 ENDGAME)
X;
END_OF_samples/mpu/transit.adl
if test 10052 -ne `wc -c <samples/mpu/transit.adl`; then
echo shar: \"samples/mpu/transit.adl\" unpacked with wrong size!
fi
# end of overwriting check
fi
echo shar: End of archive 7 \(of 11\).
cp /dev/null ark7isdone
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 archive.
exit y