|
|
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.