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: 458
Valid CSS Valid XHTML 1.0 Strict