zork-fortran/nobjs.for

C NOBJS-	NEW OBJECTS PROCESSOR
C	OBJECTS IN THIS MODULE CANNOT CALL RMINFO, JIGSUP,
C	MAJOR VERBS, OR OTHER NON-RESIDENT SUBROUTINES
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 NOBJS(RI,ARG)
	IMPLICIT INTEGER (A-Z)
	LOGICAL QOPEN,MOVETO,F
	LOGICAL QHERE,OPNCLS,MIRPAN
	include 'parser.h'
	include 'gamestat.h'
	include 'state.h'
	include 'screen.h'
	include 'puzzle.h'
C
C MISCELLANEOUS VARIABLES
C
	COMMON /HYPER/ HFACTR
	include 'rooms.h'
	include 'rflag.h'
	include 'rindex.h'
	include 'objects.h'
	include 'oflags.h'
	include 'oindex.h'
	include 'clock.h'

	include 'villians.h'
	include 'advers.h'
	include 'verbs.h'
	include 'flags.h'
C
C FUNCTIONS AND DATA
C
	QOPEN(R)=IAND(OFLAG2(R),OPENBT).NE.0
C NOBJS, PAGE 2
C
	IF(PRSO.NE.0) ODO2=ODESC2(PRSO)
	IF(PRSI.NE.0) ODI2=ODESC2(PRSI)
	AV=AVEHIC(WINNER)
	NOBJS=.TRUE.
C
	GO TO (1000,2000,3000,4000,5000,6000,7000,8000,9000,
     & 10000,11000,12000,13000,14000,15000,16000,17000,
     & 18000,19000,20000,21000),
     &	(RI-31)
	CALL BUG(6,RI)
C
C RETURN HERE TO DECLARE FALSE RESULT
C
10	NOBJS=.FALSE.
	RETURN
C
C O32--	BILLS
C
1000	IF(PRSA.NE.EATW) GO TO 1100
C						!EAT?
	CALL RSPEAK(639)
C						!JOKE.
	RETURN
C
1100	IF(PRSA.EQ.BURNW) CALL RSPEAK(640)
C						!BURN?  JOKE.
	GO TO 10
C						!LET IT BE HANDLED.
C NOBJS, PAGE 3
C
C O33--	SCREEN OF LIGHT
C
2000	TARGET=SCOL
C						!TARGET IS SCOL.
2100	IF(PRSO.NE.TARGET) GO TO 2400
C						!PRSO EQ TARGET?
	IF((PRSA.NE.PUSHW).AND.(PRSA.NE.MOVEW).AND.
     &	(PRSA.NE.TAKEW).AND.(PRSA.NE.RUBW)) GO TO 2200
	CALL RSPEAK(673)
C						!HAND PASSES THRU.
	RETURN
C
2200	IF((PRSA.NE.KILLW).AND.(PRSA.NE.ATTACW).AND.
     &	(PRSA.NE.MUNGW)) GO TO 2400
	CALL RSPSUB(674,ODI2)
C						!PASSES THRU.
	RETURN
C
2400	IF((PRSA.NE.THROWW).OR.(PRSI.NE.TARGET)) GO TO 10
	IF(HERE.EQ.BKBOX) GO TO 2600
C						!THRU SCOL?
	CALL NEWSTA(PRSO,0,BKBOX,0,0)
C						!NO, THRU WALL.
	CALL RSPSUB(675,ODO2)
C						!ENDS UP IN BOX ROOM.
	CTICK(CEVSCL)=0
C						!CANCEL ALARM.
	SCOLRM=0
C						!RESET SCOL ROOM.
	RETURN
C
2600	IF(SCOLRM.EQ.0) GO TO 2900
C						!TRIED TO GO THRU?
	CALL NEWSTA(PRSO,0,SCOLRM,0,0)
C						!SUCCESS.
	CALL RSPSUB(676,ODO2)
C						!ENDS UP SOMEWHERE.
	CTICK(CEVSCL)=0
C						!CANCEL ALARM.
	SCOLRM=0
C						!RESET SCOL ROOM.
	RETURN
C
2900	CALL RSPEAK(213)
C						!CANT DO IT.
	RETURN
C NOBJS, PAGE 4
C
C O34--	GNOME OF ZURICH
C
3000	IF((PRSA.NE.GIVEW).AND.(PRSA.NE.THROWW)) GO TO 3200
	IF(OTVAL(PRSO).NE.0) GO TO 3100
C						!THROW A TREASURE?
	CALL NEWSTA(PRSO,641,0,0,0)
C						!NO, GO POP.
	RETURN
C
3100	CALL NEWSTA(PRSO,0,0,0,0)
C						!YES, BYE BYE TREASURE.
	CALL RSPSUB(642,ODO2)
	CALL NEWSTA(ZGNOM,0,0,0,0)
C						!BYE BYE GNOME.
	CTICK(CEVZGO)=0
C						!CANCEL EXIT.
	F=MOVETO(BKENT,WINNER)
C						!NOW IN BANK ENTRANCE.
	RETURN
C
3200	IF((PRSA.NE.ATTACW).AND.(PRSA.NE.KILLW).AND.
     &	(PRSA.NE.MUNGW)) GO TO 3300
	CALL NEWSTA(ZGNOM,643,0,0,0)
C						!VANISH GNOME.
	CTICK(CEVZGO)=0
C						!CANCEL EXIT.
	RETURN
C
3300	CALL RSPEAK(644)
C						!GNOME IS IMPATIENT.
	RETURN
C
C O35--	EGG
C
4000	IF((PRSA.NE.OPENW).OR.(PRSO.NE.EGG)) GO TO 4500
	IF(.NOT.QOPEN(EGG)) GO TO 4100
C						!OPEN ALREADY?
	CALL RSPEAK(649)
C						!YES.
	RETURN
C
4100	IF(PRSI.NE.0) GO TO 4200
C						!WITH SOMETHING?
	CALL RSPEAK(650)
C						!NO, CANT.
	RETURN
C
4200	IF(PRSI.NE.HANDS) GO TO 4300
C						!WITH HANDS?
	CALL RSPEAK(651)
C						!NOT RECOMMENDED.
	RETURN
C
4300	I=652
C						!MUNG MESSAGE.
	IF((IAND(OFLAG1(PRSI),TOOLBT).NE.0).OR.
     &	(IAND(OFLAG2(PRSI),WEAPBT).NE.0)) GO TO 4600
	I=653
C						!NOVELTY 1.
	IF(IAND(OFLAG2(PRSO),FITEBT).NE.0) I=654
	OFLAG2(PRSO)=IOR(OFLAG2(PRSO),FITEBT)
	CALL RSPSUB(I,ODI2)
	RETURN
C
4500	IF((PRSA.NE.OPENW).AND.(PRSA.NE.MUNGW)) GO TO 4800
	I=655
C						!YOU BLEW IT.
4600	CALL NEWSTA(BEGG,I,OROOM(EGG),OCAN(EGG),OADV(EGG))
	CALL NEWSTA(EGG,0,0,0,0)
C						!VANISH EGG.
	OTVAL(BEGG)=2
C						!BAD EGG HAS VALUE.
	IF(OCAN(CANAR).NE.EGG) GO TO 4700
C						!WAS CANARY INSIDE?
	CALL RSPEAK(ODESCO(BCANA))
C						!YES, DESCRIBE RESULT.
	OTVAL(BCANA)=1
	RETURN
C
4700	CALL NEWSTA(BCANA,0,0,0,0)
C						!NO, VANISH IT.
	RETURN
C
4800	IF((PRSA.NE.DROPW).OR.(HERE.NE.MTREE)) GO TO 10
	CALL NEWSTA(BEGG,658,FORE3,0,0)
C						!DROPPED EGG.
	CALL NEWSTA(EGG,0,0,0,0)
	OTVAL(BEGG)=2
	IF(OCAN(CANAR).NE.EGG) GO TO 4700
	OTVAL(BCANA)=1
C						!BAD CANARY.
	RETURN
C NOBJS, PAGE 5
C
C O36--	CANARIES, GOOD AND BAD
C
5000	IF(PRSA.NE.WINDW) GO TO 10
C						!WIND EM UP?
	IF(PRSO.EQ.CANAR) GO TO 5100
C						!RIGHT ONE?
	CALL RSPEAK(645)
C						!NO, BAD NEWS.
	RETURN
C
5100	IF(.NOT.SINGSF.AND.((HERE.EQ.MTREE).OR.
     &	((HERE.GE.FORE1).AND.(HERE.LT.CLEAR))))
     &	GO TO 5200
	CALL RSPEAK(646)
C						!NO, MEDIOCRE NEWS.
	RETURN
C
5200	SINGSF=.TRUE.
C						!SANG SONG.
	I=HERE
	IF(I.EQ.MTREE) I=FORE3
C						!PLACE BAUBLE.
	CALL NEWSTA(BAUBL,647,I,0,0)
	RETURN
C
C O37--	WHITE CLIFFS
C
6000	IF((PRSA.NE.CLMBW).AND.(PRSA.NE.CLMBUW).AND.
     &	(PRSA.NE.CLMBDW)) GO TO 10
	CALL RSPEAK(648)
C						!OH YEAH?
	RETURN
C
C O38--	WALL
C
7000	IF((IABS(HERE-MLOC).NE.1).OR.(MRHERE(HERE).NE.0).OR.
     &	(PRSA.NE.PUSHW)) GO TO 7100
	CALL RSPEAK(860)
C						!PUSHED MIRROR WALL.
	RETURN
C
7100	IF(IAND(RFLAG(HERE),RNWALL).EQ.0) GO TO 10
	CALL RSPEAK(662)
C						!NO WALL.
	RETURN
C NOBJS, PAGE 6
C
C O39--	SONG BIRD GLOBAL
C
8000	IF(PRSA.NE.FINDW) GO TO 8100
C						!FIND?
	CALL RSPEAK(666)
	RETURN
C
8100	IF(PRSA.NE.EXAMIW) GO TO 10
C						!EXAMINE?
	CALL RSPEAK(667)
	RETURN
C
C O40--	PUZZLE/SCOL WALLS
C
9000	IF(HERE.NE.CPUZZ) GO TO 9500
C						!PUZZLE WALLS?
	IF(PRSA.NE.PUSHW) GO TO 10
C						!PUSH?
	DO 9100 I=1,8,2
C						!LOCATE WALL.
	  IF(PRSO.EQ.CPWL(I)) GO TO 9200
9100	CONTINUE
	CALL BUG(80,PRSO)
C						!WHAT?
C
9200	J=CPWL(I+1)
C						!GET DIRECTIONAL OFFSET.
	NXT=CPHERE+J
C						!GET NEXT STATE.
	WL=CPVEC(NXT)
C						!GET C(NEXT STATE).
	GO TO (9300,9300,9300,9250,9350),(WL+4)
C						!PROCESS.
C
9250	CALL RSPEAK(876)
C						!CLEAR CORRIDOR.
	RETURN
C
9300	IF(CPVEC(NXT+J).EQ.0) GO TO 9400
C						!MOVABLE, ROOM TO MOVE?
9350	CALL RSPEAK(877)
C						!IMMOVABLE, NO ROOM.
	RETURN
C
9400	I=878
C						!ASSUME FIRST PUSH.
	IF(CPUSHF) I=879
C						!NOT?
	CPUSHF=.TRUE.
	CPVEC(NXT+J)=WL
C						!MOVE WALL.
	CPVEC(NXT)=0
C						!VACATE NEXT STATE.
	CALL CPGOTO(NXT)
C						!ONWARD.
	CALL CPINFO(I,NXT)
C						!DESCRIBE.
	CALL PRINCR(.TRUE.,HERE)
C						!PRINT ROOMS CONTENTS.
	RFLAG(HERE)=IOR(RFLAG(HERE),RSEEN)
	RETURN
C
9500	IF(HERE.NE.SCOLAC) GO TO 9700
C						!IN SCOL ACTIVE ROOM?
	DO 9600 I=1,12,3
	  TARGET=SCOLWL(I+1)
C						!ASSUME TARGET.
	  IF(SCOLWL(I).EQ.HERE) GO TO 2100
C						!TREAT IF FOUND.
9600	CONTINUE
C
9700	IF(HERE.NE.BKBOX) GO TO 10
C						!IN BOX ROOM?
	TARGET=WNORT
	GO TO 2100
C NOBJS, PAGE 7
C
C O41--	SHORT POLE
C
10000	IF(PRSA.NE.RAISEW) GO TO 10100
C						!LIFT?
	I=749
C						!ASSUME UP.
	IF(POLEUF.EQ.2) I=750
C						!ALREADY UP?
	CALL RSPEAK(I)
	POLEUF=2
C						!POLE IS RAISED.
	RETURN
C
10100	IF((PRSA.NE.LOWERW).AND.(PRSA.NE.PUSHW)) GO TO 10
	IF(POLEUF.NE.0) GO TO 10200
C						!ALREADY LOWERED?
	CALL RSPEAK(751)
C						!CANT DO IT.
	RETURN
C
10200	IF(MOD(MDIR,180).NE.0) GO TO 10300
C						!MIRROR N-S?
	POLEUF=0
C						!YES, LOWER INTO
	CALL RSPEAK(752)
C						!CHANNEL.
	RETURN
C
10300	IF((MDIR.NE.270).OR.(MLOC.NE.MRB)) GO TO 10400
	POLEUF=0
C						!LOWER INTO HOLE.
	CALL RSPEAK(753)
	RETURN
C
10400	CALL RSPEAK(753+POLEUF)
C						!POLEUF = 1 OR 2.
	POLEUF=1
C						!NOW ON FLOOR.
	RETURN
C
C O42--	MIRROR SWITCH
C
11000	IF(PRSA.NE.PUSHW) GO TO 10
C						!PUSH?
	IF(MRPSHF) GO TO 11300
C						!ALREADY PUSHED?
	CALL RSPEAK(756)
C						!BUTTON GOES IN.
	DO 11100 I=1,OLNT
C						!BLOCKED?
	  IF(QHERE(I,MREYE).AND.(I.NE.RBEAM)) GO TO 11200
11100	CONTINUE
	CALL RSPEAK(757)
C						!NOTHING IN BEAM.
	RETURN
C
11200	CFLAG(CEVMRS)=.TRUE.
C						!MIRROR OPENS.
	CTICK(CEVMRS)=7
	MRPSHF=.TRUE.
	MROPNF=.TRUE.
	RETURN
C
11300	CALL RSPEAK(758)
C						!MIRROR ALREADYOPEN.
	RETURN
C NOBJS, PAGE 8
C
C O43--	BEAM FUNCTION
C
12000	IF((PRSA.NE.TAKEW).OR.(PRSO.NE.RBEAM)) GO TO 12100
	CALL RSPEAK(759)
C						!TAKE BEAM, JOKE.
	RETURN
C
12100	I=PRSO
C						!ASSUME BLK WITH DIROBJ.
	IF((PRSA.EQ.PUTW).AND.(PRSI.EQ.RBEAM)) GO TO 12200
	IF((PRSA.NE.MUNGW).OR.(PRSO.NE.RBEAM).OR.
     &	(PRSI.EQ.0)) GO TO 10
	I=PRSI
12200	IF(OADV(I).NE.WINNER) GO TO 12300
C						!CARRYING?
	CALL NEWSTA(I,0,HERE,0,0)
C						!DROP OBJ.
	CALL RSPSUB(760,ODESC2(I))
	RETURN
C
12300	J=761
C						!ASSUME NOT IN ROOM.
	IF(QHERE(J,HERE)) I=762
C						!IN ROOM?
	CALL RSPSUB(J,ODESC2(I))
C						!DESCRIBE.
	RETURN
C
C O44--	BRONZE DOOR
C
13000	IF((HERE.EQ.NCELL).OR.((LCELL.EQ.4).AND.
     &	((HERE.EQ.CELL).OR.(HERE.EQ.SCORR))))
     &	GO TO 13100
	CALL RSPEAK(763)
C						!DOOR NOT THERE.
	RETURN
C
13100	IF(.NOT.OPNCLS(ODOOR,764,765)) GO TO 10
C						!OPEN/CLOSE?
	IF((HERE.EQ.NCELL).AND.QOPEN(ODOOR))
     &	CALL RSPEAK(766)
	RETURN
C
C O45--	QUIZ DOOR
C
14000	IF((PRSA.NE.OPENW).AND.(PRSA.NE.CLOSEW)) GO TO 14100
	CALL RSPEAK(767)
C						!DOOR WONT MOVE.
	RETURN
C
14100	IF(PRSA.NE.KNOCKW) GO TO 10
C						!KNOCK?
	IF(INQSTF) GO TO 14200
C						!TRIED IT ALREADY?
	INQSTF=.TRUE.
C						!START INQUISITION.
	CFLAG(CEVINQ)=.TRUE.
	CTICK(CEVINQ)=2
	QUESNO=RND(8)
C						!SELECT QUESTION.
	NQATT=0
	CORRCT=0
	CALL RSPEAK(768)
C						!ANNOUNCE RULES.
	CALL RSPEAK(769)
	CALL RSPEAK(770+QUESNO)
C						!ASK QUESTION.
	RETURN
C
14200	CALL RSPEAK(798)
C						!NO REPLY.
	RETURN
C
C O46--	LOCKED DOOR
C
15000	IF(PRSA.NE.OPENW) GO TO 10
C						!OPEN?
	CALL RSPEAK(778)
C						!CANT.
	RETURN
C
C O47--	CELL DOOR
C
16000	NOBJS=OPNCLS(CDOOR,779,780)
C						!OPEN/CLOSE?
	RETURN
C NOBJS, PAGE 9
C
C O48--	DIALBUTTON
C
17000	IF(PRSA.NE.PUSHW) GO TO 10
C						!PUSH?
	CALL RSPEAK(809)
C						!CLICK.
	IF(QOPEN(CDOOR)) CALL RSPEAK(810)
C						!CLOSE CELL DOOR.
C
	DO 17100 I=1,OLNT
C						!RELOCATE OLD TO HYPER.
	  IF((OROOM(I).EQ.CELL).AND.(IAND(OFLAG1(I),DOORBT).EQ.0))
     &	CALL NEWSTA(I,0,LCELL*HFACTR,0,0)
	  IF(OROOM(I).EQ.(PNUMB*HFACTR))
     &	CALL NEWSTA(I,0,CELL,0,0)
17100	CONTINUE
C
	OFLAG2(ODOOR)=IAND(OFLAG2(ODOOR), not(OPENBT))
	OFLAG2(CDOOR)=IAND(OFLAG2(CDOOR), not(OPENBT))
	OFLAG1(ODOOR)=IAND(OFLAG1(ODOOR), not(VISIBT))
	IF(PNUMB.EQ.4) OFLAG1(ODOOR)=IOR(OFLAG1(ODOOR),VISIBT)
C
	IF(AROOM(PLAYER).NE.CELL) GO TO 17400
C						!PLAYER IN CELL?
	IF(LCELL.NE.4) GO TO 17200
C						!IN RIGHT CELL?
	OFLAG1(ODOOR)=IOR(OFLAG1(ODOOR), VISIBT)
	F=MOVETO(NCELL,PLAYER)
C						!YES, MOVETO NCELL.
	GO TO 17400
17200	F=MOVETO(PCELL,PLAYER)
C						!NO, MOVETO PCELL.
C
17400	LCELL=PNUMB
	RETURN
C NOBJS, PAGE 10
C
C O49--	DIAL INDICATOR
C
18000	IF(PRSA.NE.SPINW) GO TO 18100
C						!SPIN?
	PNUMB=RND(8)+1
C						!WHEE
C						!
	CALL RSPSUB(797,712+PNUMB)
	RETURN
C
18100	IF((PRSA.NE.MOVEW).AND.(PRSA.NE.PUTW).AND.
     &	(PRSA.NE.TRNTOW)) GO TO 10
	IF(PRSI.NE.0) GO TO 18200
C						!TURN DIAL TO X?
	CALL RSPEAK(806)
C						!MUST SPECIFY.
	RETURN
C
18200	IF((PRSI.GE.NUM1).AND.(PRSI.LE.NUM8)) GO TO 18300
	CALL RSPEAK(807)
C						!MUST BE DIGIT.
	RETURN
C
18300	PNUMB=PRSI-NUM1+1
C						!SET UP NEW.
	CALL RSPSUB(808,712+PNUMB)
	RETURN
C
C O50--	GLOBAL MIRROR
C
19000	NOBJS=MIRPAN(832,.FALSE.)
	RETURN
C
C O51--	GLOBAL PANEL
C
20000	IF(HERE.NE.FDOOR) GO TO 20100
C						!AT FRONT DOOR?
	IF((PRSA.NE.OPENW).AND.(PRSA.NE.CLOSEW)) GO TO 10
	CALL RSPEAK(843)
C						!PANEL IN DOOR, NOGO.
	RETURN
C
20100	NOBJS=MIRPAN(838,.TRUE.)
	RETURN
C
C O52--	PUZZLE ROOM SLIT
C
21000	IF((PRSA.NE.PUTW).OR.(PRSI.NE.CSLIT)) GO TO 10
	IF(PRSO.NE.GCARD) GO TO 21100
C						!PUT CARD IN SLIT?
	CALL NEWSTA(PRSO,863,0,0,0)
C						!KILL CARD.
	CPOUTF=.TRUE.
C						!OPEN DOOR.
	OFLAG1(STLDR)=IAND(OFLAG1(STLDR),not(VISIBT))
	RETURN
C
21100	IF((IAND(OFLAG1(PRSO),VICTBT).EQ.0).AND.
     &  (IAND(OFLAG2(PRSO),VILLBT).EQ.0)) GO TO 21200
	CALL RSPEAK(RND(5)+552)
C						!JOKE FOR VILL, VICT.
	RETURN
C
21200	CALL NEWSTA(PRSO,0,0,0,0)
C						!KILL OBJECT.
	CALL RSPSUB(864,ODO2)
C						!DESCRIBE.
	RETURN
C
	END
C MIRPAN--	PROCESSOR FOR GLOBAL MIRROR/PANEL
C
C DECLARATIONS
C
	LOGICAL FUNCTION MIRPAN(ST,PNF)
	IMPLICIT INTEGER(A-Z)
	LOGICAL PNF
	include 'gamestat.h'
	include 'parser.h'
	include 'verbs.h'
	include 'flags.h'
C MIRPAN, PAGE 2
C
	MIRPAN=.TRUE.
	NUM=MRHERE(HERE)
C						!GET MIRROR NUM.
	IF(NUM.NE.0) GO TO 100
C						!ANY HERE?
	CALL RSPEAK(ST)
C						!NO, LOSE.
	RETURN
C
100	MRBF=0
C						!ASSUME MIRROR OK.
	IF(((NUM.EQ.1).AND..NOT.MR1F).OR.
     &  ((NUM.EQ.2).AND..NOT.MR2F)) MRBF=1
	IF((PRSA.NE.MOVEW).AND.(PRSA.NE.OPENW)) GO TO 200
	CALL RSPEAK(ST+1)
C						!CANT OPEN OR MOVE.
	RETURN
C
200	IF(PNF.OR.((PRSA.NE.LOOKIW).AND.(PRSA.NE.EXAMIW).AND.
     &	(PRSA.NE.LOOKW))) GO TO 300
	CALL RSPEAK(844+MRBF)
C						!LOOK IN MIRROR.
	RETURN
C
300	IF(PRSA.NE.MUNGW) GO TO 400
C						!BREAK?
	CALL RSPEAK(ST+2+MRBF)
C						!DO IT.
	IF((NUM.EQ.1).AND..NOT.PNF) MR1F=.FALSE.
	IF((NUM.EQ.2).AND..NOT.PNF) MR2F=.FALSE.
	RETURN
C
400	IF(PNF.OR.(MRBF.EQ.0)) GO TO 500
C						!BROKEN MIRROR?
	CALL RSPEAK(846)
	RETURN
C
500	IF(PRSA.NE.PUSHW) GO TO 600
C						!PUSH?
	CALL RSPEAK(ST+3+NUM)
	RETURN
C
600	MIRPAN=.FALSE.
C						!CANT HANDLE IT.
	RETURN
C
	END