games-request@tekred.TEK.COM (08/05/87)
Submitted by: cunniff%hpda@hplabs.HP.COM (Ross Cunniff)
Comp.sources.games: Volume 2, Issue 26
Archive-name: adl/Part09
#! /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 9 (of 11)."
# Contents: adlcomp/compdict.c adlrun/adlfuncs.c adlrun/adlmiscr.c
# adlrun/adlscrn.c adlrun/adlstr.c include/adlprog.h
# include/adlrun.h include/builtins.h samples/aard/verbs.adl
# samples/demos/baby.adl util/virtmem.c
# Wrapped by billr@tekred on Tue Aug 4 16:27:49 1987
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f adlcomp/compdict.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"adlcomp/compdict.c\"
else
echo shar: Extracting \"adlcomp/compdict.c\" \(3753 characters\)
sed "s/^X//" >adlcomp/compdict.c <<'END_OF_adlcomp/compdict.c'
X/*LINTLIBRARY*/
X
X#include <stdio.h>
X
X#include "adltypes.h"
X#include "adlprog.h"
X
X#define HTSIZE 512 /* Size of a hash table */
X
Xchar
X *calloc();
X
X/* Structure of a hash table entry */
Xstruct hash_entry {
X struct symbol
X entry_val;
X struct hash_entry
X *next;
X};
X
X/* The three dictionaries */
Xstatic struct hash_entry
X *sys_symb[ HTSIZE ], /* The system symbols */
X *loc_symb[ HTSIZE ], /* The local symbols */
X *gen_symb[ HTSIZE ]; /* The general symbols */
X
X
Xstatic int16
Xfind( s, hash, tab, val )
Xchar
X *s;
Xstruct hash_entry
X **tab;
Xint16
X hash,
X *val;
X{
X struct hash_entry
X *ent;
X
X ent = tab[ hash ];
X while( ent != (struct hash_entry *)NULL ) {
X if( strcmp( ent->entry_val.name, s ) == 0 ) {
X *val = ent->entry_val.val;
X return ent->entry_val.type;
X }
X ent = ent->next;
X }
X return -1;
X}
X
X
Xstatic int16
Xhashval( s )
Xchar
X *s;
X{
X int
X t;
X
X t = 0;
X while( *s )
X t = (t + *s++) % HTSIZE;
X return t;
X}
X
X
Xstatic int16
Xinsert( s, type, val, first, tab )
Xchar
X *s;
Xint16
X type, val, first;
Xstruct hash_entry
X **tab;
X{
X struct hash_entry
X *ent;
X int16
X hash;
X char
X temp[ 10 ];
X
X /* Trim the string to the maximum appropriate length */
X strncpy( temp, s, LENGTH );
X temp[ LENGTH ] = '\0';
X
X hash = hashval( temp );
X ent = tab[ hash ];
X tab[ hash ] = (struct hash_entry *)calloc( 1, sizeof( struct hash_entry ) );
X tab[ hash ]->next = ent;
X strcpy( tab[ hash ]->entry_val.name, temp );
X tab[ hash ]->entry_val.type = type;
X tab[ hash ]->entry_val.val = val;
X tab[ hash ]->entry_val.first = first;
X}
X
X
Xint16
Xlookup( s, val )
Xchar
X *s;
Xint16
X *val;
X{
X int16
X found,
X hash;
X char
X temp[ 10 ];
X
X /* Trim the string to the maximum appropriate length */
X strncpy( temp, s, LENGTH );
X temp[ LENGTH ] = '\0';
X
X hash = hashval( temp );
X
X /* Search the local dictionary first */
X found = find( temp, hash, loc_symb, val );
X if( found >= 0 )
X return found;
X
X /* Search the system dictionary next */
X found = find( temp, hash, sys_symb, val );
X if( found >= 0 )
X return found;
X
X /* Search the general dictionary last */
X found = find( temp, hash, gen_symb, val );
X return found;
X}
X
X
Xint16
Xinsertkey( s, type, val, first )
Xchar
X *s;
Xint16
X type, val;
X{
X insert( s, type, val, first, gen_symb );
X NUMSYM++;
X}
X
X
Xint16
Xinsert_sys( s, type, val )
Xchar
X *s;
Xint16
X type, val;
X{
X insert( s, type, val, 0, sys_symb );
X}
X
X
Xint16
Xinsert_local( s, type, val )
Xchar
X *s;
Xint16
X type, val;
X{
X insert( s, type, val, 0, loc_symb );
X}
X
X
Xcount_symtab( debug )
Xint
X debug;
X{
X NUMSYM = write_hash( 0, gen_symb, 0 );
X if( debug )
X NUMSYM += write_hash( 0, sys_symb, 0 );
X}
X
X
Xwrite_symtab( fd, debug )
Xint
X fd,
X debug;
X{
X lseek( fd, 0L, 2 ); /* Seek to EOF */
X (void)write_hash( fd, gen_symb, 1 );
X if( debug )
X (void)write_hash( fd, sys_symb, 1 );
X}
X
X
Xstatic
Xwrite_hash( fd, tab, writing )
Xint
X fd;
Xstruct hash_entry
X **tab;
Xint
X writing;
X{
X int16
X i, j, num;
X struct hash_entry
X *ent;
X
X num = 0;
X for( i = 0; i < HTSIZE; i++ ) {
X ent = tab[ i ];
X while( ent != (struct hash_entry *)0 ) {
X if( writing ) {
X for( j = 0; j < strlen( ent->entry_val.name ); j++ )
X ent->entry_val.name[ j ] ^= CODE_CHAR;
X write( fd, &ent->entry_val, sizeof( struct symbol ) );
X }
X ent = ent->next;
X num++;
X }
X }
X return num;
X}
X
X
Xdel_locals()
X{
X int16
X i;
X struct hash_entry
X *ent1, *ent2;
X
X for( i = 0; i < HTSIZE; i++ ) {
X ent1 = loc_symb[ i ];
X while( ent1 != (struct hash_entry *)0 ) {
X ent2 = ent1;
X ent1 = ent1->next;
X free( ent2 );
X }
X loc_symb[ i ] = (struct hash_entry *)0;
X }
X}
X
X/*** EOF dict.c ***/
END_OF_adlcomp/compdict.c
if test 3753 -ne `wc -c <adlcomp/compdict.c`; then
echo shar: \"adlcomp/compdict.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f adlrun/adlfuncs.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"adlrun/adlfuncs.c\"
else
echo shar: Extracting \"adlrun/adlfuncs.c\" \(5453 characters\)
sed "s/^X//" >adlrun/adlfuncs.c <<'END_OF_adlrun/adlfuncs.c'
X#include <stdio.h>
X
X#include "adltypes.h"
X#include "adlprog.h"
X#include "builtins.h"
X#include "adlrun.h"
X
Xdosysfunc( rp )
Xint16 rp;
X{
X int16
X t;
X
X switch( rp ) {
X /* Object routines */
X case _LOC :
X case _CONT :
X case _LINK :
X case _MODIF : objprop( rp ); break;
X case _LDESC :
X case _SDESC :
X case _ACTION : t = _LDESC;
X objprop( abs( rp - t ) + _LD ); break;
X case _PROP : assertargs( "$prop", 2 );
X objprop( ARG(2) ); break;
X case _SETP : setp(); break;
X case _MOVE : move_obj(); break;
X
X /* Verb routines */
X case _VSET : vset(); break;
X case _VPROP : vprop(); break;
X
X /* Arithmetic routines */
X case _PLUS : assertargs( "$plus", 2 );
X RETVAL = ARG(1) + ARG(2); break;
X case _MINUS : assertargs( "$minus", 2 );
X RETVAL = ARG(1) - ARG(2); break;
X case _TIMES : assertargs( "$times", 2 );
X RETVAL = ARG(1) * ARG(2); break;
X case _DIV : do_div(); break;
X case _MOD : do_mod(); break;
X case _RAND : assertargs( "$rand", 1);
X RETVAL = myrand( ARG(1) ); break;
X
X /* Boolean routines */
X case _AND : do_and(); break;
X case _OR : do_or(); break;
X case _NOT : assertargs( "$not", 1 );
X RETVAL = !ARG(1); break;
X case _YORN : RETVAL = yesno(); break;
X case _PCT : assertargs( "$pct", 1 );
X RETVAL = ARG(1) >= myrand(100); break;
X case _EQ : assertargs( "$eq", 2 );
X RETVAL = ARG(1) == ARG(2); break;
X case _NE : assertargs( "$ne", 2 );
X RETVAL = ARG(1) != ARG(2); break;
X case _LT : assertargs( "$lt", 2 );
X RETVAL = ARG(1) < ARG(2); break;
X case _GT : assertargs( "$gt", 2 );
X RETVAL = ARG(1) > ARG(2); break;
X case _LE : assertargs( "$le", 2 );
X RETVAL = ARG(1) <= ARG(2); break;
X case _GE : assertargs( "$ge", 2 );
X RETVAL = ARG(1) >= ARG(2); break;
X
X /* Miscellaneous routines */
X case _SAY : saystr(); break;
X case _ARG : do_args(); break;
X case _EXIT : do_exit(); return;
X case _RETURN : do_rtrn(); return;
X case _VAL : do_val(); break;
X case _PHASE : RETVAL = Phase; break;
X case _SPEC : special(); return;
X
X /* Global value routines */
X case _SETG : setg(); break;
X case _GLOBAL : assertargs( "$global", 1 );
X varconts( ARG( 1 ) ); break;
X case _VERB : varconts( _VERB_G ); break;
X case _DOBJ : varconts( _DOBJ_G ); break;
X case _IOBJ : varconts( _IOBJ_G ); break;
X case _PREP : varconts( _PREP_G ); break;
X case _CONJ : varconts( _CONJ_G ); break;
X case _NUMD : varconts( _NUMD_G ); break;
X
X /* Transition routines */
X case _SETV : setverb(); break;
X case _HIT : hitverb(); break;
X case _MISS : missverb(); return;
X
X /* String manipulation routines */
X case _EQST : eqstring(); break;
X case _SUBS : substring(); break;
X case _LENG : lengstring(); break;
X case _CAT : catstring(); break;
X case _POS : posstring(); break;
X case _READ : readstring(); break;
X case _SAVESTR : savestr(); break;
X
X /* Name routines */
X case _NAME : do_name(); break;
X case _VNAME : do_vname(); break;
X case _MNAME : do_mname(); break;
X case _PNAME : do_pname(); break;
X
X /* Conversion routines */
X case _STR : do_str(); break;
X case _NUM : do_num(); break;
X case _ORD : ordstring(); break;
X case _CHR : chrstring(); break;
X
X /* Internal structure routines */
X case _SDEM : setdemon(); break;
X case _DDEM : deldemon(); break;
X case _SFUS : setfuse(); break;
X case _DFUS : assertargs( "$dfus", 2 );
X delfuse( ARG(1), ARG(2) ); break;
X case _INCTURN : incturn(); break;
X case _TURNS : retturn(); break;
X case _PROMPT : doprompt(); break;
X case _ACTOR : setactor(); break;
X case _DELACT : assertargs( "$delact", 1 );
X delactor( ARG(1) ); break;
X case _DEFINE : do_define(); break;
X case _UNDEF : do_undef(); break;
X
X default : error( 3 ); /* Illegal builtin */
X }
X
X if( sp <= NUMVAR ) /* A $exit was called by a fuse or something */
X return;
X popip();
X rp = pop();
X sp = bp + 1;
X bp = rp;
X}
X
X#if DEBUG
Xassertargs( s, n )
Xchar *s;
Xint16 n;
X{
X if( n >= RETVAL ) {
X fprintf( stderr, "%s: ", s );
X error( 2 ); /* Too few arguments */
X }
X}
X#endif
X
X
Xdo_rtrn()
X{
X int16
X retval, oldbp;
X
X assertargs( "$return", 1 );
X popip();
X bp = pop();
X retval = pop();
X oldbp = stack[ bp + stack[ bp ] ];
X ip = stack[ bp + stack[ bp ] + 1 ];
X sp = bp;
X push( retval );
X bp = oldbp;
X}
X
X
Xdo_exit()
X{
X int16
X code;
X
X assertargs( "$exit", 1 );
X code = ARG( 1 );
X if( (code < 0) || (code > 3) )
X error( 28 );
X if( exits[ code ].exit_ok == 0 )
X error( 28 );
X bp = sp = NUMVAR; /* Trim the stack */
X ip = 0; /* Clear the IP */
X DO_EXIT( code );
X}
X
X
Xdo_val()
X{
X assertargs( "$val", 1 );
X RETVAL = ARG( 1 );
X}
X
X
Xgetstring( s )
Xchar *s;
X{
X#if MULTIPLEX
X fseek( CURRTTY, 0L, 0 );
X if( !fgets( s, SLEN, CURRTTY ) ) {
X /* On EOF, delete the current actor */
X delactor( CURRACT );
X DO_EXIT( 1 );
X }
X#else
X if( !gets( s ) ) { /* EOF detected! */
X head_term();
X exit( -1 ); /* Exit program */
X }
X#endif
X
X if( scriptfile != (FILE *)0 )
X fprintf( scriptfile, "%s\n", s );
X numcol = 0;
X}
X
X
Xint16
Xyesno()
X{
X char
X s[ 80 ];
X int16
X i;
X
X getstring( s );
X for( i = 0; (s[ i ] == ' ') || (s[ i ] == '\t'); i++ )
X /* NOTHING */;
X if( (s[ 0 ] == 'y') || (s[ 0 ] == 'Y') )
X return 1;
X else
X return 0;
X}
X
X
Xdo_args()
X{
X int16
X oldbp;
X
X assertargs( "$arg", 1 );
X oldbp = stack[ sp - 2 ];
X if( ARG( 1 ) )
X RETVAL = stack[ oldbp + ARG( 1 ) ];
X else
X RETVAL = stack[ oldbp ] - 1;
X}
X
X/*** EOF adlfuncs.c ***/
END_OF_adlrun/adlfuncs.c
if test 5453 -ne `wc -c <adlrun/adlfuncs.c`; then
echo shar: \"adlrun/adlfuncs.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f adlrun/adlmiscr.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"adlrun/adlmiscr.c\"
else
echo shar: Extracting \"adlrun/adlmiscr.c\" \(1106 characters\)
sed "s/^X//" >adlrun/adlmiscr.c <<'END_OF_adlrun/adlmiscr.c'
X#include <stdio.h>
X
X#include "adltypes.h"
X#include "adlprog.h"
X#include "builtins.h"
X#include "vstring.h"
X#include "adlrun.h"
X
X
Xvarconts( n )
Xint16 n;
X{
X switch( n ) {
X case _VERB_G : RETVAL = Verb; break;
X case _DOBJ_G : RETVAL = Dobj[ 0 ]; break;
X case _IOBJ_G : RETVAL = Iobj; break;
X case _PREP_G : RETVAL = Prep; break;
X case _CONJ_G : RETVAL = Conj[ 0 ]; break;
X case _NUMD_G : RETVAL = NumDobj; break;
X default :
X#if DEBUG
X if( (n < 0) || (n > sp) )
X error( 13 );
X#endif
X RETVAL = stack[ n ];
X }
X}
X
X
Xsetg()
X{
X assertargs( "$setg", 2 );
X switch( ARG( 1 ) ) {
X case _VERB_G : Verb = ARG( 2 ); break;
X case _IOBJ_G : Iobj = ARG( 2 ); break;
X case _DOBJ_G : Dobj[ 0 ] = ARG( 2 ); break;
X case _PREP_G : Prep = ARG( 2 ); break;
X case _CONJ_G : Conj[ 0 ] = ARG( 2 ); break;
X case _NUMD_G : NumDobj = ARG( 2 ); break;
X default :
X if( (ARG( 1 ) < 0)||(ARG( 1 ) > sp) )
X error( 14 );
X stack[ ARG( 1 ) ] = ARG( 2 );
X }
X RETVAL = ARG( 2 );
X}
X
X
Xsaystr()
X{
X int16 i;
X
X for( i = 1; i < RETVAL; i++ )
X sayer( virtstr( ARG( i ) ) );
X}
X
X/*** EOF adlmiscr.c ***/
END_OF_adlrun/adlmiscr.c
if test 1106 -ne `wc -c <adlrun/adlmiscr.c`; then
echo shar: \"adlrun/adlmiscr.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f adlrun/adlscrn.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"adlrun/adlscrn.c\"
else
echo shar: Extracting \"adlrun/adlscrn.c\" \(4642 characters\)
sed "s/^X//" >adlrun/adlscrn.c <<'END_OF_adlrun/adlscrn.c'
X /***************************************************************\
X * *
X * adlscrn.c - Screen I/O for adlrun. Add new def's *
X * for a new terminal here (unless using termcap). *
X * *
X \***************************************************************/
X
X#include <stdio.h>
X
X#include "adltypes.h"
X#include "adlprog.h"
X#include "adldef.h"
X#include "adlrun.h"
X#include "vstring.h"
X
X
X#if HPTERM
Xstatic char
X TGOTO[] = "\033&a%dy%dC",
X CLEAR[] = "\033J",
X STANDOUT[] = "\033&dJ",
X STANDEND[] = "",
X LOCK[] = "\033l",
X NOLOCK[] = "\033m";
X#endif
X
X#if ANSI
Xstatic char
X TGOTO[] = "\033[%02d;%02dH",
X CLEAR[] = "\014",
X STANDOUT[] = "\033[0;7m",
X STANDEND[] = "\033[0m",
X LOCK[] = "",
X NOLOCK[] = "";
X#endif
X
X#if TERMCAP
Xchar
X *BC, *UP; /* Just to satisfy the linker */
X
Xstatic char
X BUFF[1024], /* Buffer for tgetent */
X TGOTO[20], /* cm */
X CLEAR[10], /* cd */
X STANDOUT[10], /* so */
X STANDEND[10], /* se */
X LOCK[10], /* ml */
X NOLOCK[10]; /* mu */
X#endif
X
Xstatic int
X END = -1; /* Last line on the screen */
X
X#if AMIGA == 0
Xchar
X *getenv(); /* Find an environment variable */
X#endif
X
Xhead_setup()
X{
X char
X *value; /* Value of an environment variable */
X FILE
X *outfile;
X
X if( !header )
X return;
X
X#if MULTIPLEX
X outfile = CURRTTY;
X#else
X outfile = stdout;
X#endif
X
X#if TERMCAP
X /* Initialize termcap */
X if( (value = getenv( "TERM" )) == (char *)0 )
X error( 29 ); /* Bad termcap */
X if( tgetent( bp, value ) <= 0 )
X error( 29 ); /* Bad termcap */
X
X /* Get the number of lines on the screen */
X END = tgetnum( "li" );
X
X /* Get the command strings */
X (void)mygetstr( "cm", TGOTO, 1 );
X (void)mygetstr( "so", STANDOUT, 0 );
X (void)mygetstr( "se", STANDEND, 0 );
X if( mygetstr( "cd", CLEAR, 0 ) == 0 )
X (void)mygetstr( "cl", CLEAR, 1 );
X (void)mygetstr( "ml", LOCK );
X (void)mygetstr( "mu", NOLOCK );
X#endif
X
X#if AMIGA
X /* Set the screen dimensions for a standard console window */
X END = 22;
X#else
X /* See if the END is in the environment */
X if( (value = getenv( "LINES" )) != (char *)0 )
X END = atoi( value );
X
X if( END < 0 )
X /* Assume a standard size terminal */
X END = 23;
X else
X /* Last line is number of lines minus one. */
X END--;
X#endif
X
X /* Go to the top of the screen */
X#if TERMCAP
X fprintf( outfile, tgoto( TGOTO, 0, 0 ) );
X#endif
X#if ANSI
X fprintf( outfile, TGOTO, 1, 1 );
X#endif
X#if HPTERM
X fprintf( outfile, TGOTO, 0, 0 );
X#endif
X
X fputs( CLEAR, outfile ); /* Clear the screen */
X fputs( STANDOUT, outfile ); /* First line inverse video */
X fprintf( outfile, H_STR, "", 0, 0 ); /* Header line */
X fputs( STANDEND, outfile ); /* End inverse video */
X fputs( LOCK, outfile ); /* lock first line */
X
X /* Go to the end of the screen */
X#if TERMCAP
X fprintf( outfile, tgoto( TGOTO, 0, END ) );
X#endif
X#if ANSI
X fprintf( outfile, TGOTO, END+1, 1 );
X#endif
X#if HPTERM
X fprintf( outfile, TGOTO, END, 0 );
X#endif
X
X fflush( outfile );
X}
X
X
X#if TERMCAP
Xmygetstr( which, where, need )
Xchar
X *which,
X *where;
Xint
X need;
X{
X int
X retval;
X char
X *temp,
X *save,
X *tgetstr();
X
X save = where;
X temp = tgetstr( which, &where );
X if( temp == (char *)0 ) {
X if( need ) {
X error( 29 ); /* Bad termcap */
X /*NOTREACHED*/
X }
X else {
X *save = '\0';
X retval = 0;
X }
X }
X else {
X *temp = '\0';
X retval = 1;
X }
X return retval;
X}
X#endif
X
X
Xwrite_head()
X{
X FILE
X *outfile;
X
X#if MULTIPLEX
X outfile = CURRTTY;
X#else
X outfile = stdout;
X#endif
X
X if( !header )
X return;
X
X assertargs( "$spec 9", 4 ); /* ($spec 9 str score moves) */
X
X fputs( NOLOCK, stdout ); /* Turn off memory lock */
X
X /* Go to the top of the screen */
X#if TERMCAP
X fprintf( outfile, tgoto( TGOTO, 0, 0 ) );
X#endif
X#if ANSI
X fprintf( outfile, TGOTO, 1, 1 );
X#endif
X#if HPTERM
X fprintf( outfile, TGOTO, 0, 0 );
X#endif
X
X fputs( STANDOUT, outfile ); /* Inverse video */
X fprintf( outfile, H_STR, virtstr( ARG( 2 ) ), ARG( 3 ), ARG( 4 ) );
X fputs( STANDEND, outfile ); /* Normal video */
X fputs( LOCK, outfile ); /* Lock the first line */
X
X /* Go to the end of the screen */
X#if TERMCAP
X fprintf( outfile, tgoto( TGOTO, 0, END ) );
X#endif
X#if ANSI
X fprintf( outfile, TGOTO, END+1, 1 );
X#endif
X#if HPTERM
X fprintf( outfile, TGOTO, END, 0 );
X#endif
X
X fflush( outfile );
X}
X
X
Xhead_term()
X{
X#if MULTIPLEX
X fputs( NOLOCK, CURRTTY );
X fflush( CURRTTY );
X#else
X fputs( NOLOCK, stdout ); /* Turn off memory lock */
X fflush( stdout );
X#endif
X}
X
X/*** EOF adlscrn.c ***/
END_OF_adlrun/adlscrn.c
if test 4642 -ne `wc -c <adlrun/adlscrn.c`; then
echo shar: \"adlrun/adlscrn.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f adlrun/adlstr.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"adlrun/adlstr.c\"
else
echo shar: Extracting \"adlrun/adlstr.c\" \(4084 characters\)
sed "s/^X//" >adlrun/adlstr.c <<'END_OF_adlrun/adlstr.c'
X#include <stdio.h>
X
X#include "adltypes.h"
X#include "adlprog.h"
X#include "adldef.h"
X#include "builtins.h"
X#include "vstring.h"
X#include "adlrun.h"
X
Xextern char
X *malloc();
X
Xeqstring()
X{
X char
X *s;
X
X assertargs( "$eqst", 2 );
X s = malloc( strlen( virtstr( ARG( 1 ) ) ) + 1 );
X if( s == (char *)0 )
X error( 27 ); /* Out of memory */
X strcpy( s, virtstr( ARG( 1 ) ) );
X if( strcmp( s, virtstr( ARG( 2 ) ) ) )
X RETVAL = 0;
X else
X RETVAL = 1;
X free( s );
X}
X
X
Xsubstring()
X{
X char
X *s;
X int
X t;
X
X assertargs( "$subs", 3 );
X t = strlen( virtstr( ARG( 1 ) ) );
X s = malloc( t + 1 );
X if( s == (char *)0 )
X error( 27 ); /* Out of memory */
X strcpy( s, virtstr( ARG( 1 ) ) );
X if( ARG( 2 ) >= t ) {
X ARG( 2 ) = t;
X ARG( 3 ) = 1;
X }
X else if( ((ARG( 2 ) + ARG( 3 )) >= t) || (!ARG( 3 )) )
X ARG( 3 ) = t - ARG( 2 );
X strncpy( s, &s[ ARG( 2 ) ], ARG( 3 ) );
X s[ ARG( 3 ) ] = '\0';
X RETVAL = newtstr( s );
X free( s );
X}
X
X
Xlengstring()
X{
X RETVAL = strlen( virtstr( ARG( 1 ) ) );
X}
X
X
Xreadstring()
X{
X char
X s[ SLEN ];
X
X getstring( s );
X RETVAL = newtstr( s );
X}
X
X
Xcatstring()
X{
X char
X *s;
X
X assertargs( "$cat", 2 );
X s = malloc( strlen( virtstr( ARG(1) ) ) + strlen( virtstr( ARG(2) ) ) + 1 );
X if( s == (char *)0 )
X error( 27 ); /* Out of memory */
X strcpy( s, virtstr( ARG(1) ) );
X strcat( s, virtstr( ARG(2) ) );
X RETVAL = newtstr( s );
X free( s );
X}
X
X
Xchrstring()
X{
X char
X s[ 2 ];
X
X assertargs( "$chr", 1 );
X s[ 0 ] = (char) ARG( 1 );
X s[ 1 ] = '\0';
X RETVAL = newtstr( s );
X}
X
X
Xordstring()
X{
X char
X temp;
X
X assertargs( "$ord", 1 );
X temp = *( virtstr( ARG( 1 ) ) );
X RETVAL = (int16) temp;
X}
X
X
Xint16
Xstrpos( s1, s2 )
Xchar
X *s1, *s2;
X{
X char
X *t0,
X *t1,
X *t2;
X
X t0 = s2;
X while( *s2 ) {
X if( *s1 == *s2 ) {
X t1 = s1;
X t2 = s2;
X while( *s1 && *s1 == *s2 ) {
X s1++;
X s2++;
X }
X if( !*s1 ) /* Found it! */
X return (int16) (s2 - t0);
X s1 = t1;
X s2 = t2;
X }
X s2++;
X }
X return -1;
X}
X
X
Xposstring()
X{
X char
X *s;
X
X assertargs( "$pos", 2 );
X s = malloc( strlen( virtstr( ARG( 1 ) ) ) + 1 );
X if( s == (char *)0 )
X error( 27 ); /* Out of memory */
X strcpy( s, virtstr( ARG( 1 ) ) );
X RETVAL = strpos( s, virtstr( ARG( 2 ) ) );
X free( s );
X}
X
X
Xsavestr()
X{
X assertargs( "$savestr", 1 );
X RETVAL = vs_save( ARG( 1 ) );
X}
X
X
Xdo_str()
X{
X char s[ SLEN ];
X
X assertargs( "$str", 1 );
X (void)sprintf( s, "%d", ARG( 1 ) );
X RETVAL = newtstr( s );
X}
X
X
Xdo_num()
X{
X assertargs( "$num", 1 );
X RETVAL = atoi( virtstr( ARG( 1 ) ) );
X}
X
X
Xchar bletch[ 10 ]; /* Static store area for xlate */
X
Xchar *
Xxlate( s )
Xchar
X *s;
X{
X int
X i;
X
X for( i = 0; s[ i ]; i++ )
X bletch[ i ] = ~s[ i ];
X bletch[ i ] = '\0';
X return bletch;
X}
X
X
Xdo_name()
X{
X char
X s[ 80 ];
X int16
X t;
X
X assertargs( "$name", 1 );
X#if DEBUG
X if( (ARG( 1 ) < 0) || (ARG( 1 ) > NUMOBJ) )
X error( 25 ); /* Illegal object for $name */
X#endif
X t = objspace[ ARG( 1 ) ].adj;
X if( t < 0 ) {
X strcpy( s, findone( VERB, -t ) );
X strcat( s, " " );
X }
X else if( t ) {
X strcpy( s, findone( ADJEC, t ) );
X strcat( s, " " );
X }
X else
X *s = '\0';
X strcat( s, findone( NOUN, objspace[ ARG( 1 ) ].noun ) );
X RETVAL = newtstr( s );
X}
X
X
Xdo_vname()
X{
X assertargs( "$vname", 1 );
X RETVAL = newtstr( findone( VERB, ARG( 1 ) ) );
X}
X
X
Xdo_mname()
X{
X assertargs( "$mname", 1 );
X if( ARG( 1 ) < 0 ) {
X ARG( 1 ) = -ARG( 1 );
X do_vname();
X }
X else if( ARG( 1 ) )
X RETVAL = newtstr( findone( ADJEC, ARG( 1 ) ) );
X else
X RETVAL = newtstr( "" );
X}
X
X
Xdo_pname()
X{
X assertargs( "$pname", 1 );
X RETVAL = newtstr( findone( PREP, ARG( 1 ) ) );
X}
X
X
Xdo_define()
X{
X char
X s1[ 80 ],
X s2[ 80 ];
X
X assertargs( "$define", 2 );
X strcpy( s1, virtstr( ARG( 1 ) ) );
X strcpy( s2, virtstr( ARG( 2 ) ) );
X define( s1, s2 );
X}
X
X
Xdo_undef()
X{
X char
X s[ 80 ];
X
X assertargs( "$undef", 1 );
X strcpy( s, xlate( virtstr( ARG( 1 ) ) ) );
X undef( s );
X}
X
X/*** EOF adlstr.c ***/
END_OF_adlrun/adlstr.c
if test 4084 -ne `wc -c <adlrun/adlstr.c`; then
echo shar: \"adlrun/adlstr.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f include/adlprog.h -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"include/adlprog.h\"
else
echo shar: Extracting \"include/adlprog.h\" \(3720 characters\)
sed "s/^X//" >include/adlprog.h <<'END_OF_include/adlprog.h'
X#define NUMPROP 32 /* Max # of object properties */
X
X/* Structure of an object */
Xstruct objrec {
X int16 loc, /* obj index */
X cont, /* obj index */
X link, /* obj index */
X adj, /* adj index */
X others, /* obj index */
X noun, /* noun index */
X props1to16, /* 0 or 1 */
X props[ NUMPROP - 16 ]; /* General props */
X}; /* 44 bytes */
X
X/* Structure of a verb */
Xstruct verbrec {
X int16 preact, /* rout index */
X postact; /* rout index */
X}; /* 4 bytes */
X
X/* Structure of a verb-prep synonym */
Xstruct vp_syn {
X int16 vrb, /* Verb index */
X prp, /* Prep index */
X val; /* Verb index */
X}; /* 6 bytes */
X
X/* Structure of a multi-word preposition ("in front of") */
Xstruct preprec {
X int16 first, /* Prep # */
X obj, /* Object # */
X last, /* Prep # */
X val; /* Prep # */
X}; /* 8 bytes */
X
X
X/* "Directory" of compiled dungeon */
Xstruct adldir {
X int16 numobjs, /* Number of objects */
X objsize; /* Size of an object */
X int32 ptr; /* Lseek index into the file */
X}; /* 8 bytes */
X
X
X/* Structure of a symbol */
X#define LENGTH 8 /* Maximum symbol name length */
Xstruct symbol {
X char
X first, /* Was this the first symbol? */
X name[ LENGTH + 1 ]; /* Name of the symbol */
X int16
X type, /* Type (NOUN, ADJEC, etc.) */
X val; /* Value */
X}; /* 14 bytes */
X
X/* Header of an ADL executable file */
Xstruct header {
X char adlname[ 80 ]; /* Hack for BSD systems */
X struct adldir codeindex, /* Index for the code */
X strtabindex, /* Index for the string tab */
X strindex, /* Index for the strings */
X symindex, /* Index for the sym table */
X verbindex, /* Index for the verbs */
X objindex, /* Index for the objects */
X nounindex, /* Index for the nouns */
X varindex, /* Index for the vars */
X prepindex, /* Index for the preps */
X vsindex, /* Index for the verb syns */
X routindex; /* Index for the routines */
X int32 adlid, /* Timestamp */
X magic; /* Magic number */
X};
X
Xextern struct verbrec *verbspace; /* Verb contents */
Xextern struct objrec *objspace; /* Object contents */
Xextern struct preprec *prepspace; /* Preposition contents */
Xextern struct vp_syn *verbsyn; /* Verb synonyms */
Xextern int16 *varspace; /* Stack & variables */
Xextern int16 *nounspace; /* Noun indices */
Xextern address *routspace; /* Routine indices */
Xextern int32 *str_tab; /* String table */
X
Xextern struct header hdr; /* Global header struct */
X
X/* Some #defines to make life easier */
X
X#define NUMNOUN hdr.nounindex.numobjs
X#define NUMSYM hdr.symindex.numobjs
X#define NUMVERB hdr.verbindex.numobjs
X#define NUMOBJ hdr.objindex.numobjs
X#define NUMVAR hdr.varindex.numobjs
X#define NUMROUT hdr.routindex.numobjs
X#define NUMSTR hdr.strtabindex.numobjs
X#define NUMPP hdr.prepindex.numobjs
X#define NUMVS hdr.vsindex.numobjs
X
X
X/* Predefined stuff */
X
X#define M_ADL 0x0ad10ad1L /* Adl magic number */
X
X#define _START 1 /* Rout # for START */
X#define _DWIMI 2 /* Rout # for DWIMI */
X#define _DWIMD 3 /* Rout # for DWIMD */
X
X#define _NOVERB 0 /* Verb # for NOVERB */
X#define _TELLER 1 /* Verb # for TELLER */
X
X#define _ALL 0 /* Obj # for .ALL */
X#define _STRING 1 /* Obj # for STRING */
X
X#define _ACT NUMPROP /* Prop # for ACTION */
X#define _LD (_ACT - 2) /* Prop # for LDESC */
X#define _SD (_ACT - 1) /* Prop # for SDESC */
X#define _PREACT (_ACT + 1) /* Prop # for PREACT */
X
X#define _VERB_G -1 /* Glob # for Verb */
X#define _DOBJ_G -2 /* Glob # for Dobj */
X#define _IOBJ_G -3 /* Glob # for Iobj */
X#define _PREP_G -4 /* Glob # for Prep */
X#define _CONJ_G -5 /* Glob # for Conj */
X#define _NUMD_G -6 /* Glob # for Numd */
X
X/*** EOF adlprog.h ***/
END_OF_include/adlprog.h
if test 3720 -ne `wc -c <include/adlprog.h`; then
echo shar: \"include/adlprog.h\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f include/adlrun.h -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"include/adlrun.h\"
else
echo shar: Extracting \"include/adlrun.h\" \(4855 characters\)
sed "s/^X//" >include/adlrun.h <<'END_OF_include/adlrun.h'
X#include <setjmp.h>
X
X#define SLEN 80 /* Maximum length of an input string */
X#define NUMDO 10 /* Maximum # of direct objs allowed */
X#define STACKSIZE 1024 /* Maximum stack depth */
X
X/* Structure of a macro definition */
Xstruct macro {
X char
X name[ 10 ], /* Name of the macro */
X val[ 80 ]; /* Replacement text of the macro */
X struct macro
X *next; /* Next macro in the stack */
X};
X
X
X/* Structure of an actor */
Xstruct actrec {
X int16
X actor; /* Object id of this actor */
X char
X *linebuf, /* Pointer to current input line */
X savebuf[ SLEN ]; /* Static save area for input line */
X int16
X interact; /* Get new string if null linebuf? */
X#if MULTIPLEX
X char
X ttyname[ SLEN ]; /* Name of the actor's tty */
X FILE
X *ttyfile; /* Opened version of the same */
X#endif
X};
X
X
X/* Structure of a $exit place */
Xstruct exit_place {
X jmp_buf
X exit_goto; /* Where to go for ($exit n) */
X int16
X exit_ok; /* Is it OK to perform ($exit n) */
X};
X
X#if MSDOS & LATTICE
X# define SET_EXIT(n) (exits[n].exit_ok=1, setjmp(&(exits[n].exit_goto)))
X# define DO_EXIT(n) (exits[n].exit_ok=0, longjmp(&(exits[n].exit_goto),1))
X#else
X# define SET_EXIT(n) (exits[n].exit_ok=1, setjmp(exits[n].exit_goto))
X# define DO_EXIT(n) (exits[n].exit_ok=0, longjmp(exits[n].exit_goto,1))
X#endif
X#define CLR_EXIT(n) (exits[n].exit_ok=0)
X
Xextern struct actrec
X actlist[]; /* List of actors */
X
Xextern address
X ip; /* Instruction pointer */
Xextern int16
X stack[], /* Execution stack */
X sp, /* Stack pointer */
X bp, /* Base pointer, or Frame pointer */
X numact, /* Number of Actors in Actlist */
X curract, /* Current Actor */
X Verb, /* Current verb */
X Prep, /* Current preposition */
X Iobj, /* Current indirect object */
X Inoun, /* and its noun */
X Imod, /* and its modifier */
X Conj[], /* List of conjunctions */
X Dobj[], /* List of direct objects */
X Dnoun[], /* and their nouns */
X Dmod[], /* and their modifiers */
X NumDobj, /* Number of direct objects */
X vecverb[], /* Verb list */
X demons[], /* List of active demons */
X fuses[], /* List of active fuses */
X ftimes[], /* When to activate fuses */
X f_actors[], /* Actors associated with fuses */
X numd, /* Number of active demons */
X numf, /* Number of active fuses */
X currturn, /* Current turn counter */
X prompter, /* Prompting routine */
X numsave, /* Number of "saved" characters */
X debug, /* Print out debugging info? */
X header, /* Should we print out header bar? */
X wordwrite, /* Should we write unknown words? */
X restarted, /* Is the game being restarted? */
X scrwidth, /* Width of the screen */
X numcol, /* How far we've written across */
X t_type, /* Current token type */
X t_val, /* Current token value */
X read_t, /* TRUE iff lexer is to read next token */
X Phase; /* Current phase # */
X
Xextern struct exit_place
X exits[]; /* List of exit places */
X
Xextern char
X *H_STR, /* Header format string */
X *s, /* Current token */
X *xp; /* Macro expansion of s */
X
Xextern FILE
X *wordfile, /* If so, write them to this file. */
X *scriptfile; /* File for "scripting" output */
X
X#if MULTIPLEX
Xextern FILE
X *CURRTTY, /* Current tty for output */
X *SYSTTY; /* Default I/O tty */
X#endif
X
Xextern char
X savec[]; /* The saved string array */
X
Xextern struct macro
X *mactab; /* Table of macro expansions */
X
Xextern int16
X bitpat[], /* Bit patterns for masking */
X ibitpat[]; /* Bitwise NOT of above */
X
X
X
X#if DEBUG
Xextern int16
X pop(); /* Pop the top of the stack */
X#else
X# define push(x) (stack[sp++]=x)
X# define pop(x) (stack[--sp])
X# define assertargs(s,n) 0
X#endif
X
X#define puship() push( ip ) /* Push the IP (in case of 32-bit) */
X#define popip() (ip = pop()) /* Pop the IP (in case of 32-bit) */
X
X#define CURRACT actlist[ curract ].actor
X#define PSTRING actlist[ curract ].linebuf
X#define SAVEBUF actlist[ curract ].savebuf
X#define INTERACT actlist[ curract ].interact
X
X#define ARG( n ) stack[ bp + n ] /* n'th argument to this rout */
X#define RETVAL stack[ bp ] /* Return val. from this rout */
X
Xextern int16
X noun_exists(), /* Is [mod noun] a legal object? */
X yesno(), /* Did the player type 'Y' or 'y'? */
X nummacro(); /* Returns number of macros defined */
X
Xextern char
X *malloc(), /* Memory allocation */
X *findone(), /* Find a symbol. */
X *expand(); /* Try to macro-expand a string */
X
Xextern int16
X lookup(), /* Look up a token in the symbol table */
X insertkey(); /* Insert a token into the symbol table */
X
Xextern int
X parse(); /* Parse the player's sentence */
X
X/*** EOF adlrun.h ***/
END_OF_include/adlrun.h
if test 4855 -ne `wc -c <include/adlrun.h`; then
echo shar: \"include/adlrun.h\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f include/builtins.h -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"include/builtins.h\"
else
echo shar: Extracting \"include/builtins.h\" \(4871 characters\)
sed "s/^X//" >include/builtins.h <<'END_OF_include/builtins.h'
X/* builtins.h -- values for built in functions */
X
X/* Object functions */
X
X#define _LOC -1 /* ($loc OBJ) container of OBJ */
X#define _CONT -2 /* ($cont OBJ) First item contained in OBJ */
X#define _LINK -3 /* ($link OBJ) Next obj in same node as OBJ */
X#define _LDESC -4 /* ($ldesc OBJ) LDesc of OBJ */
X#define _SDESC -5 /* ($sdesc OBJ) SDesc of OBJ */
X#define _ACTION -6 /* ($action OBJ) Action routine for OBJ */
X#define _PROP -7 /* ($prop OBJ NUM) NUM'th prop of OBJ */
X#define _SETP -8 /* ($setp OBJ NUM VAL) OBJ(NUM) = VAL */
X#define _MOVE -9 /* ($move OBJ1 OBJ2) move OBJ1 to OBJ2 */
X#define _MODIF -10 /* ($modif OBJ) modifier of OBJ -
X if < 0, it is a verb; if > 0 it
X is an adjec, otherwise, it's null */
X
X/* Verb functions */
X
X#define _VSET -11 /* ($vset VERB PROP VAL) VERB(PROP) = VAL */
X#define _VPROP -12 /* ($vprop VERB PROP) returns VERB(PROP) */
X
X/* Arithmetic functions */
X
X#define _PLUS -13 /* ($plus A B) A + B */
X#define _MINUS -14 /* ($minus A B) A - B */
X#define _TIMES -15 /* ($times A B) A * B */
X#define _DIV -16 /* ($div A B) A / B */
X#define _MOD -17 /* ($mod A B) A % B */
X#define _RAND -18 /* ($rand N) Random # from 1 to N, inclusive */
X
X/* Boolean functions */
X
X#define _AND -19 /* ($and A B) A & B */
X#define _OR -20 /* ($or A B) A | B */
X#define _NOT -21 /* ($not N) 1 if N==0, 0 otherwise */
X#define _YORN -22 /* ($yorn) (user input)[0] in [ 'y', 'Y' ] */
X#define _PCT -23 /* ($pct N) 1 N% of the time */
X#define _EQ -24 /* ($eq A B) A == B */
X#define _NE -25 /* ($ne A B) A != B */
X#define _LT -26 /* ($lt A B) A < B */
X#define _GT -27 /* ($gt A B) A > B */
X#define _LE -28 /* ($le A B) A <= B */
X#define _GE -29 /* ($ge A B) A >= B */
X
X/* Miscellaneous Routines */
X
X#define _SAY -30 /* ($say A B ...) printf( "%s%s...", A,B,...)*/
X#define _ARG -31 /* ($arg N) Nth arg to this routine */
X#define _EXIT -32 /* ($exit N) pop stack; if N !=0 next turn */
X#define _RETURN -33 /* ($return V) pop stack, retval = V */
X#define _VAL -34 /* ($val E) returns E */
X#define _PHASE -35 /* ($phase) returns current phase # */
X#define _SPEC -36 /* ($spec CODE A B C ...) perform one of:
X CODE = 1, Toggle debugging mode
X CODE = 2, Restart this run of ADL
X CODE = 3, Terminate this run of ADL
X CODE = 4, Save the game
X CODE = 5, Restore a game
X CODE = 6, Execute a program A with args B...
X CODE = 7, Set the unknown words file
X CODE = 8, Set script file
X CODE = 9, Write a header
X CODE = 10, Set left & right margins
X */
X
X/* Global-value functions */
X
X#define _SETG -37 /* ($setg VAR VAL) (VAR) = VAL */
X#define _GLOBAL -38 /* ($global VAR) @VAR */
X#define _VERB -39 /* ($verb) @Verb */
X#define _DOBJ -40 /* ($dobj) @Dobj */
X#define _IOBJ -41 /* ($iboj) @Iobj */
X#define _PREP -42 /* ($prep) @Prep */
X#define _CONJ -43 /* ($conj) @Conj */
X#define _NUMD -44 /* ($numd) @Numd */
X
X/* Transition procedures */
X
X#define _SETV -45 /* ($setv V1 .. V10) VECVERB = V1 .. V10 */
X#define _HIT -46 /* ($hit OBJ D1 .. D10)
X ($move OBJ D[ pos( @Verb, VECVERB )) */
X#define _MISS -47 /* ($miss R1 .. R10)
X eval( R[ pos( @Verb, VECVERB ) ) */
X
X/* String functions */
X
X#define _EQST -48 /* ($eqst A B) returns strcmp( A, B ) == 0 */
X#define _SUBS -49 /* ($subs S P N) returns copy( S, P, N ) */
X#define _LENG -50 /* ($leng S) returns length( S ) */
X#define _CAT -51 /* ($cat S1 S2) returns strcat( S1, S2 ) */
X#define _POS -52 /* ($pos S1 S2) returns strpos( S1, S2 ) */
X#define _CHR -53 /* ($chr N) returns '\NNN' */
X#define _ORD -54 /* ($ord S) returns (int16) S[ 0 ] */
X#define _READ -55 /* ($read) returns user input string */
X#define _SAVESTR -56 /* ($savestr S) saves S in perm. area */
X#define _NAME -57 /* ($name OBJ) returns (2 word) name of OBJ */
X#define _VNAME -58 /* ($vname VERB) returns name of VERB */
X#define _MNAME -59 /* ($mname MODIF) returns name of MODIF */
X#define _PNAME -60 /* ($pname PREP) returns name of PREP */
X#define _DEFINE -61 /* ($define a b) expands a to b at runtime */
X#define _UNDEF -62 /* ($undef S) undefines S */
X#define _STR -63 /* ($str N) returns the ascii value of N */
X#define _NUM -64 /* ($num S) returns numeric value of S */
X
X/* Demons, fuses, and actors */
X
X#define _SDEM -65 /* ($sdem R) activates R as a demon */
X#define _DDEM -66 /* ($ddem R) deactivates R as a demon */
X#define _SFUS -67 /* ($sfus R N) Activates R as a fuse,
X burning down in N turns */
X#define _DFUS -68 /* ($dfus R) Quenches R as a fuse */
X#define _INCTURN -69 /* ($incturn) Increment the turn counter */
X#define _TURNS -70 /* ($turns) Current val. of turn counter */
X#define _PROMPT -71 /* ($prompt R) Sets R as the prompt routine */
X#define _ACTOR -72 /* ($actor OBJ STR FLAG) new actor */
X#define _DELACT -73 /* ($delact OBJ) Deletes actor OBJ */
X
X/*** EOF builtins.h ***/
END_OF_include/builtins.h
if test 4871 -ne `wc -c <include/builtins.h`; then
echo shar: \"include/builtins.h\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f samples/aard/verbs.adl -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"samples/aard/verbs.adl\"
else
echo shar: Extracting \"samples/aard/verbs.adl\" \(6616 characters\)
sed "s/^X//" >samples/aard/verbs.adl <<'END_OF_samples/aard/verbs.adl'
X{*** VERBS ***}
X
XVERB
X sign, play,
X rname, shell, eat,
X swim, feed, score, dig,
X cut, plug, tie, untie,
X wipe, shake, xyzzy, jamb,
X abracadabra;
X
X
Xsign(PREACT) = Preact; play(PREACT) = Preact;
Xeat(PREACT) = Preact; cut(PREACT) = Preact;
Xfeed(PREACT) = Preact; plug(PREACT) = Preact;
Xuntie(PREACT) = Preact; wipe(PREACT) = Preact;
Xshake(PREACT) = Preact; jamb(PREACT) = Preact;
Xtie(PREACT) = Preact;
Xscore(PREACT) = (Expect NO_OBJ NO_OBJ);
Xdig(PREACT) = (Expect NO_OBJ NO_OBJ);
Xswim(PREACT) = (Expect NO_OBJ NO_OBJ);
X
X
Xi = inventory;
Xplugh = xyzzy; clean = wipe;
Xshut = close; peruse = read;
Xchuck = throw; hurl = throw;
Xtoss = throw; heave = throw;
Xdiscard = drop; excavate = dig;
Xgrab = take; push = touch;
Xpet = touch; devour = eat;
Xconsume = eat; wade = swim;
Xford = swim; shazam = abracadabra;
Xhocus = abracadabra; abra = abracadabra;
Xend = quit; bye = quit;
Xleave = exit; climb = up;
X
X{*** VERB ROUTINES ***}
X
Xplug(ACTION) =
X (IF ($eq ($loc .ME) irm13) THEN
X (IF ($eq ($loc cotton) .ME) THEN
X ($say "You stick the cotton into the rhino's ears.\n")
X ($move cotton .ALL)
X ($setp rhino earplg 1)
X ($exit 1)
X )
X )
X ($say "I don't quite understand what you mean.\n")
X;
X
X
Xdig(ACTION) =
X (IF ($ne ($loc shovel) .ME) THEN
X ($say "You don't have something to dig with.\n")
X ($exit 1)
X )
X (IF ($eq ($loc .ME) irm9) THEN
X (IF ($not ($prop cotton tookbt)) THEN
X ($setp cotton tookbt 1)
X ($say "You find some cotton buried in the sand.\n")
X ($move cotton irm9)
X ($return 0)
X )
X ($say "OK\n")
X ($return 0)
X )
X (IF ($eq ($loc .ME) prm17) THEN
X (IF ($not ($prop pendant dugbt)) THEN
X ($setp pendant dugbt 1)
X ($say "You find an ancient pendant buried in the grave.\n")
X ($move pendant prm17)
X ($return 0)
X )
X ($say "You dig some but you don't find anything.\n")
X ($return 0)
X )
X ($say "The ground is too hard to dig into.\n")
X;
X
X
Xcantdo =
X ($say "I don't believe I can do that.\n")
X;
X
X
Xsign(ACTION) = cantdo;
Xplay(ACTION) = cantdo;
X
Xarolg =
X ($say "It will probably cost you an arm or a leg to feed that.\n")
X ($exit 1)
X;
X
X
Xfeed(ACTION) =
X (IF ($or ($eq ($loc .ME) irm8) ($eq ($loc .ME) irm9)) THEN
X (IF ($eq ($dobj) crocodile) THEN
X (arolg)
X )
X )
X (IF ($and ($eq ($loc .ME) prm19) ($eq ($dobj) bear)) THEN
X (IF ($not ($prop bear hitbr)) THEN
X (arolg)
X )
X )
X (IF ($and ($eq ($loc .ME) prm6) ($eq ($dobj) smilo)) THEN
X (IF ($not ($prop smilo stond)) THEN
X (arolg)
X )
X )
X (IF ($or ($eq ($loc .ME) prm22) ($eq ($loc .ME) prm23)) THEN
X (IF ($eq ($dobj) tyranosaur) THEN
X (arolg)
X )
X )
X ($say "I don't quite understand what you mean.\n")
X;
X
X
Xcut(ACTION) = cantdo;
X
Xthrow(ACTION) =
X (IF ($ne ($loc ($dobj)) .ME) THEN
X ($say "You don't have it.\n")
X ($exit 1)
X )
X ($say "OK.\n")
X (cdrop)
X;
X
Xeat(ACTION) = ($say "I think I just lost my appetite.\n");
X
Xabracadabra(ACTION) =
X (IF ($ne prehs ($loc ($loc .ME))) THEN
X ($say
X"That phrase hasn't worked in at least ten thousand years.\n"
X )
X ($return 0)
X )
X (IF ($ne ($loc .ME) prm17) THEN
X ($say "Nothing happens.\n")
X ($return 0)
X )
X (IF ($prop spear tooky) THEN
X (IF ($not ($prop spear abrad)) THEN
X ($setp spear abrad 1)
X ($say "The rubble gets magically cleared away.\n")
X ($return 0)
X )
X )
X ($say "Nothing much happens.\n")
X;
X
X
Xtie(ACTION) = ($say "It is impossible to tie a knot in that right now. \n");
X
Xuntie(ACTION) = ($say "I don't quite understand what you mean.\n");
X
Xswim(ACTION) =
X (IF ($eq ($loc .ME) irm8) THEN
X (ei8)
X ($return 0)
X )
X (IF ($eq ($loc .ME) irm9) THEN
X (ei8)
X ($move .ME irm8)
X ($return 0)
X )
X ($say "I don't see enough water here to even wade in.\n")
X;
X
X
Xwipe(ACTION) = ($say "I don't quite comprehend what you are saying.\n");
X
Xshake(ACTION) = ($say "That probably won't accomplish much.\n");
X
Xjamb(ACTION) = ($say "I don't quite comprehend what you mean.\n");
X
Xxyzzy(ACTION) =
X ($say
X"You are transported to a room where you are faced by a wizard who points to
Xyou and says, ''Them's fighting words!'' You immediately get attacked by
Xall sorts of denizens of the museum: there is a cobra chewing on your leg, "
X"a troglodyte is bashing your brains out with a gold nugget, a crocodile is
Xremoving large chunks of flesh from you, a rhinoceros is goring you with his
Xhorn, a sabre-tooth cat is busy trying to disembowel you, you are being "
X"trampled by a large mammoth, a vampire is sucking you dry, a Tyranosaurus
XRex is sinking his six inch long fangs into various parts of your anatomy,
Xa large bear is dismembering your body, a gargoyle is bouncing up and "
X"down on your head, a burly troll is tearing you limb from limb, several
Xdire wolves are making mince meat out of your torso, and the wizard is about
Xto transport you to the corner of Westwood and Broxton. "
X )
X ($say "Oh dear, you seem to have gotten yourself killed, as well.\n")
X (skore)
X (ratng)
X (ratnx)
X ($spec QUIT)
X;
X
X
Xscore(ACTION) =
X (skore)
X (ratng)
X;
X
X
Xquit( ACTION ) =
X (skore)
X (ratng)
X (ratnx)
X ($spec QUIT)
X;
X
X
Xscale =
X ($setp .ME weight 0)
X (IF ($cont .ME) THEN
X (scads ($cont .ME))
X )
X;
X
X
Xscads =
X (IF %1 THEN
X ($setp .ME weight ($plus ($prop .ME weight)
X ($prop %1 weight)))
X (scads ($link %1))
X )
X;
X
X
XTakeAct = (ctake);
X
XDropAct = (cdrop);
X
X
Xctake =
X (scale)
X (IF ($prop ($dobj) NOTAKE) THEN
X ($say "That thing is too heavy to carry.\n")
X ($setg Skip TRUE)
X ($return 0)
X )
X (IF ($gt ($plus ($prop ($dobj) weight) ($prop .ME weight)) 20) THEN
X ($say
X"You are carrying too much. You will have to at least drop something first.\n"
X )
X ($setg Skip TRUE)
X ($return 0)
X )
X ($setp .ME weight ($plus ($prop ($dobj) weight) ($prop .ME weight)))
X (IF ($not ($prop ($dobj) rarea)) THEN
X ($return 0)
X )
X ($setp .ME pscore ($plus ($prop .ME pscore) ($prop ($dobj) pfound)))
X ($setp ($dobj) pfound 0)
X;
X
X
Xcdrop =
X (IF ($eq ($loc .ME) prm21) THEN
X ($say "OK, it falls further down into the crack.\n")
X ($move ($dobj) prm22)
X ($setg Skip TRUE)
X ($return 0)
X )
X (IF ($not ($prop ($dobj) rarea)) THEN
X ($return 0)
X ELSEIF ($and ($eq ($prop ($dobj) rarea) 2) ($eq ($loc .ME) mrm5)) THEN
X (scord)
X ELSEIF ($and ($eq ($prop ($dobj) rarea) 1) ($eq ($loc .ME) mrm3)) THEN
X (scord)
X )
X;
X
Xscord =
X ($setp .ME pscore ($plus ($prop .ME pscore) ($prop ($dobj) pplace)))
X ($setp ($dobj) pplace 0)
X;
X
X
Xrname(ACTION) =
X (($sdesc ($loc .ME)))
X ($exit 1)
X;
X
X
Xshell(ACTION) =
X ($spec EXEC "/bin/csh" "-i" 0)
X;
END_OF_samples/aard/verbs.adl
if test 6616 -ne `wc -c <samples/aard/verbs.adl`; then
echo shar: \"samples/aard/verbs.adl\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f samples/demos/baby.adl -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"samples/demos/baby.adl\"
else
echo shar: Extracting \"samples/demos/baby.adl\" \(6823 characters\)
sed "s/^X//" >samples/demos/baby.adl <<'END_OF_samples/demos/baby.adl'
XINCLUDE "standard.adl";
X
X{ Object properties specific to this scenario }
X
XBROKEN = 1; { The window can be broken }
X
X
X
X{ Locations in this scenario }
X
XNOUN
X room1,
X room2;
X
Xroom1(LIGHT) = TRUE;
Xroom2(LIGHT) = TRUE;
X
X
X
X{ The vocabulary for this scenario }
X
XADJEC
X sun,
X red,
X blue;
X
XNOUN
X wall,
X floor,
X sun window(room2),
X door(room1),
X red ball(room1),
X blue ball(room1);
X
XPREP
X against;
X
Xhard = red; wooden = red;
Xsoft = blue; foamy = blue;
Xsunwindow = sun window;
Xbounce = throw;
X
X
X
X
X{ Location descriptions }
X
Xroom1(LDESC) =
X ($say "You are in your bedroom. All of your really FUN toys have been ")
X ($say "put away, out of your reach. There is another room to the east.\n")
X;
Xroom1(SDESC) = ($say "Bedroom\n");
X
Xroom2(LDESC) =
X ($say "You are in the nursery. A pretty yellow sunbeam is shining on the ")
X ($say "floor. There is another room to the west.\n")
X;
Xroom2(SDESC) = ($say "Nursery\n");
X
X
X
X
X{ Transition routines }
Xcg = ($say "You can't go that way.\n");
X
Xroom1(ACTION) =
X ($miss cg cg 0 cg cg cg cg cg cg cg)
X ($hit .ME 0 0 room2 0 0 0 0 0 0 0)
X;
X
Xroom2(ACTION) =
X ($miss cg cg cg 0 cg cg cg cg cg cg)
X ($hit .ME 0 0 0 room1 0 0 0 0 0 0)
X;
X
X
X
X{ Object specific routines }
X
XBallAct = { ACTION rout for balls }
X (IF ($eq @Verb throw) THEN
X (IF ($ne @Dobj %1) THEN
X { We're the iobj; don't perform an action }
X ($exit 0)
X )
X (IF ($ne @Iobj wall) THEN
X ($say "You throw the ball at the floor, where it bounces a few ")
X ($say "times, then is still.\n")
X ELSE
X ($say "The ball sails through the air, then bounces off the wall ")
X ($say "onto the floor.\n")
X )
X ($move @Dobj ($loc .ME))
X ($exit 1)
X )
X;
X
Xred ball(LDESC) = ($say "There is a hard, wooden red ball here.\n");
Xred ball(SDESC) = ($say "a red ball");
Xred ball(ACTION) = (BallAct [red ball]);
X
Xblue ball(LDESC) = ($say "There is a soft, foamy blue ball here.\n");
Xblue ball(SDESC) = ($say "a blue ball");
Xblue ball(ACTION) = (BallAct [blue ball]);
X
X
XNoAct = { ACTION rout for wall and floor }
X (IF ($or ($ne @Verb throw) ($ne @Iobj %1)) THEN
X (Silly)
X )
X;
X
Xwall(NOTAKE) = TRUE;
Xwall(ACTION) = (NoAct wall);
X
Xfloor(NOTAKE) = TRUE;
Xfloor(ACTION) = (NoAct floor);
X
X
Xsun window(NOTAKE) = TRUE;
Xsun window(LDESC) =
X ($say "There is a large sun window here")
X (IF ($prop [sun window] BROKEN) THEN
X ($say ", shattered into a thousand pieces!\n")
X ELSE
X ($say ".\n")
X )
X;
Xsun window(SDESC) =
X (IF ($prop [sun window] BROKEN) THEN
X ($say "a broken window")
X ELSE
X ($say "a sun window")
X )
X;
Xsun window(ACTION) =
X (IF ($and ($eq @Verb throw) ($eq @Iobj [sun window])) THEN
X (IF ($eq @Dobj [red ball]) THEN
X ($say "The red ball sails through the window, shattering it!\n")
X ($move [red ball] .ALL)
X ($setp [sun window] BROKEN TRUE)
X ($exit 1)
X ELSEIF ($eq @Dobj [blue ball]) THEN
X (IF ($prop [sun window] BROKEN) THEN
X ($say "The blue ball sails through the broken window!\n")
X ($move [blue ball] .ALL)
X ELSE
X ($say "The blue ball bounces harmlessly off the window.\n")
X ($move [blue ball] room2)
X )
X ($exit 1)
X ELSE
X (Silly)
X )
X ELSEIF ($eq @Verb open) THEN
X ($say "You can't open a sun window!\n")
X ($exit 1)
X ELSEIF ($eq @Verb take) THEN
X (Silly)
X )
X;
X
X
Xdoor(NOTAKE) = TRUE;
Xdoor(LDESC) = ($say "There is a closed door here.\n");
Xdoor(SDESC) = ($say "a door");
Xdoor(ACTION) =
X (IF ($and ($eq @Verb throw) ($eq @Iobj door)) THEN
X ($say "The " ($name @Dobj) " bounces harmlessly off of the door.\n")
X ($exit 1)
X ELSEIF ($eq @Verb open) THEN
X ($say "The doorknob is too high for you to reach.\n")
X ($exit 1)
X ELSEIF ($eq @Verb take) THEN
X (Silly)
X )
X;
X
X
X
X
X{ Scenario dependant routines }
X
XParent = { The parent fuse }
X (IF ($eq ($loc .ME) room1) THEN
X ($say "Suddenly, the door to your bedroom opens! ")
X ELSE
X ($say "You hear the door in your bedroom opening! ")
X )
X ($say "Your parents enter the room. ")
X (IF ($prop [sun window] BROKEN) THEN
X ($say "Daddy notices the broken window, and turns a funny red color. ")
X ($say "\"I see that you haven't learned your lesson, dear,\" says ")
X ($say "Mommy. \"I'm afraid that you will have to stay in here for ")
X ($say "at least another hour! ")
X ($say "Mommy and Daddy leave you alone again. Let's see what other ")
X ($say "fun things there are to do around here...\n")
X ELSE
X ($say "\"Have you learned your lesson, kiddo?\" asks Daddy. Seeing ")
X ($say "your cute little face seems to have charmed them! You're off ")
X ($say "the hook! Mommy and Daddy take you out to see \"The Care ")
X ($say "Bears Eat New York\", and you live happily ever after.\n")
X )
X ($spec QUIT)
X;
X
X
XVAR
X Rand[ 10 ];
X
X(Rand + 0) = "You wonder if the blue ball will bounce off of the window.\n";
X(Rand + 1) = "You wonder if the red ball will bounce off of the window.\n" ;
X(Rand + 2) = "You find a piece of lint on the floor, and eat it. Yum!\n" ;
X(Rand + 3) = "You can hear Kitty meowing outside.\n" ;
X(Rand + 4) = "You hear Mommy singing in the kitchen.\n" ;
X(Rand + 5) = "You practice making disgusting noises. THPPP! ZZZKKK!\n" ;
X(Rand + 6) = "You hear Daddy hit his head on the garage door.\n" ;
X(Rand + 7) = "You lick the wall, to see what it tastes like.\n" ;
X(Rand + 8) = "You pretend that you're an airplane. Zoom!\n" ;
X(Rand + 9) = "You make spider shadows with your hands.\n";
X
XRandom = { Random message daemon }
XLOCAL which;
X ($incturn) { Increment the turn counter }
X ($move wall ($loc .ME)) { Move the wall to my current location }
X ($move floor ($loc .ME)) { Move the floor to my current location }
X ($setg which ($rand 20))
X (IF ($eq @which 1) THEN
X (IF ($ne ($loc [blue ball]) .ALL) THEN
X ($say ($global ($plus Rand 0)))
X )
X ELSEIF ($eq @which 2) THEN
X (IF ($ne ($loc [red ball]) .ALL) THEN
X ($say ($global ($plus Rand 1)))
X )
X ELSEIF ($le @which 10) THEN
X ($say ($global ($plus Rand ($minus @which 1))))
X )
X;
X
XNOUN ME(room1); { The main actor in this play }
X
X(Indent) = TRUE; { Indent object descriptions }
X
XSTART =
X ($say "\n\n\n\n") { A few newlines for good measure }
X ($say "It all started so innocently! Kitty asked you for a haircut, ")
X ($say "so you took Daddy's neato electric razor, and gave her a Mohawk. ")
X ($say "Unfortunately, Mommy and Daddy didn't think it was so neat, and ")
X ($say "they stuck you in here for a fifteen minute time out period...\n\n")
X (StdInit ME) { Initialize standard }
X ($sdem Random) { Set up the random message daemon }
X ($sfus ME Parent 15) { Set up mommy and daddy }
X ($define "both" "red,blue") { Set up "both" to work }
X ($define "balls" "ball") { with the balls }
X;
X
X{ Dwimming routines }
X
XDWIMI = ($return (Dwimmer %1));
XDWIMD = ($return (Dwimmer %1));
END_OF_samples/demos/baby.adl
if test 6823 -ne `wc -c <samples/demos/baby.adl`; then
echo shar: \"samples/demos/baby.adl\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f util/virtmem.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"util/virtmem.c\"
else
echo shar: Extracting \"util/virtmem.c\" \(3741 characters\)
sed "s/^X//" >util/virtmem.c <<'END_OF_util/virtmem.c'
X#include <stdio.h>
X
X#include "adltypes.h"
X#include "virtmem.h"
X
X/* Macros to find the page number and offset of an address */
X#define SEGMENT( where ) ((where >> 9) & 0x7FFF)
X#define OFFSET( where ) (where & 0x01FF)
X
Xvm_init( which, offs, handle, d )
Xint
X which; /* Paging file */
Xint32
X offs; /* Starting offset into the paging file */
Xstruct pagetab
X *handle; /* LRU queue */
Xint16
X d; /* Dirty bit */
X{
X handle->pfile = which;
X handle->offset = offs;
X handle->dirty = d;
X}
X
X
Xvm_flush( handle )
Xstruct pagetab
X *handle;
X{
X int
X i;
X
X if( handle->dirty ) {
X for( i = 0; i < handle->numpages; i++ ) {
X lseek( handle->pfile,
X handle->offset + (int32)(handle->ptabs[i].pnum * BSIZE),
X 0 );
X write( handle->pfile, handle->ptabs[ i ].buffer, BSIZE );
X }
X }
X}
X
X
Xchar *
Xvm_getpg( num, handle )
Xint
X num;
Xstruct pagetab
X *handle;
X{
X struct pt_entry
X *ptr;
X
X /* Search for the page number in the LRU queue */
X for( ptr = handle->mru; ptr; ptr = ptr->next ) {
X if( ptr->pnum == num ) {
X /* Page is in memory */
X if( ptr != handle->mru ) {
X /* Put the entry at the head of the LRU queue */
X (ptr->prev)->next = ptr->next;
X if( ptr->next )
X (ptr->next)->prev = ptr->prev;
X else
X handle->lru = ptr->prev;
X
X ptr->next = handle->mru;
X (handle->mru)->prev = ptr;
X
X ptr->prev = (struct pt_entry *)0;
X handle->mru = ptr;
X }
X return ptr->buffer;
X }
X }
X
X /* If we get here, the page is not in memory. Read it in. */
X if( handle->numpages < NUMP ) {
X /* We have available pages */
X ptr = handle->ptabs + handle->numpages++;
X if( handle->numpages == NUMP ) {
X /* We just allocated the last available page. Find the LRU. */
X for( handle->lru = handle->mru;
X (handle->lru)->next;
X handle->lru = (handle->lru)->next )
X /* NOTHING */;
X }
X }
X else { /* We need to swap an old page */
X /* Take the LRU off the end of the list. */
X ptr = handle->lru;
X handle->lru = ptr->prev;
X (ptr->prev)->next = (struct pt_entry *)0;
X
X if( handle->dirty ) {
X /* We need to write the old contents */
X lseek( handle->pfile,
X handle->offset + (int32)(ptr->pnum * BSIZE),
X 0 );
X write( handle->pfile, ptr->buffer, BSIZE );
X }
X }
X
X /* Put the old LRU at the head of the list, as the MRU */
X ptr->prev = (struct pt_entry *)0;
X ptr->next = handle->mru;
X if( handle->mru )
X (handle->mru)->prev = ptr;
X
X /* Change the data, then read in the page */
X ptr->pnum = num;
X handle->mru = ptr;
X lseek( handle->pfile, handle->offset + (int32)(num * BSIZE), 0 );
X read( handle->pfile, ptr->buffer, BSIZE );
X return ptr->buffer;
X}
X
X
Xvm_put8( data, where, handle )
Xchar
X data;
Xint32
X where;
Xstruct pagetab
X *handle;
X{
X char
X *buff;
X int
X seg,
X offs;
X
X seg = SEGMENT( where );
X offs = OFFSET( where );
X if( seg >= handle->maxpage ) { /* Grow the file */
X lseek( handle->pfile, 0L, 2 ); /* EOF */
X write( handle->pfile, handle->ptabs[0].buffer, BSIZE );
X handle->maxpage++;
X }
X buff = vm_getpg( seg, handle );
X buff[ offs ] = data;
X}
X
X
Xvm_put16( data, where, handle )
Xint16
X data;
Xint32
X where;
Xstruct pagetab
X *handle;
X{
X vm_put8( data & 0x0ff, where, handle );
X vm_put8( (data >> 8) & 0x0ff, where + 1, handle );
X}
X
X
Xchar
Xvm_get8( where, handle )
Xint32
X where;
Xstruct pagetab
X *handle;
X{
X int
X seg, offs;
X char
X *buff;
X
X seg = SEGMENT( where );
X offs = OFFSET( where );
X buff = vm_getpg( seg, handle );
X return buff[ offs ];
X}
X
X
Xint16
Xvm_get16( where, handle )
Xint32
X where;
Xstruct pagetab
X *handle;
X{
X int16
X t;
X
X t = vm_get8( where, handle ) & 0x0ff;
X t |= vm_get8( where + 1, handle ) << 8;
X return t;
X}
X
X/*** EOF virtmem.c ***/
END_OF_util/virtmem.c
if test 3741 -ne `wc -c <util/virtmem.c`; then
echo shar: \"util/virtmem.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
echo shar: End of archive 9 \(of 11\).
cp /dev/null ark9isdone
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 0