home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol045 / dverb2.ftn < prev    next >
Encoding:
Text File  |  1984-04-29  |  17.5 KB  |  650 lines
  1. C SAVE- SAVE GAME STATE
  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 SAVEGM
  10.     IMPLICIT INTEGER (A-Z)
  11. C
  12. C PARSER OUTPUT
  13. C
  14.     LOGICAL PRSWON
  15.     COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON
  16. C
  17. C GAME STATE
  18. C
  19.     LOGICAL TELFLG
  20.     COMMON /PLAY/ WINNER,HERE,TELFLG
  21.     COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD,
  22.     1    LTSHFT,BLOC,MUNGRM,HS,EGSCOR,EGMXSC
  23. C
  24. C SCREEN OF LIGHT
  25. C
  26.     COMMON /SCREEN/ FROMDR,SCOLRM,SCOLAC
  27. C
  28. C PUZZLE ROOM
  29. C
  30.     COMMON /PUZZLE/ CPDR(16),CPWL(8),CPVEC(64)
  31. C
  32. C MISCELLANEOUS VARIABLES
  33. C
  34.     COMMON /VERS/ VMAJ,VMIN,VEDIT
  35.     COMMON /TIME/ PLTIME,SHOUR,SMIN,SSEC
  36. C
  37. C ROOMS
  38. C
  39.     COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200),
  40.     1    RACTIO(200),RVAL(200),RFLAG(200)
  41.     INTEGER RRAND(200)
  42.     EQUIVALENCE (RVAL,RRAND)
  43. C
  44. C EXITS
  45. C
  46.     COMMON /EXITS/ XLNT,TRAVEL(900)
  47. C
  48. C OBJECTS
  49. C
  50.     COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
  51.     1    OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
  52.     2    OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
  53.     3    OADV(220),OCAN(220),OREAD(220)
  54. C
  55. C
  56. C CLOCK INTERRUPTS
  57. C
  58.     LOGICAL*1 CFLAG
  59.     COMMON /CEVENT/ CLNT,CTICK(25),CACTIO(25),CFLAG(25)
  60. C
  61. C
  62. C VILLAINS AND DEMONS
  63. C
  64.     LOGICAL THFFLG,SWDACT,THFACT
  65.     COMMON /HACK/ THFPOS,THFFLG,THFACT,SWDACT,SWDSTA
  66.     COMMON /VILL/ VLNT,VILLNS(4),VPROB(4),VOPPS(4),VBEST(4),VMELEE(4)
  67. C
  68. C ADVENTURERS
  69. C
  70.     COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4),
  71.     1    AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4)
  72. C
  73. C FLAGS
  74. C
  75.     LOGICAL*1 FLAGS(46)
  76.     INTEGER SWITCH(22)
  77.     COMMON /FINDEX/ FLAGS,SWITCH
  78. C
  79.     PRSWON=.FALSE.                !DISABLE GAME.
  80.     OPEN (UNIT=1,NAME='DSAVE.DAT',ACCESS='SEQUENTIAL',
  81.     1    TYPE='UNKNOWN',FORM='UNFORMATTED',ERR=100)
  82. C
  83.     CALL GTTIME(I)                !GET TIME.
  84.     WRITE(1) VMAJ,VMIN,VEDIT
  85.     WRITE(1) WINNER,HERE,THFPOS,TELFLG,THFFLG,THFACT,
  86.     1    SWDACT,SWDSTA,CPVEC
  87.     WRITE(1) I,MOVES,DEATHS,RWSCOR,EGSCOR,MXLOAD,
  88.     1    LTSHFT,BLOC,MUNGRM,HS,FROMDR,SCOLRM,SCOLAC
  89.     WRITE(1) ODESC1,ODESC2,OFLAG1,OFLAG2,OFVAL,OTVAL,
  90.     1    OSIZE,OCAPAC,OROOM,OADV,OCAN
  91.     WRITE(1) RVAL,RFLAG
  92.     WRITE(1) AROOM,ASCORE,AVEHIC,ASTREN,AFLAG
  93.     WRITE(1) FLAGS,SWITCH,VPROB,CFLAG,CTICK
  94. C
  95.     CLOSE(UNIT=1)
  96.     CALL RSPEAK(597)
  97.     RETURN
  98. C
  99. 100    CALL RSPEAK(598)            !CANT DO IT.
  100.     RETURN
  101.     END
  102. C RESTORE- RESTORE GAME STATE
  103. C
  104. C DECLARATIONS
  105. C
  106.     SUBROUTINE RSTRGM
  107.     IMPLICIT INTEGER (A-Z)
  108. C
  109. C PARSER OUTPUT
  110. C
  111.     LOGICAL PRSWON
  112.     COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON
  113. C
  114. C GAME STATE
  115. C
  116.     LOGICAL TELFLG
  117.     COMMON /PLAY/ WINNER,HERE,TELFLG
  118.     COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD,
  119.     1    LTSHFT,BLOC,MUNGRM,HS,EGSCOR,EGMXSC
  120. C
  121. C SCREEN OF LIGHT
  122. C
  123.     COMMON /SCREEN/ FROMDR,SCOLRM,SCOLAC
  124. C
  125. C PUZZLE ROOM
  126. C
  127.     COMMON /PUZZLE/ CPDR(16),CPWL(8),CPVEC(64)
  128. C
  129. C MISCELLANEOUS VARIABLES
  130. C
  131.     COMMON /VERS/ VMAJ,VMIN,VEDIT
  132.     COMMON /TIME/ PLTIME,SHOUR,SMIN,SSEC
  133. C
  134. C ROOMS
  135. C
  136.     COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200),
  137.     1    RACTIO(200),RVAL(200),RFLAG(200)
  138.     INTEGER RRAND(200)
  139.     EQUIVALENCE (RVAL,RRAND)
  140. C
  141. C EXITS
  142. C
  143.     COMMON /EXITS/ XLNT,TRAVEL(900)
  144. C
  145. C OBJECTS
  146. C
  147.     COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
  148.     1    OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
  149.     2    OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
  150.     3    OADV(220),OCAN(220),OREAD(220)
  151. C
  152. C
  153. C CLOCK INTERRUPTS
  154. C
  155.     LOGICAL*1 CFLAG
  156.     COMMON /CEVENT/ CLNT,CTICK(25),CACTIO(25),CFLAG(25)
  157. C
  158. C
  159. C VILLAINS AND DEMONS
  160. C
  161.     LOGICAL THFFLG,SWDACT,THFACT
  162.     COMMON /HACK/ THFPOS,THFFLG,THFACT,SWDACT,SWDSTA
  163.     COMMON /VILL/ VLNT,VILLNS(4),VPROB(4),VOPPS(4),VBEST(4),VMELEE(4)
  164. C
  165. C ADVENTURERS
  166. C
  167.     COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4),
  168.     1    AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4)
  169. C
  170. C FLAGS
  171. C
  172.     LOGICAL*1 FLAGS(46)
  173.     INTEGER SWITCH(22)
  174.     COMMON /FINDEX/ FLAGS,SWITCH
  175. C
  176.     PRSWON=.FALSE.            !DISABLE GAME.
  177.     OPEN (UNIT=1,NAME='DSAVE.DAT',ACCESS='SEQUENTIAL',
  178.     1    TYPE='OLD',READONLY,FORM='UNFORMATTED',ERR=100)
  179. C
  180.     READ(1) I,J,K
  181.     IF((I.NE.VMAJ).OR.(J.NE.VMIN)) GO TO 200
  182. C
  183.     READ(1) WINNER,HERE,THFPOS,TELFLG,THFFLG,THFACT,
  184.     1    SWDACT,SWDSTA,CPVEC
  185.     READ(1) PLTIME,MOVES,DEATHS,RWSCOR,EGSCOR,MXLOAD,
  186.     1    LTSHFT,BLOC,MUNGRM,HS,FROMDR,SCOLRM,SCOLAC
  187.     READ(1) ODESC1,ODESC2,OFLAG1,OFLAG2,OFVAL,OTVAL,
  188.     1    OSIZE,OCAPAC,OROOM,OADV,OCAN
  189.     READ(1) RVAL,RFLAG
  190.     READ(1) AROOM,ASCORE,AVEHIC,ASTREN,AFLAG
  191.     READ(1) FLAGS,SWITCH,VPROB,CFLAG,CTICK
  192. C
  193.     CLOSE(UNIT=1)
  194.     CALL RSPEAK(599)
  195.     RETURN
  196. C
  197. 100    CALL RSPEAK(598)            !CANT DO IT.
  198.     RETURN
  199. C
  200. 200    CALL RSPEAK(600)            !OBSOLETE VERSION
  201.     CLOSE (UNIT=1)
  202.     RETURN
  203.     END
  204. C WALK- MOVE IN SPECIFIED DIRECTION
  205. C
  206. C DECLARATIONS
  207. C
  208.     LOGICAL FUNCTION WALK(X)
  209.     IMPLICIT INTEGER(A-Z)
  210.     LOGICAL FINDXT,QOPEN,LIT,PROB,MOVETO,RMDESC
  211. C
  212. C PARSER OUTPUT
  213. C
  214.     LOGICAL PRSWON
  215.     COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON
  216. C
  217. C GAME STATE
  218. C
  219.     LOGICAL TELFLG
  220.     COMMON /PLAY/ WINNER,HERE,TELFLG
  221. C
  222. C ROOMS
  223. C
  224.     COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200),
  225.     1    RACTIO(200),RVAL(200),RFLAG(200)
  226.     INTEGER RRAND(200)
  227.     EQUIVALENCE (RVAL,RRAND)
  228. C
  229.     COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR,
  230.     1    RSACRD,RFILL,RMUNG,RBUCK,RHOUSE,RNWALL,REND
  231. C
  232. C EXITS
  233. C
  234.     COMMON /CURXT/ XTYPE,XROOM1,XSTRNG,XACTIO,XOBJ
  235.     EQUIVALENCE (XFLAG,XOBJ)
  236. C
  237.     COMMON /XSRCH/ XMIN,XMAX,XDOWN,XUP,
  238.     1    XNORTH,XSOUTH,XENTER,XEXIT,XEAST,XWEST
  239. C
  240. C OBJECTS
  241. C
  242.     COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
  243.     1    OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
  244.     2    OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
  245.     3    OADV(220),OCAN(220),OREAD(220)
  246. C
  247.     COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT,
  248.     1    NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT,
  249.     2    TOOLBT,TURNBT,ONBT
  250.     COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT,
  251.     1    WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
  252.     2    TCHBT,VEHBT,SCHBT
  253. C
  254.     LOGICAL*1 CFLAG
  255.     COMMON /CEVENT/ CLNT,CTICK(25),CACTIO(25),CFLAG(25)
  256. C
  257.     COMMON /CINDEX/ CEVCUR,CEVMNT,CEVLNT,CEVMAT,CEVCND,
  258.     1    CEVBAL,CEVBRN,CEVFUS,CEVLED,CEVSAF,CEVVLG,
  259.     2    CEVGNO,CEVBUC,CEVSPH,CEVEGH,
  260.     3    CEVFOR,CEVSCL,CEVZGI,CEVZGO,CEVSTE,
  261.     5    CEVMRS,CEVPIN,CEVINQ,CEVFOL
  262.  
  263. C
  264. C VILLAINS AND DEMONS
  265. C
  266.     LOGICAL THFFLG,SWDACT,THFACT
  267.     COMMON /HACK/ THFPOS,THFFLG,THFACT,SWDACT
  268.     COMMON /VILL/ VLNT,VILLNS(4),VPROB(4),VOPPS(4),VBEST(4),VMELEE(4)
  269. C
  270. C ADVENTURERS
  271. C
  272.     COMMON /AINDEX/ PLAYER,AROBOT,AMASTR
  273. C
  274. C FLAGS
  275. C
  276.     LOGICAL*1 FLAGS(46)
  277.     EQUIVALENCE (FLAGS(1),TROLLF)
  278.     LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
  279.     LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
  280.     LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
  281.     LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
  282.     LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
  283.     LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF
  284.     LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF
  285.     LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF
  286.     COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF,
  287.     1    DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF,
  288.     2    MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF,
  289.     3    EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF,
  290.     4    GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF,
  291.     5    GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF,
  292.     6    MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF,
  293.     7    FOLLWF,SPELLF,CPOUTF,CPUSHF
  294.     COMMON /FINDEX/ BTIEF,BINFF
  295.     COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA
  296.     COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP
  297.     COMMON /FINDEX/ MDIR,MLOC,POLEUF
  298.     COMMON /FINDEX/ QUESNO,NQATT,CORRCT
  299.     COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE
  300. C
  301. C FUNCTIONS AND DATA
  302. C
  303.     QOPEN(O)=(OFLAG2(O).AND.OPENBT).NE.0
  304. C WALK, PAGE 2
  305. C
  306.     WALK=.TRUE.                !ASSUME WINS.
  307.     IF((WINNER.NE.PLAYER).OR.LIT(HERE).OR.PROB(25,25))
  308.     1    GO TO 500
  309.     IF(.NOT.FINDXT(PRSO,HERE)) GO TO 450    !INVALID EXIT? GRUE!
  310.     GO TO (400,200,100,300),XTYPE        !DECODE EXIT TYPE.
  311.     CALL BUG(9,XTYPE)
  312. C
  313. 100    IF(CXAPPL(XACTIO).NE.0) GO TO 400    !CEXIT... RETURNED ROOM?
  314.     IF(FLAGS(XFLAG)) GO TO 400        !NO, FLAG ON?
  315. 200    CALL JIGSUP(523)            !BAD EXIT, GRUE!
  316.     RETURN
  317. C
  318. 300    IF(CXAPPL(XACTIO).NE.0) GO TO 400    !DOOR... RETURNED ROOM?
  319.     IF(QOPEN(XOBJ)) GO TO 400        !NO, DOOR OPEN?
  320.     CALL JIGSUP(523)            !BAD EXIT, GRUE!
  321.     RETURN
  322. C
  323. 400    IF(LIT(XROOM1)) GO TO 900        !VALID ROOM, IS IT LIT?
  324. 450    CALL JIGSUP(522)            !NO, GRUE!
  325.     RETURN
  326. C
  327. C ROOM IS LIT, OR WINNER IS NOT PLAYER (NO GRUE).
  328. C
  329. 500    IF(FINDXT(PRSO,HERE)) GO TO 550        !EXIT EXIST?
  330. 525    XSTRNG=678                !ASSUME WALL.
  331.     IF(PRSO.EQ.XUP) XSTRNG=679        !IF UP, CANT.
  332.     IF(PRSO.EQ.XDOWN) XSTRNG=680        !IF DOWN, CANT.
  333.     IF((RFLAG(HERE).AND.RNWALL).NE.0) XSTRNG=524
  334.     CALL RSPEAK(XSTRNG)
  335.     PRSCON=1                !STOP CMD STREAM.
  336.     RETURN
  337. C
  338. 550    GO TO (900,600,700,800),XTYPE    !BRANCH ON EXIT TYPE.
  339.     CALL BUG(9,XTYPE)
  340. C
  341. 700    IF(CXAPPL(XACTIO).NE.0) GO TO 900    !CEXIT... RETURNED ROOM?
  342.     IF(FLAGS(XFLAG)) GO TO 900        !NO, FLAG ON?
  343. 600    IF(XSTRNG.EQ.0) GO TO 525        !IF NO REASON, USE STD.
  344.     CALL RSPEAK(XSTRNG)            !DENY EXIT.
  345.     PRSCON=1                !STOP CMD STREAM.
  346.     RETURN
  347. C
  348. 800    IF(CXAPPL(XACTIO).NE.0) GO TO 900    !DOOR... RETURNED ROOM?
  349.     IF(QOPEN(XOBJ)) GO TO 900        !NO, DOOR OPEN?
  350.     IF(XSTRNG.EQ.0) XSTRNG=525        !IF NO REASON, USE STD.
  351.     CALL RSPSUB(XSTRNG,ODESC2(XOBJ))
  352.     PRSCON=1                !STOP CMD STREAM.
  353.     RETURN
  354. C
  355. 900    WALK=MOVETO(XROOM1,WINNER)        !MOVE TO ROOM.
  356.     IF(WALK) WALK=RMDESC(0)            !DESCRIBE ROOM.
  357.     RETURN
  358.     END
  359. C CXAPPL- CONDITIONAL EXIT PROCESSORS
  360. C
  361. C DECLARATIONS
  362. C
  363.     INTEGER FUNCTION CXAPPL(RI)
  364.     IMPLICIT INTEGER (A-Z)
  365. C
  366. C GAME STATE
  367. C
  368.     LOGICAL TELFLG
  369.     COMMON /PLAY/ WINNER,HERE,TELFLG
  370. C
  371. C PARSER OUTPUT
  372. C
  373.     LOGICAL PRSWON
  374.     COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON
  375. C
  376. C PUZZLE ROOM
  377. C
  378.     COMMON /PUZZLE/ CPDR(16),CPWL(8),CPVEC(64)
  379. C
  380. C ROOMS
  381. C
  382.     COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200),
  383.     1    RACTIO(200),RVAL(200),RFLAG(200)
  384.     INTEGER RRAND(200)
  385.     EQUIVALENCE (RVAL,RRAND)
  386. C
  387.     COMMON /RINDEX/ WHOUS,LROOM,CELLA
  388.     COMMON /RINDEX/ MTROL,MAZE1    
  389.     COMMON /RINDEX/ MGRAT,MAZ15    
  390.     COMMON /RINDEX/ FORE1,FORE3,CLEAR,RESER
  391.     COMMON /RINDEX/ STREA,EGYPT,ECHOR
  392.     COMMON /RINDEX/ TSHAF    
  393.     COMMON /RINDEX/ BSHAF,MMACH,DOME,MTORC
  394.     COMMON /RINDEX/ CAROU    
  395.     COMMON /RINDEX/ RIDDL,LLD2,TEMP1,TEMP2,MAINT
  396.     COMMON /RINDEX/ BLROO,TREAS,RIVR1,RIVR2,RIVR3,MCYCL
  397.     COMMON /RINDEX/ RIVR4,RIVR5,FCHMP,FALLS,MBARR
  398.     COMMON /RINDEX/ MRAIN,POG,VLBOT,VAIR1,VAIR2,VAIR3,VAIR4
  399.     COMMON /RINDEX/ LEDG2,LEDG3,LEDG4,MSAFE,CAGER
  400.     COMMON /RINDEX/ CAGED,TWELL,BWELL,ALICE,ALISM,ALITR
  401.     COMMON /RINDEX/ MTREE,BKENT,BKVW,BKTWI,BKVAU,BKBOX
  402.     COMMON /RINDEX/ CRYPT,TSTRS,MRANT,MREYE
  403.     COMMON /RINDEX/ MRA,MRB,MRC,MRG,MRD,FDOOR
  404.     COMMON /RINDEX/ MRAE,MRCE,MRCW,MRGE,MRGW,MRDW,INMIR
  405.     COMMON /RINDEX/ SCORR,NCORR,PARAP,CELL,PCELL,NCELL
  406.     COMMON /RINDEX/ CPANT,CPOUT,CPUZZ
  407. C
  408. C EXITS
  409. C
  410.     COMMON /EXITS/ XLNT,TRAVEL(900)
  411. C
  412.     COMMON /CURXT/ XTYPE,XROOM1,XSTRNG,XACTIO,XOBJ
  413.     EQUIVALENCE (XFLAG,XOBJ)
  414. C
  415.     COMMON /XPARS/ XRMASK,XDMASK,XFMASK,XFSHFT,XASHFT,
  416.     1    XELNT(4),XNORM,XNO,XCOND,XDOOR,XLFLAG
  417. C
  418.     COMMON /XSRCH/ XMIN,XMAX,XDOWN,XUP,
  419.     1    XNORTH,XSOUTH,XENTER,XEXIT,XEAST,XWEST
  420. C
  421. C OBJECTS
  422. C
  423.     COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
  424.     1    OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
  425.     2    OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
  426.     3    OADV(220),OCAN(220),OREAD(220)
  427. C
  428.     COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT,
  429.     1    NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT,
  430.     2    TOOLBT,TURNBT,ONBT
  431.     COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT,
  432.     1    WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
  433.     2    TCHBT,VEHBT,SCHBT
  434. C
  435.     COMMON /OINDEX/ GARLI,FOOD,GUNK,COAL,MACHI,DIAMO,TCASE,BOTTL
  436.     COMMON /OINDEX/ WATER,ROPE,KNIFE,SWORD,LAMP,BLAMP,RUG
  437.     COMMON /OINDEX/    LEAVE,TROLL,AXE
  438.     COMMON /OINDEX/ RKNIF,KEYS,ICE,BAR
  439.     COMMON /OINDEX/ COFFI,TORCH,TBASK,FBASK,IRBOX
  440.     COMMON /OINDEX/ GHOST,TRUNK,BELL,BOOK,CANDL
  441.     COMMON /OINDEX/ MATCH,TUBE,PUTTY,WRENC,SCREW,CYCLO,CHALI
  442.     COMMON /OINDEX/ THIEF,STILL,WINDO,GRATE,DOOR
  443.     COMMON /OINDEX/ HPOLE,LEAK,RBUTT,RAILI
  444.     COMMON /OINDEX/ POT,STATU,IBOAT,DBOAT,PUMP,RBOAT
  445.     COMMON /OINDEX/ STICK,BUOY,SHOVE,BALLO,RECEP,GUANO
  446.     COMMON /OINDEX/ BROPE,HOOK1,HOOK2,SAFE,SSLOT,BRICK,FUSE
  447.     COMMON /OINDEX/ GNOME,BLABE,DBALL,TOMB
  448.     COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT
  449.     COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE
  450.     COMMON /OINDEX/ ROBOT,FTREE,BILLS,PORTR,SCOL,ZGNOM
  451.     COMMON /OINDEX/ EGG,BEGG,BAUBL,CANAR,BCANA
  452.     COMMON /OINDEX/ YLWAL,RDWAL,PINDR,RBEAM
  453.     COMMON /OINDEX/ ODOOR,QDOOR,CDOOR,NUM1,NUM8
  454.     COMMON /OINDEX/ WARNI,CSLIT,GCARD,STLDR
  455.     COMMON /OINDEX/ HANDS,WALL,LUNGS,SAILO,AVIAT,TEETH
  456.     COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,WNORT,GWATE,MASTER
  457. C
  458.     COMMON /AINDEX/ PLAYER,AROBOT,AMASTR
  459. C
  460. C FLAGS
  461. C
  462.     LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
  463.     LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
  464.     LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
  465.     LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
  466.     LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
  467.     LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF
  468.     LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF
  469.     LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF
  470.     COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF,
  471.     1    DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF,
  472.     2    MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF,
  473.     3    EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF,
  474.     4    GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF,
  475.     5    GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF,
  476.     6    MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF,
  477.     7    FOLLWF,SPELLF,CPOUTF,CPUSHF
  478.     COMMON /FINDEX/ BTIEF,BINFF
  479.     COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA
  480.     COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP
  481.     COMMON /FINDEX/ MDIR,MLOC,POLEUF
  482.     COMMON /FINDEX/ QUESNO,NQATT,CORRCT
  483.     COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE
  484. C CXAPPL, PAGE 2
  485. C
  486.     CXAPPL=0                !NO RETURN.
  487.     IF(RI.EQ.0) RETURN            !IF NO ACTION, DONE.
  488.     GO TO (1000,2000,3000,4000,5000,6000,7000,
  489.     1    8000,9000,10000,11000,12000,13000,14000),RI
  490.     CALL BUG(5,RI)
  491. C
  492. C C1- COFFIN-CURE
  493. C
  494. 1000    EGYPTF=OADV(COFFI).NE.WINNER        !T IF NO COFFIN.
  495.     RETURN
  496. C
  497. C C2- CAROUSEL EXIT
  498. C C5- CAROUSEL OUT
  499. C
  500. 2000    IF(CAROFF) RETURN            !IF FLIPPED, NOTHING.
  501. 2500    CALL RSPEAK(121)            !SPIN THE COMPASS.
  502. 5000    I=XELNT(XCOND)*RND(8)            !CHOOSE RANDOM EXIT.
  503.     XROOM1=(TRAVEL(REXIT(HERE)+I)).AND.XRMASK
  504.     CXAPPL=XROOM1                !RETURN EXIT.
  505.     RETURN
  506. C
  507. C C3- CHIMNEY FUNCTION
  508. C
  509. 3000    LITLDF=.FALSE.            !ASSUME HEAVY LOAD.
  510.     J=0
  511.     DO 3100 I=1,OLNT            !COUNT OBJECTS.
  512.       IF(OADV(I).EQ.WINNER) J=J+1
  513. 3100    CONTINUE
  514. C
  515.     IF(J.GT.2) RETURN            !CARRYING TOO MUCH?
  516.     XSTRNG=446                !ASSUME NO LAMP.
  517.     IF(OADV(LAMP).NE.WINNER) RETURN        !NO LAMP?
  518.     LITLDF=.TRUE.                !HE CAN DO IT.
  519.     IF((OFLAG2(DOOR).AND.OPENBT).EQ.0)
  520.     1    OFLAG2(DOOR)=OFLAG2(DOOR).AND. .NOT.TCHBT
  521.     RETURN
  522. C
  523. C C4-    FROBOZZ FLAG (MAGNET ROOM, FAKE EXIT)
  524. C C6-    FROBOZZ FLAG (MAGNET ROOM, REAL EXIT)
  525. C
  526. 4000    IF(CAROFF) GO TO 2500            !IF FLIPPED, GO SPIN.
  527.     FROBZF=.FALSE.                !OTHERWISE, NOT AN EXIT.
  528.     RETURN
  529. C
  530. 6000    IF(CAROFF) GO TO 2500            !IF FLIPPED, GO SPIN.
  531.     FROBZF=.TRUE.                !OTHERWISE, AN EXIT.
  532.     RETURN
  533. C
  534. C C7-    FROBOZZ FLAG (BANK ALARM)
  535. C
  536. 7000    FROBZF=(OROOM(BILLS).NE.0).AND.(OROOM(PORTR).NE.0)
  537.     RETURN
  538. C CXAPPL, PAGE 3
  539. C
  540. C C8-    FROBOZZ FLAG (MRGO)
  541. C
  542. 8000    FROBZF=.FALSE.                !ASSUME CANT MOVE.
  543.     IF(MLOC.NE.XROOM1) GO TO 8100        !MIRROR IN WAY?
  544.     IF((PRSO.EQ.XNORTH).OR.(PRSO.EQ.XSOUTH)) GO TO 8200
  545.     IF(MOD(MDIR,180).NE.0) GO TO 8300    !MIRROR MUST BE N-S.
  546.     XROOM1=((XROOM1-MRA)*2)+MRAE        !CALC EAST ROOM.
  547.     IF(PRSO.GT.XSOUTH) XROOM1=XROOM1+1    !IF SW/NW, CALC WEST.
  548. 8100    CXAPPL=XROOM1
  549.     RETURN
  550. C
  551. 8200    XSTRNG=814                !ASSUME STRUC BLOCKS.
  552.     IF(MOD(MDIR,180).EQ.0) RETURN        !IF MIRROR N-S, DONE.
  553. 8300    LDIR=MDIR                !SEE WHICH MIRROR.
  554.     IF(PRSO.EQ.XSOUTH) LDIR=180
  555.     XSTRNG=815                !MIRROR BLOCKS.
  556.     IF(((LDIR.GT.180).AND..NOT.MR1F).OR.
  557.     1  ((LDIR.LT.180).AND..NOT.MR2F)) XSTRNG=816 !MIRROR BROKEN.
  558.     RETURN
  559. C
  560. C C9-    FROBOZZ FLAG (MIRIN)
  561. C
  562. 9000    IF(MRHERE(HERE).NE.1) GO TO 9100    !MIRROR 1 HERE?
  563.     IF(MR1F) XSTRNG=805            !SEE IF BROKEN.
  564.     FROBZF=MROPNF                !ENTER IF OPEN.
  565.     RETURN
  566. C
  567. 9100    FROBZF=.FALSE.                !NOT HERE,
  568.     XSTRNG=817                !LOSE.
  569.     RETURN
  570. C CXAPPL, PAGE 4
  571. C
  572. C C10-    FROBOZZ FLAG (MIRROR EXIT)
  573. C
  574. 10000    FROBZF=.FALSE.                !ASSUME CANT.
  575.     LDIR=((PRSO-XNORTH)/XNORTH)*45        !XLATE DIR TO DEGREES.
  576.     IF(.NOT.MROPNF .OR.
  577.     1    ((MOD(MDIR+270,360).NE.LDIR).AND.(PRSO.NE.XEXIT)))
  578.     2    GO TO 10200            !EXIT VIA MIRROR?
  579.     XROOM1=((MLOC-MRA)*2)+MRAE+1-(MDIR/180)    !ASSUME E-W EXIT.
  580.     IF(MOD(MDIR,180).EQ.0) GO TO 10100    !IF N-S, OK.
  581.     XROOM1=MLOC+1                !ASSUME N EXIT.
  582.     IF(MDIR.GT.180) XROOM1=MLOC-1        !IF SOUTH.
  583. 10100    CXAPPL=XROOM1
  584.     RETURN
  585. C
  586. 10200    IF(.NOT.WDOPNF .OR.
  587.     1    ((MOD(MDIR+180,360).NE.LDIR).AND.(PRSO.NE.XEXIT)))
  588.     2    RETURN                !EXIT VIA OPEN DOOR?
  589.     XROOM1=MLOC+1                !ASSUME N.
  590.     IF(MDIR.EQ.0) XROOM1=MLOC-1        !IF S.
  591.     CALL RSPEAK(818)            !CLOSE DOOR.
  592.     WDOPNF=.FALSE.
  593.     CXAPPL=XROOM1
  594.     RETURN
  595. C
  596. C C11-    MAYBE DOOR.  NORMAL MESSAGE IS THAT DOOR IS CLOSED.
  597. C    BUT IF LCELL.NE.4, DOOR ISNT THERE.
  598. C
  599. 11000    IF(LCELL.NE.4) XSTRNG=678        !SET UP MSG.
  600.     RETURN
  601. C
  602. C C12-    FROBZF (PUZZLE ROOM MAIN ENTRANCE)
  603. C
  604. 12000    FROBZF=.TRUE.                !ALWAYS ENTER.
  605.     CPHERE=10                !SET SUBSTATE.
  606.     RETURN
  607. C
  608. C C13-    CPOUTF (PUZZLE ROOM SIZE ENTRANCE)
  609. C
  610. 13000    CPHERE=52                !SET SUBSTATE.
  611.     RETURN
  612. C CXAPPL, PAGE 5
  613. C
  614. C C14-    FROBZF (PUZZLE ROOM TRANSITIONS)
  615. C
  616. 14000    FROBZF=.FALSE.                !ASSSUME LOSE.
  617.     IF(PRSO.NE.XUP) GO TO 14100        !UP?
  618.     IF(CPHERE.NE.10) RETURN            !AT EXIT?
  619.     XSTRNG=881                !ASSUME NO LADDER.
  620.     IF(CPVEC(CPHERE+1).NE.-2) RETURN    !LADDER HERE?
  621.     CALL RSPEAK(882)            !YOU WIN.
  622.     FROBZF=.TRUE.                !LET HIM OUT.
  623.     RETURN
  624. C
  625. 14100    IF((CPHERE.NE.52).OR.(PRSO.NE.XWEST).OR..NOT.CPOUTF)
  626.     1    GO TO 14200            !W EXIT AT DOOR?
  627.     FROBZF=.TRUE.                !YES, LET HIM OUT.
  628.     RETURN
  629. C
  630. 14200    DO 14300 I=1,16,2            !LOCATE EXIT.
  631.       IF(PRSO.EQ.CPDR(I)) GO TO 14400
  632. 14300    CONTINUE
  633.     RETURN                    !NO SUCH EXIT.
  634. C
  635. 14400    J=CPDR(I+1)                !GET DIRECTIONAL OFFSET.
  636.     NXT=CPHERE+J                !GET NEXT STATE.
  637.     K=8                    !GET ORTHOGONAL DIR.
  638.     IF(J.LT.0) K=-8
  639.     IF((((IABS(J).EQ.1).OR.(IABS(J).EQ.8)).OR.
  640.     1   ((CPVEC(CPHERE+K).EQ.0).OR.(CPVEC(NXT-K).EQ.0))).AND.
  641.     2    (CPVEC(NXT).EQ.0)) GO TO 14500    !CANT DO IT?
  642.     RETURN
  643. C
  644. 14500    CALL CPGOTO(NXT)            !MOVE TO STATE.
  645.     XROOM1=CPUZZ                !STAY IN ROOM.
  646.     CXAPPL=XROOM1
  647.     RETURN
  648. C
  649.     END
  650.