projects / unix-history / blob
? search:
summary | tags | clone url | shortlog | log | commit | commitdiff | tree
blame | history | raw | HEAD
date and time created 88/12/14 15:30:08 by sklower
[unix-history] / usr / src / contrib / dungeon / sobjs.F
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
Continuous source code history from original PDP-7 UNIX to FreeBSD 2, the first fully unencumbered FreeBSD release.