Annotation of 43BSDReno/games/dungeon/dgame.F, revision 1.1.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.