zork-fortran/sobjs.for

C SOBJS-	SIMPLE 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 SOBJS(RI,ARG)
	IMPLICIT INTEGER (A-Z)
	LOGICAL QOPEN
	LOGICAL MOVETO,OPNCLS,LIT
	LOGICAL QHERE,F
	include 'parser.h'
	include 'gamestat.h'
	include 'state.h'
	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 SOBJS, PAGE 2
C
	IF(PRSO.GT.220) GO TO 5
	IF(PRSO.NE.0) ODO2=ODESC2(PRSO)
5	IF(PRSI.NE.0) ODI2=ODESC2(PRSI)
	AV=AVEHIC(WINNER)
	SOBJS=.TRUE.
C
	GO TO (1000,3000,4000,6000,7000,8000,9000,
     & 13000,14000,16000,17000,
     & 21000,23000,24000,27000,28000,29000,30000,
     & 31000,33000,34000,36000,37000,38000,
     & 41000,42000,43000,44000,46000,
     & 53000,56000)
     &	RI
	CALL BUG(6,RI)
C
C RETURN HERE TO DECLARE FALSE RESULT
C
10	SOBJS=.FALSE.
	RETURN
C SOBJS, PAGE 3
C
C O1--	GUNK FUNCTION
C
1000	IF(OCAN(GUNK).EQ.0) GO TO 10
C						!NOT INSIDE? F
	CALL NEWSTA(GUNK,122,0,0,0)
C						!FALLS APART.
	RETURN
C
C O2--	TROPHY CASE
C
3000	IF(PRSA.NE.TAKEW) GO TO 10
C						!TAKE?
	CALL RSPEAK(128)
C						!CANT.
	RETURN
C
C O3--	BOTTLE FUNCTION
C
4000	IF(PRSA.NE.THROWW) GO TO 4100
C						!THROW?
	CALL NEWSTA(PRSO,129,0,0,0)
C						!BREAKS.
	RETURN
C
4100	IF(PRSA.NE.MUNGW) GO TO 10
C						!MUNG?
	CALL NEWSTA(PRSO,131,0,0,0)
C						!BREAKS.
	RETURN
C SOBJS, PAGE 4
C
C O4--	ROPE FUNCTION
C
6000	IF(HERE.EQ.DOME) GO TO 6100
C						!IN DOME?
	DOMEF=.FALSE.
C						!NO,
	IF(PRSA.NE.UNTIEW) GO TO 6050
C						!UNTIE?
	CALL RSPEAK(134)
C						!CANT
	RETURN
C
6050	IF(PRSA.NE.TIEW) GO TO 10
C						!TIE?
	CALL RSPEAK(135)
C						!CANT TIE
	RETURN
C
6100	IF((PRSA.NE.TIEW).OR.(PRSI.NE.RAILI)) GO TO 6200
	IF(DOMEF) GO TO 6150
C						!ALREADY TIED?
	DOMEF=.TRUE.
C						!NO, TIE IT.
	OFLAG1(ROPE)=IOR(OFLAG1(ROPE),NDSCBT)
	OFLAG2(ROPE)=IOR(OFLAG2(ROPE),CLMBBT)
	CALL NEWSTA(ROPE,137,DOME,0,0)
	RETURN
C
6150	CALL RSPEAK(136)
C						!DUMMY.
	RETURN
C
6200	IF(PRSA.NE.UNTIEW) GO TO 6300
C						!UNTIE?
	IF(DOMEF) GO TO 6250
C						!TIED?
	CALL RSPEAK(134)
C						!NO, DUMMY.
	RETURN
C
6250	DOMEF=.FALSE.
C						!YES, UNTIE IT.
	OFLAG1(ROPE)=IAND(OFLAG1(ROPE), not(NDSCBT))
	OFLAG2(ROPE)=IAND(OFLAG2(ROPE), not(CLMBBT))
	CALL RSPEAK(139)
	RETURN
C
6300	IF(DOMEF.OR.(PRSA.NE.DROPW)) GO TO 6400
C						!DROP & UNTIED?
	CALL NEWSTA(ROPE,140,MTORC,0,0)
C						!YES, DROP.
	RETURN
C
6400	IF((PRSA.NE.TAKEW).OR. .NOT.DOMEF) GO TO 10
	CALL RSPEAK(141)
C						!TAKE & TIED.
	RETURN
C
C O5--	SWORD FUNCTION
C
7000	IF((PRSA.EQ.TAKEW).AND.(WINNER.EQ.PLAYER))
     &	SWDACT=.TRUE.
	GO TO 10
C
C O6--	LANTERN
C
8000	IF(PRSA.NE.THROWW) GO TO 8100
C						!THROW?
	CALL NEWSTA(LAMP,0,0,0,0)
C						!KILL LAMP,
	CALL NEWSTA(BLAMP,142,HERE,0,0)
C						!REPLACE WITH BROKEN.
	RETURN
C
8100	IF(PRSA.EQ.TRNONW) CFLAG(CEVLNT)=.TRUE.
	IF(PRSA.EQ.TRNOFW) CFLAG(CEVLNT)=.FALSE.
	GO TO 10
C
C O7--	RUG FUNCTION
C
9000	IF(PRSA.NE.RAISEW) GO TO 9100
C						!RAISE?
	CALL RSPEAK(143)
C						!CANT
	RETURN
C
9100	IF(PRSA.NE.TAKEW) GO TO 9200
C						!TAKE?
	CALL RSPEAK(144)
C						!CANT
	RETURN
C
9200	IF(PRSA.NE.MOVEW) GO TO 9300
C						!MOVE?
	CALL RSPEAK(145+ORRUG)
	ORRUG=1
	OFLAG1(DOOR)=IOR(OFLAG1(DOOR),VISIBT)
	RETURN
C
9300	IF((PRSA.NE.LOOKUW).OR.(ORRUG.NE.0).OR.
     &	QOPEN(DOOR)) GO TO 10
	CALL RSPEAK(345)
	RETURN
C SOBJS, PAGE 5
C
C O8--	SKELETON
C
13000	I=ROBRM(HERE,100,LLD2,0,0)+ROBADV(WINNER,LLD2,0,0)
	IF(I.NE.0) CALL RSPEAK(162)
C						!IF ROBBED, SAY SO.
	RETURN
C
C O9--	MIRROR
C
14000	IF(MIRRMF.OR.(PRSA.NE.RUBW)) GO TO 14500
	MROOM=IEOR(HERE,1)
	DO 14100 I=1,OLNT
C						!INTERCHANGE OBJS.
	  IF(OROOM(I).EQ.HERE) OROOM(I)=-1
	  IF(OROOM(I).EQ.MROOM) OROOM(I)=HERE
	  IF(OROOM(I).EQ.-1) OROOM(I)=MROOM
14100	CONTINUE
	F=MOVETO(MROOM,WINNER)
	CALL RSPEAK(163)
C						!SHAKE WORLD.
	RETURN
C
14500	IF((PRSA.NE.LOOKW).AND.(PRSA.NE.LOOKIW).AND.
     &	(PRSA.NE.EXAMIW)) GO TO 14600
	I=164
C						!MIRROR OK.
	IF(MIRRMF) I=165
C						!MIRROR DEAD.
	CALL RSPEAK(I)
	RETURN
C
14600	IF(PRSA.NE.TAKEW) GO TO 14700
C						!TAKE?
	CALL RSPEAK(166)
C						!JOKE.
	RETURN
C
14700	IF((PRSA.NE.MUNGW).AND.(PRSA.NE.THROWW)) GO TO 10
	I=167
C						!MIRROR BREAKS.
	IF(MIRRMF) I=168
C						!MIRROR ALREADY BROKEN.
	MIRRMF=.TRUE.
	BADLKF=.TRUE.
	CALL RSPEAK(I)
	RETURN
C SOBJS, PAGE 6
C
C O10--	DUMBWAITER
C
16000	IF(PRSA.NE.RAISEW) GO TO 16100
C						!RAISE?
	IF(CAGETF) GO TO 16400
C						!ALREADY AT TOP?
	CALL NEWSTA(TBASK,175,TSHAF,0,0)
C						!NO, RAISE BASKET.
	CALL NEWSTA(FBASK,0,BSHAF,0,0)
	CAGETF=.TRUE.
C						!AT TOP.
	RETURN
C
16100	IF(PRSA.NE.LOWERW) GO TO 16200
C						!LOWER?
	IF(.NOT.CAGETF) GO TO 16400
C						!ALREADY AT BOTTOM?
	CALL NEWSTA(TBASK,176,BSHAF,0,0)
C						!NO, LOWER BASKET.
	CALL NEWSTA(FBASK,0,TSHAF,0,0)
	CAGETF=.FALSE.
	IF(.NOT.LIT(HERE)) CALL RSPEAK(406)
C						!IF DARK, DIE.
	RETURN
C
16200	IF((PRSO.NE.FBASK).AND.(PRSI.NE.FBASK)) GO TO 16300
	CALL RSPEAK(130)
C						!WRONG BASKET.
	RETURN
C
16300	IF(PRSA.NE.TAKEW) GO TO 10
C						!TAKE?
	CALL RSPEAK(177)
C						!JOKE.
	RETURN
C
16400	CALL RSPEAK(125+RND(3))
C						!DUMMY.
	RETURN
C
C O11--	GHOST FUNCTION
C
17000	I=178
C						!ASSUME DIRECT.
	IF(PRSO.NE.GHOST) I=179
C						!IF NOT, INDIRECT.
	CALL RSPEAK(I)
	RETURN
C						!SPEAK AND EXIT.
C SOBJS, PAGE 7
C
C O12--	TUBE
C
21000	IF((PRSA.NE.PUTW).OR.(PRSI.NE.TUBE)) GO TO 10
	CALL RSPEAK(186)
C						!CANT PUT BACK IN.
	RETURN
C
C O13--	CHALICE
C
23000	IF((PRSA.NE.TAKEW).OR.(OCAN(PRSO).NE.0).OR.
     &	(OROOM(PRSO).NE.TREAS).OR.(OROOM(THIEF).NE.TREAS).OR.
     &	(IAND(OFLAG2(THIEF),FITEBT).EQ.0).OR.
     &	.NOT. THFACT) GO TO 10
	CALL RSPEAK(204)
C						!CANT TAKE.
	RETURN
C
C O14--	PAINTING
C
24000	IF(PRSA.NE.MUNGW) GO TO 10
C						!MUNG?
	CALL RSPEAK(205)
C						!DESTROY PAINTING.
	OFVAL(PRSO)=0
	OTVAL(PRSO)=0
	ODESC1(PRSO)=207
	ODESC2(PRSO)=206
	RETURN
C SOBJS, PAGE 8
C
C O15--	BOLT
C
27000	IF(PRSA.NE.TURNW) GO TO 10
C						!TURN BOLT?
	IF(PRSI.NE.WRENC) GO TO 27500
C						!WITH WRENCH?
	IF(GATEF) GO TO 27100
C						!PROPER BUTTON PUSHED?
	CALL RSPEAK(210)
C						!NO, LOSE.
	RETURN
C
27100	IF(LWTIDF) GO TO 27200
C						!LOW TIDE NOW?
	LWTIDF=.TRUE.
C						!NO, EMPTY DAM.
	CALL RSPEAK(211)
	OFLAG2(COFFI)=IAND(OFLAG2(COFFI), not(SCRDBT))
	OFLAG1(TRUNK)=IOR(OFLAG1(TRUNK),VISIBT)
	RFLAG(RESER)=IAND(IOR(RFLAG(RESER),RLAND)
     &	,not(RWATER+RSEEN))
	RETURN
C
27200	LWTIDF=.FALSE.
C						!YES, FILL DAM.
	CALL RSPEAK(212)
	IF(QHERE(TRUNK,RESER))
     &	OFLAG1(TRUNK)=IAND(OFLAG1(TRUNK), not(VISIBT))
	RFLAG(RESER)=IAND(IOR(RFLAG(RESER),RWATER) ,not(RLAND))
	RETURN
C
27500	CALL RSPSUB(299,ODI2)
C						!NOT WITH THAT.
	RETURN
C
C O16--	GRATING
C
28000	IF((PRSA.NE.OPENW).AND.(PRSA.NE.CLOSEW)) GO TO 10
	IF(GRUNLF) GO TO 28200
C						!UNLOCKED?
	CALL RSPEAK(214)
C						!NO, LOCKED.
	RETURN
C
28200	I=215
C						!UNLOCKED, VIEW FRM CLR.
	IF(HERE.NE.CLEAR) I=216
C						!VIEW FROM BELOW.
	SOBJS=OPNCLS(GRATE,I,885)
C						!OPEN/CLOSE.
	RFLAG(MGRAT)=IAND(RFLAG(MGRAT), not(RLIGHT))
	IF(QOPEN(GRATE)) RFLAG(MGRAT)=IOR(RFLAG(MGRAT),RLIGHT)
	IF(.NOT.LIT(HERE)) CALL RSPEAK(406)
C						!IF DARK, DIE.
	RETURN
C
C O17--	TRAP DOOR
C
29000	IF(HERE.NE.LROOM) GO TO 29100
C						!FROM LIVING ROOM?
	SOBJS=OPNCLS(DOOR,218,219)
C						!OPEN/CLOSE.
	RETURN
C
29100	IF(HERE.NE.CELLA) GO TO 10
C						!FROM CELLAR?
	IF((PRSA.NE.OPENW).OR.QOPEN(DOOR)) GO TO 29200
	CALL RSPEAK(220)
C						!CANT OPEN CLOSED DOOR.
	RETURN
C
29200	SOBJS=OPNCLS(DOOR,0,22)
C						!NORMAL OPEN/CLOSE.
	RETURN
C
C O18--	DURABLE DOOR
C
30000	I=0
C						!ASSUME NO APPL.
	IF(PRSA.EQ.OPENW) I=221
C						!OPEN?
	IF(PRSA.EQ.BURNW) I=222
C						!BURN?
	IF(PRSA.EQ.MUNGW) I=223+RND(3)
C						!MUNG?
	IF(I.EQ.0) GO TO 10
	CALL RSPEAK(I)
	RETURN
C
C O19--	MASTER SWITCH
C
31000	IF(PRSA.NE.TURNW) GO TO 10
C						!TURN?
	IF(PRSI.NE.SCREW) GO TO 31500
C						!WITH SCREWDRIVER?
	IF(QOPEN(MACHI)) GO TO 31600
C						!LID UP?
	CALL RSPEAK(226)
C						!NO, ACTIVATE.
	IF(OCAN(COAL).NE.MACHI) GO TO 31400
C						!COAL INSIDE?
	CALL NEWSTA(COAL,0,0,0,0)
C						!KILL COAL,
	CALL NEWSTA(DIAMO,0,0,MACHI,0)
C						!REPLACE WITH DIAMOND.
	RETURN
C
31400	DO 31450 I=1,OLNT
C						!KILL NONCOAL OBJECTS.
	  IF(OCAN(I).NE.MACHI) GO TO 31450
C						!INSIDE MACHINE?
	  CALL NEWSTA(I,0,0,0,0)
C						!KILL OBJECT AND CONTENTS.
	  CALL NEWSTA(GUNK,0,0,MACHI,0)
C						!REDUCE TO GUNK.
31450	CONTINUE
	RETURN
C
31500	CALL RSPSUB(300,ODI2)
C						!CANT TURN WITH THAT.
	RETURN
C
31600	CALL RSPEAK(227)
C						!LID IS UP.
	RETURN
C SOBJS, PAGE 9
C
C O20--	LEAK
C
33000	IF((PRSO.NE.LEAK).OR.(PRSA.NE.PLUGW).OR.(RVMNT.LE.0))
     &	GO TO 10
	IF(PRSI.NE.PUTTY) GO TO 33100
C						!WITH PUTTY?
	RVMNT=-1
C						!DISABLE LEAK.
	CTICK(CEVMNT)=0
	CALL RSPEAK(577)
	RETURN
C
33100	CALL RSPSUB(301,ODI2)
C						!CANT WITH THAT.
	RETURN
C
C O21--	DROWNING BUTTONS
C
34000	IF(PRSA.NE.PUSHW) GO TO 10
C						!PUSH?
	GO TO (34100,34200,34300,34400),(PRSO-RBUTT+1)
	GO TO 10
C						!NOT A BUTTON.
C
34100	RFLAG(HERE)=IEOR(RFLAG(HERE),RLIGHT)
	I=230
	IF(IAND(RFLAG(HERE),RLIGHT).NE.0) I=231
	CALL RSPEAK(I)
	RETURN
C
34200	GATEF=.TRUE.
C						!RELEASE GATE.
	CALL RSPEAK(232)
	RETURN
C
34300	GATEF=.FALSE.
C						!INTERLOCK GATE.
	CALL RSPEAK(232)
	RETURN
C
34400	IF(RVMNT.NE.0) GO TO 34500
C						!LEAK ALREADY STARTED?
	CALL RSPEAK(233)
C						!NO, START LEAK.
	RVMNT=1
	CTICK(CEVMNT)=-1
	RETURN
C
34500	CALL RSPEAK(234)
C						!BUTTON JAMMED.
	RETURN
C
C O22--	INFLATABLE BOAT
C
36000	IF(PRSA.NE.INFLAW) GO TO 10
C						!INFLATE?
	IF(OROOM(IBOAT).NE.0) GO TO 36100
C						!IN ROOM?
	CALL RSPEAK(235)
C						!NO, JOKE.
	RETURN
C
36100	IF(PRSI.NE.PUMP) GO TO 36200
C						!WITH PUMP?
	CALL NEWSTA(IBOAT,0,0,0,0)
C						!KILL DEFL BOAT,
	CALL NEWSTA(RBOAT,236,HERE,0,0)
C						!REPL WITH INF.
	DEFLAF=.FALSE.
	RETURN
C
36200	I=237
C						!JOKES.
	IF(PRSI.NE.LUNGS) I=303
	CALL RSPSUB(I,ODI2)
	RETURN
C
C O23--	DEFLATED BOAT
C
37000	IF(PRSA.NE.INFLAW) GO TO 37100
C						!INFLATE?
	CALL RSPEAK(238)
C						!JOKE.
	RETURN
C
37100	IF(PRSA.NE.PLUGW) GO TO 10
C						!PLUG?
	IF(PRSI.NE.PUTTY) GO TO 33100
C						!WITH PUTTY?
	CALL NEWSTA(IBOAT,239,OROOM(DBOAT),OCAN(DBOAT),OADV(DBOAT))
	CALL NEWSTA(DBOAT,0,0,0,0)
C						!KILL DEFL BOAT, REPL.
	RETURN
C SOBJS, PAGE 10
C
C O24--	RUBBER BOAT
C
38000	IF(ARG.NE.0) GO TO 10
C						!DISMISS READIN, OUT.
	IF((PRSA.NE.BOARDW).OR.(OADV(STICK).NE.WINNER)) GO TO 38100
	CALL NEWSTA(RBOAT,0,0,0,0)
C						!KILL INFL BOAT,
	CALL NEWSTA(DBOAT,240,HERE,0,0)
C						!REPL WITH DEAD.
	DEFLAF=.TRUE.
	RETURN
C
38100	IF(PRSA.NE.INFLAW) GO TO 38200
C						!INFLATE?
	CALL RSPEAK(367)
C						!YES, JOKE.
	RETURN
C
38200	IF(PRSA.NE.DEFLAW) GO TO 10
C						!DEFLATE?
	IF(AV.EQ.RBOAT) GO TO 38300
C						!IN BOAT?
	IF(OROOM(RBOAT).EQ.0) GO TO 38400
C						!ON GROUND?
	CALL NEWSTA(RBOAT,0,0,0,0)
C						!KILL INFL BOAT,
	CALL NEWSTA(IBOAT,241,HERE,0,0)
C						!REPL WITH DEFL.
	DEFLAF=.TRUE.
	RETURN
C
38300	CALL RSPEAK(242)
C						!IN BOAT.
	RETURN
C
38400	CALL RSPEAK(243)
C						!NOT ON GROUND.
	RETURN
C
C O25--	BRAIDED ROPE
C
41000	IF((PRSA.NE.TIEW).OR.(PRSO.NE.BROPE).OR.
     &	((PRSI.NE.HOOK1).AND.(PRSI.NE.HOOK2)))
     &	GO TO 41500
	BTIEF=PRSI
C						!RECORD LOCATION.
	CFLAG(CEVBAL)=.FALSE.
C						!STALL ASCENT.
	CALL RSPEAK(248)
	RETURN
C
41500	IF((PRSA.NE.UNTIEW).OR.(PRSO.NE.BROPE)) GO TO 10
	IF(BTIEF.NE.0) GO TO 41600
C						!TIED UP?
	CALL RSPEAK(249)
C						!NO, JOKE.
	RETURN
C
41600	CALL RSPEAK(250)
	BTIEF=0
C						!UNTIE.
	CTICK(CEVBAL)=3
C						!RESTART CLOCK.
	CFLAG(CEVBAL)=.TRUE.
	RETURN
C
C O26--	SAFE
C
42000	I=0
C						!ASSUME UNPROCESSED.
	IF(PRSA.EQ.TAKEW) I=251
C						!TAKE?
	IF((PRSA.EQ.OPENW).AND.SAFEF) I=253
C						!OPEN AFTER BLAST?
	IF((PRSA.EQ.OPENW).AND..NOT.SAFEF) I=254
C						!OPEN BEFORE BLAST?
	IF((PRSA.EQ.CLOSEW).AND.SAFEF) I=253
C						!CLOSE AFTER?
	IF((PRSA.EQ.CLOSEW).AND..NOT.SAFEF) I=255
	IF(I.EQ.0) GO TO 10
	CALL RSPEAK(I)
	RETURN
C
C O27--	FUSE
C
43000	IF(PRSA.NE.BURNW) GO TO 10
C						!BURN?
	CALL RSPEAK(256)
	CTICK(CEVFUS)=2
C						!START COUNTDOWN.
	RETURN
C
C O28--	GNOME
C
44000	IF((PRSA.NE.GIVEW).AND.(PRSA.NE.THROWW)) GO TO 44500
	IF(OTVAL(PRSO).EQ.0) GO TO 44100
C						!TREASURE?
	CALL RSPSUB(257,ODO2)
C						!YES, GET DOOR.
	CALL NEWSTA(PRSO,0,0,0,0)
	CALL NEWSTA(GNOME,0,0,0,0)
C						!VANISH GNOME.
	GNODRF=.TRUE.
	RETURN
C
44100	CALL RSPSUB(258,ODO2)
C						!NO, LOSE OBJECT.
	CALL NEWSTA(PRSO,0,0,0,0)
	RETURN
C
44500	CALL RSPEAK(259)
C						!NERVOUS GNOME.
	IF(.NOT.GNOMEF) CTICK(CEVGNO)=5
C						!SCHEDULE BYEBYE.
	GNOMEF=.TRUE.
	RETURN
C
C O29--	COKE BOTTLES
C
46000	IF((PRSA.NE.THROWW).AND.(PRSA.NE.MUNGW)) GO TO 10
	CALL NEWSTA(PRSO,262,0,0,0)
C						!MUNG BOTTLES.
	RETURN
C SOBJS, PAGE 11
C
C
C O30--	ROBOT
C
53000	IF(PRSA.NE.GIVEW) GO TO 53200
C						!GIVE?
	CALL NEWSTA(PRSO,0,0,0,AROBOT)
C						!PUT ON ROBOT.
	CALL RSPSUB(302,ODO2)
	RETURN
C
53200	IF((PRSA.NE.MUNGW).AND.(PRSA.NE.THROWW)) GO TO 10
	CALL NEWSTA(ROBOT,285,0,0,0)
C						!KILL ROBOT.
	RETURN
C
C O31--	GRUE
C
56000	IF(PRSA.NE.EXAMIW) GO TO 56100
C						!EXAMINE?
	CALL RSPEAK(288)
	RETURN
C
56100	IF(PRSA.NE.FINDW) GO TO 10
C						!FIND?
	CALL RSPEAK(289)
	RETURN
C
	END