|
|
1.1 ! root 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
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.