4.4BSD/usr/src/contrib/dungeon/nrooms.F

C RAPPL2- SPECIAL PURPOSE ROOM ROUTINES, PART 2
C
C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
C WRITTEN BY R. M. SUPNIK
C
C DECLARATIONS
C
	LOGICAL FUNCTION RAPPL2(RI)
	IMPLICIT INTEGER (A-Z)
	LOGICAL QOPEN,QHERE
#include "parser.h"
#include "gamestate.h"
#include "state.h"
#include "io.h"
#include "rooms.h"
#include "rflag.h"
#include "rindex.h"
#include "objects.h"
#include "oflags.h"
#include "oindex.h"
#include "xsrch.h"
#include "clock.h"
#include "advers.h"
#include "verbs.h"
#include "flags.h"
C
C FUNCTIONS AND DATA
C
	QOPEN(R)=and(OFLAG2(R),OPENBT).NE.0
	DATA NEWRMS/38/
C RAPPL2, PAGE 2
C
	RAPPL2=.TRUE.
	GO TO (38000,39000,40000,41000,42000,43000,44000,
&		45000,46000,47000,48000,49000,50000,
&		51000,52000,53000,54000,55000,56000,
&		57000,58000,59000,60000),
&		(RI-NEWRMS+1)
	CALL BUG(70,RI)
	RETURN
C
C R38--	MIRROR D ROOM
C
38000	IF(PRSA.EQ.LOOKW) CALL LOOKTO(FDOOR,MRG,0,682,681)
	RETURN
C
C R39--	MIRROR G ROOM
C
39000	IF(PRSA.EQ.WALKIW) CALL JIGSUP(685)
	RETURN
C
C R40--	MIRROR C ROOM
C
40000	IF(PRSA.EQ.LOOKW) CALL LOOKTO(MRG,MRB,683,0,681)
	RETURN
C
C R41--	MIRROR B ROOM
C
41000	IF(PRSA.EQ.LOOKW) CALL LOOKTO(MRC,MRA,0,0,681)
	RETURN
C
C R42--	MIRROR A ROOM
C
42000	IF(PRSA.EQ.LOOKW) CALL LOOKTO(MRB,0,0,684,681)
	RETURN
C RAPPL2, PAGE 3
C
C R43--	MIRROR C EAST/WEST
C
43000	IF(PRSA.EQ.LOOKW) CALL EWTELL(HERE,683)
	RETURN
C
C R44--	MIRROR B EAST/WEST
C
44000	IF(PRSA.EQ.LOOKW) CALL EWTELL(HERE,686)
	RETURN
C
C R45--	MIRROR A EAST/WEST
C
45000	IF(PRSA.EQ.LOOKW) CALL EWTELL(HERE,687)
	RETURN
C
C R46--	INSIDE MIRROR
C
46000	IF(PRSA.NE.LOOKW) RETURN
C						!LOOK?
	CALL RSPEAK(688)
C						!DESCRIBE
C
C NOW DESCRIBE POLE STATE.
C
C CASES 1,2--	MDIR=270 & MLOC=MRB, POLE IS UP OR IN HOLE
C CASES 3,4--	MDIR=0 V MDIR=180, POLE IS UP OR IN CHANNEL
C CASE 5--	POLE IS UP
C
	I=689
C						!ASSUME CASE 5.
	IF((MDIR.EQ.270).AND.(MLOC.EQ.MRB))
&		I=690+MIN0(POLEUF,1)
	IF(MOD(MDIR,180).EQ.0)
&		I=692+MIN0(POLEUF,1)
	CALL RSPEAK(I)
C						!DESCRIBE POLE.
	CALL RSPSUB(694,695+(MDIR/45))
C						!DESCRIBE ARROW.
	RETURN
C RAPPL2, PAGE 4
C
C R47--	MIRROR EYE ROOM
C
47000	IF(PRSA.NE.LOOKW) RETURN
C						!LOOK?
	I=704
C						!ASSUME BEAM STOP.
	DO 47100 J=1,OLNT
	  IF(QHERE(J,HERE).AND.(J.NE.RBEAM)) GO TO 47200
47100	CONTINUE
	I=703
47200	CALL RSPSUB(I,ODESC2(J))
C						!DESCRIBE BEAM.
	CALL LOOKTO(MRA,0,0,0,0)
C						!LOOK NORTH.
	RETURN
C
C R48--	INSIDE CRYPT
C
48000	IF(PRSA.NE.LOOKW) RETURN
C						!LOOK?
	I=46
C						!CRYPT IS OPEN/CLOSED.
	IF(QOPEN(TOMB)) I=12
	CALL RSPSUB(705,I)
	RETURN
C
C R49--	SOUTH CORRIDOR
C
49000	IF(PRSA.NE.LOOKW) RETURN
C						!LOOK?
	CALL RSPEAK(706)
C						!DESCRIBE.
	I=46
C						!ODOOR IS OPEN/CLOSED.
	IF(QOPEN(ODOOR)) I=12
	IF(LCELL.EQ.4) CALL RSPSUB(707,I)
C						!DESCRIBE ODOOR IF THERE.
	RETURN
C
C R50--	BEHIND DOOR
C
50000	IF(PRSA.NE.WALKIW) GO TO 50100
C						!WALK IN?
	CFLAG(CEVFOL)=.TRUE.
C						!MASTER FOLLOWS.
	CTICK(CEVFOL)=-1
	RETURN
C
50100	IF(PRSA.NE.LOOKW) RETURN
C						!LOOK?
	I=46
C						!QDOOR IS OPEN/CLOSED.
	IF(QOPEN(QDOOR)) I=12
	CALL RSPSUB(708,I)
	RETURN
C RAPPL2, PAGE 5
C
C R51--	FRONT DOOR
C
51000	IF(PRSA.EQ.WALKIW) CTICK(CEVFOL)=0
C						!IF EXITS, KILL FOLLOW.
	IF(PRSA.NE.LOOKW) RETURN
C						!LOOK?
	CALL LOOKTO(0,MRD,709,0,0)
C						!DESCRIBE SOUTH.
	I=46
C						!PANEL IS OPEN/CLOSED.
	IF(INQSTF) I=12
C						!OPEN IF INQ STARTED.
	J=46
C						!QDOOR IS OPEN/CLOSED.
	IF(QOPEN(QDOOR)) J=12
	CALL RSPSB2(710,I,J)
	RETURN
C
C R52--	NORTH CORRIDOR
C
52000	IF(PRSA.NE.LOOKW) RETURN
C						!LOOK?
	I=46
	IF(QOPEN(CDOOR)) I=12
C						!CDOOR IS OPEN/CLOSED.
	CALL RSPSUB(711,I)
	RETURN
C
C R53--	PARAPET
C
53000	IF(PRSA.EQ.LOOKW) CALL RSPSUB(712,712+PNUMB)
	RETURN
C
C R54--	CELL
C
54000	IF(PRSA.NE.LOOKW) RETURN
C						!LOOK?
	I=721
C						!CDOOR IS OPEN/CLOSED.
	IF(QOPEN(CDOOR)) I=722
	CALL RSPEAK(I)
	I=46
C						!ODOOR IS OPEN/CLOSED.
	IF(QOPEN(ODOOR)) I=12
	IF(LCELL.EQ.4) CALL RSPSUB(723,I)
C						!DESCRIBE.
	RETURN
C
C R55--	PRISON CELL
C
55000	IF(PRSA.EQ.LOOKW) CALL RSPEAK(724)
C						!LOOK?
	RETURN
C
C R56--	NIRVANA CELL
C
56000	IF(PRSA.NE.LOOKW) RETURN
C						!LOOK?
	I=46
C						!ODOOR IS OPEN/CLOSED.
	IF(QOPEN(ODOOR)) I=12
	CALL RSPSUB(725,I)
	RETURN
C RAPPL2, PAGE 6
C
C R57--	NIRVANA AND END OF GAME
C
57000	IF(PRSA.NE.WALKIW) RETURN
C						!WALKIN?
	CALL RSPEAK(726)
	CALL SCORE(.FALSE.)
C moved to exit routine	CLOSE(DBCH)
	CALL EXIT
C
C R58--	TOMB ROOM
C
58000	IF(PRSA.NE.LOOKW) RETURN
C						!LOOK?
	I=46
C						!TOMB IS OPEN/CLOSED.
	IF(QOPEN(TOMB)) I=12
	CALL RSPSUB(792,I)
	RETURN
C
C R59--	PUZZLE SIDE ROOM
C
59000	IF(PRSA.NE.LOOKW) RETURN
C						!LOOK?
	I=861
C						!ASSUME DOOR CLOSED.
	IF(CPOUTF) I=862
C						!OPEN?
	CALL RSPEAK(I)
C						!DESCRIBE.
	RETURN
C
C R60--	PUZZLE ROOM
C
60000	IF(PRSA.NE.LOOKW) RETURN
C						!LOOK?
	IF(CPUSHF) GO TO 60100
C						!STARTED PUZZLE?
	CALL RSPEAK(868)
C						!NO, DESCRIBE.
	IF(and(OFLAG2(WARNI),TCHBT).NE.0) CALL RSPEAK(869)
	RETURN
C
60100	CALL CPINFO(880,CPHERE)
C						!DESCRIBE ROOM.
	RETURN
C
	END
C LOOKTO--	DESCRIBE VIEW IN MIRROR HALLWAY
C
C DECLARATIONS
C
	SUBROUTINE LOOKTO(NRM,SRM,NT,ST,HT)
	IMPLICIT INTEGER(A-Z)
#include "gamestate.h"
#include "flags.h"
C LOOKTO, PAGE 2
C
	CALL RSPEAK(HT)
C						!DESCRIBE HALL.
	CALL RSPEAK(NT)
C						!DESCRIBE NORTH VIEW.
	CALL RSPEAK(ST)
C						!DESCRIBE SOUTH VIEW.
	DIR=0
C						!ASSUME NO DIRECTION.
	IF(IABS(MLOC-HERE).NE.1) GO TO 200
C						!MIRROR TO N OR S?
	IF(MLOC.EQ.NRM) DIR=695
	IF(MLOC.EQ.SRM) DIR=699
C						!DIR=N/S.
	IF(MOD(MDIR,180).NE.0) GO TO 100
C						!MIRROR N-S?
	CALL RSPSUB(847,DIR)
C						!YES, HE SEES PANEL
	CALL RSPSB2(848,DIR,DIR)
C						!AND NARROW ROOMS.
	GO TO 200
C
100	M1=MRHERE(HERE)
C						!WHICH MIRROR?
	MRBF=0
C						!ASSUME INTACT.
	IF(((M1.EQ.1).AND..NOT.MR1F).OR.
&	  ((M1.EQ.2).AND..NOT.MR2F)) MRBF=1
	CALL RSPSUB(849+MRBF,DIR)
C						!DESCRIBE.
	IF((M1.EQ.1).AND.MROPNF) CALL RSPEAK(823+MRBF)
	IF(MRBF.NE.0) CALL RSPEAK(851)
C
200	I=0
C						!ASSUME NO MORE TO DO.
	IF((NT.EQ.0).AND.((DIR.EQ.0).OR.(DIR.EQ.699))) I=852
	IF((ST.EQ.0).AND.((DIR.EQ.0).OR.(DIR.EQ.695))) I=853
	IF((NT+ST+DIR).EQ.0) I=854
	IF(HT.NE.0) CALL RSPEAK(I)
C						!DESCRIBE HALLS.
	RETURN
C
	END
C EWTELL--	DESCRIBE E/W NARROW ROOMS
C
C DECLARATIONS
C
	SUBROUTINE EWTELL(RM,ST)
	IMPLICIT INTEGER(A-Z)
	LOGICAL M1
C
C ROOMS
#include "rindex.h"
#include "flags.h"
C EWTELL, PAGE 2
C
C NOTE THAT WE ARE EAST OR WEST OF MIRROR, AND
C MIRROR MUST BE N-S.
C
	M1=(MDIR+(MOD(RM-MRAE,2)*180)).EQ.180
	I=819+MOD(RM-MRAE,2)
C						!GET BASIC E/W STRING.
	IF((M1.AND..NOT.MR1F).OR.(.NOT.M1.AND..NOT.MR2F))
&		I=I+2
	CALL RSPEAK(I)
	IF(M1.AND.MROPNF) CALL RSPEAK(823+((I-819)/2))
	CALL RSPEAK(825)
	CALL RSPEAK(ST)
	RETURN
C
	END