1C GAME- MAIN COMMAND LOOP FOR DUNGEON 2C 3C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 4C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED 5C WRITTEN BY R. M. SUPNIK 6C 7C DECLARATIONS 8C 9 SUBROUTINE GAME 10 IMPLICIT INTEGER (A-Z) 11 LOGICAL RMDESC,VAPPLI,RAPPLI,AAPPLI 12 LOGICAL F,PARSE,FINDXT,XVEHIC,LIT 13 CHARACTER SECHO(4) 14 CHARACTER GDTSTR(3) 15#include "parser.h" 16#include "gamestate.h" 17#include "state.h" 18#include "io.h" 19#include "rooms.h" 20#include "rindex.h" 21#include "objects.h" 22#include "oflags.h" 23#include "oindex.h" 24#include "advers.h" 25#include "verbs.h" 26#include "flags.h" 27C 28C FUNCTIONS AND DATA 29C 30 DATA SECHO/'E','C','H','O'/ 31 DATA GDTSTR/'G','D','T'/ 32C GAME, PAGE 2 33C 34C START UP, DESCRIBE CURRENT LOCATION. 35C 36 CALL RSPEAK(1) 37C !WELCOME ABOARD. 38 F=RMDESC(3) 39C !START GAME. 40C 41C NOW LOOP, READING AND EXECUTING COMMANDS. 42C 43100 WINNER=PLAYER 44C !PLAYER MOVING. 45 TELFLG=.FALSE. 46C !ASSUME NOTHING TOLD. 47 IF(PRSCON.LE.1) CALL RDLINE(INBUF,INLNT,1) 48C 49 DO 150 I=1,3 50C !CALL ON GDT? 51 IF(INBUF(I+PRSCON-1).NE.GDTSTR(I)) GO TO 200 52150 CONTINUE 53 CALL GDT 54C !YES, INVOKE. 55 GO TO 100 56C !ONWARD. 57C 58200 MOVES=MOVES+1 59 PRSWON=PARSE(INBUF,INLNT,.TRUE.) 60 IF(.NOT.PRSWON) GO TO 400 61C !PARSE LOSES? 62 IF(XVEHIC(1)) GO TO 400 63C !VEHICLE HANDLE? 64C 65 IF(PRSA.EQ.TELLW) GO TO 2000 66C !TELL? 67300 IF((PRSO.EQ.VALUA).OR.(PRSO.EQ.EVERY)) GO TO 900 68 IF(.NOT.VAPPLI(PRSA)) GO TO 400 69C !VERB OK? 70350 IF(.NOT.ECHOF.AND.(HERE.EQ.ECHOR)) GO TO 1000 71 F=RAPPLI(RACTIO(HERE)) 72C 73400 CALL XENDMV(TELFLG) 74C !DO END OF MOVE. 75 IF(.NOT.LIT(HERE)) PRSCON=1 76 GO TO 100 77C 78900 CALL VALUAC(VALUA) 79 GO TO 350 80C GAME, PAGE 3 81C 82C SPECIAL CASE-- ECHO ROOM. 83C IF INPUT IS NOT 'ECHO' OR A DIRECTION, JUST ECHO. 84C 851000 CALL RDLINE(INBUF,INLNT,0) 86 MOVES=MOVES+1 87C !CHARGE FOR MOVES. 88 DO 1100 I=1,4 89C !INPUT = ECHO? 90 IF(INBUF(I).NE.SECHO(I)) GO TO 1300 911100 CONTINUE 92C 93C Note: the following DO loop was changed from DO 1200 I=5,78 94C The change was necessary because the RDLINE function was changed, 95C and no longer provides a 78 character buffer padded with blanks. 96C 97 DO 1200 I=5,INLNT 98 IF(INBUF(I).NE.' ') GO TO 1300 991200 CONTINUE 100C 101 CALL RSPEAK(571) 102C !KILL THE ECHO. 103 ECHOF=.TRUE. 104 OFLAG2(BAR)=and(OFLAG2(BAR), not(SCRDBT)) 105 PRSWON=.TRUE. 106C !FAKE OUT PARSER. 107 PRSCON=1 108C !FORCE NEW INPUT. 109 GO TO 400 110C 1111300 PRSWON=PARSE(INBUF,INLNT,.FALSE.) 112 IF(.NOT.PRSWON .OR. (PRSA.NE.WALKW)) 113& GO TO 1400 114 IF(FINDXT(PRSO,HERE)) GO TO 300 115C !VALID EXIT? 116C 117#ifdef PDP 1181400 call outstr(INBUF, INLNT) 119#else 1201400 WRITE(OUTCH,1410) (INBUF(J),J=1,INLNT) 121#ifdef NOCC 1221410 FORMAT(78A1) 123#else NOCC 1241410 FORMAT(1X,78A1) 125#endif NOCC 126#endif PDP 127 TELFLG=.TRUE. 128C !INDICATE OUTPUT. 129 GO TO 1000 130C !MORE ECHO ROOM. 131C GAME, PAGE 4 132C 133C SPECIAL CASE-- TELL <ACTOR>, NEW COMMAND 134C NOTE THAT WE CANNOT BE IN THE ECHO ROOM. 135C 1362000 IF(and(OFLAG2(PRSO),ACTRBT).NE.0) GO TO 2100 137 CALL RSPEAK(602) 138C !CANT DO IT. 139 GO TO 350 140C !VAPPLI SUCCEEDS. 141C 1422100 WINNER=OACTOR(PRSO) 143C !NEW PLAYER. 144 HERE=AROOM(WINNER) 145C !NEW LOCATION. 146 IF(PRSCON.LE.1) GO TO 2700 147C !ANY INPUT? 148 IF(PARSE(INBUF,INLNT,.TRUE.)) GO TO 2150 1492700 I=341 150C !FAILS. 151 IF(TELFLG) I=604 152C !GIVE RESPONSE. 153 CALL RSPEAK(I) 1542600 WINNER=PLAYER 155C !RESTORE STATE. 156 HERE=AROOM(WINNER) 157 GO TO 350 158C 1592150 IF(AAPPLI(AACTIO(WINNER))) GO TO 2400 160C !ACTOR HANDLE? 161 IF(XVEHIC(1)) GO TO 2400 162C !VEHICLE HANDLE? 163 IF((PRSO.EQ.VALUA).OR.(PRSO.EQ.EVERY)) GO TO 2900 164 IF(.NOT.VAPPLI(PRSA)) GO TO 2400 165C !VERB HANDLE? 1662350 F=RAPPLI(RACTIO(HERE)) 167C 1682400 CALL XENDMV(TELFLG) 169C !DO END OF MOVE. 170 GO TO 2600 171C !DONE. 172C 1732900 CALL VALUAC(VALUA) 174C !ALL OR VALUABLES. 175 GO TO 350 176C 177 END 178C XENDMV- EXECUTE END OF MOVE FUNCTIONS. 179C 180C DECLARATIONS 181C 182 SUBROUTINE XENDMV(FLAG) 183 IMPLICIT INTEGER(A-Z) 184 LOGICAL F,CLOCKD,FLAG,XVEHIC 185#include "parser.h" 186#include "villians.h" 187C 188 IF(.NOT.FLAG) CALL RSPEAK(341) 189C !DEFAULT REMARK. 190 IF(THFACT) CALL THIEFD 191C !THIEF DEMON. 192 IF(PRSWON) CALL FIGHTD 193C !FIGHT DEMON. 194 IF(SWDACT) CALL SWORDD 195C !SWORD DEMON. 196 IF(PRSWON) F=CLOCKD(X) 197C !CLOCK DEMON. 198 IF(PRSWON) F=XVEHIC(2) 199C !VEHICLE READOUT. 200 RETURN 201 END 202C XVEHIC- EXECUTE VEHICLE FUNCTION 203C 204C DECLARATIONS 205C 206 LOGICAL FUNCTION XVEHIC(N) 207 IMPLICIT INTEGER(A-Z) 208 LOGICAL OAPPLI 209#include "gamestate.h" 210#include "objects.h" 211#include "advers.h" 212C 213 XVEHIC=.FALSE. 214C !ASSUME LOSES. 215 AV=AVEHIC(WINNER) 216C !GET VEHICLE. 217 IF(AV.NE.0) XVEHIC=OAPPLI(OACTIO(AV),N) 218 RETURN 219 END 220