Path: uunet!zephyr.ens.tek.com!tekred!saab!billr From: billr@saab.CNA.TEK.COM (Bill Randle) Newsgroups: comp.sources.games Subject: v09i095: adven - original adventure game in FORTRAN, Part07/08 Message-ID: <5634@tekred.CNA.TEK.COM> Date: 18 May 90 18:22:11 GMT Sender: news@tekred.CNA.TEK.COM Lines: 1949 Approved: billr@saab.CNA.TEK.COM Submitted-by: Chris Rende Posting-number: Volume 9, Issue 95 Archive-name: adven/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 'carry.f' <<'END_OF_FILE' XC*** CARRY X X SUBROUTINE CARRY(OBJECT,WHERE) X XC START TOTING AN OBJECT, REMOVING IT FROM THE LIST OF THINGS AT ITS FORMER XC LOCATION. IF OBJECT>MAXOBJ (MOVING "FIXED" SECOND LOC), XC DON'T CHANGE PLACE. X X IMPLICIT INTEGER(A-Z) X COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150), X 1 FIXED(150),MAXOBJ X X IF(OBJECT.GT.MAXOBJ)GOTO 5 X IF(PLACE(OBJECT).EQ.-1)RETURN X PLACE(OBJECT)=-1 X5 IF(ATLOC(WHERE).NE.OBJECT)GOTO 6 X ATLOC(WHERE)=LINK(OBJECT) X RETURN X X6 TEMP=ATLOC(WHERE) X7 IF(LINK(TEMP).EQ.OBJECT)GOTO 8 X TEMP=LINK(TEMP) X IF(TEMP.NE.0)GOTO 7 X CALL BUG(35) X X8 LINK(TEMP)=LINK(OBJECT) X RETURN X END END_OF_FILE if test 711 -ne `wc -c <'carry.f'`; then echo shar: \"'carry.f'\" unpacked with wrong size! fi # end of 'carry.f' fi if test -f 'class.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'class.f'\" else echo shar: Extracting \"'class.f'\" \(301 characters\) sed "s/^X//" >'class.f' <<'END_OF_FILE' XC*** CLASS X X X INTEGER FUNCTION CLASS(WORD) X XC RETURNS WORD CLASS NUMBER (1=MOTION VERB; 2=NOUN; 3=ACTION VERB; XC 4=MISCELLANEOUS WORD; 5=PREPOSITION; 6=ADJECTIVE; 7=CONJUNCTION). X X X IMPLICIT INTEGER(A-Z) X X CLASS=WORD/1000 +1 X IF(WORD.LT.0)CLASS=-1 X RETURN X END END_OF_FILE if test 301 -ne `wc -c <'class.f'`; then echo shar: \"'class.f'\" unpacked with wrong size! fi # end of 'class.f' fi if test -f 'clrlin.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'clrlin.f'\" else echo shar: Extracting \"'clrlin.f'\" \(571 characters\) sed "s/^X//" >'clrlin.f' <<'END_OF_FILE' XC*** CLRLIN X X SUBROUTINE CLRLIN X XC CLEARS OUT ALL CURRENT SYNTAX ARGS IN PREPARATION FOR A NEW INPUT LINE X X IMPLICIT INTEGER(A-Z) X REAL*8 VTXT,OTXT,IOTXT X COMMON /WRDCOM/ VERBS(45),VTXT(45,2),VRBX,OBJS(45),OTXT(45,2), X 1 OBJX,IOBJS(15),IOTXT(15,2),IOBX,PREP,WORDS(45) X X DO 1 I=1,45 X OBJS(I)=0 X VERBS(I)=0 X DO 1 J=1,2 X1 VTXT(I,J)=0 X X DO 3 I=1,15 X IOBJS(I)=0 X DO 3 J=1,2 X IOTXT(I,J)=0 X3 OTXT(I,J)=0 X X VRBX=0 X OBJX=0 X IOBX=0 X PREP=0 X RETURN X X END END_OF_FILE if test 571 -ne `wc -c <'clrlin.f'`; then echo shar: \"'clrlin.f'\" unpacked with wrong size! fi # end of 'clrlin.f' fi if test -f 'confuz.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'confuz.f'\" else echo shar: Extracting \"'confuz.f'\" \(321 characters\) sed "s/^X//" >'confuz.f' <<'END_OF_FILE' XC*** CONFUZ X X X INTEGER FUNCTION CONFUZ(DUMMY) X XC GENERATES SOME VARIANT OF "DON'T UNDERSTAND THAT" MESSAGE. X X IMPLICIT INTEGER(A-Z) X LOGICAL PCT X CONFUZ=60 X IF(PCT(50))CONFUZ=61 X IF(PCT(33))CONFUZ=13 X IF(PCT(25))CONFUZ=347 X IF(PCT(20))CONFUZ=195 X RETURN X END END_OF_FILE if test 321 -ne `wc -c <'confuz.f'`; then echo shar: \"'confuz.f'\" unpacked with wrong size! fi # end of 'confuz.f' fi if test -f 'dark.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'dark.f'\" else echo shar: Extracting \"'dark.f'\" \(554 characters\) sed "s/^X//" >'dark.f' <<'END_OF_FILE' XC*** DARK .TRUE. IF THERE IS NO LIGHT HERE X X X LOGICAL FUNCTION DARK(DUMMY) X XC TRUE IF LOCATION "LOC" IS DARK X X IMPLICIT INTEGER(A-Z) X INTEGER*4 LOCCON,OBJCON X COMMON /CONCOM/ LOCCON(250),OBJCON(150) X COMMON /LOCCOM/ LOC,OLDLOC,OLDLC2,NEWLOC,MAXLOC X INTEGER*4 POINTS X COMMON /OBJCOM/ PLAC(150),FIXD(150),WEIGHT(150),PROP(150), X 1 POINTS(150) X LOGICAL ATHAND X DATA LAMP /2/ X X DARK=MOD(LOCCON(LOC),2).EQ.0.AND.(PROP(LAMP).EQ.0.OR. X 1 .NOT.ATHAND(LAMP)) X RETURN X END END_OF_FILE if test 554 -ne `wc -c <'dark.f'`; then echo shar: \"'dark.f'\" unpacked with wrong size! fi # end of 'dark.f' fi if test -f 'datime.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'datime.f'\" else echo shar: Extracting \"'datime.f'\" \(852 characters\) sed "s/^X//" >'datime.f' <<'END_OF_FILE' X SUBROUTINE DATIME(D,T) X XC RETURN THE DATE AND TIME IN D AND T. D IS NUMBER OF DAYS SINCE 01-JAN-77, XC T IS MINUTES PAST MIDNIGHT. THIS IS HARDER THAN IT SOUNDS, BECAUSE THE XC FINAGLED DEC FUNCTIONS RETURN THE VALUES ONLY AS ASCII STRINGS! X X IMPLICIT INTEGER(A-Z) X DIMENSION DAT(4),HATH(12) XC DATA MONTHS/'-JAN-','-FEB-','-MAR-','-APR-','-MAY-','-JUN-', XC 1 '-JUL-','-AUG-','-SEP-','-OCT-','-NOV-','-DEC-'/ X DATA HATH/31,28,31,30,31,30,31,31,30,31,30,31/ X X CALL TIMDAT(DAT,4) X T=DAT(4) X D=(RS(DAT(2),8)-:260)*10+RT(DAT(2),8)-:260 X Y=(RS(DAT(3),8)-:260)*10+(RT(DAT(3),8)-:260) X Y=Y-77 X M=(RS(DAT(1),8)-:260)*10+RT(DAT(1),8)-:260 X DO 1 I=1,12 X IF(I.EQ.M)GO TO 2 X1 D=D+HATH(I) X CALL BUG(28) X X2 D=D+Y*365-1 X X RETURN X END END_OF_FILE if test 852 -ne `wc -c <'datime.f'`; then echo shar: \"'datime.f'\" unpacked with wrong size! fi # end of 'datime.f' fi if test -f 'drop.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'drop.f'\" else echo shar: Extracting \"'drop.f'\" \(468 characters\) sed "s/^X//" >'drop.f' <<'END_OF_FILE' XC*** DROP X X X X SUBROUTINE DROP(OBJECT,WHERE) X XC PLACE AN OBJECT AT A GIVEN LOC, PREFIXING IT ONTO THE ATLOC LIST. X X IMPLICIT INTEGER(A-Z) X COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150), X 1 FIXED(150),MAXOBJ X X IF(OBJECT.GT.MAXOBJ)GOTO 1 X PLACE(OBJECT)=WHERE X GOTO 2 X X1 FIXED(OBJECT-MAXOBJ)=WHERE X2 IF(WHERE.LE.0)RETURN X LINK(OBJECT)=ATLOC(WHERE) X ATLOC(WHERE)=OBJECT X RETURN X END END_OF_FILE if test 468 -ne `wc -c <'drop.f'`; then echo shar: \"'drop.f'\" unpacked with wrong size! fi # end of 'drop.f' fi if test -f 'enclsd.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'enclsd.f'\" else echo shar: Extracting \"'enclsd.f'\" \(316 characters\) sed "s/^X//" >'enclsd.f' <<'END_OF_FILE' XC*** ENCLSD .TURE. IF OBJ INSIDE SOMETHING X X X LOGICAL FUNCTION ENCLSD(OBJECT) X XC ENCLSD(OBJ) = TRUE IF THE OBJ IS IN A CONTAINER X X IMPLICIT INTEGER(A-Z) X COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150), X 1 FIXED(150),MAXOBJ X ENCLSD=PLACE(OBJECT).LT.-1 X RETURN X END END_OF_FILE if test 316 -ne `wc -c <'enclsd.f'`; then echo shar: \"'enclsd.f'\" unpacked with wrong size! fi # end of 'enclsd.f' fi if test -f 'forced.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'forced.f'\" else echo shar: Extracting \"'forced.f'\" \(404 characters\) sed "s/^X//" >'forced.f' <<'END_OF_FILE' XC*** FORCED X X X LOGICAL FUNCTION FORCED(LOC) X XC A FORCED LOCATION IS ONE FROM WHICH HE IS IMMEDIATELY BOUNCED TO ANOTHER. XC NORMAL USE IS FOR DEATH (FORCE TO LOC ZERO) AND FOR DESCRIPTIONS OF XC JOURNEY FROM ONE PLACE TO ANOTHER. X X IMPLICIT INTEGER(A-Z) X INTEGER*4 LOCCON,OBJCON X COMMON /CONCOM/ LOCCON(250),OBJCON(150) X X FORCED=LOCCON(LOC).EQ.2 X X RETURN X END END_OF_FILE if test 404 -ne `wc -c <'forced.f'`; then echo shar: \"'forced.f'\" unpacked with wrong size! fi # end of 'forced.f' fi if test -f 'getin.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'getin.f'\" else echo shar: Extracting \"'getin.f'\" \(1172 characters\) sed "s/^X//" >'getin.f' <<'END_OF_FILE' X SUBROUTINE GETIN(WORD1,WORD1X,WORD2,WORD2X) X XC GET A COMMAND FROM THE ADVENTURER. SNARF OUT THE FIRST WORD, PAD IT WITH XC BLANKS, AND RETURN IT IN WORD1. CHARS 6 THRU 10 ARE RETURNED IN WORD1X, IN XC CASE WE NEED TO PRINT OUT THE WHOLE WORD IN AN ERROR MESSAGE. ANY NUMBER OF XC BLANKS MAY FOLLOW THE WORD. IF A SECOND WORD APPEARS, IT IS RETURNED IN XC WORD2 (CHARS 6 THRU 10 IN WORD2X), ELSE WORD2 IS SET TO ZERO. X X IMPLICIT INTEGER(A-Z) X LOGICAL BLKLIN X COMMON /BLKCOM/ BLKLIN X DIMENSION A(70),TEMP(70) X REAL*8 WRD(2),WORD1,WORD1X,WORD2,WORD2X X X IF(BLKLIN)PRINT 1 X1 FORMAT() X READ(1,3)A X3 FORMAT(70A1) X DO 1001 I=1,70 XC ************************** XC convert lowercase to upper XC ************************** XC IF(A(I).GE.'a'.AND.A(I).LE.'z')A(I)=AND(A(I),:157777) X1001 CONTINUE X WORD1=' ' X WORD1X=' ' X WORD2=0 X10 J=1 X CALL A1TOA5(A,J,WRD,TERM) X IF(TERM.EQ.'; '.OR.TERM.EQ.0)RETURN X WORD1=WRD(1) X WORD1X=WRD(2) X CALL A1TOA5(A,J,WRD,TERM) X IF(TERM.EQ.'; '.OR.TERM.EQ.0)RETURN X WORD2=WRD(1) X WORD2X=WRD(2) X RETURN X END END_OF_FILE if test 1172 -ne `wc -c <'getin.f'`; then echo shar: \"'getin.f'\" unpacked with wrong size! fi # end of 'getin.f' fi if test -f 'gspeak.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'gspeak.f'\" else echo shar: Extracting \"'gspeak.f'\" \(1696 characters\) sed "s/^X//" >'gspeak.f' <<'END_OF_FILE' XC*** GSPEAK X X SUBROUTINE GSPEAK(LOC) X XC PRINT LOCATION DESCRIPTIONS. WORKS JUST LIKE SPEAK, EXCEPT THAT XC LOCATION NUMBER IS PREFIXED TO EACH LINE. THIS IS A SLAVE RTN FOR XC GRIPE. WOULD USE XSPEAK, EXCEPT THAT XSPEAK USES 'PRINT' STMTS XC INSTEAD OF WRITES, THANX TO LOSING '$' FEATURE WHEN TRYING TO SEND XC MULTI-PART LINES TO A DISK FILE. X X IMPLICIT INTEGER(A-Z) X INTEGER*4 RTEXT,PTEXT,MTEXT X INTEGER*4 LINES X COMMON /TXTCOM/ LINES(25000),RTEXT(400),PTEXT(150),MTEXT(45) X INTEGER*4 LTEXT,STEXT,M,OLINE X COMMON /LTXCOM/ LTEXT(250),STEXT(250),KEY(250),ABB(250),LOCSIZ X COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150), X 1 FIXED(150),MAXOBJ X INTEGER*4 POINTS,K,L X COMMON /OBJCOM/ PLAC(150),FIXD(150),WEIGHT(150),PROP(150), X 1 POINTS(150) X DIMENSION OLINE(18) X X K=STEXT(LOC) X IF(K.EQ.0.OR.LINES(K+1).EQ.XOR('>$< ','CLYD'))K=LTEXT(LOC) X1 L=IABS(LINES(K))-K-1 X DO 2 I=1,L X2 OLINE(I)=XOR(LINES(K+I),'CLYD') X WRITE (14,3)LOC,(OLINE(I),I=1,L) X3 FORMAT (1X,I3,' ',18A4) X K=K+L+1 X IF(LINES(K).GE.0)GOTO 1 X XC NOW PRINT OUT NAMES OF OBJECTS AT THIS LOCATION X X DO 7 OBJ=1,MAXOBJ X IF(LOC.NE.PLACE(OBJ).AND.LOC.NE.FIXED(OBJ))GOTO 7 X SKIP=PROP(OBJ) X IF(OBJ.EQ.STEPS.AND.LOC.EQ.FIXED(STEPS))SKIP=1 XC* X M=PTEXT(OBJ) X IF(SKIP.LT.0)GOTO 40 X DO 30 I=0,SKIP X10 M=IABS(LINES(M)) X IF(LINES(M).GE.0)GOTO 10 X30 CONTINUE XC* X40 L=IABS(LINES(M))-M-1 X DO 6 I=1,L X6 OLINE(I)=XOR(LINES(M+I),'CLYD') X WRITE (14,9)(OLINE(J),J=1,L) X9 FORMAT (8X,18A4) X7 CONTINUE X RETURN X X END END_OF_FILE if test 1696 -ne `wc -c <'gspeak.f'`; then echo shar: \"'gspeak.f'\" unpacked with wrong size! fi # end of 'gspeak.f' fi if test -f 'here.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'here.f'\" else echo shar: Extracting \"'here.f'\" \(416 characters\) sed "s/^X//" >'here.f' <<'END_OF_FILE' XC*** HERE .TRUE. IF OBJ AT THIS LOCATION X X X LOGICAL FUNCTION HERE(OBJ) X XC HERE(OBJ) = TRUE IF THE OBJ IS AT "LOC" (OR IS BEING CARRIED) X X IMPLICIT INTEGER(A-Z) X COMMON /LOCCOM/ LOC,OLDLOC,OLDLC2,NEWLOC,MAXLOC X COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150), X 1 FIXED(150),MAXOBJ X LOGICAL TOTING X HERE=PLACE(OBJ).EQ.LOC.OR.TOTING(OBJ) X RETURN X END END_OF_FILE if test 416 -ne `wc -c <'here.f'`; then echo shar: \"'here.f'\" unpacked with wrong size! fi # end of 'here.f' fi if test -f 'hinged.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'hinged.f'\" else echo shar: Extracting \"'hinged.f'\" \(324 characters\) sed "s/^X//" >'hinged.f' <<'END_OF_FILE' XC*** HINGED .TRUE. IF OBJ CAN BE OPENED X X X LOGICAL FUNCTION HINGED(OBJ) X XC HINGED(OBJ) = TRUE IF OBJECT CAN BE OPENED/SHUT. X X IMPLICIT INTEGER(A-Z) X LOGICAL BITSET X INTEGER*4 LOCCON,OBJCON X COMMON /CONCOM/ LOCCON(250),OBJCON(150) X X HINGED=BITSET(OBJCON(OBJ),1) X X RETURN X END END_OF_FILE if test 324 -ne `wc -c <'hinged.f'`; then echo shar: \"'hinged.f'\" unpacked with wrong size! fi # end of 'hinged.f' fi if test -f 'holding.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'holding.f'\" else echo shar: Extracting \"'holding.f'\" \(310 characters\) sed "s/^X//" >'holding.f' <<'END_OF_FILE' XC*** HOLDNG .TRUE. IF HOLDING OBJ X X X LOGICAL FUNCTION HOLDNG(OBJ) X XC HOLDNG(OBJ) = TRUE IF THE OBJ IS BEING CARRIED IN HAND. X X IMPLICIT INTEGER(A-Z) X COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150), X 1 FIXED(150),MAXOBJ X HOLDNG=PLACE(OBJ).EQ.-1 X RETURN X END END_OF_FILE if test 310 -ne `wc -c <'holding.f'`; then echo shar: \"'holding.f'\" unpacked with wrong size! fi # end of 'holding.f' fi if test -f 'hours.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'hours.f'\" else echo shar: Extracting \"'hours.f'\" \(1139 characters\) sed "s/^X//" >'hours.f' <<'END_OF_FILE' XC*** HOURS X X SUBROUTINE HOURS X XC ANNOUNCE THE CURRENT HOURS WHEN THE CAVE IS OPEN FOR ADVENTURING. THIS INFO XC IS STORED IN WKDAY, WKEND, AND HOLID, WHERE BIT SHIFT(1,N) IS ON IFF THE XC HOUR FROM N:00 TO N:59 IS "PRIME TIME" (CAVE CLOSED). WKDAY IS FOR XC WEEKDAYS, WKEND FOR WEEKENDS, HOLID FOR HOLIDAYS. NEXT HOLIDAY IS FROM XC HBEGIN TO HEND. X X IMPLICIT INTEGER(A-Z) X REAL*8 T1 X DIMENSION HNAME(10),VAL(5) X INTEGER*4 WKDAY,WKEND,HOLID X DOUBLE PRECISION MAGIC X COMMON /WIZCOM/ WKDAY,WKEND,HOLID,HBEGIN,HEND,HNAME, X 1 SHORT,MAGIC,MAGNM,LATNCY,SAVED,SAVET,SETUP X PRINT 1 X1 FORMAT() X CALL HOURSX(WKDAY,'MON - FRI:') X CALL HOURSX(WKEND,'SAT - SUN:') X CALL HOURSX(HOLID,'HOLIDAYS: ') X CALL DATIME(D,T) X IF(HEND.LT.D.OR.HEND.LT.HBEGIN)RETURN X IF(HBEGIN.GT.D)GOTO 10 X PRINT 5,HNAME X5 FORMAT(/' Today is a holiday, namely ',10A2) X RETURN X X10 D=HBEGIN-D X T1='DAYS,' X IF(D.EQ.1)T1='DAY, ' X PRINT 15,D,T,HNAME X15 FORMAT(/' The next holiday will be in',I3,' ',A5,' namely ',10A2) X RETURN X END END_OF_FILE if test 1139 -ne `wc -c <'hours.f'`; then echo shar: \"'hours.f'\" unpacked with wrong size! fi # end of 'hours.f' fi if test -f 'hoursx.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'hoursx.f'\" else echo shar: Extracting \"'hoursx.f'\" \(918 characters\) sed "s/^X//" >'hoursx.f' <<'END_OF_FILE' XC*** HOURSX X X X X SUBROUTINE HOURSX(H,DDAY) X XC USED BY HOURS (ABOVE) TO PRINT HOURS FOR EITHER WEEKDAYS OR WEEKENDS. X X IMPLICIT INTEGER(A-Z) X LOGICAL FIRST X DIMENSION DAY(5), DDAY(5) X INTEGER*4 H X X FIRST=.TRUE. X FROM=-1 X DO 1 I=1,5 X1 DAY(I)=DDAY(I) X IF(H.NE.0)GOTO 10 X PRINT 2, DAY X2 FORMAT(10X,5A2,' Open all day') X RETURN X X10 FROM=FROM+1 X IF(AND(H,LS(0000001,FROM)).NE.0) GOTO 10 X IF(FROM.GE.24)GOTO 20 X TILL=FROM X14 TILL=TILL+1 X IF(AND(H,LS(0000001,TILL)).EQ.0.AND.TILL.NE.24) GOTO 14 X IF(FIRST)PRINT 16,DAY,FROM,TILL X IF(.NOT.FIRST)PRINT 18,FROM,TILL X16 FORMAT(10X,5A2,I4,':00 to',I3,':00') X18 FORMAT(20X,I4,':00 to',I3,':00') X FIRST=.FALSE. X FROM=TILL X GOTO 10 X X20 IF(FIRST)PRINT 22,DAY1,DAY2 X22 FORMAT(10X,2A5,' Closed all day') X RETURN X END END_OF_FILE if test 918 -ne `wc -c <'hoursx.f'`; then echo shar: \"'hoursx.f'\" unpacked with wrong size! fi # end of 'hoursx.f' fi if test -f 'insert.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'insert.f'\" else echo shar: Extracting \"'insert.f'\" \(485 characters\) sed "s/^X//" >'insert.f' <<'END_OF_FILE' XC*** INSERT X X SUBROUTINE INSERT(OBJECT,CONTNR) X X IMPLICIT INTEGER(A-Z) X COMMON /HLDCOM/ HOLDER(150),HLINK(150) X COMMON /LOCCOM/ LOC,OLDLOC,OLDLC2,NEWLOC,MAXLOC X COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150), X 1 FIXED(150),MAXOBJ X X IF(CONTNR.EQ.OBJECT)CALL BUG(32) X CALL CARRY(OBJECT,LOC) X X TEMP=HOLDER(CONTNR) X HOLDER(CONTNR)=OBJECT X HLINK(OBJECT)=TEMP X PLACE(OBJECT)=-CONTNR X RETURN X X END END_OF_FILE if test 485 -ne `wc -c <'insert.f'`; then echo shar: \"'insert.f'\" unpacked with wrong size! fi # end of 'insert.f' fi if test -f 'inside.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'inside.f'\" else echo shar: Extracting \"'inside.f'\" \(291 characters\) sed "s/^X//" >'inside.f' <<'END_OF_FILE' XC*** INSIDE .TRUE. IF LOCATION IS WELL WITHIN THE CAVE X X X LOGICAL FUNCTION INSIDE(LOC) X XC INSIDE(LOC) = TRUE IF LOCATION IS WELL WITHIN THE CAVE X X IMPLICIT INTEGER(A-Z) X LOGICAL OUTSID,PORTAL X INSIDE=.NOT.OUTSID(LOC).AND..NOT.PORTAL(LOC) X RETURN X END END_OF_FILE if test 291 -ne `wc -c <'inside.f'`; then echo shar: \"'inside.f'\" unpacked with wrong size! fi # end of 'inside.f' fi if test -f 'juggle.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'juggle.f'\" else echo shar: Extracting \"'juggle.f'\" \(453 characters\) sed "s/^X//" >'juggle.f' <<'END_OF_FILE' XC*** JUGGLE X X SUBROUTINE JUGGLE(OBJECT) X XC JUGGLE AN OBJECT BY PICKING IT UP AND PUTTING IT DOWN AGAIN, THE PURPOSE XC BEING TO GET THE OBJECT TO THE FRONT OF THE CHAIN OF THINGS AT ITS LOC. X X IMPLICIT INTEGER(A-Z) X COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150), X 1 FIXED(150),MAXOBJ X X I=PLACE(OBJECT) X J=FIXED(OBJECT) X CALL MOVE(OBJECT,I) X CALL MOVE(OBJECT+MAXOBJ,J) X RETURN X END END_OF_FILE if test 453 -ne `wc -c <'juggle.f'`; then echo shar: \"'juggle.f'\" unpacked with wrong size! fi # end of 'juggle.f' fi if test -f 'liq.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'liq.f'\" else echo shar: Extracting \"'liq.f'\" \(425 characters\) sed "s/^X//" >'liq.f' <<'END_OF_FILE' XC*** LIQ X X X INTEGER FUNCTION LIQ(OBJ) X IMPLICIT INTEGER(A-Z) X COMMON /LIQCOM/ BOTTLE,CASK,WATER,OIL,WINE,LIQTYP(5) X INTEGER*4 POINTS X COMMON /OBJCOM/ PLAC(150),FIXD(150),WEIGHT(150),PROP(150), X 1 POINTS(150) X XC LIQ=LIQ2(MAX0(PROP(OBJ),-1-PROP(OBJ))) X LIQ=LIQTYP(MAX0(PROP(OBJ)+1,-1-(PROP(OBJ)+1))) X IF(OBJ.NE.BOTTLE.AND.OBJ.NE.CASK)LIQ=0 X RETURN X END END_OF_FILE if test 425 -ne `wc -c <'liq.f'`; then echo shar: \"'liq.f'\" unpacked with wrong size! fi # end of 'liq.f' fi if test -f 'liq2.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'liq2.f'\" else echo shar: Extracting \"'liq2.f'\" \(318 characters\) sed "s/^X//" >'liq2.f' <<'END_OF_FILE' XC*** LIQ2 XC NON-LOGICAL (ILLOGICAL?) FUNCTIONS (CLASS,LIQ,LIQ2,LIQLOC,VAL) X X INTEGER FUNCTION LIQ2(PBOTL) X IMPLICIT INTEGER(A-Z) X COMMON /LIQCOM/ BOTTLE,CASK,WATER,OIL,WINE,LIQTYP(5) X X LIQ2=(1-PBOTL)*WATER+(PBOTL/2)*(WATER+OIL)+(PBOTL/4) X 1 *(WATER+WINE-2*OIL) X RETURN X END END_OF_FILE if test 318 -ne `wc -c <'liq2.f'`; then echo shar: \"'liq2.f'\" unpacked with wrong size! fi # end of 'liq2.f' fi if test -f 'liqloc.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'liqloc.f'\" else echo shar: Extracting \"'liqloc.f'\" \(445 characters\) sed "s/^X//" >'liqloc.f' <<'END_OF_FILE' XC*** LIQLOC X X INTEGER FUNCTION LIQLOC(LOC) X IMPLICIT INTEGER(A-Z) X COMMON /LIQCOM/ BOTTLE,CASK,WATER,OIL,WINE,LIQTYP(5) X INTEGER*4 LOCCON,OBJCON X INTEGER*2 WRD(2) X COMMON /CONCOM/ LOCCON(250),OBJCON(150) X EQUIVALENCE (LOCCON,WRD) XC CALL TOOCT(LOCCON(LOC)) XC CALL TOOCT(WRD(LOC*2)) X X LIQLOC=LIQ2(INTS(MOD(LOCCON(LOC)/8,2)*(MOD(LOCCON(LOC)/2*2,16)-9) X 1 +1)) X X RETURN X END END_OF_FILE if test 445 -ne `wc -c <'liqloc.f'`; then echo shar: \"'liqloc.f'\" unpacked with wrong size! fi # end of 'liqloc.f' fi if test -f 'living.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'living.f'\" else echo shar: Extracting \"'living.f'\" \(339 characters\) sed "s/^X//" >'living.f' <<'END_OF_FILE' XC*** LIVING .TRUE. IF OBJ IS LIVING, BEAR FOR EXAMPLE X X X LOGICAL FUNCTION LIVING(OBJ) X XC LIVING(OBJ) = TRUE IF OBJ IS SOME SORT OF CRITTER X X IMPLICIT INTEGER(A-Z) X LOGICAL BITSET X INTEGER*4 LOCCON,OBJCON X COMMON /CONCOM/ LOCCON(250),OBJCON(150) X X LIVING=BITSET(OBJCON(OBJ),9) X X RETURN X END END_OF_FILE if test 339 -ne `wc -c <'living.f'`; then echo shar: \"'living.f'\" unpacked with wrong size! fi # end of 'living.f' fi if test -f 'locked.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'locked.f'\" else echo shar: Extracting \"'locked.f'\" \(265 characters\) sed "s/^X//" >'locked.f' <<'END_OF_FILE' XC*** LOCKED .TRUE. IF LOCKABLE OBJ IS LOCKED X X LOGICAL FUNCTION LOCKED(OBJ) X IMPLICIT INTEGER(A-Z) X LOGICAL BITSET X INTEGER*4 LOCCON,OBJCON X COMMON/CONCOM/LOCCON(250),OBJCON(150) X LOCKED=BITSET(OBJCON(OBJ),4) X RETURN X END END_OF_FILE if test 265 -ne `wc -c <'locked.f'`; then echo shar: \"'locked.f'\" unpacked with wrong size! fi # end of 'locked.f' fi if test -f 'login.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'login.f'\" else echo shar: Extracting \"'login.f'\" \(369 characters\) sed "s/^X//" >'login.f' <<'END_OF_FILE' XC*** LOGIN X SUBROUTINE LOGIN X IMPLICIT INTEGER(A-Z) X DIMENSION VEC(15) X LOGICAL ACTIVE X INTEGER*4 MESSGS X COMMON/LNKCOM/ACTIVE(32),USER(15,32),MESSGS(32),MONITO(32), X 1 TEXT(70,32) X COMMON/WRUCOM/ME X CALL TIMDAT(VEC,15) X ME=VEC(12) X CALL TIMDAT(USER(1,ME),15) X ACTIVE(VEC(12))=.TRUE. X RETURN X END END_OF_FILE if test 369 -ne `wc -c <'login.f'`; then echo shar: \"'login.f'\" unpacked with wrong size! fi # end of 'login.f' fi if test -f 'logout.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'logout.f'\" else echo shar: Extracting \"'logout.f'\" \(284 characters\) sed "s/^X//" >'logout.f' <<'END_OF_FILE' XC*** LOGOUT X LOGICAL FUNCTION LOGOUT(DUMMY) X IMPLICIT INTEGER(A-Z) X COMMON/LNKCOM/ACTIVE(32),USER(15,32),MESSGS(32),MONITO(32), X 1 TEXT(70,32) X COMMON/WRUCOM/ME X LOGICAL ACTIVE X INTEGER*4 MESSGS X LOGOUT=.NOT.ACTIVE(ME) X RETURN X END END_OF_FILE if test 284 -ne `wc -c <'logout.f'`; then echo shar: \"'logout.f'\" unpacked with wrong size! fi # end of 'logout.f' fi if test -f 'lookin.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'lookin.f'\" else echo shar: Extracting \"'lookin.f'\" \(722 characters\) sed "s/^X//" >'lookin.f' <<'END_OF_FILE' XC*** LOOKIN X X SUBROUTINE LOOKIN(CONTNR) X XC LIST CONTENTS IF OBJ IS A CONTAINER AND IS OPEN OR TRANSPARENT. XC SAVE INITIAL VALUE OF BLKLIN THRU SUBROUTINE. X X IMPLICIT INTEGER(A-Z) X COMMON /BLKCOM/ BLKLIN X COMMON /HLDCOM/ HOLDER(150),HLINK(150) X LOGICAL VESSEL,AJAR,OPAQUE,BLKLIN,BSAVE X DIMENSION TK(20) X X IF(.NOT.VESSEL(CONTNR).OR. X 1 (.NOT.AJAR(CONTNR).AND.OPAQUE(CONTNR)) )RETURN X TEMP=HOLDER(CONTNR) X LOOP=0 X BSAVE=BLKLIN X20 IF(TEMP.EQ.0)RETURN X BLKLIN=.FALSE. X IF(LOOP.EQ.0)CALL RSPEAK(360) X CALL TNOUA(' ',5) X CALL PSPEAK(TEMP,-1) X BLKLIN=BSAVE X TEMP=HLINK(TEMP) X LOOP=-1 X GOTO 20 X X END END_OF_FILE if test 722 -ne `wc -c <'lookin.f'`; then echo shar: \"'lookin.f'\" unpacked with wrong size! fi # end of 'lookin.f' fi if test -f 'move.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'move.f'\" else echo shar: Extracting \"'move.f'\" \(675 characters\) sed "s/^X//" >'move.f' <<'END_OF_FILE' XC*** MOVE X X X X SUBROUTINE MOVE(OBJECT,WHERE) X XC PLACE ANY OBJECT ANYWHERE BY PICKING IT UP AND DROPPING IT. MAY ALREADY BE XC TOTING, IN WHICH CASE THE CARRY IS A NO-OP. MUSTN'T PICK UP OBJECTS WHICH XC ARE NOT AT ANY LOC, SINCE CARRY WANTS TO REMOVE OBJECTS FROM ATLOC CHAINS. X X IMPLICIT INTEGER(A-Z) X COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150), X 1 FIXED(150),MAXOBJ X LOGICAL ENCLSD X X IF(ENCLSD(OBJECT))CALL REMOVE(OBJECT) X FROM=PLACE(OBJECT) X IF(OBJECT.GT.MAXOBJ)FROM=FIXED(OBJECT-MAXOBJ) X IF(FROM.GT.0.AND.FROM.LE.MAXOBJ*2)CALL CARRY(OBJECT,FROM) X CALL DROP(OBJECT,WHERE) X RETURN X END END_OF_FILE if test 675 -ne `wc -c <'move.f'`; then echo shar: \"'move.f'\" unpacked with wrong size! fi # end of 'move.f' fi if test -f 'mspeak.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'mspeak.f'\" else echo shar: Extracting \"'mspeak.f'\" \(326 characters\) sed "s/^X//" >'mspeak.f' <<'END_OF_FILE' XC*** MSPEAK X X X X SUBROUTINE MSPEAK(I) X XC PRINT THE I-TH "MAGIC" MESSAGE (SECTION 12 OF DATABASE). X X IMPLICIT INTEGER(A-Z) X INTEGER*4 RTEXT,PTEXT,MTEXT,M X INTEGER*4 LINES X COMMON /TXTCOM/ LINES(25000),RTEXT(400),PTEXT(150),MTEXT(45) X X IF(I.NE.0)CALL SPEAK(MTEXT(I)) X RETURN X END END_OF_FILE if test 326 -ne `wc -c <'mspeak.f'`; then echo shar: \"'mspeak.f'\" unpacked with wrong size! fi # end of 'mspeak.f' fi if test -f 'newhrs.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'newhrs.f'\" else echo shar: Extracting \"'newhrs.f'\" \(616 characters\) sed "s/^X//" >'newhrs.f' <<'END_OF_FILE' XC*** NEWHRS X X X X SUBROUTINE NEWHRS X XC SET UP NEW HOURS FOR THE CAVE. SPECIFIED AS INVERSE--I.E., WHEN IS IT XC CLOSED DUE TO PRIME TIME? SEE HOURS (ABOVE) FOR DESC OF VARIABLES. X X IMPLICIT INTEGER(A-Z) X DIMENSION HNAME(10) X INTEGER*4 WKDAY,WKEND,HOLID,NEWHRX X DOUBLE PRECISION MAGIC X COMMON /WIZCOM/ WKDAY,WKEND,HOLID,HBEGIN,HEND,HNAME, X 1 SHORT,MAGIC,MAGNM,LATNCY,SAVED,SAVET,SETUP X CALL MSPEAK(21) X WKDAY=NEWHRX('WEEKDAYS: ') X WKEND=NEWHRX('WEEKENDS: ') X HOLID=NEWHRX('HOLIDAYS: ') X CALL MSPEAK(22) X CALL HOURS X RETURN X END END_OF_FILE if test 616 -ne `wc -c <'newhrs.f'`; then echo shar: \"'newhrs.f'\" unpacked with wrong size! fi # end of 'newhrs.f' fi if test -f 'newhrx.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'newhrx.f'\" else echo shar: Extracting \"'newhrx.f'\" \(627 characters\) sed "s/^X//" >'newhrx.f' <<'END_OF_FILE' XC*** NEWHRX X X X X INTEGER*4 FUNCTION NEWHRX(DAY) X XC INPUT PRIME TIME SPECS AND SET UP A WORD OF INTERNAL FORMAT. X X IMPLICIT INTEGER(A-Z) X DIMENSION DDAY(5), DAY(5) X X NEWHRX=0 X DO 8 I=1,5 X8 DDAY(I)=DAY(I) X PRINT 9,DDAY X9 FORMAT(' PRIME TIME ON ',5A2) X10 PRINT 2 X2 FORMAT(' FROM:') X READ(1,3)FROM X3 FORMAT(I4) X IF(FROM.LT.0.OR.FROM.GE.24)RETURN X PRINT 4 X4 FORMAT(' TILL:') X READ(1,3)TILL X TILL=TILL-1 X IF(TILL.LT.FROM.OR.TILL.GE.24)RETURN X DO 5 I=FROM,TILL X5 NEWHRX=OR(NEWHRX,LS(0000001,I)) X GOTO 10 X END END_OF_FILE if test 627 -ne `wc -c <'newhrx.f'`; then echo shar: \"'newhrx.f'\" unpacked with wrong size! fi # end of 'newhrx.f' fi if test -f 'noway.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'noway.f'\" else echo shar: Extracting \"'noway.f'\" \(393 characters\) sed "s/^X//" >'noway.f' <<'END_OF_FILE' XC*** NOWAY X X X INTEGER FUNCTION NOWAY(DUMMY) X XC GENERATE'S SOME VARIANT OF "CAN'T DO THAT" MESSAGE. X X IMPLICIT INTEGER(A-Z) X LOGICAL PCT X X NOWAY=14 X IF(PCT(50))NOWAY=110 X IF(PCT(33))NOWAY=147 X IF(PCT(25))NOWAY=250 X IF(PCT(20))NOWAY=262 X IF(PCT(17))NOWAY=25 X IF(PCT(14))NOWAY=345 X IF(PCT(12))NOWAY=346 X RETURN X END END_OF_FILE if test 393 -ne `wc -c <'noway.f'`; then echo shar: \"'noway.f'\" unpacked with wrong size! fi # end of 'noway.f' fi if test -f 'opaque.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'opaque.f'\" else echo shar: Extracting \"'opaque.f'\" \(430 characters\) sed "s/^X//" >'opaque.f' <<'END_OF_FILE' XC*** OPAQUE .TRUE. IF OBJ IS NON-TRANSPARENT CONTAINER X X X LOGICAL FUNCTION OPAQUE(OBJ) X XC OPAQUE(OBJ) = TRUE IF OBJECT IS NOT TRANSPARENT. E.G., BAG & CHEST ARE OPAQ XC WICKER CAGE & GLASS BOTTLE ARE TRANSPARENT. X X IMPLICIT INTEGER(A-Z) X LOGICAL BITSET X INTEGER*4 LOCCON,OBJCON X COMMON /CONCOM/ LOCCON(250),OBJCON(150) X X OPAQUE=BITSET(OBJCON(OBJ),17) X X RETURN X END END_OF_FILE if test 430 -ne `wc -c <'opaque.f'`; then echo shar: \"'opaque.f'\" unpacked with wrong size! fi # end of 'opaque.f' fi if test -f 'outsid.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'outsid.f'\" else echo shar: Extracting \"'outsid.f'\" \(339 characters\) sed "s/^X//" >'outsid.f' <<'END_OF_FILE' XC*** OUTSID .TRUE. IF LOCATION IS OUTSIDE THE CAVE X X X LOGICAL FUNCTION OUTSID(LOC) X XC OUTSID(LOC) = TRUE IF LOCATION IS OUTSIDE THE CAVE X X IMPLICIT INTEGER(A-Z) X LOGICAL BITSET X INTEGER*4 LOCCON,OBJCON X COMMON /CONCOM/ LOCCON(250),OBJCON(150) X X OUTSID=BITSET(LOCCON(LOC),6) X X RETURN X END END_OF_FILE if test 339 -ne `wc -c <'outsid.f'`; then echo shar: \"'outsid.f'\" unpacked with wrong size! fi # end of 'outsid.f' fi if test -f 'plural.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'plural.f'\" else echo shar: Extracting \"'plural.f'\" \(347 characters\) sed "s/^X//" >'plural.f' <<'END_OF_FILE' XC*** PLURAL .TRUE. IF OBJ IS MULTIPLE OBJS X X X LOGICAL FUNCTION PLURAL(OBJ) X XC PLURAL(OBJ) = TRUE IF OBJECT IS A "BUNCH" OF THINGS (COINS, SHOES). X X IMPLICIT INTEGER(A-Z) X LOGICAL BITSET X INTEGER*4 LOCCON,OBJCON X COMMON /CONCOM/ LOCCON(250),OBJCON(150) X X PLURAL=BITSET(OBJCON(OBJ),13) X X RETURN X END END_OF_FILE if test 347 -ne `wc -c <'plural.f'`; then echo shar: \"'plural.f'\" unpacked with wrong size! fi # end of 'plural.f' fi if test -f 'pma1.pma' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'pma1.pma'\" else echo shar: Extracting \"'pma1.pma'\" \(1804 characters\) sed "s/^X//" >'pma1.pma' <<'END_OF_FILE' X SEG X ENT ENTER XECBENT ARGT X D64V X E64V X CALL GETTIM X STA STIME XREAD JMP LOOP XCHAR BSZ 1 XCHKS LDX =8 XCHK CAS SPEC-1,1 X SKP X JMP BL-1,1 X DRX X JMP CHK X JMP STORE XRRED JMP READ XERASEC LDA CP,* X SZE X S1A X STA CP,* X JMP READ XKILLC CRA X STA CP,* X JMP READ XEND LDA FLAG X SPL X PRTN X CALL GETTIM X SUB STIME X STA ETIME,* X PRTN XSTORE LDA CP,* X LGR 1 X STA 0 X ERA BS,* X SNZ X JMP RRED X LDA BA,*1 X SSC X ICA X CAR X ERA CHAR X SSC X ICA X STA BA,*1 X IRS CP,* X JMP RRED XSPEC DATA '377 X DATA '223 X DATA '200 X DATA '222 X DATA '224 XERASE DATA '210 XKILL DATA '230 X DATA '212 XBL JMP READ X JMP READ X JMP READ X JMP READ X JMP READ X JMP ERASEC X JMP KILLC X JMP END XFLAG BSZ 1 XLOOP E64R X SKS '704 CHAR PRESENT X JMP TSTTIM NO TEST TIMEOUT X E64V X LDA ='200 XININ E64R X INA 4 X JMP ININ X E64V XT1RET STA CHAR RETURN CHAR X JMP CHKS XTSTTIM E64V X CALL GETTIM X SUB STIME X SPL X ADD =3600 X SUB LIMIT,* X SPL X JMP LOOP X LDA LIMIT,* X TCA X STA FLAG X STA ETIME,* X LDA ='212 X JMP T1RET X* X* X LINK XSTIME BSZ 1 XENTER ECB ECBENT,,BA,5 X DYNM BA(3),BS(3),LIMIT(3),ETIME(3),CP(3) X END END_OF_FILE if test 1804 -ne `wc -c <'pma1.pma'`; then echo shar: \"'pma1.pma'\" unpacked with wrong size! fi # end of 'pma1.pma' fi if test -f 'pma2.pma' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'pma2.pma'\" else echo shar: Extracting \"'pma2.pma'\" \(326 characters\) sed "s/^X//" >'pma2.pma' <<'END_OF_FILE' X SEG X ENT GETTIM XIGTM NOP X D64V X E64V X PCL TIMDAT X EXT TIMDAT X AP TIMBUF,S X AP =5,SL X LDA TIMBUF+3 X PID X DIV =60 X XCB X MPY =60 X ADD TIMBUF+4 X PRTN XGETTIM ECB IGTM,,0 X LINK XTIMBUF BSZ 7 X END X END_OF_FILE if test 326 -ne `wc -c <'pma2.pma'`; then echo shar: \"'pma2.pma'\" unpacked with wrong size! fi # end of 'pma2.pma' fi if test -f 'poof.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'poof.f'\" else echo shar: Extracting \"'poof.f'\" \(599 characters\) sed "s/^X//" >'poof.f' <<'END_OF_FILE' XC*** POOF X X SUBROUTINE POOF X XC AS PART OF DATABASE INITIALISATION, WE CALL POOF TO SET UP SOME DUMMY XC PRIME-TIME SPECS, MAGIC WORDS, ETC. X X IMPLICIT INTEGER(A-Z) X DIMENSION HNAME(10) X INTEGER*4 WKDAY,WKEND,HOLID X DOUBLE PRECISION MAGIC X COMMON /WIZCOM/ WKDAY,WKEND,HOLID,HBEGIN,HEND,HNAME, X 1 SHORT,MAGIC,MAGNM,LATNCY,SAVED,SAVET,SETUP X XC WKDAY="00177000 [CLOSES FROM 9AM - 5PM] X WKDAY=0 X WKEND=0 X HOLID=0 X HBEGIN=0 X HEND=-1 X SHORT=35 X MAGIC='HOBBIT' X MAGNM=1 X LATNCY=90 X RETURN X END END_OF_FILE if test 599 -ne `wc -c <'poof.f'`; then echo shar: \"'poof.f'\" unpacked with wrong size! fi # end of 'poof.f' fi if test -f 'portal.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'portal.f'\" else echo shar: Extracting \"'portal.f'\" \(341 characters\) sed "s/^X//" >'portal.f' <<'END_OF_FILE' XC*** PORTAL .TRUE. IF LOCATION IS IN CAVE ENTRANCE X X X LOGICAL FUNCTION PORTAL(LOC) X XC PORTAL(LOC) = TRUE IS LOCATION IS IN CAVE "ENTRANCE" X X IMPLICIT INTEGER(A-Z) X LOGICAL BITSET X INTEGER*4 LOCCON,OBJCON X COMMON /CONCOM/ LOCCON(250),OBJCON(150) X X PORTAL=BITSET(LOCCON(LOC),5) X X RETURN X END END_OF_FILE if test 341 -ne `wc -c <'portal.f'`; then echo shar: \"'portal.f'\" unpacked with wrong size! fi # end of 'portal.f' fi if test -f 'printd.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'printd.f'\" else echo shar: Extracting \"'printd.f'\" \(315 characters\) sed "s/^X//" >'printd.f' <<'END_OF_FILE' XC*** PRINTD .TRUE. IF OBJ CAN BE READ X X X LOGICAL FUNCTION PRINTD(OBJ) X XC PRINTD(OBJ) = TRUE IF OBJECT CAN BE READ. X X IMPLICIT INTEGER(A-Z) X LOGICAL BITSET X INTEGER*4 LOCCON,OBJCON X COMMON /CONCOM/ LOCCON(250),OBJCON(150) X X PRINTD=BITSET(OBJCON(OBJ),8) X X RETURN X END END_OF_FILE if test 315 -ne `wc -c <'printd.f'`; then echo shar: \"'printd.f'\" unpacked with wrong size! fi # end of 'printd.f' fi if test -f 'pspeak.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'pspeak.f'\" else echo shar: Extracting \"'pspeak.f'\" \(555 characters\) sed "s/^X//" >'pspeak.f' <<'END_OF_FILE' XC*** PSPEAK X X X X SUBROUTINE PSPEAK(MSG,SKIP) X XC FIND THE SKIP+1ST MESSAGE FROM MSG AND PRINT IT. MSG SHOULD BE THE INDEX OF XC THE INVENTORY MESSAGE FOR OBJECT. (INVEN+N+1 MESSAGE IS PROP=N MESSAGE). X X IMPLICIT INTEGER(A-Z) X INTEGER*4 RTEXT,PTEXT,MTEXT,M X INTEGER*4 LINES X COMMON /TXTCOM/ LINES(25000),RTEXT(400),PTEXT(150),MTEXT(45) X X M=PTEXT(MSG) X IF(SKIP.LT.0)GOTO 9 X DO 3 I=0,SKIP X1 M=IABS(LINES(M)) X IF(LINES(M).GE.0)GOTO 1 X3 CONTINUE X9 CALL SPEAK(M) X RETURN X END END_OF_FILE if test 555 -ne `wc -c <'pspeak.f'`; then echo shar: \"'pspeak.f'\" unpacked with wrong size! fi # end of 'pspeak.f' fi if test -f 'put.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'put.f'\" else echo shar: Extracting \"'put.f'\" \(294 characters\) sed "s/^X//" >'put.f' <<'END_OF_FILE' XC*** PUT X X X X INTEGER FUNCTION PUT(OBJECT,WHERE,PVAL) X XC PUT IS THE SAME AS MOVE, EXCEPT IT RETURNS A VALUE USED TO SET UP THE XC NEGATED PROP VALUES FOR THE REPOSITORY OBJECTS. X X IMPLICIT INTEGER(A-Z) X X CALL MOVE(OBJECT,WHERE) X PUT=(-1)-PVAL X RETURN X END END_OF_FILE if test 294 -ne `wc -c <'put.f'`; then echo shar: \"'put.f'\" unpacked with wrong size! fi # end of 'put.f' fi if test -f 'ran.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'ran.f'\" else echo shar: Extracting \"'ran.f'\" \(664 characters\) sed "s/^X//" >'ran.f' <<'END_OF_FILE' XC*** RAN XC UTILITY ROUTINES (SHIFT, RAN, DATIME, CIAO, BUG, LOG) X X X INTEGER FUNCTION RAN(RANGE) X XC SINCE THE RAN FUNCTION IN LIB40 SEEMS TO BE A REAL LOSE, WE'LL USE ONE OF XC OUR OWN. IT'S BEEN RUN THROUGH MANY OF THE TESTS IN KNUTH VOL. 2 AND XC SEEMS TO BE QUITE RELIABLE. RAN RETURNS A VALUE UNIFORMLY SELECTED XC BETWEEN 0 AND RANGE-1. NOTE RESEMBLANCE TO ALG USED IN WIZARD. X X IMPLICIT INTEGER(A-Z) X INTEGER*4 R X DATA R/0/ X X D=1 X IF(R.NE.0)GOTO 1 X CALL DATIME(D,T) X R=18*T+5 X D=1000+MOD(D,1000) X1 DO 2 T=1,D X2 R=MOD(R*1021,1048576) X RAN=(RANGE*R)/1048576 X RETURN X END END_OF_FILE if test 664 -ne `wc -c <'ran.f'`; then echo shar: \"'ran.f'\" unpacked with wrong size! fi # end of 'ran.f' fi if test -f 'remove.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'remove.f'\" else echo shar: Extracting \"'remove.f'\" \(529 characters\) sed "s/^X//" >'remove.f' <<'END_OF_FILE' XC*** REMOVE X X X SUBROUTINE REMOVE(OBJECT) X X IMPLICIT INTEGER(A-Z) X COMMON /HLDCOM/ HOLDER(150),HLINK(150) X COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150), X 1 FIXED(150),MAXOBJ X X CONTNR=-PLACE(OBJECT) X PLACE(OBJECT)=-1 X X IF(HOLDER(CONTNR).NE.OBJECT)GOTO 1 X HOLDER(CONTNR)=HLINK(OBJECT) X RETURN X X1 TEMP=HOLDER(CONTNR) X2 IF(HLINK(TEMP).EQ.OBJECT)GOTO 3 X TEMP=HLINK(TEMP) X GOTO 2 X X3 HLINK(TEMP)=HLINK(OBJECT) X RETURN X END END_OF_FILE if test 529 -ne `wc -c <'remove.f'`; then echo shar: \"'remove.f'\" unpacked with wrong size! fi # end of 'remove.f' fi if test -f 'rspeak.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'rspeak.f'\" else echo shar: Extracting \"'rspeak.f'\" \(334 characters\) sed "s/^X//" >'rspeak.f' <<'END_OF_FILE' XC*** RSPEAK X X SUBROUTINE RSPEAK(I) X XC PRINT THE I-TH "RANDOM" MESSAGE (SECTION 6 OF DATABASE). X X IMPLICIT INTEGER(A-Z) X INTEGER*4 RTEXT,PTEXT,MTEXT,M X INTEGER*4 LINES X COMMON /TXTCOM/ LINES(25000),RTEXT(400),PTEXT(150),MTEXT(45) X X M=RTEXT(I) X IF(I.NE.0)CALL SPEAK(M) X RETURN X END END_OF_FILE if test 334 -ne `wc -c <'rspeak.f'`; then echo shar: \"'rspeak.f'\" unpacked with wrong size! fi # end of 'rspeak.f' fi if test -f 'small.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'small.f'\" else echo shar: Extracting \"'small.f'\" \(275 characters\) sed "s/^X//" >'small.f' <<'END_OF_FILE' XC*** SMALL .TRUE. IF IT FITS IN SACK OR SMALL CONTAINER X X LOGICAL FUNCTION SMALL(OBJ) X IMPLICIT INTEGER(A-Z) X LOGICAL BITSET X INTEGER*4 LOCCON,OBJCON X COMMON/CONCOM/LOCCON(250),OBJCON(150) X SMALL=BITSET(OBJCON(OBJ),16) X RETURN X END END_OF_FILE if test 275 -ne `wc -c <'small.f'`; then echo shar: \"'small.f'\" unpacked with wrong size! fi # end of 'small.f' fi if test -f 'speak.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'speak.f'\" else echo shar: Extracting \"'speak.f'\" \(1377 characters\) sed "s/^X//" >'speak.f' <<'END_OF_FILE' XC*** SPEAK XC I/O ROUTINES XC (SPEAK, PSPEAK, RSPEAK, GETIN, YES, A5TOA1, GETLIN, A1TOA5, CONFUZ, CLRLIN, N X X SUBROUTINE SPEAK(N) X XC PRINT THE MESSAGE WHICH STARTS AT LINES(N). PRECEDE IT WITH A BLANK LINE XC UNLESS BLKLIN IS FALSE. X X IMPLICIT INTEGER(A-Z) X LOGICAL BLKLIN X INTEGER*4 RTEXT,PTEXT,MTEXT,N,K,I,L X INTEGER*4 LINES,OLINE,MESSGS X COMMON /TXTCOM/ LINES(25000),RTEXT(400),PTEXT(150),MTEXT(45) X COMMON /BLKCOM/ BLKLIN X DIMENSION OLINE(36),ILINE(70) X LOGICAL ACTIVE X COMMON/LNKCOM/ACTIVE(32),USER(15,32),MESSGS(32),MONITO(32), X 1 TEXT(70,32) X COMMON/WRUCOM/ME X X M=0 X IF(MONITO(ME).LE.0)GOTO 100 X CALL SEM$WT(MONITO(ME),CODE) X MESSGS(ME)=N X100 IF(N.EQ.0)GOTO 4 X IF(LINES(N+1).EQ.XOR('>$< ','CLYD'))GOTO 4 X IF(BLKLIN)PRINT 3 X K=N XC next line gutted as i can't imagine what it means. dt. XC1 IF(M.GT.22)CALL DUPLX$(:30000) XC so add a new label 1 X1 CONTINUE X IF(M.GT.22)M=0 X L=IABS(LINES(K))-K-1 X DO 2 I=1,L X2 OLINE(I)=XOR(LINES(K+I),'CLYD') X PRINT 3,(OLINE(I),I=1,L) X3 FORMAT(' ',19A4) X M=M+1 X K=K+L+1 X IF(LINES(K).GE.0)GOTO 1 X4 IF(MONITO(ME).GE.0)RETURN X DO 10 I=1,70 X10 ILINE(I)=TEXT(I,IABS(MONITO(ME))) X MONITO(ME)=0 X WRITE(1,101)ILINE X101 FORMAT(70A1) X RETURN X END END_OF_FILE if test 1377 -ne `wc -c <'speak.f'`; then echo shar: \"'speak.f'\" unpacked with wrong size! fi # end of 'speak.f' fi if test -f 'toting.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'toting.f'\" else echo shar: Extracting \"'toting.f'\" \(711 characters\) sed "s/^X//" >'toting.f' <<'END_OF_FILE' XC*** TOTING .TRUE. IF OBJ SOMEWHERE ON PERSON X X X LOGICAL FUNCTION TOTING(OBJ) X XC TOTING(OBJ) = TRUE IF THE OBJ IS BEING CARRIED (IN HAND OR XC CONTAINER). OBJ MAY NOT BE REACHABLE. SEE XC ALSO: ENCLSD, ATHAND, HOLDNG. X X IMPLICIT INTEGER(A-Z) X COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150), X 1 FIXED(150),MAXOBJ X LOGICAL HOLDNG,ENCLSD,AAA,BBB,CCC X X CONTNR=-PLACE(OBJ) X OUTER=-PLACE(CONTNR) X OUTER2=-PLACE(OUTER) X X AAA=HOLDNG(CONTNR) X BBB=ENCLSD(CONTNR).AND.HOLDNG(OUTER) X CCC=ENCLSD(OUTER).AND.HOLDNG(OUTER2) X X TOTING=HOLDNG(OBJ).OR.(ENCLSD(OBJ).AND.(AAA.OR.BBB.OR.CCC)) X RETURN X END END_OF_FILE if test 711 -ne `wc -c <'toting.f'`; then echo shar: \"'toting.f'\" unpacked with wrong size! fi # end of 'toting.f' fi if test -f 'treasr.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'treasr.f'\" else echo shar: Extracting \"'treasr.f'\" \(329 characters\) sed "s/^X//" >'treasr.f' <<'END_OF_FILE' XC*** TREASR .TRUE. IF OBJ IS VALUABLE FOR POINTS X X X LOGICAL FUNCTION TREASR(OBJ) X XC TREASR(OBJ) = TRUE IF OBJECT IS A TREASURE X X IMPLICIT INTEGER(A-Z) X LOGICAL BITSET X INTEGER*4 LOCCON,OBJCON X COMMON /CONCOM/ LOCCON(250),OBJCON(150) X X TREASR=BITSET(OBJCON(OBJ),14) X X RETURN X END END_OF_FILE if test 329 -ne `wc -c <'treasr.f'`; then echo shar: \"'treasr.f'\" unpacked with wrong size! fi # end of 'treasr.f' fi if test -f 'vessel.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'vessel.f'\" else echo shar: Extracting \"'vessel.f'\" \(325 characters\) sed "s/^X//" >'vessel.f' <<'END_OF_FILE' XC*** VESSEL .TRUE. IF OBJ CAN HOLD A LIQUID X X X LOGICAL FUNCTION VESSEL(OBJ) X XC VESSEL(OBJ) = TRUE IF OBJECT IS A CONTAINER X X IMPLICIT INTEGER(A-Z) X LOGICAL BITSET X INTEGER*4 LOCCON,OBJCON X COMMON /CONCOM/ LOCCON(250),OBJCON(150) X X VESSEL=BITSET(OBJCON(OBJ),15) X X RETURN X END END_OF_FILE if test 325 -ne `wc -c <'vessel.f'`; then echo shar: \"'vessel.f'\" unpacked with wrong size! fi # end of 'vessel.f' fi if test -f 'vocab.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'vocab.f'\" else echo shar: Extracting \"'vocab.f'\" \(375 characters\) sed "s/^X//" >'vocab.f' <<'END_OF_FILE' XC*** VOCAB XC DATA STRUCTURE ROUTINES XC (VOCAB, VOCABX, DSTROY, JUGGLE, MOVE, PUT, CARRY, DROP, INSERT, REMOVE) X X X INTEGER FUNCTION VOCAB(ID,INIT) X XC THIS DECRYPTS THE WORD BEFORE SENDING IT TO VOCABX, WHO DOES ALL XC THE REAL WORK. SEE COMMENTS IN VOCABX. X X IMPLICIT INTEGER(A-Z) X REAL*8 ID X VOCAB=VOCABX(ID,INIT) X X RETURN X END END_OF_FILE if test 375 -ne `wc -c <'vocab.f'`; then echo shar: \"'vocab.f'\" unpacked with wrong size! fi # end of 'vocab.f' fi if test -f 'vocabx.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'vocabx.f'\" else echo shar: Extracting \"'vocabx.f'\" \(1145 characters\) sed "s/^X//" >'vocabx.f' <<'END_OF_FILE' XC*** VOCABX X X X INTEGER FUNCTION VOCABX(ID,INIT) X XC LOOK UP ID IN THE VOCABULARY (ATAB) AND RETURN ITS "DEFINITION" (KTAB), OR XC -1 IF NOT FOUND. IF INIT IS POSITIVE, THIS IS AN INITIALISATION CALL SETTING XC UP A KEYWORD VARIABLE, AND NOT FINDING IT CONSTITUTES A BUG. IT ALSO MEANS XC THAT ONLY KTAB VALUES WHICH TAKEN OVER 1000 EQUAL INIT MAY BE CONSIDERED. XC (THUS "STEPS", WHICH IS A MOTION VERB AS WELL AS AN OBJECT, MAY BE LOCATED XC AS AN OBJECT.) AND IT ALSO MEANS THE KTAB VALUE IS TAKEN MOD 1000. X X IMPLICIT INTEGER(A-Z) X REAL*8 ATAB,ID X COMMON /VOCCOM/ KTAB(600),ATAB(600),TABSIZ X XC HASH=ID.XOR.'PHROG' (DONE BY CALLER) X WDCLAS=INIT X IF(INIT.LT.0)WDCLAS=-INIT-1 X DO 1 I=1,TABSIZ X IF(KTAB(I).EQ.-1)GOTO 2 X IF(ATAB(I).NE.ID)GOTO 1 X IF(CLASS(KTAB(I)).GE.WDCLAS)GOTO 3 X1 CONTINUE X CALL BUG(21) X X2 VOCABX=-1 X IF(INIT.LT.0)RETURN X PRINT 4,ID X4 FORMAT (' VOCAB ERROR: CAN''T FIND WORD ''',A5,''' IN TABLE.') X CALL BUG(5) X X3 VOCABX=KTAB(I) X IF(INIT.GE.0)VOCABX=MOD(VOCABX,1000) X RETURN X END END_OF_FILE if test 1145 -ne `wc -c <'vocabx.f'`; then echo shar: \"'vocabx.f'\" unpacked with wrong size! fi # end of 'vocabx.f' fi if test -f 'wearing.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'wearing.f'\" else echo shar: Extracting \"'wearing.f'\" \(368 characters\) sed "s/^X//" >'wearing.f' <<'END_OF_FILE' XC*** WEARNG .TRUE. IF WEARING OBJ X X X LOGICAL FUNCTION WEARNG(OBJ) X XC WEARNG(OBJ) = TRUE IF THE OBJ IS BEING WORN X X IMPLICIT INTEGER(A-Z) X COMMON /BITCOM/ OPENBT,UNLKBT,BURNBT,WEARBT X INTEGER*4 LOCCON,OBJCON X COMMON /CONCOM/ LOCCON(250),OBJCON(150) X LOGICAL BITSET X X WEARNG=BITSET(OBJCON(OBJ),WEARBT) X RETURN X END END_OF_FILE if test 368 -ne `wc -c <'wearing.f'`; then echo shar: \"'wearing.f'\" unpacked with wrong size! fi # end of 'wearing.f' fi if test -f 'xspeak.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'xspeak.f'\" else echo shar: Extracting \"'xspeak.f'\" \(1511 characters\) sed "s/^X//" >'xspeak.f' <<'END_OF_FILE' XC*** XSPEAK XC UTILITY ROUTINES FOR CREATING A READABLE CAVE MAP. (XSPEAK, XMAP) X X SUBROUTINE XSPEAK(LOC) X XC PRINT LOCATION DESCRIPTIONS. WORKS JUST LIKE SPEAK, EXCEPT THAT XC LOCATION NUMBER IS PREFIXED TO EACH LINE. X X IMPLICIT INTEGER(A-Z) X INTEGER*4 RTEXT,PTEXT,MTEXT X INTEGER*4 LINES X COMMON /TXTCOM/ LINES(25000),RTEXT(400),PTEXT(150),MTEXT(45) X INTEGER*4 LTEXT,STEXT,K,L X COMMON /LTXCOM/ LTEXT(250),STEXT(250),KEY(250),ABB(250),LOCSIZ X COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150), X 1 FIXED(150),MAXOBJ X INTEGER*4 POINTS,OLINE X COMMON /OBJCOM/ PLAC(150),FIXD(150),WEIGHT(150),PROP(150), X 1 POINTS(150) X DIMENSION OLINE(18) X X K=STEXT(LOC) X IF(K.EQ.0.OR.LINES(K+1).EQ.XOR('>$< ','CLYD'))K=LTEXT(LOC) XC WRITE (22,5) X WRITE(5,5) XC WRITE (22,5) X WRITE(5,5) X5 FORMAT (1H ) X1 L=IABS(LINES(K))-K-1 X DO 2 I=1,L X2 OLINE(I)=XOR(LINES(K+I),'CLYD') XC WRITE (22,3),LOC,(OLINE(I),I=1,L) X WRITE(5,3)LOC,(OLINE(I),I=1,L) X3 FORMAT (1X,I3,' ',18A4) X K=K+L+1 X IF(LINES(K).GE.0)GOTO 1 X DO 7 OBJ=1,MAXOBJ X IF(LOC.NE.PLAC(OBJ).AND.LOC.NE.FIXD(OBJ))GOTO 7 X K=PTEXT(OBJ) X L=IABS(LINES(K))-K-1 X DO 6 I=1,L X6 OLINE(I)=XOR(LINES(K+I),'CLYD') XC WRITE (22,9),(OLINE(J),J=1,L) X WRITE(5,9)(OLINE(J),J=1,L) X7 CONTINUE XC WRITE (22,5) X WRITE(5,5) X RETURN X X9 FORMAT (8X,18A4) X END END_OF_FILE if test 1511 -ne `wc -c <'xspeak.f'`; then echo shar: \"'xspeak.f'\" unpacked with wrong size! fi # end of 'xspeak.f' fi if test -f 'yesm.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'yesm.f'\" else echo shar: Extracting \"'yesm.f'\" \(234 characters\) sed "s/^X//" >'yesm.f' <<'END_OF_FILE' XC*** YESM X X X X LOGICAL FUNCTION YESM(X,Y,Z) X XC CALL YESX (BELOW) WITH MESSAGES FROM SECTION 12. X X IMPLICIT INTEGER(A-Z) X EXTERNAL MSPEAK X LOGICAL YESX X X YESM=YESX(X,Y,Z,MSPEAK) X RETURN X END END_OF_FILE if test 234 -ne `wc -c <'yesm.f'`; then echo shar: \"'yesm.f'\" unpacked with wrong size! fi # end of 'yesm.f' fi if test -f 'yesx.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'yesx.f'\" else echo shar: Extracting \"'yesx.f'\" \(706 characters\) sed "s/^X//" >'yesx.f' <<'END_OF_FILE' XC*** YESX X X X X LOGICAL FUNCTION YESX(X,Y,Z,SPK) X XC PRINT MESSAGE X, WAIT FOR YES/NO ANSWER. IF YES, PRINT Y AND LEAVE YEA XC TRUE; IF NO, PRINT Z AND LEAVE YEA FALSE. SPK IS EITHER RSPEAK OR MSPEAK. X X IMPLICIT INTEGER(A-Z) X REAL*8 REPLY,JUNK1,JUNK2,JUNK3 X EXTERNAL SPK X X1 IF(X.NE.0)CALL SPK(X) X CALL GETIN(REPLY,JUNK1,JUNK2,JUNK3) X IF(REPLY.EQ.'YES '.OR.REPLY.EQ.'Y ')GOTO 10 X IF(REPLY.EQ.'NO '.OR.REPLY.EQ.'N ')GOTO 20 X PRINT 9 X9 FORMAT(/' Please answer the question.') X GOTO 1 X10 YESX=.TRUE. X IF(Y.NE.0)CALL SPK(Y) X RETURN X20 YESX=.FALSE. X IF(Z.NE.0)CALL SPK(Z) X RETURN X END END_OF_FILE if test 706 -ne `wc -c <'yesx.f'`; then echo shar: \"'yesx.f'\" unpacked with wrong size! fi # end of 'yesx.f' fi echo shar: End of archive 7 \(of 8\). cp /dev/null ark7isdone MISSING="" for I in 1 2 3 4 5 6 7 8 ; do if test ! -f ark${I}isdone ; then MISSING="${MISSING} ${I}" fi done if test "${MISSING}" = "" ; then echo You have unpacked all 8 archives. rm -f ark[1-9]isdone else echo You still need to unpack the following archives: echo " " ${MISSING} fi ## End of shell archive. exit 0