home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Usenet 1994 October
/
usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso
/
games
/
volume2
/
dungeon
/
part07
/
lightp.F
< prev
next >
Wrap
Text File
|
1987-09-01
|
2KB
|
120 lines
C LIGHTP- LIGHT PROCESSOR
C
C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
C WRITTEN BY R. M. SUPNIK
C
C DECLARATIONS
C
LOGICAL FUNCTION LIGHTP(OBJ)
IMPLICIT INTEGER (A-Z)
LOGICAL QON
#include "parser.h"
#include "gamestate.h"
#include "objects.h"
#include "oflags.h"
#include "oindex.h"
#include "clock.h"
#include "verbs.h"
#include "flags.h"
C
C FUNCTIONS AND DATA
C
QON(R)=and(OFLAG1(R),ONBT).NE.0
C LIGHTP, PAGE 2
C
LIGHTP=.TRUE.
C !ASSUME WINS
FLOBTS=FLAMBT+LITEBT+ONBT
IF(OBJ.NE.CANDL) GO TO 20000
C !CANDLE?
IF(ORCAND.NE.0) GO TO 19100
C !FIRST REF?
ORCAND=1
C !YES, CANDLES ARE
CTICK(CEVCND)=50
C !BURNING WHEN SEEN.
C
19100 IF(PRSI.EQ.CANDL) GO TO 10
C !IGNORE IND REFS.
IF(PRSA.NE.TRNOFW) GO TO 19200
C !TURN OFF?
I=513
C !ASSUME OFF.
IF(QON(CANDL)) I=514
C !IF ON, DIFFERENT.
CFLAG(CEVCND)=.FALSE.
C !DISABLE COUNTDOWN.
OFLAG1(CANDL)=and(OFLAG1(CANDL), not(ONBT))
CALL RSPEAK(I)
RETURN
C
19200 IF((PRSA.NE.BURNW).AND.(PRSA.NE.TRNONW)) GO TO 10
IF(and(OFLAG1(CANDL),LITEBT).NE.0) GO TO 19300
CALL RSPEAK(515)
C !CANDLES TOO SHORT.
RETURN
C
19300 IF(PRSI.NE.0) GO TO 19400
C !ANY FLAME?
CALL RSPEAK(516)
C !NO, LOSE.
PRSWON=.FALSE.
RETURN
C
19400 IF((PRSI.NE.MATCH).OR. .NOT.QON(MATCH)) GO TO 19500
I=517
C !ASSUME OFF.
IF(QON(CANDL)) I=518
C !IF ON, JOKE.
OFLAG1(CANDL)=or(OFLAG1(CANDL),ONBT)
CFLAG(CEVCND)=.TRUE.
C !RESUME COUNTDOWN.
CALL RSPEAK(I)
RETURN
C
19500 IF((PRSI.NE.TORCH).OR. .NOT.QON(TORCH)) GO TO 19600
IF(QON(CANDL)) GO TO 19700
C !ALREADY ON?
CALL NEWSTA(CANDL,521,0,0,0)
C !NO, VAPORIZE.
RETURN
C
19600 CALL RSPEAK(519)
C !CANT LIGHT WITH THAT.
RETURN
C
19700 CALL RSPEAK(520)
C !ALREADY ON.
RETURN
C
20000 IF(OBJ.NE.MATCH) CALL BUG(6,OBJ)
IF((PRSA.NE.TRNONW).OR.(PRSO.NE.MATCH)) GO TO 20500
IF(ORMTCH.NE.0) GO TO 20100
C !ANY MATCHES LEFT?
CALL RSPEAK(183)
C !NO, LOSE.
RETURN
C
20100 ORMTCH=ORMTCH-1
C !DECREMENT NO MATCHES.
OFLAG1(MATCH)=or(OFLAG1(MATCH),FLOBTS)
CTICK(CEVMAT)=2
C !COUNTDOWN.
CALL RSPEAK(184)
RETURN
C
20500 IF((PRSA.NE.TRNOFW).OR.(and(OFLAG1(MATCH),ONBT).EQ.0))
& GO TO 10
OFLAG1(MATCH)=and(OFLAG1(MATCH), not(FLOBTS))
CTICK(CEVMAT)=0
CALL RSPEAK(185)
RETURN
C
C HERE FOR FALSE RETURN
C
10 LIGHTP=.FALSE.
RETURN
END