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
Last modified: 1988-10-21
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 661
Valid CSS Valid XHTML 1.0 Strict