projects / unix-history / blob
? search:
summary | tags | clone url | shortlog | log | commit | commitdiff | tree
blame | history | raw | HEAD
date and time created 90/10/11 11:35:49 by bostic
[unix-history] / usr / src / contrib / dungeon / nobjs.F
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 "gamestate.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)=and(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((and(OFLAG1(PRSI),TOOLBT).NE.0).OR.
& (and(OFLAG2(PRSI),WEAPBT).NE.0)) GO TO 4600
I=653
C !NOVELTY 1.
IF(and(OFLAG2(PRSO),FITEBT).NE.0) I=654
OFLAG2(PRSO)=or(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(and(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)=or(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.(and(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)=and(OFLAG2(ODOOR), not(OPENBT))
OFLAG2(CDOOR)=and(OFLAG2(CDOOR), not(OPENBT))
OFLAG1(ODOOR)=and(OFLAG1(ODOOR), not(VISIBT))
IF(PNUMB.EQ.4) OFLAG1(ODOOR)=or(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)=or(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)=and(OFLAG1(STLDR),not(VISIBT))
RETURN
C
21100 IF((and(OFLAG1(PRSO),VICTBT).EQ.0).AND.
& (and(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 "gamestate.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
Continuous source code history from original PDP-7 UNIX to FreeBSD 2, the first fully unencumbered FreeBSD release.