home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol046 / lightp.for < prev    next >
Encoding:
Text File  |  1984-04-29  |  5.9 KB  |  187 lines
  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. C
  13. C PARSER OUTPUT
  14. C
  15.     LOGICAL PRSWON
  16.     COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON
  17. C
  18. C GAME STATE
  19. C
  20.     LOGICAL TELFLG
  21.     COMMON /PLAY/ WINNER,HERE,TELFLG
  22. C
  23. C OBJECTS
  24. C
  25.     COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
  26.     1    OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
  27.     2    OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
  28.     3    OADV(220),OCAN(220),OREAD(220)
  29. C
  30.     COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT,
  31.     1    NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT,
  32.     2    TOOLBT,TURNBT,ONBT
  33.     COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT,
  34.     1    WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
  35.     2    TCHBT,VEHBT,SCHBT
  36. C
  37.     COMMON /OINDEX/ GARLI,FOOD,GUNK,COAL,MACHI,DIAMO,TCASE,BOTTL
  38.     COMMON /OINDEX/ WATER,ROPE,KNIFE,SWORD,LAMP,BLAMP,RUG
  39.     COMMON /OINDEX/    LEAVE,TROLL,AXE
  40.     COMMON /OINDEX/ RKNIF,KEYS,ICE,BAR
  41.     COMMON /OINDEX/ COFFI,TORCH,TBASK,FBASK,IRBOX
  42.     COMMON /OINDEX/ GHOST,TRUNK,BELL,BOOK,CANDL
  43.     COMMON /OINDEX/ MATCH,TUBE,PUTTY,WRENC,SCREW,CYCLO,CHALI
  44.     COMMON /OINDEX/ THIEF,STILL,WINDO,GRATE,DOOR
  45.     COMMON /OINDEX/ HPOLE,LEAK,RBUTT,RAILI
  46.     COMMON /OINDEX/ POT,STATU,IBOAT,DBOAT,PUMP,RBOAT
  47.     COMMON /OINDEX/ STICK,BUOY,SHOVE,BALLO,RECEP,GUANO
  48.     COMMON /OINDEX/ BROPE,HOOK1,HOOK2,SAFE,SSLOT,BRICK,FUSE
  49.     COMMON /OINDEX/ GNOME,BLABE,DBALL,TOMB
  50.     COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT
  51.     COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE
  52.     COMMON /OINDEX/ ROBOT,FTREE,BILLS,PORTR,SCOL,ZGNOM
  53.     COMMON /OINDEX/ EGG,BEGG,BAUBL,CANAR,BCANA
  54.     COMMON /OINDEX/ YLWAL,RDWAL,PINDR,RBEAM
  55.     COMMON /OINDEX/ ODOOR,QDOOR,CDOOR,NUM1,NUM8
  56.     COMMON /OINDEX/ WARNI,CSLIT,GCARD,STLDR
  57.     COMMON /OINDEX/ HANDS,WALL,LUNGS,SAILO,AVIAT,TEETH
  58.     COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,WNORT,GWATE,MASTER
  59. C
  60. C CLOCK INTERRUPTS
  61. C
  62.     LOGICAL*1 CFLAG
  63.     COMMON /CEVENT/ CLNT,CTICK(25),CACTIO(25),CFLAG(25)
  64. C
  65.     COMMON /CINDEX/ CEVCUR,CEVMNT,CEVLNT,CEVMAT,CEVCND,
  66.     1    CEVBAL,CEVBRN,CEVFUS,CEVLED,CEVSAF,CEVVLG,
  67.     2    CEVGNO,CEVBUC,CEVSPH,CEVEGH,
  68.     3    CEVFOR,CEVSCL,CEVZGI,CEVZGO,CEVSTE,
  69.     5    CEVMRS,CEVPIN,CEVINQ,CEVFOL
  70.  
  71. C
  72. C VERBS
  73. C
  74.     COMMON /VINDEX/ CINTW,DEADXW,FRSTQW,INXW,OUTXW
  75.     COMMON /VINDEX/ WALKIW,FIGHTW,FOOW
  76.     COMMON /VINDEX/ MELTW,READW,INFLAW,DEFLAW,ALARMW,EXORCW
  77.     COMMON /VINDEX/ PLUGW,KICKW,WAVEW,RAISEW,LOWERW,RUBW
  78.     COMMON /VINDEX/ PUSHW,UNTIEW,TIEW,TIEUPW,TURNW,BREATW
  79.     COMMON /VINDEX/ KNOCKW,LOOKW,EXAMIW,SHAKEW,MOVEW,TRNONW,TRNOFW
  80.     COMMON /VINDEX/ OPENW,CLOSEW,FINDW,WAITW,SPINW,BOARDW,UNBOAW,TAKEW
  81.     COMMON /VINDEX/ INVENW,FILLW,EATW,DRINKW,BURNW
  82.     COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW
  83.     COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW
  84.     COMMON /VINDEX/ DIGW,LEAPW,STAYW,FOLLOW
  85.     COMMON /VINDEX/ HELLOW,LOOKIW,LOOKUW,PUMPW,WINDW
  86.     COMMON /VINDEX/ CLMBW,CLMBUW,CLMBDW,TRNTOW
  87. C
  88. C FLAGS
  89. C
  90.     LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
  91.     LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
  92.     LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
  93.     LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
  94.     LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
  95.     LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF
  96.     LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF
  97.     LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF
  98.     COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF,
  99.     1    DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF,
  100.     2    MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF,
  101.     3    EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF,
  102.     4    GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF,
  103.     5    GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF,
  104.     6    MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF,
  105.     7    FOLLWF,SPELLF,CPOUTF,CPUSHF
  106.     COMMON /FINDEX/ BTIEF,BINFF
  107.     COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA
  108.     COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP
  109.     COMMON /FINDEX/ MDIR,MLOC,POLEUF
  110.     COMMON /FINDEX/ QUESNO,NQATT,CORRCT
  111.     COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE
  112. C
  113. C FUNCTIONS AND DATA
  114. C
  115.     QON(R)=(OFLAG1(R).AND.ONBT).NE.0
  116. C LIGHTP, PAGE 2
  117. C
  118.     LIGHTP=.TRUE.                !ASSUME WINS
  119.     FLOBTS=FLAMBT+LITEBT+ONBT
  120.     IF(OBJ.NE.CANDL) GO TO 20000        !CANDLE?
  121.     IF(ORCAND.NE.0) GO TO 19100        !FIRST REF?
  122.     ORCAND=1                !YES, CANDLES ARE
  123.     CTICK(CEVCND)=50            !BURNING WHEN SEEN.
  124. C
  125. 19100    IF(PRSI.EQ.CANDL) GO TO 10        !IGNORE IND REFS.
  126.     IF(PRSA.NE.TRNOFW) GO TO 19200        !TURN OFF?
  127.     I=513                    !ASSUME OFF.
  128.     IF(QON(CANDL)) I=514            !IF ON, DIFFERENT.
  129.     CFLAG(CEVCND)=.FALSE.            !DISABLE COUNTDOWN.
  130.     OFLAG1(CANDL)=OFLAG1(CANDL).AND. .NOT.ONBT
  131.     CALL RSPEAK(I)
  132.     RETURN
  133. C
  134. 19200    IF((PRSA.NE.BURNW).AND.(PRSA.NE.TRNONW)) GO TO 10
  135.     IF((OFLAG1(CANDL).AND.LITEBT).NE.0) GO TO 19300
  136.     CALL RSPEAK(515)            !CANDLES TOO SHORT.
  137.     RETURN
  138. C
  139. 19300    IF(PRSI.NE.0) GO TO 19400        !ANY FLAME?
  140.     CALL RSPEAK(516)            !NO, LOSE.
  141.     PRSWON=.FALSE.
  142.     RETURN
  143. C
  144. 19400    IF((PRSI.NE.MATCH).OR. .NOT.QON(MATCH)) GO TO 19500
  145.     I=517                    !ASSUME OFF.
  146.     IF(QON(CANDL)) I=518            !IF ON, JOKE.
  147.     OFLAG1(CANDL)=OFLAG1(CANDL).OR.ONBT    !LITE CANDLES.
  148.     CFLAG(CEVCND)=.TRUE.            !RESUME COUNTDOWN.
  149.     CALL RSPEAK(I)
  150.     RETURN
  151. C
  152. 19500    IF((PRSI.NE.TORCH).OR. .NOT.QON(TORCH)) GO TO 19600
  153.     IF(QON(CANDL)) GO TO 19700        !ALREADY ON?
  154.     CALL NEWSTA(CANDL,521,0,0,0)        !NO, VAPORIZE.
  155.     RETURN
  156. C
  157. 19600    CALL RSPEAK(519)            !CANT LIGHT WITH THAT.
  158.     RETURN
  159. C
  160. 19700    CALL RSPEAK(520)            !ALREADY ON.
  161.     RETURN
  162. C
  163. 20000    IF(OBJ.NE.MATCH) CALL BUG(6,OBJ)
  164.     IF((PRSA.NE.TRNONW).OR.(PRSO.NE.MATCH)) GO TO 20500
  165.     IF(ORMTCH.NE.0) GO TO 20100        !ANY MATCHES LEFT?
  166.     CALL RSPEAK(183)            !NO, LOSE.
  167.     RETURN
  168. C
  169. 20100    ORMTCH=ORMTCH-1                !DECREMENT NO MATCHES.
  170.     OFLAG1(MATCH)=OFLAG1(MATCH).OR.FLOBTS
  171.     CTICK(CEVMAT)=2                !COUNTDOWN.
  172.     CALL RSPEAK(184)
  173.     RETURN
  174. C
  175. 20500    IF((PRSA.NE.TRNOFW).OR.((OFLAG1(MATCH).AND.ONBT).EQ.0))
  176.     1    GO TO 10            !EXTINGUISH?
  177.     OFLAG1(MATCH)=OFLAG1(MATCH).AND. .NOT.FLOBTS
  178.     CTICK(CEVMAT)=0
  179.     CALL RSPEAK(185)
  180.     RETURN
  181. C
  182. C HERE FOR FALSE RETURN
  183. C
  184. 10    LIGHTP=.FALSE.
  185.     RETURN
  186.     END
  187.