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