From mipos3!omepd!intelisc!littlei!reed!tektronix!tekgen!tekred!games-request Thu Sep 3 07:17:03 PDT 1987 Article 88 of comp.sources.games: Path: td2cad!mipos3!omepd!intelisc!littlei!reed!tektronix!tekgen!tekred!games-request From: games-request@tekred.TEK.COM Newsgroups: comp.sources.games Subject: v02i035: dungeon - game of adventure, Part02/14 Message-ID: <1558@tekred.TEK.COM> Date: 1 Sep 87 18:49:33 GMT Sender: billr@tekred.TEK.COM Lines: 2157 Approved: billr@tekred.TEK.COM Submitted by: Bill Randle Comp.sources.games: Volume 2, Issue 35 Archive-name: dungeon/Part02 #! /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 clockr.F <<'END_OF_clockr.F' XC CEVAPP- CLOCK EVENT APPLICABLES 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 CEVAPP(RI) X IMPLICIT INTEGER (A-Z) X INTEGER CNDTCK(10),LMPTCK(12) X LOGICAL FINDXT,LIT,RMDESC,QOPEN,MOVETO X LOGICAL F,QLEDGE,QVAIR,QHERE,PROB X#include "gamestate.h" X#include "state.h" 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#include "curxt.h" X#include "xsrch.h" X#include "villians.h" X#include "advers.h" X#include "flags.h" XC XC FUNCTIONS AND DATA XC X QOPEN(R)=(and(OFLAG2(R),OPENBT)).NE.0 X QLEDGE(R)=(R.EQ.LEDG2).OR.(R.EQ.LEDG3).OR.(R.EQ.LEDG4).OR. X& (R.EQ.VLBOT) X QVAIR(R)=(R.EQ.VAIR1).OR.(R.EQ.VAIR2).OR.(R.EQ.VAIR3).OR. X& (R.EQ.VAIR4) X DATA CNDTCK/50,20,10,5,0,156,156,156,157,0/ X DATA LMPTCK/50,30,20,10,4,0,154,154,154,154,155,0/ XC CEVAPP, PAGE 2 XC X IF(RI.EQ.0) RETURN XC !IGNORE DISABLED. X GO TO (1000,2000,3000,4000,5000,6000,7000,8000,9000,10000, X& 11000,12000,13000,14000,15000,16000,17000,18000,19000, X& 20000,21000,22000,23000,24000),RI X CALL BUG(3,RI) XC XC CEV1-- CURE CLOCK. LET PLAYER SLOWLY RECOVER. XC X1000 ASTREN(PLAYER)=MIN0(0,ASTREN(PLAYER)+1) XC !RECOVER. X IF(ASTREN(PLAYER).GE.0) RETURN XC !FULLY RECOVERED? X CTICK(CEVCUR)=30 XC !NO, WAIT SOME MORE. X RETURN XC XC CEV2-- MAINT-ROOM WITH LEAK. RAISE THE WATER LEVEL. XC X2000 IF(HERE.EQ.MAINT) CALL RSPEAK(71+(RVMNT/2)) XC !DESCRIBE. X RVMNT=RVMNT+1 XC !RAISE WATER LEVEL. X IF(RVMNT.LE.16) RETURN XC !IF NOT FULL, EXIT. X CTICK(CEVMNT)=0 XC !FULL, DISABLE CLOCK. X RFLAG(MAINT)=or(RFLAG(MAINT),RMUNG) X RRAND(MAINT)=80 XC !SAY IT IS FULL OF WATER. X IF(HERE.EQ.MAINT) CALL JIGSUP(81) XC !DROWN HIM IF PRESENT. X RETURN XC XC CEV3-- LANTERN. DESCRIBE GROWING DIMNESS. XC X3000 CALL LITINT(LAMP,ORLAMP,CEVLNT,LMPTCK,12) XC !DO LIGHT INTERRUPT. X RETURN XC XC CEV4-- MATCH. OUT IT GOES. XC X4000 CALL RSPEAK(153) XC !MATCH IS OUT. X OFLAG1(MATCH)=and(OFLAG1(MATCH), not(ONBT)) X RETURN XC XC CEV5-- CANDLE. DESCRIBE GROWING DIMNESS. XC X5000 CALL LITINT(CANDL,ORCAND,CEVCND,CNDTCK,10) XC !DO CANDLE INTERRUPT. X RETURN XC CEVAPP, PAGE 3 XC XC CEV6-- BALLOON XC X6000 CTICK(CEVBAL)=3 XC !RESCHEDULE INTERRUPT. X F=AVEHIC(WINNER).EQ.BALLO XC !SEE IF IN BALLOON. X IF(BLOC.EQ.VLBOT) GO TO 6800 XC !AT BOTTOM? X IF(QLEDGE(BLOC)) GO TO 6700 XC !ON LEDGE? X IF(QOPEN(RECEP).AND.(BINFF.NE.0)) X& GO TO 6500 XC XC BALLOON IS IN MIDAIR AND IS DEFLATED (OR HAS RECEPTACLE CLOSED). XC FALL TO NEXT ROOM. XC X IF(BLOC.NE.VAIR1) GO TO 6300 XC !IN VAIR1? X BLOC=VLBOT XC !YES, NOW AT VLBOT. X CALL NEWSTA(BALLO,0,BLOC,0,0) X IF(F) GO TO 6200 XC !IN BALLOON? X IF(QLEDGE(HERE)) CALL RSPEAK(530) XC !ON LEDGE, DESCRIBE. X RETURN XC X6200 F=MOVETO(BLOC,WINNER) XC !MOVE HIM. X IF(BINFF.EQ.0) GO TO 6250 XC !IN BALLOON. INFLATED? X CALL RSPEAK(531) XC !YES, LANDED. X F=RMDESC(0) XC !DESCRIBE. X RETURN XC X6250 CALL NEWSTA(BALLO,532,0,0,0) XC !NO, BALLOON & CONTENTS DIE. X CALL NEWSTA(DBALL,0,BLOC,0,0) XC !INSERT DEAD BALLOON. X AVEHIC(WINNER)=0 XC !NOT IN VEHICLE. X CFLAG(CEVBAL)=.FALSE. XC !DISABLE INTERRUPTS. X CFLAG(CEVBRN)=.FALSE. X BINFF=0 X BTIEF=0 X RETURN XC X6300 BLOC=BLOC-1 XC !NOT IN VAIR1, DESCEND. X CALL NEWSTA(BALLO,0,BLOC,0,0) X IF(F) GO TO 6400 XC !IS HE IN BALLOON? X IF(QLEDGE(HERE)) CALL RSPEAK(533) XC !IF ON LEDGE, DESCRIBE. X RETURN XC X6400 F=MOVETO(BLOC,WINNER) XC !IN BALLOON, MOVE HIM. X CALL RSPEAK(534) XC !DESCRIBE. X F=RMDESC(0) X RETURN XC XC BALLOON IS IN MIDAIR AND IS INFLATED, UP-UP-AND-AWAY XC ! XC X6500 IF(BLOC.NE.VAIR4) GO TO 6600 XC !AT VAIR4? X CTICK(CEVBRN)=0 X CTICK(CEVBAL)=0 X BINFF=0 X BTIEF=0 X BLOC=VLBOT XC !FALL TO BOTTOM. X CALL NEWSTA(BALLO,0,0,0,0) XC !BALLOON & CONTENTS DIE. X CALL NEWSTA(DBALL,0,BLOC,0,0) XC !SUBSTITUTE DEAD BALLOON. X IF(F) GO TO 6550 XC !WAS HE IN IT? X IF(QLEDGE(HERE)) CALL RSPEAK(535) XC !IF HE CAN SEE, DESCRIBE. X RETURN XC X6550 CALL JIGSUP(536) XC !IN BALLOON AT CRASH, DIE. X RETURN XC X6600 BLOC=BLOC+1 XC !NOT AT VAIR4, GO UP. X CALL NEWSTA(BALLO,0,BLOC,0,0) X IF(F) GO TO 6650 XC !IN BALLOON? X IF(QLEDGE(HERE)) CALL RSPEAK(537) XC !CAN HE SEE IT? X RETURN XC X6650 F=MOVETO(BLOC,WINNER) XC !MOVE PLAYER. X CALL RSPEAK(538) XC !DESCRIBE. X F=RMDESC(0) X RETURN XC XC ON LEDGE, GOES TO MIDAIR ROOM WHETHER INFLATED OR NOT. XC X6700 BLOC=BLOC+(VAIR2-LEDG2) XC !MOVE TO MIDAIR. X CALL NEWSTA(BALLO,0,BLOC,0,0) X IF(F) GO TO 6750 XC !IN BALLOON? X IF(QLEDGE(HERE)) CALL RSPEAK(539) XC !NO, STRANDED. X CTICK(CEVVLG)=10 XC !MATERIALIZE GNOME. X RETURN XC X6750 F=MOVETO(BLOC,WINNER) XC !MOVE TO NEW ROOM. X CALL RSPEAK(540) XC !DESCRIBE. X F=RMDESC(0) X RETURN XC XC AT BOTTOM, GO UP IF INFLATED, DO NOTHING IF DEFLATED. XC X6800 IF((BINFF.EQ.0).OR..NOT.QOPEN(RECEP)) RETURN X BLOC=VAIR1 XC !INFLATED AND OPEN, X CALL NEWSTA(BALLO,0,BLOC,0,0) XC !GO UP TO VAIR1. X IF(F) GO TO 6850 XC !IN BALLOON? X IF(QLEDGE(HERE)) CALL RSPEAK(541) XC !IF CAN SEE, DESCRIBE. X RETURN XC X6850 F=MOVETO(BLOC,WINNER) XC !MOVE PLAYER. X CALL RSPEAK(542) X F=RMDESC(0) X RETURN XC CEVAPP, PAGE 4 XC XC CEV7-- BALLOON BURNUP XC X7000 DO 7100 I=1,OLNT XC !FIND BURNING OBJECT X IF((RECEP.EQ.OCAN(I)).AND.((and(OFLAG1(I),FLAMBT)).NE.0)) X& GO TO 7200 X7100 CONTINUE X CALL BUG(4,0) XC X7200 CALL NEWSTA(I,0,0,0,0) XC !VANISH OBJECT. X BINFF=0 XC !UNINFLATED. X IF(HERE.EQ.BLOC) CALL RSPSUB(292,ODESC2(I)) XC !DESCRIBE. X RETURN XC XC CEV8-- FUSE FUNCTION XC X8000 IF(OCAN(FUSE).NE.BRICK) GO TO 8500 XC !IGNITED BRICK? X BR=OROOM(BRICK) XC !GET BRICK ROOM. X BC=OCAN(BRICK) XC !GET CONTAINER. X IF((BR.EQ.0).AND.(BC.NE.0)) BR=OROOM(BC) X CALL NEWSTA(FUSE,0,0,0,0) XC !KILL FUSE. X CALL NEWSTA(BRICK,0,0,0,0) XC !KILL BRICK. X IF((BR.NE.0).AND.(BR.NE.HERE)) GO TO 8100 XC !BRICK ELSEWHERE? XC X RFLAG(HERE)=or(RFLAG(HERE),RMUNG) X RRAND(HERE)=114 XC !MUNG ROOM. X CALL JIGSUP(150) XC !DEAD. X RETURN XC X8100 CALL RSPEAK(151) XC !BOOM. X MUNGRM=BR XC !SAVE ROOM THAT BLEW. X CTICK(CEVSAF)=5 XC !SET SAFE INTERRUPT. X IF(BR.NE.MSAFE) GO TO 8200 XC !BLEW SAFE ROOM? X IF(BC.NE.SSLOT) RETURN XC !WAS BRICK IN SAFE? X CALL NEWSTA(SSLOT,0,0,0,0) XC !KILL SLOT. X OFLAG2(SAFE)=or(OFLAG2(SAFE),OPENBT) X SAFEF=.TRUE. XC !INDICATE SAFE BLOWN. X RETURN XC X8200 DO 8250 I=1,OLNT XC !BLEW WRONG ROOM. X IF(QHERE(I,BR) .AND. ((and(OFLAG1(I),TAKEBT)).NE.0)) X& CALL NEWSTA(I,0,0,0,0) X8250 CONTINUE X IF(BR.NE.LROOM) RETURN XC !BLEW LIVING ROOM? X DO 8300 I=1,OLNT X IF(OCAN(I).EQ.TCASE) CALL NEWSTA(I,0,0,0,0) XC !KILL TROPHY CASE. X8300 CONTINUE X RETURN XC X8500 IF(QHERE(FUSE,HERE).OR.(OADV(FUSE).EQ.WINNER)) X& CALL RSPEAK(152) X CALL NEWSTA(FUSE,0,0,0,0) XC !KILL FUSE. X RETURN XC CEVAPP, PAGE 5 XC XC CEV9-- LEDGE MUNGE. XC X9000 RFLAG(LEDG4)=or(RFLAG(LEDG4),RMUNG) X RRAND(LEDG4)=109 X IF(HERE.EQ.LEDG4) GO TO 9100 XC !WAS HE THERE? X CALL RSPEAK(110) XC !NO, NARROW ESCAPE. X RETURN XC X9100 IF(AVEHIC(WINNER).NE.0) GO TO 9200 XC !IN VEHICLE? X CALL JIGSUP(111) XC !NO, DEAD. X RETURN XC X9200 IF(BTIEF.NE.0) GO TO 9300 XC !TIED TO LEDGE? X CALL RSPEAK(112) XC !NO, NO PLACE TO LAND. X RETURN XC X9300 BLOC=VLBOT XC !YES, CRASH BALLOON. X CALL NEWSTA(BALLO,0,0,0,0) XC !BALLOON & CONTENTS DIE. X CALL NEWSTA(DBALL,0,BLOC,0,0) XC !INSERT DEAD BALLOON. X BTIEF=0 X BINFF=0 X CFLAG(CEVBAL)=.FALSE. X CFLAG(CEVBRN)=.FALSE. X CALL JIGSUP(113) XC !DEAD X RETURN XC XC CEV10-- SAFE MUNG. XC X10000 RFLAG(MUNGRM)=or(RFLAG(MUNGRM),RMUNG) X RRAND(MUNGRM)=114 X IF(HERE.EQ.MUNGRM) GO TO 10100 XC !IS HE PRESENT? X CALL RSPEAK(115) XC !LET HIM KNOW. X IF(MUNGRM.EQ.MSAFE) CTICK(CEVLED)=8 XC !START LEDGE CLOCK. X RETURN XC X10100 I=116 XC !HE'S DEAD, X IF((and(RFLAG(HERE),RHOUSE)).NE.0) I=117 X CALL JIGSUP(I) XC !LET HIM KNOW. X RETURN XC CEVAPP, PAGE 6 XC XC CEV11-- VOLCANO GNOME XC X11000 IF(QLEDGE(HERE)) GO TO 11100 XC !IS HE ON LEDGE? X CTICK(CEVVLG)=1 XC !NO, WAIT A WHILE. X RETURN XC X11100 CALL NEWSTA(GNOME,118,HERE,0,0) XC !YES, MATERIALIZE GNOME. X RETURN XC XC CEV12-- VOLCANO GNOME DISAPPEARS XC X12000 CALL NEWSTA(GNOME,149,0,0,0) XC !DISAPPEAR THE GNOME. X RETURN XC XC CEV13-- BUCKET. XC X13000 IF(OCAN(WATER).EQ.BUCKE) X& CALL NEWSTA(WATER,0,0,0,0) X RETURN XC XC CEV14-- SPHERE. IF EXPIRES, HE'S TRAPPED. XC X14000 RFLAG(CAGER)=or(RFLAG(CAGER),RMUNG) X RRAND(CAGER)=147 X CALL JIGSUP(148) XC !MUNG PLAYER. X RETURN XC XC CEV15-- END GAME HERALD. XC X15000 ENDGMF=.TRUE. XC !WE'RE IN ENDGAME. X CALL RSPEAK(119) XC !INFORM OF ENDGAME. X RETURN XC CEVAPP, PAGE 7 XC XC CEV16-- FOREST MURMURS XC X16000 CFLAG(CEVFOR)=(HERE.EQ.MTREE).OR. X& ((HERE.GE.FORE1).AND.(HERE.LT.CLEAR)) X IF(CFLAG(CEVFOR).AND.PROB(10,10)) CALL RSPEAK(635) X RETURN XC XC CEV17-- SCOL ALARM XC X17000 IF(HERE.EQ.BKTWI) CFLAG(CEVZGI)=.TRUE. XC !IF IN TWI, GNOME. X IF(HERE.EQ.BKVAU) CALL JIGSUP(636) XC !IF IN VAU, DEAD. X RETURN XC XC CEV18-- ENTER GNOME OF ZURICH XC X18000 CFLAG(CEVZGO)=.TRUE. XC !EXITS, TOO. X CALL NEWSTA(ZGNOM,0,BKTWI,0,0) XC !PLACE IN TWI. X IF(HERE.EQ.BKTWI) CALL RSPEAK(637) XC !ANNOUNCE. X RETURN XC XC CEV19-- EXIT GNOME XC X19000 CALL NEWSTA(ZGNOM,0,0,0,0) XC !VANISH. X IF(HERE.EQ.BKTWI) CALL RSPEAK(638) XC !ANNOUNCE. X RETURN XC CEVAPP, PAGE 8 XC XC CEV20-- START OF ENDGAME XC X20000 IF(SPELLF) GO TO 20200 XC !SPELL HIS WAY IN? X IF(HERE.NE.CRYPT) RETURN XC !NO, STILL IN TOMB? X IF(.NOT.LIT(HERE)) GO TO 20100 XC !LIGHTS OFF? X CTICK(CEVSTE)=3 XC !RESCHEDULE. X RETURN XC X20100 CALL RSPEAK(727) XC !ANNOUNCE. X20200 DO 20300 I=1,OLNT XC !STRIP HIM OF OBJS. X CALL NEWSTA(I,0,OROOM(I),OCAN(I),0) X20300 CONTINUE X CALL NEWSTA(LAMP,0,0,0,PLAYER) XC !GIVE HIM LAMP. X CALL NEWSTA(SWORD,0,0,0,PLAYER) XC !GIVE HIM SWORD. XC X OFLAG1(LAMP)=and((or(OFLAG1(LAMP),LITEBT)), not(ONBT)) X OFLAG2(LAMP)=or(OFLAG2(LAMP),TCHBT) X CFLAG(CEVLNT)=.FALSE. XC !LAMP IS GOOD AS NEW. X CTICK(CEVLNT)=350 X ORLAMP=0 X OFLAG2(SWORD)=or(OFLAG2(SWORD),TCHBT) X SWDACT=.TRUE. X SWDSTA=0 XC X THFACT=.FALSE. XC !THIEF GONE. X ENDGMF=.TRUE. XC !ENDGAME RUNNING. X CFLAG(CEVMAT)=.FALSE. XC !MATCHES GONE, X CFLAG(CEVCND)=.FALSE. XC !CANDLES GONE. XC X CALL SCRUPD(RVAL(CRYPT)) XC !SCORE CRYPT, X RVAL(CRYPT)=0 XC !BUT ONLY ONCE. X F=MOVETO(TSTRS,WINNER) XC !TO TOP OF STAIRS, X F=RMDESC(3) XC !AND DESCRIBE. X RETURN XC !BAM XC ! XC XC CEV21-- MIRROR CLOSES. XC X21000 MRPSHF=.FALSE. XC !BUTTON IS OUT. X MROPNF=.FALSE. XC !MIRROR IS CLOSED. X IF(HERE.EQ.MRANT) CALL RSPEAK(728) XC !DESCRIBE BUTTON. X IF((HERE.EQ.INMIR).OR.(MRHERE(HERE).EQ.1)) X& CALL RSPEAK(729) X RETURN XC CEVAPP, PAGE 9 XC XC CEV22-- DOOR CLOSES. XC X22000 IF(WDOPNF) CALL RSPEAK(730) XC !DESCRIBE. X WDOPNF=.FALSE. XC !CLOSED. X RETURN XC XC CEV23-- INQUISITOR'S QUESTION XC X23000 IF(AROOM(PLAYER).NE.FDOOR) RETURN XC !IF PLAYER LEFT, DIE. X CALL RSPEAK(769) X CALL RSPEAK(770+QUESNO) X CTICK(CEVINQ)=2 X RETURN XC XC CEV24-- MASTER FOLLOWS XC X24000 IF(AROOM(AMASTR).EQ.HERE) RETURN XC !NO MOVEMENT, DONE. X IF((HERE.NE.CELL).AND.(HERE.NE.PCELL)) GO TO 24100 X IF(FOLLWF) CALL RSPEAK(811) XC !WONT GO TO CELLS. X FOLLWF=.FALSE. X RETURN XC X24100 FOLLWF=.TRUE. XC !FOLLOWING. X I=812 XC !ASSUME CATCHES UP. X DO 24200 J=XMIN,XMAX,XMIN X IF(FINDXT(J,AROOM(AMASTR)).AND.(XROOM1.EQ.HERE)) X& I=813 X24200 CONTINUE X CALL RSPEAK(I) X CALL NEWSTA(MASTER,0,HERE,0,0) XC !MOVE MASTER OBJECT. X AROOM(AMASTR)=HERE XC !MOVE MASTER PLAYER. X RETURN XC X END XC LITINT- LIGHT INTERRUPT PROCESSOR XC XC DECLARATIONS XC X SUBROUTINE LITINT(OBJ,CTR,CEV,TICKS,TICKLN) X IMPLICIT INTEGER (A-Z) X INTEGER TICKS(TICKLN) X#include "gamestate.h" X#include "objects.h" X#include "oflags.h" X#include "clock.h" XC X CTR=CTR+1 XC !ADVANCE STATE CNTR. X CTICK(CEV)=TICKS(CTR) XC !RESET INTERRUPT. X IF(CTICK(CEV).NE.0) GO TO 100 XC !EXPIRED? X OFLAG1(OBJ)=and(OFLAG1(OBJ), not(LITEBT+FLAMBT+ONBT)) X IF((OROOM(OBJ).EQ.HERE).OR.(OADV(OBJ).EQ.WINNER)) X& CALL RSPSUB(293,ODESC2(OBJ)) X RETURN XC X100 IF((OROOM(OBJ).EQ.HERE).OR.(OADV(OBJ).EQ.WINNER)) X& CALL RSPEAK(TICKS(CTR+(TICKLN/2))) X RETURN XC X END END_OF_clockr.F if test 12197 -ne `wc -c dungeon.doc <<'END_OF_dungeon.doc' XTo: Dungeon Players XFrom: "The Translator" XSubj: Game Information XDate: 8-OCT-80, 6-dec-85 X X XThis is the first (and last) source release of the PDP-11 version of XDungeon. X XPlease note that Dungeon has been superceded by the game ZORK(tm). XThe following is an extract from the new product announcement for XZORK in the September, 1980 issue of the RT-11 SIG newsletter: X X "'ZORK: The Great Underground Empire - Part I' ...was developed X by the original authors based on their ZORK (Dungeon) game for X the PDP-10. It features a greatly improved parser; command X input and transcript output files; SAVEs to any device and X file name; and adaptation to different terminal types, X including a status line on VT100s. Note: this is not the X FORTRAN version that has been available through DECUS. This X version has been completely rewritten to run efficiently on X small machines - up to 10 times as fast as the DECUS version. X X ...ZORK runs under RT-ll, HT-ll, or RSTS/E and requires as X little as 20K words of memory and a single floppy disk drive. X The game package, consisting of an RX01-format diskette and X an instruction booklet, is available from Infocom, Inc., X P.O. Box 120, Kendall Station, Cambridge, Ma. 02142." X XZORK(tm) is a trademark of Infocom, Inc. It is available for several Xpopular personal computers as well as for the PDP-ll. X X X1. Components X XDungeon is a maze-solving game for solitaire play. It runs on any PDP-11 X(with 28KW of memory or more) or VAX-11. X XThe following compile and run information does not apply to the Xf77/Unix implementation. See the README file for information on Xcompilation. X XDungeon consists of the following files: X X X all operating systems X --------------------- X X DMAIN.FTN -program root X DGAME.FTN -main routine X DSUB.FTN -resident subroutines X DINIT.FTN -initialization routine X NP.FOR -parser, part 0 X NP1.FOR -parser, part 1 X NP2.FOR -parser, part 2 X NP3.FOR -parser, part 3 X GDT.FTN -game debugging tool X VERBS.FTN -principal verbs X OBJCTS.FTN -principal objects X SVERBS.FTN -simple verbs X DVERB1.FTN -auxiliary verbs, part 1 X DVERB2.FTN -auxiliary verbs, part 2 X all operating systems (continued) X --------------------------------- X X ACTORS.FTN -character processors X DEMONS.FTN -demon processors X CLOCKR.FTN -clock event processors X ROOMS.FOR -room processors X NROOMS.FOR -new room processors X SOBJS.FOR -simple objects X NOBJS.FOR -new objects X BALLOP.FOR -balloon processor X LIGHTP.FOR -light processors X VILLNS.FOR -villain processors X DSO1.FOR -overlaid subroutines, part 1 X DSO2.FOR -overlaid subroutines, part 2 X DSO3.FOR -overlaid subroutines, part 3 X DSO4.FOR -overlaid subroutines, part 4 X DSO5.FOR -overlaid subroutines, part 5 X DSO6.FOR -overlaid subroutines, part 6 X DSO7.FOR -overlaid subroutines, part 7 X DINDX.DAT -initialization data base X DTEXT.DAT -main data base [binary file] X DUNGEO.DOC -this file X X X RT11 only X --------- X X RTTIM.FOR -time subroutine X RRND.MAC -random number generator X RTCMP.COM -compile command file X RTBLD.COM -link command file X X X RSTS/E only X ----------- X X RTTIM.FOR -time subroutine X RRND.MAC -random number generator X RSTSCB.CTL -compile/build batch file X X X RSX11M, RSX11M+ only X -------------------- X X RSXTIM.MAC -time subroutine X RRND.MAC -random number generator X RSXCMP.CMD -compile command file X RSXBLD.CMD -task build command file X D.ODL -overlay descriptor file X X X VMS only X -------- X X VMSTIM.FOR -time subroutine X VMSRND.MAC -random number generator X VMSCMP.COM -compile command file X VMSBLD.COM -link command file X 2. Installation Instructions, RT11 X XBefore starting, please note that: X X - Dungeon requires RT11 V3 or later. X X - Dungeon requires Fortran-IV V2 or later, threaded code option. X X - Dungeon requires 26KW of user memory (runs under SJ monitor only). X X - All files (source and object) must reside on the same disk X (at least 2500 disk blocks are needed). X X - Dungeon does not require EIS or floating point. X XExcept for DTEXT.DAT, all files in the distribution kit are ASCII. XDTEXT.DAT is a binary file consisting of 76-byte fixed length records. XIf the distribution kit consists of RT11-compatible media, then PIP Xcan be used to transfer the files. If the distribution kit consists Xof DOS-compatible media, then FILEX must be used to transfer the files. XThe /I switch (image binary) must be used to transfer DTEXT.DAT; the X/A (ASCII) switch should be used to transfer the other files. X XTo compile Dungeon, issue the following command: X X .@RTCMP(cr) X XSeveral of the compilations will produce warning messages, but none Xshould produce a fatal error. X XTo link the compiled sources, issue the following command: X X .@RTBLD(cr) X XThe command file assumes that the Fortran-IV object time library has Xbeen merged into the system library. If this is not the case, edit XRTBLD.COM and add switch /LINKLIBRARY:FORLIB.OBJ to the first command Xline. X XIt is now possible to run Dungeon: X X .R DUNGEO(cr) X XWhen invoked, Dungeon takes no more than 5-10 seconds to start up. X XNotes on the executable program: X X - The only files needed to execute Dungeon are DUNGEO.SAV, X DINDX.DAT, and DTEXT.DAT. All other files can be deleted. X X - Files DINDX.DAT and DTEXT.DAT must reside on logical device SY: X (this can be changed with a source edit, see section 8). X 3. Installation Instructions, RSTS/E X XBefore starting, please note that: X X - Dungeon requires RSTS/E V6C or later. X X - Dungeon requires Fortran-IV V2 or later, threaded code option X (operation under Fortran-IV-Plus V2.5 or later will probably X work but is not supported). X X - Dungeon requires 28KW of user memory. X X - All files (source and object) must reside in the same user area X (at least 2500 disk blocks are needed). X X - Dungeon does not require EIS or floating point. X XExcept for DTEXT.DAT, all files in the distribution kit are ASCII. XDTEXT.DAT is a binary file consisting of 76-byte fixed length records. XIf the distribution kit consists of RT11- or DOS-compatible disks, Xthen FIT can be used to transfer the files. For example (RT11 disk): X X RUN $FIT(cr) X FIT>*.*/RSTS=DK:*.*/RT11(cr) X FIT>^Z X XIf the distribution kit consists of DOS-compatible magtape, then PIP Xcan be used to transfer the files, providing that the magtape is Xassigned as a DOS-label device. For example: X X ASSIGN MM0:.DOS(cr) X RUN $PIP(cr) X **.*/AS=MM:*.FTN,*.FOR,*.MAC,*.DOC,*.CTL(cr) X **.*/AS=MM:*.CMD,*.COM,*.ODL,DINDX.DAT(cr) X **.*/BL=MM:DTEXT.DAT(cr) X *^C X DEASS MM0:(cr) X XTo compile and link Dungeon, submit control file RSTSCB.CTL to the Xbatch processor: X X SUBMIT RSTSCB.CTL(cr) X XSeveral of the compilations will produce warning messages, but none Xshould produce a fatal error. X XIt is now possible to run Dungeon: X X RUN DUNGEO(cr) X XWhen invoked, Dungeon takes no more than 5-10 seconds to start up. X XNotes on the executable program: X X - The only files needed to execute Dungeon are DUNGEO.SAV, X DINDX.DAT, and DTEXT.DAT. All other files can be deleted. X X - Files DINDX.DAT and DTEXT.DAT must reside in the user's area on X logical device SY: (this can be changed with a source edit, see X section 8). X 4. Installation Instructions, RSX11M and RSX11M+ X XBefore starting, please note that: X X - Dungeon requires RSX11M V3 (RSX11M+ V1) or later. X X - Dungeon requires Fortran-IV-Plus V2.5 or later (operation under X Fortran-IV V2 or later will probably work but is not supported). X X - Dungeon requires a 32KW user partition (mapped systems only). X X - All files (source and object) must reside in the same user area X (at least 2500 disk blocks are needed). X X - TKB should invoke BIGTKB.TSK with a large memory increment. X X - The Fortran-IV-Plus object time library must be merged into X the system library (SYSLIB.OLB). Further, the library must X be set up to invoke the short error text module ($SHORT) as X the default. Task building with a separate object time library X produces numerous errors; task building with a resident library X or the normal error text module produces an oversize task image. X X - Dungeon requires EIS but not floating point. X XExcept for DTEXT.DAT, all files in the distribution kit are ASCII. XDTEXT.DAT is a binary file consisting of 76-byte fixed length records. XIf the distribution kit consists of Files-11 compatible media, then XPIP can be used to transfer the files. For example: X X >PIP SY:*.*=MM:*.*(cr) -requires ANSI magtape support X XIf the distribution kit consists of DOS- or RT11-compatible media, Xthen FLX must be used to transfer the files. The /IM:76. switch X(image binary fixed length) must be used to transfer DTEXT.DAT; Xthe /FA switch (formatted ASCII) should be used to transfer the Xother files. For example (DOS magtape): X X >FLX(cr) X FLX>SY:/RS/FA=MM:*.FTN,*.FOR,*.MAC,*.DOC/DO(cr) X FLX>SY:/RS/FA=MM:*.CMD,*.COM,*.ODL,DINDX.DAT/DO(cr) X FLX>SY:/RS/IM:76.=MM:DTEXT.DAT/DO(cr) X FLX>^Z X XTo compile Dungeon, issue the following command: X X >@RSXCMP(cr) X XThere should be no error messages. X XTo task build the compiled sources, issue the following command: X X >TKB @RSXBLD(cr) X XIt is now possible to run Dungeon: X X >RUN DUNGEON(cr) X XWhen invoked, Dungeon takes no more than 5-10 seconds to start up. X If your system maintains a separate Fortran-IV-Plus object time Xlibrary (F4POTS.OLB), then you must create a local copy of the Xsystem library with the Fortran-IV-Plus object time library Xmerged in and the short error text as the default. The following Xcommands are an example of how such a local copy could be built: X X >PIP SY:*.*=LB:[1,1]SYSLIB.OLB,F4POTS.OLB(cr) -copy libraries X >LBR(cr) -invoke LBR X LBR>SHORT.OBJ=F4POTS.OLB/EX:$SHORT(cr) -extract $SHORT X LBR>F4POTS.OLB/DE:$SHORT(cr) -delete $SHORT X LBR>F4POTS.OBJ=F4POTS.OLB/EX(cr) -extract other modules X LBR>SYSLIB.OLB=F4POTS.OBJ(cr) -insert other modules X LBR>SYSLIB.OLB/DG:$ERTXT(cr) -delete dup entry X LBR>SYSLIB.OLB=SHORT.OBJ/RP(cr) -insert $SHORT X LBR>^Z X >PIP F4POTS.*;*,SHORT.OBJ;*/DE(cr) X XThen edit D.ODL to reference the local library instead of the Xdefault system library: X X >TEC D.ODL(cr) X *FS[1,1]$SY:$EX$$ X XDungeon can now be task built as described above. X XNotes on the executable program: X X - The only files needed to execute Dungeon are DUNGEON.TSK, X DINDX.DAT, and DTEXT.DAT. All other files can be deleted. X X - Files DINDX.DAT and DTEXT.DAT must reside in the user's area on X logical device SY: (this can be changed with a source edit, see X section 8). X X - Exiting from Dungeon via an MCR ABOrt command instead of the QUIT X command will leave file DTEXT.DAT open and locked. The file must X be manually unlocked before the game is next invoked: X X >PIP DTEXT.DAT/UN(cr) X 5. Installation Instructions, VMS X XBefore starting, please note that: X X - Dungeon requires VMS V1 or later. X X - Dungeon requires VAX Fortran-IV V1 or later. X X - All files (source and object) must reside in the user's area X (at least 2500 disk blocks are needed). X XExcept for DTEXT.DAT, all files in the distribution kit are ASCII. XDTEXT.DAT is a binary file consisting of 76-byte fixed length records. XIf the distribution kit consists of Files-11 compatible media, then XCOPY can be used to transfer the files. For example: X X $ COPY MM:*.* *.*(cr) X XIf the distribution kit consists of DOS- or RT11-compatible media, Xthen FLX must be used to transfer the files. The /IM:76. switch X(image binary fixed length) must be used to transfer DTEXT.DAT; Xthe /FA switch (formatted ASCII) should be used to transfer the Xother files. For example (DOS magtape): X X $ MCR FLX(cr) X FLX>SY:/RS/FA=MM:*.FTN,*.FOR,*.MAC,*.DOC/DO(cr) X FLX>SY:/RS/FA=MM:*.CMD,*.COM,*.ODL,DINDX.DAT/DO(cr) X FLX>SY:/RS/IM:76.=MM:DTEXT.DAT/DO(cr) X FLX>^Z X XTo compile Dungeon, issue the following command: X X $ @VMSCMP(cr) X XThere should be no error messages. X XTo link the compiled sources, issue the following command: X X $ @VMSBLD(cr) X XIt is now possible to run Dungeon: X X $ RUN DUNGEON(cr) X XWhen invoked, Dungeon takes no more than 5-10 seconds to start up. X XNotes on the executable program: X X - The only files needed to execute Dungeon are DUNGEON.EXE, X DINDX.DAT, and DTEXT.DAT. All other files can be deleted. X X - Files DINDX.DAT and DTEXT.DAT must reside in the user's area X (this can be changed with a source edit, see section 8). X 6. Warnings and Restrictions X XFor those familiar with the MDL version of the game on the ARPAnet, Xthe following is a list of the major incompatabilties: X X -The first six letters of a word are considered X significant, instead of the first five. X -The syntax for TELL, ANSWER, and INCANT is different. X -Compound objects are not recognized. X -Compound commands can be delimited with comma as well X as period. X XAlso, the palantir, brochure, and dead man problems are not Ximplemented. X X X7. Abstract of Informational Printouts X XSUMMARY X------- X X Welcome to Dungeon! X X Dungeon is a game of adventure, danger, and low cunning. In it Xyou will explore some of the most amazing territory ever seen by mortal Xman. Hardened adventurers have run screaming from the terrors contained Xwithin. X X In Dungeon, the intrepid explorer delves into the forgotten secrets Xof a lost labyrinth deep in the bowels of the earth, searching for Xvast treasures long hidden from prying eyes, treasures guarded by Xfearsome monsters and diabolical traps! X X No DECsystem should be without one! X X Dungeon was created at the Programming Technology Division of the MIT XLaboratory for Computer Science by Tim Anderson, Marc Blank, Bruce XDaniels, and Dave Lebling. It was inspired by the Adventure game of XCrowther and Woods, and the Dungeons and Dragons game of Gygax Xand Arneson. The original version was written in MDL (alias MUDDLE). XThe current version was translated from MDL into FORTRAN IV by Xa somewhat paranoid DEC engineer who prefers to remain anonymous. X X On-line information may be obtained with the commands HELP and INFO. X INFO X---- X XWelcome to Dungeon! X X You are near a large dungeon, which is reputed to contain vast Xquantities of treasure. Naturally, you wish to acquire some of it. XIn order to do so, you must of course remove it from the dungeon. To Xreceive full credit for it, you must deposit it safely in the trophy Xcase in the living room of the house. X X In addition to valuables, the dungeon contains various objects Xwhich may or may not be useful in your attempt to get rich. You may Xneed sources of light, since dungeons are often dark, and weapons, Xsince dungeons often have unfriendly things wandering about. Reading Xmaterial is scattered around the dungeon as well; some of it Xis rumored to be useful. X X To determine how successful you have been, a score is kept. XWhen you find a valuable object and pick it up, you receive a Xcertain number of points, which depends on the difficulty of finding Xthe object. You receive extra points for transporting the treasure Xsafely to the living room and placing it in the trophy case. In Xaddition, some particularly interesting rooms have a value associated Xwith visiting them. The only penalty is for getting yourself killed, Xwhich you may do only twice. X X Of special note is a thief (always carrying a large bag) who Xlikes to wander around in the dungeon (he has never been seen by the Xlight of day). He likes to take things. Since he steals for pleasure Xrather than profit and is somewhat sadistic, he only takes things which Xyou have seen. Although he prefers valuables, sometimes in his haste Xhe may take something which is worthless. From time to time, he examines Xhis take and discards objects which he doesn't like. He may occas- Xionally stop in a room you are visiting, but more often he just wanders Xthrough and rips you off (he is a skilled pickpocket). X XHELP X---- X XUseful commands: X X The 'BRIEF' command suppresses printing of long room descriptions Xfor rooms which have been visited. The 'SUPERBRIEF' command suppresses Xprinting of long room descriptions for all rooms. The 'VERBOSE' Xcommand restores long descriptions. X The 'INFO' command prints information which might give some idea Xof what the game is about. X The 'QUIT' command prints your score and asks whether you wish Xto continue playing. X The 'SAVE' command saves the state of the game for later continuation. X The 'RESTORE' command restores a saved game. X The 'INVENTORY' command lists the objects in your possession. X The 'LOOK' command prints a description of your surroundings. X The 'SCORE' command prints your current score and ranking. X The 'TIME' command tells you how long you have been playing. X The 'DIAGNOSE' command reports on your injuries, if any. X Command abbreviations: X X The 'INVENTORY' command may be abbreviated 'I'. X The 'LOOK' command may be abbreviated 'L'. X The 'QUIT' command may be abbreviated 'Q'. X XContainment: X X Some objects can contain other objects. Many such containers can Xbe opened and closed. The rest are always open. They may or may Xnot be transparent. For you to access (e.g., take) an object Xwhich is in a container, the container must be open. For you Xto see such an object, the container must be either open or Xtransparent. Containers have a capacity, and objects have sizes; Xthe number of objects which will fit therefore depends on their Xsizes. You may put any object you have access to (it need not be Xin your hands) into any other object. At some point, the program Xwill attempt to pick it up if you don't already have it, which Xprocess may fail if you're carrying too much. Although containers Xcan contain other containers, the program doesn't access more than Xone level down. X XFighting: X X Occupants of the dungeon will, as a rule, fight back when Xattacked. In some cases, they may attack even if unprovoked. XUseful verbs here are 'ATTACK WITH ', 'KILL', Xetc. Knife-throwing may or may not be useful. You have a Xfighting strength which varies with time. Being in a fight, Xgetting killed, and being injured all lower this strength. XStrength is regained with time. Thus, it is not a good idea to Xfight someone immediately after being killed. Other details Xshould become apparent after a few melees or deaths. X XCommand parser: X X A command is one line of text terminated by a carriage return. XFor reasons of simplicity, all words are distinguished by their Xfirst six letters. All others are ignored. For example, typing X'DISASSEMBLE THE ENCYCLOPEDIA' is not only meaningless, it also Xcreates excess effort for your fingers. Note that this trunca- Xtion may produce ambiguities in the intepretation of longer words. X[Also note that upper and lower case are equivalent.] X X You are dealing with a fairly stupid parser, which understands Xthe following types of things-- X X Actions: X Among the more obvious of these, such as TAKE, PUT, DROP, etc. X Fairly general forms of these may be used, such as PICK UP, X PUT DOWN, etc. X X Directions: X NORTH, SOUTH, UP, DOWN, etc. and their various abbreviations. X Other more obscure directions (LAND, CROSS) are appropriate in X only certain situations. X Objects: X Most objects have names and can be referenced by them. X X Adjectives: X Some adjectives are understood and required when there are X two objects which can be referenced with the same 'name' (e.g., X DOORs, BUTTONs). X X Prepositions: X It may be necessary in some cases to include prepositions, but X the parser attempts to handle cases which aren't ambiguous X without. Thus 'GIVE CAR TO DEMON' will work, as will 'GIVE DEMON X CAR'. 'GIVE CAR DEMON' probably won't do anything interesting. X When a preposition is used, it should be appropriate; 'GIVE CAR X WITH DEMON' won't parse. X X Sentences: X The parser understands a reasonable number of syntactic construc- X tions. In particular, multiple commands (separated by commas) X can be placed on the same line. X X Ambiguity: X The parser tries to be clever about what to do in the case of X actions which require objects that are not explicitly specified. X If there is only one possible object, the parser will assume X that it should be used. Otherwise, the parser will ask. X Most questions asked by the parser can be answered. X 8. Source Notes X XA few notes for source hackers. X X- The initialization module (DINIT.FTN) includes an access protection X function PROTCT. If PROTCT returns a value of .TRUE., the game is X permitted to start; if PROTCT returns .FALSE., the game is X terminated with a suitably nasty message. At present, PROTCT is a X dummy routine and always returns .TRUE.; by tailoring PROTCT, X access to the game can be restricted to certain hours or users. X X- The data base OPEN and READ statements are in the initialization X module (DINIT.FTN). The data base file names are simply "DINDX.DAT" X and "DTEXT.DAT". These may be freely changed to include logical X device names, UIC's, etc. Thus, it is possible to place the data X base files on different devices, in a fixed UIC, etc. X X- Converting the game to another processor is not a straightforward X procedure. The game makes heavy use of extended and/or X idiosynchratic features of PDP-11 Fortran. Particular nasties X include the following: X X > The game vocabulary is stored in Radix-50 notation. X > [F77 version has converted these to ints.] X X > The game uses the extended I/O commands OPEN and CLOSE. X X > The game uses LOGICAL*1 variables for character strings. X > [F77 version uses CHARACTER.] X X > The game uses logical operators on integers for bitwise binary X operations. X > [F77 version uses the functions and() and or() and not() where X necessary, as well as standard fortran .and., .or., etc.] X X > The game treats certain arrays and variables as unsigned X 16-bit integers (integer overflow may occur). X > [F77 vax version uses 32-bit ints except in the subroutine X that reads the text file, where they are declared as 16-bits. X The F77 pdp version uses the -I2 compile flag force 16-bit X ints and logicals.] X X In general, the game was implemented to fit in memory, not to be X transported. You're on your own, friend! END_OF_dungeon.doc if test 22194 -ne `wc -c verbs.F <<'END_OF_verbs.F' XC VAPPLI- MAIN VERB PROCESSING ROUTINE 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 VAPPLI(RI) X IMPLICIT INTEGER (A-Z) X LOGICAL LIT,OBJACT X LOGICAL QEMPTY,RMDESC,CLOCKD X LOGICAL QOPEN,EDIBLE,DRKBLE X LOGICAL TAKE,PUT,DROP,WALK X LOGICAL QHERE,SVERBS,FINDXT,OAPPLI,F X#include "parser.h" X#include "gamestate.h" X#include "state.h" XC X COMMON /STAR/ MBASE,STRBIT X#include "rooms.h" X#include "rflag.h" X#include "rindex.h" X#include "xsrch.h" X#include "objects.h" X#include "oflags.h" X#include "oindex.h" X#include "advers.h" X#include "verbs.h" XC XC FUNCTIONS AND DATA XC X QOPEN(R)=and(OFLAG2(R),OPENBT).NE.0 X EDIBLE(R)=and(OFLAG1(R),FOODBT).NE.0 X DRKBLE(R)=and(OFLAG1(R),DRNKBT).NE.0 X DATA MXNOP/39/,MXSMP/99/ XC VAPPLI, PAGE 2 XC X VAPPLI=.TRUE. XC !ASSUME WINS. XC X IF(PRSO.GT.220) GO TO 5 XC X IF(PRSO.NE.0) ODO2=ODESC2(PRSO) XC !SET UP DESCRIPTORS. X5 IF(PRSI.NE.0) ODI2=ODESC2(PRSI) X AV=AVEHIC(WINNER) X RMK=372+RND(6) XC !REMARK FOR HACK-HACKS. XC X IF(RI.EQ.0) GO TO 10 XC !ZERO IS FALSE. X IF(RI.LE.MXNOP) RETURN XC !NOP? X IF(RI.LE.MXSMP) GO TO 100 XC !SIMPLE VERB? X GO TO (18000,20000, X& 22000,23000,24000,25000,26000,27000,28000,29000,30000, X& 31000,32000,33000,34000,35000,36000, 38000,39000,40000, X& 41000,42000,43000,44000,45000,46000,47000,48000,49000,50000, X& 51000,52000,53000, 55000,56000, 58000,59000,60000, X& 63000,64000,65000,66000, 68000,69000,70000, X& 71000,72000,73000,74000, 77000,78000, X& 80000,81000,82000,83000,84000,85000,86000,87000,88000), X& (RI-MXSMP) X CALL BUG(7,RI) XC XC ALL VERB PROCESSORS RETURN HERE TO DECLARE FAILURE. XC X10 VAPPLI=.FALSE. XC !LOSE. X RETURN XC XC SIMPLE VERBS ARE HANDLED EXTERNALLY. XC X100 VAPPLI=SVERBS(RI) X RETURN XC VAPPLI, PAGE 3 XC XC V100-- READ. OUR FIRST REAL VERB. XC X18000 IF(LIT(HERE)) GO TO 18100 XC !ROOM LIT? X CALL RSPEAK(356) XC !NO, CANT READ. X RETURN XC X18100 IF(PRSI.EQ.0) GO TO 18200 XC !READ THROUGH OBJ? X IF(and(OFLAG1(PRSI),TRANBT).NE.0) GO TO 18200 X CALL RSPSUB(357,ODI2) XC !NOT TRANSPARENT. X RETURN XC X18200 IF(and(OFLAG1(PRSO),READBT).NE.0) GO TO 18300 X CALL RSPSUB(358,ODO2) XC !NOT READABLE. X RETURN XC X18300 IF(.NOT.OBJACT(X)) CALL RSPEAK(OREAD(PRSO)) X RETURN XC XC V101-- MELT. UNLESS OBJECT HANDLES, JOKE. XC X20000 IF(.NOT.OBJACT(X)) CALL RSPSUB(361,ODO2) X RETURN XC XC V102-- INFLATE. WORKS ONLY WITH BOATS. XC X22000 IF(.NOT.OBJACT(X)) CALL RSPEAK(368) XC !OBJ HANDLE? X RETURN XC XC V103-- DEFLATE. XC X23000 IF(.NOT.OBJACT(X)) CALL RSPEAK(369) XC !OBJ HANDLE? X RETURN XC VAPPLI, PAGE 4 XC XC V104-- ALARM. IF SLEEPING, WAKE HIM UP. XC X24000 IF(and(OFLAG2(PRSO),SLEPBT).EQ.0) GO TO 24100 X VAPPLI=OBJACT(X) XC !SLEEPING, LET OBJ DO. X RETURN XC X24100 CALL RSPSUB(370,ODO2) XC !JOKE. X RETURN XC XC V105-- EXORCISE. OBJECTS HANDLE. XC X25000 F=OBJACT(X) XC !OBJECTS HANDLE. X RETURN XC XC V106-- PLUG. LET OBJECTS HANDLE. XC X26000 IF(.NOT.OBJACT(X)) CALL RSPEAK(371) X RETURN XC XC V107-- KICK. IF OBJECT IGNORES, JOKE. XC X27000 IF(.NOT.OBJACT(X)) CALL RSPSB2(378,ODO2,RMK) X RETURN XC XC V108-- WAVE. SAME. XC X28000 IF(.NOT.OBJACT(X)) CALL RSPSB2(379,ODO2,RMK) X RETURN XC XC V109,V110-- RAISE, LOWER. SAME. XC X29000 CONTINUE X30000 IF(.NOT.OBJACT(X)) CALL RSPSB2(380,ODO2,RMK) X RETURN XC XC V111-- RUB. SAME. XC X31000 IF(.NOT.OBJACT(X)) CALL RSPSB2(381,ODO2,RMK) X RETURN XC XC V112-- PUSH. SAME. XC X32000 IF(.NOT.OBJACT(X)) CALL RSPSB2(382,ODO2,RMK) X RETURN XC VAPPLI, PAGE 5 XC XC V113-- UNTIE. IF OBJECT IGNORES, JOKE. XC X33000 IF(OBJACT(X)) RETURN XC !OBJECT HANDLE? X I=383 XC !NO, NOT TIED. X IF(and(OFLAG2(PRSO),TIEBT).EQ.0) I=384 X CALL RSPEAK(I) X RETURN XC XC V114-- TIE. NEVER REALLY WORKS. XC X34000 IF(and(OFLAG2(PRSO),TIEBT).NE.0) GO TO 34100 X CALL RSPEAK(385) XC !NOT TIEABLE. X RETURN XC X34100 IF(.NOT.OBJACT(X)) CALL RSPSUB(386,ODO2) XC !JOKE. X RETURN XC XC V115-- TIE UP. NEVER REALLY WORKS. XC X35000 IF(and(OFLAG2(PRSI),TIEBT).NE.0) GO TO 35100 X CALL RSPSUB(387,ODO2) XC !NOT TIEABLE. X RETURN XC X35100 I=388 XC !ASSUME VILLAIN. X IF(and(OFLAG2(PRSO),VILLBT).EQ.0) I=389 X CALL RSPSUB(I,ODO2) XC !JOKE. X RETURN XC XC V116-- TURN. OBJECT MUST HANDLE. XC X36000 IF(and(OFLAG1(PRSO),TURNBT).NE.0) GO TO 36100 X CALL RSPEAK(390) XC !NOT TURNABLE. X RETURN XC X36100 IF(and(OFLAG1(PRSI),TOOLBT).NE.0) GO TO 36200 X CALL RSPSUB(391,ODI2) XC !NOT A TOOL. X RETURN XC X36200 VAPPLI=OBJACT(X) XC !LET OBJECT HANDLE. X RETURN XC XC V117-- BREATHE. BECOMES INFLATE WITH LUNGS. XC X38000 PRSA=INFLAW X PRSI=LUNGS X GO TO 22000 XC !HANDLE LIKE INFLATE. XC XC V118-- KNOCK. MOSTLY JOKE. XC X39000 IF(OBJACT(X)) RETURN XC !OBJ HANDLE? X I=394 XC !JOKE FOR DOOR. X IF(and(OFLAG1(PRSO),DOORBT).EQ.0) I=395 X CALL RSPSUB(I,ODO2) XC !JOKE FOR NONDOORS TOO. X RETURN XC XC V119-- LOOK. XC X40000 IF(PRSO.NE.0) GO TO 41500 XC !SOMETHING TO LOOK AT? X VAPPLI=RMDESC(3) XC !HANDLED BY RMDESC. X RETURN XC XC V120-- EXAMINE. XC X41000 IF(PRSO.NE.0) GO TO 41500 XC !SOMETHING TO EXAMINE? X VAPPLI=RMDESC(0) XC !HANDLED BY RMDESC. X RETURN XC X41500 IF(OBJACT(X)) RETURN XC !OBJ HANDLE? X I=OREAD(PRSO) XC !GET READING MATERIAL. X IF(I.NE.0) CALL RSPEAK(I) XC !OUTPUT IF THERE, X IF(I.EQ.0) CALL RSPSUB(429,ODO2) XC !OTHERWISE DEFAULT. X PRSA=FOOW XC !DEFUSE ROOM PROCESSORS. X RETURN XC XC V121-- SHAKE. IF HOLLOW OBJECT, SOME ACTION. XC X42000 IF(OBJACT(X)) RETURN XC !OBJECT HANDLE? X IF(and(OFLAG2(PRSO),VILLBT).EQ.0) GO TO 42100 X CALL RSPEAK(371) XC !JOKE FOR VILLAINS. X RETURN XC X42100 IF(QEMPTY(PRSO).OR.(and(OFLAG1(PRSO),TAKEBT).EQ.0)) X& GO TO 10 X IF(QOPEN(PRSO)) GO TO 42300 XC !OPEN? SPILL. X CALL RSPSUB(396,ODO2) XC !NO, DESCRIBE NOISE. X RETURN XC X42300 CALL RSPSUB(397,ODO2) XC !SPILL THE WORKS. X DO 42500 I=1,OLNT XC !SPILL CONTENTS. X IF(OCAN(I).NE.PRSO) GO TO 42500 XC !INSIDE? X OFLAG2(I)=or(OFLAG2(I),TCHBT) X IF(AV.EQ.0) GO TO 42400 XC !IN VEHICLE? X CALL NEWSTA(I,0,0,AV,0) XC !YES, SPILL IN THERE. X GO TO 42500 XC X42400 CALL NEWSTA(I,0,HERE,0,0) XC !NO, SPILL ON FLOOR, X IF(I.EQ.WATER) CALL NEWSTA(I,133,0,0,0) XC !BUT WATER DISAPPEARS. X42500 CONTINUE X RETURN XC XC V122-- MOVE. MOSTLY JOKES. XC X43000 IF(OBJACT(X)) RETURN XC !OBJ HANDLE? X I=398 XC !ASSUME NOT HERE. X IF(QHERE(PRSO,HERE)) I=399 X CALL RSPSUB(I,ODO2) XC !JOKE. X RETURN XC VAPPLI, PAGE 6 XC XC V123-- TURN ON. XC X44000 F=LIT(HERE) XC !RECORD IF LIT. X IF(OBJACT(X)) GO TO 44300 XC !OBJ HANDLE? X IF((and(OFLAG1(PRSO),LITEBT).NE.0).AND. X& (OADV(PRSO).EQ.WINNER)) GO TO 44100 X CALL RSPEAK(400) XC !CANT DO IT. X RETURN XC X44100 IF(and(OFLAG1(PRSO),ONBT).EQ.0) GO TO 44200 X CALL RSPEAK(401) XC !ALREADY ON. X RETURN XC X44200 OFLAG1(PRSO)=or(OFLAG1(PRSO),ONBT) X CALL RSPSUB(404,ODO2) X44300 IF(.NOT.F .AND.LIT(HERE)) F=RMDESC(0) XC !ROOM NEWLY LIT. X RETURN XC XC V124-- TURN OFF. XC X45000 IF(OBJACT(X)) GO TO 45300 XC !OBJ HANDLE? X IF((and(OFLAG1(PRSO),LITEBT).NE.0).AND. X& (OADV(PRSO).EQ.WINNER)) GO TO 45100 X CALL RSPEAK(402) XC !CANT DO IT. X RETURN XC X45100 IF(and(OFLAG1(PRSO),ONBT).NE.0) GO TO 45200 X CALL RSPEAK(403) XC !ALREADY OFF. X RETURN XC X45200 OFLAG1(PRSO)=and(OFLAG1(PRSO), not(ONBT)) X CALL RSPSUB(405,ODO2) X45300 IF(.NOT.LIT(HERE)) CALL RSPEAK(406) XC !MAY BE DARK. X RETURN XC XC V125-- OPEN. A FINE MESS. XC X46000 IF(OBJACT(X)) RETURN XC !OBJ HANDLE? X IF(and(OFLAG1(PRSO),CONTBT).NE.0) GO TO 46100 X46050 CALL RSPSUB(407,ODO2) XC !NOT OPENABLE. X RETURN XC X46100 IF(OCAPAC(PRSO).NE.0) GO TO 46200 X CALL RSPSUB(408,ODO2) XC !NOT OPENABLE. X RETURN XC X46200 IF(.NOT.QOPEN(PRSO)) GO TO 46225 X CALL RSPEAK(412) XC !ALREADY OPEN. X RETURN XC X46225 OFLAG2(PRSO)=or(OFLAG2(PRSO),OPENBT) X IF((and(OFLAG1(PRSO),TRANBT).NE.0).OR.QEMPTY(PRSO)) X& GO TO 46300 X CALL PRINCO(PRSO,410) XC !PRINT CONTENTS. X RETURN XC X46300 CALL RSPEAK(409) XC !DONE X RETURN XC XC V126-- CLOSE. XC X47000 IF(OBJACT(X)) RETURN XC !OBJ HANDLE? X IF(and(OFLAG1(PRSO),CONTBT).EQ.0) GO TO 46050 X IF(OCAPAC(PRSO).NE.0) GO TO 47100 X CALL RSPSUB(411,ODO2) XC !NOT CLOSABLE. X RETURN XC X47100 IF(QOPEN(PRSO)) GO TO 47200 XC !OPEN? X CALL RSPEAK(413) XC !NO, JOKE. X RETURN XC X47200 OFLAG2(PRSO)=and(OFLAG2(PRSO), not(OPENBT)) X CALL RSPEAK(414) XC !DONE. X RETURN XC VAPPLI, PAGE 7 XC XC V127-- FIND. BIG MEGILLA. XC X48000 IF(OBJACT(X)) RETURN XC !OBJ HANDLE? X I=415 XC !DEFAULT CASE. X IF(QHERE(PRSO,HERE)) GO TO 48300 XC !IN ROOM? X IF(OADV(PRSO).EQ.WINNER) GO TO 48200 XC !ON WINNER? X J=OCAN(PRSO) XC !DOWN ONE LEVEL. X IF(J.EQ.0) GO TO 10 X IF(((and(OFLAG1(J),TRANBT).EQ.0).AND. X& (.NOT.QOPEN(J).OR.(and(OFLAG1(J),(DOORBT+CONTBT)).EQ.0)))) X& GO TO 10 X I=417 XC !ASSUME IN ROOM. X IF(QHERE(J,HERE)) GO TO 48100 X IF(OADV(J).NE.WINNER) GO TO 10 XC !NOT HERE OR ON PERSON. X I=418 X48100 CALL RSPSUB(I,ODESC2(J)) XC !DESCRIBE FINDINGS. X RETURN XC X48200 I=416 X48300 CALL RSPSUB(I,ODO2) XC !DESCRIBE FINDINGS. X RETURN XC XC V128-- WAIT. RUN CLOCK DEMON. XC X49000 CALL RSPEAK(419) XC !TIME PASSES. X DO 49100 I=1,3 X IF(CLOCKD(X)) RETURN X49100 CONTINUE X RETURN XC XC V129-- SPIN. XC V159-- TURN TO. XC X50000 CONTINUE X88000 IF(.NOT.OBJACT(X)) CALL RSPEAK(663) XC !IF NOT OBJ, JOKE. X RETURN XC XC V130-- BOARD. WORKS WITH VEHICLES. XC X51000 IF(and(OFLAG2(PRSO),VEHBT).NE.0) GO TO 51100 X CALL RSPSUB(421,ODO2) XC !NOT VEHICLE, JOKE. X RETURN XC X51100 IF(QHERE(PRSO,HERE)) GO TO 51200 XC !HERE? X CALL RSPSUB(420,ODO2) XC !NO, JOKE. X RETURN XC X51200 IF(AV.EQ.0) GO TO 51300 XC !ALREADY GOT ONE? X CALL RSPSUB(422,ODO2) XC !YES, JOKE. X RETURN XC X51300 IF(OBJACT(X)) RETURN XC !OBJ HANDLE? X CALL RSPSUB(423,ODO2) XC !DESCRIBE. X AVEHIC(WINNER)=PRSO X IF(WINNER.NE.PLAYER) OCAN(AOBJ(WINNER))=PRSO X RETURN XC XC V131-- DISEMBARK. XC X52000 IF(AV.EQ.PRSO) GO TO 52100 XC !FROM VEHICLE? X CALL RSPEAK(424) XC !NO, JOKE. X RETURN XC X52100 IF(OBJACT(X)) RETURN XC !OBJ HANDLE? X IF(and(RFLAG(HERE),RLAND).NE.0) GO TO 52200 X CALL RSPEAK(425) XC !NOT ON LAND. X RETURN XC X52200 AVEHIC(WINNER)=0 X CALL RSPEAK(426) X IF(WINNER.NE.PLAYER) CALL NEWSTA(AOBJ(WINNER),0,HERE,0,0) X RETURN XC XC V132-- TAKE. HANDLED EXTERNALLY. XC X53000 VAPPLI=TAKE(.TRUE.) X RETURN XC XC V133-- INVENTORY. PROCESSED EXTERNALLY. XC X55000 CALL INVENT(WINNER) X RETURN XC VAPPLI, PAGE 8 XC XC V134-- FILL. STRANGE DOINGS WITH WATER. XC X56000 IF(PRSI.NE.0) GO TO 56050 XC !ANY OBJ SPECIFIED? X IF(and(RFLAG(HERE),(RWATER+RFILL)).NE.0) GO TO 56025 X CALL RSPEAK(516) XC !NOTHING TO FILL WITH. X PRSWON=.FALSE. XC !YOU LOSE. X RETURN XC X56025 PRSI=GWATE XC !USE GLOBAL WATER. X56050 IF(OBJACT(X)) RETURN XC !OBJ HANDLE? X IF((PRSI.NE.GWATE).AND.(PRSI.NE.WATER)) X& CALL RSPSB2(444,ODI2,ODO2) X RETURN XC XC V135,V136-- EAT/DRINK XC X58000 CONTINUE X59000 IF(OBJACT(X)) RETURN XC !OBJ HANDLE? X IF(PRSO.EQ.GWATE) GO TO 59500 XC !DRINK GLOBAL WATER? X IF(.NOT.EDIBLE(PRSO)) GO TO 59400 XC !EDIBLE? X IF(OADV(PRSO).EQ.WINNER) GO TO 59200 XC !YES, ON WINNER? X59100 CALL RSPSUB(454,ODO2) XC !NOT ACCESSIBLE. X RETURN XC X59200 IF(PRSA.EQ.DRINKW) GO TO 59300 XC !DRINK FOOD? X CALL NEWSTA(PRSO,455,0,0,0) XC !NO, IT DISAPPEARS. X RETURN XC X59300 CALL RSPEAK(456) XC !YES, JOKE. X RETURN XC X59400 IF(.NOT.DRKBLE(PRSO)) GO TO 59600 XC !DRINKABLE? X IF(OCAN(PRSO).EQ.0) GO TO 59100 XC !YES, IN SOMETHING? X IF(OADV(OCAN(PRSO)).NE.WINNER) GO TO 59100 X IF(QOPEN(OCAN(PRSO))) GO TO 59500 XC !CONT OPEN? X CALL RSPEAK(457) XC !NO, JOKE. X RETURN XC X59500 CALL NEWSTA(PRSO,458,0,0,0) XC !GONE. X RETURN XC X59600 CALL RSPSUB(453,ODO2) XC !NOT FOOD OR DRINK. X RETURN XC XC V137-- BURN. COMPLICATED. XC X60000 IF(and(OFLAG1(PRSI),(FLAMBT+LITEBT+ONBT)).NE. X& (FLAMBT+LITEBT+ONBT)) GO TO 60400 X IF(OBJACT(X)) RETURN XC !OBJ HANDLE? X IF(OCAN(PRSO).NE.RECEP) GO TO 60050 XC !BALLOON? X IF(OAPPLI(OACTIO(BALLO),0)) RETURN XC !DID IT HANDLE? X60050 IF(and(OFLAG1(PRSO),BURNBT).EQ.0) GO TO 60300 X IF(OADV(PRSO).NE.WINNER) GO TO 60100 XC !CARRYING IT? X CALL RSPSUB(459,ODO2) X CALL JIGSUP(460) X RETURN XC X60100 J=OCAN(PRSO) XC !GET CONTAINER. X IF(QHERE(PRSO,HERE).OR. ((AV.NE.0).AND.(J.EQ.AV))) X& GO TO 60200 X IF(J.EQ.0) GO TO 60150 XC !INSIDE? X IF(.NOT.QOPEN(J)) GO TO 60150 XC !OPEN? X IF(QHERE(J,HERE).OR.((AV.NE.0).AND.(OCAN(J).EQ.AV))) X& GO TO 60200 X60150 CALL RSPEAK(461) XC !CANT REACH IT. X RETURN XC X60200 CALL RSPSUB(462,ODO2) XC !BURN IT. X CALL NEWSTA(PRSO,0,0,0,0) X RETURN XC X60300 CALL RSPSUB(463,ODO2) XC !CANT BURN IT. X RETURN XC X60400 CALL RSPSUB(301,ODI2) XC !CANT BURN IT WITH THAT. X RETURN XC VAPPLI, PAGE 9 XC XC V138-- MUNG. GO TO COMMON ATTACK CODE. XC X63000 I=466 XC !CHOOSE PHRASE. X IF(and(OFLAG2(PRSO),VILLBT).NE.0) GO TO 66100 X IF(.NOT.OBJACT(X)) CALL RSPSB2(466,ODO2,RMK) X RETURN XC XC V139-- KILL. GO TO COMMON ATTACK CODE. XC X64000 I=467 XC !CHOOSE PHRASE. X GO TO 66100 XC XC V140-- SWING. INVERT OBJECTS, FALL THRU TO ATTACK. XC X65000 J=PRSO XC !INVERT. X PRSO=PRSI X PRSI=J X J=ODO2 X ODO2=ODI2 X ODI2=J X PRSA=ATTACW XC !FOR OBJACT. XC XC V141-- ATTACK. FALL THRU TO ATTACK CODE. XC X66000 I=468 XC XC COMMON MUNG/ATTACK/SWING/KILL CODE. XC X66100 IF(PRSO.NE.0) GO TO 66200 XC !ANYTHING? X CALL RSPEAK(469) XC !NO, JOKE. X RETURN XC X66200 IF(OBJACT(X)) RETURN XC !OBJ HANDLE? X IF(and(OFLAG2(PRSO),VILLBT).NE.0) GO TO 66300 X IF(and(OFLAG1(PRSO),VICTBT).EQ.0) X& CALL RSPSUB(470,ODO2) X RETURN XC X66300 J=471 XC !ASSUME NO WEAPON. X IF(PRSI.EQ.0) GO TO 66500 X IF(and(OFLAG2(PRSI),WEAPBT).EQ.0) GO TO 66400 X MELEE=1 XC !ASSUME SWORD. X IF(PRSI.NE.SWORD) MELEE=2 XC !MUST BE KNIFE. X I=BLOW(PLAYER,PRSO,MELEE,.TRUE.,0) XC !STRIKE BLOW. X RETURN XC X66400 J=472 XC !NOT A WEAPON. X66500 CALL RSPSB2(I,ODO2,J) XC !JOKE. X RETURN XC VAPPLI, PAGE 10 XC XC V142-- WALK. PROCESSED EXTERNALLY. XC X68000 VAPPLI=WALK(X) X RETURN XC XC V143-- TELL. PROCESSED IN GAME. XC X69000 CALL RSPEAK(603) X RETURN XC XC V144-- PUT. PROCESSED EXTERNALLY. XC X70000 VAPPLI=PUT(.TRUE.) X RETURN XC XC V145,V146,V147,V148-- DROP/GIVE/POUR/THROW XC X71000 CONTINUE X72000 CONTINUE X73000 CONTINUE X74000 VAPPLI=DROP(.FALSE.) X RETURN XC XC V149-- SAVE XC X77000 IF(and(RFLAG(TSTRS),RSEEN).EQ.0) GO TO 77100 X CALL RSPEAK(828) XC !NO SAVES IN ENDGAME. X RETURN XC X77100 CALL SAVEGM X RETURN XC XC V150-- RESTORE XC X#ifdef PDP X78000 call restor X#else X78000 IF(and(RFLAG(TSTRS),RSEEN).EQ.0) GO TO 78100 X CALL RSPEAK(829) XC !NO RESTORES IN ENDGAME. X RETURN XC X78100 CALL RSTRGM X#endif PDP X RETURN XC VAPPLI, PAGE 11 XC XC V151-- HELLO XC X80000 IF(PRSO.NE.0) GO TO 80100 XC !ANY OBJ? X CALL RSPEAK(346+RND(4)) XC !NO, VANILLA HELLO. X RETURN XC X80100 IF(PRSO.NE.AVIAT) GO TO 80200 XC !HELLO AVIATOR? X CALL RSPEAK(350) XC !NOTHING HAPPENS. X RETURN XC X80200 IF(PRSO.NE.SAILO) GO TO 80300 XC !HELLO SAILOR? X HS=HS+1 XC !COUNT. X I=351 XC !GIVE NORMAL OR X IF(MOD(HS,10).EQ.0) I=352 XC !RANDOM MESSAGE. X IF(MOD(HS,20).EQ.0) I=353 X CALL RSPEAK(I) XC !SPEAK UP. X RETURN XC X80300 IF(OBJACT(X)) RETURN XC !OBJ HANDLE? X I=354 XC !ASSUME VILLAIN. X IF(and(OFLAG2(PRSO),(VILLBT+ACTRBT)).EQ.0) I=355 X CALL RSPSUB(I,ODO2) XC !HELLO THERE XC ! X RETURN XC XC V152-- LOOK INTO XC X81000 IF(OBJACT(X)) RETURN XC !OBJ HANDLE? X IF(and(OFLAG1(PRSO),DOORBT).EQ.0) GO TO 81300 X IF(.NOT.QOPEN(PRSO)) GO TO 81200 XC !OPEN? X CALL RSPSUB(628,ODO2) XC !OPEN DOOR- UNINTERESTING. X RETURN XC X81200 CALL RSPSUB(525,ODO2) XC !CLOSED DOOR- CANT SEE. X RETURN XC X81300 IF(and(OFLAG2(PRSO),VEHBT).NE.0) GO TO 81400 X IF(QOPEN(PRSO).OR.(and(OFLAG1(PRSO),TRANBT).NE.0)) X& GO TO 81400 X IF(and(OFLAG1(PRSO),CONTBT).NE.0) GO TO 81200 X CALL RSPSUB(630,ODO2) XC !CANT LOOK INSIDE. X RETURN XC X81400 IF(QEMPTY(PRSO)) GO TO 81500 XC !VEH OR SEE IN. EMPTY? X CALL PRINCO(PRSO,573) XC !NO, LIST CONTENTS. X RETURN XC X81500 CALL RSPSUB(629,ODO2) XC !EMPTY. X RETURN XC XC V153-- LOOK UNDER XC X82000 IF(.NOT.OBJACT(X)) CALL RSPEAK(631) XC !OBJECT HANDLE? X RETURN XC VAPPLI, PAGE 12 XC XC V154-- PUMP XC X83000 IF((OROOM(PUMP).EQ.HERE).OR.(OADV(PUMP).EQ.WINNER)) X& GO TO 83100 X CALL RSPEAK(632) XC !NO. X RETURN XC X83100 PRSI=PUMP XC !BECOMES INFLATE X PRSA=INFLAW XC !X WITH PUMP. X GO TO 22000 XC !DONE. XC XC V155-- WIND XC X84000 IF(.NOT.OBJACT(X)) CALL RSPSUB(634,ODO2) XC !OBJ HANDLE? X RETURN XC XC V156-- CLIMB XC V157-- CLIMB UP XC V158-- CLIMB DOWN XC X85000 CONTINUE X86000 CONTINUE X87000 I=XUP XC !ASSUME UP. X IF(PRSA.EQ.CLMBDW) I=XDOWN XC !UNLESS CLIMB DN. X F=(and(OFLAG2(PRSO),CLMBBT)).NE.0 X IF(F.AND.FINDXT(I,HERE)) GO TO 87500 XC !ANYTHING TO CLIMB? X IF(OBJACT(X)) RETURN XC !OBJ HANDLE? X I=657 X IF(F) I=524 XC !VARIETY OF JOKES. X IF(.NOT.F .AND.((PRSO.EQ.WALL).OR. X& ((PRSO.GE.WNORT).AND.(PRSO.LE.WNORT+3)))) X& I=656 X CALL RSPEAK(I) XC !JOKE. X RETURN XC X87500 PRSA=WALKW XC !WALK X PRSO=I XC !IN SPECIFIED DIR. X VAPPLI=WALK(X) X RETURN XC X END XC CLOCKD- CLOCK DEMON FOR INTERMOVE CLOCK EVENTS XC XC DECLARATIONS XC X LOGICAL FUNCTION CLOCKD(X) X IMPLICIT INTEGER (A-Z) XC XC CLOCK INTERRUPTS XC X#include "clock.h" XC X CLOCKD=.FALSE. XC !ASSUME NO ACTION. X DO 100 I=1,CLNT X IF(.NOT.CFLAG(I) .OR.(CTICK(I).EQ.0)) GO TO 100 X IF(CTICK(I).LT.0) GO TO 50 XC !PERMANENT ENTRY? X CTICK(I)=CTICK(I)-1 X IF(CTICK(I).NE.0) GO TO 100 XC !TIMER EXPIRED? X50 CLOCKD=.TRUE. X CALL CEVAPP(CACTIO(I)) XC !DO ACTION. X100 CONTINUE X RETURN XC X END END_OF_verbs.F if test 17427 -ne `wc -c