dgame.for

C GAME- MAIN COMMAND LOOP FOR DUNGEON
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 DECLARATIONS
C
	SUBROUTINE GAME
	IMPLICIT INTEGER (A-Z)
	LOGICAL RMDESC,VAPPLI,RAPPLI,AAPPLI
	LOGICAL F,PARSE,FINDXT,XVEHIC,LIT
	CHARACTER SECHO(4)
	CHARACTER GDTSTR(3)
	include 'parser.h'
	include 'gamestat.h'
	include 'state.h'
	include 'io.h'
	include 'rooms.h'
	include 'rindex.h'
	include 'objects.h'
	include 'oflags.h'
	include 'oindex.h'
	include 'advers.h'
	include 'verbs.h'
	include 'flags.h'
C
C FUNCTIONS AND DATA
C
	DATA SECHO/'E','C','H','O'/
D	DATA GDTSTR/'G','D','T'/
C GAME, PAGE 2
C
C START UP, DESCRIBE CURRENT LOCATION.
C
	CALL RSPEAK(1)
C						!WELCOME ABOARD.
	F=RMDESC(3)
C						!START GAME.
C
C NOW LOOP, READING AND EXECUTING COMMANDS.
C
100	WINNER=PLAYER
C						!PLAYER MOVING.
	TELFLG=.FALSE.
C						!ASSUME NOTHING TOLD.
	IF(PRSCON.LE.1) CALL RDLINE(INBUF,INLNT,1)
C
D	DO 150 I=1,3
C						!CALL ON GDT?
D	  IF(INBUF(I+PRSCON-1).NE.GDTSTR(I)) GO TO 200
D150	CONTINUE
D	CALL GDT
C						!YES, INVOKE.
D	GO TO 100
C						!ONWARD.
C
200	MOVES=MOVES+1
	PRSWON=PARSE(INBUF,INLNT,.TRUE.)
	IF(.NOT.PRSWON) GO TO 400
C						!PARSE LOSES?
	IF(XVEHIC(1)) GO TO 400
C						!VEHICLE HANDLE?
C
	IF(PRSA.EQ.TELLW) GO TO 2000
C						!TELL?
300	IF((PRSO.EQ.VALUA).OR.(PRSO.EQ.EVERY)) GO TO 900
	IF(.NOT.VAPPLI(PRSA)) GO TO 400
C						!VERB OK?
350	IF(.NOT.ECHOF.AND.(HERE.EQ.ECHOR)) GO TO 1000
	F=RAPPLI(RACTIO(HERE))
C
400	CALL XENDMV(TELFLG)
C						!DO END OF MOVE.
	IF(.NOT.LIT(HERE)) PRSCON=1
	GO TO 100
C
900	CALL VALUAC(VALUA)
	GO TO 350
C GAME, PAGE 3
C
C SPECIAL CASE-- ECHO ROOM.
C IF INPUT IS NOT 'ECHO' OR A DIRECTION, JUST ECHO.
C
1000	CALL RDLINE(INBUF,INLNT,0)
	MOVES=MOVES+1
C						!CHARGE FOR MOVES.
	DO 1100 I=1,4
C						!INPUT = ECHO?
	  IF(INBUF(I).NE.SECHO(I)) GO TO 1300
1100	CONTINUE
C
C   Note: the following DO loop was changed from DO 1200 I=5,78
C     The change was necessary because the RDLINE function was changed,
C      and no longer provides a 78 character buffer padded with blanks.
C
	DO 1200 I=5,INLNT
	  IF(INBUF(I).NE.' ') GO TO 1300
1200	CONTINUE
C
	CALL RSPEAK(571)
C						!KILL THE ECHO.
	ECHOF=.TRUE.
	OFLAG2(BAR)=IAND(OFLAG2(BAR), not(SCRDBT))
	PRSWON=.TRUE.
C						!FAKE OUT PARSER.
	PRSCON=1
C						!FORCE NEW INPUT.
	GO TO 400
C
1300	PRSWON=PARSE(INBUF,INLNT,.FALSE.)
	IF(.NOT.PRSWON .OR. (PRSA.NE.WALKW))
     &	GO TO 1400
	IF(FINDXT(PRSO,HERE)) GO TO 300
C						!VALID EXIT?
C
1400	WRITE(OUTCH,1410) (INBUF(J),J=1,INLNT)
1410	FORMAT(1X,78A1)
	TELFLG=.TRUE.
C						!INDICATE OUTPUT.
	GO TO 1000
C						!MORE ECHO ROOM.
C GAME, PAGE 4
C
C SPECIAL CASE-- TELL <ACTOR>, NEW COMMAND
C NOTE THAT WE CANNOT BE IN THE ECHO ROOM.
C
2000	IF(IAND(OFLAG2(PRSO),ACTRBT).NE.0) GO TO 2100
	CALL RSPEAK(602)
C						!CANT DO IT.
	GO TO 350
C						!VAPPLI SUCCEEDS.
C
2100	WINNER=OACTOR(PRSO)
C						!NEW PLAYER.
	HERE=AROOM(WINNER)
C						!NEW LOCATION.
	IF(PRSCON.LE.1) GO TO 2700
C						!ANY INPUT?
	IF(PARSE(INBUF,INLNT,.TRUE.)) GO TO 2150
2700	I=341
C						!FAILS.
	IF(TELFLG) I=604
C						!GIVE RESPONSE.
	CALL RSPEAK(I)
2600	WINNER=PLAYER
C						!RESTORE STATE.
	HERE=AROOM(WINNER)
	GO TO 350
C
2150	IF(AAPPLI(AACTIO(WINNER))) GO TO 2400
C						!ACTOR HANDLE?
	IF(XVEHIC(1)) GO TO 2400
C						!VEHICLE HANDLE?
	IF((PRSO.EQ.VALUA).OR.(PRSO.EQ.EVERY)) GO TO 2900
	IF(.NOT.VAPPLI(PRSA)) GO TO 2400
C						!VERB HANDLE?
2350	F=RAPPLI(RACTIO(HERE))
C
2400	CALL XENDMV(TELFLG)
C						!DO END OF MOVE.
	GO TO 2600
C						!DONE.
C
2900	CALL VALUAC(VALUA)
C						!ALL OR VALUABLES.
	GO TO 350
C
	END
C XENDMV-	EXECUTE END OF MOVE FUNCTIONS.
C
C DECLARATIONS
C
	SUBROUTINE XENDMV(FLAG)
	IMPLICIT INTEGER(A-Z)
	LOGICAL F,CLOCKD,FLAG,XVEHIC
	include 'parser.h'
	include 'villians.h'
C
	IF(.NOT.FLAG) CALL RSPEAK(341)
C						!DEFAULT REMARK.
	IF(THFACT) CALL THIEFD
C						!THIEF DEMON.
	IF(PRSWON) CALL FIGHTD
C						!FIGHT DEMON.
	IF(SWDACT) CALL SWORDD
C						!SWORD DEMON.
	IF(PRSWON) F=CLOCKD(X)
C						!CLOCK DEMON.
	IF(PRSWON) F=XVEHIC(2)
C						!VEHICLE READOUT.
	RETURN
	END
C XVEHIC- EXECUTE VEHICLE FUNCTION
C
C DECLARATIONS
C
	LOGICAL FUNCTION XVEHIC(N)
	IMPLICIT INTEGER(A-Z)
	LOGICAL OAPPLI
	include 'gamestat.h'
	include 'objects.h'
	include 'advers.h'
C
	XVEHIC=.FALSE.
C						!ASSUME LOSES.
	AV=AVEHIC(WINNER)
C						!GET VEHICLE.
	IF(AV.NE.0) XVEHIC=OAPPLI(OACTIO(AV),N)
	RETURN
	END