Annotation of 43BSDReno/games/dungeon/dgame.F, revision 1.1

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

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.