home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol047 / nobjs.for < prev    next >
Encoding:
Text File  |  1984-04-29  |  19.3 KB  |  695 lines
  1. C NOBJS-    NEW OBJECTS PROCESSOR
  2. C    OBJECTS IN THIS MODULE CANNOT CALL RMINFO, JIGSUP,
  3. C    MAJOR VERBS, OR OTHER NON-RESIDENT SUBROUTINES
  4. C
  5. C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
  6. C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
  7. C WRITTEN BY R. M. SUPNIK
  8. C
  9. C DECLARATIONS
  10. C
  11.     LOGICAL FUNCTION NOBJS(RI,ARG)
  12.     IMPLICIT INTEGER (A-Z)
  13.     LOGICAL QOPEN,MOVETO,F
  14.     LOGICAL QHERE,OPNCLS,MIRPAN
  15. C
  16. C PARSER OUTPUT
  17. C
  18.     LOGICAL PRSWON
  19.     COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON
  20. C
  21. C GAME STATE
  22. C
  23.     LOGICAL TELFLG
  24.     COMMON /PLAY/ WINNER,HERE,TELFLG
  25.     COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD,
  26.     1    LTSHFT,BLOC,MUNGRM,HS,EGSCOR,EGMXSC
  27. C
  28. C SCREEN OF LIGHT
  29. C
  30.     COMMON /SCREEN/ FROMDR,SCOLRM,SCOLAC
  31.     COMMON /SCREEN/ SCOLDR(8),SCOLWL(12)
  32. C
  33. C PUZZLE ROOM
  34. C
  35.     COMMON /PUZZLE/ CPDR(16),CPWL(8),CPVEC(64)
  36. C
  37. C MISCELLANEOUS VARIABLES
  38. C
  39.     COMMON /HYPER/ HFACTR
  40. C
  41. C ROOMS
  42. C
  43.     COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200),
  44.     1    RACTIO(200),RVAL(200),RFLAG(200)
  45.     INTEGER RRAND(200)
  46.     EQUIVALENCE (RVAL,RRAND)
  47. C
  48.     COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR,
  49.     1    RSACRD,RFILL,RMUNG,RBUCK,RHOUSE,RNWALL,REND
  50. C
  51.     COMMON /RINDEX/ WHOUS,LROOM,CELLA
  52.     COMMON /RINDEX/ MTROL,MAZE1    
  53.     COMMON /RINDEX/ MGRAT,MAZ15    
  54.     COMMON /RINDEX/ FORE1,FORE3,CLEAR,RESER
  55.     COMMON /RINDEX/ STREA,EGYPT,ECHOR
  56.     COMMON /RINDEX/ TSHAF    
  57.     COMMON /RINDEX/ BSHAF,MMACH,DOME,MTORC
  58.     COMMON /RINDEX/ CAROU    
  59.     COMMON /RINDEX/ RIDDL,LLD2,TEMP1,TEMP2,MAINT
  60.     COMMON /RINDEX/ BLROO,TREAS,RIVR1,RIVR2,RIVR3,MCYCL
  61.     COMMON /RINDEX/ RIVR4,RIVR5,FCHMP,FALLS,MBARR
  62.     COMMON /RINDEX/ MRAIN,POG,VLBOT,VAIR1,VAIR2,VAIR3,VAIR4
  63.     COMMON /RINDEX/ LEDG2,LEDG3,LEDG4,MSAFE,CAGER
  64.     COMMON /RINDEX/ CAGED,TWELL,BWELL,ALICE,ALISM,ALITR
  65.     COMMON /RINDEX/ MTREE,BKENT,BKVW,BKTWI,BKVAU,BKBOX
  66.     COMMON /RINDEX/ CRYPT,TSTRS,MRANT,MREYE
  67.     COMMON /RINDEX/ MRA,MRB,MRC,MRG,MRD,FDOOR
  68.     COMMON /RINDEX/ MRAE,MRCE,MRCW,MRGE,MRGW,MRDW,INMIR
  69.     COMMON /RINDEX/ SCORR,NCORR,PARAP,CELL,PCELL,NCELL
  70.     COMMON /RINDEX/ CPANT,CPOUT,CPUZZ
  71. C
  72. C OBJECTS
  73. C
  74.     COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
  75.     1    OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
  76.     2    OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
  77.     3    OADV(220),OCAN(220),OREAD(220)
  78. C
  79.     COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT,
  80.     1    NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT,
  81.     2    TOOLBT,TURNBT,ONBT
  82.     COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT,
  83.     1    WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
  84.     2    TCHBT,VEHBT,SCHBT
  85. C
  86.     COMMON /OINDEX/ GARLI,FOOD,GUNK,COAL,MACHI,DIAMO,TCASE,BOTTL
  87.     COMMON /OINDEX/ WATER,ROPE,KNIFE,SWORD,LAMP,BLAMP,RUG
  88.     COMMON /OINDEX/    LEAVE,TROLL,AXE
  89.     COMMON /OINDEX/ RKNIF,KEYS,ICE,BAR
  90.     COMMON /OINDEX/ COFFI,TORCH,TBASK,FBASK,IRBOX
  91.     COMMON /OINDEX/ GHOST,TRUNK,BELL,BOOK,CANDL
  92.     COMMON /OINDEX/ MATCH,TUBE,PUTTY,WRENC,SCREW,CYCLO,CHALI
  93.     COMMON /OINDEX/ THIEF,STILL,WINDO,GRATE,DOOR
  94.     COMMON /OINDEX/ HPOLE,LEAK,RBUTT,RAILI
  95.     COMMON /OINDEX/ POT,STATU,IBOAT,DBOAT,PUMP,RBOAT
  96.     COMMON /OINDEX/ STICK,BUOY,SHOVE,BALLO,RECEP,GUANO
  97.     COMMON /OINDEX/ BROPE,HOOK1,HOOK2,SAFE,SSLOT,BRICK,FUSE
  98.     COMMON /OINDEX/ GNOME,BLABE,DBALL,TOMB
  99.     COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT
  100.     COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE
  101.     COMMON /OINDEX/ ROBOT,FTREE,BILLS,PORTR,SCOL,ZGNOM
  102.     COMMON /OINDEX/ EGG,BEGG,BAUBL,CANAR,BCANA
  103.     COMMON /OINDEX/ YLWAL,RDWAL,PINDR,RBEAM
  104.     COMMON /OINDEX/ ODOOR,QDOOR,CDOOR,NUM1,NUM8
  105.     COMMON /OINDEX/ WARNI,CSLIT,GCARD,STLDR
  106.     COMMON /OINDEX/ HANDS,WALL,LUNGS,SAILO,AVIAT,TEETH
  107.     COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,WNORT,GWATE,MASTER
  108. C
  109. C CLOCK INTERRUPTS
  110. C
  111.     LOGICAL*1 CFLAG
  112.     COMMON /CEVENT/ CLNT,CTICK(25),CACTIO(25),CFLAG(25)
  113. C
  114.     COMMON /CINDEX/ CEVCUR,CEVMNT,CEVLNT,CEVMAT,CEVCND,
  115.     1    CEVBAL,CEVBRN,CEVFUS,CEVLED,CEVSAF,CEVVLG,
  116.     2    CEVGNO,CEVBUC,CEVSPH,CEVEGH,
  117.     3    CEVFOR,CEVSCL,CEVZGI,CEVZGO,CEVSTE,
  118.     5    CEVMRS,CEVPIN,CEVINQ,CEVFOL
  119.  
  120. C
  121. C VILLAINS AND DEMONS
  122. C
  123.     LOGICAL THFFLG,SWDACT,THFACT
  124.     COMMON /HACK/ THFPOS,THFFLG,THFACT,SWDACT,SWDSTA
  125. C
  126. C ADVENTURERS
  127. C
  128.     COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4),
  129.     1    AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4)
  130. C
  131.     COMMON /AINDEX/ PLAYER,AROBOT,AMASTR
  132. C
  133. C VERBS
  134. C
  135.     COMMON /VINDEX/ CINTW,DEADXW,FRSTQW,INXW,OUTXW
  136.     COMMON /VINDEX/ WALKIW,FIGHTW,FOOW
  137.     COMMON /VINDEX/ MELTW,READW,INFLAW,DEFLAW,ALARMW,EXORCW
  138.     COMMON /VINDEX/ PLUGW,KICKW,WAVEW,RAISEW,LOWERW,RUBW
  139.     COMMON /VINDEX/ PUSHW,UNTIEW,TIEW,TIEUPW,TURNW,BREATW
  140.     COMMON /VINDEX/ KNOCKW,LOOKW,EXAMIW,SHAKEW,MOVEW,TRNONW,TRNOFW
  141.     COMMON /VINDEX/ OPENW,CLOSEW,FINDW,WAITW,SPINW,BOARDW,UNBOAW,TAKEW
  142.     COMMON /VINDEX/ INVENW,FILLW,EATW,DRINKW,BURNW
  143.     COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW
  144.     COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW
  145.     COMMON /VINDEX/ DIGW,LEAPW,STAYW,FOLLOW
  146.     COMMON /VINDEX/ HELLOW,LOOKIW,LOOKUW,PUMPW,WINDW
  147.     COMMON /VINDEX/ CLMBW,CLMBUW,CLMBDW,TRNTOW
  148. C
  149. C FLAGS
  150. C
  151.     LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
  152.     LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
  153.     LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
  154.     LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
  155.     LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
  156.     LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF
  157.     LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF
  158.     LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF
  159.     COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF,
  160.     1    DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF,
  161.     2    MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF,
  162.     3    EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF,
  163.     4    GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF,
  164.     5    GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF,
  165.     6    MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF,
  166.     7    FOLLWF,SPELLF,CPOUTF,CPUSHF
  167.     COMMON /FINDEX/ BTIEF,BINFF
  168.     COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA
  169.     COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP
  170.     COMMON /FINDEX/ MDIR,MLOC,POLEUF
  171.     COMMON /FINDEX/ QUESNO,NQATT,CORRCT
  172.     COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE
  173. C
  174. C FUNCTIONS AND DATA
  175. C
  176.     QOPEN(R)=(OFLAG2(R).AND.OPENBT).NE.0
  177. C NOBJS, PAGE 2
  178. C
  179.     IF(PRSO.NE.0) ODO2=ODESC2(PRSO)
  180.     IF(PRSI.NE.0) ODI2=ODESC2(PRSI)
  181.     AV=AVEHIC(WINNER)
  182.     NOBJS=.TRUE.
  183. C
  184.     GO TO (1000,2000,3000,4000,5000,6000,7000,8000,9000,
  185.     1 10000,11000,12000,13000,14000,15000,16000,17000,
  186.     2 18000,19000,20000,21000),
  187.     3    (RI-31)
  188.     CALL BUG(6,RI)
  189. C
  190. C RETURN HERE TO DECLARE FALSE RESULT
  191. C
  192. 10    NOBJS=.FALSE.
  193.     RETURN
  194. C
  195. C O32--    BILLS
  196. C
  197. 1000    IF(PRSA.NE.EATW) GO TO 1100        !EAT?
  198.     CALL RSPEAK(639)            !JOKE.
  199.     RETURN
  200. C
  201. 1100    IF(PRSA.EQ.BURNW) CALL RSPEAK(640)    !BURN?  JOKE.
  202.     GO TO 10                !LET IT BE HANDLED.
  203. C NOBJS, PAGE 3
  204. C
  205. C O33--    SCREEN OF LIGHT
  206. C
  207. 2000    TARGET=SCOL                !TARGET IS SCOL.
  208. 2100    IF(PRSO.NE.TARGET) GO TO 2400        !PRSO EQ TARGET?
  209.     IF((PRSA.NE.PUSHW).AND.(PRSA.NE.MOVEW).AND.
  210.     1    (PRSA.NE.TAKEW).AND.(PRSA.NE.RUBW)) GO TO 2200
  211.     CALL RSPEAK(673)            !HAND PASSES THRU.
  212.     RETURN
  213. C
  214. 2200    IF((PRSA.NE.KILLW).AND.(PRSA.NE.ATTACW).AND.
  215.     1    (PRSA.NE.MUNGW)) GO TO 2400    !AGGRESSIVE?
  216.     CALL RSPSUB(674,ODI2)            !PASSES THRU.
  217.     RETURN
  218. C
  219. 2400    IF((PRSA.NE.THROWW).OR.(PRSI.NE.TARGET)) GO TO 10
  220.     IF(HERE.EQ.BKBOX) GO TO 2600        !THRU SCOL?
  221.     CALL NEWSTA(PRSO,0,BKBOX,0,0)        !NO, THRU WALL.
  222.     CALL RSPSUB(675,ODO2)            !ENDS UP IN BOX ROOM.
  223.     CTICK(CEVSCL)=0                !CANCEL ALARM.
  224.     SCOLRM=0                !RESET SCOL ROOM.
  225.     RETURN
  226. C
  227. 2600    IF(SCOLRM.EQ.0) GO TO 2900        !TRIED TO GO THRU?
  228.     CALL NEWSTA(PRSO,0,SCOLRM,0,0)        !SUCCESS.
  229.     CALL RSPSUB(676,ODO2)            !ENDS UP SOMEWHERE.
  230.     CTICK(CEVSCL)=0            !CANCEL ALARM.
  231.     SCOLRM=0                !RESET SCOL ROOM.
  232.     RETURN
  233. C
  234. 2900    CALL RSPEAK(213)            !CANT DO IT.
  235.     RETURN
  236. C NOBJS, PAGE 4
  237. C
  238. C O34--    GNOME OF ZURICH
  239. C
  240. 3000    IF((PRSA.NE.GIVEW).AND.(PRSA.NE.THROWW)) GO TO 3200
  241.     IF(OTVAL(PRSO).NE.0) GO TO 3100        !THROW A TREASURE?
  242.     CALL NEWSTA(PRSO,641,0,0,0)        !NO, GO POP.
  243.     RETURN
  244. C
  245. 3100    CALL NEWSTA(PRSO,0,0,0,0)        !YES, BYE BYE TREASURE.
  246.     CALL RSPSUB(642,ODO2)
  247.     CALL NEWSTA(ZGNOM,0,0,0,0)        !BYE BYE GNOME.
  248.     CTICK(CEVZGO)=0                !CANCEL EXIT.
  249.     F=MOVETO(BKENT,WINNER)            !NOW IN BANK ENTRANCE.
  250.     RETURN
  251. C
  252. 3200    IF((PRSA.NE.ATTACW).AND.(PRSA.NE.KILLW).AND.
  253.     1    (PRSA.NE.MUNGW)) GO TO 3300    !AGGRESSIVE?
  254.     CALL NEWSTA(ZGNOM,643,0,0,0)        !VANISH GNOME.
  255.     CTICK(CEVZGO)=0                !CANCEL EXIT.
  256.     RETURN
  257. C
  258. 3300    CALL RSPEAK(644)            !GNOME IS IMPATIENT.
  259.     RETURN
  260. C
  261. C O35--    EGG
  262. C
  263. 4000    IF((PRSA.NE.OPENW).OR.(PRSO.NE.EGG)) GO TO 4500
  264.     IF(.NOT.QOPEN(EGG)) GO TO 4100        !OPEN ALREADY?
  265.     CALL RSPEAK(649)            !YES.
  266.     RETURN
  267. C
  268. 4100    IF(PRSI.NE.0) GO TO 4200        !WITH SOMETHING?
  269.     CALL RSPEAK(650)            !NO, CANT.
  270.     RETURN
  271. C
  272. 4200    IF(PRSI.NE.HANDS) GO TO 4300        !WITH HANDS?
  273.     CALL RSPEAK(651)            !NOT RECOMMENDED.
  274.     RETURN
  275. C
  276. 4300    I=652                    !MUNG MESSAGE.
  277.     IF(((OFLAG1(PRSI).AND.TOOLBT).NE.0).OR.
  278.     1    ((OFLAG2(PRSI).AND.WEAPBT).NE.0)) GO TO 4600
  279.     I=653                    !NOVELTY 1.
  280.     IF((OFLAG2(PRSO).AND.FITEBT).NE.0) I=654 !NOVELTY 2.
  281.     OFLAG2(PRSO)=OFLAG2(PRSO).OR.FITEBT
  282.     CALL RSPSUB(I,ODI2)
  283.     RETURN
  284. C
  285. 4500    IF((PRSA.NE.OPENW).AND.(PRSA.NE.MUNGW)) GO TO 4800
  286.     I=655                    !YOU BLEW IT.
  287. 4600    CALL NEWSTA(BEGG,I,OROOM(EGG),OCAN(EGG),OADV(EGG))
  288.     CALL NEWSTA(EGG,0,0,0,0)        !VANISH EGG.
  289.     OTVAL(BEGG)=2                !BAD EGG HAS VALUE.
  290.     IF(OCAN(CANAR).NE.EGG) GO TO 4700    !WAS CANARY INSIDE?
  291.     CALL RSPEAK(ODESCO(BCANA))        !YES, DESCRIBE RESULT.
  292.     OTVAL(BCANA)=1
  293.     RETURN
  294. C
  295. 4700    CALL NEWSTA(BCANA,0,0,0,0)        !NO, VANISH IT.
  296.     RETURN
  297. C
  298. 4800    IF((PRSA.NE.DROPW).OR.(HERE.NE.MTREE)) GO TO 10
  299.     CALL NEWSTA(BEGG,658,FORE3,0,0)    !DROPPED EGG.
  300.     CALL NEWSTA(EGG,0,0,0,0)
  301.     OTVAL(BEGG)=2
  302.     IF(OCAN(CANAR).NE.EGG) GO TO 4700
  303.     OTVAL(BCANA)=1            !BAD CANARY.
  304.     RETURN
  305. C NOBJS, PAGE 5
  306. C
  307. C O36--    CANARIES, GOOD AND BAD
  308. C
  309. 5000    IF(PRSA.NE.WINDW) GO TO 10        !WIND EM UP?
  310.     IF(PRSO.EQ.CANAR) GO TO 5100        !RIGHT ONE?
  311.     CALL RSPEAK(645)            !NO, BAD NEWS.
  312.     RETURN
  313. C
  314. 5100    IF(.NOT.SINGSF.AND.((HERE.EQ.MTREE).OR.
  315.     1    ((HERE.GE.FORE1).AND.(HERE.LT.CLEAR))))
  316.     2    GO TO 5200            !FIRST SONG IN FOR?
  317.     CALL RSPEAK(646)            !NO, MEDIOCRE NEWS.
  318.     RETURN
  319. C
  320. 5200    SINGSF=.TRUE.                !SANG SONG.
  321.     I=HERE
  322.     IF(I.EQ.MTREE) I=FORE3            !PLACE BAUBLE.
  323.     CALL NEWSTA(BAUBL,647,I,0,0)
  324.     RETURN
  325. C
  326. C O37--    WHITE CLIFFS
  327. C
  328. 6000    IF((PRSA.NE.CLMBW).AND.(PRSA.NE.CLMBUW).AND.
  329.     1    (PRSA.NE.CLMBDW)) GO TO 10    !CLIMB?
  330.     CALL RSPEAK(648)            !OH YEAH?
  331.     RETURN
  332. C
  333. C O38--    WALL 
  334. C
  335. 7000    IF((IABS(HERE-MLOC).NE.1).OR.(MRHERE(HERE).NE.0).OR.
  336.     1    (PRSA.NE.PUSHW)) GO TO 7100
  337.     CALL RSPEAK(860)            !PUSHED MIRROR WALL.
  338.     RETURN
  339. C
  340. 7100    IF((RFLAG(HERE).AND.RNWALL).EQ.0) GO TO 10
  341.     CALL RSPEAK(662)            !NO WALL.
  342.     RETURN
  343. C NOBJS, PAGE 6
  344. C
  345. C O39--    SONG BIRD GLOBAL
  346. C
  347. 8000    IF(PRSA.NE.FINDW) GO TO 8100        !FIND?
  348.     CALL RSPEAK(666)
  349.     RETURN
  350. C
  351. 8100    IF(PRSA.NE.EXAMIW) GO TO 10        !EXAMINE?
  352.     CALL RSPEAK(667)
  353.     RETURN
  354. C
  355. C O40--    PUZZLE/SCOL WALLS
  356. C
  357. 9000    IF(HERE.NE.CPUZZ) GO TO 9500        !PUZZLE WALLS?
  358.     IF(PRSA.NE.PUSHW) GO TO 10        !PUSH?
  359.     DO 9100 I=1,8,2                !LOCATE WALL.
  360.       IF(PRSO.EQ.CPWL(I)) GO TO 9200
  361. 9100    CONTINUE
  362.     CALL BUG(80,PRSO)            !WHAT?
  363. C
  364. 9200    J=CPWL(I+1)                !GET DIRECTIONAL OFFSET.
  365.     NXT=CPHERE+J                !GET NEXT STATE.
  366.     WL=CPVEC(NXT)                !GET C(NEXT STATE).
  367.     GO TO (9300,9300,9300,9250,9350),(WL+4)    !PROCESS.
  368. C
  369. 9250    CALL RSPEAK(876)            !CLEAR CORRIDOR.
  370.     RETURN
  371. C
  372. 9300    IF(CPVEC(NXT+J).EQ.0) GO TO 9400    !MOVABLE, ROOM TO MOVE?
  373. 9350    CALL RSPEAK(877)            !IMMOVABLE, NO ROOM.
  374.     RETURN
  375. C
  376. 9400    I=878                    !ASSUME FIRST PUSH.
  377.     IF(CPUSHF) I=879            !NOT?
  378.     CPUSHF=.TRUE.
  379.     CPVEC(NXT+J)=WL                !MOVE WALL.
  380.     CPVEC(NXT)=0                !VACATE NEXT STATE.
  381.     CALL CPGOTO(NXT)            !ONWARD.
  382.     CALL CPINFO(I,NXT)            !DESCRIBE.
  383.     CALL PRINCR(.TRUE.,HERE)        !PRINT ROOMS CONTENTS.
  384.     RFLAG(HERE)=RFLAG(HERE).OR.RSEEN
  385.     RETURN
  386. C
  387. 9500    IF(HERE.NE.SCOLAC) GO TO 9700        !IN SCOL ACTIVE ROOM?
  388.     DO 9600 I=1,12,3
  389.       TARGET=SCOLWL(I+1)            !ASSUME TARGET.
  390.       IF(SCOLWL(I).EQ.HERE) GO TO 2100    !TREAT IF FOUND.
  391. 9600    CONTINUE
  392. C
  393. 9700    IF(HERE.NE.BKBOX) GO TO 10        !IN BOX ROOM?
  394.     TARGET=WNORT
  395.     GO TO 2100
  396. C NOBJS, PAGE 7
  397. C
  398. C O41--    SHORT POLE
  399. C
  400. 10000    IF(PRSA.NE.RAISEW) GO TO 10100        !LIFT?
  401.     I=749                    !ASSUME UP.
  402.     IF(POLEUF.EQ.2) I=750            !ALREADY UP?
  403.     CALL RSPEAK(I)
  404.     POLEUF=2                !POLE IS RAISED.
  405.     RETURN
  406. C
  407. 10100    IF((PRSA.NE.LOWERW).AND.(PRSA.NE.PUSHW)) GO TO 10
  408.     IF(POLEUF.NE.0) GO TO 10200        !ALREADY LOWERED?
  409.     CALL RSPEAK(751)            !CANT DO IT.
  410.     RETURN
  411. C
  412. 10200    IF(MOD(MDIR,180).NE.0) GO TO 10300    !MIRROR N-S?
  413.     POLEUF=0                !YES, LOWER INTO
  414.     CALL RSPEAK(752)            !CHANNEL.
  415.     RETURN
  416. C
  417. 10300    IF((MDIR.NE.270).OR.(MLOC.NE.MRB)) GO TO 10400
  418.     POLEUF=0                !LOWER INTO HOLE.
  419.     CALL RSPEAK(753)
  420.     RETURN
  421. C
  422. 10400    CALL RSPEAK(753+POLEUF)            !POLEUF = 1 OR 2.
  423.     POLEUF=1                !NOW ON FLOOR.
  424.     RETURN
  425. C
  426. C O42--    MIRROR SWITCH
  427. C
  428. 11000    IF(PRSA.NE.PUSHW) GO TO 10        !PUSH?
  429.     IF(MRPSHF) GO TO 11300            !ALREADY PUSHED?
  430.     CALL RSPEAK(756)            !BUTTON GOES IN.
  431.     DO 11100 I=1,OLNT            !BLOCKED?
  432.       IF(QHERE(I,MREYE).AND.(I.NE.RBEAM)) GO TO 11200
  433. 11100    CONTINUE
  434.     CALL RSPEAK(757)            !NOTHING IN BEAM.
  435.     RETURN
  436. C
  437. 11200    CFLAG(CEVMRS)=.TRUE.            !MIRROR OPENS.
  438.     CTICK(CEVMRS)=7
  439.     MRPSHF=.TRUE.
  440.     MROPNF=.TRUE.
  441.     RETURN
  442. C
  443. 11300    CALL RSPEAK(758)            !MIRROR ALREADYOPEN.
  444.     RETURN
  445. C NOBJS, PAGE 8
  446. C
  447. C O43--    BEAM FUNCTION
  448. C
  449. 12000    IF((PRSA.NE.TAKEW).OR.(PRSO.NE.RBEAM)) GO TO 12100
  450.     CALL RSPEAK(759)            !TAKE BEAM, JOKE.
  451.     RETURN
  452. C
  453. 12100    I=PRSO                    !ASSUME BLK WITH DIROBJ.
  454.     IF((PRSA.EQ.PUTW).AND.(PRSI.EQ.RBEAM)) GO TO 12200
  455.     IF((PRSA.NE.MUNGW).OR.(PRSO.NE.RBEAM).OR.
  456.     1    (PRSI.EQ.0)) GO TO 10        !BREAK BEAM WITH X?
  457.     I=PRSI
  458. 12200    IF(OADV(I).NE.WINNER) GO TO 12300    !CARRYING?
  459.     CALL NEWSTA(I,0,HERE,0,0)        !DROP OBJ.
  460.     CALL RSPSUB(760,ODESC2(I))
  461.     RETURN
  462. C
  463. 12300    J=761                    !ASSUME NOT IN ROOM.
  464.     IF(QHERE(J,HERE)) I=762            !IN ROOM?
  465.     CALL RSPSUB(J,ODESC2(I))        !DESCRIBE.
  466.     RETURN
  467. C
  468. C O44--    BRONZE DOOR
  469. C
  470. 13000    IF((HERE.EQ.NCELL).OR.((LCELL.EQ.4).AND.
  471.     1    ((HERE.EQ.CELL).OR.(HERE.EQ.SCORR))))
  472.     2    GO TO 13100
  473.     CALL RSPEAK(763)            !DOOR NOT THERE.
  474.     RETURN
  475. C
  476. 13100    IF(.NOT.OPNCLS(ODOOR,764,765)) GO TO 10    !OPEN/CLOSE?
  477.     IF((HERE.EQ.NCELL).AND.QOPEN(ODOOR))
  478.     1    CALL RSPEAK(766)        !DESCR VIEW.
  479.     RETURN
  480. C
  481. C O45--    QUIZ DOOR
  482. C
  483. 14000    IF((PRSA.NE.OPENW).AND.(PRSA.NE.CLOSEW)) GO TO 14100
  484.     CALL RSPEAK(767)            !DOOR WONT MOVE.
  485.     RETURN
  486. C
  487. 14100    IF(PRSA.NE.KNOCKW) GO TO 10        !KNOCK?
  488.     IF(INQSTF) GO TO 14200        !TRIED IT ALREADY?
  489.     INQSTF=.TRUE.                !START INQUISITION.
  490.     CFLAG(CEVINQ)=.TRUE.
  491.     CTICK(CEVINQ)=2
  492.     QUESNO=RND(8)                !SELECT QUESTION.
  493.     NQATT=0
  494.     CORRCT=0
  495.     CALL RSPEAK(768)            !ANNOUNCE RULES.
  496.     CALL RSPEAK(769)
  497.     CALL RSPEAK(770+QUESNO)            !ASK QUESTION.
  498.     RETURN
  499. C
  500. 14200    CALL RSPEAK(798)            !NO REPLY.
  501.     RETURN
  502. C
  503. C O46--    LOCKED DOOR
  504. C
  505. 15000    IF(PRSA.NE.OPENW) GO TO 10        !OPEN?
  506.     CALL RSPEAK(778)            !CANT.
  507.     RETURN
  508. C
  509. C O47--    CELL DOOR
  510. C
  511. 16000    NOBJS=OPNCLS(CDOOR,779,780)        !OPEN/CLOSE?
  512.     RETURN
  513. C NOBJS, PAGE 9
  514. C
  515. C O48--    DIALBUTTON
  516. C
  517. 17000    IF(PRSA.NE.PUSHW) GO TO 10        !PUSH?
  518.     CALL RSPEAK(809)            !CLICK.
  519.     IF(QOPEN(CDOOR)) CALL RSPEAK(810)    !CLOSE CELL DOOR.
  520. C
  521.     DO 17100 I=1,OLNT            !RELOCATE OLD TO HYPER.
  522.       IF((OROOM(I).EQ.CELL).AND.((OFLAG1(I).AND.DOORBT).EQ.0))
  523.     1    CALL NEWSTA(I,0,LCELL*HFACTR,0,0)
  524.       IF(OROOM(I).EQ.(PNUMB*HFACTR))
  525.     1    CALL NEWSTA(I,0,CELL,0,0)    !MOVE IN NEW HYPER.
  526. 17100    CONTINUE
  527. C
  528.     OFLAG2(ODOOR)=OFLAG2(ODOOR).AND. .NOT.OPENBT
  529.     OFLAG2(CDOOR)=OFLAG2(CDOOR).AND. .NOT.OPENBT
  530.     OFLAG1(ODOOR)=OFLAG1(ODOOR).AND. .NOT.VISIBT
  531.     IF(PNUMB.EQ.4) OFLAG1(ODOOR)=OFLAG1(ODOOR).OR.VISIBT
  532. C
  533.     IF(AROOM(PLAYER).NE.CELL) GO TO 17400    !PLAYER IN CELL?
  534.     IF(LCELL.NE.4) GO TO 17200        !IN RIGHT CELL?
  535.     OFLAG1(ODOOR)=OFLAG1(ODOOR).OR. VISIBT
  536.     F=MOVETO(NCELL,PLAYER)            !YES, MOVETO NCELL.
  537.     GO TO 17400
  538. 17200    F=MOVETO(PCELL,PLAYER)            !NO, MOVETO PCELL.
  539. C
  540. 17400    LCELL=PNUMB
  541.     RETURN
  542. C NOBJS, PAGE 10
  543. C
  544. C O49--    DIAL INDICATOR
  545. C
  546. 18000    IF(PRSA.NE.SPINW) GO TO 18100        !SPIN?
  547.     PNUMB=RND(8)+1                !WHEE!
  548.     CALL RSPSUB(797,712+PNUMB)
  549.     RETURN
  550. C
  551. 18100    IF((PRSA.NE.MOVEW).AND.(PRSA.NE.PUTW).AND.
  552.     1    (PRSA.NE.TRNTOW)) GO TO 10
  553.     IF(PRSI.NE.0) GO TO 18200        !TURN DIAL TO X?
  554.     CALL RSPEAK(806)            !MUST SPECIFY.
  555.     RETURN
  556. C
  557. 18200    IF((PRSI.GE.NUM1).AND.(PRSI.LE.NUM8)) GO TO 18300
  558.     CALL RSPEAK(807)            !MUST BE DIGIT.
  559.     RETURN
  560. C
  561. 18300    PNUMB=PRSI-NUM1+1            !SET UP NEW.
  562.     CALL RSPSUB(808,712+PNUMB)
  563.     RETURN
  564. C
  565. C O50--    GLOBAL MIRROR
  566. C
  567. 19000    NOBJS=MIRPAN(832,.FALSE.)
  568.     RETURN
  569. C
  570. C O51--    GLOBAL PANEL
  571. C
  572. 20000    IF(HERE.NE.FDOOR) GO TO 20100        !AT FRONT DOOR?
  573.     IF((PRSA.NE.OPENW).AND.(PRSA.NE.CLOSEW)) GO TO 10
  574.     CALL RSPEAK(843)            !PANEL IN DOOR, NOGO.
  575.     RETURN
  576. C
  577. 20100    NOBJS=MIRPAN(838,.TRUE.)
  578.     RETURN
  579. C
  580. C O52--    PUZZLE ROOM SLIT
  581. C
  582. 21000    IF((PRSA.NE.PUTW).OR.(PRSI.NE.CSLIT)) GO TO 10
  583.     IF(PRSO.NE.GCARD) GO TO 21100        !PUT CARD IN SLIT?
  584.     CALL NEWSTA(PRSO,863,0,0,0)        !KILL CARD.
  585.     CPOUTF=.TRUE.                !OPEN DOOR.
  586.     OFLAG1(STLDR)=OFLAG1(STLDR).AND..NOT.VISIBT    !VANISH DOOR.
  587.     RETURN
  588. C
  589. 21100    IF(((OFLAG1(PRSO).AND.VICTBT).EQ.0).AND.
  590.     1  ((OFLAG2(PRSO).AND.VILLBT).EQ.0)) GO TO 21200
  591.     CALL RSPEAK(RND(5)+552)            !JOKE FOR VILL, VICT.
  592.     RETURN
  593. C
  594. 21200    CALL NEWSTA(PRSO,0,0,0,0)        !KILL OBJECT.
  595.     CALL RSPSUB(864,ODO2)            !DESCRIBE.
  596.     RETURN
  597. C
  598.     END
  599. C MIRPAN--    PROCESSOR FOR GLOBAL MIRROR/PANEL
  600. C
  601. C DECLARATIONS
  602. C
  603.     LOGICAL FUNCTION MIRPAN(ST,PNF)
  604.     IMPLICIT INTEGER(A-Z)
  605.     LOGICAL PNF
  606. C
  607. C GAME STATE
  608. C
  609.     LOGICAL TELFLG
  610.     COMMON /PLAY/ WINNER,HERE,TELFLG
  611. C
  612. C PARSER OUTPUT
  613. C
  614.     LOGICAL PRSWON
  615.     COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON
  616. C
  617. C VERBS
  618. C
  619.     COMMON /VINDEX/ CINTW,DEADXW,FRSTQW,INXW,OUTXW
  620.     COMMON /VINDEX/ WALKIW,FIGHTW,FOOW
  621.     COMMON /VINDEX/ MELTW,READW,INFLAW,DEFLAW,ALARMW,EXORCW
  622.     COMMON /VINDEX/ PLUGW,KICKW,WAVEW,RAISEW,LOWERW,RUBW
  623.     COMMON /VINDEX/ PUSHW,UNTIEW,TIEW,TIEUPW,TURNW,BREATW
  624.     COMMON /VINDEX/ KNOCKW,LOOKW,EXAMIW,SHAKEW,MOVEW,TRNONW,TRNOFW
  625.     COMMON /VINDEX/ OPENW,CLOSEW,FINDW,WAITW,SPINW,BOARDW,UNBOAW,TAKEW
  626.     COMMON /VINDEX/ INVENW,FILLW,EATW,DRINKW,BURNW
  627.     COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW
  628.     COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW
  629.     COMMON /VINDEX/ DIGW,LEAPW,STAYW,FOLLOW
  630.     COMMON /VINDEX/ HELLOW,LOOKIW,LOOKUW,PUMPW,WINDW
  631.     COMMON /VINDEX/ CLMBW,CLMBUW,CLMBDW,TRNTOW
  632. C
  633. C FLAGS
  634. C
  635.     LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
  636.     LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
  637.     LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
  638.     LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
  639.     LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
  640.     LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF
  641.     LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF
  642.     LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF
  643.     COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF,
  644.     1    DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF,
  645.     2    MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF,
  646.     3    EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF,
  647.     4    GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF,
  648.     5    GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF,
  649.     6    MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF,
  650.     7    FOLLWF,SPELLF,CPOUTF,CPUSHF
  651.     COMMON /FINDEX/ BTIEF,BINFF
  652.     COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA
  653.     COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP
  654.     COMMON /FINDEX/ MDIR,MLOC,POLEUF
  655.     COMMON /FINDEX/ QUESNO,NQATT,CORRCT
  656.     COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE
  657. C MIRPAN, PAGE 2
  658. C
  659.     MIRPAN=.TRUE.
  660.     NUM=MRHERE(HERE)            !GET MIRROR NUM.
  661.     IF(NUM.NE.0) GO TO 100            !ANY HERE?
  662.     CALL RSPEAK(ST)                !NO, LOSE.
  663.     RETURN
  664. C
  665. 100    MRBF=0                    !ASSUME MIRROR OK.
  666.     IF(((NUM.EQ.1).AND..NOT.MR1F).OR.
  667.     1  ((NUM.EQ.2).AND..NOT.MR2F)) MRBF=1
  668.     IF((PRSA.NE.MOVEW).AND.(PRSA.NE.OPENW)) GO TO 200
  669.     CALL RSPEAK(ST+1)            !CANT OPEN OR MOVE.
  670.     RETURN
  671. C
  672. 200    IF(PNF.OR.((PRSA.NE.LOOKIW).AND.(PRSA.NE.EXAMIW).AND.
  673.     1    (PRSA.NE.LOOKW))) GO TO 300
  674.     CALL RSPEAK(844+MRBF)            !LOOK IN MIRROR.
  675.     RETURN
  676. C
  677. 300    IF(PRSA.NE.MUNGW) GO TO 400        !BREAK?
  678.     CALL RSPEAK(ST+2+MRBF)            !DO IT.
  679.     IF((NUM.EQ.1).AND..NOT.PNF) MR1F=.FALSE.
  680.     IF((NUM.EQ.2).AND..NOT.PNF) MR2F=.FALSE.
  681.     RETURN
  682. C
  683. 400    IF(PNF.OR.(MRBF.EQ.0)) GO TO 500    !BROKEN MIRROR?
  684.     CALL RSPEAK(846)
  685.     RETURN
  686. C
  687. 500    IF(PRSA.NE.PUSHW) GO TO 600        !PUSH?
  688.     CALL RSPEAK(ST+3+NUM)
  689.     RETURN
  690. C
  691. 600    MIRPAN=.FALSE.            !CANT HANDLE IT.
  692.     RETURN
  693. C
  694.     END
  695.