4.4BSD/usr/src/contrib/dungeon/dgame.F

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 "gamestate.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'/
	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
	DO 150 I=1,3
C						!CALL ON GDT?
	  IF(INBUF(I+PRSCON-1).NE.GDTSTR(I)) GO TO 200
150	CONTINUE
	CALL GDT
C						!YES, INVOKE.
	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)=and(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
#ifdef PDP
1400	call outstr(INBUF, INLNT)
#else
1400	WRITE(OUTCH,1410) (INBUF(J),J=1,INLNT)
#ifdef NOCC
1410	FORMAT(78A1)
#else NOCC
1410	FORMAT(1X,78A1)
#endif NOCC
#endif PDP
	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(and(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 "gamestate.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