xref: /csrg-svn/contrib/dungeon/sobjs.F (revision 35973)

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 "gamestate.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)=and(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)=or(OFLAG1(ROPE),NDSCBT)
	OFLAG2(ROPE)=or(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)=and(OFLAG1(ROPE), not(NDSCBT))
	OFLAG2(ROPE)=and(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)=or(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=xor(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.
&		(and(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)=and(OFLAG2(COFFI), not(SCRDBT))
	OFLAG1(TRUNK)=or(OFLAG1(TRUNK),VISIBT)
	RFLAG(RESER)=and(or(RFLAG(RESER),RLAND)
&		,not(RWATER+RSEEN))
	RETURN
C
27200	LWTIDF=.FALSE.
C						!YES, FILL DAM.
	CALL RSPEAK(212)
	IF(QHERE(TRUNK,RESER))
&		OFLAG1(TRUNK)=and(OFLAG1(TRUNK), not(VISIBT))
	RFLAG(RESER)=and(or(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)=and(RFLAG(MGRAT), not(RLIGHT))
	IF(QOPEN(GRATE)) RFLAG(MGRAT)=or(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)=xor(RFLAG(HERE),RLIGHT)
	I=230
	IF(and(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