# 2.11BSD#431 - /usr/src/new/PORT/dungeon/dgame.F

       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: 657 |