home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1994 March / Source_Code_CD-ROM_Walnut_Creek_March_1994.iso / compsrcs / games / vmsnet / dungeon / part25 < prev    next >
Encoding:
Internet Message Format  |  1992-02-23  |  47.1 KB
  1. Path: uunet!paladin.american.edu!gatech!nntp.msstate.edu!emory!dragon.com!cts
  2. From: cts@dragon.com
  3. Newsgroups: vmsnet.sources.games
  4. Subject: Dungeon Part 25/30
  5. Message-ID: <1992Feb24.013636.818@dragon.com>
  6. Date: 24 Feb 92 06:36:36 GMT
  7. Organization: Computer Projects Unlimited
  8. Lines: 1556
  9.  
  10. -+-+-+-+-+-+-+-+ START OF PART 25 -+-+-+-+-+-+-+-+
  11. X525   XSTRNG=678
  12. XC                                               !ASSUME WALL.
  13. X      IF(PRSO.EQ.XUP) XSTRNG=679
  14. XC                                               !IF UP, CANT.
  15. X      IF(PRSO.EQ.XDOWN) XSTRNG=680
  16. XC                                               !IF DOWN, CANT.
  17. X      IF(and(RFLAG(HERE),RNWALL).NE.0) XSTRNG=524
  18. X      CALL RSPEAK(XSTRNG)
  19. X      PRSCON=1
  20. XC                                               !STOP CMD STREAM.
  21. X      RETURN
  22. XC
  23. X550   GO TO (900,600,700,800),XTYPE
  24. XC                                               !BRANCH ON EXIT TYPE.
  25. X      CALL BUG(9,XTYPE)
  26. XC
  27. X700   IF(CXAPPL(XACTIO).NE.0) GO TO 900
  28. XC                                               !CEXIT... RETURNED ROOM?
  29. X      IF(FLAGS(XFLAG)) GO TO 900
  30. XC                                               !NO, FLAG ON?
  31. X600   IF(XSTRNG.EQ.0) GO TO 525
  32. XC                                               !IF NO REASON, USE STD.
  33. X      CALL RSPEAK(XSTRNG)
  34. XC                                               !DENY EXIT.
  35. X      PRSCON=1
  36. XC                                               !STOP CMD STREAM.
  37. X      RETURN
  38. XC
  39. X800   IF(CXAPPL(XACTIO).NE.0) GO TO 900
  40. XC                                               !DOOR... RETURNED ROOM?
  41. X      IF(QOPEN(XOBJ)) GO TO 900
  42. XC                                               !NO, DOOR OPEN?
  43. X      IF(XSTRNG.EQ.0) XSTRNG=525
  44. XC                                               !IF NO REASON, USE STD.
  45. X      CALL RSPSUB(XSTRNG,ODESC2(XOBJ))
  46. X      PRSCON=1
  47. XC                                               !STOP CMD STREAM.
  48. X      RETURN
  49. XC
  50. X900   WALK=MOVETO(XROOM1,WINNER)
  51. XC                                               !MOVE TO ROOM.
  52. X      IF(WALK) WALK=RMDESC(0)
  53. XC                                               !DESCRIBE ROOM.
  54. X      RETURN
  55. X      END
  56. X`0C
  57. XC CXAPPL- CONDITIONAL EXIT PROCESSORS
  58. XC
  59. XC DECLARATIONS
  60. XC
  61. X      INTEGER FUNCTION CXAPPL(RI)
  62. X      IMPLICIT INTEGER (A-Z)
  63. X
  64. X      INCLUDE 'GAMESTATE.LIB'
  65. X      INCLUDE 'PARSER.LIB'
  66. X      INCLUDE 'PUZZLE.LIB'
  67. X      INCLUDE 'ROOMS.LIB'
  68. X      INCLUDE 'RINDEX.LIB'
  69. X      INCLUDE 'EXITS.LIB'
  70. X      INCLUDE 'CURXT.LIB'
  71. X      INCLUDE 'XPARS.LIB'
  72. X      INCLUDE 'XSRCH.LIB'
  73. X      INCLUDE 'OBJECTS.LIB'
  74. X      INCLUDE 'OFLAGS.LIB'
  75. X      INCLUDE 'OINDEX.LIB'
  76. X      INCLUDE 'ADVERS.LIB'
  77. X      INCLUDE 'FLAGS.LIB'
  78. X`0C
  79. XC CXAPPL, PAGE 2
  80. XC
  81. X      CXAPPL=0
  82. XC                                               !NO RETURN.
  83. X      IF(RI.EQ.0) RETURN
  84. XC                                               !IF NO ACTION, DONE.
  85. X      GO TO (1000,2000,3000,4000,5000,6000,7000,
  86. X     &       8000,9000,10000,11000,12000,13000,14000),RI
  87. X      CALL BUG(5,RI)
  88. XC
  89. XC C1- COFFIN-CURE
  90. XC
  91. X1000  EGYPTF=OADV(COFFI).NE.WINNER
  92. XC                                               !T IF NO COFFIN.
  93. X      RETURN
  94. XC
  95. XC C2- CAROUSEL EXIT
  96. XC C5- CAROUSEL OUT
  97. XC
  98. X2000  IF(CAROFF) RETURN
  99. XC                                               !IF FLIPPED, NOTHING.
  100. X2500  CALL RSPEAK(121)
  101. XC                                               !SPIN THE COMPASS.
  102. X5000  I=XELNT(XCOND)*RND(8)
  103. XC                                               !CHOOSE RANDOM EXIT.
  104. X      XROOM1=and(TRAVEL(REXIT(HERE)+I),XRMASK)
  105. X      CXAPPL=XROOM1
  106. XC                                               !RETURN EXIT.
  107. X      RETURN
  108. XC
  109. XC C3- CHIMNEY FUNCTION
  110. XC
  111. X3000  LITLDF=.FALSE.
  112. XC                                               !ASSUME HEAVY LOAD.
  113. X      J=0
  114. X      DO 3100 I=1,OLNT
  115. XC                                               !COUNT OBJECTS.
  116. X        IF(OADV(I).EQ.WINNER) J=J+1
  117. X3100  CONTINUE
  118. XC
  119. X      IF(J.GT.2) RETURN
  120. XC                                               !CARRYING TOO MUCH?
  121. X      XSTRNG=446
  122. XC                                               !ASSUME NO LAMP.
  123. X      IF(OADV(LAMP).NE.WINNER) RETURN
  124. XC                                               !NO LAMP?
  125. X      LITLDF=.TRUE.
  126. XC                                               !HE CAN DO IT.
  127. X      IF(and(OFLAG2(DOOR),OPENBT).EQ.0)
  128. X     &   OFLAG2(DOOR)=and(OFLAG2(DOOR), not(TCHBT))
  129. X      RETURN
  130. XC
  131. XC C4-   FROBOZZ FLAG (MAGNET ROOM, FAKE EXIT)
  132. XC C6-   FROBOZZ FLAG (MAGNET ROOM, REAL EXIT)
  133. XC
  134. X4000  IF(CAROFF) GO TO 2500
  135. XC                                               !IF FLIPPED, GO SPIN.
  136. X      FROBZF=.FALSE.
  137. XC                                               !OTHERWISE, NOT AN EXIT.
  138. X      RETURN
  139. XC
  140. X6000  IF(CAROFF) GO TO 2500
  141. XC                                               !IF FLIPPED, GO SPIN.
  142. X      FROBZF=.TRUE.
  143. XC                                               !OTHERWISE, AN EXIT.
  144. X      RETURN
  145. XC
  146. XC C7-   FROBOZZ FLAG (BANK ALARM)
  147. XC
  148. X7000  FROBZF=and((OROOM(BILLS).NE.0),(OROOM(PORTR).NE.0))
  149. X      RETURN
  150. X`0C
  151. XC CXAPPL, PAGE 3
  152. XC
  153. XC C8-   FROBOZZ FLAG (MRGO)
  154. XC
  155. X8000  FROBZF=.FALSE.
  156. XC                                               !ASSUME CANT MOVE.
  157. X      IF(MLOC.NE.XROOM1) GO TO 8100
  158. XC                                               !MIRROR IN WAY?
  159. X      IF((PRSO.EQ.XNORTH).OR.(PRSO.EQ.XSOUTH)) GO TO 8200
  160. X      IF(MOD(MDIR,180).NE.0) GO TO 8300
  161. XC                                               !MIRROR MUST BE N-S.
  162. X      XROOM1=((XROOM1-MRA)*2)+MRAE
  163. XC                                               !CALC EAST ROOM.
  164. X      IF(PRSO.GT.XSOUTH) XROOM1=XROOM1+1
  165. XC                                               !IF SW/NW, CALC WEST.
  166. X8100  CXAPPL=XROOM1
  167. X      RETURN
  168. XC
  169. X8200  XSTRNG=814
  170. XC                                               !ASSUME STRUC BLOCKS.
  171. X      IF(MOD(MDIR,180).EQ.0) RETURN
  172. XC                                               !IF MIRROR N-S, DONE.
  173. X8300  LDIR=MDIR
  174. XC                                               !SEE WHICH MIRROR.
  175. X      IF(PRSO.EQ.XSOUTH) LDIR=180
  176. X      XSTRNG=815
  177. XC                                               !MIRROR BLOCKS.
  178. X      IF(((LDIR.GT.180).AND..NOT.MR1F).OR.
  179. X     &   ((LDIR.LT.180).AND..NOT.MR2F)) XSTRNG=816
  180. X      RETURN
  181. XC
  182. XC C9-   FROBOZZ FLAG (MIRIN)
  183. XC
  184. X9000  IF(MRHERE(HERE).NE.1) GO TO 9100
  185. XC                                               !MIRROR 1 HERE?
  186. X      IF(MR1F) XSTRNG=805
  187. XC                                               !SEE IF BROKEN.
  188. X      FROBZF=MROPNF
  189. XC                                               !ENTER IF OPEN.
  190. X      RETURN
  191. XC
  192. X9100  FROBZF=.FALSE.
  193. XC                                               !NOT HERE,
  194. X      XSTRNG=817
  195. XC                                               !LOSE.
  196. X      RETURN
  197. X`0C
  198. XC CXAPPL, PAGE 4
  199. XC
  200. XC C10-  FROBOZZ FLAG (MIRROR EXIT)
  201. XC
  202. X10000 FROBZF=.FALSE.
  203. XC                                               !ASSUME CANT.
  204. X      LDIR=((PRSO-XNORTH)/XNORTH)*45
  205. XC                                               !XLATE DIR TO DEGREES.
  206. X      IF(.NOT.MROPNF .OR.
  207. X     &  ((MOD(MDIR+270,360).NE.LDIR).AND.(PRSO.NE.XEXIT)))
  208. X     &GO TO 10200
  209. X      XROOM1=((MLOC-MRA)*2)+MRAE+1-(MDIR/180)
  210. XC                                               !ASSUME E-W EXIT.
  211. X      IF(MOD(MDIR,180).EQ.0) GO TO 10100
  212. XC                                               !IF N-S, OK.
  213. X      XROOM1=MLOC+1
  214. XC                                               !ASSUME N EXIT.
  215. X      IF(MDIR.GT.180) XROOM1=MLOC-1
  216. XC                                               !IF SOUTH.
  217. X10100 CXAPPL=XROOM1
  218. X      RETURN
  219. XC
  220. X10200 IF(.NOT.WDOPNF .OR.
  221. X     &    ((MOD(MDIR+180,360).NE.LDIR).AND.(PRSO.NE.XEXIT)))
  222. X     &RETURN
  223. X      XROOM1=MLOC+1
  224. XC                                               !ASSUME N.
  225. X      IF(MDIR.EQ.0) XROOM1=MLOC-1
  226. XC                                               !IF S.
  227. X      CALL RSPEAK(818)
  228. XC                                               !CLOSE DOOR.
  229. X      WDOPNF=.FALSE.
  230. X      CXAPPL=XROOM1
  231. X      RETURN
  232. XC
  233. XC C11-  MAYBE DOOR.  NORMAL MESSAGE IS THAT DOOR IS CLOSED.
  234. XC       BUT IF LCELL.NE.4, DOOR ISNT THERE.
  235. XC
  236. X11000 IF(LCELL.NE.4) XSTRNG=678
  237. XC                                               !SET UP MSG.
  238. X      RETURN
  239. XC
  240. XC C12-  FROBZF (PUZZLE ROOM MAIN ENTRANCE)
  241. XC
  242. X12000 FROBZF=.TRUE.
  243. XC                                               !ALWAYS ENTER.
  244. X      CPHERE=10
  245. XC                                               !SET SUBSTATE.
  246. X      RETURN
  247. XC
  248. XC C13-  CPOUTF (PUZZLE ROOM SIZE ENTRANCE)
  249. XC
  250. X13000 CPHERE=52
  251. XC                                               !SET SUBSTATE.
  252. X      RETURN
  253. X`0C
  254. XC CXAPPL, PAGE 5
  255. XC
  256. XC C14-  FROBZF (PUZZLE ROOM TRANSITIONS)
  257. XC
  258. X14000 FROBZF=.FALSE.
  259. XC                                               !ASSSUME LOSE.
  260. X      IF(PRSO.NE.XUP) GO TO 14100
  261. XC                                               !UP?
  262. X      IF(CPHERE.NE.10) RETURN
  263. XC                                               !AT EXIT?
  264. X      XSTRNG=881
  265. XC                                               !ASSUME NO LADDER.
  266. X      IF(CPVEC(CPHERE+1).NE.-2) RETURN
  267. XC                                               !LADDER HERE?
  268. X      CALL RSPEAK(882)
  269. XC                                               !YOU WIN.
  270. X      FROBZF=.TRUE.
  271. XC                                               !LET HIM OUT.
  272. X      RETURN
  273. XC
  274. X14100 IF((CPHERE.NE.52).OR.(PRSO.NE.XWEST).OR..NOT.CPOUTF)
  275. X     &GO TO 14200
  276. X      FROBZF=.TRUE.
  277. XC                                               !YES, LET HIM OUT.
  278. X      RETURN
  279. XC
  280. X14200 DO 14300 I=1,16,2
  281. XC                                               !LOCATE EXIT.
  282. X        IF(PRSO.EQ.CPDR(I)) GO TO 14400
  283. X14300 CONTINUE
  284. X      RETURN
  285. XC                                               !NO SUCH EXIT.
  286. XC
  287. X14400 J=CPDR(I+1)
  288. XC                                               !GET DIRECTIONAL OFFSET.
  289. X      NXT=CPHERE+J
  290. XC                                               !GET NEXT STATE.
  291. X      K=8
  292. XC                                               !GET ORTHOGONAL DIR.
  293. X      IF(J.LT.0) K=-8
  294. X      IF((((IABS(J).EQ.1).OR.(IABS(J).EQ.8)).OR.
  295. X     &   ((CPVEC(CPHERE+K).EQ.0).OR.(CPVEC(NXT-K).EQ.0))).AND.
  296. X     &    (CPVEC(NXT).EQ.0)) GO TO 14500
  297. X      RETURN
  298. XC
  299. X14500 CALL CPGOTO(NXT)
  300. XC                                               !MOVE TO STATE.
  301. X      XROOM1=CPUZZ
  302. XC                                               !STAY IN ROOM.
  303. X      CXAPPL=XROOM1
  304. X      RETURN
  305. XC
  306. X      END
  307. $ CALL UNPACK [.SRC]DVERB2.FOR;1 1165527564
  308. $ create 'f'
  309. XC
  310. XC EXITS
  311. XC
  312. X      COMMON /EXITS/ XLNT,TRAVEL(900)
  313. $ CALL UNPACK [.SRC]EXITS.LIB;1 1846676531
  314. $ create 'f'
  315. X      Parameter INDXFILE='dindx.dat'
  316. X      Parameter TEXTFILE='dtext.dat'
  317. X      character*128 filedir
  318. $ CALL UNPACK [.SRC]FILES.LIB;3 1427397779
  319. $ create 'f'
  320. XC
  321. XC FLAGS
  322. XC
  323. X      LOGICAL TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
  324. X      LOGICAL DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
  325. X      LOGICAL MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
  326. X      LOGICAL EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
  327. X      LOGICAL GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
  328. X      LOGICAL GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF
  329. X      LOGICAL MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF
  330. X      LOGICAL FOLLWF,SPELLF,CPOUTF,CPUSHF
  331. X      COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF,
  332. X     &`09`09DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF,
  333. X     &`09`09MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF,
  334. X     &`09`09EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF,
  335. X     &`09`09GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF,
  336. X     &`09`09GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF,
  337. X     &`09`09MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF,
  338. X     &`09`09FOLLWF,SPELLF,CPOUTF,CPUSHF
  339. X      COMMON /FINDEX/ BTIEF,BINFF
  340. X      COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA
  341. X      COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP
  342. X      COMMON /FINDEX/ MDIR,MLOC,POLEUF
  343. X      COMMON /FINDEX/ QUESNO,NQATT,CORRCT
  344. X      COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE
  345. X
  346. X      LOGICAL FLAGS(46)
  347. X      EQUIVALENCE (FLAGS(1),TROLLF)
  348. X      INTEGER SWITCH(22)
  349. X      EQUIVALENCE (SWITCH(1), BTIEF)
  350. $ CALL UNPACK [.SRC]FLAGS.LIB;1 1277628691
  351. $ create 'f'
  352. XC
  353. XC GAME STATE
  354. XC
  355. X      LOGICAL TELFLG
  356. X      COMMON /PLAY/ WINNER,HERE,TELFLG
  357. $ CALL UNPACK [.SRC]GAMESTATE.LIB;1 1513897159
  358. $ create 'f'
  359. XC GDT- GAME DEBUGGING TOOL
  360. XC
  361. XC COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
  362. XC ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
  363. XC WRITTEN BY R. M. SUPNIK
  364. XC
  365. XC DECLARATIONS
  366. XC
  367. X      SUBROUTINE GDT
  368. X      IMPLICIT INTEGER (A-Z)
  369. X      CHARACTER*2 DBGCMD(38),CMD
  370. X      INTEGER ARGTYP(38)
  371. X      LOGICAL VALID1,VALID2,VALID3
  372. X      character*2 ldbgcm(38)
  373. X
  374. X      INCLUDE 'PARSER.LIB'
  375. X      INCLUDE 'GAMESTATE.LIB'
  376. X      INCLUDE 'STATE.LIB'
  377. X      INCLUDE 'SCREEN.LIB'
  378. X      INCLUDE 'PUZZLE.LIB'
  379. XC
  380. XC MISCELLANEOUS VARIABLES
  381. XC
  382. X      COMMON /STAR/ MBASE,STRBIT
  383. X
  384. X      INCLUDE 'IO.LIB'
  385. X      INCLUDE 'MINDEX.LIB'
  386. X      INCLUDE 'DEBUG.LIB'
  387. X      INCLUDE 'ROOMS.LIB'
  388. X      INCLUDE 'RINDEX.LIB'
  389. X      INCLUDE 'EXITS.LIB'
  390. X      INCLUDE 'OBJECTS.LIB'
  391. X      INCLUDE 'OINDEX.LIB'
  392. X      INCLUDE 'CLOCK.LIB'
  393. X      INCLUDE 'VILLIANS.LIB'
  394. X      INCLUDE 'ADVERS.LIB'
  395. X      INCLUDE 'FLAGS.LIB'
  396. XC
  397. XC FUNCTIONS AND DATA
  398. XC
  399. X      VALID1(A1,L1)=(A1.GT.0).AND.(A1.LE.L1)
  400. X      VALID2(A1,A2,L1)=VALID1(A1,L1).AND.VALID1(A2,L1).AND.
  401. X     &      (A1.LE.A2)
  402. X      VALID3(A1,L1,A2,L2)=VALID1(A1,L1).AND.VALID1(A2,L2)
  403. X      DATA CMDMAX/38/
  404. X      DATA DBGCMD/'DR','DO','DA','DC','DX','DH','DL','DV','DF','DS',
  405. X     &            'AF','HE','NR','NT','NC','ND','RR','RT','RC','RD',
  406. X     &            'TK','EX','AR','AO','AA','AC','AX','AV','D2','DN',
  407. X     &            'AN','DM','DT','AH','DP','PD','DZ','AZ'/
  408. X      DATA ldbgcm/'dr','d','Oda','dc','dx','dh','dl','dv','df','ds',
  409. X     &            'af','he','nr','nt','nc','nd','rr','rt','rc','rd',
  410. X     &            'tk','ex','ar','a','Oaa','ac','ax','av','d2','dn',
  411. X     &            'an','dm','dt','ah','dp','pd','dz','az'/
  412. X      DATA ARGTYP/  2 ,  2 ,  2 ,  2 ,  2 ,  0 ,  0 ,  2 ,  2 ,  0 ,
  413. X     &              1 ,  0 ,  0 ,  0 ,  0 ,  0 ,  0 ,  0 ,  0 ,  0 ,
  414. X     &              1 ,  0 ,  3 ,  3 ,  3 ,  3 ,  1 ,  3 ,  2 ,  2 ,
  415. X     &              1 ,  2 ,  1 ,  0 ,  0 ,  0 ,  0 ,  1 /
  416. X`0C
  417. XC GDT, PAGE 2
  418. XC
  419. XC FIRST, VALIDATE THAT THE CALLER IS AN IMPLEMENTER.
  420. XC
  421. X      FMAX=46
  422. XC                                               !SET ARRAY LIMITS.
  423. X      SMAX=22
  424. XC
  425. X      IF(GDTFLG.NE.0) GO TO 2000
  426. XC                                               !IF OK, SKIP.
  427. X      WRITE(OUTCH,100)
  428. XC                                               !NOT AN IMPLEMENTER.
  429. X      RETURN
  430. XC                                               !BOOT HIM OFF
  431. XC
  432. X100   FORMAT(' You are not an authorized user.')
  433. X`0C
  434. Xc GDT, PAGE 2A
  435. XC
  436. XC HERE TO GET NEXT COMMAND
  437. XC
  438. X2000  WRITE(OUTCH,200)
  439. XC                                               !OUTPUT PROMPT.
  440. X      READ(INPCH,210) CMD
  441. XC                                               !GET COMMAND.
  442. X      IF(CMD.EQ.'  ') GO TO 2000
  443. XC                                               !IGNORE BLANKS.
  444. X      DO 2100 I=1,CMDMAX
  445. XC                                               !LOOK IT UP.
  446. X        IF(CMD.EQ.DBGCMD(I)) GO TO 2300
  447. XC                                               !FOUND?
  448. XC     check for lower case command, as well
  449. XC
  450. X        if(cmd .eq. ldbgcm(i)) go to 2300
  451. X2100  CONTINUE
  452. X2200  WRITE(OUTCH,220)
  453. XC                                               !NO, LOSE.
  454. X      GO TO 2000
  455. XC
  456. X200     FORMAT(' GDT>',$)
  457. X210     FORMAT(A2)
  458. X220     FORMAT(' ?')
  459. X230     FORMAT(2I6)
  460. X240     FORMAT(I6)
  461. X225     FORMAT(' Limits:   ',$)
  462. X235     FORMAT(' Entry:    ',$)
  463. X245     FORMAT(' Idx,Ary:  ',$)
  464. Xc
  465. X2300  GO TO (2400,2500,2600,2700),ARGTYP(I)+1
  466. XC                                               !BRANCH ON ARG TYPE.
  467. X      GO TO 2200
  468. XC                                               !ILLEGAL TYPE.
  469. XC
  470. X2700  WRITE(OUTCH,245)
  471. XC                                               !TYPE 3, REQUEST ARRAY COORD
  472. VS.
  473. X      READ(INPCH,230) J,K
  474. X      GO TO 2400
  475. XC
  476. X2600  WRITE(OUTCH,225)
  477. XC                                               !TYPE 2, READ BOUNDS.
  478. X      READ(INPCH,230) J,K
  479. X      IF(K.EQ.0) K=J
  480. X      GO TO 2400
  481. XC
  482. X2500  WRITE(OUTCH,235)
  483. XC                                               !TYPE 1, READ ENTRY NO.
  484. X      READ(INPCH,240) J
  485. X2400  GO TO (10000,11000,12000,13000,14000,15000,16000,17000,18000,
  486. X     & 19000,20000,21000,22000,23000,24000,25000,26000,27000,28000,
  487. X     & 29000,30000,31000,32000,33000,34000,35000,36000,37000,38000,
  488. X     & 39000,40000,41000,42000,43000,44000,45000,46000,47000),I
  489. X      GO TO 2200
  490. XC                                               !WHAT???
  491. X`0C
  492. XC GDT, PAGE 3
  493. XC
  494. XC DR-- DISPLAY ROOMS
  495. XC
  496. X10000 IF(.NOT.VALID2(J,K,RLNT)) GO TO 2200
  497. XC                                               !ARGS VALID?
  498. X      WRITE(OUTCH,300)
  499. XC                                               !COL HDRS.
  500. X      DO 10100 I=J,K
  501. X        WRITE(OUTCH,310) I,(EQR(I,L),L=1,5)
  502. X10100 CONTINUE
  503. X      GO TO 2000
  504. XC
  505. X300     FORMAT(' RM#  DESC1  EXITS ACTION  VALUE  FLAGS')
  506. X310     FORMAT(1X,I3,4(1X,I6),1X,I6)
  507. XC
  508. XC DO-- DISPLAY OBJECTS
  509. XC
  510. X11000 IF(.NOT.VALID2(J,K,OLNT)) GO TO 2200
  511. XC                                               !ARGS VALID?
  512. X      WRITE(OUTCH,320)
  513. XC                                               !COL HDRS
  514. X      DO 11100 I=J,K
  515. X        WRITE(OUTCH,330) I,(EQO(I,L),L=1,14)
  516. X11100 CONTINUE
  517. X      GO TO 2000
  518. XC
  519. X320   FORMAT(' OB# DESC1 DESC2 DESCO ACT FLAGS1 FLAGS2 FVL TVL
  520. X     &    SIZE CAPAC ROOM ADV CON  READ')
  521. X330   FORMAT(1X,I3,3I6,I4,2I7,2I4,2I6,1X,3I4,I6)
  522. XC
  523. XC DA-- DISPLAY ADVENTURERS
  524. XC
  525. X12000 IF(.NOT.VALID2(J,K,ALNT)) GO TO 2200
  526. XC                                               !ARGS VALID?
  527. X      WRITE(OUTCH,340)
  528. X      DO 12100 I=J,K
  529. X        WRITE(OUTCH,350) I,(EQA(I,L),L=1,7)
  530. X12100 CONTINUE
  531. X      GO TO 2000
  532. XC
  533. X340   FORMAT(' AD#   ROOM  SCORE  VEHIC OBJECT ACTION  STREN  FLAGS')
  534. X350   FORMAT(1X,I3,6(1X,I6),1X,I6)
  535. XC
  536. XC DC-- DISPLAY CLOCK EVENTS
  537. XC
  538. X13000 IF(.NOT.VALID2(J,K,CLNT)) GO TO 2200
  539. XC                                               !ARGS VALID?
  540. X      WRITE(OUTCH,360)
  541. X      DO 13100 I=J,K
  542. X        WRITE(OUTCH,370) I,(EQC(I,L),L=1,2),CFLAG(I)
  543. X13100 CONTINUE
  544. X      GO TO 2000
  545. XC
  546. X360   FORMAT(' CL#   TICK ACTION  FLAG')
  547. X370   FORMAT(1X,I3,1X,I6,1X,I6,5X,L1)
  548. XC
  549. XC DX-- DISPLAY EXITS
  550. XC
  551. X14000 IF(.NOT.VALID2(J,K,XLNT)) GO TO 2200
  552. XC                                               !ARGS VALID?
  553. X      WRITE(OUTCH,380)
  554. XC                                               !COL HDRS.
  555. X      DO 14100 I=J,K,10
  556. XC                                               !TEN PER LINE.
  557. X        L=MIN0(I+9,K)
  558. XC                                               !COMPUTE END OF LINE.
  559. X        WRITE(OUTCH,390) I,L,(TRAVEL(L1),L1=I,L)
  560. X14100 CONTINUE
  561. X      GO TO 2000
  562. XC
  563. X380   FORMAT('   RANGE   CONTENTS')
  564. X390   FORMAT(1X,I3,'-',I3,3X,10I7)
  565. XC
  566. XC DH-- DISPLAY HACKS
  567. XC
  568. X15000 WRITE(OUTCH,400) THFPOS,THFFLG,THFACT,SWDACT,SWDSTA
  569. X      GO TO 2000
  570. XC
  571. X400   FORMAT(' THFPOS=',I6,', THFFLG=',L2,',THFACT=',L2/
  572. X     &       ' SWDACT=',L2,', SWDSTA=',I2)
  573. XC
  574. XC DL-- DISPLAY LENGTHS
  575. XC
  576. X16000 WRITE(OUTCH,410) RLNT,XLNT,OLNT,CLNT,VLNT,ALNT,MLNT,R2LNT,
  577. X     &                 MBASE,STRBIT
  578. X      GO TO 2000
  579. XC
  580. X410     FORMAT(' R=',I6,', X=',I6,', O=',I6,', C=',I6/
  581. X     &  ' V=',I6,', A=',I6,', M=',I6,', R2=',I5/
  582. X     &  ' MBASE=',I6,', STRBIT=',I6)
  583. XC
  584. XC DV-- DISPLAY VILLAINS
  585. XC
  586. X17000 IF(.NOT.VALID2(J,K,VLNT)) GO TO 2200
  587. XC                                               !ARGS VALID?
  588. X      WRITE(OUTCH,420)
  589. XC                                               !COL HDRS
  590. X      DO 17100 I=J,K
  591. X        WRITE(OUTCH,430) I,(EQV(I,L),L=1,5)
  592. X17100 CONTINUE
  593. X      GO TO 2000
  594. XC
  595. X420   FORMAT(' VL# OBJECT   PROB   OPPS   BEST  MELEE')
  596. X430   FORMAT(1X,I3,5(1X,I6))
  597. XC
  598. XC DF-- DISPLAY FLAGS
  599. XC
  600. X18000 IF(.NOT.VALID2(J,K,FMAX)) GO TO 2200
  601. XC                                               !ARGS VALID?
  602. X      DO 18100 I=J,K
  603. X        WRITE(OUTCH,440) I,FLAGS(I)
  604. X18100 CONTINUE
  605. X      GO TO 2000
  606. XC
  607. X440   FORMAT(' Flag #',I2,' = ',L1)
  608. XC
  609. XC DS-- DISPLAY STATE
  610. XC
  611. X19000 WRITE(OUTCH,450) PRSA,PRSO,PRSI,PRSWON,PRSCON
  612. X      WRITE(OUTCH,460) WINNER,HERE,TELFLG
  613. X      WRITE(OUTCH,470) MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD,LTSHFT,BLOC,
  614. X     &                 MUNGRM,HS,EGSCOR,EGMXSC
  615. X      WRITE(OUTCH,475) FROMDR,SCOLRM,SCOLAC
  616. X      GO TO 2000
  617. XC
  618. X450   FORMAT(' Parse vector=',3(1X,I6),1X,L6,1X,I6)
  619. X460   FORMAT(' Play vector= ',2(1X,I6),1X,L6)
  620. X470   FORMAT(' State vector=',9(1X,I6)/14X,2(1X,I6))
  621. X475   FORMAT(' Scol vector= ',1X,I6,2(1X,I6))
  622. X`0C
  623. XC GDT, PAGE 4
  624. XC
  625. XC AF-- ALTER FLAGS
  626. XC
  627. X20000 IF(.NOT.VALID1(J,FMAX)) GO TO 2200
  628. XC                                               !ENTRY NO VALID?
  629. X      WRITE(OUTCH,480) FLAGS(J)
  630. XC                                               !TYPE OLD, GET NEW.
  631. X      READ(INPCH,490) FLAGS(J)
  632. X      GO TO 2000
  633. XC
  634. X480   FORMAT(' Old=',L2,6X,'New= ',$)
  635. X490   FORMAT(L1)
  636. XC
  637. XC 21000-- HELP
  638. XC
  639. X21000 WRITE(OUTCH,900)
  640. X      GO TO 2000
  641. XC
  642. X900   FORMAT(' Valid commands are:'/' AA- Alter ADVS'/
  643. X     &  ' AC- Alter CEVENT'/' AF- Alter FINDEX'/' AH- Alter HERE'/
  644. X     &  ' AN- Alter switches'/' AO- Alter OBJCTS'/' AR- Alter ROOMS'/
  645. X     &  ' AV- Alter VILLS'/' AX- Alter EXITS'/
  646. X     &  ' AZ- Alter PUZZLE'/' DA- Display ADVS'/
  647. X     &  ' DC- Display CEVENT'/' DF- Display FINDEX'/' DH- Display HACKS'/
  648. X     &  ' DL- Display lengths'/' DM- Display RTEXT'/
  649. X     &  ' DN- Display switches'/
  650. X     &  ' DO- Display OBJCTS'/' DP- Display parser'/
  651. X     &  ' DR- Display ROOMS'/' DS- Display state'/' DT- Display text'/
  652. X     &  ' DV- Display VILLS'/' DX- Display EXITS'/' DZ- Display PUZZLE'/
  653. X     &  ' D2- Display ROOM2'/' EX- Exit'/' HE- Type this message'/
  654. X     &  ' NC- No cyclops'/' ND- No deaths'/' NR- No robber'/
  655. X     &  ' NT- No troll'/' PD- Program detail'/
  656. X     &  ' RC- Restore cyclops'/' RD- Restore deaths'/
  657. X     &  ' RR- Restore robber'/' RT- Restore troll'/' TK- Take.')
  658. XC
  659. XC NR-- NO ROBBER
  660. XC
  661. X22000 THFFLG=.FALSE.
  662. XC                                               !DISABLE ROBBER.
  663. X      THFACT=.FALSE.
  664. X      CALL NEWSTA(THIEF,0,0,0,0)
  665. XC                                               !VANISH THIEF.
  666. X      WRITE(OUTCH,500)
  667. X      GO TO 2000
  668. XC
  669. X500   FORMAT(' No robber.')
  670. XC
  671. XC NT-- NO TROLL
  672. XC
  673. X23000 TROLLF=.TRUE.
  674. X      CALL NEWSTA(TROLL,0,0,0,0)
  675. X      WRITE(OUTCH,510)
  676. X      GO TO 2000
  677. XC
  678. X510   FORMAT(' No troll.')
  679. XC
  680. XC NC-- NO CYCLOPS
  681. XC
  682. X24000 CYCLOF=.TRUE.
  683. X      CALL NEWSTA(CYCLO,0,0,0,0)
  684. X      WRITE(OUTCH,520)
  685. X      GO TO 2000
  686. XC
  687. X520   FORMAT(' No cyclops.')
  688. XC
  689. XC ND-- IMMORTALITY MODE
  690. XC
  691. X25000 DBGFLG=1
  692. X      WRITE(OUTCH,530)
  693. X      GO TO 2000
  694. XC
  695. X530   FORMAT(' No deaths.')
  696. XC
  697. XC RR-- RESTORE ROBBER
  698. XC
  699. X26000 THFACT=.TRUE.
  700. X      WRITE(OUTCH,540)
  701. X      GO TO 2000
  702. XC
  703. X540   FORMAT(' Restored robber.')
  704. XC
  705. XC RT-- RESTORE TROLL
  706. XC
  707. X27000 TROLLF=.FALSE.
  708. X      CALL NEWSTA(TROLL,0,MTROL,0,0)
  709. X      WRITE(OUTCH,550)
  710. X      GO TO 2000
  711. XC
  712. X550   FORMAT(' Restored troll.')
  713. XC
  714. XC RC-- RESTORE CYCLOPS
  715. XC
  716. X28000 CYCLOF=.FALSE.
  717. X      MAGICF=.FALSE.
  718. X      CALL NEWSTA(CYCLO,0,MCYCL,0,0)
  719. X      WRITE(OUTCH,560)
  720. X      GO TO 2000
  721. XC
  722. X560   FORMAT(' Restored cyclops.')
  723. XC
  724. XC RD-- MORTAL MODE
  725. XC
  726. X29000 DBGFLG=0
  727. X      WRITE(OUTCH,570)
  728. X      GO TO 2000
  729. XC
  730. X570   FORMAT(' Restored deaths.')
  731. X`0C
  732. XC GDT, PAGE 5
  733. XC
  734. XC TK-- TAKE
  735. XC
  736. X30000 IF(.NOT.VALID1(J,OLNT)) GO TO 2200
  737. XC                                               !VALID OBJECT?
  738. X      CALL NEWSTA(J,0,0,0,WINNER)
  739. XC                                               !YES, TAKE OBJECT.
  740. X      WRITE(OUTCH,580)
  741. XC                                               !TELL.
  742. X      GO TO 2000
  743. XC
  744. X580   FORMAT(' Taken.')
  745. XC
  746. XC EX-- GOODBYE
  747. XC
  748. X31000 PRSCON=1
  749. X      RETURN
  750. XC
  751. XC AR--  ALTER ROOM ENTRY
  752. XC
  753. X32000 IF(.NOT.VALID3(J,RLNT,K,5)) GO TO 2200
  754. XC                                               !INDICES VALID?
  755. X      WRITE(OUTCH,590) EQR(J,K)
  756. XC                                               !TYPE OLD, GET NEW.
  757. X      READ(INPCH,600) EQR(J,K)
  758. X      GO TO 2000
  759. XC
  760. X590   FORMAT(' Old= ',I6,6X,'New= ',$)
  761. X600   FORMAT(I6)
  762. XC
  763. XC AO-- ALTER OBJECT ENTRY
  764. XC
  765. X33000 IF(.NOT.VALID3(J,OLNT,K,14)) GO TO 2200
  766. XC                                               !INDICES VALID?
  767. X      WRITE(OUTCH,590) EQO(J,K)
  768. X      READ(INPCH,600) EQO(J,K)
  769. X      GO TO 2000
  770. XC
  771. XC AA-- ALTER ADVS ENTRY
  772. XC
  773. X34000 IF(.NOT.VALID3(J,ALNT,K,7)) GO TO 2200
  774. XC                                               !INDICES VALID?
  775. X      WRITE(OUTCH,590) EQA(J,K)
  776. X      READ(INPCH,600) EQA(J,K)
  777. X      GO TO 2000
  778. XC
  779. XC AC-- ALTER CLOCK EVENTS
  780. XC
  781. X35000 IF(.NOT.VALID3(J,CLNT,K,3)) GO TO 2200
  782. XC                                               !INDICES VALID?
  783. X      IF(K.EQ.3) GO TO 35500
  784. XC                                               !FLAGS ENTRY?
  785. X      WRITE(OUTCH,590) EQC(J,K)
  786. X      READ(INPCH,600) EQC(J,K)
  787. X      GO TO 2000
  788. XC
  789. X35500 WRITE(OUTCH,480) CFLAG(J)
  790. X      READ(INPCH,490) CFLAG(J)
  791. X      GO TO 2000
  792. X`0C
  793. XC GDT, PAGE 6
  794. XC
  795. XC AX-- ALTER EXITS
  796. XC
  797. X36000 IF(.NOT.VALID1(J,XLNT)) GO TO 2200
  798. XC                                               !ENTRY NO VALID?
  799. X      WRITE(OUTCH,610) TRAVEL(J)
  800. X      READ(INPCH,620) TRAVEL(J)
  801. X      GO TO 2000
  802. XC
  803. X610   FORMAT(' Old= ',I6,6X,'New= ',$)
  804. X620   FORMAT(I6)
  805. XC
  806. XC AV-- ALTER VILLAINS
  807. XC
  808. X37000 IF(.NOT.VALID3(J,VLNT,K,5)) GO TO 2200
  809. XC                                               !INDICES VALID?
  810. X      WRITE(OUTCH,590) EQV(J,K)
  811. X      READ(INPCH,600) EQV(J,K)
  812. X      GO TO 2000
  813. XC
  814. XC D2-- DISPLAY ROOM2 LIST
  815. XC
  816. X38000 IF(.NOT.VALID2(J,K,R2LNT)) GO TO 2200
  817. X      DO 38100 I=J,K
  818. X        WRITE(OUTCH,630) I,RROOM2(I),OROOM2(I)
  819. X38100 CONTINUE
  820. X      GO TO 2000
  821. XC
  822. X630   FORMAT(' #',I2,'   Room=',I6,'   Obj=',I6)
  823. XC
  824. XC DN-- DISPLAY SWITCHES
  825. XC
  826. X39000 IF(.NOT.VALID2(J,K,SMAX)) GO TO 2200
  827. XC                                               !VALID?
  828. X      DO 39100 I=J,K
  829. X        WRITE(OUTCH,640) I,SWITCH(I)
  830. X39100 CONTINUE
  831. X      GO TO 2000
  832. XC
  833. X640   FORMAT(' Switch #',I2,' = ',I6)
  834. XC
  835. XC AN-- ALTER SWITCHES
  836. XC
  837. X40000 IF(.NOT.VALID1(J,SMAX)) GO TO 2200
  838. XC                                               !VALID ENTRY?
  839. X      WRITE(OUTCH,590) SWITCH(J)
  840. X      READ(INPCH,600) SWITCH(J)
  841. X      GO TO 2000
  842. XC
  843. XC DM-- DISPLAY MESSAGES
  844. XC
  845. X41000 IF(.NOT.VALID2(J,K,MLNT)) GO TO 2200
  846. XC                                               !VALID LIMITS?
  847. X      WRITE(OUTCH,380)
  848. X      DO 41100 I=J,K,10
  849. X        L=MIN0(I+9,K)
  850. X        WRITE(OUTCH,650) I,L,(RTEXT(L1),L1=I,L)
  851. X41100 CONTINUE
  852. X      GO TO 2000
  853. XC
  854. X650   FORMAT(1X,I4,'-',I4,3X,10(1X,I6))
  855. XC
  856. XC DT-- DISPLAY TEXT
  857. XC
  858. X42000 CALL RSPEAK(J)
  859. X      GO TO 2000
  860. XC
  861. XC AH--  ALTER HERE
  862. XC
  863. X43000 WRITE(OUTCH,590) HERE
  864. X      READ(INPCH,600) HERE
  865. X      EQA(1,1)=HERE
  866. X      GO TO 2000
  867. XC
  868. XC DP--  DISPLAY PARSER STATE
  869. XC
  870. X44000 WRITE(OUTCH,660) ORP,LASTIT,PVEC,SYN
  871. X      GO TO 2000
  872. XC
  873. X660   FORMAT(' ORPHS= ',I7,I7,4I7/
  874. X     &  ' PV=    ',I7,4I7/' SYN=   ',6I7/15X,5I7)
  875. XC
  876. XC PD--  PROGRAM DETAIL DEBUG
  877. XC
  878. X45000 WRITE(OUTCH,610) PRSFLG
  879. XC                                               !TYPE OLD, GET NEW.
  880. X      READ(INPCH,620) PRSFLG
  881. X      GO TO 2000
  882. XC
  883. XC DZ--  DISPLAY PUZZLE ROOM
  884. XC
  885. X46000 DO 46100 I=1,64,8
  886. XC                                               !DISPLAY PUZZLE
  887. X        WRITE(OUTCH,670) (CPVEC(J),J=I,I+7)
  888. X46100 CONTINUE
  889. X      GO TO 2000
  890. XC
  891. X670   FORMAT(2X,8I3)
  892. XC
  893. XC AZ--  ALTER PUZZLE ROOM
  894. XC
  895. X47000 IF(.NOT.VALID1(J,64)) GO TO 2200
  896. XC                                               !VALID ENTRY?
  897. X      WRITE(OUTCH,590) CPVEC(J)
  898. XC                                               !OUTPUT OLD,
  899. X      READ(INPCH,600) CPVEC(J)
  900. X      GO TO 2000
  901. XC
  902. X      END
  903. $ CALL UNPACK [.SRC]GDT.FOR;1 1093853645
  904. $ create 'f'
  905. X      subroutine image_dir (dir)
  906. X
  907. X      implicit none
  908. X
  909. X      external jpi$_imagname
  910. X      integer*4 sys$getjpi
  911. X      integer*2 len
  912. X      integer*4 status
  913. X      integer*4 i
  914. X      structure /itmlist/`20
  915. X         union
  916. X            map
  917. X               integer*2 buflen
  918. X               integer*2 code
  919. X               integer*4 bufadr
  920. X               integer*4 retlenadr
  921. X            end map
  922. X            map
  923. X               integer*4 end_list
  924. X            end map
  925. X         end union
  926. X      end structure
  927. X
  928. X      record /itmlist/ itmlst
  929. X      character*128 imagname
  930. X      character*128 dir
  931. X      itmlst.buflen=80
  932. X      itmlst.code       = %loc(jpi$_imagname)
  933. X      itmlst.bufadr     = %loc(imagname)
  934. X      itmlst.retlenadr  = %loc(len)
  935. X
  936. X      status = sys$getjpi (%val(1),,,itmlst,,,)`09! Get myself
  937. X
  938. X      do 10,i=len,1,-1
  939. X        if (imagname (i:i) .eq. '`5D') goto 20
  940. X   10 continue
  941. X
  942. X   20 dir = imagname(1:i)
  943. X
  944. X      return`20
  945. X      end
  946. $ CALL UNPACK [.SRC]IMAGE_DIR.FOR;1 1916815225
  947. $ create 'f'
  948. XC
  949. XC I/O VARIABLES
  950. XC
  951. X      CHARACTER INBUF(78)
  952. X      COMMON /INPUT/ INLNT,INBUF
  953. X      COMMON /CHAN/ INPCH,OUTCH,DBCH
  954. $ CALL UNPACK [.SRC]IO.LIB;1 1913199783
  955. $ create 'f'
  956. XC LIGHTP-       LIGHT PROCESSOR
  957. XC
  958. XC COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
  959. XC ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
  960. XC WRITTEN BY R. M. SUPNIK
  961. XC
  962. XC DECLARATIONS
  963. XC
  964. X      LOGICAL FUNCTION LIGHTP(OBJ)
  965. X      IMPLICIT INTEGER (A-Z)
  966. X      LOGICAL QON
  967. X
  968. X      INCLUDE 'PARSER.LIB'
  969. X      INCLUDE 'GAMESTATE.LIB'
  970. X      INCLUDE 'OBJECTS.LIB'
  971. X      INCLUDE 'OFLAGS.LIB'
  972. X      INCLUDE 'OINDEX.LIB'
  973. X      INCLUDE 'CLOCK.LIB'
  974. X
  975. X      INCLUDE 'VERBS.LIB'
  976. X      INCLUDE 'FLAGS.LIB'
  977. XC
  978. XC FUNCTIONS AND DATA
  979. XC
  980. X      QON(R)=and(OFLAG1(R),ONBT).NE.0
  981. X`0C
  982. XC LIGHTP, PAGE 2
  983. XC
  984. X      LIGHTP=.TRUE.
  985. XC                                               !ASSUME WINS
  986. X      FLOBTS=FLAMBT+LITEBT+ONBT
  987. X      IF(OBJ.NE.CANDL) GO TO 20000
  988. XC                                               !CANDLE?
  989. X      IF(ORCAND.NE.0) GO TO 19100
  990. XC                                               !FIRST REF?
  991. X      ORCAND=1
  992. XC                                               !YES, CANDLES ARE
  993. X      CTICK(CEVCND)=50
  994. XC                                               !BURNING WHEN SEEN.
  995. XC
  996. X19100 IF(PRSI.EQ.CANDL) GO TO 10
  997. XC                                               !IGNORE IND REFS.
  998. X      IF(PRSA.NE.TRNOFW) GO TO 19200
  999. XC                                               !TURN OFF?
  1000. X      I=513
  1001. XC                                               !ASSUME OFF.
  1002. X      IF(QON(CANDL)) I=514
  1003. XC                                               !IF ON, DIFFERENT.
  1004. X      CFLAG(CEVCND)=.FALSE.
  1005. XC                                               !DISABLE COUNTDOWN.
  1006. X      OFLAG1(CANDL)=and(OFLAG1(CANDL), not(ONBT))
  1007. X      CALL RSPEAK(I)
  1008. X      RETURN
  1009. XC
  1010. X19200 IF((PRSA.NE.BURNW).AND.(PRSA.NE.TRNONW)) GO TO 10
  1011. X      IF(and(OFLAG1(CANDL),LITEBT).NE.0) GO TO 19300
  1012. X      CALL RSPEAK(515)
  1013. XC                                               !CANDLES TOO SHORT.
  1014. X      RETURN
  1015. XC
  1016. X19300 IF(PRSI.NE.0) GO TO 19400
  1017. XC                                               !ANY FLAME?
  1018. X      CALL RSPEAK(516)
  1019. XC                                               !NO, LOSE.
  1020. X      PRSWON=.FALSE.
  1021. X      RETURN
  1022. XC
  1023. X19400 IF((PRSI.NE.MATCH).OR. .NOT.QON(MATCH)) GO TO 19500
  1024. X      I=517
  1025. XC                                               !ASSUME OFF.
  1026. X      IF(QON(CANDL)) I=518
  1027. XC                                               !IF ON, JOKE.
  1028. X      OFLAG1(CANDL)=or(OFLAG1(CANDL),ONBT)
  1029. X      CFLAG(CEVCND)=.TRUE.
  1030. XC                                               !RESUME COUNTDOWN.
  1031. X      CALL RSPEAK(I)
  1032. X      RETURN
  1033. XC
  1034. X19500 IF((PRSI.NE.TORCH).OR. .NOT.QON(TORCH)) GO TO 19600
  1035. X      IF(QON(CANDL)) GO TO 19700
  1036. XC                                               !ALREADY ON?
  1037. X      CALL NEWSTA(CANDL,521,0,0,0)
  1038. XC                                               !NO, VAPORIZE.
  1039. X      RETURN
  1040. XC
  1041. X19600   CALL RSPEAK(519)
  1042. XC                                               !CANT LIGHT WITH THAT.
  1043. X      RETURN
  1044. XC
  1045. X19700 CALL RSPEAK(520)
  1046. XC                                               !ALREADY ON.
  1047. X      RETURN
  1048. XC
  1049. X20000 IF(OBJ.NE.MATCH) CALL BUG(6,OBJ)
  1050. X      IF((PRSA.NE.TRNONW).OR.(PRSO.NE.MATCH)) GO TO 20500
  1051. X      IF(ORMTCH.NE.0) GO TO 20100
  1052. XC                                               !ANY MATCHES LEFT?
  1053. X      CALL RSPEAK(183)
  1054. XC                                               !NO, LOSE.
  1055. X      RETURN
  1056. XC
  1057. X20100 ORMTCH=ORMTCH-1
  1058. XC                                               !DECREMENT NO MATCHES.
  1059. X      OFLAG1(MATCH)=or(OFLAG1(MATCH),FLOBTS)
  1060. X      CTICK(CEVMAT)=2
  1061. XC                                               !COUNTDOWN.
  1062. X      CALL RSPEAK(184)
  1063. X      RETURN
  1064. XC
  1065. X20500 IF((PRSA.NE.TRNOFW).OR.(and(OFLAG1(MATCH),ONBT).EQ.0))
  1066. X     &  GO TO 10
  1067. X      OFLAG1(MATCH)=and(OFLAG1(MATCH), not(FLOBTS))
  1068. X      CTICK(CEVMAT)=0
  1069. X      CALL RSPEAK(185)
  1070. X      RETURN
  1071. XC
  1072. XC HERE FOR FALSE RETURN
  1073. XC
  1074. X10    LIGHTP=.FALSE.
  1075. X      RETURN
  1076. X      END
  1077. $ CALL UNPACK [.SRC]LIGHTP.FOR;1 1445928945
  1078. $ create 'f'
  1079. XC
  1080. XC MESSAGE INDEX
  1081. XC
  1082. X      COMMON /RMSG/ MLNT,RTEXT(1050)
  1083. $ CALL UNPACK [.SRC]MINDEX.LIB;1 152440333
  1084. $ create 'f'
  1085. XC NOBJS-        NEW OBJECTS PROCESSOR
  1086. XC       OBJECTS IN THIS MODULE CANNOT CALL RMINFO, JIGSUP,
  1087. XC       MAJOR VERBS, OR OTHER NON-RESIDENT SUBROUTINES
  1088. XC
  1089. XC COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
  1090. XC ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
  1091. XC WRITTEN BY R. M. SUPNIK
  1092. XC
  1093. XC DECLARATIONS
  1094. XC
  1095. X      LOGICAL FUNCTION NOBJS(RI,ARG)
  1096. X      IMPLICIT INTEGER (A-Z)
  1097. X      LOGICAL QOPEN,MOVETO,F
  1098. X      LOGICAL QHERE,OPNCLS,MIRPAN
  1099. X
  1100. X      INCLUDE 'PARSER.LIB'
  1101. X      INCLUDE 'GAMESTATE.LIB'
  1102. X      INCLUDE 'STATE.LIB'
  1103. X      INCLUDE 'SCREEN.LIB'
  1104. X      INCLUDE 'PUZZLE.LIB'
  1105. XC
  1106. XC MISCELLANEOUS VARIABLES
  1107. XC
  1108. X      COMMON /HYPER/ HFACTR
  1109. X
  1110. X      INCLUDE 'ROOMS.LIB'
  1111. X      INCLUDE 'RFLAG.LIB'
  1112. X      INCLUDE 'RINDEX.LIB'
  1113. X      INCLUDE 'OBJECTS.LIB'
  1114. X      INCLUDE 'OFLAGS.LIB'
  1115. X      INCLUDE 'OINDEX.LIB'
  1116. X      INCLUDE 'CLOCK.LIB'
  1117. X
  1118. X      INCLUDE 'VILLIANS.LIB'
  1119. X      INCLUDE 'ADVERS.LIB'
  1120. X      INCLUDE 'VERBS.LIB'
  1121. X      INCLUDE 'FLAGS.LIB'
  1122. XC
  1123. XC FUNCTIONS AND DATA
  1124. XC
  1125. X      QOPEN(R)=and(OFLAG2(R),OPENBT).NE.0
  1126. X`0C
  1127. XC NOBJS, PAGE 2
  1128. XC
  1129. X      IF(PRSO.NE.0) ODO2=ODESC2(PRSO)
  1130. X      IF(PRSI.NE.0) ODI2=ODESC2(PRSI)
  1131. X      AV=AVEHIC(WINNER)
  1132. X      NOBJS=.TRUE.
  1133. XC
  1134. X      GO TO ( 1000, 2000, 3000, 4000, 5000, 6000, 7000, 8000, 9000,
  1135. X     & 10000,11000,12000,13000,14000,15000,16000,17000,18000,19000,`20
  1136. X     & 20000,21000),
  1137. X     &(RI-31)
  1138. X      CALL BUG(6,RI)
  1139. XC
  1140. XC RETURN HERE TO DECLARE FALSE RESULT
  1141. XC
  1142. X10    NOBJS=.FALSE.
  1143. X      RETURN
  1144. XC
  1145. XC O32-- BILLS
  1146. XC
  1147. X1000  IF(PRSA.NE.EATW) GO TO 1100
  1148. XC                                               !EAT?
  1149. X      CALL RSPEAK(639)
  1150. XC                                               !JOKE.
  1151. X      RETURN
  1152. XC
  1153. X1100  IF(PRSA.EQ.BURNW) CALL RSPEAK(640)
  1154. XC                                               !BURN?  JOKE.
  1155. X      GO TO 10
  1156. XC                                               !LET IT BE HANDLED.
  1157. X`0C
  1158. XC NOBJS, PAGE 3
  1159. XC
  1160. XC O33-- SCREEN OF LIGHT
  1161. XC
  1162. X2000  TARGET=SCOL
  1163. XC                                               !TARGET IS SCOL.
  1164. X2100  IF(PRSO.NE.TARGET) GO TO 2400
  1165. XC                                               !PRSO EQ TARGET?
  1166. X      IF((PRSA.NE.PUSHW).AND.(PRSA.NE.MOVEW).AND.
  1167. X     &   (PRSA.NE.TAKEW).AND.(PRSA.NE.RUBW)) GO TO 2200
  1168. X      CALL RSPEAK(673)
  1169. XC                                               !HAND PASSES THRU.
  1170. X      RETURN
  1171. XC
  1172. X2200  IF((PRSA.NE.KILLW).AND.(PRSA.NE.ATTACW).AND.
  1173. X     &          (PRSA.NE.MUNGW)) GO TO 2400
  1174. X      CALL RSPSUB(674,ODI2)
  1175. XC                                               !PASSES THRU.
  1176. X      RETURN
  1177. XC
  1178. X2400  IF((PRSA.NE.THROWW).OR.(PRSI.NE.TARGET)) GO TO 10
  1179. X      IF(HERE.EQ.BKBOX) GO TO 2600
  1180. XC                                               !THRU SCOL?
  1181. X      CALL NEWSTA(PRSO,0,BKBOX,0,0)
  1182. XC                                               !NO, THRU WALL.
  1183. X      CALL RSPSUB(675,ODO2)
  1184. XC                                               !ENDS UP IN BOX ROOM.
  1185. X      CTICK(CEVSCL)=0
  1186. XC                                               !CANCEL ALARM.
  1187. X      SCOLRM=0
  1188. XC                                               !RESET SCOL ROOM.
  1189. X      RETURN
  1190. XC
  1191. X2600  IF(SCOLRM.EQ.0) GO TO 2900
  1192. XC                                               !TRIED TO GO THRU?
  1193. X      CALL NEWSTA(PRSO,0,SCOLRM,0,0)
  1194. XC                                               !SUCCESS.
  1195. X      CALL RSPSUB(676,ODO2)
  1196. XC                                               !ENDS UP SOMEWHERE.
  1197. X      CTICK(CEVSCL)=0
  1198. XC                                               !CANCEL ALARM.
  1199. X      SCOLRM=0
  1200. XC                                               !RESET SCOL ROOM.
  1201. X      RETURN
  1202. XC
  1203. X2900  CALL RSPEAK(213)
  1204. XC                                               !CANT DO IT.
  1205. X      RETURN
  1206. X`0C
  1207. XC NOBJS, PAGE 4
  1208. XC
  1209. XC O34-- GNOME OF ZURICH
  1210. XC
  1211. X3000  IF((PRSA.NE.GIVEW).AND.(PRSA.NE.THROWW)) GO TO 3200
  1212. X      IF(OTVAL(PRSO).NE.0) GO TO 3100
  1213. XC                                               !THROW A TREASURE?
  1214. X      CALL NEWSTA(PRSO,641,0,0,0)
  1215. XC                                               !NO, GO POP.
  1216. X      RETURN
  1217. XC
  1218. X3100  CALL NEWSTA(PRSO,0,0,0,0)
  1219. XC                                               !YES, BYE BYE TREASURE.
  1220. X      CALL RSPSUB(642,ODO2)
  1221. X      CALL NEWSTA(ZGNOM,0,0,0,0)
  1222. XC                                               !BYE BYE GNOME.
  1223. X      CTICK(CEVZGO)=0
  1224. XC                                               !CANCEL EXIT.
  1225. X      F=MOVETO(BKENT,WINNER)
  1226. XC                                               !NOW IN BANK ENTRANCE.
  1227. X      RETURN
  1228. XC
  1229. X3200  IF((PRSA.NE.ATTACW).AND.(PRSA.NE.KILLW).AND.
  1230. X     &   (PRSA.NE.MUNGW)) GO TO 3300
  1231. X      CALL NEWSTA(ZGNOM,643,0,0,0)
  1232. XC                                               !VANISH GNOME.
  1233. X      CTICK(CEVZGO)=0
  1234. XC                                               !CANCEL EXIT.
  1235. X      RETURN
  1236. XC
  1237. X3300  CALL RSPEAK(644)
  1238. XC                                               !GNOME IS IMPATIENT.
  1239. X      RETURN
  1240. XC
  1241. XC O35-- EGG
  1242. XC
  1243. X4000  IF((PRSA.NE.OPENW).OR.(PRSO.NE.EGG)) GO TO 4500
  1244. X      IF(.NOT.QOPEN(EGG)) GO TO 4100
  1245. XC                                               !OPEN ALREADY?
  1246. X      CALL RSPEAK(649)
  1247. XC                                               !YES.
  1248. X      RETURN
  1249. XC
  1250. X4100  IF(PRSI.NE.0) GO TO 4200
  1251. XC                                               !WITH SOMETHING?
  1252. X      CALL RSPEAK(650)
  1253. XC                                               !NO, CANT.
  1254. X      RETURN
  1255. XC
  1256. X4200  IF(PRSI.NE.HANDS) GO TO 4300
  1257. XC                                               !WITH HANDS?
  1258. X      CALL RSPEAK(651)
  1259. XC                                               !NOT RECOMMENDED.
  1260. X      RETURN
  1261. XC
  1262. X4300  I=652
  1263. XC                                               !MUNG MESSAGE.
  1264. X      IF((and(OFLAG1(PRSI),TOOLBT).NE.0).OR.
  1265. X     &   (and(OFLAG2(PRSI),WEAPBT).NE.0)) GO TO 4600
  1266. X      I=653
  1267. XC                                               !NOVELTY 1.
  1268. X      IF(and(OFLAG2(PRSO),FITEBT).NE.0) I=654
  1269. X      OFLAG2(PRSO)=or(OFLAG2(PRSO),FITEBT)
  1270. X      CALL RSPSUB(I,ODI2)
  1271. X      RETURN
  1272. XC
  1273. X4500  IF((PRSA.NE.OPENW).AND.(PRSA.NE.MUNGW)) GO TO 4800
  1274. X      I=655
  1275. XC                                               !YOU BLEW IT.
  1276. X4600  CALL NEWSTA(BEGG,I,OROOM(EGG),OCAN(EGG),OADV(EGG))
  1277. X      CALL NEWSTA(EGG,0,0,0,0)
  1278. XC                                               !VANISH EGG.
  1279. X      OTVAL(BEGG)=2
  1280. XC                                               !BAD EGG HAS VALUE.
  1281. X      IF(OCAN(CANAR).NE.EGG) GO TO 4700
  1282. XC                                               !WAS CANARY INSIDE?
  1283. X      CALL RSPEAK(ODESCO(BCANA))
  1284. XC                                               !YES, DESCRIBE RESULT.
  1285. X      OTVAL(BCANA)=1
  1286. X      RETURN
  1287. XC
  1288. X4700  CALL NEWSTA(BCANA,0,0,0,0)
  1289. XC                                               !NO, VANISH IT.
  1290. X      RETURN
  1291. XC
  1292. X4800  IF((PRSA.NE.DROPW).OR.(HERE.NE.MTREE)) GO TO 10
  1293. X      CALL NEWSTA(BEGG,658,FORE3,0,0)
  1294. XC                                               !DROPPED EGG.
  1295. X      CALL NEWSTA(EGG,0,0,0,0)
  1296. X      OTVAL(BEGG)=2
  1297. X      IF(OCAN(CANAR).NE.EGG) GO TO 4700
  1298. X      OTVAL(BCANA)=1
  1299. XC                                               !BAD CANARY.
  1300. X      RETURN
  1301. X`0C
  1302. XC NOBJS, PAGE 5
  1303. XC
  1304. XC O36-- CANARIES, GOOD AND BAD
  1305. XC
  1306. X5000  IF(PRSA.NE.WINDW) GO TO 10
  1307. XC                                               !WIND EM UP?
  1308. X      IF(PRSO.EQ.CANAR) GO TO 5100
  1309. XC                                               !RIGHT ONE?
  1310. X      CALL RSPEAK(645)
  1311. XC                                               !NO, BAD NEWS.
  1312. X      RETURN
  1313. XC
  1314. X5100  IF(.NOT.SINGSF.AND.((HERE.EQ.MTREE).OR.
  1315. X     &   ((HERE.GE.FORE1).AND.(HERE.LT.CLEAR))))
  1316. X     &GO TO 5200
  1317. X      CALL RSPEAK(646)
  1318. XC                                               !NO, MEDIOCRE NEWS.
  1319. X      RETURN
  1320. XC
  1321. X5200  SINGSF=.TRUE.
  1322. XC                                               !SANG SONG.
  1323. X      I=HERE
  1324. X      IF(I.EQ.MTREE) I=FORE3
  1325. XC                                               !PLACE BAUBLE.
  1326. X      CALL NEWSTA(BAUBL,647,I,0,0)
  1327. X      RETURN
  1328. XC
  1329. XC O37-- WHITE CLIFFS
  1330. XC
  1331. X6000  IF((PRSA.NE.CLMBW).AND.(PRSA.NE.CLMBUW).AND.
  1332. X     &   (PRSA.NE.CLMBDW)) GO TO 10
  1333. X      CALL RSPEAK(648)
  1334. XC                                               !OH YEAH?
  1335. X      RETURN
  1336. XC
  1337. XC O38-- WALL
  1338. XC
  1339. X7000  IF((IABS(HERE-MLOC).NE.1).OR.(MRHERE(HERE).NE.0).OR.
  1340. X     &   (PRSA.NE.PUSHW)) GO TO 7100
  1341. X      CALL RSPEAK(860)
  1342. XC                                               !PUSHED MIRROR WALL.
  1343. X      RETURN
  1344. XC
  1345. X7100  IF(and(RFLAG(HERE),RNWALL).EQ.0) GO TO 10
  1346. X      CALL RSPEAK(662)
  1347. XC                                               !NO WALL.
  1348. X      RETURN
  1349. X`0C
  1350. XC NOBJS, PAGE 6
  1351. XC
  1352. XC O39-- SONG BIRD GLOBAL
  1353. XC
  1354. X8000  IF(PRSA.NE.FINDW) GO TO 8100
  1355. XC                                               !FIND?
  1356. X      CALL RSPEAK(666)
  1357. X      RETURN
  1358. XC
  1359. X8100  IF(PRSA.NE.EXAMIW) GO TO 10
  1360. XC                                               !EXAMINE?
  1361. X      CALL RSPEAK(667)
  1362. X      RETURN
  1363. XC
  1364. XC O40-- PUZZLE/SCOL WALLS
  1365. XC
  1366. X9000  IF(HERE.NE.CPUZZ) GO TO 9500
  1367. XC                                               !PUZZLE WALLS?
  1368. X      IF(PRSA.NE.PUSHW) GO TO 10
  1369. XC                                               !PUSH?
  1370. X      DO 9100 I=1,8,2
  1371. XC                                               !LOCATE WALL.
  1372. X        IF(PRSO.EQ.CPWL(I)) GO TO 9200
  1373. X9100  CONTINUE
  1374. X      CALL BUG(80,PRSO)
  1375. XC                                               !WHAT?
  1376. XC
  1377. X9200  J=CPWL(I+1)
  1378. XC                                               !GET DIRECTIONAL OFFSET.
  1379. X      NXT=CPHERE+J
  1380. XC                                               !GET NEXT STATE.
  1381. X      WL=CPVEC(NXT)
  1382. XC                                               !GET C(NEXT STATE).
  1383. X      GO TO (9300,9300,9300,9250,9350),(WL+4)
  1384. XC                                               !PROCESS.
  1385. XC
  1386. X9250  CALL RSPEAK(876)
  1387. XC                                               !CLEAR CORRIDOR.
  1388. X      RETURN
  1389. XC
  1390. X9300  IF(CPVEC(NXT+J).EQ.0) GO TO 9400
  1391. XC                                               !MOVABLE, ROOM TO MOVE?
  1392. X9350  CALL RSPEAK(877)
  1393. XC                                               !IMMOVABLE, NO ROOM.
  1394. X      RETURN
  1395. XC
  1396. X9400  I=878
  1397. XC                                               !ASSUME FIRST PUSH.
  1398. X      IF(CPUSHF) I=879
  1399. XC                                               !NOT?
  1400. X      CPUSHF=.TRUE.
  1401. X      CPVEC(NXT+J)=WL
  1402. XC                                               !MOVE WALL.
  1403. X      CPVEC(NXT)=0
  1404. XC                                               !VACATE NEXT STATE.
  1405. X      CALL CPGOTO(NXT)
  1406. XC                                               !ONWARD.
  1407. X      CALL CPINFO(I,NXT)
  1408. XC                                               !DESCRIBE.
  1409. X      CALL PRINCR(.TRUE.,HERE)
  1410. XC                                               !PRINT ROOMS CONTENTS.
  1411. X      RFLAG(HERE)=or(RFLAG(HERE),RSEEN)
  1412. X      RETURN
  1413. XC
  1414. X9500  IF(HERE.NE.SCOLAC) GO TO 9700
  1415. XC                                               !IN SCOL ACTIVE ROOM?
  1416. X      DO 9600 I=1,12,3
  1417. X        TARGET=SCOLWL(I+1)
  1418. XC                                               !ASSUME TARGET.
  1419. X        IF(SCOLWL(I).EQ.HERE) GO TO 2100
  1420. XC                                               !TREAT IF FOUND.
  1421. X9600  CONTINUE
  1422. XC
  1423. X9700  IF(HERE.NE.BKBOX) GO TO 10
  1424. XC                                               !IN BOX ROOM?
  1425. X      TARGET=WNORT
  1426. X      GO TO 2100
  1427. X`0C
  1428. XC NOBJS, PAGE 7
  1429. XC
  1430. XC O41-- SHORT POLE
  1431. XC
  1432. X10000 IF(PRSA.NE.RAISEW) GO TO 10100
  1433. XC                                               !LIFT?
  1434. X      I=749
  1435. XC                                               !ASSUME UP.
  1436. X      IF(POLEUF.EQ.2) I=750
  1437. XC                                               !ALREADY UP?
  1438. X      CALL RSPEAK(I)
  1439. X      POLEUF=2
  1440. XC                                               !POLE IS RAISED.
  1441. X      RETURN
  1442. XC
  1443. X10100 IF((PRSA.NE.LOWERW).AND.(PRSA.NE.PUSHW)) GO TO 10
  1444. X      IF(POLEUF.NE.0) GO TO 10200
  1445. XC                                               !ALREADY LOWERED?
  1446. X      CALL RSPEAK(751)
  1447. XC                                               !CANT DO IT.
  1448. X      RETURN
  1449. XC
  1450. X10200 IF(MOD(MDIR,180).NE.0) GO TO 10300
  1451. XC                                               !MIRROR N-S?
  1452. X      POLEUF=0
  1453. XC                                               !YES, LOWER INTO
  1454. X      CALL RSPEAK(752)
  1455. XC                                               !CHANNEL.
  1456. X      RETURN
  1457. XC
  1458. X10300 IF((MDIR.NE.270).OR.(MLOC.NE.MRB)) GO TO 10400
  1459. X      POLEUF=0
  1460. XC                                               !LOWER INTO HOLE.
  1461. X      CALL RSPEAK(753)
  1462. X      RETURN
  1463. XC
  1464. X10400 CALL RSPEAK(753+POLEUF)
  1465. XC                                               !POLEUF = 1 OR 2.
  1466. X      POLEUF=1
  1467. XC                                               !NOW ON FLOOR.
  1468. X      RETURN
  1469. XC
  1470. XC O42-- MIRROR SWITCH
  1471. XC
  1472. X11000 IF(PRSA.NE.PUSHW) GO TO 10
  1473. XC                                               !PUSH?
  1474. X      IF(MRPSHF) GO TO 11300
  1475. XC                                               !ALREADY PUSHED?
  1476. X      CALL RSPEAK(756)
  1477. XC                                               !BUTTON GOES IN.
  1478. X      DO 11100 I=1,OLNT
  1479. XC                                               !BLOCKED?
  1480. X        IF(QHERE(I,MREYE).AND.(I.NE.RBEAM)) GO TO 11200
  1481. X11100 CONTINUE
  1482. X      CALL RSPEAK(757)
  1483. XC                                               !NOTHING IN BEAM.
  1484. X      RETURN
  1485. XC
  1486. X11200 CFLAG(CEVMRS)=.TRUE.
  1487. XC                                               !MIRROR OPENS.
  1488. X      CTICK(CEVMRS)=7
  1489. X      MRPSHF=.TRUE.
  1490. X      MROPNF=.TRUE.
  1491. X      RETURN
  1492. XC
  1493. X11300 CALL RSPEAK(758)
  1494. XC                                               !MIRROR ALREADYOPEN.
  1495. X      RETURN
  1496. X`0C
  1497. XC NOBJS, PAGE 8
  1498. XC
  1499. XC O43-- BEAM FUNCTION
  1500. XC
  1501. X12000 IF((PRSA.NE.TAKEW).OR.(PRSO.NE.RBEAM)) GO TO 12100
  1502. X      CALL RSPEAK(759)
  1503. XC                                               !TAKE BEAM, JOKE.
  1504. X      RETURN
  1505. XC
  1506. X12100 I=PRSO
  1507. XC                                               !ASSUME BLK WITH DIROBJ.
  1508. X      IF((PRSA.EQ.PUTW).AND.(PRSI.EQ.RBEAM)) GO TO 12200
  1509. X      IF((PRSA.NE.MUNGW).OR.(PRSO.NE.RBEAM).OR.
  1510. X     &          (PRSI.EQ.0)) GO TO 10
  1511. X      I=PRSI
  1512. X12200 IF(OADV(I).NE.WINNER) GO TO 12300
  1513. XC                                               !CARRYING?
  1514. X      CALL NEWSTA(I,0,HERE,0,0)
  1515. XC                                               !DROP OBJ.
  1516. X      CALL RSPSUB(760,ODESC2(I))
  1517. X      RETURN
  1518. XC
  1519. X12300 J=761
  1520. XC                                               !ASSUME NOT IN ROOM.
  1521. X      IF(QHERE(J,HERE)) I=762
  1522. XC                                               !IN ROOM?
  1523. X      CALL RSPSUB(J,ODESC2(I))
  1524. XC                                               !DESCRIBE.
  1525. X      RETURN
  1526. XC
  1527. XC O44-- BRONZE DOOR
  1528. XC
  1529. X13000 IF((HERE.EQ.NCELL).OR.((LCELL.EQ.4).AND.
  1530. X     &   ((HERE.EQ.CELL).OR.(HERE.EQ.SCORR))))
  1531. X     &  GO TO 13100
  1532. X      CALL RSPEAK(763)
  1533. XC                                               !DOOR NOT THERE.
  1534. X      RETURN
  1535. XC
  1536. X13100 IF(.NOT.OPNCLS(ODOOR,764,765)) GO TO 10
  1537. XC                                               !OPEN/CLOSE?
  1538. X      IF((HERE.EQ.NCELL).AND.QOPEN(ODOOR))
  1539. X     &  CALL RSPEAK(766)
  1540. X      RETURN
  1541. XC
  1542. XC O45-- QUIZ DOOR
  1543. XC
  1544. X14000 IF((PRSA.NE.OPENW).AND.(PRSA.NE.CLOSEW)) GO TO 14100
  1545. X      CALL RSPEAK(767)
  1546. XC                                               !DOOR WONT MOVE.
  1547. X      RETURN
  1548. XC
  1549. X14100 IF(PRSA.NE.KNOCKW) GO TO 10
  1550. XC                                               !KNOCK?
  1551. X      IF(INQSTF) GO TO 14200
  1552. XC                                               !TRIED IT ALREADY?
  1553. X      INQSTF=.TRUE.
  1554. XC                                               !START INQUISITION.
  1555. X      CFLAG(CEVINQ)=.TRUE.
  1556. X      CTICK(CEVINQ)=2
  1557. X      QUESNO=RND(8)
  1558. XC                                               !SELECT QUESTION.
  1559. X      NQATT=0
  1560. X      CORRCT=0
  1561. X      CALL RSPEAK(768)
  1562. XC                                               !ANNOUNCE RULES.
  1563. X      CALL RSPEAK(769)
  1564. X      CALL RSPEAK(770+QUESNO)
  1565. +-+-+-+-+-+-+-+-  END  OF PART 25 +-+-+-+-+-+-+-+-
  1566.