home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / games / volume2 / dungeon / part06 / nrooms.F < prev    next >
Text File  |  1987-09-01  |  7KB  |  359 lines
  1. C RAPPL2- SPECIAL PURPOSE ROOM ROUTINES, PART 2
  2. C
  3. C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
  4. C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
  5. C WRITTEN BY R. M. SUPNIK
  6. C
  7. C DECLARATIONS
  8. C
  9.     LOGICAL FUNCTION RAPPL2(RI)
  10.     IMPLICIT INTEGER (A-Z)
  11.     LOGICAL QOPEN,QHERE
  12. #include "parser.h"
  13. #include "gamestate.h"
  14. #include "state.h"
  15. #include "io.h"
  16. #include "rooms.h"
  17. #include "rflag.h"
  18. #include "rindex.h"
  19. #include "objects.h"
  20. #include "oflags.h"
  21. #include "oindex.h"
  22. #include "xsrch.h"
  23. #include "clock.h"
  24. #include "advers.h"
  25. #include "verbs.h"
  26. #include "flags.h"
  27. C
  28. C FUNCTIONS AND DATA
  29. C
  30.     QOPEN(R)=and(OFLAG2(R),OPENBT).NE.0
  31.     DATA NEWRMS/38/
  32. C RAPPL2, PAGE 2
  33. C
  34.     RAPPL2=.TRUE.
  35.     GO TO (38000,39000,40000,41000,42000,43000,44000,
  36. &        45000,46000,47000,48000,49000,50000,
  37. &        51000,52000,53000,54000,55000,56000,
  38. &        57000,58000,59000,60000),
  39. &        (RI-NEWRMS+1)
  40.     CALL BUG(70,RI)
  41.     RETURN
  42. C
  43. C R38--    MIRROR D ROOM
  44. C
  45. 38000    IF(PRSA.EQ.LOOKW) CALL LOOKTO(FDOOR,MRG,0,682,681)
  46.     RETURN
  47. C
  48. C R39--    MIRROR G ROOM
  49. C
  50. 39000    IF(PRSA.EQ.WALKIW) CALL JIGSUP(685)
  51.     RETURN
  52. C
  53. C R40--    MIRROR C ROOM
  54. C
  55. 40000    IF(PRSA.EQ.LOOKW) CALL LOOKTO(MRG,MRB,683,0,681)
  56.     RETURN
  57. C
  58. C R41--    MIRROR B ROOM
  59. C
  60. 41000    IF(PRSA.EQ.LOOKW) CALL LOOKTO(MRC,MRA,0,0,681)
  61.     RETURN
  62. C
  63. C R42--    MIRROR A ROOM
  64. C
  65. 42000    IF(PRSA.EQ.LOOKW) CALL LOOKTO(MRB,0,0,684,681)
  66.     RETURN
  67. C RAPPL2, PAGE 3
  68. C
  69. C R43--    MIRROR C EAST/WEST
  70. C
  71. 43000    IF(PRSA.EQ.LOOKW) CALL EWTELL(HERE,683)
  72.     RETURN
  73. C
  74. C R44--    MIRROR B EAST/WEST
  75. C
  76. 44000    IF(PRSA.EQ.LOOKW) CALL EWTELL(HERE,686)
  77.     RETURN
  78. C
  79. C R45--    MIRROR A EAST/WEST
  80. C
  81. 45000    IF(PRSA.EQ.LOOKW) CALL EWTELL(HERE,687)
  82.     RETURN
  83. C
  84. C R46--    INSIDE MIRROR
  85. C
  86. 46000    IF(PRSA.NE.LOOKW) RETURN
  87. C                        !LOOK?
  88.     CALL RSPEAK(688)
  89. C                        !DESCRIBE
  90. C
  91. C NOW DESCRIBE POLE STATE.
  92. C
  93. C CASES 1,2--    MDIR=270 & MLOC=MRB, POLE IS UP OR IN HOLE
  94. C CASES 3,4--    MDIR=0 V MDIR=180, POLE IS UP OR IN CHANNEL
  95. C CASE 5--    POLE IS UP
  96. C
  97.     I=689
  98. C                        !ASSUME CASE 5.
  99.     IF((MDIR.EQ.270).AND.(MLOC.EQ.MRB))
  100. &        I=690+MIN0(POLEUF,1)
  101.     IF(MOD(MDIR,180).EQ.0)
  102. &        I=692+MIN0(POLEUF,1)
  103.     CALL RSPEAK(I)
  104. C                        !DESCRIBE POLE.
  105.     CALL RSPSUB(694,695+(MDIR/45))
  106. C                        !DESCRIBE ARROW.
  107.     RETURN
  108. C RAPPL2, PAGE 4
  109. C
  110. C R47--    MIRROR EYE ROOM
  111. C
  112. 47000    IF(PRSA.NE.LOOKW) RETURN
  113. C                        !LOOK?
  114.     I=704
  115. C                        !ASSUME BEAM STOP.
  116.     DO 47100 J=1,OLNT
  117.       IF(QHERE(J,HERE).AND.(J.NE.RBEAM)) GO TO 47200
  118. 47100    CONTINUE
  119.     I=703
  120. 47200    CALL RSPSUB(I,ODESC2(J))
  121. C                        !DESCRIBE BEAM.
  122.     CALL LOOKTO(MRA,0,0,0,0)
  123. C                        !LOOK NORTH.
  124.     RETURN
  125. C
  126. C R48--    INSIDE CRYPT
  127. C
  128. 48000    IF(PRSA.NE.LOOKW) RETURN
  129. C                        !LOOK?
  130.     I=46
  131. C                        !CRYPT IS OPEN/CLOSED.
  132.     IF(QOPEN(TOMB)) I=12
  133.     CALL RSPSUB(705,I)
  134.     RETURN
  135. C
  136. C R49--    SOUTH CORRIDOR
  137. C
  138. 49000    IF(PRSA.NE.LOOKW) RETURN
  139. C                        !LOOK?
  140.     CALL RSPEAK(706)
  141. C                        !DESCRIBE.
  142.     I=46
  143. C                        !ODOOR IS OPEN/CLOSED.
  144.     IF(QOPEN(ODOOR)) I=12
  145.     IF(LCELL.EQ.4) CALL RSPSUB(707,I)
  146. C                        !DESCRIBE ODOOR IF THERE.
  147.     RETURN
  148. C
  149. C R50--    BEHIND DOOR
  150. C
  151. 50000    IF(PRSA.NE.WALKIW) GO TO 50100
  152. C                        !WALK IN?
  153.     CFLAG(CEVFOL)=.TRUE.
  154. C                        !MASTER FOLLOWS.
  155.     CTICK(CEVFOL)=-1
  156.     RETURN
  157. C
  158. 50100    IF(PRSA.NE.LOOKW) RETURN
  159. C                        !LOOK?
  160.     I=46
  161. C                        !QDOOR IS OPEN/CLOSED.
  162.     IF(QOPEN(QDOOR)) I=12
  163.     CALL RSPSUB(708,I)
  164.     RETURN
  165. C RAPPL2, PAGE 5
  166. C
  167. C R51--    FRONT DOOR
  168. C
  169. 51000    IF(PRSA.EQ.WALKIW) CTICK(CEVFOL)=0
  170. C                        !IF EXITS, KILL FOLLOW.
  171.     IF(PRSA.NE.LOOKW) RETURN
  172. C                        !LOOK?
  173.     CALL LOOKTO(0,MRD,709,0,0)
  174. C                        !DESCRIBE SOUTH.
  175.     I=46
  176. C                        !PANEL IS OPEN/CLOSED.
  177.     IF(INQSTF) I=12
  178. C                        !OPEN IF INQ STARTED.
  179.     J=46
  180. C                        !QDOOR IS OPEN/CLOSED.
  181.     IF(QOPEN(QDOOR)) J=12
  182.     CALL RSPSB2(710,I,J)
  183.     RETURN
  184. C
  185. C R52--    NORTH CORRIDOR
  186. C
  187. 52000    IF(PRSA.NE.LOOKW) RETURN
  188. C                        !LOOK?
  189.     I=46
  190.     IF(QOPEN(CDOOR)) I=12
  191. C                        !CDOOR IS OPEN/CLOSED.
  192.     CALL RSPSUB(711,I)
  193.     RETURN
  194. C
  195. C R53--    PARAPET
  196. C
  197. 53000    IF(PRSA.EQ.LOOKW) CALL RSPSUB(712,712+PNUMB)
  198.     RETURN
  199. C
  200. C R54--    CELL
  201. C
  202. 54000    IF(PRSA.NE.LOOKW) RETURN
  203. C                        !LOOK?
  204.     I=721
  205. C                        !CDOOR IS OPEN/CLOSED.
  206.     IF(QOPEN(CDOOR)) I=722
  207.     CALL RSPEAK(I)
  208.     I=46
  209. C                        !ODOOR IS OPEN/CLOSED.
  210.     IF(QOPEN(ODOOR)) I=12
  211.     IF(LCELL.EQ.4) CALL RSPSUB(723,I)
  212. C                        !DESCRIBE.
  213.     RETURN
  214. C
  215. C R55--    PRISON CELL
  216. C
  217. 55000    IF(PRSA.EQ.LOOKW) CALL RSPEAK(724)
  218. C                        !LOOK?
  219.     RETURN
  220. C
  221. C R56--    NIRVANA CELL
  222. C
  223. 56000    IF(PRSA.NE.LOOKW) RETURN
  224. C                        !LOOK?
  225.     I=46
  226. C                        !ODOOR IS OPEN/CLOSED.
  227.     IF(QOPEN(ODOOR)) I=12
  228.     CALL RSPSUB(725,I)
  229.     RETURN
  230. C RAPPL2, PAGE 6
  231. C
  232. C R57--    NIRVANA AND END OF GAME
  233. C
  234. 57000    IF(PRSA.NE.WALKIW) RETURN
  235. C                        !WALKIN?
  236.     CALL RSPEAK(726)
  237.     CALL SCORE(.FALSE.)
  238. C moved to exit routine    CLOSE(DBCH)
  239.     CALL EXIT
  240. C
  241. C R58--    TOMB ROOM
  242. C
  243. 58000    IF(PRSA.NE.LOOKW) RETURN
  244. C                        !LOOK?
  245.     I=46
  246. C                        !TOMB IS OPEN/CLOSED.
  247.     IF(QOPEN(TOMB)) I=12
  248.     CALL RSPSUB(792,I)
  249.     RETURN
  250. C
  251. C R59--    PUZZLE SIDE ROOM
  252. C
  253. 59000    IF(PRSA.NE.LOOKW) RETURN
  254. C                        !LOOK?
  255.     I=861
  256. C                        !ASSUME DOOR CLOSED.
  257.     IF(CPOUTF) I=862
  258. C                        !OPEN?
  259.     CALL RSPEAK(I)
  260. C                        !DESCRIBE.
  261.     RETURN
  262. C
  263. C R60--    PUZZLE ROOM
  264. C
  265. 60000    IF(PRSA.NE.LOOKW) RETURN
  266. C                        !LOOK?
  267.     IF(CPUSHF) GO TO 60100
  268. C                        !STARTED PUZZLE?
  269.     CALL RSPEAK(868)
  270. C                        !NO, DESCRIBE.
  271.     IF(and(OFLAG2(WARNI),TCHBT).NE.0) CALL RSPEAK(869)
  272.     RETURN
  273. C
  274. 60100    CALL CPINFO(880,CPHERE)
  275. C                        !DESCRIBE ROOM.
  276.     RETURN
  277. C
  278.     END
  279. C LOOKTO--    DESCRIBE VIEW IN MIRROR HALLWAY
  280. C
  281. C DECLARATIONS
  282. C
  283.     SUBROUTINE LOOKTO(NRM,SRM,NT,ST,HT)
  284.     IMPLICIT INTEGER(A-Z)
  285. #include "gamestate.h"
  286. #include "flags.h"
  287. C LOOKTO, PAGE 2
  288. C
  289.     CALL RSPEAK(HT)
  290. C                        !DESCRIBE HALL.
  291.     CALL RSPEAK(NT)
  292. C                        !DESCRIBE NORTH VIEW.
  293.     CALL RSPEAK(ST)
  294. C                        !DESCRIBE SOUTH VIEW.
  295.     DIR=0
  296. C                        !ASSUME NO DIRECTION.
  297.     IF(IABS(MLOC-HERE).NE.1) GO TO 200
  298. C                        !MIRROR TO N OR S?
  299.     IF(MLOC.EQ.NRM) DIR=695
  300.     IF(MLOC.EQ.SRM) DIR=699
  301. C                        !DIR=N/S.
  302.     IF(MOD(MDIR,180).NE.0) GO TO 100
  303. C                        !MIRROR N-S?
  304.     CALL RSPSUB(847,DIR)
  305. C                        !YES, HE SEES PANEL
  306.     CALL RSPSB2(848,DIR,DIR)
  307. C                        !AND NARROW ROOMS.
  308.     GO TO 200
  309. C
  310. 100    M1=MRHERE(HERE)
  311. C                        !WHICH MIRROR?
  312.     MRBF=0
  313. C                        !ASSUME INTACT.
  314.     IF(((M1.EQ.1).AND..NOT.MR1F).OR.
  315. &      ((M1.EQ.2).AND..NOT.MR2F)) MRBF=1
  316.     CALL RSPSUB(849+MRBF,DIR)
  317. C                        !DESCRIBE.
  318.     IF((M1.EQ.1).AND.MROPNF) CALL RSPEAK(823+MRBF)
  319.     IF(MRBF.NE.0) CALL RSPEAK(851)
  320. C
  321. 200    I=0
  322. C                        !ASSUME NO MORE TO DO.
  323.     IF((NT.EQ.0).AND.((DIR.EQ.0).OR.(DIR.EQ.699))) I=852
  324.     IF((ST.EQ.0).AND.((DIR.EQ.0).OR.(DIR.EQ.695))) I=853
  325.     IF((NT+ST+DIR).EQ.0) I=854
  326.     IF(HT.NE.0) CALL RSPEAK(I)
  327. C                        !DESCRIBE HALLS.
  328.     RETURN
  329. C
  330.     END
  331. C EWTELL--    DESCRIBE E/W NARROW ROOMS
  332. C
  333. C DECLARATIONS
  334. C
  335.     SUBROUTINE EWTELL(RM,ST)
  336.     IMPLICIT INTEGER(A-Z)
  337.     LOGICAL M1
  338. C
  339. C ROOMS
  340. #include "rindex.h"
  341. #include "flags.h"
  342. C EWTELL, PAGE 2
  343. C
  344. C NOTE THAT WE ARE EAST OR WEST OF MIRROR, AND
  345. C MIRROR MUST BE N-S.
  346. C
  347.     M1=(MDIR+(MOD(RM-MRAE,2)*180)).EQ.180
  348.     I=819+MOD(RM-MRAE,2)
  349. C                        !GET BASIC E/W STRING.
  350.     IF((M1.AND..NOT.MR1F).OR.(.NOT.M1.AND..NOT.MR2F))
  351. &        I=I+2
  352.     CALL RSPEAK(I)
  353.     IF(M1.AND.MROPNF) CALL RSPEAK(823+((I-819)/2))
  354.     CALL RSPEAK(825)
  355.     CALL RSPEAK(ST)
  356.     RETURN
  357. C
  358.     END
  359.