games-request@tekred.UUCP (09/01/87)
Submitted by: Bill Randle <games-request@tekred.TEK.COM>
Comp.sources.games: Volume 2, Issue 37
Archive-name: dungeon/Part04
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of archive 4 (of 7)."
# Contents: clock.h dverb2.F gdt.F lex.c nobjs.F sverbs.F
# Wrapped by billr@tekred on Tue Apr 21 10:24:29 1987
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f clock.h -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"clock.h\"
else
echo shar: Extracting \"clock.h\" \(339 characters\)
sed "s/^X//" >clock.h <<'END_OF_clock.h'
XC
XC CLOCK INTERRUPTS
XC
X LOGICAL CFLAG
X COMMON /CEVENT/ CLNT,CTICK(25),CACTIO(25),CFLAG(25)
XC
X COMMON /CINDEX/ CEVCUR,CEVMNT,CEVLNT,CEVMAT,CEVCND,
X& CEVBAL,CEVBRN,CEVFUS,CEVLED,CEVSAF,CEVVLG,
X& CEVGNO,CEVBUC,CEVSPH,CEVEGH,
X& CEVFOR,CEVSCL,CEVZGI,CEVZGO,CEVSTE,
X& CEVMRS,CEVPIN,CEVINQ,CEVFOL
X INTEGER EQC(25,2)
X EQUIVALENCE (CTICK, EQC)
END_OF_clock.h
if test 339 -ne `wc -c <clock.h`; then
echo shar: \"clock.h\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f dverb2.F -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"dverb2.F\"
else
echo shar: Extracting \"dverb2.F\" \(10970 characters\)
sed "s/^X//" >dverb2.F <<'END_OF_dverb2.F'
XC SAVE- SAVE GAME STATE
XC
XC COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
XC ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
XC WRITTEN BY R. M. SUPNIK
XC
XC DECLARATIONS
XC
X SUBROUTINE SAVEGM
X IMPLICIT INTEGER (A-Z)
X#include "parser.h"
X#include "gamestate.h"
X#include "state.h"
X#include "screen.h"
X#include "puzzle.h"
X#include "rooms.h"
X#include "exits.h"
X#include "objects.h"
X#include "clock.h"
X#include "villians.h"
X#include "advers.h"
X#include "flags.h"
XC
XC MISCELLANEOUS VARIABLES
XC
X COMMON /VERS/ VMAJ,VMIN,VEDIT
X COMMON /TIME/ PLTIME,SHOUR,SMIN,SSEC
XC
X PRSWON=.FALSE.
XC !DISABLE GAME.
XC Note: save file format is different for PDP vs. non-PDP versions
XC
X#ifdef PDP
XC
XC send restore data flag down pipe
XC
X call outstr(stchr,1)
X
XC write out necessary common blocks
XC
XC /play/
X call arywt(4,winner)
XC
XC /state/
X call arywt(11,moves)
XC
XC /screen/
X call arywt(3,formdr)
XC
XC /puzzle/
X call arywt(64,cpvec)
XC
XC /vers/
X call arywt(3,vmaj)
XC
XC /rooms/
X call arywt(400,rval)
XC
XC /objects/
X call arywt(2860,odesc1)
XC
XC /cevent/
X call arywt(100,ctick)
XC
XC /hack/
X call arywt(8,thfpos)
XC
XC /vill/
X call arywt(4,vprob)
XC
XC /advs/
X call arywt(28,aroom)
XC
XC /findex/
X call arywt(114,flags)
XC
XC send end of data flag down pipe
XC
X call outstr(endchr,1)
X CALL RSPEAK(597)
X RETURN
X#else
X OPEN (UNIT=1,file='dsave.dat',ACCESS='SEQUENTIAL',
X& status='UNKNOWN',FORM='UNFORMATTED',ERR=100)
XC
X CALL GTTIME(I)
XC !GET TIME.
X WRITE(1) VMAJ,VMIN,VEDIT
X WRITE(1) WINNER,HERE,THFPOS,TELFLG,THFFLG,THFACT,
X& SWDACT,SWDSTA,CPVEC
X WRITE(1) I,MOVES,DEATHS,RWSCOR,EGSCOR,MXLOAD,
X& LTSHFT,BLOC,MUNGRM,HS,FROMDR,SCOLRM,SCOLAC
X WRITE(1) ODESC1,ODESC2,OFLAG1,OFLAG2,OFVAL,OTVAL,
X& OSIZE,OCAPAC,OROOM,OADV,OCAN
X WRITE(1) RVAL,RFLAG
X WRITE(1) AROOM,ASCORE,AVEHIC,ASTREN,AFLAG
X WRITE(1) FLAGS,SWITCH,VPROB,CFLAG,CTICK
XC
X CLOSE(UNIT=1)
X CALL RSPEAK(597)
X RETURN
XC
X100 CALL RSPEAK(598)
XC !CANT DO IT.
X RETURN
X#endif PDP
X END
XC RESTORE- RESTORE GAME STATE
XC
XC DECLARATIONS
XC
X SUBROUTINE RSTRGM
X IMPLICIT INTEGER (A-Z)
X#include "parser.h"
X#include "gamestate.h"
X#include "state.h"
X#include "screen.h"
X#include "puzzle.h"
X#include "rooms.h"
X#include "exits.h"
X#include "objects.h"
X#include "clock.h"
X#include "villians.h"
X#include "advers.h"
X#include "flags.h"
XC
XC MISCELLANEOUS VARIABLES
XC
X COMMON /VERS/ VMAJ,VMIN,VEDIT
X COMMON /TIME/ PLTIME,SHOUR,SMIN,SSEC
XC
X PRSWON=.FALSE.
XC !DISABLE GAME.
XC Note: save file format is different for PDP vs. non-PDP versions
XC
X#ifdef PDP
XC
XC read in necessary common blocks
XC
XC /play/
X call aryrd(4,winner)
XC
XC /state/
X call aryrd(11,moves)
XC
XC /screen/
X call aryrd(3,formdr)
XC
XC /puzzle/
X call aryrd(64,cpvec)
XC
XC /vers/
X call intrd(i)
X call intrd(j)
X call intrd(k)
XC
XC /rooms/
X call aryrd(400,rval)
XC
XC /objects/
X call aryrd(2860,odesc1)
XC
XC /cevent/
X call aryrd(100,ctick)
XC
XC /hack/
X call aryrd(8,thfpos)
XC
XC /vill/
X call aryrd(4,vprob)
XC
XC /advs/
X call aryrd(28,aroom)
XC
XC /findex/
X call aryrd(114,flags)
XC
X
XC
X IF(or((I.NE.VMAJ),(J.NE.VMIN))) GO TO 200
X CALL RSPEAK(599)
X RETURN
XC
X200 CALL RSPEAK(600)
XC !OBSOLETE VERSION
X RETURN
X#else
X OPEN (UNIT=1,file='dsave.dat',ACCESS='SEQUENTIAL',
X& status='OLD',FORM='UNFORMATTED',ERR=100)
XC
X READ(1) I,J,K
X IF(or((I.NE.VMAJ),(J.NE.VMIN))) GO TO 200
XC
X READ(1) WINNER,HERE,THFPOS,TELFLG,THFFLG,THFACT,
X& SWDACT,SWDSTA,CPVEC
X READ(1) PLTIME,MOVES,DEATHS,RWSCOR,EGSCOR,MXLOAD,
X& LTSHFT,BLOC,MUNGRM,HS,FROMDR,SCOLRM,SCOLAC
X READ(1) ODESC1,ODESC2,OFLAG1,OFLAG2,OFVAL,OTVAL,
X& OSIZE,OCAPAC,OROOM,OADV,OCAN
X READ(1) RVAL,RFLAG
X READ(1) AROOM,ASCORE,AVEHIC,ASTREN,AFLAG
X READ(1) FLAGS,SWITCH,VPROB,CFLAG,CTICK
XC
X CLOSE(UNIT=1)
X CALL RSPEAK(599)
X RETURN
XC
X100 CALL RSPEAK(598)
XC !CANT DO IT.
X RETURN
XC
X200 CALL RSPEAK(600)
XC !OBSOLETE VERSION
X CLOSE (UNIT=1)
X RETURN
X#endif PDP
X END
XC WALK- MOVE IN SPECIFIED DIRECTION
XC
XC DECLARATIONS
XC
X LOGICAL FUNCTION WALK(X)
X IMPLICIT INTEGER(A-Z)
X LOGICAL FINDXT,QOPEN,LIT,PROB,MOVETO,RMDESC
X#include "parser.h"
X#include "gamestate.h"
X#include "rooms.h"
X#include "rflag.h"
X#include "curxt.h"
X#include "xsrch.h"
X#include "objects.h"
X#include "oflags.h"
X#include "clock.h"
X
X#include "villians.h"
X#include "advers.h"
X#include "flags.h"
XC
XC FUNCTIONS AND DATA
XC
X QOPEN(O)=and(OFLAG2(O),OPENBT).NE.0
XC WALK, PAGE 2
XC
X WALK=.TRUE.
XC !ASSUME WINS.
X IF((WINNER.NE.PLAYER).OR.LIT(HERE).OR.PROB(25,25))
X& GO TO 500
X IF(.NOT.FINDXT(PRSO,HERE)) GO TO 450
XC !INVALID EXIT? GRUE
XC !
X GO TO (400,200,100,300),XTYPE
XC !DECODE EXIT TYPE.
X CALL BUG(9,XTYPE)
XC
X100 IF(CXAPPL(XACTIO).NE.0) GO TO 400
XC !CEXIT... RETURNED ROOM?
X IF(FLAGS(XFLAG)) GO TO 400
XC !NO, FLAG ON?
X200 CALL JIGSUP(523)
XC !BAD EXIT, GRUE
XC !
X RETURN
XC
X300 IF(CXAPPL(XACTIO).NE.0) GO TO 400
XC !DOOR... RETURNED ROOM?
X IF(QOPEN(XOBJ)) GO TO 400
XC !NO, DOOR OPEN?
X CALL JIGSUP(523)
XC !BAD EXIT, GRUE
XC !
X RETURN
XC
X400 IF(LIT(XROOM1)) GO TO 900
XC !VALID ROOM, IS IT LIT?
X450 CALL JIGSUP(522)
XC !NO, GRUE
XC !
X RETURN
XC
XC ROOM IS LIT, OR WINNER IS NOT PLAYER (NO GRUE).
XC
X500 IF(FINDXT(PRSO,HERE)) GO TO 550
XC !EXIT EXIST?
X525 XSTRNG=678
XC !ASSUME WALL.
X IF(PRSO.EQ.XUP) XSTRNG=679
XC !IF UP, CANT.
X IF(PRSO.EQ.XDOWN) XSTRNG=680
XC !IF DOWN, CANT.
X IF(and(RFLAG(HERE),RNWALL).NE.0) XSTRNG=524
X CALL RSPEAK(XSTRNG)
X PRSCON=1
XC !STOP CMD STREAM.
X RETURN
XC
X550 GO TO (900,600,700,800),XTYPE
XC !BRANCH ON EXIT TYPE.
X CALL BUG(9,XTYPE)
XC
X700 IF(CXAPPL(XACTIO).NE.0) GO TO 900
XC !CEXIT... RETURNED ROOM?
X IF(FLAGS(XFLAG)) GO TO 900
XC !NO, FLAG ON?
X600 IF(XSTRNG.EQ.0) GO TO 525
XC !IF NO REASON, USE STD.
X CALL RSPEAK(XSTRNG)
XC !DENY EXIT.
X PRSCON=1
XC !STOP CMD STREAM.
X RETURN
XC
X800 IF(CXAPPL(XACTIO).NE.0) GO TO 900
XC !DOOR... RETURNED ROOM?
X IF(QOPEN(XOBJ)) GO TO 900
XC !NO, DOOR OPEN?
X IF(XSTRNG.EQ.0) XSTRNG=525
XC !IF NO REASON, USE STD.
X CALL RSPSUB(XSTRNG,ODESC2(XOBJ))
X PRSCON=1
XC !STOP CMD STREAM.
X RETURN
XC
X900 WALK=MOVETO(XROOM1,WINNER)
XC !MOVE TO ROOM.
X IF(WALK) WALK=RMDESC(0)
XC !DESCRIBE ROOM.
X RETURN
X END
XC CXAPPL- CONDITIONAL EXIT PROCESSORS
XC
XC DECLARATIONS
XC
X INTEGER FUNCTION CXAPPL(RI)
X IMPLICIT INTEGER (A-Z)
X#include "gamestate.h"
X#include "parser.h"
X#include "puzzle.h"
X#include "rooms.h"
X#include "rindex.h"
X#include "exits.h"
X#include "curxt.h"
X#include "xpars.h"
X#include "xsrch.h"
X#include "objects.h"
X#include "oflags.h"
X#include "oindex.h"
X#include "advers.h"
X#include "flags.h"
XC CXAPPL, PAGE 2
XC
X CXAPPL=0
XC !NO RETURN.
X IF(RI.EQ.0) RETURN
XC !IF NO ACTION, DONE.
X GO TO (1000,2000,3000,4000,5000,6000,7000,
X& 8000,9000,10000,11000,12000,13000,14000),RI
X CALL BUG(5,RI)
XC
XC C1- COFFIN-CURE
XC
X1000 EGYPTF=OADV(COFFI).NE.WINNER
XC !T IF NO COFFIN.
X RETURN
XC
XC C2- CAROUSEL EXIT
XC C5- CAROUSEL OUT
XC
X2000 IF(CAROFF) RETURN
XC !IF FLIPPED, NOTHING.
X2500 CALL RSPEAK(121)
XC !SPIN THE COMPASS.
X5000 I=XELNT(XCOND)*RND(8)
XC !CHOOSE RANDOM EXIT.
X XROOM1=and(TRAVEL(REXIT(HERE)+I),XRMASK)
X CXAPPL=XROOM1
XC !RETURN EXIT.
X RETURN
XC
XC C3- CHIMNEY FUNCTION
XC
X3000 LITLDF=.FALSE.
XC !ASSUME HEAVY LOAD.
X J=0
X DO 3100 I=1,OLNT
XC !COUNT OBJECTS.
X IF(OADV(I).EQ.WINNER) J=J+1
X3100 CONTINUE
XC
X IF(J.GT.2) RETURN
XC !CARRYING TOO MUCH?
X XSTRNG=446
XC !ASSUME NO LAMP.
X IF(OADV(LAMP).NE.WINNER) RETURN
XC !NO LAMP?
X LITLDF=.TRUE.
XC !HE CAN DO IT.
X IF(and(OFLAG2(DOOR),OPENBT).EQ.0)
X& OFLAG2(DOOR)=and(OFLAG2(DOOR), not(TCHBT))
X RETURN
XC
XC C4- FROBOZZ FLAG (MAGNET ROOM, FAKE EXIT)
XC C6- FROBOZZ FLAG (MAGNET ROOM, REAL EXIT)
XC
X4000 IF(CAROFF) GO TO 2500
XC !IF FLIPPED, GO SPIN.
X FROBZF=.FALSE.
XC !OTHERWISE, NOT AN EXIT.
X RETURN
XC
X6000 IF(CAROFF) GO TO 2500
XC !IF FLIPPED, GO SPIN.
X FROBZF=.TRUE.
XC !OTHERWISE, AN EXIT.
X RETURN
XC
XC C7- FROBOZZ FLAG (BANK ALARM)
XC
X7000 FROBZF=and((OROOM(BILLS).NE.0),(OROOM(PORTR).NE.0))
X RETURN
XC CXAPPL, PAGE 3
XC
XC C8- FROBOZZ FLAG (MRGO)
XC
X8000 FROBZF=.FALSE.
XC !ASSUME CANT MOVE.
X IF(MLOC.NE.XROOM1) GO TO 8100
XC !MIRROR IN WAY?
X IF((PRSO.EQ.XNORTH).OR.(PRSO.EQ.XSOUTH)) GO TO 8200
X IF(MOD(MDIR,180).NE.0) GO TO 8300
XC !MIRROR MUST BE N-S.
X XROOM1=((XROOM1-MRA)*2)+MRAE
XC !CALC EAST ROOM.
X IF(PRSO.GT.XSOUTH) XROOM1=XROOM1+1
XC !IF SW/NW, CALC WEST.
X8100 CXAPPL=XROOM1
X RETURN
XC
X8200 XSTRNG=814
XC !ASSUME STRUC BLOCKS.
X IF(MOD(MDIR,180).EQ.0) RETURN
XC !IF MIRROR N-S, DONE.
X8300 LDIR=MDIR
XC !SEE WHICH MIRROR.
X IF(PRSO.EQ.XSOUTH) LDIR=180
X XSTRNG=815
XC !MIRROR BLOCKS.
X IF(((LDIR.GT.180).AND..NOT.MR1F).OR.
X& ((LDIR.LT.180).AND..NOT.MR2F)) XSTRNG=816
X RETURN
XC
XC C9- FROBOZZ FLAG (MIRIN)
XC
X9000 IF(MRHERE(HERE).NE.1) GO TO 9100
XC !MIRROR 1 HERE?
X IF(MR1F) XSTRNG=805
XC !SEE IF BROKEN.
X FROBZF=MROPNF
XC !ENTER IF OPEN.
X RETURN
XC
X9100 FROBZF=.FALSE.
XC !NOT HERE,
X XSTRNG=817
XC !LOSE.
X RETURN
XC CXAPPL, PAGE 4
XC
XC C10- FROBOZZ FLAG (MIRROR EXIT)
XC
X10000 FROBZF=.FALSE.
XC !ASSUME CANT.
X LDIR=((PRSO-XNORTH)/XNORTH)*45
XC !XLATE DIR TO DEGREES.
X IF(.NOT.MROPNF .OR.
X& ((MOD(MDIR+270,360).NE.LDIR).AND.(PRSO.NE.XEXIT)))
X& GO TO 10200
X XROOM1=((MLOC-MRA)*2)+MRAE+1-(MDIR/180)
XC !ASSUME E-W EXIT.
X IF(MOD(MDIR,180).EQ.0) GO TO 10100
XC !IF N-S, OK.
X XROOM1=MLOC+1
XC !ASSUME N EXIT.
X IF(MDIR.GT.180) XROOM1=MLOC-1
XC !IF SOUTH.
X10100 CXAPPL=XROOM1
X RETURN
XC
X10200 IF(.NOT.WDOPNF .OR.
X& ((MOD(MDIR+180,360).NE.LDIR).AND.(PRSO.NE.XEXIT)))
X& RETURN
X XROOM1=MLOC+1
XC !ASSUME N.
X IF(MDIR.EQ.0) XROOM1=MLOC-1
XC !IF S.
X CALL RSPEAK(818)
XC !CLOSE DOOR.
X WDOPNF=.FALSE.
X CXAPPL=XROOM1
X RETURN
XC
XC C11- MAYBE DOOR. NORMAL MESSAGE IS THAT DOOR IS CLOSED.
XC BUT IF LCELL.NE.4, DOOR ISNT THERE.
XC
X11000 IF(LCELL.NE.4) XSTRNG=678
XC !SET UP MSG.
X RETURN
XC
XC C12- FROBZF (PUZZLE ROOM MAIN ENTRANCE)
XC
X12000 FROBZF=.TRUE.
XC !ALWAYS ENTER.
X CPHERE=10
XC !SET SUBSTATE.
X RETURN
XC
XC C13- CPOUTF (PUZZLE ROOM SIZE ENTRANCE)
XC
X13000 CPHERE=52
XC !SET SUBSTATE.
X RETURN
XC CXAPPL, PAGE 5
XC
XC C14- FROBZF (PUZZLE ROOM TRANSITIONS)
XC
X14000 FROBZF=.FALSE.
XC !ASSSUME LOSE.
X IF(PRSO.NE.XUP) GO TO 14100
XC !UP?
X IF(CPHERE.NE.10) RETURN
XC !AT EXIT?
X XSTRNG=881
XC !ASSUME NO LADDER.
X IF(CPVEC(CPHERE+1).NE.-2) RETURN
XC !LADDER HERE?
X CALL RSPEAK(882)
XC !YOU WIN.
X FROBZF=.TRUE.
XC !LET HIM OUT.
X RETURN
XC
X14100 IF((CPHERE.NE.52).OR.(PRSO.NE.XWEST).OR..NOT.CPOUTF)
X& GO TO 14200
X FROBZF=.TRUE.
XC !YES, LET HIM OUT.
X RETURN
XC
X14200 DO 14300 I=1,16,2
XC !LOCATE EXIT.
X IF(PRSO.EQ.CPDR(I)) GO TO 14400
X14300 CONTINUE
X RETURN
XC !NO SUCH EXIT.
XC
X14400 J=CPDR(I+1)
XC !GET DIRECTIONAL OFFSET.
X NXT=CPHERE+J
XC !GET NEXT STATE.
X K=8
XC !GET ORTHOGONAL DIR.
X IF(J.LT.0) K=-8
X IF((((IABS(J).EQ.1).OR.(IABS(J).EQ.8)).OR.
X& ((CPVEC(CPHERE+K).EQ.0).OR.(CPVEC(NXT-K).EQ.0))).AND.
X& (CPVEC(NXT).EQ.0)) GO TO 14500
X RETURN
XC
X14500 CALL CPGOTO(NXT)
XC !MOVE TO STATE.
X XROOM1=CPUZZ
XC !STAY IN ROOM.
X CXAPPL=XROOM1
X RETURN
XC
X END
END_OF_dverb2.F
if test 10970 -ne `wc -c <dverb2.F`; then
echo shar: \"dverb2.F\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f gdt.F -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"gdt.F\"
else
echo shar: Extracting \"gdt.F\" \(11509 characters\)
sed "s/^X//" >gdt.F <<'END_OF_gdt.F'
XC GDT- GAME DEBUGGING TOOL
XC
XC COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
XC ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
XC WRITTEN BY R. M. SUPNIK
XC
XC DECLARATIONS
XC
X SUBROUTINE GDT
X IMPLICIT INTEGER (A-Z)
X#ifdef PDP
XC
XC no debugging tool available in pdp version
XC
X call nogdt
X return
X#else
X CHARACTER*2 DBGCMD(38),CMD
X INTEGER ARGTYP(38)
X LOGICAL VALID1,VALID2,VALID3
X character*2 ldbgcmd(38)
X#include "parser.h"
X#include "gamestate.h"
X#include "state.h"
X#include "screen.h"
X#include "puzzle.h"
XC
XC MISCELLANEOUS VARIABLES
XC
X COMMON /STAR/ MBASE,STRBIT
X#include "io.h"
X#include "mindex.h"
X#include "debug.h"
X#include "rooms.h"
X#include "rindex.h"
X#include "exits.h"
X#include "objects.h"
X#include "oindex.h"
X#include "clock.h"
X#include "villians.h"
X#include "advers.h"
X#include "flags.h"
XC
XC FUNCTIONS AND DATA
XC
X VALID1(A1,L1)=(A1.GT.0).AND.(A1.LE.L1)
X VALID2(A1,A2,L1)=VALID1(A1,L1).AND.VALID1(A2,L1).AND.
X& (A1.LE.A2)
X VALID3(A1,L1,A2,L2)=VALID1(A1,L1).AND.VALID1(A2,L2)
X DATA CMDMAX/38/
X DATA DBGCMD/'DR','DO','DA','DC','DX','DH','DL','DV','DF','DS',
X& 'AF','HE','NR','NT','NC','ND','RR','RT','RC','RD',
X& 'TK','EX','AR','AO','AA','AC','AX','AV','D2','DN',
X& 'AN','DM','DT','AH','DP','PD','DZ','AZ'/
X DATA ldbgcmd/'dr','do','da','dc','dx','dh','dl','dv','df','ds',
X& 'af','he','nr','nt','nc','nd','rr','rt','rc','rd',
X& 'tk','ex','ar','ao','aa','ac','ax','av','d2','dn',
X& 'an','dm','dt','ah','dp','pd','dz','az'/
X DATA ARGTYP/ 2 , 2 , 2 , 2 , 2 , 0 , 0 , 2 , 2 , 0 ,
X& 1 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ,
X& 1 , 0 , 3 , 3 , 3 , 3 , 1 , 3 , 2 , 2 ,
X& 1 , 2 , 1 , 0 , 0 , 0 , 0 , 1 /
XC GDT, PAGE 2
XC
XC FIRST, VALIDATE THAT THE CALLER IS AN IMPLEMENTER.
XC
X FMAX=46
XC !SET ARRAY LIMITS.
X SMAX=22
XC
X IF(GDTFLG.NE.0) GO TO 2000
XC !IF OK, SKIP.
X WRITE(OUTCH,100)
XC !NOT AN IMPLEMENTER.
X RETURN
XC !BOOT HIM OFF
XC
X100 FORMAT(' You are not an authorized user.')
Xc GDT, PAGE 2A
XC
XC HERE TO GET NEXT COMMAND
XC
X2000 WRITE(OUTCH,200)
XC !OUTPUT PROMPT.
X READ(INPCH,210) CMD
XC !GET COMMAND.
X IF(CMD.EQ.' ') GO TO 2000
XC !IGNORE BLANKS.
X DO 2100 I=1,CMDMAX
XC !LOOK IT UP.
X IF(CMD.EQ.DBGCMD(I)) GO TO 2300
XC !FOUND?
XC check for lower case command, as well
X if(cmd .eq. ldbgcmd(i)) go to 2300
X2100 CONTINUE
X2200 WRITE(OUTCH,220)
XC !NO, LOSE.
X GO TO 2000
XC
X200 FORMAT(' GDT>',$)
X210 FORMAT(A2)
X220 FORMAT(' ?')
X230 FORMAT(2I6)
X240 FORMAT(I6)
X225 FORMAT(' Limits: ',$)
X235 FORMAT(' Entry: ',$)
X245 FORMAT(' Idx,Ary: ',$)
Xc
X2300 GO TO (2400,2500,2600,2700),ARGTYP(I)+1
XC !BRANCH ON ARG TYPE.
X GO TO 2200
XC !ILLEGAL TYPE.
XC
X2700 WRITE(OUTCH,245)
XC !TYPE 3, REQUEST ARRAY COORDS.
X READ(INPCH,230) J,K
X GO TO 2400
XC
X2600 WRITE(OUTCH,225)
XC !TYPE 2, READ BOUNDS.
X READ(INPCH,230) J,K
X IF(K.EQ.0) K=J
X GO TO 2400
XC
X2500 WRITE(OUTCH,235)
XC !TYPE 1, READ ENTRY NO.
X READ(INPCH,240) J
X2400 GO TO (10000,11000,12000,13000,14000,15000,16000,17000,18000,
X& 19000,20000,21000,22000,23000,24000,25000,26000,27000,28000,
X& 29000,30000,31000,32000,33000,34000,35000,36000,37000,38000,
X& 39000,40000,41000,42000,43000,44000,45000,46000,47000),I
X GO TO 2200
XC !WHAT???
XC GDT, PAGE 3
XC
XC DR-- DISPLAY ROOMS
XC
X10000 IF(.NOT.VALID2(J,K,RLNT)) GO TO 2200
XC !ARGS VALID?
X WRITE(OUTCH,300)
XC !COL HDRS.
X DO 10100 I=J,K
X WRITE(OUTCH,310) I,(EQR(I,L),L=1,5)
X10100 CONTINUE
X GO TO 2000
XC
X300 FORMAT(' RM# DESC1 EXITS ACTION VALUE FLAGS')
X310 FORMAT(1X,I3,4(1X,I6),1X,I6)
XC
XC DO-- DISPLAY OBJECTS
XC
X11000 IF(.NOT.VALID2(J,K,OLNT)) GO TO 2200
XC !ARGS VALID?
X WRITE(OUTCH,320)
XC !COL HDRS
X DO 11100 I=J,K
X WRITE(OUTCH,330) I,(EQO(I,L),L=1,14)
X11100 CONTINUE
X GO TO 2000
XC
X320 FORMAT(' OB# DESC1 DESC2 DESCO ACT FLAGS1 FLAGS2 FVL TVL
X& SIZE CAPAC ROOM ADV CON READ')
X330 FORMAT(1X,I3,3I6,I4,2I7,2I4,2I6,1X,3I4,I6)
XC
XC DA-- DISPLAY ADVENTURERS
XC
X12000 IF(.NOT.VALID2(J,K,ALNT)) GO TO 2200
XC !ARGS VALID?
X WRITE(OUTCH,340)
X DO 12100 I=J,K
X WRITE(OUTCH,350) I,(EQA(I,L),L=1,7)
X12100 CONTINUE
X GO TO 2000
XC
X340 FORMAT(' AD# ROOM SCORE VEHIC OBJECT ACTION STREN FLAGS')
X350 FORMAT(1X,I3,6(1X,I6),1X,I6)
XC
XC DC-- DISPLAY CLOCK EVENTS
XC
X13000 IF(.NOT.VALID2(J,K,CLNT)) GO TO 2200
XC !ARGS VALID?
X WRITE(OUTCH,360)
X DO 13100 I=J,K
X WRITE(OUTCH,370) I,(EQC(I,L),L=1,2),CFLAG(I)
X13100 CONTINUE
X GO TO 2000
XC
X360 FORMAT(' CL# TICK ACTION FLAG')
X370 FORMAT(1X,I3,1X,I6,1X,I6,5X,L1)
XC
XC DX-- DISPLAY EXITS
XC
X14000 IF(.NOT.VALID2(J,K,XLNT)) GO TO 2200
XC !ARGS VALID?
X WRITE(OUTCH,380)
XC !COL HDRS.
X DO 14100 I=J,K,10
XC !TEN PER LINE.
X L=MIN0(I+9,K)
XC !COMPUTE END OF LINE.
X WRITE(OUTCH,390) I,L,(TRAVEL(L1),L1=I,L)
X14100 CONTINUE
X GO TO 2000
XC
X380 FORMAT(' RANGE CONTENTS')
X390 FORMAT(1X,I3,'-',I3,3X,10I7)
XC
XC DH-- DISPLAY HACKS
XC
X15000 WRITE(OUTCH,400) THFPOS,THFFLG,THFACT,SWDACT,SWDSTA
X GO TO 2000
XC
X400 FORMAT(' THFPOS=',I6,', THFFLG=',L2,',THFACT=',L2/
X& ' SWDACT=',L2,', SWDSTA=',I2)
XC
XC DL-- DISPLAY LENGTHS
XC
X16000 WRITE(OUTCH,410) RLNT,XLNT,OLNT,CLNT,VLNT,ALNT,MLNT,R2LNT,
X& MBASE,STRBIT
X GO TO 2000
XC
X410 FORMAT(' R=',I6,', X=',I6,', O=',I6,', C=',I6/
X& ' V=',I6,', A=',I6,', M=',I6,', R2=',I5/
X& ' MBASE=',I6,', STRBIT=',I6)
XC
XC DV-- DISPLAY VILLAINS
XC
X17000 IF(.NOT.VALID2(J,K,VLNT)) GO TO 2200
XC !ARGS VALID?
X WRITE(OUTCH,420)
XC !COL HDRS
X DO 17100 I=J,K
X WRITE(OUTCH,430) I,(EQV(I,L),L=1,5)
X17100 CONTINUE
X GO TO 2000
XC
X420 FORMAT(' VL# OBJECT PROB OPPS BEST MELEE')
X430 FORMAT(1X,I3,5(1X,I6))
XC
XC DF-- DISPLAY FLAGS
XC
X18000 IF(.NOT.VALID2(J,K,FMAX)) GO TO 2200
XC !ARGS VALID?
X DO 18100 I=J,K
X WRITE(OUTCH,440) I,FLAGS(I)
X18100 CONTINUE
X GO TO 2000
XC
X440 FORMAT(' Flag #',I2,' = ',L1)
XC
XC DS-- DISPLAY STATE
XC
X19000 WRITE(OUTCH,450) PRSA,PRSO,PRSI,PRSWON,PRSCON
X WRITE(OUTCH,460) WINNER,HERE,TELFLG
X WRITE(OUTCH,470) MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD,LTSHFT,BLOC,
X& MUNGRM,HS,EGSCOR,EGMXSC
X WRITE(OUTCH,475) FROMDR,SCOLRM,SCOLAC
X GO TO 2000
XC
X450 FORMAT(' Parse vector=',3(1X,I6),1X,L6,1X,I6)
X460 FORMAT(' Play vector= ',2(1X,I6),1X,L6)
X470 FORMAT(' State vector=',9(1X,I6)/14X,2(1X,I6))
X475 FORMAT(' Scol vector= ',1X,I6,2(1X,I6))
XC GDT, PAGE 4
XC
XC AF-- ALTER FLAGS
XC
X20000 IF(.NOT.VALID1(J,FMAX)) GO TO 2200
XC !ENTRY NO VALID?
X WRITE(OUTCH,480) FLAGS(J)
XC !TYPE OLD, GET NEW.
X READ(INPCH,490) FLAGS(J)
X GO TO 2000
XC
X480 FORMAT(' Old=',L2,6X,'New= ',$)
X490 FORMAT(L1)
XC
XC 21000-- HELP
XC
X21000 WRITE(OUTCH,900)
X GO TO 2000
XC
X900 FORMAT(' Valid commands are:'/' AA- Alter ADVS'/
X& ' AC- Alter CEVENT'/' AF- Alter FINDEX'/' AH- Alter HERE'/
X& ' AN- Alter switches'/' AO- Alter OBJCTS'/' AR- Alter ROOMS'/
X& ' AV- Alter VILLS'/' AX- Alter EXITS'/
X& ' AZ- Alter PUZZLE'/' DA- Display ADVS'/
X& ' DC- Display CEVENT'/' DF- Display FINDEX'/' DH- Display HACKS'/
X& ' DL- Display lengths'/' DM- Display RTEXT'/
X& ' DN- Display switches'/
X& ' DO- Display OBJCTS'/' DP- Display parser'/
X& ' DR- Display ROOMS'/' DS- Display state'/' DT- Display text'/
X& ' DV- Display VILLS'/' DX- Display EXITS'/' DZ- Display PUZZLE'/
X& ' D2- Display ROOM2'/' EX- Exit'/' HE- Type this message'/
X& ' NC- No cyclops'/' ND- No deaths'/' NR- No robber'/
X& ' NT- No troll'/' PD- Program detail'/
X& ' RC- Restore cyclops'/' RD- Restore deaths'/
X& ' RR- Restore robber'/' RT- Restore troll'/' TK- Take.')
XC
XC NR-- NO ROBBER
XC
X22000 THFFLG=.FALSE.
XC !DISABLE ROBBER.
X THFACT=.FALSE.
X CALL NEWSTA(THIEF,0,0,0,0)
XC !VANISH THIEF.
X WRITE(OUTCH,500)
X GO TO 2000
XC
X500 FORMAT(' No robber.')
XC
XC NT-- NO TROLL
XC
X23000 TROLLF=.TRUE.
X CALL NEWSTA(TROLL,0,0,0,0)
X WRITE(OUTCH,510)
X GO TO 2000
XC
X510 FORMAT(' No troll.')
XC
XC NC-- NO CYCLOPS
XC
X24000 CYCLOF=.TRUE.
X CALL NEWSTA(CYCLO,0,0,0,0)
X WRITE(OUTCH,520)
X GO TO 2000
XC
X520 FORMAT(' No cyclops.')
XC
XC ND-- IMMORTALITY MODE
XC
X25000 DBGFLG=1
X WRITE(OUTCH,530)
X GO TO 2000
XC
X530 FORMAT(' No deaths.')
XC
XC RR-- RESTORE ROBBER
XC
X26000 THFACT=.TRUE.
X WRITE(OUTCH,540)
X GO TO 2000
XC
X540 FORMAT(' Restored robber.')
XC
XC RT-- RESTORE TROLL
XC
X27000 TROLLF=.FALSE.
X CALL NEWSTA(TROLL,0,MTROL,0,0)
X WRITE(OUTCH,550)
X GO TO 2000
XC
X550 FORMAT(' Restored troll.')
XC
XC RC-- RESTORE CYCLOPS
XC
X28000 CYCLOF=.FALSE.
X MAGICF=.FALSE.
X CALL NEWSTA(CYCLO,0,MCYCL,0,0)
X WRITE(OUTCH,560)
X GO TO 2000
XC
X560 FORMAT(' Restored cyclops.')
XC
XC RD-- MORTAL MODE
XC
X29000 DBGFLG=0
X WRITE(OUTCH,570)
X GO TO 2000
XC
X570 FORMAT(' Restored deaths.')
XC GDT, PAGE 5
XC
XC TK-- TAKE
XC
X30000 IF(.NOT.VALID1(J,OLNT)) GO TO 2200
XC !VALID OBJECT?
X CALL NEWSTA(J,0,0,0,WINNER)
XC !YES, TAKE OBJECT.
X WRITE(OUTCH,580)
XC !TELL.
X GO TO 2000
XC
X580 FORMAT(' Taken.')
XC
XC EX-- GOODBYE
XC
X31000 PRSCON=1
X RETURN
XC
XC AR-- ALTER ROOM ENTRY
XC
X32000 IF(.NOT.VALID3(J,RLNT,K,5)) GO TO 2200
XC !INDICES VALID?
X WRITE(OUTCH,590) EQR(J,K)
XC !TYPE OLD, GET NEW.
X READ(INPCH,600) EQR(J,K)
X GO TO 2000
XC
X590 FORMAT(' Old= ',I6,6X,'New= ',$)
X600 FORMAT(I6)
XC
XC AO-- ALTER OBJECT ENTRY
XC
X33000 IF(.NOT.VALID3(J,OLNT,K,14)) GO TO 2200
XC !INDICES VALID?
X WRITE(OUTCH,590) EQO(J,K)
X READ(INPCH,600) EQO(J,K)
X GO TO 2000
XC
XC AA-- ALTER ADVS ENTRY
XC
X34000 IF(.NOT.VALID3(J,ALNT,K,7)) GO TO 2200
XC !INDICES VALID?
X WRITE(OUTCH,590) EQA(J,K)
X READ(INPCH,600) EQA(J,K)
X GO TO 2000
XC
XC AC-- ALTER CLOCK EVENTS
XC
X35000 IF(.NOT.VALID3(J,CLNT,K,3)) GO TO 2200
XC !INDICES VALID?
X IF(K.EQ.3) GO TO 35500
XC !FLAGS ENTRY?
X WRITE(OUTCH,590) EQC(J,K)
X READ(INPCH,600) EQC(J,K)
X GO TO 2000
XC
X35500 WRITE(OUTCH,480) CFLAG(J)
X READ(INPCH,490) CFLAG(J)
X GO TO 2000
XC GDT, PAGE 6
XC
XC AX-- ALTER EXITS
XC
X36000 IF(.NOT.VALID1(J,XLNT)) GO TO 2200
XC !ENTRY NO VALID?
X WRITE(OUTCH,610) TRAVEL(J)
X READ(INPCH,620) TRAVEL(J)
X GO TO 2000
XC
X610 FORMAT(' Old= ',I6,6X,'New= ',$)
X620 FORMAT(I6)
XC
XC AV-- ALTER VILLAINS
XC
X37000 IF(.NOT.VALID3(J,VLNT,K,5)) GO TO 2200
XC !INDICES VALID?
X WRITE(OUTCH,590) EQV(J,K)
X READ(INPCH,600) EQV(J,K)
X GO TO 2000
XC
XC D2-- DISPLAY ROOM2 LIST
XC
X38000 IF(.NOT.VALID2(J,K,R2LNT)) GO TO 2200
X DO 38100 I=J,K
X WRITE(OUTCH,630) I,RROOM2(I),OROOM2(I)
X38100 CONTINUE
X GO TO 2000
XC
X630 FORMAT(' #',I2,' Room=',I6,' Obj=',I6)
XC
XC DN-- DISPLAY SWITCHES
XC
X39000 IF(.NOT.VALID2(J,K,SMAX)) GO TO 2200
XC !VALID?
X DO 39100 I=J,K
X WRITE(OUTCH,640) I,SWITCH(I)
X39100 CONTINUE
X GO TO 2000
XC
X640 FORMAT(' Switch #',I2,' = ',I6)
XC
XC AN-- ALTER SWITCHES
XC
X40000 IF(.NOT.VALID1(J,SMAX)) GO TO 2200
XC !VALID ENTRY?
X WRITE(OUTCH,590) SWITCH(J)
X READ(INPCH,600) SWITCH(J)
X GO TO 2000
XC
XC DM-- DISPLAY MESSAGES
XC
X41000 IF(.NOT.VALID2(J,K,MLNT)) GO TO 2200
XC !VALID LIMITS?
X WRITE(OUTCH,380)
X DO 41100 I=J,K,10
X L=MIN0(I+9,K)
X WRITE(OUTCH,650) I,L,(RTEXT(L1),L1=I,L)
X41100 CONTINUE
X GO TO 2000
XC
X650 FORMAT(1X,I3,'-',I3,3X,10(1X,I6))
XC
XC DT-- DISPLAY TEXT
XC
X42000 CALL RSPEAK(J)
X GO TO 2000
XC
XC AH-- ALTER HERE
XC
X43000 WRITE(OUTCH,590) HERE
X READ(INPCH,600) HERE
X EQA(1,1)=HERE
X GO TO 2000
XC
XC DP-- DISPLAY PARSER STATE
XC
X44000 WRITE(OUTCH,660) ORP,LASTIT,PVEC,SYN
X GO TO 2000
XC
X660 FORMAT(' ORPHS= ',I7,I7,4I7/
X& ' PV= ',I7,4I7/' SYN= ',6I7/15X,5I7)
XC
XC PD-- PROGRAM DETAIL DEBUG
XC
X45000 WRITE(OUTCH,610) PRSFLG
XC !TYPE OLD, GET NEW.
X READ(INPCH,620) PRSFLG
X GO TO 2000
XC
XC DZ-- DISPLAY PUZZLE ROOM
XC
X46000 DO 46100 I=1,64,8
XC !DISPLAY PUZZLE
X WRITE(OUTCH,670) (CPVEC(J),J=I,I+7)
X46100 CONTINUE
X GO TO 2000
XC
X670 FORMAT(2X,8I3)
XC
XC AZ-- ALTER PUZZLE ROOM
XC
X47000 IF(.NOT.VALID1(J,64)) GO TO 2200
XC !VALID ENTRY?
X WRITE(OUTCH,590) CPVEC(J)
XC !OUTPUT OLD,
X READ(INPCH,600) CPVEC(J)
X GO TO 2000
XC
X#endif PDP
X END
END_OF_gdt.F
if test 11509 -ne `wc -c <gdt.F`; then
echo shar: \"gdt.F\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lex.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lex.c\"
else
echo shar: Extracting \"lex.c\" \(1532 characters\)
sed "s/^X//" >lex.c <<'END_OF_lex.c'
X#define FALSE 0
X#define TRUE 1
X
Xlex_(inbuf, inlnt, outbuf, op, vbflag, lprscon)
X char inbuf[78];
X int outbuf[40], *inlnt, *op, *vbflag;
X int *lprscon; /* added */
X{
X /*
X * lex - lexical analyzer, converted from fortran
X *
X * input: one line of ascii characters
X * output: tokenized input, packed in radix-50 format
X */
X
X char j;
X int cp, i, k, prsptr;
X static int num601 = {601};
X
X for (i=0; i<40; i++)
X outbuf[i] = 0;
X *op = -1;
X prsptr = *lprscon - 1;
X /* printf("lex: inbuf=%s, inlnt=%d\n", inbuf, *inlnt); */
X
Xtoknlp:
X *op += 2;
X cp = 0;
X while ((*lprscon)++ <= *inlnt) {
X j = inbuf[prsptr++];
X /* printf("lex: chr=%c\n", j); */
X if ((j == '.') || (j == ','))
X break;
X else if (j == ' ')
X if (cp) /* if (cp != 0) */
X goto toknlp;
X else
X continue; /* first token */
X else if ((j >= 'A') && (j <= 'Z'))
X j -= '@';
X else if (((j >= '1') && (j <= '9')) || (j == '-'))
X j -= 0x0c; /* formfeed */
X else {
X if (*vbflag)
X rspeak_(&num601);
X return(FALSE);
X }
X
X if (cp >= 6)
X /*
X * ignore remainder of any token > 6 chars
X */
X continue;
X /*
X * pack three chars per word in radix-50 format
X */
X k = *op + (cp/3) - 1;
X /* printf("*op=%d, cp=%d, k=%d\n", *op, cp, k); */
X switch (cp%3) {
X case 0:
X outbuf[k] += j * 1560;
X case 1:
X outbuf[k] += j * 39;
X case 2:
X outbuf[k] += j;
X }
X cp++;
X }
X if (*lprscon > *inlnt)
X *lprscon = 1;
X if (!cp) /* if (cp == 0) */
X if (*op == 1)
X return(FALSE); /* no valid tokens */
X else {
X *op -= 2;
X return(TRUE);
X };
X}
END_OF_lex.c
if test 1532 -ne `wc -c <lex.c`; then
echo shar: \"lex.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f nobjs.F -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"nobjs.F\"
else
echo shar: Extracting \"nobjs.F\" \(13027 characters\)
sed "s/^X//" >nobjs.F <<'END_OF_nobjs.F'
XC NOBJS- NEW OBJECTS PROCESSOR
XC OBJECTS IN THIS MODULE CANNOT CALL RMINFO, JIGSUP,
XC MAJOR VERBS, OR OTHER NON-RESIDENT SUBROUTINES
XC
XC COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
XC ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
XC WRITTEN BY R. M. SUPNIK
XC
XC DECLARATIONS
XC
X LOGICAL FUNCTION NOBJS(RI,ARG)
X IMPLICIT INTEGER (A-Z)
X LOGICAL QOPEN,MOVETO,F
X LOGICAL QHERE,OPNCLS,MIRPAN
X#include "parser.h"
X#include "gamestate.h"
X#include "state.h"
X#include "screen.h"
X#include "puzzle.h"
XC
XC MISCELLANEOUS VARIABLES
XC
X COMMON /HYPER/ HFACTR
X#include "rooms.h"
X#include "rflag.h"
X#include "rindex.h"
X#include "objects.h"
X#include "oflags.h"
X#include "oindex.h"
X#include "clock.h"
X
X#include "villians.h"
X#include "advers.h"
X#include "verbs.h"
X#include "flags.h"
XC
XC FUNCTIONS AND DATA
XC
X QOPEN(R)=and(OFLAG2(R),OPENBT).NE.0
XC NOBJS, PAGE 2
XC
X IF(PRSO.NE.0) ODO2=ODESC2(PRSO)
X IF(PRSI.NE.0) ODI2=ODESC2(PRSI)
X AV=AVEHIC(WINNER)
X NOBJS=.TRUE.
XC
X GO TO (1000,2000,3000,4000,5000,6000,7000,8000,9000,
X& 10000,11000,12000,13000,14000,15000,16000,17000,
X& 18000,19000,20000,21000),
X& (RI-31)
X CALL BUG(6,RI)
XC
XC RETURN HERE TO DECLARE FALSE RESULT
XC
X10 NOBJS=.FALSE.
X RETURN
XC
XC O32-- BILLS
XC
X1000 IF(PRSA.NE.EATW) GO TO 1100
XC !EAT?
X CALL RSPEAK(639)
XC !JOKE.
X RETURN
XC
X1100 IF(PRSA.EQ.BURNW) CALL RSPEAK(640)
XC !BURN? JOKE.
X GO TO 10
XC !LET IT BE HANDLED.
XC NOBJS, PAGE 3
XC
XC O33-- SCREEN OF LIGHT
XC
X2000 TARGET=SCOL
XC !TARGET IS SCOL.
X2100 IF(PRSO.NE.TARGET) GO TO 2400
XC !PRSO EQ TARGET?
X IF((PRSA.NE.PUSHW).AND.(PRSA.NE.MOVEW).AND.
X& (PRSA.NE.TAKEW).AND.(PRSA.NE.RUBW)) GO TO 2200
X CALL RSPEAK(673)
XC !HAND PASSES THRU.
X RETURN
XC
X2200 IF((PRSA.NE.KILLW).AND.(PRSA.NE.ATTACW).AND.
X& (PRSA.NE.MUNGW)) GO TO 2400
X CALL RSPSUB(674,ODI2)
XC !PASSES THRU.
X RETURN
XC
X2400 IF((PRSA.NE.THROWW).OR.(PRSI.NE.TARGET)) GO TO 10
X IF(HERE.EQ.BKBOX) GO TO 2600
XC !THRU SCOL?
X CALL NEWSTA(PRSO,0,BKBOX,0,0)
XC !NO, THRU WALL.
X CALL RSPSUB(675,ODO2)
XC !ENDS UP IN BOX ROOM.
X CTICK(CEVSCL)=0
XC !CANCEL ALARM.
X SCOLRM=0
XC !RESET SCOL ROOM.
X RETURN
XC
X2600 IF(SCOLRM.EQ.0) GO TO 2900
XC !TRIED TO GO THRU?
X CALL NEWSTA(PRSO,0,SCOLRM,0,0)
XC !SUCCESS.
X CALL RSPSUB(676,ODO2)
XC !ENDS UP SOMEWHERE.
X CTICK(CEVSCL)=0
XC !CANCEL ALARM.
X SCOLRM=0
XC !RESET SCOL ROOM.
X RETURN
XC
X2900 CALL RSPEAK(213)
XC !CANT DO IT.
X RETURN
XC NOBJS, PAGE 4
XC
XC O34-- GNOME OF ZURICH
XC
X3000 IF((PRSA.NE.GIVEW).AND.(PRSA.NE.THROWW)) GO TO 3200
X IF(OTVAL(PRSO).NE.0) GO TO 3100
XC !THROW A TREASURE?
X CALL NEWSTA(PRSO,641,0,0,0)
XC !NO, GO POP.
X RETURN
XC
X3100 CALL NEWSTA(PRSO,0,0,0,0)
XC !YES, BYE BYE TREASURE.
X CALL RSPSUB(642,ODO2)
X CALL NEWSTA(ZGNOM,0,0,0,0)
XC !BYE BYE GNOME.
X CTICK(CEVZGO)=0
XC !CANCEL EXIT.
X F=MOVETO(BKENT,WINNER)
XC !NOW IN BANK ENTRANCE.
X RETURN
XC
X3200 IF((PRSA.NE.ATTACW).AND.(PRSA.NE.KILLW).AND.
X& (PRSA.NE.MUNGW)) GO TO 3300
X CALL NEWSTA(ZGNOM,643,0,0,0)
XC !VANISH GNOME.
X CTICK(CEVZGO)=0
XC !CANCEL EXIT.
X RETURN
XC
X3300 CALL RSPEAK(644)
XC !GNOME IS IMPATIENT.
X RETURN
XC
XC O35-- EGG
XC
X4000 IF((PRSA.NE.OPENW).OR.(PRSO.NE.EGG)) GO TO 4500
X IF(.NOT.QOPEN(EGG)) GO TO 4100
XC !OPEN ALREADY?
X CALL RSPEAK(649)
XC !YES.
X RETURN
XC
X4100 IF(PRSI.NE.0) GO TO 4200
XC !WITH SOMETHING?
X CALL RSPEAK(650)
XC !NO, CANT.
X RETURN
XC
X4200 IF(PRSI.NE.HANDS) GO TO 4300
XC !WITH HANDS?
X CALL RSPEAK(651)
XC !NOT RECOMMENDED.
X RETURN
XC
X4300 I=652
XC !MUNG MESSAGE.
X IF((and(OFLAG1(PRSI),TOOLBT).NE.0).OR.
X& (and(OFLAG2(PRSI),WEAPBT).NE.0)) GO TO 4600
X I=653
XC !NOVELTY 1.
X IF(and(OFLAG2(PRSO),FITEBT).NE.0) I=654
X OFLAG2(PRSO)=or(OFLAG2(PRSO),FITEBT)
X CALL RSPSUB(I,ODI2)
X RETURN
XC
X4500 IF((PRSA.NE.OPENW).AND.(PRSA.NE.MUNGW)) GO TO 4800
X I=655
XC !YOU BLEW IT.
X4600 CALL NEWSTA(BEGG,I,OROOM(EGG),OCAN(EGG),OADV(EGG))
X CALL NEWSTA(EGG,0,0,0,0)
XC !VANISH EGG.
X OTVAL(BEGG)=2
XC !BAD EGG HAS VALUE.
X IF(OCAN(CANAR).NE.EGG) GO TO 4700
XC !WAS CANARY INSIDE?
X CALL RSPEAK(ODESCO(BCANA))
XC !YES, DESCRIBE RESULT.
X OTVAL(BCANA)=1
X RETURN
XC
X4700 CALL NEWSTA(BCANA,0,0,0,0)
XC !NO, VANISH IT.
X RETURN
XC
X4800 IF((PRSA.NE.DROPW).OR.(HERE.NE.MTREE)) GO TO 10
X CALL NEWSTA(BEGG,658,FORE3,0,0)
XC !DROPPED EGG.
X CALL NEWSTA(EGG,0,0,0,0)
X OTVAL(BEGG)=2
X IF(OCAN(CANAR).NE.EGG) GO TO 4700
X OTVAL(BCANA)=1
XC !BAD CANARY.
X RETURN
XC NOBJS, PAGE 5
XC
XC O36-- CANARIES, GOOD AND BAD
XC
X5000 IF(PRSA.NE.WINDW) GO TO 10
XC !WIND EM UP?
X IF(PRSO.EQ.CANAR) GO TO 5100
XC !RIGHT ONE?
X CALL RSPEAK(645)
XC !NO, BAD NEWS.
X RETURN
XC
X5100 IF(.NOT.SINGSF.AND.((HERE.EQ.MTREE).OR.
X& ((HERE.GE.FORE1).AND.(HERE.LT.CLEAR))))
X& GO TO 5200
X CALL RSPEAK(646)
XC !NO, MEDIOCRE NEWS.
X RETURN
XC
X5200 SINGSF=.TRUE.
XC !SANG SONG.
X I=HERE
X IF(I.EQ.MTREE) I=FORE3
XC !PLACE BAUBLE.
X CALL NEWSTA(BAUBL,647,I,0,0)
X RETURN
XC
XC O37-- WHITE CLIFFS
XC
X6000 IF((PRSA.NE.CLMBW).AND.(PRSA.NE.CLMBUW).AND.
X& (PRSA.NE.CLMBDW)) GO TO 10
X CALL RSPEAK(648)
XC !OH YEAH?
X RETURN
XC
XC O38-- WALL
XC
X7000 IF((IABS(HERE-MLOC).NE.1).OR.(MRHERE(HERE).NE.0).OR.
X& (PRSA.NE.PUSHW)) GO TO 7100
X CALL RSPEAK(860)
XC !PUSHED MIRROR WALL.
X RETURN
XC
X7100 IF(and(RFLAG(HERE),RNWALL).EQ.0) GO TO 10
X CALL RSPEAK(662)
XC !NO WALL.
X RETURN
XC NOBJS, PAGE 6
XC
XC O39-- SONG BIRD GLOBAL
XC
X8000 IF(PRSA.NE.FINDW) GO TO 8100
XC !FIND?
X CALL RSPEAK(666)
X RETURN
XC
X8100 IF(PRSA.NE.EXAMIW) GO TO 10
XC !EXAMINE?
X CALL RSPEAK(667)
X RETURN
XC
XC O40-- PUZZLE/SCOL WALLS
XC
X9000 IF(HERE.NE.CPUZZ) GO TO 9500
XC !PUZZLE WALLS?
X IF(PRSA.NE.PUSHW) GO TO 10
XC !PUSH?
X DO 9100 I=1,8,2
XC !LOCATE WALL.
X IF(PRSO.EQ.CPWL(I)) GO TO 9200
X9100 CONTINUE
X CALL BUG(80,PRSO)
XC !WHAT?
XC
X9200 J=CPWL(I+1)
XC !GET DIRECTIONAL OFFSET.
X NXT=CPHERE+J
XC !GET NEXT STATE.
X WL=CPVEC(NXT)
XC !GET C(NEXT STATE).
X GO TO (9300,9300,9300,9250,9350),(WL+4)
XC !PROCESS.
XC
X9250 CALL RSPEAK(876)
XC !CLEAR CORRIDOR.
X RETURN
XC
X9300 IF(CPVEC(NXT+J).EQ.0) GO TO 9400
XC !MOVABLE, ROOM TO MOVE?
X9350 CALL RSPEAK(877)
XC !IMMOVABLE, NO ROOM.
X RETURN
XC
X9400 I=878
XC !ASSUME FIRST PUSH.
X IF(CPUSHF) I=879
XC !NOT?
X CPUSHF=.TRUE.
X CPVEC(NXT+J)=WL
XC !MOVE WALL.
X CPVEC(NXT)=0
XC !VACATE NEXT STATE.
X CALL CPGOTO(NXT)
XC !ONWARD.
X CALL CPINFO(I,NXT)
XC !DESCRIBE.
X CALL PRINCR(.TRUE.,HERE)
XC !PRINT ROOMS CONTENTS.
X RFLAG(HERE)=or(RFLAG(HERE),RSEEN)
X RETURN
XC
X9500 IF(HERE.NE.SCOLAC) GO TO 9700
XC !IN SCOL ACTIVE ROOM?
X DO 9600 I=1,12,3
X TARGET=SCOLWL(I+1)
XC !ASSUME TARGET.
X IF(SCOLWL(I).EQ.HERE) GO TO 2100
XC !TREAT IF FOUND.
X9600 CONTINUE
XC
X9700 IF(HERE.NE.BKBOX) GO TO 10
XC !IN BOX ROOM?
X TARGET=WNORT
X GO TO 2100
XC NOBJS, PAGE 7
XC
XC O41-- SHORT POLE
XC
X10000 IF(PRSA.NE.RAISEW) GO TO 10100
XC !LIFT?
X I=749
XC !ASSUME UP.
X IF(POLEUF.EQ.2) I=750
XC !ALREADY UP?
X CALL RSPEAK(I)
X POLEUF=2
XC !POLE IS RAISED.
X RETURN
XC
X10100 IF((PRSA.NE.LOWERW).AND.(PRSA.NE.PUSHW)) GO TO 10
X IF(POLEUF.NE.0) GO TO 10200
XC !ALREADY LOWERED?
X CALL RSPEAK(751)
XC !CANT DO IT.
X RETURN
XC
X10200 IF(MOD(MDIR,180).NE.0) GO TO 10300
XC !MIRROR N-S?
X POLEUF=0
XC !YES, LOWER INTO
X CALL RSPEAK(752)
XC !CHANNEL.
X RETURN
XC
X10300 IF((MDIR.NE.270).OR.(MLOC.NE.MRB)) GO TO 10400
X POLEUF=0
XC !LOWER INTO HOLE.
X CALL RSPEAK(753)
X RETURN
XC
X10400 CALL RSPEAK(753+POLEUF)
XC !POLEUF = 1 OR 2.
X POLEUF=1
XC !NOW ON FLOOR.
X RETURN
XC
XC O42-- MIRROR SWITCH
XC
X11000 IF(PRSA.NE.PUSHW) GO TO 10
XC !PUSH?
X IF(MRPSHF) GO TO 11300
XC !ALREADY PUSHED?
X CALL RSPEAK(756)
XC !BUTTON GOES IN.
X DO 11100 I=1,OLNT
XC !BLOCKED?
X IF(QHERE(I,MREYE).AND.(I.NE.RBEAM)) GO TO 11200
X11100 CONTINUE
X CALL RSPEAK(757)
XC !NOTHING IN BEAM.
X RETURN
XC
X11200 CFLAG(CEVMRS)=.TRUE.
XC !MIRROR OPENS.
X CTICK(CEVMRS)=7
X MRPSHF=.TRUE.
X MROPNF=.TRUE.
X RETURN
XC
X11300 CALL RSPEAK(758)
XC !MIRROR ALREADYOPEN.
X RETURN
XC NOBJS, PAGE 8
XC
XC O43-- BEAM FUNCTION
XC
X12000 IF((PRSA.NE.TAKEW).OR.(PRSO.NE.RBEAM)) GO TO 12100
X CALL RSPEAK(759)
XC !TAKE BEAM, JOKE.
X RETURN
XC
X12100 I=PRSO
XC !ASSUME BLK WITH DIROBJ.
X IF((PRSA.EQ.PUTW).AND.(PRSI.EQ.RBEAM)) GO TO 12200
X IF((PRSA.NE.MUNGW).OR.(PRSO.NE.RBEAM).OR.
X& (PRSI.EQ.0)) GO TO 10
X I=PRSI
X12200 IF(OADV(I).NE.WINNER) GO TO 12300
XC !CARRYING?
X CALL NEWSTA(I,0,HERE,0,0)
XC !DROP OBJ.
X CALL RSPSUB(760,ODESC2(I))
X RETURN
XC
X12300 J=761
XC !ASSUME NOT IN ROOM.
X IF(QHERE(J,HERE)) I=762
XC !IN ROOM?
X CALL RSPSUB(J,ODESC2(I))
XC !DESCRIBE.
X RETURN
XC
XC O44-- BRONZE DOOR
XC
X13000 IF((HERE.EQ.NCELL).OR.((LCELL.EQ.4).AND.
X& ((HERE.EQ.CELL).OR.(HERE.EQ.SCORR))))
X& GO TO 13100
X CALL RSPEAK(763)
XC !DOOR NOT THERE.
X RETURN
XC
X13100 IF(.NOT.OPNCLS(ODOOR,764,765)) GO TO 10
XC !OPEN/CLOSE?
X IF((HERE.EQ.NCELL).AND.QOPEN(ODOOR))
X& CALL RSPEAK(766)
X RETURN
XC
XC O45-- QUIZ DOOR
XC
X14000 IF((PRSA.NE.OPENW).AND.(PRSA.NE.CLOSEW)) GO TO 14100
X CALL RSPEAK(767)
XC !DOOR WONT MOVE.
X RETURN
XC
X14100 IF(PRSA.NE.KNOCKW) GO TO 10
XC !KNOCK?
X IF(INQSTF) GO TO 14200
XC !TRIED IT ALREADY?
X INQSTF=.TRUE.
XC !START INQUISITION.
X CFLAG(CEVINQ)=.TRUE.
X CTICK(CEVINQ)=2
X QUESNO=RND(8)
XC !SELECT QUESTION.
X NQATT=0
X CORRCT=0
X CALL RSPEAK(768)
XC !ANNOUNCE RULES.
X CALL RSPEAK(769)
X CALL RSPEAK(770+QUESNO)
XC !ASK QUESTION.
X RETURN
XC
X14200 CALL RSPEAK(798)
XC !NO REPLY.
X RETURN
XC
XC O46-- LOCKED DOOR
XC
X15000 IF(PRSA.NE.OPENW) GO TO 10
XC !OPEN?
X CALL RSPEAK(778)
XC !CANT.
X RETURN
XC
XC O47-- CELL DOOR
XC
X16000 NOBJS=OPNCLS(CDOOR,779,780)
XC !OPEN/CLOSE?
X RETURN
XC NOBJS, PAGE 9
XC
XC O48-- DIALBUTTON
XC
X17000 IF(PRSA.NE.PUSHW) GO TO 10
XC !PUSH?
X CALL RSPEAK(809)
XC !CLICK.
X IF(QOPEN(CDOOR)) CALL RSPEAK(810)
XC !CLOSE CELL DOOR.
XC
X DO 17100 I=1,OLNT
XC !RELOCATE OLD TO HYPER.
X IF((OROOM(I).EQ.CELL).AND.(and(OFLAG1(I),DOORBT).EQ.0))
X& CALL NEWSTA(I,0,LCELL*HFACTR,0,0)
X IF(OROOM(I).EQ.(PNUMB*HFACTR))
X& CALL NEWSTA(I,0,CELL,0,0)
X17100 CONTINUE
XC
X OFLAG2(ODOOR)=and(OFLAG2(ODOOR), not(OPENBT))
X OFLAG2(CDOOR)=and(OFLAG2(CDOOR), not(OPENBT))
X OFLAG1(ODOOR)=and(OFLAG1(ODOOR), not(VISIBT))
X IF(PNUMB.EQ.4) OFLAG1(ODOOR)=or(OFLAG1(ODOOR),VISIBT)
XC
X IF(AROOM(PLAYER).NE.CELL) GO TO 17400
XC !PLAYER IN CELL?
X IF(LCELL.NE.4) GO TO 17200
XC !IN RIGHT CELL?
X OFLAG1(ODOOR)=or(OFLAG1(ODOOR), VISIBT)
X F=MOVETO(NCELL,PLAYER)
XC !YES, MOVETO NCELL.
X GO TO 17400
X17200 F=MOVETO(PCELL,PLAYER)
XC !NO, MOVETO PCELL.
XC
X17400 LCELL=PNUMB
X RETURN
XC NOBJS, PAGE 10
XC
XC O49-- DIAL INDICATOR
XC
X18000 IF(PRSA.NE.SPINW) GO TO 18100
XC !SPIN?
X PNUMB=RND(8)+1
XC !WHEE
XC !
X CALL RSPSUB(797,712+PNUMB)
X RETURN
XC
X18100 IF((PRSA.NE.MOVEW).AND.(PRSA.NE.PUTW).AND.
X& (PRSA.NE.TRNTOW)) GO TO 10
X IF(PRSI.NE.0) GO TO 18200
XC !TURN DIAL TO X?
X CALL RSPEAK(806)
XC !MUST SPECIFY.
X RETURN
XC
X18200 IF((PRSI.GE.NUM1).AND.(PRSI.LE.NUM8)) GO TO 18300
X CALL RSPEAK(807)
XC !MUST BE DIGIT.
X RETURN
XC
X18300 PNUMB=PRSI-NUM1+1
XC !SET UP NEW.
X CALL RSPSUB(808,712+PNUMB)
X RETURN
XC
XC O50-- GLOBAL MIRROR
XC
X19000 NOBJS=MIRPAN(832,.FALSE.)
X RETURN
XC
XC O51-- GLOBAL PANEL
XC
X20000 IF(HERE.NE.FDOOR) GO TO 20100
XC !AT FRONT DOOR?
X IF((PRSA.NE.OPENW).AND.(PRSA.NE.CLOSEW)) GO TO 10
X CALL RSPEAK(843)
XC !PANEL IN DOOR, NOGO.
X RETURN
XC
X20100 NOBJS=MIRPAN(838,.TRUE.)
X RETURN
XC
XC O52-- PUZZLE ROOM SLIT
XC
X21000 IF((PRSA.NE.PUTW).OR.(PRSI.NE.CSLIT)) GO TO 10
X IF(PRSO.NE.GCARD) GO TO 21100
XC !PUT CARD IN SLIT?
X CALL NEWSTA(PRSO,863,0,0,0)
XC !KILL CARD.
X CPOUTF=.TRUE.
XC !OPEN DOOR.
X OFLAG1(STLDR)=and(OFLAG1(STLDR),not(VISIBT))
X RETURN
XC
X21100 IF((and(OFLAG1(PRSO),VICTBT).EQ.0).AND.
X& (and(OFLAG2(PRSO),VILLBT).EQ.0)) GO TO 21200
X CALL RSPEAK(RND(5)+552)
XC !JOKE FOR VILL, VICT.
X RETURN
XC
X21200 CALL NEWSTA(PRSO,0,0,0,0)
XC !KILL OBJECT.
X CALL RSPSUB(864,ODO2)
XC !DESCRIBE.
X RETURN
XC
X END
XC MIRPAN-- PROCESSOR FOR GLOBAL MIRROR/PANEL
XC
XC DECLARATIONS
XC
X LOGICAL FUNCTION MIRPAN(ST,PNF)
X IMPLICIT INTEGER(A-Z)
X LOGICAL PNF
X#include "gamestate.h"
X#include "parser.h"
X#include "verbs.h"
X#include "flags.h"
XC MIRPAN, PAGE 2
XC
X MIRPAN=.TRUE.
X NUM=MRHERE(HERE)
XC !GET MIRROR NUM.
X IF(NUM.NE.0) GO TO 100
XC !ANY HERE?
X CALL RSPEAK(ST)
XC !NO, LOSE.
X RETURN
XC
X100 MRBF=0
XC !ASSUME MIRROR OK.
X IF(((NUM.EQ.1).AND..NOT.MR1F).OR.
X& ((NUM.EQ.2).AND..NOT.MR2F)) MRBF=1
X IF((PRSA.NE.MOVEW).AND.(PRSA.NE.OPENW)) GO TO 200
X CALL RSPEAK(ST+1)
XC !CANT OPEN OR MOVE.
X RETURN
XC
X200 IF(PNF.OR.((PRSA.NE.LOOKIW).AND.(PRSA.NE.EXAMIW).AND.
X& (PRSA.NE.LOOKW))) GO TO 300
X CALL RSPEAK(844+MRBF)
XC !LOOK IN MIRROR.
X RETURN
XC
X300 IF(PRSA.NE.MUNGW) GO TO 400
XC !BREAK?
X CALL RSPEAK(ST+2+MRBF)
XC !DO IT.
X IF((NUM.EQ.1).AND..NOT.PNF) MR1F=.FALSE.
X IF((NUM.EQ.2).AND..NOT.PNF) MR2F=.FALSE.
X RETURN
XC
X400 IF(PNF.OR.(MRBF.EQ.0)) GO TO 500
XC !BROKEN MIRROR?
X CALL RSPEAK(846)
X RETURN
XC
X500 IF(PRSA.NE.PUSHW) GO TO 600
XC !PUSH?
X CALL RSPEAK(ST+3+NUM)
X RETURN
XC
X600 MIRPAN=.FALSE.
XC !CANT HANDLE IT.
X RETURN
XC
X END
END_OF_nobjs.F
if test 13027 -ne `wc -c <nobjs.F`; then
echo shar: \"nobjs.F\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f sverbs.F -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"sverbs.F\"
else
echo shar: Extracting \"sverbs.F\" \(13200 characters\)
sed "s/^X//" >sverbs.F <<'END_OF_sverbs.F'
XC SVERBS- SIMPLE VERBS PROCESSOR
XC ALL VERBS IN THIS ROUTINE MUST BE INDEPENDANT
XC OF OBJECT ACTIONS
XC
XC COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
XC ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
XC WRITTEN BY R. M. SUPNIK
XC
XC DECLARATIONS
XC
X LOGICAL FUNCTION SVERBS(RI)
X IMPLICIT INTEGER (A-Z)
X LOGICAL MOVETO,YESNO
X LOGICAL RMDESC
X LOGICAL QOPEN
X LOGICAL FINDXT,QHERE,F
X INTEGER JOKES(25)
X CHARACTER ANSSTR(78)
X CHARACTER P1(6),P2(6),CH(6)
X INTEGER ANSWER(28)
X#include "parser.h"
X#include "gamestate.h"
X#include "state.h"
X#include "screen.h"
XC
XC MISCELLANEOUS VARIABLES
XC
X CHARACTER VEDIT
X COMMON /VERS/ VMAJ,VMIN,VEDIT
X#include "io.h"
X#include "rooms.h"
X#include "rflag.h"
X#include "rindex.h"
X#include "exits.h"
X#include "curxt.h"
X#include "xpars.h"
X#include "xsrch.h"
X#include "objects.h"
X#include "oflags.h"
X#include "oindex.h"
X#include "clock.h"
X
X#include "advers.h"
X#include "verbs.h"
X#include "flags.h"
XC
XC FUNCTIONS AND DATA
XC
X QOPEN(R)=and(OFLAG2(R),OPENBT).NE.0
X DATA MXNOP/39/,MXJOKE/64/
X DATA JOKES/4,5,3,304,305,306,307,308,309,310,311,312,
X& 313,5314,5319,324,325,883,884,120,120,0,0,0,0/
X DATA ANSWER/0,6,1,6,2,5,3,5,4,3,4,6,4,6,4,5,
X& 5,5,5,4,5,6,6,10,7,4,7,6/
X DATA ANSSTR/'T','E','M','P','L','E',
X& 'F','O','R','E','S','T',
X& '3','0','0','0','3',
X& 'F','L','A','S','K',
X& 'R','U','B',
X& 'F','O','N','D','L','E',
X& 'C','A','R','R','E','S',
X& 'T','O','U','C','H',
X& 'B','O','N','E','S',
X& 'B','O','D','Y',
X& 'S','K','E','L','E','T',
X& 'R','U','S','T','Y','K','N','I','F','E',
X& 'N','O','N','E',
X& 'N','O','W','H','E','R','\0'/
XC SVERBS, PAGE 2
XC
X SVERBS=.TRUE.
XC !ASSUME WINS.
X IF(PRSO.NE.0) ODO2=ODESC2(PRSO)
XC !SET UP DESCRIPTORS.
X IF(PRSI.NE.0) ODI2=ODESC2(PRSI)
XC
X IF(RI.EQ.0) CALL BUG(7,RI)
XC !ZERO IS VERBOTEN.
X IF(RI.LE.MXNOP) RETURN
XC !NOP?
X IF(RI.LE.MXJOKE) GO TO 100
XC !JOKE?
X GO TO (65000,66000,67000,68000,69000,
X& 1000,2000,3000,4000,5000,6000,7000,8000,9000,10000,
X& 11000,12000,13000,14000,15000,16000,17000,18000,19000,20000,
X& 21000,22000,23000,24000,25000,26000,27000),
X& (RI-MXJOKE)
X CALL BUG(7,RI)
XC
XC ALL VERB PROCESSORS RETURN HERE TO DECLARE FAILURE.
XC
X10 SVERBS=.FALSE.
XC !LOSE.
X RETURN
XC
XC JOKE PROCESSOR.
XC FIND PROPER ENTRY IN JOKES, USE IT TO SELECT STRING TO PRINT.
XC
X100 I=JOKES(RI-MXNOP)
XC !GET TABLE ENTRY.
X J=I/1000
XC !ISOLATE # STRINGS.
X IF(J.NE.0) I=MOD(I,1000)+RND(J)
XC !IF RANDOM, CHOOSE.
X CALL RSPEAK(I)
XC !PRINT JOKE.
X RETURN
XC SVERBS, PAGE 2A
XC
XC V65-- ROOM
XC
X65000 SVERBS=RMDESC(2)
XC !DESCRIBE ROOM ONLY.
X RETURN
XC
XC V66-- OBJECTS
XC
X66000 SVERBS=RMDESC(1)
XC !DESCRIBE OBJ ONLY.
X IF(.NOT.TELFLG) CALL RSPEAK(138)
XC !NO OBJECTS.
X RETURN
XC
XC V67-- RNAME
XC
X67000 CALL RSPEAK(RDESC2-HERE)
XC !SHORT ROOM NAME.
X RETURN
XC
XC V68-- RESERVED
XC
X68000 RETURN
XC
XC V69-- RESERVED
XC
X69000 RETURN
XC SVERBS, PAGE 3
XC
XC V70-- BRIEF. SET FLAG.
XC
X1000 BRIEFF=.TRUE.
XC !BRIEF DESCRIPTIONS.
X SUPERF=.FALSE.
X CALL RSPEAK(326)
X RETURN
XC
XC V71-- VERBOSE. CLEAR FLAGS.
XC
X2000 BRIEFF=.FALSE.
XC !LONG DESCRIPTIONS.
X SUPERF=.FALSE.
X CALL RSPEAK(327)
X RETURN
XC
XC V72-- SUPERBRIEF. SET FLAG.
XC
X3000 SUPERF=.TRUE.
X CALL RSPEAK(328)
X RETURN
XC
XC V73-- STAY (USED IN ENDGAME).
XC
X4000 IF(WINNER.NE.AMASTR) GO TO 4100
XC !TELL MASTER, STAY.
X CALL RSPEAK(781)
XC !HE DOES.
X CTICK(CEVFOL)=0
XC !NOT FOLLOWING.
X RETURN
XC
X4100 IF(WINNER.EQ.PLAYER) CALL RSPEAK(664)
XC !JOKE.
X RETURN
XC
XC V74-- VERSION. PRINT INFO.
XC
X#ifdef PDP
X5000 call prvers(vmaj,vmin,vedit)
X#else
X5000 WRITE(OUTCH,5010) VMAJ,VMIN,VEDIT
X5010 FORMAT(' V',I1,'.',I2,A1)
X#endif PDP
X TELFLG=.TRUE.
X RETURN
XC
XC V75-- SWIM. ALWAYS A JOKE.
XC
X6000 I=330
XC !ASSUME WATER.
X IF(and(RFLAG(HERE),(RWATER+RFILL)).EQ.0)
X& I=331+RND(3)
X CALL RSPEAK(I)
X RETURN
XC
XC V76-- GERONIMO. IF IN BARREL, FATAL, ELSE JOKE.
XC
X7000 IF(HERE.EQ.MBARR) GO TO 7100
XC !IN BARREL?
X CALL RSPEAK(334)
XC !NO, JOKE.
X RETURN
XC
X7100 CALL JIGSUP(335)
XC !OVER FALLS.
X RETURN
XC
XC V77-- SINBAD ET AL. CHASE CYCLOPS, ELSE JOKE.
XC
X8000 IF((HERE.EQ.MCYCL).AND.QHERE(CYCLO,HERE)) GO TO 8100
X CALL RSPEAK(336)
XC !NOT HERE, JOKE.
X RETURN
XC
X8100 CALL NEWSTA(CYCLO,337,0,0,0)
XC !CYCLOPS FLEES.
X CYCLOF=.TRUE.
XC !SET ALL FLAGS.
X MAGICF=.TRUE.
X OFLAG2(CYCLO)=and(OFLAG2(CYCLO), not(FITEBT))
X RETURN
XC
XC V78-- WELL. OPEN DOOR, ELSE JOKE.
XC
X9000 IF(RIDDLF.OR.(HERE.NE.RIDDL)) GO TO 9100
XC !IN RIDDLE ROOM?
X RIDDLF=.TRUE.
XC !YES, SOLVED IT.
X CALL RSPEAK(338)
X RETURN
XC
X9100 CALL RSPEAK(339)
XC !WELL, WHAT?
X RETURN
XC
XC V79-- PRAY. IF IN TEMP2, POOF
XC !
XC
X10000 IF(HERE.NE.TEMP2) GO TO 10050
XC !IN TEMPLE?
X IF(MOVETO(FORE1,WINNER)) GO TO 10100
XC !FORE1 STILL THERE?
X10050 CALL RSPEAK(340)
XC !JOKE.
X RETURN
XC
X10100 F=RMDESC(3)
XC !MOVED, DESCRIBE.
X RETURN
XC
XC V80-- TREASURE. IF IN TEMP1, POOF
XC !
XC
X11000 IF(HERE.NE.TEMP1) GO TO 11050
XC !IN TEMPLE?
X IF(MOVETO(TREAS,WINNER)) GO TO 10100
XC !TREASURE ROOM THERE?
X11050 CALL RSPEAK(341)
XC !NOTHING HAPPENS.
X RETURN
XC
XC V81-- TEMPLE. IF IN TREAS, POOF
XC !
XC
X12000 IF(HERE.NE.TREAS) GO TO 12050
XC !IN TREASURE?
X IF(MOVETO(TEMP1,WINNER)) GO TO 10100
XC !TEMP1 STILL THERE?
X12050 CALL RSPEAK(341)
XC !NOTHING HAPPENS.
X RETURN
XC
XC V82-- BLAST. USUALLY A JOKE.
XC
X13000 I=342
XC !DONT UNDERSTAND.
X IF(PRSO.EQ.SAFE) I=252
XC !JOKE FOR SAFE.
X CALL RSPEAK(I)
X RETURN
XC
XC V83-- SCORE. PRINT SCORE.
XC
X14000 CALL SCORE(.FALSE.)
X RETURN
XC
XC V84-- QUIT. FINISH OUT THE GAME.
XC
X15000 CALL SCORE(.TRUE.)
XC !TELLL SCORE.
X IF(.NOT.YESNO(343,0,0)) RETURN
XC !ASK FOR Y/N DECISION.
X#ifdef PDP
XC close routine moved to exit for pdp version
X#else
X CLOSE (DBCH)
X#endif PDP
X CALL EXIT
XC !BYE.
XC SVERBS, PAGE 4
XC
XC V85-- FOLLOW (USED IN ENDGAME)
XC
X16000 IF(WINNER.NE.AMASTR) RETURN
XC !TELL MASTER, FOLLOW.
X CALL RSPEAK(782)
X CTICK(CEVFOL)=-1
XC !STARTS FOLLOWING.
X RETURN
XC
XC V86-- WALK THROUGH
XC
X17000 IF((SCOLRM.EQ.0).OR.((PRSO.NE.SCOL).AND.
X& ((PRSO.NE.WNORT).OR.(HERE.NE.BKBOX)))) GO TO 17100
X SCOLAC=SCOLRM
XC !WALKED THRU SCOL.
X PRSO=0
XC !FAKE OUT FROMDR.
X CTICK(CEVSCL)=6
XC !START ALARM.
X CALL RSPEAK(668)
XC !DISORIENT HIM.
X F=MOVETO(SCOLRM,WINNER)
XC !INTO ROOM.
X F=RMDESC(3)
XC !DESCRIBE.
X RETURN
XC
X17100 IF(HERE.NE.SCOLAC) GO TO 17300
XC !ON OTHER SIDE OF SCOL?
X DO 17200 I=1,12,3
XC !WALK THRU PROPER WALL?
X IF((SCOLWL(I).EQ.HERE).AND.(SCOLWL(I+1).EQ.PRSO))
X& GO TO 17500
X17200 CONTINUE
XC
X17300 IF(and(OFLAG1(PRSO),TAKEBT).NE.0) GO TO 17400
X I=669
XC !NO, JOKE.
X IF(PRSO.EQ.SCOL) I=670
XC !SPECIAL JOKE FOR SCOL.
X CALL RSPSUB(I,ODO2)
X RETURN
XC
X17400 I=671
XC !JOKE.
X IF(OROOM(PRSO).NE.0) I=552+RND(5)
XC !SPECIAL JOKES IF CARRY.
X CALL RSPEAK(I)
X RETURN
XC
X17500 PRSO=SCOLWL(I+2)
XC !THRU SCOL WALL...
X DO 17600 I=1,8,2
XC !FIND MATCHING ROOM.
X IF(PRSO.EQ.SCOLDR(I)) SCOLRM=SCOLDR(I+1)
X17600 CONTINUE
XC !DECLARE NEW SCOLRM.
X CTICK(CEVSCL)=0
XC !CANCEL ALARM.
X CALL RSPEAK(668)
XC !DISORIENT HIM.
X F=MOVETO(BKBOX,WINNER)
XC !BACK IN BOX ROOM.
X F=RMDESC(3)
X RETURN
XC
XC V87-- RING. A JOKE.
XC
X18000 I=359
XC !CANT RING.
X IF(PRSO.EQ.BELL) I=360
XC !DING, DONG.
X CALL RSPEAK(I)
XC !JOKE.
X RETURN
XC
XC V88-- BRUSH. JOKE WITH OBSCURE TRAP.
XC
X19000 IF(PRSO.EQ.TEETH) GO TO 19100
XC !BRUSH TEETH?
X CALL RSPEAK(362)
XC !NO, JOKE.
X RETURN
XC
X19100 IF(PRSI.NE.0) GO TO 19200
XC !WITH SOMETHING?
X CALL RSPEAK(363)
XC !NO, JOKE.
X RETURN
XC
X19200 IF((PRSI.EQ.PUTTY).AND.(OADV(PUTTY).EQ.WINNER))
X& GO TO 19300
X CALL RSPSUB(364,ODI2)
XC !NO, JOKE.
X RETURN
XC
X19300 CALL JIGSUP(365)
XC !YES, DEAD
XC !
XC !
XC !
XC !
XC !
X RETURN
XC SVERBS, PAGE 5
XC
XC V89-- DIG. UNLESS SHOVEL, A JOKE.
XC
X20000 IF(PRSO.EQ.SHOVE) RETURN
XC !SHOVEL?
X I=392
XC !ASSUME TOOL.
X IF(and(OFLAG1(PRSO),TOOLBT).EQ.0) I=393
X CALL RSPSUB(I,ODO2)
X RETURN
XC
XC V90-- TIME. PRINT OUT DURATION OF GAME.
XC
X#ifdef PDP
XC no duration time available for pdp version (removed
XC to make things fit)
X21000 TELFLG=.TRUE.
X RETURN
X#else
X21000 CALL GTTIME(K)
XC !GET PLAY TIME.
X I=K/60
X J=MOD(K,60)
XC
X WRITE(OUTCH,21010)
X IF(I.NE.0) WRITE(OUTCH,21011) I
X IF(I.GE.2) WRITE(OUTCH,21012)
X IF(I.EQ.1) WRITE(OUTCH,21013)
X IF(J.EQ.1) WRITE(OUTCH,21014) J
X IF(J.NE.1) WRITE(OUTCH,21015) J
X TELFLG=.TRUE.
X RETURN
XC
X21010 FORMAT(' You have been playing Dungeon for ',$)
X21011 FORMAT('+',I3,' hour',$)
X21012 FORMAT('+s and ',$)
X21013 FORMAT('+ and ',$)
X21014 FORMAT('+',I2,' minute.')
X21015 FORMAT('+',I2,' minutes.')
X#endif PDP
XC
XC V91-- LEAP. USUALLY A JOKE, WITH A CATCH.
XC
X22000 IF(PRSO.EQ.0) GO TO 22200
XC !OVER SOMETHING?
X IF(QHERE(PRSO,HERE)) GO TO 22100
XC !HERE?
X CALL RSPEAK(447)
XC !NO, JOKE.
X RETURN
XC
X22100 IF(and(OFLAG2(PRSO),VILLBT).EQ.0) GO TO 22300
X CALL RSPSUB(448,ODO2)
XC !CANT JUMP VILLAIN.
X RETURN
XC
X22200 IF(.NOT.FINDXT(XDOWN,HERE)) GO TO 22300
XC !DOWN EXIT?
X IF((XTYPE.EQ.XNO).OR.((XTYPE.EQ.XCOND).AND.
X& .NOT.FLAGS(XFLAG))) GO TO 22400
X22300 CALL RSPEAK(314+RND(5))
XC !WHEEEE
XC !
X RETURN
XC
X22400 CALL JIGSUP(449+RND(4))
XC !FATAL LEAP.
X RETURN
XC SVERBS, PAGE 6
XC
XC V92-- LOCK.
XC
X23000 IF((PRSO.EQ.GRATE).AND.(HERE.EQ.MGRAT))
X& GO TO 23200
X23100 CALL RSPEAK(464)
XC !NOT LOCK GRATE.
X RETURN
XC
X23200 GRUNLF=.FALSE.
XC !GRATE NOW LOCKED.
X CALL RSPEAK(214)
X TRAVEL(REXIT(HERE)+1)=214
XC !CHANGE EXIT STATUS.
X RETURN
XC
XC V93-- UNLOCK
XC
X24000 IF((PRSO.NE.GRATE).OR.(HERE.NE.MGRAT))
X& GO TO 23100
X IF(PRSI.EQ.KEYS) GO TO 24200
XC !GOT KEYS?
X CALL RSPSUB(465,ODI2)
XC !NO, JOKE.
X RETURN
XC
X24200 GRUNLF=.TRUE.
XC !UNLOCK GRATE.
X CALL RSPEAK(217)
X TRAVEL(REXIT(HERE)+1)=217
XC !CHANGE EXIT STATUS.
X RETURN
XC
XC V94-- DIAGNOSE.
XC
X25000 I=FIGHTS(WINNER,.FALSE.)
XC !GET FIGHTS STRENGTH.
X J=ASTREN(WINNER)
XC !GET HEALTH.
X K=MIN0(I+J,4)
XC !GET STATE.
X IF(.NOT.CFLAG(CEVCUR)) J=0
XC !IF NO WOUNDS.
X L=MIN0(4,IABS(J))
XC !SCALE.
X CALL RSPEAK(473+L)
XC !DESCRIBE HEALTH.
X I=(30*(-J-1))+CTICK(CEVCUR)
XC !COMPUTE WAIT.
XC
X#ifdef PDP
X if(J .ne. 0) call cured(I)
X#else
X IF(J.NE.0) WRITE(OUTCH,25100) I
X25100 FORMAT(' You will be cured after ',I3,' moves.')
X#endif PDP
XC
X CALL RSPEAK(478+K)
XC !HOW MUCH MORE?
X IF(DEATHS.NE.0) CALL RSPEAK(482+DEATHS)
XC !HOW MANY DEATHS?
X RETURN
XC SVERBS, PAGE 7
XC
XC V95-- INCANT
XC
X26000 DO 26100 I=1,6
XC !SET UP PARSE.
X P1(I)=' '
X P2(I)=' '
X26100 CONTINUE
X WP=1
XC !WORD POINTER.
X CP=1
XC !CHAR POINTER.
X IF(PRSCON.LE.1) GO TO 26300
X DO 26200 I=PRSCON,INLNT
XC !PARSE INPUT
X IF(INBUF(I).EQ.',') GO TO 26300
XC !END OF PHRASE?
X IF(INBUF(I).NE.' ') GO TO 26150
XC !SPACE?
X IF(CP.NE.1) WP=WP+1
X CP=1
X GO TO 26200
X26150 IF(WP.EQ.1) P1(CP)=INBUF(I)
XC !STUFF INTO HOLDER.
X IF(WP.EQ.2) P2(CP)=INBUF(I)
X CP=MIN0(CP+1,6)
X26200 CONTINUE
XC
X26300 PRSCON=1
XC !KILL REST OF LINE.
X IF(P1(1).NE.' ') GO TO 26400
XC !ANY INPUT?
X CALL RSPEAK(856)
XC !NO, HO HUM.
X RETURN
XC
X26400 CALL ENCRYP(P1,CH)
XC !COMPUTE RESPONSE.
X IF(P2(1).NE.' ') GO TO 26600
XC !TWO PHRASES?
XC
X IF(SPELLF) GO TO 26550
XC !HE'S TRYING TO LEARN.
X IF(and(RFLAG(TSTRS),RSEEN).EQ.0) GO TO 26575
X SPELLF=.TRUE.
XC !TELL HIM.
X TELFLG=.TRUE.
X#ifdef PDP
X call voice(P1,CH)
X#else
X WRITE(OUTCH,26510) P1,CH
X26510 FORMAT(' A hollow voice replies: "',6A1,1X,6A1,'".')
X#endif PDP
XC
X RETURN
XC
X26550 CALL RSPEAK(857)
XC !HE'S GOT ONE ALREADY.
X RETURN
XC
X26575 CALL RSPEAK(858)
XC !HE'S NOT IN ENDGAME.
X RETURN
XC
X26600 IF(and(RFLAG(TSTRS),RSEEN).NE.0) GO TO 26800
X DO 26700 I=1,6
X IF(P2(I).NE.CH(I)) GO TO 26575
XC !WRONG.
X26700 CONTINUE
X SPELLF=.TRUE.
XC !IT WORKS.
X CALL RSPEAK(859)
X CTICK(CEVSTE)=1
XC !FORCE START.
X RETURN
XC
X26800 CALL RSPEAK(855)
XC !TOO LATE.
X RETURN
XC SVERBS, PAGE 8
XC
XC V96-- ANSWER
XC
X27000 IF((PRSCON.GT.1).AND.
X& (HERE.EQ.FDOOR).AND.INQSTF)
X& GO TO 27100
X CALL RSPEAK(799)
XC !NO ONE LISTENS.
X PRSCON=1
X RETURN
XC
X27100 K=1
XC !POINTER INTO ANSSTR.
X DO 27300 J=1,28,2
XC !CHECK ANSWERS.
X NEWK=K+ANSWER(J+1)
XC !COMPUTE NEXT K.
X IF(QUESNO.NE.ANSWER(J)) GO TO 27300
XC !ONLY CHECK PROPER ANS.
X I=PRSCON-1
XC !SCAN ANSWER.
X DO 27200 L=K,NEWK-1
X27150 I=I+1
XC !SKIP INPUT BLANKS.
X IF(I.GT.INLNT) GO TO 27300
XC !END OF INPUT? LOSE.
X IF(INBUF(I).EQ.' ') GO TO 27150
X IF(INBUF(I).NE.ANSSTR(L)) GO TO 27300
X27200 CONTINUE
X GO TO 27500
XC !RIGHT ANSWER.
X27300 K=NEWK
XC
X PRSCON=1
XC !KILL REST OF LINE.
X NQATT=NQATT+1
XC !WRONG, CRETIN.
X IF(NQATT.GE.5) GO TO 27400
XC !TOO MANY WRONG?
X CALL RSPEAK(800+NQATT)
XC !NO, TRY AGAIN.
X RETURN
XC
X27400 CALL RSPEAK(826)
XC !ALL OVER.
X CFLAG(CEVINQ)=.FALSE.
XC !LOSE.
X RETURN
XC
X27500 PRSCON=1
XC !KILL REST OF LINE.
X CORRCT=CORRCT+1
XC !GOT IT RIGHT.
X CALL RSPEAK(800)
XC !HOORAY.
X IF(CORRCT.GE.3) GO TO 27600
XC !WON TOTALLY?
X CTICK(CEVINQ)=2
XC !NO, START AGAIN.
X QUESNO=MOD(QUESNO+3,8)
X NQATT=0
X CALL RSPEAK(769)
XC !ASK NEXT QUESTION.
X CALL RSPEAK(770+QUESNO)
X RETURN
XC
X27600 CALL RSPEAK(827)
XC !QUIZ OVER,
X CFLAG(CEVINQ)=.FALSE.
X OFLAG2(QDOOR)=or(OFLAG2(QDOOR),OPENBT)
X RETURN
XC
X END
END_OF_sverbs.F
if test 13200 -ne `wc -c <sverbs.F`; then
echo shar: \"sverbs.F\" unpacked with wrong size!
fi
# end of overwriting check
fi
echo shar: End of archive 4 \(of 7\).
cp /dev/null ark4isdone
MISSING=""
for I in 1 2 3 4 5 6 7 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have unpacked all 7 archives.
rm -f ark[1-9]isdone
else
echo You still need to unpack the following archives:
echo " " ${MISSING}
fi
## End of shell archive.
exit 0