Source to dungeon-2.5.6/dverb1.f
C TAKE-- BASIC TAKE SEQUENCE
C
C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
C WRITTEN BY R. M. SUPNIK
C
C TAKE AN OBJECT (FOR VERBS TAKE, PUT, DROP, READ, ETC.)
C
LOGICAL FUNCTION TAKE(FLG)
C
C DECLARATIONS
C
IMPLICIT INTEGER (A-Z)
LOGICAL FLG,OBJACT,OAPPLI,QOPEN,QHERE
C
C PARSER OUTPUT
C
LOGICAL PRSWON
COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON
C
C GAME STATE
C
LOGICAL TELFLG
COMMON /PLAY/ WINNER,HERE,TELFLG
COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD,
1 LTSHFT,BLOC,MUNGRM,HS,EGSCOR,EGMXSC
COMMON /STAR/ MBASE,STRBIT
C
C OBJECTS
C
COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
3 OADV(220),OCAN(220),OREAD(220)
C
COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT,
1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT,
2 TOOLBT,TURNBT,ONBT
COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT,
1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
2 TCHBT,VEHBT,SCHBT
C
C
C ADVENTURERS
C
COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4),
1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4)
C
COMMON /AINDEX/ PLAYER,AROBOT,AMASTR
C
C FUNCTIONS AND DATA
C
QOPEN(O)=ZAND(OFLAG2(O),OPENBT).NE.0
C TAKE, PAGE 2
C
TAKE=.FALSE.
C ASSUME LOSES.
OA=OACTIO(PRSO)
C GET OBJECT ACTION.
IF(PRSO.LE.STRBIT) GO TO 100
C STAR?
TAKE=OBJACT()
C YES, LET IT HANDLE.
RETURN
C
100 X=OCAN(PRSO)
C INSIDE?
IF(PRSO.NE.AVEHIC(WINNER)) GO TO 400
C HIS VEHICLE?
CALL RSPEAK(672)
C DUMMY.
RETURN
C
400 IF(ZAND(OFLAG1(PRSO),TAKEBT).NE.0) GO TO 500
C TAKEABLE?
IF(.NOT.OAPPLI(OA,0)) CALL RSPEAK(552+ZRND(5))
RETURN
C
C OBJECT IS TAKEABLE AND IN POSITION TO BE TAKEN.
C
500 IF((X.NE.0).OR. QHERE(PRSO,HERE)) GO TO 600
IF(OADV(PRSO).EQ.WINNER) CALL RSPEAK(557)
C ALREADY GOT IT?
RETURN
C
600 IF(((X.NE.0).AND.(OADV(X).EQ.WINNER)).OR.
1 ((WEIGHT(0,PRSO,WINNER)+OSIZE(PRSO)).LE.MXLOAD))
2 GO TO 700
CALL RSPEAK(558)
C TOO MUCH WEIGHT.
RETURN
C
700 TAKE=.TRUE.
C AT LAST.
IF(OAPPLI(OA,0)) RETURN
C DID IT HANDLE?
CALL NEWSTA(PRSO,0,0,0,WINNER)
C TAKE OBJECT FOR WINNER.
OFLAG2(PRSO)=ZOR(OFLAG2(PRSO),TCHBT)
C HAS BEEN TOUCHED.
CALL SCRUPD(OFVAL(PRSO))
C UPDATE SCORE.
OFVAL(PRSO)=0
C CANT BE SCORED AGAIN.
IF(FLG) CALL RSPEAK(559)
C TELL TAKEN.
RETURN
C
END
C DROP- DROP VERB PROCESSOR
C
C DECLARATIONS
C
LOGICAL FUNCTION DROP()
IMPLICIT INTEGER (A-Z)
LOGICAL F,PUT,OBJACT
C
C PARSER OUTPUT
C
LOGICAL PRSWON
COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON
C
C GAME STATE
C
LOGICAL TELFLG
COMMON /PLAY/ WINNER,HERE,TELFLG
C
C ROOMS
C
COMMON /RINDEX/ WHOUS,LROOM,CELLA
COMMON /RINDEX/ MTROL,MAZE1
COMMON /RINDEX/ MGRAT,MAZ15
COMMON /RINDEX/ FORE1,FORE3,CLEAR,RESER
COMMON /RINDEX/ STREA,EGYPT,ECHOR
COMMON /RINDEX/ TSHAF
COMMON /RINDEX/ BSHAF,MMACH,DOME,MTORC
COMMON /RINDEX/ CAROU
COMMON /RINDEX/ RIDDL,LLD2,TEMP1,TEMP2,MAINT
COMMON /RINDEX/ BLROO,TREAS,RIVR1,RIVR2,RIVR3,MCYCL
COMMON /RINDEX/ RIVR4,RIVR5,FCHMP,FALLS,MBARR
COMMON /RINDEX/ MRAIN,POG,VLBOT,VAIR1,VAIR2,VAIR3,VAIR4
COMMON /RINDEX/ LEDG2,LEDG3,LEDG4,MSAFE,CAGER
COMMON /RINDEX/ CAGED,TWELL,BWELL,ALICE,ALISM,ALITR
COMMON /RINDEX/ MTREE,BKENT,BKVW,BKTWI,BKVAU,BKBOX
COMMON /RINDEX/ CRYPT,TSTRS,MRANT,MREYE
COMMON /RINDEX/ MRA,MRB,MRC,MRG,MRD,FDOOR
COMMON /RINDEX/ MRAE,MRCE,MRCW,MRGE,MRGW,MRDW,INMIR
COMMON /RINDEX/ SCORR,NCORR,PARAP,CELL,PCELL,NCELL
COMMON /RINDEX/ CPANT,CPOUT,CPUZZ
C
C OBJECTS
C
COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
3 OADV(220),OCAN(220),OREAD(220)
C
COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT,
1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT,
2 TOOLBT,TURNBT,ONBT
COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT,
1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
2 TCHBT,VEHBT,SCHBT
C
C
C ADVENTURERS
C
COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4),
1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4)
C
C VERBS
C
COMMON /VINDEX/ CINTW,DEADXW,FRSTQW,INXW,OUTXW
COMMON /VINDEX/ WALKIW,FIGHTW,FOOW
COMMON /VINDEX/ MELTW,READW,INFLAW,DEFLAW,ALARMW,EXORCW
COMMON /VINDEX/ PLUGW,KICKW,WAVEW,RAISEW,LOWERW,RUBW
COMMON /VINDEX/ PUSHW,UNTIEW,TIEW,TIEUPW,TURNW,BREATW
COMMON /VINDEX/ KNOCKW,LOOKW,EXAMIW,SHAKEW,MOVEW,TRNONW,TRNOFW
COMMON /VINDEX/OPENW,CLOSEW,FINDW,WAITW,SPINW,BOARDW,UNBOAW,TAKEW
COMMON /VINDEX/ INVENW,FILLW,EATW,DRINKW,BURNW
COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW
COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW
COMMON /VINDEX/ DIGW,LEAPW,STAYW,FOLLOW
COMMON /VINDEX/ HELLOW,LOOKIW,LOOKUW,PUMPW,WINDW
COMMON /VINDEX/ CLMBW,CLMBUW,CLMBDW,TRNTOW
C DROP, PAGE 2
C
DROP=.TRUE.
C ASSUME WINS.
X=OCAN(PRSO)
C GET CONTAINER.
IF(X.EQ.0) GO TO 200
C IS IT INSIDE?
IF(OADV(X).NE.WINNER) GO TO 1000
C IS HE CARRYING CON?
IF(ZAND(OFLAG2(X),OPENBT).NE.0) GO TO 300
C IS IT OPEN?
CALL RSPSUB(525,ODESC2(X))
C CANT REACH.
RETURN
C
200 IF(OADV(PRSO).NE.WINNER) GO TO 1000
C IS HE CARRYING OBJ?
300 IF(AVEHIC(WINNER).EQ.0) GO TO 400
C IS HE IN VEHICLE?
PRSI=AVEHIC(WINNER)
C YES,
F=PUT()
C DROP INTO VEHICLE.
PRSI=0
C DISARM PARSER.
RETURN
C DONE.
C
400 CALL NEWSTA(PRSO,0,HERE,0,0)
C DROP INTO ROOM.
IF(HERE.EQ.MTREE) CALL NEWSTA(PRSO,0,FORE3,0,0)
CALL SCRUPD(OFVAL(PRSO))
C SCORE OBJECT.
OFVAL(PRSO)=0
C CANT BE SCORED AGAIN.
OFLAG2(PRSO)=ZOR(OFLAG2(PRSO),TCHBT)
C HAS BEEN TOUCHED.
C
IF(OBJACT()) RETURN
C DID IT HANDLE?
I=0
C ASSUME NOTHING TO SAY.
IF(PRSA.EQ.DROPW) I=528
IF(PRSA.EQ.THROWW) I=529
IF((I.NE.0).AND.(HERE.EQ.MTREE)) I=659
CALL RSPSUB(I,ODESC2(PRSO))
RETURN
C
1000 CALL RSPEAK(527)
C DONT HAVE IT.
RETURN
C
END
C PUT- PUT VERB PROCESSOR
C
C DECLARATIONS
C
LOGICAL FUNCTION PUT()
IMPLICIT INTEGER (A-Z)
LOGICAL QOPEN,QHERE,OBJACT,TAKE
C
C PARSER OUTPUT
C
LOGICAL PRSWON
COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON
C
C GAME STATE
C
LOGICAL TELFLG
COMMON /PLAY/ WINNER,HERE,TELFLG
C
C MISCELLANEOUS VARIABLES
C
COMMON /STAR/ MBASE,STRBIT
C
C OBJECTS
C
COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
3 OADV(220),OCAN(220),OREAD(220)
C
COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT,
1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT,
2 TOOLBT,TURNBT,ONBT
COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT,
1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
2 TCHBT,VEHBT,SCHBT
C
C ADVENTURERS
C
COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4),
1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4)
C
C VERBS
C
COMMON /VINDEX/ CINTW,DEADXW,FRSTQW,INXW,OUTXW
COMMON /VINDEX/ WALKIW,FIGHTW,FOOW
COMMON /VINDEX/ MELTW,READW,INFLAW,DEFLAW,ALARMW,EXORCW
COMMON /VINDEX/ PLUGW,KICKW,WAVEW,RAISEW,LOWERW,RUBW
COMMON /VINDEX/ PUSHW,UNTIEW,TIEW,TIEUPW,TURNW,BREATW
COMMON /VINDEX/ KNOCKW,LOOKW,EXAMIW,SHAKEW,MOVEW,TRNONW,TRNOFW
COMMON /VINDEX/OPENW,CLOSEW,FINDW,WAITW,SPINW,BOARDW,UNBOAW,TAKEW
COMMON /VINDEX/ INVENW,FILLW,EATW,DRINKW,BURNW
COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW
COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW
COMMON /VINDEX/ DIGW,LEAPW,STAYW,FOLLOW
COMMON /VINDEX/ HELLOW,LOOKIW,LOOKUW,PUMPW,WINDW
COMMON /VINDEX/ CLMBW,CLMBUW,CLMBDW,TRNTOW
C
C FUNCTIONS AND DATA
C
QOPEN(R)=ZAND(OFLAG2(R),OPENBT).NE.0
C PUT, PAGE 2
C
PUT=.FALSE.
IF((PRSO.LE.STRBIT).AND.(PRSI.LE.STRBIT)) GO TO 200
IF(.NOT.OBJACT()) CALL RSPEAK(560)
C STAR
PUT=.TRUE.
RETURN
C
200 IF(QOPEN(PRSI).OR.(ZAND(OFLAG1(PRSI),(DOORBT+CONTBT)).NE.0)
1 .OR.(ZAND(OFLAG2(PRSI),VEHBT).NE.0)) GO TO 300
CALL RSPEAK(561)
C CANT PUT IN THAT.
RETURN
C
300 IF(QOPEN(PRSI)) GO TO 400
C IS IT OPEN?
CALL RSPEAK(562)
C NO, JOKE
RETURN
C
400 IF(PRSO.NE.PRSI) GO TO 500
C INTO ITSELF?
CALL RSPEAK(563)
C YES, JOKE.
RETURN
C
500 IF(OCAN(PRSO).NE.PRSI) GO TO 600
C ALREADY INSIDE.
CALL RSPSB2(564,ODESC2(PRSO),ODESC2(PRSI))
PUT=.TRUE.
RETURN
C
600 IF((WEIGHT(0,PRSO,0)+WEIGHT(0,PRSI,0)+OSIZE(PRSO))
1 .LE.OCAPAC(PRSI)) GO TO 700
C NOT TOO FULL?
CALL RSPEAK(565)
C THEN CANT DO IT.
RETURN
C
C NOW SEE IF OBJECT (OR ITS CONTAINER) IS IN ROOM
C
700 J=PRSO
C START SEARCH.
725 IF(QHERE(J,HERE)) GO TO 750
C IS IT HERE?
J=OCAN(J)
IF(J.NE.0) GO TO 725
C MORE TO DO?
GO TO 800
C NO, SCH FAILS.
C
750 SVO=PRSO
C SAVE PARSER.
SVI=PRSI
PRSA=TAKEW
PRSI=0
IF(.NOT.TAKE(.FALSE.)) RETURN
C TAKE OBJECT.
PRSA=PUTW
PRSO=SVO
PRSI=SVI
GO TO 1000
C
C NOW SEE IF OBJECT IS ON PERSON.
C
800 IF(OCAN(PRSO).EQ.0) GO TO 1000
C INSIDE?
IF(QOPEN(OCAN(PRSO))) GO TO 900
C OPEN?
CALL RSPSUB(566,ODESC2(PRSO))
C LOSE.
RETURN
C
900 CALL SCRUPD(OFVAL(PRSO))
C SCORE OBJECT.
OFVAL(PRSO)=0
OFLAG2(PRSO)=ZOR(OFLAG2(PRSO),TCHBT)
C HAS BEEN TOUCHED.
CALL NEWSTA(PRSO,0,0,0,WINNER)
C TEMPORARILY ON WINNER.
C
1000 IF(OBJACT()) RETURN
C NO, GIVE OBJECT A SHOT.
CALL NEWSTA(PRSO,2,0,PRSI,0)
C CONTAINED INSIDE.
PUT=.TRUE.
RETURN
C
END
C VALUAC- HANDLES VALUABLES/EVERYTHING
C
C DECLARATIONS
C
SUBROUTINE VALUAC(V)
IMPLICIT INTEGER (A-Z)
LOGICAL LIT,F,F1,TAKE,PUT,DROP,NOTVAL,QHERE
C
C PARSER OUTPUT
C
LOGICAL PRSWON
COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON
C
C GAME STATE
C
LOGICAL TELFLG
COMMON /PLAY/ WINNER,HERE,TELFLG
C
C OBJECTS
C
COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
3 OADV(220),OCAN(220),OREAD(220)
C
COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT,
1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT,
2 TOOLBT,TURNBT,ONBT
COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT,
1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
2 TCHBT,VEHBT,SCHBT
C
C VERBS
C
COMMON /VINDEX/ CINTW,DEADXW,FRSTQW,INXW,OUTXW
COMMON /VINDEX/ WALKIW,FIGHTW,FOOW
COMMON /VINDEX/ MELTW,READW,INFLAW,DEFLAW,ALARMW,EXORCW
COMMON /VINDEX/ PLUGW,KICKW,WAVEW,RAISEW,LOWERW,RUBW
COMMON /VINDEX/ PUSHW,UNTIEW,TIEW,TIEUPW,TURNW,BREATW
COMMON /VINDEX/ KNOCKW,LOOKW,EXAMIW,SHAKEW,MOVEW,TRNONW,TRNOFW
COMMON /VINDEX/OPENW,CLOSEW,FINDW,WAITW,SPINW,BOARDW,UNBOAW,TAKEW
COMMON /VINDEX/ INVENW,FILLW,EATW,DRINKW,BURNW
COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW
COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW
COMMON /VINDEX/ DIGW,LEAPW,STAYW,FOLLOW
COMMON /VINDEX/ HELLOW,LOOKIW,LOOKUW,PUMPW,WINDW
COMMON /VINDEX/ CLMBW,CLMBUW,CLMBDW,TRNTOW
C
C FUNCTIONS AND DATA
C
NOTVAL(R)=(SAVEP.EQ.V).AND.(OTVAL(R).LE.0)
C VALUAC, PAGE 2
C
F=.TRUE.
C ASSUME NO ACTIONS.
I=579
C ASSUME NOT LIT.
IF(.NOT.LIT(HERE)) GO TO 4000
C IF NOT LIT, PUNT.
I=677
C ASSUME WRONG VERB.
SAVEP=PRSO
C SAVE PRSO.
SAVEH=HERE
C SAVE HERE.
C
100 IF(PRSA.NE.TAKEW) GO TO 1000
C TAKE EVERY/VALUA?
DO 500 PRSO=1,OLNT
C LOOP THRU OBJECTS.
IF(.NOT.QHERE(PRSO,HERE).OR.
1 (ZAND(OFLAG1(PRSO),VISIBT).EQ.0).OR.
2 (ZAND(OFLAG2(PRSO),ACTRBT).NE.0).OR.
3 NOTVAL(PRSO)) GO TO 500
IF((ZAND(OFLAG1(PRSO),TAKEBT).EQ.0).AND.
1 (ZAND(OFLAG2(PRSO),TRYBT).EQ.0)) GO TO 500
F=.FALSE.
CALL RSPSUB(580,ODESC2(PRSO))
F1=TAKE(.TRUE.)
IF(SAVEH.NE.HERE) RETURN
500 CONTINUE
GO TO 3000
C
1000 IF(PRSA.NE.DROPW) GO TO 2000
C DROP EVERY/VALUA?
DO 1500 PRSO=1,OLNT
IF((OADV(PRSO).NE.WINNER).OR.NOTVAL(PRSO))
1 GO TO 1500
F=.FALSE.
CALL RSPSUB(580,ODESC2(PRSO))
F1=DROP()
IF(SAVEH.NE.HERE) RETURN
1500 CONTINUE
GO TO 3000
C
2000 IF(PRSA.NE.PUTW) GO TO 3000
C PUT EVERY/VALUA?
DO 2500 PRSO=1,OLNT
C LOOP THRU OBJECTS.
IF((OADV(PRSO).NE.WINNER)
1 .OR.(PRSO.EQ.PRSI).OR.NOTVAL(PRSO).OR.
2 (ZAND(OFLAG1(PRSO),VISIBT).EQ.0)) GO TO 2500
F=.FALSE.
CALL RSPSUB(580,ODESC2(PRSO))
F1=PUT()
IF(SAVEH.NE.HERE) RETURN
2500 CONTINUE
C
3000 I=581
IF(SAVEP.EQ.V) I=582
C CHOOSE MESSAGE.
4000 IF(F) CALL RSPEAK(I)
C IF NOTHING, REPORT.
RETURN
END