C*** A5TOA1
SUBROUTINE A5TOA1(A,B,C,QQ,LENG)
C A AND B CONTAIN A 1- TO 12-CHARACTER WORD IN A6 FORMAT, C CONTAINS ANOTHER
C WORD AND/OR PUNCTUATION. THEY ARE UNPACKED TO ONE CHARACTER PER WORD IN THE
C ARRAY "CHARS".
C THE INDEX OF THE LAST NON-BLANK CHAR IN CHARS IS RETURNED IN LENG.
IMPLICIT INTEGER(A-Z)
CHARACTER*6 A,B,C
CHARACTER QQ(20)
DO 300 JJ=1,6
QQ(JJ)=A(JJ:JJ)
300 QQ(JJ+6)=B(JJ:JJ)
DO 5 I=1,12
IF(QQ(I).EQ.' ')GOTO 10
5 CONTINUE
LENG=12
GOTO 15
10 CONTINUE
LENG=I-1
15 DO 20 I=1,6
IF(C(I:I).NE.' ')THEN
LENG=LENG+1
QQ(LENG) = C(I:I)
ENDIF
20 CONTINUE
DO 21 I= LENG+1,20
21 QQ(I) = ' '
DO 22 I= 1,20
22 IF(QQ(I).EQ.'_')QQ(I) = ' '
RETURN
END
C*** AJAR .TRUE. IF OBJ IS CONTAINER AND IS OPEN
C THE NEXT LOGICAL FUNCTIONS DESCRIBE ATTRIBUTES OF OBJECTS.
C (AJAR, HINGED, OPAQUE, PRINTD, TREASR, VESSEL, WEARNG)
LOGICAL FUNCTION AJAR(OBJ)
C AJAR(OBJ) = TRUE IF OBJECT IS AN OPEN OR UNHINGED CONTAINER.
IMPLICIT INTEGER(A-Z)
LOGICAL BITSET,HINGED,VESSEL
COMMON /BITCOM/ OPENBT,UNLKBT,BURNBT,WEARBT
COMMON /CONCOM/ LOCCON(250),OBJCON(150)
AJAR=BITSET(OBJCON(OBJ),OPENBT).OR.
1 (VESSEL(OBJ).AND..NOT.HINGED(OBJ))
RETURN
END
C*** AT .TRUE. IF AT OBJ
LOGICAL FUNCTION AT(OBJ)
C AT(OBJ) = TRUE IF ON EITHER SIDE OF TWO-PLACED OBJECT
IMPLICIT INTEGER(A-Z)
COMMON /LOCCOM/ LOC,OLDLOC,OLDLC2,NEWLOC,MAXLOC
COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150),
1 FIXED(150),MAXOBJ
AT = .FALSE.
IF(OBJ.LT.1.OR.OBJ.GT.MAXOBJ)RETURN
AT=PLACE(OBJ).EQ.LOC.OR.FIXED(OBJ).EQ.LOC
RETURN
END
C*** ATHAND .TRUE. IF OBJ READILY AVAILABLE
LOGICAL FUNCTION ATHAND(OBJ)
C ATHAND(OBJ) = TRUE IF OBJ IS READILY REACHABLE.
C IT CAN BE LYING HERE, IN HAND OR IN OPEN CONTAINER.
IMPLICIT INTEGER(A-Z)
COMMON /LOCCOM/ LOC,OLDLOC,OLDLC2,NEWLOC,MAXLOC
COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150),
1 FIXED(150),MAXOBJ
LOGICAL TOTING,AJAR,ENCLSD,HOLDNG,AAA
ATHAND = .FALSE.
IF(PLACE(OBJ).EQ.LOC.OR.HOLDNG(OBJ))THEN
ATHAND = .TRUE.
RETURN
ENDIF
IF(.NOT.ENCLSD(OBJ))RETURN
CONTNR=-PLACE(OBJ)
ATHAND=
1 (AJAR(CONTNR).AND.
2 (PLACE(CONTNR).EQ.LOC.OR.
3 (TOTING(OBJ).AND.HOLDNG(CONTNR))))
RETURN
END
C*** BITOFF
SUBROUTINE BITOFF(OBJ,BIT)
C TURNS OFF (SETS=0) A BIT IN OBJCON.
IMPLICIT INTEGER(A-Z)
COMMON /CONCOM/ LOCCON(250),OBJCON(150)
C OBJCON(OBJ)=IAND(OBJCON(OBJ),INOT(BITS(BIT)))
C THE FOLLOWING SHOULD BE EQUIVALENT TO THE ABOVE
OBJCON(OBJ)=IOR(OBJCON(OBJ),(BITS(BIT)))-BITS(BIT)
RETURN
END
C*** BITON
SUBROUTINE BITON(OBJ,BIT)
C TURNS ON (SETS=1) A BIT IN OBJCON.
IMPLICIT INTEGER(A-Z)
COMMON /CONCOM/ LOCCON(250),OBJCON(150)
OBJCON(OBJ)=IOR(OBJCON(OBJ),BITS(BIT))
RETURN
END
C*** BITS
INTEGER FUNCTION BITS(SHIFT)
IMPLICIT INTEGER (A-Z)
BITS=(2**SHIFT)
RETURN
END
C*** BITSET
C MISCELLANEOUS LOGICAL FUNCTIONS (BITSET, PCT)
C ALSO, SUBROUTINES FOR TURNING BITS ON AND OFF (BITON, BITOFF).
LOGICAL FUNCTION BITSET(WORD,N)
C BITSET(COND,L,N) = TRUE IF COND(L) HAS BIT N SET
IMPLICIT INTEGER(A-Z)
BITSET=IAND(WORD,2**N).NE.0
5 RETURN
END
C*** BLIND .TRUE. IF YOU CAN'T SEE AT THIS LOC
C LOCATION ATTRIBUTES. (BLIND, DARK, FORCED, INSIDE, OUTSID, PORTAL)
LOGICAL FUNCTION BLIND(DUMMY)
C TRUE IF ADVENTURER IS "BLIND" AT THIS LOC, (DARKNESS OR GLARE)
IMPLICIT INTEGER(A-Z)
COMMON /CONCOM/ LOCCON(250),OBJCON(150)
COMMON /LOCCOM/ LOC,OLDLOC,OLDLC2,NEWLOC,MAXLOC
COMMON /OBJCOM/ PLAC(150),FIXD(150),WEIGHT(150),PROP(150),
1 POINTS(150)
LOGICAL DARK,ATHAND
DATA LAMP /2/
BLIND=DARK(0).OR.(LOC.EQ.200.AND.ATHAND(LAMP).AND.PROP(LAMP)
1 .EQ.1)
RETURN
END
C*** BUG
SUBROUTINE BUG(NUM)
IMPLICIT INTEGER(A-Z)
C THE FOLLOWING CONDITIONS ARE CURRENTLY CONSIDERED FATAL BUGS. NUMBERS < 20
C ARE DETECTED WHILE READING THE DATABASE; THE OTHERS OCCUR AT "RUN TIME".
C 0 MESSAGE LINE > 70 CHARACTERS
C 1 NULL LINE IN MESSAGE
C 2 TOO MANY WORDS OF MESSAGES
C 3 TOO MANY TRAVEL OPTIONS
C 4 TOO MANY VOCABULARY WORDS
C 5 REQUIRED VOCABULARY WORD NOT FOUND
C 6 TOO MANY RTEXT OR MTEXT MESSAGES
C 7 TOO MANY HINTS
C 8 LOCATION HAS COND BIT BEING SET TWICE
C 9 INVALID SECTION NUMBER IN DATABASE
C 10 OUT OF ORDER LOCS OR RSPEAK ENTRIES.
C 11 ILLEGAL MOTION WORD IN TRAVEL TABLE
C 12 ** UNUSED **.
C 13 UNKNOWN OR ILLEGAL WORD IN ADJECTIVE TABLE.
C 14 ILLEGAL WORD IN PREP/OBJ TABLE
C 15 TOO MANY ENTRIES IN PREP/OBJ TABLE
C 16 OBJECT HAS CONDITION BIT SET TWICE
C 17 OBJECT NUMBER TOO LARGE
C 18 TOO MANY ENTRIES IN ADJECTIVE/NOUN TABLE.
C 20 SPECIAL TRAVEL (500>L>300) EXCEEDS GOTO LIST
C 21 RAN OFF END OF VOCABULARY TABLE
C 22 VERB CLASS (N/1000) NOT BETWEEN 1 AND 3
C 23 INTRANSITIVE ACTION VERB EXCEEDS GOTO LIST
C 24 TRANSITIVE ACTION VERB EXCEEDS GOTO LIST
C 25 CONDITIONAL TRAVEL ENTRY WITH NO ALTERNATIVE
C 26 LOCATION HAS NO TRAVEL ENTRIES
C 27 HINT NUMBER EXCEEDS GOTO LIST
C 28 INVALID MONTH RETURNED BY DATE FUNCTION
C 29 ACTION VERB 'LEAVE' HAS NO OBJECT.
C 30 PREPOSITION FOUND IN UNEXPECTED TABLE
C 31 RECEIVED AN UNEXPECTED WORD TERMINATOR FROM A1TOA5
C 32 TRYING TO PUT A CONTAINER INTO ITSELF (TRICKY!)
C 33 UNKNOWN WORD CLASS IN GETWDS
C 35 TRYING TO CARRY A NON-EXISTENT OBJECT
WRITE(*,1) NUM
1 FORMAT (' FATAL ERROR, SEE SOURCE CODE FOR INTERPRETATION.'/
1 ' PROBABLE CAUSE: ERRONEOUS INFO IN DATABASE OR BAD ASAVE.DAT'/
2 ' ERROR CODE =',I2/)
STOP
END
C*** BURDEN .. RETURNS WEIGHT OF ITEMS BEING CARRIED
INTEGER FUNCTION BURDEN(OBJ)
C IF OBJ=0, BURDEN CALCULATES THE TOTAL WEIGHT OF THE ADVENTURER'S BURDEN,
C INCLUDING EVERYTHING IN ALL CONTAINERS (EXCEPT THE BOAT) THAT HE IS
C CARRYING.
C IF OBJ#0 AND OBJ IS A CONTAINER, CALCULATE THE WEIGHT OF EVERYTHING INSIDE
C THE CONTAINER (INCLUDING THE CONTAINER ITSELF). SINCE DONKEY FORTRAN
C ISN'T RECURSIVE, WE WILL ONLY CALCULATE WEIGHTS OF CONTAINED CONTAINERS
C ONE LEVEL DOWN. THE ONLY SERIOUS CONTAINED CONTAINER WOULD BE THE SACK
C THE ONLY THINGS WE'LL MISS WILL BE FILLED VS EMPTY BOTTLE OR CAGE.
C IF OBJ#0 AND ISN'T A CONTAINER, RETURN ITS WEIGHT.
IMPLICIT INTEGER(A-Z)
COMMON /OBJCOM/ PLAC(150),FIXD(150),WEIGHT(150),PROP(150),
1 POINTS(150)
COMMON /HLDCOM/ HOLDER(150),HLINK(150)
COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150),
1 FIXED(150),MAXOBJ
LOGICAL TOTING,WEARNG
DATA BOAT /48/
BURDEN=0
IF(OBJ.NE.0)GOTO 200
DO 100 I=1,MAXOBJ
IF(.NOT.TOTING(I).OR.PLACE(I).EQ.-BOAT)GOTO 100
BURDEN=BURDEN+WEIGHT(I)
100 CONTINUE
RETURN
200 BURDEN=WEIGHT(OBJ)
IF(OBJ.EQ.BOAT)RETURN
TEMP=HOLDER(OBJ)
210 IF(TEMP.EQ.0)RETURN
BURDEN=BURDEN+WEIGHT(TEMP)
TEMP=HLINK(TEMP)
GOTO 210
END
C*** CARRY
SUBROUTINE CARRY(OBJECT,WHERE)
C START TOTING AN OBJECT, REMOVING IT FROM THE LIST OF THINGS AT ITS FORMER
C LOCATION. IF OBJECT>MAXOBJ (MOVING "FIXED" SECOND LOC),
C DON'T CHANGE PLACE.
IMPLICIT INTEGER(A-Z)
COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150),
1 FIXED(150),MAXOBJ
IF(OBJECT.GT.MAXOBJ)GOTO 5
IF(PLACE(OBJECT).EQ.-1)RETURN
PLACE(OBJECT)=-1
5 IF(ATLOC(WHERE).NE.OBJECT)GOTO 6
ATLOC(WHERE)=LINK(OBJECT)
RETURN
6 TEMP=ATLOC(WHERE)
7 IF(LINK(TEMP).EQ.OBJECT)GOTO 8
TEMP=LINK(TEMP)
IF(TEMP.NE.0)GOTO 7
CALL BUG(35)
8 LINK(TEMP)=LINK(OBJECT)
RETURN
END
C*** CLASS
INTEGER FUNCTION CLASS(WORD)
C RETURNS WORD CLASS NUMBER (1=MOTION VERB; 2=NOUN; 3=ACTION VERB;
C 4=MISCELLANEOUS WORD; 5=PREPOSITION; 6=ADJECTIVE; 7=CONJUNCTION).
IMPLICIT INTEGER(A-Z)
CLASS=WORD/1000 +1
IF(WORD.LT.0)CLASS=-1
RETURN
END
C*** CLRLIN
SUBROUTINE CLRLIN
C CLEARS OUT ALL CURRENT SYNTAX ARGS IN PREPARATION FOR A NEW INPUT LINE
IMPLICIT INTEGER(A-Z)
CHARACTER*6 VTXT,OTXT,IOTXT,DTK,ATAB,TXT,ALLZERO
COMMON /WRDCOM/ VERBS(45),VRBX,OBJS(45),
1 OBJX,IOBJS(15),IOBX,PREP,WORDS(45)
COMMON /SV3COM/DTK(9),ATAB(600),VTXT(45,2),OTXT(45,2),IOTXT(15,2)
1 ,TXT(35,2)
DO 3333 I=1,6
3333 ALLZERO(I:I) = CHAR(0)
DO 1 I=1,45
OBJS(I)=0
VERBS(I)=0
DO 1 J=1,2
1 VTXT(I,J)=ALLZERO
DO 3 I=1,15
IOBJS(I)=0
DO 3 J=1,2
IOTXT(I,J)=ALLZERO
3 OTXT(I,J)=ALLZERO
VRBX=0
OBJX=0
IOBX=0
PREP=0
RETURN
END
C*** CONFUZ
INTEGER FUNCTION CONFUZ(DUMMY)
C GENERATES SOME VARIANT OF "DON'T UNDERSTAND THAT" MESSAGE.
IMPLICIT INTEGER(A-Z)
LOGICAL PCT
CONFUZ=60
IF(PCT(50))CONFUZ=61
IF(PCT(33))CONFUZ=13
IF(PCT(25))CONFUZ=347
IF(PCT(20))CONFUZ=195
RETURN
END
C*** DARK .TRUE. IF THERE IS NO LIGHT HERE
LOGICAL FUNCTION DARK(DUMMY)
C TRUE IF LOCATION "LOC" IS DARK
IMPLICIT INTEGER(A-Z)
COMMON /CONCOM/ LOCCON(250),OBJCON(150)
COMMON /LOCCOM/ LOC,OLDLOC,OLDLC2,NEWLOC,MAXLOC
COMMON /OBJCOM/ PLAC(150),FIXD(150),WEIGHT(150),PROP(150),
1 POINTS(150)
LOGICAL ATHAND
DATA LAMP /2/
DARK=MOD(LOCCON(LOC),2).EQ.0.AND.(PROP(LAMP).EQ.0.OR.
1 .NOT.ATHAND(LAMP))
RETURN
END
C*** DEAD .TRUE. IF OBJ IS NOW DEAD
LOGICAL FUNCTION DEAD(OBJ)
IMPLICIT INTEGER(A-Z)
LOGICAL BITSET
COMMON/CONCOM/LOCCON(250),OBJCON(150)
DEAD=BITSET(OBJCON(OBJ),10)
RETURN
END
C*** DROP
SUBROUTINE DROP(OBJECT,WHERE)
C PLACE AN OBJECT AT A GIVEN LOC, PREFIXING IT ONTO THE ATLOC LIST.
IMPLICIT INTEGER(A-Z)
COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150),
1 FIXED(150),MAXOBJ
IF(OBJECT.GT.MAXOBJ)GOTO 1
PLACE(OBJECT)=WHERE
GOTO 2
1 FIXED(OBJECT-MAXOBJ)=WHERE
2 IF(WHERE.LE.0)RETURN
LINK(OBJECT)=ATLOC(WHERE)
ATLOC(WHERE)=OBJECT
RETURN
END
C*** DSTROY
SUBROUTINE DSTROY(OBJECT)
C PERMANENTLY ELIMINATE "OBJECT" BY MOVING TO A NON-EXISTENT LOCATION.
IMPLICIT INTEGER(A-Z)
CALL MOVE(OBJECT,0)
RETURN
END
C*** EDIBLE .TRUE. IF OBJ CAN BE EATEN
LOGICAL FUNCTION EDIBLE(OBJ)
IMPLICIT INTEGER(A-Z)
LOGICAL BITSET
COMMON/CONCOM/LOCCON(250),OBJCON(150)
EDIBLE=BITSET(OBJCON(OBJ),7)
RETURN
END
C*** ENCLSD .TURE. IF OBJ INSIDE SOMETHING
LOGICAL FUNCTION ENCLSD(OBJECT)
C ENCLSD(OBJ) = TRUE IF THE OBJ IS IN A CONTAINER
IMPLICIT INTEGER(A-Z)
COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150),
1 FIXED(150),MAXOBJ
ENCLSD=.FALSE.
IF(OBJECT.LT.1.OR.OBJECT.GT.MAXOBJ)RETURN
ENCLSD=PLACE(OBJECT).LT.-1
RETURN
END
C*** FORCED
LOGICAL FUNCTION FORCED(LOC)
C A FORCED LOCATION IS ONE FROM WHICH HE IS IMMEDIATELY BOUNCED TO ANOTHER.
C NORMAL USE IS FOR DEATH (FORCE TO LOC ZERO) AND FOR DESCRIPTIONS OF
C JOURNEY FROM ONE PLACE TO ANOTHER.
IMPLICIT INTEGER(A-Z)
COMMON /CONCOM/ LOCCON(250),OBJCON(150)
FORCED=LOCCON(LOC).EQ.2
RETURN
END
C*** GETLIN
SUBROUTINE GETLIN
IMPLICIT INTEGER(A-Z)
LOGICAL BLKLIN
COMMON /BLKCOM/ BLKLIN
CHARACTER*6 TXT,WDS(2),KK,DTK,ATAB,VTXT,OTXT,IOTXT,TXT2(35,2)
LOGICAL ACTIVE
COMMON /UTXCOM/ WDX
CHARACTER CHRS(150), CHR2(150),CHRX(70)
COMMON /SV3COM/DTK(9),ATAB(600),VTXT(45,2),OTXT(45,2),IOTXT(15,2)
1 ,TXT(35,2)
10 DO 15 I=1,35
DO 15 J=1,2
TXT2(I,J) = ' '
15 TXT(I,J) = ' '
20 IF(BLKLIN)WRITE(*,*)' '
WRITE(*,1266)
1266 FORMAT(' >')
C??????????????????????????????? THE FOLLOWING WORKS ON MANY COMPUTERS:
C1266 FORMAT(' >',$)
30 READ (*,50)CHRX
50 FORMAT(70A1)
DO 1 I=1,70
CHRX(I) = CHAR(IAND(ICHAR(CHRX(I)), 127))
IF(CHRX(I).LT.' ')CHRX(I) = ' '
IF(CHRX(I).GE.'`')CHRX(I) = CHAR(ICHAR(CHRX(I)) - 32)
1 CONTINUE
DO 4 I=1,70
IF(CHRX(I).NE.' ') GOTO 6
4 CONTINUE
GOTO 20
6 CONTINUE
INDX = 1
DO 2 I=1,70
IF(CHRX(I).EQ.'.'.OR.CHRX(I).EQ.';'.OR.CHRX(I).EQ.',')THEN
CHR2(INDX) = ' '
INDX = INDX + 1
CHR2(INDX) = 'A'
INDX = INDX + 1
CHR2(INDX) = 'N'
INDX = INDX + 1
CHR2(INDX) = 'D'
INDX = INDX + 1
CHR2(INDX) = ' '
INDX = INDX + 1
ELSE
CHR2(INDX) = CHRX(I)
INDX = INDX + 1
ENDIF
2 CONTINUE
CHR2(INDX) = '.'
DO 70 INDX2= 1,INDX
70 IF(CHR2(INDX2).NE.' ') GOTO 73
73 CONTINUE
J = 1
DO 71 I = INDX2,INDX
IF(I.NE.INDX2.AND.CHRS(J-1).EQ.' '.AND.CHR2(I).EQ.' ')GOTO71
CHRS(J) = CHR2(I)
J = J+1
71 CONTINUE
IF(CHRS(1).EQ.'.') GOTO 20
WDX = 1
J = 1
DO 100 I=1,100
IF(CHRS(I).EQ.'.') GO TO 200
IF(CHRS(I).EQ.' ') GO TO 120
IF(J.LE.6)TXT2(WDX,1)(J:J) = CHRS(I)
IF(J.GT.6.AND.J.LE.12)TXT2(WDX,2)(J-6:J-6) = CHRS(I)
J = J+1
GOTO 100
120 CONTINUE
J = 1
WDX = WDX + 1
100 CONTINUE
200 CONTINUE
TXT(1,1) = TXT2(1,1)
TXT(1,2) = TXT2(1,2)
J = 1
DO 210 I=2,35
IF(TXT(J,1).NE.'AND '.OR.TXT2(I,1).NE.'AND ')THEN
J = J+1
TXT(J,1) = TXT2(I,1)
TXT(J,2) = TXT2(I,2)
ELSE
WDX = WDX - 1
ENDIF
210 CONTINUE
C WRITE(*,12345)(TXT(IQQ,1),IQQ = 1,35)
C12345 FORMAT(' ',5A6)
END
C*** GETOBJ
SUBROUTINE GETOBJ(OBJ)
C ANALYSE AN OBJECT WORD. SEE IF THE THING IS HERE, WHETHER WE'VE GOT A VERB
C YET, AND SO ON. OBJECT MUST BE HERE UNLESS VERB IS "FIND" OR "INVENT(ORY)"
C (AND NO NEW VERB YET TO BE ANALYSED). WATER, OIL AND WINE ARE ALSO
C FUNNY, SINCE THEY ARE NEVER ACTUALLY DROPPED AT ANY LOCATION, BUT MIGHT
C BE HERE INSIDE THE BOTTLE OR AS A FEATURE OF THE LOCATION.
C
C HAS THREE POSSIBLE RETURN VALUES FOR 'OBJ':
C VAL > 0 :: A POSITIVE OBJECT NUMBER
C VAL = 0 :: OBJECT NOT FOUND HERE. ERROR MESSAGE PRINTED.
C VAL < 0 :: OBJECT WORD REALLY SOMETHING ELSE. RETURN NEGATIVE
C VALUE OF SUBSTITUTED WORD.
IMPLICIT INTEGER(A-Z)
LOGICAL AT
CHARACTER ZAPP(20)
COMMON /DWFCOM/ DWARF,KNIFE,KNFLOC,DFLAG,DSEEN(6),DLOC(6),
1 ODLOC(6),DWFMAX
COMMON /LIQCOM/ BOTTLE,CASK,WATER,OIL,WINE,LIQTYP(5)
COMMON /LOCCOM/ LOC,OLDLOC,OLDLC2,NEWLOC,MAXLOC
COMMON /MNECOM/ BACK,CAVE,DPRSSN,ENTRNC,EXIT,GO,LOOK,NULL,
1 AXE,BEAR,BOAT,BOOK,BOOK2,BOOTH,CARVNG,CHASM,CHASM2,DOOR,GNOME,
2 GRATE,LAMP,PDOOR,PLANT,PLANT2,ROCKS,ROD,ROD2,SAFE,
3 TDOOR,TDOOR2,TROLL,TROLL2,EMRALD,SPICES,
4 FIND,YELL,INVENT,LEAVE,POUR,SAY,TAKE,THROW,
5 IWEST,PHUCE(2,4),TK(20)
COMMON /OBJCOM/ PLAC(150),FIXD(150),WEIGHT(150),PROP(150),
1 POINTS(150)
COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150),
1 FIXED(150),MAXOBJ
CHARACTER*6 TXT
COMMON /UTXCOM/ WDX
CHARACTER*6 VTXT,OTXT,IOTXT,DTK,ATAB
COMMON /WRDCOM/ VERBS(45),VRBX,OBJS(45),
1 OBJX,IOBJS(15),IOBX,PREP,WORDS(45)
LOGICAL ATHAND,BLIND,HERE,HOLDNG,PLURAL
COMMON /SV3COM/DTK(9),ATAB(600),VTXT(45,2),OTXT(45,2),IOTXT(15,2)
1 ,TXT(35,2)
IF(HOLDNG(OBJ))RETURN
IF(BLIND(0))GOTO 280
IF(FIXED(OBJ).EQ.LOC.OR.ATHAND(OBJ))GOTO 290
IF(.NOT.HERE(OBJ))GOTO 205
K=335
IF(PLURAL(OBJ))K=373
OBJ=0
CALL RSPEAK(K)
RETURN
205 IF(OBJ.NE.GRATE)GOTO 210
IF(LOC.EQ.1.OR.LOC.EQ.4.OR.LOC.EQ.7)OBJ=-DPRSSN
IF(LOC.GT.9.AND.LOC.LT.15)OBJ=-ENTRNC
IF(OBJ.EQ.GRATE)GOTO 280
RETURN
210 IF(OBJ.NE.DWARF)GOTO 220
L1=DWFMAX-1
DO 212 I=1,L1
IF(DLOC(I).EQ.LOC.AND.DFLAG.GE.2)GOTO 290
212 CONTINUE
GOTO 280
220 IF(OBJ.EQ.LIQLOC(LOC).OR.
1 (ATHAND(BOTTLE).AND.LIQ(BOTTLE).EQ.OBJ).OR.
2 (ATHAND(CASK).AND.LIQ(CASK).EQ.OBJ))GOTO 290
IF(OBJ.NE.PLANT.OR..NOT.AT(PLANT2).OR.PROP(PLANT2).EQ.0)GOTO 230
OBJ=PLANT2
GOTO 290
230 IF(OBJ.NE.ROCKS.OR..NOT.AT(CARVNG))GOTO 240
OBJ=CARVNG
GOTO 290
240 IF(OBJ.NE.ROD.OR..NOT.ATHAND(ROD2))GOTO 250
OBJ=ROD2
GOTO 290
250 IF(OBJ.NE.DOOR.OR..NOT.
1 (AT(SAFE).OR.AT(TDOOR).OR.AT(TDOOR2).OR.AT(PDOOR)))
2 GOTO 260
OBJ=TDOOR
IF(AT(TDOOR2))OBJ=TDOOR2
IF(AT(PDOOR))OBJ=PDOOR
IF(AT(SAFE))OBJ=SAFE
GOTO 290
260 IF(OBJ.NE.BOOK.OR..NOT.ATHAND(BOOK2))GOTO 270
OBJ=BOOK2
GOTO 290
270 IF(VERBS(VRBX).EQ.FIND.OR.VERBS(VRBX).EQ.INVENT)GOTO 290
C IT ISN'T HERE. TELL HIM & RETURN.
280 OBJ=0
CALL A5TOA1(TXT(WDX,1),TXT(WDX,2),'_here.',ZAPP,K)
WRITE(*,282)(ZAPP(I),I=1,K)
282 FORMAT(/' I see no ',20A1)
290 RETURN
END
C*** GETWDS
SUBROUTINE GETWDS
C WHEN CALLED, CHECKS IF PREVIOUS WORDS VECTOR HAS BEEN EXHAUSTED.
C IF NOT, BRANCH AROUND THE CODE WHICH READS IN A NEW LINE. IF VECTOR IS EMPTY
C SUCK UP A LINE FROM THE TTY, THEN CHECK EACH WORD FOR INTELLIGIBILITY.
C IF THE WORD IS VALID, ITS NUMBER GETS STUCK INTO THE WORDS VECTOR.
C THEN EACH WORD IS PARSED BY THE APPROPRIATE CODE. THE LABELS BELOW ARE
C 100 TIMES THE WORD CLASS.
C
C THE FOLLOWING VECTORS ARE USED:
C TXT(WDX,2) HOLD THE RAW TEXT FROM GETLIN
C WORDS(WDX) LIST OF WORD NUMBERS, CONVERTED FROM TXT(WDX,1).
C VTXT(VRBX,2) HOLD THE TEXT FOR VERB VRBX.
C VERBS(VRBX) IS THE LIST OF VALIDATED VERB NUMBERS.
C OTXT(OBJX,2) HOLDS THE TEXT OF THE OBJECT OBJX.
C OBJX(OBJX) IS THE LIST OF VALIDATED OBJECT NUMBERS.
C IOTXT(IOBX,2) HOLDS THE TEXT FOR PREP'S IOBJ.
IMPLICIT INTEGER(A-Z)
LOGICAL BLIND,LIVING,PCT,PFLAG,HINGED,AT,ATHAND,TOTING,K1,ISWIZ
LOGICAL KILLED
CHARACTER*6 WORD1,WORD2,DKK,DK
CHARACTER ZAPP(20)
COMMON/IZWIZ/ISWIZ
COMMON /ADJCOM/ ADJKEY(50),ADJTAB(150),ADJSIZ
COMMON /DIECOM/ NUMDIE,MAXDIE,TURNS,KILLED
COMMON /DWFCOM/ DWARF,KNIFE,KNFLOC,DFLAG,DSEEN(6),DLOC(6),
1 ODLOC(6),DWFMAX
COMMON /LIQCOM/ BOTTLE,CASK,WATER,OIL,WINE,LIQTYP(5)
COMMON /LOCCOM/ LOC,OLDLOC,OLDLC2,NEWLOC,MAXLOC
COMMON /MNECOM/ BACK,CAVE,DPRSSN,ENTRNC,EXIT,GO,LOOK,NULL,
1 AXE,BEAR,BOAT,BOOK,BOOK2,BOOTH,CARVNG,CHASM,CHASM2,DOOR,GNOME,
2 GRATE,LAMP,PDOOR,PLANT,PLANT2,ROCKS,ROD,ROD2,SAFE,
3 TDOOR,TDOOR2,TROLL,TROLL2,EMRALD,SPICES,
4 FIND,YELL,INVENT,LEAVE,POUR,SAY,TAKE,THROW,
5 IWEST,PHUCE(2,4),TK(20)
COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150),
1 FIXED(150),MAXOBJ
COMMON /PRPCOM/ VKEY(60),PTAB(300),VKYSIZ,PTBSIZ
CHARACTER*6 TXT,DTK(9),ATAB
COMMON /UTXCOM/ WDX
CHARACTER*6 VTXT,OTXT,IOTXT
COMMON /WRDCOM/ VERBS(45),VRBX,OBJS(45),
1 OBJX,IOBJS(15),IOBX,PREP,WORDS(45)
DIMENSION TAKDIR(20)
COMMON /SV3COM/DTK,ATAB(600),VTXT(45,2),OTXT(45,2),IOTXT(15,2)
1 ,TXT(35,2)
C MOTION NOUN ACTION MISC PREP ADJ CONJ
DATA CLASSD,CLASSN,CLASSA,CLASSM,CLASSP,CLASSJ,CLASSC
1 /1,2,3,4,5,6,7/
C
C A FEW MORE ACTION VERBS NOT IN COMMON.
DATA DROP,FEED,NOTHNG,LIGHT,DRINK,SCORE /02,21,05,07,15,24/
DATA PICK,PUT,GET /41,42,44/
C
C AND A MOTION VERB:
DATA ENTER /3/
C
C AND TO GET/DROP EVERYTHING IN SIGHT:
DATA ALL /109/
C
C TAKDIR IS A LIST OF MOTION VERBS WHICH ARE ACCEPTABLE AFTER 'TAKE'.
DATA TAKDIR/2,6,9,10,11,13,14,17,23,25,33,34,
1 36,37,39,78,79,80,89,-1/
C
C IF WORDS(WDX+1) HAS SOMETHING IN IT, WE ARE STILL PROCESSING OLD INPUT LINE.
C IF WORDS(1) = -2, SOMEONE ELSE HAS CALLED GETLIN (E.G., KILL DRAGON).
POUR = 13
IF(WORDS(WDX+1).GT.0)GOTO 30
C IF WORDS(1) HAS BEEN SET TO -2, SOMEONE ELSE HAS ALREADY READ IN
C THE NEW LINE, PRESUMABLY TO CHECK FOR SOME NON-STANDARD WORD.
C (THIS HAPPENS WHEN KILLING DRAGON WITH BARE HANDS.)
20 IF(WORDS(1).NE.-2)CALL GETLIN
WDX=0
DO 25 I=1,35
WORDS(I)=0
IF(TXT(I,1).NE.' ')WORDS(I)=VOCABX(TXT(I,1),-1)
25 CONTINUE
C THE FIRST WORD OF EACH CLAUSE GETS SPECIAL CHECKING, MOSTLY LOOKING
C FOR IDIOMS.
C SPECIAL HANDLING FOR 'SAY' AND 'CALL'. WIN IF SAYING/CALLING
C MAGIC WORDS. NARKY IF UTTERING ANYTHING ELSE. IF NO OBJ, PASS
C ON FOR HIGHER LEVEL PARSING.
30 PFLAG=.FALSE.
WDX=WDX+1
WORD=WORDS(WDX)
IF(WORD)830,800,32
32 KK=CLASS(WORD)
IF(KK.EQ.-1)GOTO 91
IF(KK.EQ.CLASSA.OR.KK.EQ.CLASSD.OR.KK.EQ.CLASSM)CALL CLRLIN
K=VAL(WORD)
IF(KK.NE.CLASSA.OR.(K.NE.SAY.AND.K.NE.YELL))GOTO 40
C 'SAY' OR 'CALL'. IF NO NEXT WORD, PASS ON TO HIGHER POWERS.
C IF OBJECT IS MAGIC WORD ('SAY XYZZY'), FLUSH 'SAY' & TAKE NEXT WORD.
IF(WORDS(WDX+1).EQ.0.OR.CLASS(WORDS(WDX+1)).EQ.CLASSC)GOTO 99
WDX=WDX+1
IF(K.EQ.SAY)CALL A5TOA1(TXT(WDX,1),TXT(WDX,2),'". ',ZAPP,K)
IF(K.EQ.YELL)CALL A5TOA1(TXT(WDX,1),TXT(WDX,2),'"!!!!!',ZAPP,K)
WORD=WORDS(WDX)
IF(WORD.EQ.62.OR.WORD.EQ.65.OR.WORD.EQ.71.OR.WORD.EQ.82
1 .OR.WORD.EQ.2025)GOTO 99
WRITE(*,37)(ZAPP(I),I=1,K)
37 FORMAT(/' Okay, "',20A1)
GOTO 860
C SPECIAL STUFF FOR 'ENTER'. CAN'T GO INTO WATER.
C 'ENTER BOAT' MEANS 'TAKE BOAT'.
40 WORD1=TXT(WDX,1)
WORD2=TXT(WDX+1,1)
IF(WORD1.NE.'ENTER ')GOTO 50
IF(WORD2.EQ.' ')GOTO 91
SPK=43
IF(LIQLOC(LOC).EQ.WATER)SPK=70
IF(WORD2.EQ.'STREAM'.OR.WORD2.EQ.'WATER '.OR.WORD2.EQ.
1 'RESERV'.OR.WORD2.EQ.'OCEAN '.OR.WORD2.EQ.'SEA '
2 .OR.WORD2.EQ.'POOL ')GOTO 810
IF(WORD2.NE.'BOAT '.AND.WORD2.NE.'ROWBOA')GOTO 99
WORD=TAKE+2000
GOTO 99
C 'LEAVE' IS A MOTION VERB, UNLESS LEAVING AN OBJECT,
C E.G., 'LEAVE BOAT' OR 'LEAVE BOTTLE'. BUT MAKE SURE TO LEAVE ('DROP')
C ONLY TOTABLE OBJECTS.
50 KK=WORDS(WDX+1)
IF(WORD1.NE.'LEAVE '.OR.CLASS(KK).NE.CLASSN)
1 GOTO 55
IF(HINGED(VAL(KK)).OR.FIXED(VAL(KK)).NE.0)GOTO 99
WORD=LEAVE+2000
GOTO 99
C IF 'LIGHT LAMP', LIGHT MUST BE TAKEN AS AN ACTION VERB, NOT A NOUN.
55 IF(WORD1.NE.'LIGHT'.OR.WORDS(WDX+1).NE.(LAMP+1000))GOTO 60
WORD=LIGHT+2000
GOTO 99
C 'WATER PLANT' BECOMES 'POUR WATER', IF WE ARE AT PLANT.
C 'OIL DOOR' BECOMES 'POUR OIL', ETC., ETC.
60 IF((WORD1.NE.'WATER '.AND.WORD1.NE.'OIL ')
1 .OR.(WORD2.NE.'PLANT '.AND.WORD2.NE.'DOOR '
2 .AND.WORD2.NE.'SWORD '.AND.WORD2.NE.'ANVIL '))GOTO 65
IF(.NOT.AT(VOCABX(WORD2,CLASSN)))GOTO 61
WORDS(WDX+1)=WORDS(WDX)
TXT(WDX+1,1)=WORD1
TXT(WDX+1,2)=TXT(WDX,2)
61 WORD=POUR+2000
GOTO 99
C CHECK FILLING OR EMPTYING A CONTAINER.
65 IF((WORD1.NE.'EMPTY ').OR.
1 (CLASS(WORDS(WDX+1)).NE.CLASSN))GOTO 91
KK=VAL(WORDS(WDX+1))
C IF(KK.NE.SACK.AND.KK.NE.SAFE.AND.KK.NE.BOAT.AND.KK.NE.CHEST)
C 1 GOTO 91
C *** UNFINISHED CODE HERE ***
C ALL THAT ACTUALLY HAPPENS IS OFF ERROR MESSAGES. THE STOOGE
C SIMPLY CAN'T SAY 'EMPTY SACK OR 'TAKE ALL FROM SACK' ETC
GOTO 91
C THIS IS THE 'INNER' LOOP. DISPATCHING OF ALL WORDS IN A CLAUSE AFTER
C THE FIRST COMES THRU HERE.
90 WDX=WDX+1
WORD=WORDS(WDX)
91 IF(WORD)830,900,92
96 WCLASS=WCLASS+1
WORD=VOCABX(TXT(WDX,1),-(WCLASS+1))
IF(WORD.EQ.-1)GOTO 800
WORDS(WDX)=WORD
92 IF(CLASS(WORD).NE.CLASSN)GOTO 99
C IT'S NOT THE FIRST: MAKE SURE HE INCLUDED A COMMA OR 'AND'.
C DIFFERENTIATE BETWEEN DIR & INDIR OBJECTS.
C CHECK FOR SPECIAL CASE OF MULTIPLE OBJECTS: 'FEED BEAR HONEY' OR
C 'THROW TROLL NUGGET'.
K=OBJX
IF(PFLAG)K=IOBX
IF(K.EQ.0.OR.CLASS(WORDS(WDX-1)).EQ.CLASSC)GOTO 99
KK=VAL(VERBS(VRBX))
IF(.NOT.LIVING(OBJS(OBJX)).OR.(KK.NE.THROW.AND.KK.NE.FEED))
1 GOTO 800
IOBX=IOBX+1
IOBJS(IOBX)=OBJS(OBJX)
OBJS(OBJX)=0
OBJX=OBJX-1
99 WCLASS=CLASS(WORD)
GOTO(100,200,300,400,500,600,700),WCLASS
C MWD OBJ AVB MVB PRP ADJ CNJ
CALL BUG(33)
C MOTION VERB.
C A MOTION VERB IS EITHER A DIRECTION ('WEST') OR A MOTION ('JUMP').
C MULTIPLE MOTIONS MUST BE SEPARATED BY COMMAS OR AND'S. THERE ARE
C SOME IDIOMATIC USES WHICH MUST BE SCANNED FOR, SUCH AS 'TAKE BRIDGE',
C WHICH BECOMES 'BRIDGE' AND 'GO WEST', WHICH BECOMES 'WEST', AND 'LEAVE THING'
C IS DIFFERENT FROM JUST 'LEAVE'.
C
C IF ORIGINAL VERB WAS 'GO', FLUSH IT & REPLACE WITH THIS ONE.
C I.E., 'GO WEST' BECOMES 'WEST'.
C
C CHECK TAKDIR(20) LIST FOR VALID OBJECT MOTION VERBS FOR 'TAKE'.
C IF FOUND, THROW AWAY 'TAKE' AND USE THE MOTION VERB.
C
C SINCE THE ORIGINAL VERB IS AN ACTION VERB, CHECK THIS WORD IN THE
C NOUN TABLE. MAYBE IT IS AN OBJECT SYNONYMOUS WITH A VERB ('ROCKS').
C
C IF IT ISN'T A VALID MOTION-OBJECT OF 'TAKE' OR 'GO', NOR AN OBJECT,
C CHECK THE PREP TABLE. IF FOUND, HAND IT TO THE PREPOSITION ANALYZER.
100 IF(VRBX.EQ.0)GOTO 180
K=VERBS(VRBX)
IF(CLASS(K).GT.CLASSA)GOTO 800
IF(CLASS(K).NE.CLASSA)GOTO 140
IF(VAL(K).EQ.GO)GOTO 180
IF(VAL(K).NE.TAKE)GOTO 96
KK=VAL(WORD)
DO 110 I=1,20
IF(TAKDIR(I).EQ.KK)GOTO 180
110 CONTINUE
GOTO 96
C IF ORIGINAL MOTION VERB WAS CRAWL, JUMP OR CLIMB, IGNORE CURRENT WORD.
C I.E., 'CLIMB UP' OR 'JUMP OVER' BECOME 'CLIMB' & 'JUMP' ONLY.
140 IF(K.EQ.17.OR.K.EQ.39.OR.K.EQ.56)GOTO 90
C 'CRAWL' 'JUMP' 'CLIMB'
180 VERBS(1)=WORD
VRBX=1
IF(TXT(WDX,1).NE.'WEST ')GOTO 90
IWEST=IWEST+1
IF(IWEST.EQ.10)CALL RSPEAK(17)
K=VAL(WORD)
IF(K.EQ.EXIT.OR.K.EQ.ENTER)GOTO 860
GOTO 90
C ANALYZE OBJECT.
C IF PFLAG IS TRUE, THEN WE ARE PROCESSING A SET OF INDIRECT (PREP)
C OBJECTS, NOT DIRECT OBJS.
200 IF(PFLAG)GOTO 503
IF(VRBX.NE.0)GOTO 220
K=VOCABX(TXT(WDX,1),-(CLASSA+1))
IF(K.EQ.-1)GOTO 220
WORD=K
GOTO 300
220 WORD=VAL(WORD)
IF(WORD.EQ.ALL)GOTO 280
222 CALL GETOBJ(WORD)
IF(WORD)230,860,240
C IT WASN'T REALLY AN OBJECT. GO SEE WHAT IT WAS.
230 WORD=-WORD
GOTO 99
C IT WAS REALLY AN OBJECT & IT IS HERE.
240 OBJX=OBJX+1
OBJS(OBJX)=WORD
OTXT(OBJX,1)=TXT(WDX,1)
OTXT(OBJX,2)=TXT(WDX,2)
GOTO 90
C TAKE EVERYTHING NOT BATTENED DOWN.
280 KK=VAL(VERBS(VRBX))
K1=.FALSE.
IF(KK.EQ.DROP.OR.KK.EQ.PUT.OR.KK.EQ.LEAVE)GOTO 281
K1=.TRUE.
IF(KK.NE.TAKE.AND.KK.NE.PICK.AND.KK.NE.GET)GOTO 800
SPK=357
IF(BLIND(0))GOTO 810
281 DO 289 I=1,MAXOBJ
IF(.NOT.ATHAND(I).OR.FIXED(I).NE.0)GOTO 289
IF(I.GE.WATER.AND.I.LE.WINE+1)GOTO 289
IF((K1.AND.TOTING(I)) .OR. (.NOT.K1.AND..NOT.TOTING(I)) )GOTO 289
OBJX=OBJX+1
OBJS(OBJX)=I
C OTXT(OBJX,1)=NTXT(I,1)
C OTXT(OBJX,2)=NTXT(I,2)
OTXT(OBJX,1)='BUG???'
OTXT(OBJX,2)=' '
IF(OBJX.EQ.44)GOTO 90
289 CONTINUE
GOTO 90
C ACTION VERB.
300 IF(VRBX.EQ.0)GOTO 370
IF(VAL(VERBS(VRBX)).NE.TAKE)GOTO 320
K=VAL(WORD)
IF(K.EQ.DRINK.OR.K.EQ.INVENT.OR.K.EQ.SCORE.OR.K.EQ.NOTHNG
1 .OR.K.EQ.LOOK)GOTO 371
IF(K.NE.GO)GOTO 800
DK=TXT(WDX,1)
IF(DK.EQ.'WALK '.OR.DK.EQ.'RUN '.OR.DK.EQ.'HIKE ')
1 GOTO 371
GOTO 800
320 IF(OBJX.NE.0.OR.CLASS(WORDS(WDX-1)).NE.CLASSC)GOTO 800
370 VRBX=VRBX+1
371 VERBS(VRBX)=WORD
VTXT(VRBX,1)=TXT(WDX,1)
VTXT(VRBX,2)=TXT(WDX,2)
GOTO 90
C MISCELLANEOUS WORDS/VERBS.
400 IF(VRBX.NE.0)GOTO 800
VERBS(1)=WORD
VRBX=1
GOTO 90
C ANALYZE A PREPOSITION AND ITS OBJECT. CHECK THAT PREP
C IS VALID FOR THIS VERB, AND THEN CHECK THAT THE OBJECT IS VALID
C FOR THIS PREPOSITION. IF FIRST CHECK FAILS, SYNTAX IS MESSED
C UP; IF SECOND PART FAILS, IT MAY MERELY BE AN IMPOSSIBLE ACT.
500 IF(CLASS(VERBS(VRBX)).NE.CLASSA.OR.IOBX.NE.0)GOTO 800
IF(PFLAG)GOTO 503
VRBKEY=VKEY(VAL(VERBS(VRBX)))
IF(VRBKEY.EQ.0)GOTO 800
PREP=VAL(WORD)
PFLAG=.TRUE.
WDX=WDX+1
WORD=WORDS(WDX)
IF(WORD.EQ.0)GOTO 510
GOTO(800,503,800,800,800,600,510),CLASS(WORD)
GOTO 840
503 WORD=VAL(WORD)
IF(WORD.EQ.ALL)GOTO 510
504 CALL GETOBJ(WORD)
IF(WORD)570,860,505
505 IOBX=IOBX+1
IOBJS(IOBX)=WORD
IOTXT(IOBX,1)=TXT(WDX,1)
IOTXT(IOBX,2)=TXT(WDX,2)
510 KK=IABS(PTAB(VRBKEY)/1000)
IF(KK.NE.PREP)GOTO 525
C PREP IS VALID WITH THIS VERB. NOW CHECK OBJECT OF PREP.
IF(WORD.EQ.0.OR.CLASS(WORD).EQ.CLASSC)GOTO 530
C AN OBJ FOLLOWS THE PREP. SEE IF IT'S PLAUSIBLE.
520 KK=IABS((MOD(PTAB(VRBKEY),0001000)))
IF(KK.EQ.WORD.AND.KK.EQ.ALL)GOTO 280
IF(KK.EQ.WORD.OR.KK.EQ.999)GOTO 90
525 VRBKEY=VRBKEY+1
IF(PTAB(VRBKEY-1).GE.0)GOTO 510
GOTO 570
C NO OBJ FOLLOWS PREP. CHECK SPECIAL CASES.
530 PFLAG=.FALSE.
WDX=WDX-1
DK=TXT(WDX,1)
DKK=VTXT(VRBX,1)
IF((DK.NE.'ON '.AND.DK.NE.'OFF ').AND.
1 (DKK.NE.'TURN '.OR.OBJS(OBJX).NE.LAMP) .AND.
2 (DKK.NE.'TAKE '.AND.DKK.NE.'PUT ') )GOTO 570
IF((DK.EQ.'UP '.AND.DKK.NE.'PICK ').OR.
1 (DK.EQ.'DOWN '.AND.(DKK.NE.'PUT '.AND.VERBS(VRBX).NE.THROW
2 )))GOTO 570
WDX=WDX+1
WORD=WORDS(WDX)
IF(WORD.EQ.0)GOTO 900
IF(CLASS(WORD).NE.CLASSC)GOTO 800
GOTO 91
C YOU CAN'T DO THAT!!
570 SPK=NOWAY(0)
GOTO 810
C ADJECTIVE HANDLER.
C SCARF THE NEXT WORD, MAKE SURE IT IS A VALID OBJECT FOR THIS ADJ.
C THEN CALL GETOBJ TO SEE IF IT IS REALLY THERE, THEN LINK INTO OBJ
C CODE.
600 ADJ=VAL(WORD)
WDX=WDX+1
WORD=WORDS(WDX)
IF(WORD)840,640,605
605 IF(CLASS(WORD).EQ.CLASSC) GOTO 640
IF(CLASS(WORD).NE.CLASSN) WORD=VOCABX(TXT(WDX,1),-(CLASSN+1))
IF(WORD.EQ.-1.OR.CLASS(WORD).NE.CLASSN.OR.VAL(WORD).EQ.ALL)
1 GOTO 800
WORDS(WDX)=WORD
KK=VAL(WORD)
K=ADJKEY(ADJ)
610 IF(KK.EQ.IABS(ADJTAB(K)))GOTO 92
IF(ADJTAB(K).LT.0)GOTO 800
K=K+1
GOTO 610
640 CALL A5TOA1(TXT(WDX-1,1),TXT(WDX-1,2),'_WHAT?',ZAPP,K)
WRITE(*,642)(ZAPP(I),I=1,K)
642 FORMAT(1X, 20A1)
GOTO 20
C ANALYZE A CONJUNCTION. MAY BE A COMMA OR AN EXPLICIT "AND".
C LOOK AHEAD AT NEXT WORD. IF IT IS AN ACTION VERB AND NO OBJECT
C HAS YET BEEN SPECIFIED, PUT IT INTO THE VERB STACK. IF IT IS
C AN OBJECT, ADD IT TO THE PILE.
C ELSE, BUMP BACK THE WORD POINTER, ASSUME END OF CLAUSE, AND
C RETURN.
700 WDX=WDX+1
WORD=WORDS(WDX)
IF(WORD)840,800,710
710 GOTO(790,92,720,790,800,92,800),CLASS(WORD)
C A NEW ACTION VERB FOLLOWS. IF NO PREVIOUS VERB HAS BEEN TYPED,
C HE LOSES. IF PREVIOUS VERB IS NOT AN ACTION VERB, HE LOSES.
C IF AN OBJ/IOBJ WAS SPECIFIED FOR PREV ACT VERB, HE LOSES. ONLY
C VALID SYNTAX IS: 'GET AND OPEN CAGE'.
720 IF(VRBX.NE.0.AND.CLASS(VERBS(VRBX)).EQ.CLASSA
1 .AND.OBJX.EQ.0.AND.IOBX.EQ.0)GOTO 92
790 WDX=WDX-1
GOTO 900
C GEE, I DON'T UNDERSTAND. FLUSH REST OF CURRENT CLAUSE, UP TO
C EOL OR CONJUNCTION & CONTINUE.
800 SPK=CONFUZ(0)
810 CALL RSPEAK(SPK)
820 CALL CLRLIN
GOTO 20
C AN IRREGULAR WORD WAS TYPED IN BY USER. CHECK FOR WIZARDRY.
830 CONTINUE
840 CONTINUE
841 IF(PCT(25))GOTO 850
CALL A5TOA1(TXT(WDX,1),TXT(WDX,2),'. ',ZAPP,K)
WRITE(*,842)(ZAPP(I),I=1,K)
842 FORMAT(/' I don''t understand the word ',20A1)
CALL CLRLIN
GOTO 20
850 CALL A5TOA1(TXT(WDX,1),TXT(WDX,2),'? ',ZAPP,K)
WRITE(*,852)(ZAPP(I),I=1,K)
852 FORMAT(/' Mumble? ',20A1)
CALL CLRLIN
GOTO 20
C SCAN TO CONJ OR END OF LINE.
860 CALL CLRLIN
PFLAG=.FALSE.
862 WDX=WDX+1
IF(WORDS(WDX).EQ.0)GOTO 20
IF(CLASS(WORDS(WDX)).EQ.CLASSC)GOTO 90
GOTO 862
C END OF CLAUSE. WE APPEAR TO HAVE REACHED THE END OF A SENTENCE.
C IT WAS TERMINATED EITHER BY CRLF OR A CONJUNCTION. IF A CONJ,
C THE CONJ ANALYZER CLAIMS THAT THE NEXT WORDS ARE NOT PART OF
C THIS CLAUSE. DECIDE WHETHER OR NOT WE HAVE ENOUGH TO WORK WITH.
900 PFLAG=.FALSE.
IF(VERBS(1).NE.0)GOTO 930
IF(OBJS(1).EQ.0)GOTO 800
IF(OBJS(2).NE.0)GOTO 920
CALL A5TOA1(OTXT(1,1),OTXT(1,2),'? ',ZAPP,K)
WRITE(*,915)(ZAPP(I),I=1,K)
915 FORMAT(/' What do you want to do with the ',20A1)
GOTO 20
920 WRITE(*,*)' What do you want to do with them'
GOTO 20
930 IF(OBJX.GT.1.AND.IOBX.GT.1)GOTO 800
RETURN
END
C*** HERE .TRUE. IF OBJ AT THIS LOCATION
LOGICAL FUNCTION HERE(OBJ)
C HERE(OBJ) = TRUE IF THE OBJ IS AT "LOC" (OR IS BEING CARRIED)
IMPLICIT INTEGER(A-Z)
COMMON /LOCCOM/ LOC,OLDLOC,OLDLC2,NEWLOC,MAXLOC
COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150),
1 FIXED(150),MAXOBJ
LOGICAL TOTING
HERE = .FALSE.
IF(OBJ.LT.1.OR.OBJ.GT.MAXOBJ)RETURN
HERE=PLACE(OBJ).EQ.LOC.OR.TOTING(OBJ)
RETURN
END
C*** HINGED .TRUE. IF OBJ CAN BE OPENED
LOGICAL FUNCTION HINGED(OBJ)
C HINGED(OBJ) = TRUE IF OBJECT CAN BE OPENED/SHUT.
IMPLICIT INTEGER(A-Z)
LOGICAL BITSET
COMMON /CONCOM/ LOCCON(250),OBJCON(150)
HINGED=BITSET(OBJCON(OBJ),1)
RETURN
END
C*** HOLDNG .TRUE. IF HOLDING OBJ
LOGICAL FUNCTION HOLDNG(OBJ)
C HOLDNG(OBJ) = TRUE IF THE OBJ IS BEING CARRIED IN HAND.
IMPLICIT INTEGER(A-Z)
COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150),
1 FIXED(150),MAXOBJ
HOLDNG = .FALSE.
IF(OBJ.LT.1.OR.OBJ.GT.MAXOBJ)RETURN
HOLDNG=PLACE(OBJ).EQ.-1
RETURN
END
C*** INSERT
SUBROUTINE INSERT(OBJECT,CONTNR)
IMPLICIT INTEGER(A-Z)
COMMON /HLDCOM/ HOLDER(150),HLINK(150)
COMMON /LOCCOM/ LOC,OLDLOC,OLDLC2,NEWLOC,MAXLOC
COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150),
1 FIXED(150),MAXOBJ
IF(CONTNR.EQ.OBJECT)CALL BUG(32)
CALL CARRY(OBJECT,LOC)
TEMP=HOLDER(CONTNR)
HOLDER(CONTNR)=OBJECT
HLINK(OBJECT)=TEMP
PLACE(OBJECT)=-CONTNR
RETURN
END
C*** INSIDE .TRUE. IF LOCATION IS WELL WITHIN THE CAVE
LOGICAL FUNCTION INSIDE(LOC)
C INSIDE(LOC) = TRUE IF LOCATION IS WELL WITHIN THE CAVE
IMPLICIT INTEGER(A-Z)
LOGICAL OUTSID,PORTAL
INSIDE=.NOT.OUTSID(LOC).AND..NOT.PORTAL(LOC)
RETURN
END
C*** JUGGLE
SUBROUTINE JUGGLE(OBJECT)
C JUGGLE AN OBJECT BY PICKING IT UP AND PUTTING IT DOWN AGAIN, THE PURPOSE
C BEING TO GET THE OBJECT TO THE FRONT OF THE CHAIN OF THINGS AT ITS LOC.
IMPLICIT INTEGER(A-Z)
COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150),
1 FIXED(150),MAXOBJ
I=PLACE(OBJECT)
J=FIXED(OBJECT)
CALL MOVE(OBJECT,I)
CALL MOVE(OBJECT+MAXOBJ,J)
RETURN
END
C*** LIQ
INTEGER FUNCTION LIQ(OBJ)
IMPLICIT INTEGER(A-Z)
COMMON /LIQCOM/ BOTTLE,CASK,WATER,OIL,WINE,LIQTYP(5)
COMMON /OBJCOM/ PLAC(150),FIXD(150),WEIGHT(150),PROP(150),
1 POINTS(150)
C LIQ=LIQ2(MAX0(PROP(OBJ),-1-PROP(OBJ)))
LIQ = 0
IF(OBJ.NE.BOTTLE.AND.OBJ.NE.CASK)RETURN
IQ = MAX0(PROP(OBJ)+1,-1-(PROP(OBJ)+1))
IF(IQ.LE.0)RETURN
LIQ=LIQTYP(IQ)
RETURN
END
C*** LIQ2
C NON-LOGICAL (ILLOGICAL?) FUNCTIONS (CLASS,LIQ,LIQ2,LIQLOC,VAL)
INTEGER FUNCTION LIQ2(PBOTL)
IMPLICIT INTEGER(A-Z)
COMMON /LIQCOM/ BOTTLE,CASK,WATER,OIL,WINE,LIQTYP(5)
LIQ2=(1-PBOTL)*WATER+(PBOTL/2)*(WATER+OIL)+(PBOTL/4)
1 *(WATER+WINE-2*OIL)
RETURN
END
C*** LIQLOC
INTEGER FUNCTION LIQLOC(LOC)
IMPLICIT INTEGER(A-Z)
COMMON /LIQCOM/ BOTTLE,CASK,WATER,OIL,WINE,LIQTYP(5)
INTEGER WRD(2)
COMMON /CONCOM/ LOCCON(250),OBJCON(150)
EQUIVALENCE (LOCCON,WRD)
C CALL TOOCT(LOCCON(LOC))
C CALL TOOCT(WRD(LOC*2))
LIQLOC=LIQ2((MOD(LOCCON(LOC)/8,2)*(MOD(LOCCON(LOC)/2*2,16)-9)
1 +1))
RETURN
END
C*** LIVING .TRUE. IF OBJ IS LIVING, BEAR FOR EXAMPLE
LOGICAL FUNCTION LIVING(OBJ)
C LIVING(OBJ) = TRUE IF OBJ IS SOME SORT OF CRITTER
IMPLICIT INTEGER(A-Z)
LOGICAL BITSET
COMMON /CONCOM/ LOCCON(250),OBJCON(150)
LIVING=BITSET(OBJCON(OBJ),9)
RETURN
END
C*** LOCKED .TRUE. IF LOCKABLE OBJ IS LOCKED
LOGICAL FUNCTION LOCKED(OBJ)
IMPLICIT INTEGER(A-Z)
LOGICAL BITSET
COMMON/CONCOM/LOCCON(250),OBJCON(150)
LOCKED=BITSET(OBJCON(OBJ),4)
RETURN
END
C*** LOCKS .TRUE. IF YOU CAN LOCK THIS OBJ
LOGICAL FUNCTION LOCKS(OBJ)
IMPLICIT INTEGER(A-Z)
LOGICAL BITSET
COMMON/CONCOM/LOCCON(250),OBJCON(150)
LOCKS=BITSET(OBJCON(OBJ),3)
RETURN
END
C*** LOOKIN
SUBROUTINE LOOKIN(CONTNR)
C LIST CONTENTS IF OBJ IS A CONTAINER AND IS OPEN OR TRANSPARENT.
C SAVE INITIAL VALUE OF BLKLIN THRU SUBROUTINE.
IMPLICIT INTEGER(A-Z)
COMMON /BLKCOM/ BLKLIN
COMMON /HLDCOM/ HOLDER(150),HLINK(150)
LOGICAL VESSEL,AJAR,OPAQUE,BLKLIN,BSAVE
DIMENSION TK(20)
IF(.NOT.VESSEL(CONTNR).OR.
1 (.NOT.AJAR(CONTNR).AND.OPAQUE(CONTNR)) )RETURN
TEMP=HOLDER(CONTNR)
LOOP=0
BSAVE=BLKLIN
20 IF(TEMP.EQ.0)RETURN
BLKLIN=.FALSE.
IF(LOOP.EQ.0)CALL RSPEAK(360)
CALL TNOUA
CALL PSPEAK(TEMP,-1)
BLKLIN=BSAVE
TEMP=HLINK(TEMP)
LOOP=-1
GOTO 20
END
SUBROUTINE MOVE(OBJECT,WHERE)
C PLACE ANY OBJECT ANYWHERE BY PICKING IT UP AND DROPPING IT. MAY ALREADY BE
C TOTING, IN WHICH CASE THE CARRY IS A NO-OP. MUSTN'T PICK UP OBJECTS WHICH
C ARE NOT AT ANY LOC, SINCE CARRY WANTS TO REMOVE OBJECTS FROM ATLOC CHAINS.
IMPLICIT INTEGER(A-Z)
COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150),
1 FIXED(150),MAXOBJ
LOGICAL ENCLSD
IF(OBJECT.GT.MAXOBJ)THEN
FROM=FIXED(OBJECT-MAXOBJ)
ELSE
IF(ENCLSD(OBJECT))CALL REMOVE(OBJECT)
FROM=PLACE(OBJECT)
ENDIF
IF(FROM.GT.0.AND.FROM.LE.MAXOBJ*2)CALL CARRY(OBJECT,FROM)
CALL DROP(OBJECT,WHERE)
RETURN
END
C*** NOWAY
INTEGER FUNCTION NOWAY(DUMMY)
C GENERATE'S SOME VARIANT OF "CAN'T DO THAT" MESSAGE.
IMPLICIT INTEGER(A-Z)
LOGICAL PCT
NOWAY=14
IF(PCT(50))NOWAY=110
IF(PCT(33))NOWAY=147
IF(PCT(25))NOWAY=250
IF(PCT(20))NOWAY=262
IF(PCT(17))NOWAY=25
IF(PCT(14))NOWAY=345
IF(PCT(12))NOWAY=346
RETURN
END
C*** OPAQUE .TRUE. IF OBJ IS NON-TRANSPARENT CONTAINER
LOGICAL FUNCTION OPAQUE(OBJ)
C OPAQUE(OBJ) = TRUE IF OBJECT IS NOT TRANSPARENT. E.G., BAG & CHEST ARE OPAQ
C WICKER CAGE & GLASS BOTTLE ARE TRANSPARENT.
IMPLICIT INTEGER(A-Z)
LOGICAL BITSET
COMMON /CONCOM/ LOCCON(250),OBJCON(150)
OPAQUE=BITSET(OBJCON(OBJ),6)
RETURN
END
C*** OUTSID .TRUE. IF LOCATION IS OUTSIDE THE CAVE
LOGICAL FUNCTION OUTSID(LOC)
C OUTSID(LOC) = TRUE IF LOCATION IS OUTSIDE THE CAVE
IMPLICIT INTEGER(A-Z)
LOGICAL BITSET
COMMON /CONCOM/ LOCCON(250),OBJCON(150)
OUTSID=BITSET(LOCCON(LOC),6)
RETURN
END
C*** PCT
LOGICAL FUNCTION PCT(N)
C PCT(N) = TRUE N% OF THE TIME (N INTEGER FROM 0 TO 100)
IMPLICIT INTEGER(A-Z)
PCT=RANZ(100).LT.N
RETURN
END
C*** PLURAL .TRUE. IF OBJ IS MULTIPLE OBJS
LOGICAL FUNCTION PLURAL(OBJ)
C PLURAL(OBJ) = TRUE IF OBJECT IS A "BUNCH" OF THINGS (COINS, SHOES).
IMPLICIT INTEGER(A-Z)
LOGICAL BITSET
COMMON /CONCOM/ LOCCON(250),OBJCON(150)
PLURAL=BITSET(OBJCON(OBJ),13)
RETURN
END
C*** PORTAL .TRUE. IF LOCATION IS IN CAVE ENTRANCE
LOGICAL FUNCTION PORTAL(LOC)
C PORTAL(LOC) = TRUE IS LOCATION IS IN CAVE "ENTRANCE"
IMPLICIT INTEGER(A-Z)
LOGICAL BITSET
COMMON /CONCOM/ LOCCON(250),OBJCON(150)
PORTAL=BITSET(LOCCON(LOC),5)
RETURN
END
C*** PRINTD .TRUE. IF OBJ CAN BE READ
LOGICAL FUNCTION PRINTD(OBJ)
C PRINTD(OBJ) = TRUE IF OBJECT CAN BE READ.
IMPLICIT INTEGER(A-Z)
LOGICAL BITSET
COMMON /CONCOM/ LOCCON(250),OBJCON(150)
PRINTD=BITSET(OBJCON(OBJ),8)
RETURN
END
C*** PSPEAK
SUBROUTINE PSPEAK(MSG,SKIP)
C FIND THE SKIP+1ST MESSAGE FROM MSG AND PRINT IT. MSG SHOULD BE THE INDEX OF
C THE INVENTORY MESSAGE FOR OBJECT. (INVEN+N+1 MESSAGE IS PROP=N MESSAGE).
IMPLICIT INTEGER(A-Z)
COMMON /TXTCOM/ LINES(25000),RTEXT(450),PTEXT(150)
M=PTEXT(MSG)
IF(SKIP.LT.0)GOTO 9
DO 3 I=0,SKIP
1 M=IABS(LINES(M))
IF(LINES(M).GE.0)GOTO 1
3 CONTINUE
9 CALL SPEAK(M)
RETURN
END
C*** PUT
INTEGER FUNCTION PUT(OBJECT,WHERE,PVAL)
C PUT IS THE SAME AS MOVE, EXCEPT IT RETURNS A VALUE USED TO SET UP THE
C NEGATED PROP VALUES FOR THE REPOSITORY OBJECTS.
IMPLICIT INTEGER(A-Z)
CALL MOVE(OBJECT,WHERE)
PUT=(-1)-PVAL
RETURN
END
C*** RANZ
C UTILITY ROUTINES (SHIFT, RAN, DATIME, CIAO, BUG, LOG)
INTEGER FUNCTION RANZ(RANGE)
IMPLICIT INTEGER (A-Z)
SAVE
DATA SEED/12345/
SEED = SEED*69069+1
I = 16384/RANGE
J = IABS(SEED)/I
RANZ = MOD(J,RANGE)
RETURN
END
C*** RATING
SUBROUTINE RATING(SCORE,BONUS,GAVEUP,SCORNG,CLOSNG,CLOSED
1 ,HNTMAX)
C CALCULATE WHAT THE PLAYER'S SCORE WOULD BE IF HE QUIT NOW.
C THIS MAY BE THE END OF THE GAME, OR HE MAY JUST BE WONDERING
C HOW HE IS DOING.
IMPLICIT INTEGER(A-Z)
LOGICAL TREASR,GAVEUP,CLOSNG,CLOSED,SCORNG,HINTED,KILLED
COMMON /MNECOM/ BACK,CAVE,DPRSSN,ENTRNC,EXIT,GO,LOOK,NULL,
1 AXE,BEAR,BOAT,BOOK,BOOK2,BOOTH,CARVNG,CHASM,CHASM2,DOOR,GNOME,
2 GRATE,LAMP,PDOOR,PLANT,PLANT2,ROCKS,ROD,ROD2,SAFE,
3 TDOOR,TDOOR2,TROLL,TROLL2,EMRALD,SPICES,
4 FIND,YELL,INVENT,LEAVE,POUR,SAY,TAKE,THROW,
5 IWEST,PHUCE(2,4),TK(20)
COMMON /DIECOM/ NUMDIE,MAXDIE,TURNS,KILLED
COMMON /DWFCOM/ DWARF,KNIFE,KNFLOC,DFLAG,DSEEN(6),DLOC(6),
1 ODLOC(6),DWFMAX
COMMON /HNTCOM/ HINTLC(20),HINTED(20),HINTS(20,4),HNTSIZ,HNTMIN
COMMON /OBJCOM/ PLAC(150),FIXD(150),WEIGHT(150),PROP(150),
1 POINTS(150)
COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150),
1 FIXED(150),MAXOBJ
COMMON /SV2COM/ANVIL,BATTER,BEES,BILLBD,BIRD,BRUSH,CAGE,
1 CAKES,CHAIN,CHEST,CHLOC,CHLOC2,CLAM,CLOAK,CLSSES,COINS,CROWN,
2 DALTLC,DOG,DRAGON,EGGS,FISSUR,FLOWER,GATLOC,GRAIL,HIVE,
3 HONEY,HORN,JEWELS,KEYS,LYRE,
4 MAGZIN,MIRROR,MUSHRM,MXSCOR,NUGGET,OYSTER,PEARL,PHONE,
5 PILLOW,POLE,POSTER,PREPAT,PREPDN,PREPFR,PREPIN,PREPOF,
6 PREPON,PYRAM,RADIUM,RING,RUG,SAPPHI,SHIELD,SHOES,
7 SHUT,SLUGS,SNAKE,SPHERE,STEPS,STICKS,SWORD,TABLET,TRIDNT,
8 UNLOCK,VASE,WALL,WALL2,WEAR,WUMPUS,Y2,YANK
DIMENSION QK(20)
C THE PRESENT SCORING ALGORITHM IS AS FOLLOWS:
C (TREASURE POINTS ARE EXPLAINED IN A FOLLOWING COMMENT)
C OBJECTIVE: POINTS: PRESENT TOTAL POSSIBLE:
C GETTING WELL INTO CAVE 25 25
C TOTAL POSSIBLE FOR TREASURES (+MAG) 426
C SURVIVING (MAX-NUM)*10 30
C NOT QUITTING 4 4
C REACHING "CLOSNG" 20 20
C "CLOSED": QUIT/KILLED 10
C KLUTZED 20
C WRONG WAY 25
C SUCCESS 30 30
C ROUND OUT THE TOTAL 16 16
C TOTAL: 551
C (POINTS CAN ALSO BE DEDUCTED FOR USING HINTS.)
SCORE=0
MXSCOR=0
C FIRST TALLY UP THE TREASURES. MUST BE IN BUILDING AND NOT BROKEN.
C GIVE THE POOR GUY PARTIAL SCORE JUST FOR FINDING EACH TREASURE.
C GETS FULL SCORE, QK(3), FOR OBJ IF:
C OBJ IS AT LOC QK(1), AND
C OBJ HAS PROP VALUE OF QK(2)
C
C WEIGHT TOTAL POSSIBLE
C MAGAZINE 1 (ABSOLUTE) 1
C
C ALL THE FOLLOWING ARE MULTIPLIED BY 5 (RANGE 5-25):
C BOOK 2
C CASK 3 (WITH WINE ONLY)
C CHAIN 4 (MUST ENTER VIA STYX)
C CHEST 5
C CLOAK 3
C CLOVER 1
C COINS 5
C CROWN 2
C CRYSTAL-BALL 2
C DIAMONDS 2
C EGGS 3
C EMERALD 3
C GRAIL 2
C HORN 2
C JEWELS 1
C LYRE 1
C NUGGET 2
C PEARL 4
C PYRAMID 4
C RADIUM 4
C RING 4
C RUG 3
C SAPPHIRE 1
C SHOES 3
C SPICES 1
C SWORD 4
C TRIDENT 2
C VASE 2
C DROPLET 5
C TREE 5
C TOTAL: 85 * 5 = 425 + 1 ==> 426
DO 1010 OBJ=1,MAXOBJ
IF(POINTS(OBJ).EQ.0)GOTO 1010
QK(3)=IABS(POINTS(OBJ))/1000000
QK(2)=(IABS(POINTS(OBJ))-QK(3)*1000000)/1000
QK(1)=IABS(POINTS(OBJ))-QK(3)*1000000-QK(2)*1000
IF(POINTS(OBJ).LT.0) QK(1)=-QK(1)
K=0
IF(.NOT.TREASR(OBJ))GOTO 1007
K=QK(3)*2
IF(PROP(OBJ).GE.0)SCORE=SCORE+K
QK(3)=QK(3)*5
1007 IF(PLACE(OBJ).EQ.QK(1).AND.PROP(OBJ).EQ.QK(2).AND.
1 (PLACE(OBJ).NE.-CHEST.OR.PLACE(CHEST).EQ.3).AND.
2 (PLACE(OBJ).NE.-SHIELD.OR.PLACE(SHIELD).EQ.-SAFE))
3 SCORE=SCORE+QK(3)-K
MXSCOR=MXSCOR+QK(3)
1010 CONTINUE
C NOW LOOK AT HOW HE FINISHED AND HOW FAR HE GOT. MAXDIE AND NUMDIE TELL US
C HOW WELL HE SURVIVED. GAVEUP SAYS WHETHER HE EXITED VIA QUIT. DFLAG WILL
C TELL US IF HE EVER GOT SUITABLY DEEP INTO THE CAVE. CLOSNG STILL INDICATES
C WHETHER HE REACHED THE ENDGAME. AND IF HE GOT AS FAR AS "CAVE CLOSED"
C (INDICATED BY "CLOSED"), THEN BONUS IS ZERO FOR MUNDANE EXITS OR 133, 134,
C 135 IF HE BLEW IT (SO TO SPEAK).
ASCORE=(MAXDIE-NUMDIE)*10
MXSCOR=MXSCOR+MAXDIE*10
IF(.NOT.(SCORNG.OR.GAVEUP))ASCORE=ASCORE+4
MXSCOR=MXSCOR+4
IF(DFLAG.NE.0)ASCORE=ASCORE+25
MXSCOR=MXSCOR+25
IF(CLOSNG)ASCORE=ASCORE+20
MXSCOR=MXSCOR+20
IF(.NOT.CLOSED)GOTO 1020
IF(BONUS.EQ.0)ASCORE=ASCORE+10
IF(BONUS.EQ.135)ASCORE=ASCORE+20
IF(BONUS.EQ.134)ASCORE=ASCORE+25
IF(BONUS.EQ.133)ASCORE=ASCORE+30
1020 MXSCOR=MXSCOR+30
C ROUND IT OFF.
ASCORE=ASCORE+16
MXSCOR=MXSCOR+16
C DEDUCT POINTS FOR HINTS. HINTS < HNTMIN ARE SPECIAL; SEE DATABASE DESCRIPTIO
DO 1030 I=1,HNTMAX
1030 IF(HINTED(I))SCORE=SCORE-HINTS(I,2)
JTURNS=TURNS/100
IF(JTURNS.EQ.0)ASCORE=0
IF(JTURNS.EQ.1)ASCORE=ASCORE/3
IF(JTURNS.EQ.2)ASCORE=(ASCORE*2)/3
SCORE=SCORE+ASCORE
IF(SCORE.LT.0) SCORE=0
RETURN
END
C*** REMOVE
SUBROUTINE REMOVE(OBJECT)
IMPLICIT INTEGER(A-Z)
COMMON /HLDCOM/ HOLDER(150),HLINK(150)
COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150),
1 FIXED(150),MAXOBJ
CONTNR=-PLACE(OBJECT)
PLACE(OBJECT)=-1
IF(HOLDER(CONTNR).NE.OBJECT)GOTO 1
HOLDER(CONTNR)=HLINK(OBJECT)
RETURN
1 TEMP=HOLDER(CONTNR)
2 IF(HLINK(TEMP).EQ.OBJECT)GOTO 3
TEMP=HLINK(TEMP)
GOTO 2
3 HLINK(TEMP)=HLINK(OBJECT)
RETURN
END
C*** RSPEAK
SUBROUTINE RSPEAK(I)
C PRINT THE I-TH "RANDOM" MESSAGE (SECTION 6 OF DATABASE).
IMPLICIT INTEGER(A-Z)
COMMON /TXTCOM/ LINES(25000),RTEXT(450),PTEXT(150)
IF(I.LE.0)RETURN
M=RTEXT(I)
CALL SPEAK(M)
RETURN
END
C*** SMALL .TRUE. IF IT FITS IN SACK OR SMALL CONTAINER
LOGICAL FUNCTION SMALL(OBJ)
IMPLICIT INTEGER(A-Z)
LOGICAL BITSET
COMMON/CONCOM/LOCCON(250),OBJCON(150)
SMALL=BITSET(OBJCON(OBJ),5)
RETURN
END
C*** SPEAK
SUBROUTINE SPEAK(N)
C PRINT THE MESSAGE WHICH STARTS AT LINES(N). PRECEDE IT WITH A BLANK LINE
C UNLESS BLKLIN IS FALSE.
IMPLICIT INTEGER(A-Z)
LOGICAL BLKLIN
COMMON /TNOUX/INDENT
COMMON /TXTCOM/ LINES(25000),RTEXT(450),PTEXT(150)
COMMON /BLKCOM/ BLKLIN
DIMENSION OLINE(30)
C DATA ZCLYD/'CLYD'/,ZLS/'<$$<'/
C ZCLYD = 0
C ZCLYD = 37+256*(9+256*(20+256*15))
ZCLYD = ICHAR('c')+256*(ICHAR('L')+ 256*(ICHAR('y')
1 +256*ICHAR('D')))
ZLS = 60+256*(36+256*(36+256*60))
XCLYD=IEOR(ZCLYD,ZLS)
100 IF(N.EQ.0)GOTO 145
IF(LINES(N+1).EQ.XCLYD)GOTO 4
K=N
1 CONTINUE
L=IABS(LINES(K))-K-1
DO 2 I=1,L
2 OLINE(I)=IEOR(LINES(K+I),ZCLYD)
IF(INDENT.EQ.0)WRITE(*,3) (OLINE(I),I=1,L)
IF(INDENT.EQ.1)WRITE(*,133)(OLINE(I),I=1,L)
133 FORMAT(6X,19A4)
3 FORMAT(' ',19A4)
K=K+L+1
IF(LINES(K).GE.0)GOTO 1
4 CONTINUE
145 INDENT=0
RETURN
END
C A HORRIBLE KLUDGE
SUBROUTINE TNOUA
INTEGER INDENT
COMMON /TNOUX/INDENT
INDENT=1
RETURN
END
C*** TOTING .TRUE. IF OBJ SOMEWHERE ON PERSON
LOGICAL FUNCTION TOTING(OBJ)
C TOTING(OBJ) = TRUE IF THE OBJ IS BEING CARRIED (IN HAND OR
C CONTAINER). OBJ MAY NOT BE REACHABLE. SEE
C ALSO: ENCLSD, ATHAND, HOLDNG.
IMPLICIT INTEGER(A-Z)
COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150),
1 FIXED(150),MAXOBJ
LOGICAL HOLDNG,ENCLSD,AAA,BBB,CCC
TOTING = .FALSE.
IF(HOLDNG(OBJ))THEN
TOTING = .TRUE.
RETURN
ENDIF
CONTNR=-PLACE(OBJ)
IF(CONTNR.LE.0)RETURN
IF(HOLDNG(CONTNR))THEN
TOTING = .TRUE.
RETURN
ENDIF
OUTER=-PLACE(CONTNR)
IF(OUTER.LE.0)RETURN
IF(HOLDNG(OUTER))THEN
TOTING = .TRUE.
RETURN
ENDIF
OUTER2=-PLACE(OUTER)
IF(OUTER2.LE.0)RETURN
IF(HOLDNG(OUTER2))THEN
TOTING = .TRUE.
RETURN
ENDIF
RETURN
END
C*** TRAVL
C FIGURE OUT THE NEW LOCATION
C
C GIVEN THE CURRENT LOCATION IN "LOC", AND A MOTION VERB NUMBER IN "K", PUT
C THE NEW LOCATION IN "NEWLOC". THE CURRENT LOC IS SAVED IN "OLDLOC" IN CASE
C HE WANTS TO RETREAT. THE CURRENT OLDLOC IS SAVED IN OLDLC2, IN CASE HE
C DIES. (IF HE DOES, NEWLOC WILL BE LIMBO, AND OLDLOC WILL BE WHAT KILLED
C HIM, SO WE NEED OLDLC2, WHICH IS THE LAST PLACE HE WAS SAFE.)
SUBROUTINE TRAVL(K,BCROSS,TALLY2)
IMPLICIT INTEGER(A-Z)
LOGICAL KILLED,PCT,HOLDNG,ENCLSD
LOGICAL INSIDE,OUTSID,PORTAL,TOTING,HERE,AT,FORCED
COMMON /DIECOM/ NUMDIE,MAXDIE,TURNS,KILLED
COMMON /TRVCOM/ TRAVEL(1600)
COMMON /LTXCOM/ LTEXT(250),STEXT(250),KEY(250),ABB(250),LOCSIZ
COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150),
1 FIXED(150),MAXOBJ
COMMON /OBJCOM/ PLAC(150),FIXD(150),WEIGHT(150),PROP(150),
1 POINTS(150)
COMMON /LOCCOM/ LOC,OLDLOC,OLDLC2,NEWLOC,MAXLOC
COMMON /MNECOM/ BACK,CAVE,DPRSSN,ENTRNC,EXIT,GO,LOOK,NULL,
1 AXE,BEAR,BOAT,BOOK,BOOK2,BOOTH,CARVNG,CHASM,CHASM2,DOOR,GNOME,
2 GRATE,LAMP,PDOOR,PLANT,PLANT2,ROCKS,ROD,ROD2,SAFE,
3 TDOOR,TDOOR2,TROLL,TROLL2,EMRALD,SPICES,
4 FIND,YELL,INVENT,LEAVE,POUR,SAY,TAKE,THROW,
5 IWEST,PHUCE(2,4),TK(20)
KILLED=.FALSE.
KK=KEY(LOC)
NEWLOC=LOC
IF(KK.EQ.0)CALL BUG(26)
IF(K.EQ.NULL)RETURN
IF(K.EQ.BACK)GOTO 20
IF(K.EQ.CAVE)GOTO 40
OLDLC2=OLDLOC
OLDLOC=LOC
9 LL=IABS(TRAVEL(KK))
IF(MOD(LL,0001000).EQ.1.OR.MOD(LL,0001000).EQ.K)
1 GOTO 10
IF(TRAVEL(KK).LT.0000000)GOTO 50
KK=KK+1
GOTO 9
10 LL=LL/0001000
11 NEWLOC=LL/0001000
K=MOD(NEWLOC,100)
IF(NEWLOC.LE.MAXLOC)GOTO 13
IF(PROP(K).NE.NEWLOC/100-3)GOTO 16
12 IF(TRAVEL(KK).LT.0)CALL BUG(25)
KK=KK+1
NEW1=IABS(TRAVEL(KK))/1000
IF(NEW1.EQ.LL)GOTO 12
LL=NEW1
GOTO 11
13 IF(NEWLOC.LE.100)GOTO 14
IF(TOTING(K).OR.(NEWLOC.GT.200.AND.AT(K)))GOTO 16
GOTO 12
14 IF(NEWLOC.NE.0.AND..NOT.PCT(NEWLOC))GOTO 12
16 NEWLOC=MOD(LL,1000)
IF(NEWLOC.LE.MAXLOC)GO TO 2000
IF(NEWLOC.LE.500)GOTO 30000
CALL RSPEAK(NEWLOC-500)
NEWLOC=LOC
RETURN
C HANDLE "GO BACK". LOOK FOR VERB WHICH GOES FROM LOC TO OLDLOC, OR TO OLDLC2
C IF OLDLOC HAS FORCED-MOTION. K2 SAVES ENTRY -> FORCED LOC -> PREVIOUS LOC.
20 K=OLDLOC
IF(FORCED(K))K=OLDLC2
OLDLC2=OLDLOC
OLDLOC=LOC
K2=0
IF(K.NE.LOC)GOTO 21
CALL RSPEAK(91)
GO TO 2000
21 LL=MOD((IABS(TRAVEL(KK))/1000),1000)
IF(LL.EQ.K)GOTO 25
IF(LL.GT.MAXLOC)GOTO 22
J=KEY(LL)
IF(FORCED(LL).AND.MOD((IABS(TRAVEL(J))/1000),1000).EQ.K)
1 K2=KK
22 IF(TRAVEL(KK).LT.000000)GOTO 23
KK=KK+1
GOTO 21
23 KK=K2
IF(KK.NE.0)GOTO 25
CALL RSPEAK(140)
2000 IF(NEWLOC.LT.242.OR.NEWLOC.GT.247)RETURN
IF(NEWLOC.NE.242)GOTO 2010
KALFLG=0
RETURN
2010 IF(NEWLOC.NE.OLDLOC+1)GOTO 2020
KALFLG=KALFLG+1
RETURN
2020 KALFLG=-10
RETURN
25 K=MOD(IABS(TRAVEL(KK)),1000)
KK=KEY(LOC)
GOTO 9
C CAVE. DIFFERENT MESSAGES DEPENDING ON WHETHER ABOVE GROUND.
40 IF(OUTSID(LOC))CALL RSPEAK(57)
IF(.NOT.OUTSID(LOC))CALL RSPEAK(58)
RETURN
C NON-APPLICABLE MOTION. VARIOUS MESSAGES DEPENDING ON WORD GIVEN.
50 SPK=12
IF(K.GE.43.AND.K.LE.50)SPK=9
IF(K.EQ.29.OR.K.EQ.30)SPK=9
IF(K.EQ.7.OR.K.EQ.36.OR.K.EQ.37)SPK=10
IF(K.EQ.11.OR.K.EQ.19)SPK=11
IF(K.EQ.62.OR.K.EQ.65.OR.K.EQ.82)SPK=42
IF(K.EQ.17)SPK=80
CALL RSPEAK(SPK)
RETURN
C SPECIAL MOTIONS COME HERE. LABELLING CONVENTION: STATEMENT NUMBERS NNNXX
C (XX=00-99) ARE USED FOR SPECIAL CASE NUMBER NNN (NNN=301-500).
30000 NEWLOC=NEWLOC-MAXLOC
GOTO (30100,30200,30300,30400,30500,30600,30700),NEWLOC
C ALCOV PLOVR TROLL PHUCE BOOTH BRDGE
WRITE(*,1001)NEWLOC
1001 FORMAT('BUG IN TRAVEL TABLES. NEWLOC= ',I5)
CALL BUG(20)
C TRAVEL 301. PLOVER-ALCOVE PASSAGE. CAN CARRY ONLY EMERALD. NOTE: TRAVEL
C TABLE MUST INCLUDE "USELESS" ENTRIES GOING THROUGH PASSAGE, WHICH CAN NEVER
C BE USED FOR ACTUAL MOTION, BUT CAN BE SPOTTED BY "GO BACK".
30100 NEWLOC=99+100-LOC
KK=BURDEN(0)
IF(KK.EQ.0.OR.(KK.EQ.BURDEN(EMRALD).AND.HOLDNG(EMRALD)))RETURN
NEWLOC=LOC
CALL RSPEAK(117)
RETURN
C TRAVEL 302. PLOVER TRANSPORT. DROP THE EMERALD (ONLY USE SPECIAL TRAVEL IF
C TOTING IT), SO HE'S FORCED TO USE THE PLOVER-PASSAGE TO GET IT OUT. HAVING
C DROPPED IT, GO BACK AND PRETEND HE WASN'T CARRYING IT AFTER ALL.
30200 IF(ENCLSD(EMRALD))CALL REMOVE(EMRALD)
CALL DROP(EMRALD,LOC)
GOTO 12
C TRAVEL 303. TROLL BRIDGE. MUST BE DONE ONLY AS SPECIAL MOTION SO THAT
C DWARVES WON'T WANDER ACROSS AND ENCOUNTER THE BEAR. (THEY WON'T FOLLOW THE
C PLAYER THERE BECAUSE THAT REGION IS FORBIDDEN TO THE PIRATE.) IF
C PROP(TROLL)=1, HE'S CROSSED SINCE PAYING, SO STEP OUT AND BLOCK HIM.
C (STANDARD TRAVEL ENTRIES CHECK FOR PROP(TROLL)=0.) SPECIAL STUFF FOR BEAR.
30300 IF(PROP(TROLL).NE.1)GOTO 30310
CALL PSPEAK(TROLL,1)
PROP(TROLL)=0
CALL MOVE(TROLL2,0)
CALL MOVE(TROLL2+MAXOBJ,0)
CALL MOVE(TROLL,PLAC(TROLL))
CALL MOVE(TROLL+MAXOBJ,FIXD(TROLL))
CALL JUGGLE(CHASM)
NEWLOC=LOC
RETURN
30310 NEWLOC=PLAC(TROLL)+FIXD(TROLL)-LOC
IF(PROP(TROLL).EQ.0)PROP(TROLL)=1
IF(.NOT.HOLDNG(BEAR))RETURN
CALL RSPEAK(162)
PROP(CHASM)=1
PROP(TROLL)=2
CALL DROP(BEAR,NEWLOC)
FIXED(BEAR)=-1
PROP(BEAR)=3
IF(PROP(SPICES).LT.0)TALLY2=TALLY2+1
OLDLC2=NEWLOC
KILLED=.TRUE.
RETURN
C TRAVEL 304. GROWING OR SHRINKING IN AREA OF TINY DOOR. EACH TIME
C HE DOES THIS, EVERYTHING MUST BE MOVED TO THE NEW LOC. PRESUMABLY,
C ALL HIS POSSESIONS ARE SHRUNK OR STRECHED ALONG WITH HIM.
C PHUCE(2,4) IS AN ARRAY CONTAINING FOUR PAIRS OF "HERE" (K) AND
C "THERE" (KK) LOCATIONS.
30400 K=PHUCE(1,LOC-161+1)
NEWLOC=PHUCE(2,LOC-161+1)
DO 30410 OBJ=1,MAXOBJ
IF(OBJ.EQ.BOAT)GOTO 30410
IF(PLACE(OBJ).EQ.K.AND.(FIXED(OBJ).EQ.0.OR.FIXED(OBJ).EQ.-1))
1 CALL MOVE(OBJ,NEWLOC)
30410 CONTINUE
RETURN
C TRAVEL #5. PHONE BOOTH IN ROTUNDA.
C TRYING TO SHOVE PAST GNOME, TO GET INTO PHONE BOOTH.
30500 IF((PROP(BOOTH).EQ.0.AND.PCT(55)).OR.ABB(LOC).EQ.1)GOTO 30510
NEWLOC=189
IF(PROP(BOOTH).NE.1)RETURN
CALL RSPEAK(253)
GOTO 30512
30510 CALL RSPEAK(263)
PROP(BOOTH)=1
CALL MOVE(GNOME,188)
30512 NEWLOC=LOC
RETURN
C TRAVEL #6. COLLAPSING CLAY BRIDGE. HE CAN CROSS WITH THREE (OR FEWER)
C THINGS. IF MORE, OR IF CARRYING OBVIOUSLY HEAVY THINGS, HE MAY END UP
C IN THE DRINK.
30600 NEWLOC=235
IF(LOC.EQ.235)NEWLOC=190
BCROSS=BCROSS+1
KK=BURDEN(0)
IF(KK.LE.4)RETURN
K=MAX0( ((KK+BCROSS)**2)/10, 10)
30605 IF(PCT(K))GOTO 30610
CALL RSPEAK(318)
RETURN
30610 CALL RSPEAK(319)
NEWLOC=236
IF(HOLDNG(LAMP))CALL MOVE(LAMP,236)
IF(TOTING(AXE).AND.ENCLSD(AXE))CALL REMOVE(AXE)
IF(HOLDNG(AXE))CALL MOVE(AXE,208)
DO 30620 OBJ=1,MAXOBJ
30620 IF(TOTING(OBJ))CALL DSTROY(OBJ)
PROP(CHASM2)=1
RETURN
C THE KALEIDOSCOPE CODE IS HERE
30700 IF(KALFLG.NE.5)GOTO 30701
NEWLOC=248
OLDLOC=247
RETURN
30701 NEWLOC=242+RANZ(5)
OLDLOC=NEWLOC-1
CALL RSPEAK(406)
KALFLG=-10
IF(NEWLOC.EQ.242)KALFLG=0
RETURN
C END OF SPECIALS.
END
C*** TREASR .TRUE. IF OBJ IS VALUABLE FOR POINTS
LOGICAL FUNCTION TREASR(OBJ)
C TREASR(OBJ) = TRUE IF OBJECT IS A TREASURE
IMPLICIT INTEGER(A-Z)
LOGICAL BITSET
COMMON /CONCOM/ LOCCON(250),OBJCON(150)
TREASR=BITSET(OBJCON(OBJ),14)
RETURN
END
C*** VAL
INTEGER FUNCTION VAL(WORD)
C RETURNS THE 'VALUE' OF A WORD, MODULO 1000.
IMPLICIT INTEGER(A-Z)
VAL=MOD(WORD,1000)
RETURN
END
C*** VESSEL .TRUE. IF OBJ CAN HOLD A LIQUID
LOGICAL FUNCTION VESSEL(OBJ)
C VESSEL(OBJ) = TRUE IF OBJECT IS A CONTAINER
IMPLICIT INTEGER(A-Z)
LOGICAL BITSET
COMMON /CONCOM/ LOCCON(250),OBJCON(150)
VESSEL=BITSET(OBJCON(OBJ),15)
RETURN
END
C*** VOCABX
INTEGER FUNCTION VOCABX(ID,INIT)
C LOOK UP ID IN THE VOCABULARY (ATAB) AND RETURN ITS "DEFINITION" (KTAB
C -1 IF NOT FOUND. IF INIT IS POSITIVE, THIS IS AN INITIALISATION CALL
C UP A KEYWORD VARIABLE, AND NOT FINDING IT CONSTITUTES A BUG. IT ALSO
C THAT ONLY KTAB VALUES WHICH TAKEN OVER 1000 EQUAL INIT MAY BE CONSIDE
C (THUS "STEPS", WHICH IS A MOTION VERB AS WELL AS AN OBJECT, MAY BE LO
C AS AN OBJECT.) AND IT ALSO MEANS THE KTAB VALUE IS TAKEN MOD 1000.
IMPLICIT INTEGER(A-Z)
CHARACTER*6 ATAB,DTK,ID,VTXT,OTXT,IOTXT,TXT
COMMON /VOCCOM/ KTAB(600),TABSIZ
COMMON /SV3COM/DTK(9),ATAB(600),VTXT(45,2),OTXT(45,2),IOTXT(15,2)
1 ,TXT(35,2)
C HASH=ID.XOR.'PHROG' (DONE BY CALLER)
WDCLAS=INIT
IF(INIT.LT.0)WDCLAS=-INIT-1
DO 1 I=1,TABSIZ
IF(KTAB(I).EQ.-1)GOTO 2
IF(ATAB(I).NE.ID)GOTO 1
IF(CLASS(KTAB(I)).GE.WDCLAS)GOTO 3
1 CONTINUE
CALL BUG(21)
2 VOCABX=-1
IF(INIT.LT.0)RETURN
WRITE(*,4)ID
4 FORMAT (' VOCAB ERROR: CAN''T FIND WORD ''',A5,''' IN TABLE.')
CALL BUG(5)
3 VOCABX=KTAB(I)
IF(INIT.GE.0)VOCABX=MOD(VOCABX,1000)
RETURN
END
C*** WEARNG .TRUE. IF WEARING OBJ
LOGICAL FUNCTION WEARNG(OBJ)
C WEARNG(OBJ) = TRUE IF THE OBJ IS BEING WORN
IMPLICIT INTEGER(A-Z)
COMMON /BITCOM/ OPENBT,UNLKBT,BURNBT,WEARBT
COMMON /CONCOM/ LOCCON(250),OBJCON(150)
LOGICAL BITSET
WEARNG=BITSET(OBJCON(OBJ),WEARBT)
RETURN
END
C*** WORN .TRUE. IF OBJ IS BEING WORN
LOGICAL FUNCTION WORN(OBJ)
IMPLICIT INTEGER(A-Z)
LOGICAL BITSET
COMMON/CONCOM/LOCCON(250),OBJCON(150)
WORN=BITSET(OBJCON(OBJ),11)
RETURN
END
C*** YES
LOGICAL FUNCTION YES(X,Y,Z)
C PRINT MESSAGE X, WAIT FOR YES/NO ANSWER.
IMPLICIT INTEGER(A-Z)
CHARACTER*6 REPLY
1 IF(X.NE.0)CALL RSPEAK(X)
WRITE(*,338)
338 FORMAT(/,' >')
C??????????????? THE FOLLOWING WORKS BETTER ON VAXES, ETC:
C338 FORMAT(/,' >',$)
READ(*,30)REPLY
30 FORMAT(A6)
DO 2 I=1,6
IF(REPLY(I:I).GE.'a'.AND.REPLY(I:I).LE.'z')
1 REPLY(I:I) = CHAR(ICHAR(REPLY(I:I)) -32)
2 CONTINUE
IF(REPLY.EQ.'YES '.OR.REPLY.EQ.'Y ')GOTO 10
IF(REPLY.EQ.'NO '.OR.REPLY.EQ.'N ')GOTO 20
WRITE(*,*)' Please answer the question.'
GOTO 1
10 YES=.TRUE.
IF(Y.NE.0)CALL RSPEAK(Y)
RETURN
20 YES=.FALSE.
IF(Z.NE.0)CALL RSPEAK(Z)
RETURN
END