# 2.11BSD#431 - /usr/src/new/PORT/dungeon/nrooms.F

       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: 673 |