|
|
1.1 root 1: C LIGHTP- LIGHT PROCESSOR
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: LOGICAL FUNCTION LIGHTP(OBJ)
10: IMPLICIT INTEGER (A-Z)
11: LOGICAL QON
12: #include "parser.h"
13: #include "gamestate.h"
14: #include "objects.h"
15: #include "oflags.h"
16: #include "oindex.h"
17: #include "clock.h"
18:
19: #include "verbs.h"
20: #include "flags.h"
21: C
22: C FUNCTIONS AND DATA
23: C
24: QON(R)=and(OFLAG1(R),ONBT).NE.0
25: C LIGHTP, PAGE 2
26: C
27: LIGHTP=.TRUE.
28: C !ASSUME WINS
29: FLOBTS=FLAMBT+LITEBT+ONBT
30: IF(OBJ.NE.CANDL) GO TO 20000
31: C !CANDLE?
32: IF(ORCAND.NE.0) GO TO 19100
33: C !FIRST REF?
34: ORCAND=1
35: C !YES, CANDLES ARE
36: CTICK(CEVCND)=50
37: C !BURNING WHEN SEEN.
38: C
39: 19100 IF(PRSI.EQ.CANDL) GO TO 10
40: C !IGNORE IND REFS.
41: IF(PRSA.NE.TRNOFW) GO TO 19200
42: C !TURN OFF?
43: I=513
44: C !ASSUME OFF.
45: IF(QON(CANDL)) I=514
46: C !IF ON, DIFFERENT.
47: CFLAG(CEVCND)=.FALSE.
48: C !DISABLE COUNTDOWN.
49: OFLAG1(CANDL)=and(OFLAG1(CANDL), not(ONBT))
50: CALL RSPEAK(I)
51: RETURN
52: C
53: 19200 IF((PRSA.NE.BURNW).AND.(PRSA.NE.TRNONW)) GO TO 10
54: IF(and(OFLAG1(CANDL),LITEBT).NE.0) GO TO 19300
55: CALL RSPEAK(515)
56: C !CANDLES TOO SHORT.
57: RETURN
58: C
59: 19300 IF(PRSI.NE.0) GO TO 19400
60: C !ANY FLAME?
61: CALL RSPEAK(516)
62: C !NO, LOSE.
63: PRSWON=.FALSE.
64: RETURN
65: C
66: 19400 IF((PRSI.NE.MATCH).OR. .NOT.QON(MATCH)) GO TO 19500
67: I=517
68: C !ASSUME OFF.
69: IF(QON(CANDL)) I=518
70: C !IF ON, JOKE.
71: OFLAG1(CANDL)=or(OFLAG1(CANDL),ONBT)
72: CFLAG(CEVCND)=.TRUE.
73: C !RESUME COUNTDOWN.
74: CALL RSPEAK(I)
75: RETURN
76: C
77: 19500 IF((PRSI.NE.TORCH).OR. .NOT.QON(TORCH)) GO TO 19600
78: IF(QON(CANDL)) GO TO 19700
79: C !ALREADY ON?
80: CALL NEWSTA(CANDL,521,0,0,0)
81: C !NO, VAPORIZE.
82: RETURN
83: C
84: 19600 CALL RSPEAK(519)
85: C !CANT LIGHT WITH THAT.
86: RETURN
87: C
88: 19700 CALL RSPEAK(520)
89: C !ALREADY ON.
90: RETURN
91: C
92: 20000 IF(OBJ.NE.MATCH) CALL BUG(6,OBJ)
93: IF((PRSA.NE.TRNONW).OR.(PRSO.NE.MATCH)) GO TO 20500
94: IF(ORMTCH.NE.0) GO TO 20100
95: C !ANY MATCHES LEFT?
96: CALL RSPEAK(183)
97: C !NO, LOSE.
98: RETURN
99: C
100: 20100 ORMTCH=ORMTCH-1
101: C !DECREMENT NO MATCHES.
102: OFLAG1(MATCH)=or(OFLAG1(MATCH),FLOBTS)
103: CTICK(CEVMAT)=2
104: C !COUNTDOWN.
105: CALL RSPEAK(184)
106: RETURN
107: C
108: 20500 IF((PRSA.NE.TRNOFW).OR.(and(OFLAG1(MATCH),ONBT).EQ.0))
109: & GO TO 10
110: OFLAG1(MATCH)=and(OFLAG1(MATCH), not(FLOBTS))
111: CTICK(CEVMAT)=0
112: CALL RSPEAK(185)
113: RETURN
114: C
115: C HERE FOR FALSE RETURN
116: C
117: 10 LIGHTP=.FALSE.
118: RETURN
119: END
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.