X7$ ?BOOT-U-No boot on volume ߋtvYzdzO$szQO$SRT11A DECRT11A $4rBPJ컺J@CA]R9 *W%/0/5γ2A#`Fq=%jKFc+POh,Pba]%S1,fчP2;%VΨSRQPS|Ne'D+l>J%guޓpMz~ xM"N7m<Kջ&Z?FO硓=;+ .\9lĮXCir0}gDsޛ],$ad]YFkЬF/V+PfDw?SfaR$iNmW0K+ `N"˴ͬ qMpj$K2j0525r;(IR쇼ɻh{ [@Fyԟ C1ˮMcW%-(fU[Y筛Y1/;l(W vރ-4KapW˝+9Y~ cjX@~>$ {&w˫})QP3#Wn7 ݑZ7}OR}r,ӹ}o^J? ޞ7yr|!f*NϬ"g׃NU p3=ϓ,ʮߢ_4D%v~5P"CbR"bu( pSwQW07RWG1507"!3^YCՀ " %vV˥y0QΆī0i0kFAB¾#H*.ˀ̌;^'}ŏ0.ϒ0:ȣ{,mP OϐN4L_=$S8`>*0!M8(X$Ea(0s2a@`X4ϸ,77Bv?ש͈ |4Qi: Vv!U¥JP0Ч!&|Oϊ ּ""`"ui0Zjێ^ yA?4 a.RCv]͐2&(4 a}m@Կ)gat X~0Z<}fpN7%Hͺ;ː"e:C9SvfQjB&)xRGޘ*CLxbRvu9ZչN0_FS\W%) mY'(5dZgmQho"A^Y]%⑫"׌u g994)}T"=((4I#b*A+x*9RWH^#ԃH_gPd#zuҞntPUMR`^P$K:s Ig& < br1hw*5Ol_푰znP$m/ؠPa<&2>`( hM' ("`(%R(v<av`;( p:(' '@'' ' ' @'   ($V,[,up(up($t,(oL05' YxA''Z' Z'1 Z' !Z'_Z_'^()r8T'$^skQs:wsK%sS%sH:'9g&ts{^+L&Cǀ%B_8y}){S,aCRVJ 14{ !^ 85PUYd{*9@Q.Oq(fwHt*wW@|?jr@i&w87 tU1]xT'Oqc“J`M{'RN?d ՓŮn1g~>u @:Γ؁" dq [ne2Q#;"pkftY_.k~$ 2kqZR}-۟_S`c{L`1*|o;p Qrzz/[ܫp|y5@c7 p~1JEmjz!P~P Q|~׻ zl"& d /+CWI2 Z pį#5 ElQClZ"|a0F,n?}PBe6kl4LPnonZeA Ei3U ;aj%:|[&ݓ@4;Oz.p@ibFRP>cTE.ݯ,bn[ 0D=1)z7%7 #V.q*1qWsTm\Vu uܭܘױߟQ+1 jw4 Ŧ-IxO-@Q* ) j,~i֛ @ qSpH+CPTU}{r;K}qֻ eza׊i@h95NQ+#fʁ2xw'@cW.$yvp ¢Vǝ=h>ybfp9s3E3f>4N܆ΓKjO"Ev- gjzk-}3gԵ; Gƀ.LmM_mKt:Qq-pKZVӾCM1 460WrneB鱠l.MvL;)PUGh0B3wYoXU^U p;_k"pAafشƄ%"g'9cۀ)duqaȱN:c\O^Ýw;*0pS#h`ħţ]u e] ǸкVB!?Bӭ &(@I9k_KzUZnl TlSʼnRSy U**WHm/NJ?~u[9?%DoqDjA"םֈcCpNbɵm4                                                                ۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m   Jx5ȎNET044 NET02 SYSTEM DECFILE11B a,҉A$NET044.A[NET.A]NETACP.EXE;1;1_`NET044.ABACKUP/COMMENT=VAX/VMS SPKITBLD Procedure/INTER/LOG/VERIFY DUB0:[NET.A]*.* DUA1:[0,0]NET044.A/LABEL=(NET01,NET02,NET03,NET04,NET05,NET06,NET07,NET08,NET09,NET10)/SAVE/INIT/BLOCK=9000/GROUP=25VAX/VMS SPKITBLD Procedure C AAPPLI- APPLICABLES FOR ADVENTURERS C C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED C WRITTEN BY R. M. SUPNIK C C DECLARATIONS C LOGICAL FUNCTION AAPPLI(RI) IMPLICIT INTEGER (A-Z) LOGICAL F,MOVETO C C PARSER OUTPUT C LOGICAL PRSWON COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG C C ROOMS C COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200), 1 RACTIO(200),RVAL(200),RFLAG(200) INTEGER RRAND(200) EQUIVALENCE (RVAL,RRAND) C COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR, 1 RSACRD,RFILL,RMUNG,RBUCK,RHOUSE,RNWALL,REND C COMMON /RINDEX/ WHOUS,LROOM,CELLA COMMON /RINDEX/ MTROL,MAZE1 COMMON /RINDEX/ MGRAT,MAZ15 COMMON /RINDEX/ FORE1,FORE3,CLEAR,RESER COMMON /RINDEX/ STREA,EGYPT,ECHOR COMMON /RINDEX/ TSHAF COMMON /RINDEX/ BSHAF,MMACH,DOME,MTORC COMMON /RINDEX/ CAROU COMMON /RINDEX/ RIDDL,LLD2,TEMP1,TEMP2,MAINT COMMON /RINDEX/ BLROO,TREAS,RIVR1,RIVR2,RIVR3,MCYCL COMMON /RINDEX/ RIVR4,RIVR5,FCHMP,FALLS,MBARR COMMON /RINDEX/ MRAIN,POG,VLBOT,VAIR1,VAIR2,VAIR3,VAIR4 COMMON /RINDEX/ LEDG2,LEDG3,LEDG4,MSAFE,CAGER COMMON /RINDEX/ CAGED,TWELL,BWELL,ALICE,ALISM,ALITR COMMON /RINDEX/ MTREE,BKENT,BKVW,BKTWI,BKVAU,BKBOX COMMON /RINDEX/ CRYPT,TSTRS,MRANT,MREYE COMMON /RINDEX/ MRA,MRB,MRC,MRG,MRD,FDOOR COMMON /RINDEX/ MRAE,MRCE,MRCW,MRGE,MRGW,MRDW,INMIR COMMON /RINDEX/ SCORR,NCORR,PARAP,CELL,PCELL,NCELL COMMON /RINDEX/ CPANT,CPOUT,CPUZZ C C EXITS C COMMON /XSRCH/ XMIN,XMAX,XDOWN,XUP, 1 XNORTH,XSOUTH,XENTER,XEXIT,XEAST,XWEST C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT, 1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT, 2 TOOLBT,TURNBT,ONBT COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT, 1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT, 2 TCHBT,VEHBT,SCHBT C COMMON /OINDEX/ GARLI,FOOD,GUNK,COAL,MACHI,DIAMO,TCASE,BOTTL COMMON /OINDEX/ WATER,ROPE,KNIFE,SWORD,LAMP,BLAMP,RUG COMMON /OINDEX/ LEAVE,TROLL,AXE COMMON /OINDEX/ RKNIF,KEYS,ICE,BAR COMMON /OINDEX/ COFFI,TORCH,TBASK,FBASK,IRBOX COMMON /OINDEX/ GHOST,TRUNK,BELL,BOOK,CANDL COMMON /OINDEX/ MATCH,TUBE,PUTTY,WRENC,SCREW,CYCLO,CHALI COMMON /OINDEX/ THIEF,STILL,WINDO,GRATE,DOOR COMMON /OINDEX/ HPOLE,LEAK,RBUTT,RAILI COMMON /OINDEX/ POT,STATU,IBOAT,DBOAT,PUMP,RBOAT COMMON /OINDEX/ STICK,BUOY,SHOVE,BALLO,RECEP,GUANO COMMON /OINDEX/ BROPE,HOOK1,HOOK2,SAFE,SSLOT,BRICK,FUSE COMMON /OINDEX/ GNOME,BLABE,DBALL,TOMB COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE COMMON /OINDEX/ ROBOT,FTREE,BILLS,PORTR,SCOL,ZGNOM COMMON /OINDEX/ EGG,BEGG,BAUBL,CANAR,BCANA COMMON /OINDEX/ YLWAL,RDWAL,PINDR,RBEAM COMMON /OINDEX/ ODOOR,QDOOR,CDOOR,NUM1,NUM8 COMMON /OINDEX/ WARNI,CSLIT,GCARD,STLDR COMMON /OINDEX/ HANDS,WALL,LUNGS,SAILO,AVIAT,TEETH COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,WNORT,GWATE,MASTER C C CLOCK INTERRUPTS C LOGICAL*1 CFLAG COMMON /CEVENT/ CLNT,CTICK(25),CACTIO(25),CFLAG(25) C COMMON /CINDEX/ CEVCUR,CEVMNT,CEVLNT,CEVMAT,CEVCND, 1 CEVBAL,CEVBRN,CEVFUS,CEVLED,CEVSAF,CEVVLG, 2 CEVGNO,CEVBUC,CEVSPH,CEVEGH, 3 CEVFOR,CEVSCL,CEVZGI,CEVZGO,CEVSTE, 5 CEVMRS,CEVPIN,CEVINQ,CEVFOL C C ADVENTURERS C COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4), 1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4) C COMMON /AINDEX/ PLAYER,AROBOT,AMASTR C C VERBS C COMMON /VINDEX/ CINTW,DEADXW,FRSTQW,INXW,OUTXW COMMON /VINDEX/ WALKIW,FIGHTW,FOOW COMMON /VINDEX/ MELTW,READW,INFLAW,DEFLAW,ALARMW,EXORCW COMMON /VINDEX/ PLUGW,KICKW,WAVEW,RAISEW,LOWERW,RUBW COMMON /VINDEX/ PUSHW,UNTIEW,TIEW,TIEUPW,TURNW,BREATW COMMON /VINDEX/ KNOCKW,LOOKW,EXAMIW,SHAKEW,MOVEW,TRNONW,TRNOFW COMMON /VINDEX/ OPENW,CLOSEW,FINDW,WAITW,SPINW,BOARDW,UNBOAW,TAKEW COMMON /VINDEX/ INVENW,FILLW,EATW,DRINKW,BURNW COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW COMMON /VINDEX/ DIGW,LEAPW,STAYW,FOLLOW COMMON /VINDEX/ HELLOW,LOOKIW,LOOKUW,PUMPW,WINDW COMMON /VINDEX/ CLMBW,CLMBUW,CLMBDW,TRNTOW C C FLAGS C LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF, 1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF, 2 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF, 3 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF, 4 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF, 5 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF, 6 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF, 7 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ BTIEF,BINFF COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP COMMON /FINDEX/ MDIR,MLOC,POLEUF COMMON /FINDEX/ QUESNO,NQATT,CORRCT COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE C AAPPLI, PAGE 2 C IF(RI.EQ.0) GO TO 10 !IF ZERO, NO APP. AAPPLI=.TRUE. !ASSUME WINS. GO TO (1000,2000),RI !BRANCH ON ADV. CALL BUG(11,RI) C C COMMON FALSE RETURN. C 10 AAPPLI=.FALSE. RETURN C C A1-- ROBOT. PROCESS MOST COMMANDS GIVEN TO ROBOT. C 1000 IF((PRSA.NE.RAISEW).OR.(PRSO.NE.RCAGE)) GO TO 1200 CFLAG(CEVSPH)=.FALSE. !ROBOT RAISED CAGE. WINNER=PLAYER !RESET FOR PLAYER. F=MOVETO(CAGER,WINNER) !MOVE TO NEW ROOM. CALL NEWSTA(CAGE,567,CAGER,0,0) !INSTALL CAGE IN ROOM. CALL NEWSTA(ROBOT,0,CAGER,0,0) !INSTALL ROBOT IN ROOM. AROOM(AROBOT)=CAGER !ALSO MOVE ROBOT/ADV. CAGESF=.TRUE. !CAGE SOLVED. OFLAG1(ROBOT)=OFLAG1(ROBOT).AND..NOT.NDSCBT OFLAG1(SPHER)=OFLAG1(SPHER).OR.TAKEBT !RESET FLAGS. RETURN C 1200 IF((PRSA.NE.DRINKW).AND.(PRSA.NE.EATW)) GO TO 1300 CALL RSPEAK(568) !EAT OR DRINK, JOKE. RETURN C 1300 IF(PRSA.NE.READW) GO TO 1400 !READ, CALL RSPEAK(569) !JOKE. RETURN C 1400 IF((PRSA.EQ.WALKW).OR.(PRSA.EQ.TAKEW).OR.(PRSA.EQ.DROPW) 1 .OR.(PRSA.EQ.PUTW).OR.(PRSA.EQ.PUSHW).OR.(PRSA.EQ.THROWW) 2 .OR.(PRSA.EQ.TURNW).OR.(PRSA.EQ.LEAPW)) GO TO 10 CALL RSPEAK(570) !JOKE. RETURN C AAPPLI, PAGE 3 C C A2-- MASTER. PROCESS MOST COMMANDS GIVEN TO MASTER. C 2000 IF((OFLAG2(QDOOR).AND.OPENBT).NE.0) GO TO 2100 CALL RSPEAK(783) !NO MASTER YET. RETURN C 2100 IF(PRSA.NE.WALKW) GO TO 2200 !WALK? I=784 !ASSUME WONT. IF(((HERE.EQ.SCORR).AND. 1 ((PRSO.EQ.XNORTH).OR.(PRSO.EQ.XENTER))).OR. 2 ((HERE.EQ.NCORR).AND. 3 ((PRSO.EQ.XSOUTH).OR.(PRSO.EQ.XENTER)))) 4 I=785 !IF PRISON, CANT. CALL RSPEAK(I) RETURN C 2200 IF((PRSA.EQ.TAKEW).OR.(PRSA.EQ.DROPW).OR.(PRSA.EQ.PUTW).OR. 1 (PRSA.EQ.THROWW).OR.(PRSA.EQ.PUSHW).OR.(PRSA.EQ.TURNW).OR. 2 (PRSA.EQ.SPINW).OR.(PRSA.EQ.TRNTOW).OR.(PRSA.EQ.FOLLOW).OR. 3 (PRSA.EQ.STAYW).OR.(PRSA.EQ.OPENW).OR.(PRSA.EQ.CLOSEW).OR. 4 (PRSA.EQ.KILLW)) GO TO 10 !MASTER CAN DO. CALL RSPEAK(786) !MASTER CANT DO IT. RETURN C END C THIEFD- INTERMOVE THIEF DEMON C C DECLARATIONS C SUBROUTINE THIEFD IMPLICIT INTEGER (A-Z) LOGICAL DFLAG,ONCE,PROB,QHERE,QSTILL,LIT,WINNIN C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG C COMMON /DEBUG/ DBGFLG,PRSFLG C C ROOMS C COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200), 1 RACTIO(200),RVAL(200),RFLAG(200) INTEGER RRAND(200) EQUIVALENCE (RVAL,RRAND) C COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR, 1 RSACRD,RFILL,RMUNG,RBUCK,RHOUSE,RNWALL,REND C COMMON /RINDEX/ WHOUS,LROOM,CELLA COMMON /RINDEX/ MTROL,MAZE1 COMMON /RINDEX/ MGRAT,MAZ15 COMMON /RINDEX/ FORE1,FORE3,CLEAR,RESER COMMON /RINDEX/ STREA,EGYPT,ECHOR COMMON /RINDEX/ TSHAF COMMON /RINDEX/ BSHAF,MMACH,DOME,MTORC COMMON /RINDEX/ CAROU COMMON /RINDEX/ RIDDL,LLD2,TEMP1,TEMP2,MAINT COMMON /RINDEX/ BLROO,TREAS,RIVR1,RIVR2,RIVR3,MCYCL COMMON /RINDEX/ RIVR4,RIVR5,FCHMP,FALLS,MBARR COMMON /RINDEX/ MRAIN,POG,VLBOT,VAIR1,VAIR2,VAIR3,VAIR4 COMMON /RINDEX/ LEDG2,LEDG3,LEDG4,MSAFE,CAGER COMMON /RINDEX/ CAGED,TWELL,BWELL,ALICE,ALISM,ALITR COMMON /RINDEX/ MTREE,BKENT,BKVW,BKTWI,BKVAU,BKBOX COMMON /RINDEX/ CRYPT,TSTRS,MRANT,MREYE COMMON /RINDEX/ MRA,MRB,MRC,MRG,MRD,FDOOR COMMON /RINDEX/ MRAE,MRCE,MRCW,MRGE,MRGW,MRDW,INMIR COMMON /RINDEX/ SCORR,NCORR,PARAP,CELL,PCELL,NCELL COMMON /RINDEX/ CPANT,CPOUT,CPUZZ C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT, 1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT, 2 TOOLBT,TURNBT,ONBT COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT, 1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT, 2 TCHBT,VEHBT,SCHBT C COMMON /OINDEX/ GARLI,FOOD,GUNK,COAL,MACHI,DIAMO,TCASE,BOTTL COMMON /OINDEX/ WATER,ROPE,KNIFE,SWORD,LAMP,BLAMP,RUG COMMON /OINDEX/ LEAVE,TROLL,AXE COMMON /OINDEX/ RKNIF,KEYS,ICE,BAR COMMON /OINDEX/ COFFI,TORCH,TBASK,FBASK,IRBOX COMMON /OINDEX/ GHOST,TRUNK,BELL,BOOK,CANDL COMMON /OINDEX/ MATCH,TUBE,PUTTY,WRENC,SCREW,CYCLO,CHALI COMMON /OINDEX/ THIEF,STILL,WINDO,GRATE,DOOR COMMON /OINDEX/ HPOLE,LEAK,RBUTT,RAILI COMMON /OINDEX/ POT,STATU,IBOAT,DBOAT,PUMP,RBOAT COMMON /OINDEX/ STICK,BUOY,SHOVE,BALLO,RECEP,GUANO COMMON /OINDEX/ BROPE,HOOK1,HOOK2,SAFE,SSLOT,BRICK,FUSE COMMON /OINDEX/ GNOME,BLABE,DBALL,TOMB COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE COMMON /OINDEX/ ROBOT,FTREE,BILLS,PORTR,SCOL,ZGNOM COMMON /OINDEX/ EGG,BEGG,BAUBL,CANAR,BCANA COMMON /OINDEX/ YLWAL,RDWAL,PINDR,RBEAM COMMON /OINDEX/ ODOOR,QDOOR,CDOOR,NUM1,NUM8 COMMON /OINDEX/ WARNI,CSLIT,GCARD,STLDR COMMON /OINDEX/ HANDS,WALL,LUNGS,SAILO,AVIAT,TEETH COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,WNORT,GWATE,MASTER C C VILLAINS AND DEMONS C LOGICAL THFFLG,SWDACT,THFACT COMMON /HACK/ THFPOS,THFFLG,THFACT,SWDACT,SWDSTA C C FLAGS C LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF, 1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF, 2 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF, 3 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF, 4 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF, 5 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF, 6 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF, 7 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ BTIEF,BINFF COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP COMMON /FINDEX/ MDIR,MLOC,POLEUF COMMON /FINDEX/ QUESNO,NQATT,CORRCT COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE C C FUNCTIONS AND DATA C QSTILL(R)=(QHERE(STILL,R).OR.(OADV(STILL).EQ.-THIEF)) C THIEFD, PAGE 2 C D DFLAG=(PRSFLG.AND."100000).NE.0 !SET UP DETAIL FLAG. ONCE=.FALSE. !INIT FLAG. 1025 RHERE=OROOM(THIEF) !VISIBLE POS. IF(RHERE.NE.0) THFPOS=RHERE C IF(THFPOS.EQ.HERE) GO TO 1100 !THIEF IN WIN RM? IF(THFPOS.NE.TREAS) GO TO 1400 !THIEF NOT IN TREAS? C C THIEF IS IN TREASURE ROOM, AND WINNER IS NOT. C D IF(DFLAG) TYPE 10 D10 FORMAT(' THIEFD-- IN TREASURE ROOM') IF(RHERE.EQ.0) GO TO 1050 !VISIBLE? CALL NEWSTA(THIEF,0,0,0,0) !YES, VANISH. RHERE=0 IF(QSTILL(TREAS)) CALL NEWSTA(STILL,0,0,THIEF,0) 1050 I=ROBADV(-THIEF,THFPOS,0,0) !DROP VALUABLES. IF(QHERE(EGG,THFPOS)) OFLAG2(EGG)=OFLAG2(EGG).OR.OPENBT GO TO 1700 C C THIEF AND WINNER IN SAME ROOM. C 1100 IF(THFPOS.EQ.TREAS) GO TO 1700 !IF TREAS ROOM, NOTHING. IF((RFLAG(THFPOS).AND.RLIGHT).NE.0) GO TO 1400 !NOT IF LIGHT. D IF(DFLAG) TYPE 20 D20 FORMAT(' THIEFD-- IN ADV ROOM') IF(THFFLG) GO TO 1300 !THIEF ANNOUNCED? IF((RHERE.NE.0).OR.PROB(70,70)) GO TO 1150 !IF INVIS AND 30%. IF(OCAN(STILL).NE.THIEF) GO TO 1700 !ABORT IF NO STILLETTO. CALL NEWSTA(THIEF,583,THFPOS,0,0) !INSERT THIEF INTO ROOM. THFFLG=.TRUE. !THIEF IS ANNOUNCED. RETURN C 1150 IF((RHERE.EQ.0).OR.((OFLAG2(THIEF).AND.FITEBT).EQ.0)) 1 GO TO 1200 !IF VISIBLE AND FIGHT. IF(WINNIN(THIEF,WINNER)) GO TO 1175 !WINNING? CALL NEWSTA(THIEF,584,0,0,0) !NO, VANISH THIEF. OFLAG2(THIEF)=OFLAG2(THIEF).AND. .NOT.FITEBT IF(QSTILL(THFPOS)) CALL NEWSTA(STILL,0,0,THIEF,0) RETURN C 1175 IF(PROB(90,90)) GO TO 1700 !90% CHANCE TO STAY. C 1200 IF((RHERE.EQ.0).OR.PROB(70,70)) GO TO 1250 !IF VISIBLE AND 30% CALL NEWSTA(THIEF,585,0,0,0) !VANISH THIEF. IF(QSTILL(THFPOS)) CALL NEWSTA(STILL,0,0,THIEF,0) RETURN C 1300 IF(RHERE.EQ.0) GO TO 1700 !ANNOUNCED. VISIBLE? 1250 IF(PROB(70,70)) RETURN !70% CHANCE TO DO NOTHING. THFFLG=.TRUE. NR=ROBRM(THFPOS,100,0,0,-THIEF)+ROBADV(WINNER,0,0,-THIEF) I=586 !ROBBED EM. IF(RHERE.NE.0) I=588 !WAS HE VISIBLE? IF(NR.NE.0) I=I+1 !DID HE GET ANYTHING? CALL NEWSTA(THIEF,I,0,0,0) !VANISH THIEF. IF(QSTILL(THFPOS)) 1 CALL NEWSTA(STILL,0,0,THIEF,0) !RECLAIM STILLETTO. IF((NR.NE.0).AND..NOT.LIT(THFPOS)) CALL RSPEAK(406) RHERE=0 GO TO 1700 !ONWARD. C C NOT IN ADVENTURERS ROOM. C 1400 CALL NEWSTA(THIEF,0,0,0,0) !VANISH. RHERE=0 D IF(DFLAG) TYPE 30,THFPOS D30 FORMAT(' THIEFD-- IN ROOM ',I4) IF(QSTILL(THFPOS)) 1 CALL NEWSTA(STILL,0,0,THIEF,0) IF((RFLAG(THFPOS).AND.RSEEN).EQ.0) GO TO 1700 !CANT ROB UNSEEN. I=ROBRM(THFPOS,75,0,0,-THIEF) !ROB ROOM 75%. IF((THFPOS.LT.MAZE1).OR.(THFPOS.GT.MAZ15).OR. 1 (HERE.LT.MAZE1).OR.(HERE.GT.MAZ15)) GO TO 1500 DO 1450 I=1,OLNT !BOTH IN MAZE. IF(.NOT.QHERE(I,THFPOS).OR.PROB(60,60).OR. 1 ((OFLAG1(I).AND.(VISIBT+TAKEBT)).NE.(VISIBT+TAKEBT))) 2 GO TO 1450 CALL RSPSUB(590,ODESC2(I)) !TAKE OBJECT. IF(PROB(40,20)) GO TO 1700 CALL NEWSTA(I,0,0,0,-THIEF) !MOST OF THE TIME. OFLAG2(I)=OFLAG2(I).OR.TCHBT GO TO 1700 1450 CONTINUE GO TO 1700 C 1500 DO 1550 I=1,OLNT !NOT IN MAZE. IF(.NOT.QHERE(I,THFPOS).OR.(OTVAL(I).NE.0).OR.PROB(80,60).OR. 1 ((OFLAG1(I).AND.(VISIBT+TAKEBT)).NE.(VISIBT+TAKEBT))) 2 GO TO 1550 CALL NEWSTA(I,0,0,0,-THIEF) OFLAG2(I)=OFLAG2(I).OR.TCHBT GO TO 1700 1550 CONTINUE C C NOW MOVE TO NEW ROOM. C 1700 IF(OADV(ROPE).EQ.-THIEF) DOMEF=.FALSE. IF(ONCE) GO TO 1800 ONCE=.NOT.ONCE 1750 THFPOS=THFPOS-1 !NEXT ROOM. IF(THFPOS.LE.0) THFPOS=RLNT IF((RFLAG(THFPOS).AND.(RLAND+RSACRD+REND)).NE.RLAND) 1 GO TO 1750 !MUST BE LAND, PROFANE. THFFLG=.FALSE. !NOT ANNOUNCED. GO TO 1025 !ONCE MORE. C C ALL DONE. C 1800 IF(THFPOS.EQ.TREAS) RETURN !IN TREASURE ROOM? J=591 !NO, DROP STUFF. IF(THFPOS.NE.HERE) J=0 DO 1850 I=1,OLNT IF((OADV(I).NE.-THIEF).OR.PROB(70,70).OR. 1 (OTVAL(I).GT.0)) GO TO 1850 CALL NEWSTA(I,J,THFPOS,0,0) J=0 1850 CONTINUE RETURN C END C BALLOP- BALLOON FUNCTION C C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED C WRITTEN BY R. M. SUPNIK C C DECLARATIONS C LOGICAL FUNCTION BALLOP(ARG) IMPLICIT INTEGER (A-Z) LOGICAL FINDXT,QEMPTY C C PARSER OUTPUT C LOGICAL PRSWON COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD, 1 LTSHFT,BLOC,MUNGRM,HS,EGSCOR,EGMXSC C C ROOMS C COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200), 1 RACTIO(200),RVAL(200),RFLAG(200) INTEGER RRAND(200) EQUIVALENCE (RVAL,RRAND) C COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR, 1 RSACRD,RFILL,RMUNG,RBUCK,RHOUSE,RNWALL,REND C C EXITS C COMMON /CURXT/ XTYPE,XROOM1,XSTRNG,XACTIO,XOBJ EQUIVALENCE (XFLAG,XOBJ) C COMMON /XPARS/ XRMASK,XDMASK,XFMASK,XFSHFT,XASHFT, 1 XELNT(4),XNORM,XNO,XCOND,XDOOR,XLFLAG C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT, 1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT, 2 TOOLBT,TURNBT,ONBT COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT, 1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT, 2 TCHBT,VEHBT,SCHBT C COMMON /OINDEX/ GARLI,FOOD,GUNK,COAL,MACHI,DIAMO,TCASE,BOTTL COMMON /OINDEX/ WATER,ROPE,KNIFE,SWORD,LAMP,BLAMP,RUG COMMON /OINDEX/ LEAVE,TROLL,AXE COMMON /OINDEX/ RKNIF,KEYS,ICE,BAR COMMON /OINDEX/ COFFI,TORCH,TBASK,FBASK,IRBOX COMMON /OINDEX/ GHOST,TRUNK,BELL,BOOK,CANDL COMMON /OINDEX/ MATCH,TUBE,PUTTY,WRENC,SCREW,CYCLO,CHALI COMMON /OINDEX/ THIEF,STILL,WINDO,GRATE,DOOR COMMON /OINDEX/ HPOLE,LEAK,RBUTT,RAILI COMMON /OINDEX/ POT,STATU,IBOAT,DBOAT,PUMP,RBOAT COMMON /OINDEX/ STICK,BUOY,SHOVE,BALLO,RECEP,GUANO COMMON /OINDEX/ BROPE,HOOK1,HOOK2,SAFE,SSLOT,BRICK,FUSE COMMON /OINDEX/ GNOME,BLABE,DBALL,TOMB COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE COMMON /OINDEX/ ROBOT,FTREE,BILLS,PORTR,SCOL,ZGNOM COMMON /OINDEX/ EGG,BEGG,BAUBL,CANAR,BCANA COMMON /OINDEX/ YLWAL,RDWAL,PINDR,RBEAM COMMON /OINDEX/ ODOOR,QDOOR,CDOOR,NUM1,NUM8 COMMON /OINDEX/ WARNI,CSLIT,GCARD,STLDR COMMON /OINDEX/ HANDS,WALL,LUNGS,SAILO,AVIAT,TEETH COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,WNORT,GWATE,MASTER C C CLOCK INTERRUPTS C LOGICAL*1 CFLAG COMMON /CEVENT/ CLNT,CTICK(25),CACTIO(25),CFLAG(25) C COMMON /CINDEX/ CEVCUR,CEVMNT,CEVLNT,CEVMAT,CEVCND, 1 CEVBAL,CEVBRN,CEVFUS,CEVLED,CEVSAF,CEVVLG, 2 CEVGNO,CEVBUC,CEVSPH,CEVEGH, 3 CEVFOR,CEVSCL,CEVZGI,CEVZGO,CEVSTE, 5 CEVMRS,CEVPIN,CEVINQ,CEVFOL C C VERBS C COMMON /VINDEX/ CINTW,DEADXW,FRSTQW,INXW,OUTXW COMMON /VINDEX/ WALKIW,FIGHTW,FOOW COMMON /VINDEX/ MELTW,READW,INFLAW,DEFLAW,ALARMW,EXORCW COMMON /VINDEX/ PLUGW,KICKW,WAVEW,RAISEW,LOWERW,RUBW COMMON /VINDEX/ PUSHW,UNTIEW,TIEW,TIEUPW,TURNW,BREATW COMMON /VINDEX/ KNOCKW,LOOKW,EXAMIW,SHAKEW,MOVEW,TRNONW,TRNOFW COMMON /VINDEX/ OPENW,CLOSEW,FINDW,WAITW,SPINW,BOARDW,UNBOAW,TAKEW COMMON /VINDEX/ INVENW,FILLW,EATW,DRINKW,BURNW COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW COMMON /VINDEX/ DIGW,LEAPW,STAYW,FOLLOW COMMON /VINDEX/ HELLOW,LOOKIW,LOOKUW,PUMPW,WINDW COMMON /VINDEX/ CLMBW,CLMBUW,CLMBDW,TRNTOW C C FLAGS C LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF, 1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF, 2 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF, 3 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF, 4 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF, 5 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF, 6 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF, 7 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ BTIEF,BINFF COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP COMMON /FINDEX/ MDIR,MLOC,POLEUF COMMON /FINDEX/ QUESNO,NQATT,CORRCT COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE C BALLOP, PAGE 2 C BALLOP=.TRUE. !ASSUME WINS. IF(ARG.NE.2) GO TO 200 !READOUT? IF(PRSA.NE.LOOKW) GO TO 10 !ONLY PROCESS LOOK. IF(BINFF.NE.0) GO TO 50 !INFLATED? CALL RSPEAK(543) !NO. GO TO 100 50 CALL RSPSUB(544,ODESC2(BINFF)) !YES. 100 IF(BTIEF.NE.0) CALL RSPEAK(545) !HOOKED? RETURN C 200 IF(ARG.NE.1) GO TO 500 !READIN? IF(PRSA.NE.WALKW) GO TO 300 !WALK? IF(FINDXT(PRSO,HERE)) GO TO 250 !VALID EXIT? CALL RSPEAK(546) !NO, JOKE. RETURN C 250 IF(BTIEF.EQ.0) GO TO 275 !TIED UP? CALL RSPEAK(547) !YES, JOKE. RETURN C 275 IF(XTYPE.NE.XNORM) GO TO 10 !NORMAL EXIT? IF((RFLAG(XROOM1).AND.RMUNG).EQ.0) BLOC=XROOM1 10 BALLOP=.FALSE. RETURN C 300 IF((PRSA.NE.TAKEW).OR.(PRSO.NE.BINFF)) GO TO 350 CALL RSPSUB(548,ODESC2(BINFF)) !RECEP CONT TOO HOT. RETURN C 350 IF((PRSA.NE.PUTW).OR.(PRSI.NE.RECEP).OR.QEMPTY(RECEP)) 1 GO TO 10 !RECEP ALREADY FULL. CALL RSPEAK(549) RETURN C 500 IF((PRSA.NE.UNBOAW).OR.((RFLAG(HERE).AND.RLAND).EQ.0)) 1 GO TO 600 !DISEMBARK ON LAND? IF(BINFF.NE.0) CTICK(CEVBAL)=3 !HE GOT OUT, START BALLOON. GO TO 10 C 600 IF((PRSA.NE.BURNW).OR.(OCAN(PRSO).NE.RECEP)) GO TO 700 CALL RSPSUB(550,ODESC2(PRSO)) !LIGHT FIRE IN RECEP. CTICK(CEVBRN)=OSIZE(PRSO)*20 OFLAG1(PRSO)=(OFLAG1(PRSO).OR.(ONBT+FLAMBT+LITEBT)).AND. 1 .NOT.(TAKEBT+READBT) !BURN IT. IF(BINFF.NE.0) RETURN !ALREADY INFLATED? IF(.NOT.BLABF) CALL NEWSTA(BLABE,0,0,BALLO,0) !INSERT LABEL. BLABF=.TRUE. !ONLY ONCE. BINFF=PRSO CTICK(CEVBAL)=3 !START COUNTDOWN. CALL RSPEAK(551) RETURN C 700 IF((PRSA.EQ.UNBOAW).AND.(BINFF.NE.0).AND. 1 ((RFLAG(HERE).AND.RLAND).NE.0)) 2 CTICK(CEVBAL)=3 GO TO 10 C END C CEVAPP- CLOCK EVENT APPLICABLES C C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED C WRITTEN BY R. M. SUPNIK C C DECLARATIONS C SUBROUTINE CEVAPP(RI) IMPLICIT INTEGER (A-Z) INTEGER CNDTCK(10),LMPTCK(12) LOGICAL FINDXT,LIT,RMDESC,QOPEN,MOVETO LOGICAL F,QLEDGE,QVAIR,QHERE,PROB C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD, 1 LTSHFT,BLOC,MUNGRM,HS,EGSCOR,EGMXSC C C ROOMS C COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200), 1 RACTIO(200),RVAL(200),RFLAG(200) INTEGER RRAND(200) EQUIVALENCE (RVAL,RRAND) C COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR, 1 RSACRD,RFILL,RMUNG,RBUCK,RHOUSE,RNWALL,REND C COMMON /RINDEX/ WHOUS,LROOM,CELLA COMMON /RINDEX/ MTROL,MAZE1 COMMON /RINDEX/ MGRAT,MAZ15 COMMON /RINDEX/ FORE1,FORE3,CLEAR,RESER COMMON /RINDEX/ STREA,EGYPT,ECHOR COMMON /RINDEX/ TSHAF COMMON /RINDEX/ BSHAF,MMACH,DOME,MTORC COMMON /RINDEX/ CAROU COMMON /RINDEX/ RIDDL,LLD2,TEMP1,TEMP2,MAINT COMMON /RINDEX/ BLROO,TREAS,RIVR1,RIVR2,RIVR3,MCYCL COMMON /RINDEX/ RIVR4,RIVR5,FCHMP,FALLS,MBARR COMMON /RINDEX/ MRAIN,POG,VLBOT,VAIR1,VAIR2,VAIR3,VAIR4 COMMON /RINDEX/ LEDG2,LEDG3,LEDG4,MSAFE,CAGER COMMON /RINDEX/ CAGED,TWELL,BWELL,ALICE,ALISM,ALITR COMMON /RINDEX/ MTREE,BKENT,BKVW,BKTWI,BKVAU,BKBOX COMMON /RINDEX/ CRYPT,TSTRS,MRANT,MREYE COMMON /RINDEX/ MRA,MRB,MRC,MRG,MRD,FDOOR COMMON /RINDEX/ MRAE,MRCE,MRCW,MRGE,MRGW,MRDW,INMIR COMMON /RINDEX/ SCORR,NCORR,PARAP,CELL,PCELL,NCELL COMMON /RINDEX/ CPANT,CPOUT,CPUZZ C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT, 1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT, 2 TOOLBT,TURNBT,ONBT COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT, 1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT, 2 TCHBT,VEHBT,SCHBT C COMMON /OINDEX/ GARLI,FOOD,GUNK,COAL,MACHI,DIAMO,TCASE,BOTTL COMMON /OINDEX/ WATER,ROPE,KNIFE,SWORD,LAMP,BLAMP,RUG COMMON /OINDEX/ LEAVE,TROLL,AXE COMMON /OINDEX/ RKNIF,KEYS,ICE,BAR COMMON /OINDEX/ COFFI,TORCH,TBASK,FBASK,IRBOX COMMON /OINDEX/ GHOST,TRUNK,BELL,BOOK,CANDL COMMON /OINDEX/ MATCH,TUBE,PUTTY,WRENC,SCREW,CYCLO,CHALI COMMON /OINDEX/ THIEF,STILL,WINDO,GRATE,DOOR COMMON /OINDEX/ HPOLE,LEAK,RBUTT,RAILI COMMON /OINDEX/ POT,STATU,IBOAT,DBOAT,PUMP,RBOAT COMMON /OINDEX/ STICK,BUOY,SHOVE,BALLO,RECEP,GUANO COMMON /OINDEX/ BROPE,HOOK1,HOOK2,SAFE,SSLOT,BRICK,FUSE COMMON /OINDEX/ GNOME,BLABE,DBALL,TOMB COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE COMMON /OINDEX/ ROBOT,FTREE,BILLS,PORTR,SCOL,ZGNOM COMMON /OINDEX/ EGG,BEGG,BAUBL,CANAR,BCANA COMMON /OINDEX/ YLWAL,RDWAL,PINDR,RBEAM COMMON /OINDEX/ ODOOR,QDOOR,CDOOR,NUM1,NUM8 COMMON /OINDEX/ WARNI,CSLIT,GCARD,STLDR COMMON /OINDEX/ HANDS,WALL,LUNGS,SAILO,AVIAT,TEETH COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,WNORT,GWATE,MASTER C C CLOCK INTERRUPTS C LOGICAL*1 CFLAG COMMON /CEVENT/ CLNT,CTICK(25),CACTIO(25),CFLAG(25) C COMMON /CINDEX/ CEVCUR,CEVMNT,CEVLNT,CEVMAT,CEVCND, 1 CEVBAL,CEVBRN,CEVFUS,CEVLED,CEVSAF,CEVVLG, 2 CEVGNO,CEVBUC,CEVSPH,CEVEGH, 3 CEVFOR,CEVSCL,CEVZGI,CEVZGO,CEVSTE, 5 CEVMRS,CEVPIN,CEVINQ,CEVFOL C C EXITS C COMMON /CURXT/ XTYPE,XROOM1,XSTRNG,XACTIO,XOBJ EQUIVALENCE (XFLAG,XOBJ) C COMMON /XSRCH/ XMIN,XMAX,XDOWN,XUP, 1 XNORTH,XSOUTH,XENTER,XEXIT,XEAST,XWEST C C VILLAINS AND DEMONS C LOGICAL THFFLG,SWDACT,THFACT COMMON /HACK/ THFPOS,THFFLG,THFACT,SWDACT,SWDSTA C C ADVENTURERS C COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4), 1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4) C COMMON /AINDEX/ PLAYER,AROBOT,AMASTR C C FLAGS C LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF, 1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF, 2 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF, 3 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF, 4 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF, 5 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF, 6 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF, 7 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ BTIEF,BINFF COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP COMMON /FINDEX/ MDIR,MLOC,POLEUF COMMON /FINDEX/ QUESNO,NQATT,CORRCT COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE C C FUNCTIONS AND DATA C QOPEN(R)=(OFLAG2(R).AND.OPENBT).NE.0 QLEDGE(R)=(R.EQ.LEDG2).OR.(R.EQ.LEDG3).OR.(R.EQ.LEDG4).OR. 1 (R.EQ.VLBOT) QVAIR(R)=(R.EQ.VAIR1).OR.(R.EQ.VAIR2).OR.(R.EQ.VAIR3).OR. 1 (R.EQ.VAIR4) DATA CNDTCK/50,20,10,5,0,156,156,156,157,0/ DATA LMPTCK/50,30,20,10,4,0,154,154,154,154,155,0/ C CEVAPP, PAGE 2 C IF(RI.EQ.0) RETURN !IGNORE DISABLED. GO TO (1000,2000,3000,4000,5000,6000,7000,8000,9000,10000, 1 11000,12000,13000,14000,15000,16000,17000,18000,19000, 2 20000,21000,22000,23000,24000),RI CALL BUG(3,RI) C C CEV1-- CURE CLOCK. LET PLAYER SLOWLY RECOVER. C 1000 ASTREN(PLAYER)=MIN0(0,ASTREN(PLAYER)+1) !RECOVER. IF(ASTREN(PLAYER).GE.0) RETURN !FULLY RECOVERED? CTICK(CEVCUR)=30 !NO, WAIT SOME MORE. RETURN C C CEV2-- MAINT-ROOM WITH LEAK. RAISE THE WATER LEVEL. C 2000 IF(HERE.EQ.MAINT) CALL RSPEAK(71+(RVMNT/2)) !DESCRIBE. RVMNT=RVMNT+1 !RAISE WATER LEVEL. IF(RVMNT.LE.16) RETURN !IF NOT FULL, EXIT. CTICK(CEVMNT)=0 !FULL, DISABLE CLOCK. RFLAG(MAINT)=RFLAG(MAINT).OR.RMUNG !MUNG ROOM. RRAND(MAINT)=80 !SAY IT IS FULL OF WATER. IF(HERE.EQ.MAINT) CALL JIGSUP(81) !DROWN HIM IF PRESENT. RETURN C C CEV3-- LANTERN. DESCRIBE GROWING DIMNESS. C 3000 CALL LITINT(LAMP,ORLAMP,CEVLNT,LMPTCK,12) !DO LIGHT INTERRUPT. RETURN C C CEV4-- MATCH. OUT IT GOES. C 4000 CALL RSPEAK(153) !MATCH IS OUT. OFLAG1(MATCH)=OFLAG1(MATCH).AND. .NOT.ONBT RETURN C C CEV5-- CANDLE. DESCRIBE GROWING DIMNESS. C 5000 CALL LITINT(CANDL,ORCAND,CEVCND,CNDTCK,10) !DO CANDLE INTERRUPT. RETURN C CEVAPP, PAGE 3 C C CEV6-- BALLOON C 6000 CTICK(CEVBAL)=3 !RESCHEDULE INTERRUPT. F=AVEHIC(WINNER).EQ.BALLO !SEE IF IN BALLOON. IF(BLOC.EQ.VLBOT) GO TO 6800 !AT BOTTOM? IF(QLEDGE(BLOC)) GO TO 6700 !ON LEDGE? IF(QOPEN(RECEP).AND.(BINFF.NE.0)) 1 GO TO 6500 !INFLATED AND RECEP OPEN?. C C BALLOON IS IN MIDAIR AND IS DEFLATED (OR HAS RECEPTACLE CLOSED). C FALL TO NEXT ROOM. C IF(BLOC.NE.VAIR1) GO TO 6300 !IN VAIR1? BLOC=VLBOT !YES, NOW AT VLBOT. CALL NEWSTA(BALLO,0,BLOC,0,0) IF(F) GO TO 6200 !IN BALLOON? IF(QLEDGE(HERE)) CALL RSPEAK(530) !ON LEDGE, DESCRIBE. RETURN C 6200 F=MOVETO(BLOC,WINNER) !MOVE HIM. IF(BINFF.EQ.0) GO TO 6250 !IN BALLOON. INFLATED? CALL RSPEAK(531) !YES, LANDED. F=RMDESC(0) !DESCRIBE. RETURN C 6250 CALL NEWSTA(BALLO,532,0,0,0) !NO, BALLOON & CONTENTS DIE. CALL NEWSTA(DBALL,0,BLOC,0,0) !INSERT DEAD BALLOON. AVEHIC(WINNER)=0 !NOT IN VEHICLE. CFLAG(CEVBAL)=.FALSE. !DISABLE INTERRUPTS. CFLAG(CEVBRN)=.FALSE. BINFF=0 BTIEF=0 RETURN C 6300 BLOC=BLOC-1 !NOT IN VAIR1, DESCEND. CALL NEWSTA(BALLO,0,BLOC,0,0) IF(F) GO TO 6400 !IS HE IN BALLOON? IF(QLEDGE(HERE)) CALL RSPEAK(533) !IF ON LEDGE, DESCRIBE. RETURN C 6400 F=MOVETO(BLOC,WINNER) !IN BALLOON, MOVE HIM. CALL RSPEAK(534) !DESCRIBE. F=RMDESC(0) RETURN C C BALLOON IS IN MIDAIR AND IS INFLATED, UP-UP-AND-AWAY! C 6500 IF(BLOC.NE.VAIR4) GO TO 6600 !AT VAIR4? CTICK(CEVBRN)=.FALSE. !DISABLE INTERRUPTS. CTICK(CEVBAL)=.FALSE. BINFF=0 BTIEF=0 BLOC=VLBOT !FALL TO BOTTOM. CALL NEWSTA(BALLO,0,0,0,0) !BALLOON & CONTENTS DIE. CALL NEWSTA(DBALL,0,BLOC,0,0) !SUBSTITUTE DEAD BALLOON. IF(F) GO TO 6550 !WAS HE IN IT? IF(QLEDGE(HERE)) CALL RSPEAK(535) !IF HE CAN SEE, DESCRIBE. RETURN C 6550 CALL JIGSUP(536) !IN BALLOON AT CRASH, DIE. RETURN C 6600 BLOC=BLOC+1 !NOT AT VAIR4, GO UP. CALL NEWSTA(BALLO,0,BLOC,0,0) IF(F) GO TO 6650 !IN BALLOON? IF(QLEDGE(HERE)) CALL RSPEAK(537) !CAN HE SEE IT? RETURN C 6650 F=MOVETO(BLOC,WINNER) !MOVE PLAYER. CALL RSPEAK(538) !DESCRIBE. F=RMDESC(0) RETURN C C ON LEDGE, GOES TO MIDAIR ROOM WHETHER INFLATED OR NOT. C 6700 BLOC=BLOC+(VAIR2-LEDG2) !MOVE TO MIDAIR. CALL NEWSTA(BALLO,0,BLOC,0,0) IF(F) GO TO 6750 !IN BALLOON? IF(QLEDGE(HERE)) CALL RSPEAK(539) !NO, STRANDED. CTICK(CEVVLG)=10 !MATERIALIZE GNOME. RETURN C 6750 F=MOVETO(BLOC,WINNER) !MOVE TO NEW ROOM. CALL RSPEAK(540) !DESCRIBE. F=RMDESC(0) RETURN C C AT BOTTOM, GO UP IF INFLATED, DO NOTHING IF DEFLATED. C 6800 IF((BINFF.EQ.0).OR..NOT.QOPEN(RECEP)) RETURN BLOC=VAIR1 !INFLATED AND OPEN, CALL NEWSTA(BALLO,0,BLOC,0,0) !GO UP TO VAIR1. IF(F) GO TO 6850 !IN BALLOON? IF(QLEDGE(HERE)) CALL RSPEAK(541) !IF CAN SEE, DESCRIBE. RETURN C 6850 F=MOVETO(BLOC,WINNER) !MOVE PLAYER. CALL RSPEAK(542) F=RMDESC(0) RETURN C CEVAPP, PAGE 4 C C CEV7-- BALLOON BURNUP C 7000 DO 7100 I=1,OLNT !FIND BURNING OBJECT IF((RECEP.EQ.OCAN(I)).AND.((OFLAG1(I).AND.FLAMBT).NE.0)) 1 GO TO 7200 !IN RECEPTACLE. 7100 CONTINUE CALL BUG(4,0) C 7200 CALL NEWSTA(I,0,0,0,0) !VANISH OBJECT. BINFF=0 !UNINFLATED. IF(HERE.EQ.BLOC) CALL RSPSUB(292,ODESC2(I)) !DESCRIBE. RETURN C C CEV8-- FUSE FUNCTION C 8000 IF(OCAN(FUSE).NE.BRICK) GO TO 8500 !IGNITED BRICK? BR=OROOM(BRICK) !GET BRICK ROOM. BC=OCAN(BRICK) !GET CONTAINER. IF((BR.EQ.0).AND.(BC.NE.0)) BR=OROOM(BC) CALL NEWSTA(FUSE,0,0,0,0) !KILL FUSE. CALL NEWSTA(BRICK,0,0,0,0) !KILL BRICK. IF((BR.NE.0).AND.(BR.NE.HERE)) GO TO 8100 !BRICK ELSEWHERE? C RFLAG(HERE)=RFLAG(HERE).OR.RMUNG !BLEW SELF. RRAND(HERE)=114 !MUNG ROOM. CALL JIGSUP(150) !DEAD. RETURN C 8100 CALL RSPEAK(151) !BOOM. MUNGRM=BR !SAVE ROOM THAT BLEW. CTICK(CEVSAF)=5 !SET SAFE INTERRUPT. IF(BR.NE.MSAFE) GO TO 8200 !BLEW SAFE ROOM? IF(BC.NE.SSLOT) RETURN !WAS BRICK IN SAFE? CALL NEWSTA(SSLOT,0,0,0,0) !KILL SLOT. OFLAG2(SAFE)=OFLAG2(SAFE).OR.OPENBT !OPEN SAFE. SAFEF=.TRUE. !INDICATE SAFE BLOWN. RETURN C 8200 DO 8250 I=1,OLNT !BLEW WRONG ROOM. IF(QHERE(I,BR) .AND. ((OFLAG1(I).AND.TAKEBT).NE.0)) 1 CALL NEWSTA(I,0,0,0,0) !VANISH CONTENTS. 8250 CONTINUE IF(BR.NE.LROOM) RETURN !BLEW LIVING ROOM? DO 8300 I=1,OLNT IF(OCAN(I).EQ.TCASE) CALL NEWSTA(I,0,0,0,0) !KILL TROPHY CASE. 8300 CONTINUE RETURN C 8500 IF(QHERE(FUSE,HERE).OR.(OADV(FUSE).EQ.WINNER)) 1 CALL RSPEAK(152) CALL NEWSTA(FUSE,0,0,0,0) !KILL FUSE. RETURN C CEVAPP, PAGE 5 C C CEV9-- LEDGE MUNGE. C 9000 RFLAG(LEDG4)=RFLAG(LEDG4).OR.RMUNG !LEDGE COLLAPSES. RRAND(LEDG4)=109 IF(HERE.EQ.LEDG4) GO TO 9100 !WAS HE THERE? CALL RSPEAK(110) !NO, NARROW ESCAPE. RETURN C 9100 IF(AVEHIC(WINNER).NE.0) GO TO 9200 !IN VEHICLE? CALL JIGSUP(111) !NO, DEAD. RETURN C 9200 IF(BTIEF.NE.0) GO TO 9300 !TIED TO LEDGE? CALL RSPEAK(112) !NO, NO PLACE TO LAND. RETURN C 9300 BLOC=VLBOT !YES, CRASH BALLOON. CALL NEWSTA(BALLO,0,0,0,0) !BALLOON & CONTENTS DIE. CALL NEWSTA(DBALL,0,BLOC,0,0) !INSERT DEAD BALLOON. BTIEF=0 BINFF=0 CFLAG(CEVBAL)=.FALSE. CFLAG(CEVBRN)=.FALSE. CALL JIGSUP(113) !DEAD RETURN C C CEV10-- SAFE MUNG. C 10000 RFLAG(MUNGRM)=RFLAG(MUNGRM).OR.RMUNG !MUNG TARGET. RRAND(MUNGRM)=114 IF(HERE.EQ.MUNGRM) GO TO 10100 !IS HE PRESENT? CALL RSPEAK(115) !LET HIM KNOW. IF(MUNGRM.EQ.MSAFE) CTICK(CEVLED)=8 !START LEDGE CLOCK. RETURN C 10100 I=116 !HE'S DEAD, IF((RFLAG(HERE).AND.RHOUSE).NE.0) I=117 !ONE WAY OR ANOTHER. CALL JIGSUP(I) !LET HIM KNOW. RETURN C CEVAPP, PAGE 6 C C CEV11-- VOLCANO GNOME C 11000 IF(QLEDGE(HERE)) GO TO 11100 !IS HE ON LEDGE? CTICK(CEVVLG)=1 !NO, WAIT A WHILE. RETURN C 11100 CALL NEWSTA(GNOME,118,HERE,0,0) !YES, MATERIALIZE GNOME. RETURN C C CEV12-- VOLCANO GNOME DISAPPEARS C 12000 CALL NEWSTA(GNOME,149,0,0,0) !DISAPPEAR THE GNOME. RETURN C C CEV13-- BUCKET. C 13000 IF(OCAN(WATER).EQ.BUCKE) 1 CALL NEWSTA(WATER,0,0,0,0) !WATER LEAKS OUT. RETURN C C CEV14-- SPHERE. IF EXPIRES, HE'S TRAPPED. C 14000 RFLAG(CAGER)=RFLAG(CAGER).OR.RMUNG !MUNG ROOM. RRAND(CAGER)=147 CALL JIGSUP(148) !MUNG PLAYER. RETURN C C CEV15-- END GAME HERALD. C 15000 ENDGMF=.TRUE. !WE'RE IN ENDGAME. CALL RSPEAK(119) !INFORM OF ENDGAME. RETURN C CEVAPP, PAGE 7 C C CEV16-- FOREST MURMURS C 16000 CFLAG(CEVFOR)=(HERE.EQ.MTREE).OR. 1 ((HERE.GE.FORE1).AND.(HERE.LT.CLEAR)) IF(CFLAG(CEVFOR).AND.PROB(10,10)) CALL RSPEAK(635) RETURN C C CEV17-- SCOL ALARM C 17000 IF(HERE.EQ.BKTWI) CFLAG(CEVZGI)=.TRUE. !IF IN TWI, GNOME. IF(HERE.EQ.BKVAU) CALL JIGSUP(636) !IF IN VAU, DEAD. RETURN C C CEV18-- ENTER GNOME OF ZURICH C 18000 CFLAG(CEVZGO)=.TRUE. !EXITS, TOO. CALL NEWSTA(ZGNOM,0,BKTWI,0,0) !PLACE IN TWI. IF(HERE.EQ.BKTWI) CALL RSPEAK(637) !ANNOUNCE. RETURN C C CEV19-- EXIT GNOME C 19000 CALL NEWSTA(ZGNOM,0,0,0,0) !VANISH. IF(HERE.EQ.BKTWI) CALL RSPEAK(638) !ANNOUNCE. RETURN C CEVAPP, PAGE 8 C C CEV20-- START OF ENDGAME C 20000 IF(SPELLF) GO TO 20200 !SPELL HIS WAY IN? IF(HERE.NE.CRYPT) RETURN !NO, STILL IN TOMB? IF(.NOT.LIT(HERE)) GO TO 20100 !LIGHTS OFF? CTICK(CEVSTE)=3 !RESCHEDULE. RETURN C 20100 CALL RSPEAK(727) !ANNOUNCE. 20200 DO 20300 I=1,OLNT !STRIP HIM OF OBJS. CALL NEWSTA(I,0,OROOM(I),OCAN(I),0) 20300 CONTINUE CALL NEWSTA(LAMP,0,0,0,PLAYER) !GIVE HIM LAMP. CALL NEWSTA(SWORD,0,0,0,PLAYER) !GIVE HIM SWORD. C OFLAG1(LAMP)=(OFLAG1(LAMP).OR.LITEBT).AND. .NOT.ONBT OFLAG2(LAMP)=OFLAG2(LAMP).OR.TCHBT CFLAG(CEVLNT)=.FALSE. !LAMP IS GOOD AS NEW. CTICK(CEVLNT)=350 ORLAMP=0 OFLAG2(SWORD)=OFLAG2(SWORD).OR.TCHBT !RECREATE SWORD. SWDACT=.TRUE. SWDSTA=0 C THFACT=.FALSE. !THIEF GONE. ENDGMF=.TRUE. !ENDGAME RUNNING. CFLAG(CEVMAT)=.FALSE. !MATCHES GONE, CFLAG(CEVCND)=.FALSE. !CANDLES GONE. C CALL SCRUPD(RVAL(CRYPT)) !SCORE CRYPT, RVAL(CRYPT)=0 !BUT ONLY ONCE. F=MOVETO(TSTRS,WINNER) !TO TOP OF STAIRS, F=RMDESC(3) !AND DESCRIBE. RETURN !BAM! C C CEV21-- MIRROR CLOSES. C 21000 MRPSHF=.FALSE. !BUTTON IS OUT. MROPNF=.FALSE. !MIRROR IS CLOSED. IF(HERE.EQ.MRANT) CALL RSPEAK(728) !DESCRIBE BUTTON. IF((HERE.EQ.INMIR).OR.(MRHERE(HERE).EQ.1)) 1 CALL RSPEAK(729) !DESCRIBE MIRROR. RETURN C CEVAPP, PAGE 9 C C CEV22-- DOOR CLOSES. C 22000 IF(WDOPNF) CALL RSPEAK(730) !DESCRIBE. WDOPNF=.FALSE. !CLOSED. RETURN C C CEV23-- INQUISITOR'S QUESTION C 23000 IF(AROOM(PLAYER).NE.FDOOR) RETURN !IF PLAYER LEFT, DIE. CALL RSPEAK(769) CALL RSPEAK(770+QUESNO) CTICK(CEVINQ)=2 RETURN C C CEV24-- MASTER FOLLOWS C 24000 IF(AROOM(AMASTR).EQ.HERE) RETURN !NO MOVEMENT, DONE. IF((HERE.NE.CELL).AND.(HERE.NE.PCELL)) GO TO 24100 IF(FOLLWF) CALL RSPEAK(811) !WONT GO TO CELLS. FOLLWF=.FALSE. RETURN C 24100 FOLLWF=.TRUE. !FOLLOWING. I=812 !ASSUME CATCHES UP. DO 24200 J=XMIN,XMAX,XMIN IF(FINDXT(J,AROOM(AMASTR)).AND.(XROOM1.EQ.HERE)) 1 I=813 !ASSUME FOLLOWS. 24200 CONTINUE CALL RSPEAK(I) CALL NEWSTA(MASTER,0,HERE,0,0) !MOVE MASTER OBJECT. AROOM(AMASTR)=HERE !MOVE MASTER PLAYER. RETURN C END C LITINT- LIGHT INTERRUPT PROCESSOR C C DECLARATIONS C SUBROUTINE LITINT(OBJ,CTR,CEV,TICKS,TICKLN) IMPLICIT INTEGER (A-Z) INTEGER TICKS(TICKLN) C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT, 1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT, 2 TOOLBT,TURNBT,ONBT COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT, 1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT, 2 TCHBT,VEHBT,SCHBT C C CLOCK INTERRUPTS C LOGICAL*1 CFLAG COMMON /CEVENT/ CLNT,CTICK(25),CACTIO(25),CFLAG(25) C CTR=CTR+1 !ADVANCE STATE CNTR. CTICK(CEV)=TICKS(CTR) !RESET INTERRUPT. IF(CTICK(CEV).NE.0) GO TO 100 !EXPIRED? OFLAG1(OBJ)=OFLAG1(OBJ).AND. .NOT.(LITEBT+FLAMBT+ONBT) IF((OROOM(OBJ).EQ.HERE).OR.(OADV(OBJ).EQ.WINNER)) 1 CALL RSPSUB(293,ODESC2(OBJ)) RETURN C 100 IF((OROOM(OBJ).EQ.HERE).OR.(OADV(OBJ).EQ.WINNER)) 1 CALL RSPEAK(TICKS(CTR+(TICKLN/2))) RETURN C END C FIGHTD- INTERMOVE FIGHT DEMON C C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED C WRITTEN BY R. M. SUPNIK C C DECLARATIONS C SUBROUTINE FIGHTD IMPLICIT INTEGER (A-Z) LOGICAL PROB,OAPPLI C C PARSER OUTPUT C LOGICAL PRSWON COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT, 1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT, 2 TOOLBT,TURNBT,ONBT COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT, 1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT, 2 TCHBT,VEHBT,SCHBT C COMMON /OINDEX/ GARLI,FOOD,GUNK,COAL,MACHI,DIAMO,TCASE,BOTTL COMMON /OINDEX/ WATER,ROPE,KNIFE,SWORD,LAMP,BLAMP,RUG COMMON /OINDEX/ LEAVE,TROLL,AXE COMMON /OINDEX/ RKNIF,KEYS,ICE,BAR COMMON /OINDEX/ COFFI,TORCH,TBASK,FBASK,IRBOX COMMON /OINDEX/ GHOST,TRUNK,BELL,BOOK,CANDL COMMON /OINDEX/ MATCH,TUBE,PUTTY,WRENC,SCREW,CYCLO,CHALI COMMON /OINDEX/ THIEF,STILL,WINDO,GRATE,DOOR COMMON /OINDEX/ HPOLE,LEAK,RBUTT,RAILI COMMON /OINDEX/ POT,STATU,IBOAT,DBOAT,PUMP,RBOAT COMMON /OINDEX/ STICK,BUOY,SHOVE,BALLO,RECEP,GUANO COMMON /OINDEX/ BROPE,HOOK1,HOOK2,SAFE,SSLOT,BRICK,FUSE COMMON /OINDEX/ GNOME,BLABE,DBALL,TOMB COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE COMMON /OINDEX/ ROBOT,FTREE,BILLS,PORTR,SCOL,ZGNOM COMMON /OINDEX/ EGG,BEGG,BAUBL,CANAR,BCANA COMMON /OINDEX/ YLWAL,RDWAL,PINDR,RBEAM COMMON /OINDEX/ ODOOR,QDOOR,CDOOR,NUM1,NUM8 COMMON /OINDEX/ WARNI,CSLIT,GCARD,STLDR COMMON /OINDEX/ HANDS,WALL,LUNGS,SAILO,AVIAT,TEETH COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,WNORT,GWATE,MASTER C C VILLAINS AND DEMONS C COMMON /VILL/ VLNT,VILLNS(4),VPROB(4),VOPPS(4),VBEST(4),VMELEE(4) C C ADVENTURERS C COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4), 1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4) C COMMON /AFLAGS/ ASTAG C COMMON /AINDEX/ PLAYER,AROBOT,AMASTR C C VERBS C COMMON /VINDEX/ CINTW,DEADXW,FRSTQW,INXW,OUTXW COMMON /VINDEX/ WALKIW,FIGHTW,FOOW COMMON /VINDEX/ MELTW,READW,INFLAW,DEFLAW,ALARMW,EXORCW COMMON /VINDEX/ PLUGW,KICKW,WAVEW,RAISEW,LOWERW,RUBW COMMON /VINDEX/ PUSHW,UNTIEW,TIEW,TIEUPW,TURNW,BREATW COMMON /VINDEX/ KNOCKW,LOOKW,EXAMIW,SHAKEW,MOVEW,TRNONW,TRNOFW COMMON /VINDEX/ OPENW,CLOSEW,FINDW,WAITW,SPINW,BOARDW,UNBOAW,TAKEW COMMON /VINDEX/ INVENW,FILLW,EATW,DRINKW,BURNW COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW COMMON /VINDEX/ DIGW,LEAPW,STAYW,FOLLOW COMMON /VINDEX/ HELLOW,LOOKIW,LOOKUW,PUMPW,WINDW COMMON /VINDEX/ CLMBW,CLMBUW,CLMBDW,TRNTOW C C FLAGS C LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF, 1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF, 2 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF, 3 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF, 4 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF, 5 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF, 6 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF, 7 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ BTIEF,BINFF COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP COMMON /FINDEX/ MDIR,MLOC,POLEUF COMMON /FINDEX/ QUESNO,NQATT,CORRCT COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE C C FUNCTIONS AND DATA C DATA ROUT/1/ C FIGHTD, PAGE 2 C DO 2400 I=1,VLNT !LOOP THRU VILLAINS. VOPPS(I)=0 !CLEAR OPPONENT SLOT. OBJ=VILLNS(I) !GET OBJECT NO. RA=OACTIO(OBJ) !GET HIS ACTION. IF(HERE.NE.OROOM(OBJ)) GO TO 2200 !ADVENTURER STILL HERE? IF((OBJ.EQ.THIEF).AND.THFENF) GO TO 2400 !THIEF ENGROSSED? IF(OCAPAC(OBJ).GE.0) GO TO 2050 !YES, VILL AWAKE? IF((VPROB(I).EQ.0).OR..NOT.PROB(VPROB(I),VPROB(I))) 1 GO TO 2025 !NO, SEE IF WAKES UP. OCAPAC(OBJ)=IABS(OCAPAC(OBJ)) VPROB(I)=0 IF(RA.EQ.0) GO TO 2400 !ANYTHING TO DO? PRSA=INXW !YES, WAKE HIM UP. F=OAPPLI(RA,0) GO TO 2400 !NOTHING ELSE HAPPENS. C 2025 VPROB(I)=VPROB(I)+10 !INCREASE WAKEUP PROB. GO TO 2400 !NOTHING ELSE. C 2050 IF((OFLAG2(OBJ).AND.FITEBT).EQ.0) GO TO 2100 VOPPS(I)=OBJ !FIGHTING, SET UP OPP. GO TO 2400 C 2100 IF(RA.EQ.0) GO TO 2400 !NOT FIGHTING, PRSA=FRSTQW !SET UP PROBABILITY IF(.NOT.OAPPLI(RA,0)) GO TO 2400 !OF FIGHTING. OFLAG2(OBJ)=OFLAG2(OBJ).OR.FITEBT VOPPS(I)=OBJ !SET UP OPP. GO TO 2400 C 2200 IF(((OFLAG2(OBJ).AND.FITEBT).EQ.0).OR.(RA.EQ.0)) 1 GO TO 2300 !NOTHING TO DO. PRSA=FIGHTW !HAVE A FIGHT. F=OAPPLI(RA,0) 2300 IF(OBJ.EQ.THIEF) THFENF=.FALSE. !TURN OFF ENGROSSED. AFLAG(PLAYER)=AFLAG(PLAYER).AND. .NOT.ASTAG OFLAG2(OBJ)=OFLAG2(OBJ).AND. .NOT.(STAGBT+FITEBT) IF((OCAPAC(OBJ).GE.0).OR.(RA.EQ.0)) 1 GO TO 2400 PRSA=INXW !WAKE HIM UP. F=OAPPLI(RA,0) OCAPAC(OBJ)=IABS(OCAPAC(OBJ)) 2400 CONTINUE C FIGHTD, PAGE 3 C C NOW DO ACTUAL COUNTERBLOWS. C OUT=0 !ASSUME HERO OK. 2600 DO 2700 I=1,VLNT !LOOP THRU OPPS. J=VOPPS(I) IF(J.EQ.0) GO TO 2700 !SLOT EMPTY? PRSCON=1 !STOP CMD STREAM. RA=OACTIO(J) IF(RA.EQ.0) GO TO 2650 !VILLAIN ACTION? PRSA=FIGHTW !SEE IF IF(OAPPLI(RA,0)) GO TO 2700 !SPECIAL ACTION. 2650 RES=BLOW(PLAYER,J,VMELEE(I),.FALSE.,OUT) !STRIKE BLOW. IF(RES.LT.0) RETURN !IF HERO DEAD, EXIT. IF(RES.EQ.ROUT) OUT=2+RND(3) !IF HERO OUT, SET FLG. 2700 CONTINUE OUT=OUT-1 !DECREMENT OUT COUNT. IF(OUT.GT.0) GO TO 2600 !IF STILL OUT, GO AGAIN. RETURN C END C BLOW- STRIKE BLOW C C DECLARATIONS C INTEGER FUNCTION BLOW(H,V,RMK,HFLG,OUT) IMPLICIT INTEGER (A-Z) LOGICAL HFLG,OAPPLI,PROB INTEGER DEF1R(3),DEF2R(4),DEF3R(5) INTEGER RVECTR(66),RSTATE(45) C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG C C PARSE VECTOR C LOGICAL PRSWON COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON C C MISCELLANEOUS VARIABLES C COMMON /STAR/ MBASE,STRBIT C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT, 1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT, 2 TOOLBT,TURNBT,ONBT COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT, 1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT, 2 TCHBT,VEHBT,SCHBT C C C CLOCK INTERRUPTS C LOGICAL*1 CFLAG COMMON /CEVENT/ CLNT,CTICK(25),CACTIO(25),CFLAG(25) C COMMON /CINDEX/ CEVCUR,CEVMNT,CEVLNT,CEVMAT,CEVCND, 1 CEVBAL,CEVBRN,CEVFUS,CEVLED,CEVSAF,CEVVLG, 2 CEVGNO,CEVBUC,CEVSPH,CEVEGH, 3 CEVFOR,CEVSCL,CEVZGI,CEVZGO,CEVSTE, 5 CEVMRS,CEVPIN,CEVINQ,CEVFOL C C ADVENTURERS C COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4), 1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4) C COMMON /AFLAGS/ ASTAG C COMMON /AINDEX/ PLAYER,AROBOT,AMASTR C C VERBS C COMMON /VINDEX/ CINTW,DEADXW,FRSTQW,INXW,OUTXW COMMON /VINDEX/ WALKIW,FIGHTW,FOOW C C FUNCTIONS AND DATA C DATA RMISS/0/,ROUT/1/,RKILL/2/,RLIGHT/3/ DATA RSER/4/,RSTAG/5/,RLOSE/6/,RHES/7/,RSIT/8/ DATA DEF1R/1,2,3/ DATA DEF2R/13,23,24,25/ DATA DEF3R/35,36,46,47,57/ C DATA RVECTR/0,0,0,0,5,5,1,1,2,2,2,2, 1 0,0,0,0,0,5,5,3,3,1, 2 0,0,0,5,5,3,3,3,1,2,2,2, 3 0,0,0,0,0,5,5,3,3,4,4, 4 0,0,0,5,5,3,3,3,4,4,4, 5 0,5,5,3,3,3,3,4,4,4/ DATA RSTATE/5000,3005,3008,4011,3015,3018,1021,0,0, 1 5022,3027,3030,4033,3037,3040,1043,0,0, 2 4044,2048,4050,4054,5058,4063,4067,3071,1074, 3 4075,1079,4080,4084,4088,4092,4096,4100,1104, 4 4105,2109,4111,4115,4119,4123,4127,3131,3134/ C BLOW, PAGE 3 C RA=OACTIO(V) !GET VILLAIN ACTION, DV=ODESC2(V) !DESCRIPTION. BLOW=RMISS !ASSUME NO RESULT. D TYPE 10,H,V,RMK,HFLG,OUT D10 FORMAT(' BLOW 10-- ',3I7,L7,I7) IF(.NOT.HFLG) GO TO 1000 !HERO STRIKING BLOW? C C HERO IS ATTACKER, VILLAIN IS DEFENDER. C PBLOSE=10 !BAD LK PROB. OFLAG2(V)=OFLAG2(V).OR.FITEBT !YES, VILLAIN GETS MAD. IF((AFLAG(H).AND.ASTAG).EQ.0) GO TO 100 !HERO STAG? CALL RSPEAK(591) !YES, CANT FIGHT. AFLAG(H)=AFLAG(H).AND. .NOT.ASTAG RETURN C 100 ATT=FIGHTS(H,.TRUE.) !GET HIS STRENGTH. OA=ATT DEF=VILSTR(V) !GET VILL STRENGTH. OD=DEF DWEAP=0 !ASSUME NO WEAPON. DO 200 I=1,OLNT !SEARCH VILLAIN. IF((OCAN(I).EQ.V).AND.((OFLAG2(I).AND.WEAPBT).NE.0)) 1 DWEAP=I 200 CONTINUE IF(V.EQ.AOBJ(PLAYER)) GO TO 300 !KILLING SELF? IF(DEF.NE.0) GO TO 2000 !DEFENDER ALIVE? CALL RSPSUB(592,DV) !VILLAIN DEAD. RETURN C 300 CALL JIGSUP(593) !KILLING SELF. RETURN C C VILLAIN IS ATTACKER, HERO IS DEFENDER. C 1000 PBLOSE=50 !BAD LK PROB. AFLAG(H)=AFLAG(H).AND..NOT.ASTAG !VILL STRIKING. IF((OFLAG2(V).AND.STAGBT).EQ.0) GO TO 1200 !VILL STAGGERED? OFLAG2(V)=OFLAG2(V).AND. .NOT.STAGBT !MAKE HIM OK. CALL RSPSUB(594,DV) !DESCRIBE. RETURN C 1200 ATT=VILSTR(V) !SET UP ATT, DEF. OA=ATT DEF=FIGHTS(H,.TRUE.) IF(DEF.LE.0) RETURN !DONT ALLOW DEAD DEF. OD=FIGHTS(H,.FALSE.) DWEAP=IABS(FWIM(0,WEAPBT,0,0,H,.TRUE.)) !FIND A WEAPON. C BLOW, PAGE 4 C C PARTIES ARE NOW EQUIPPED. DEF CANNOT BE ZERO. C ATT MUST BE > 0. C 2000 CONTINUE D TYPE 2050,ATT,OA,DEF,OD,DWEAP D2050 FORMAT(' BLOW 2050-- ',5I7) IF(DEF.GT.0) GO TO 2100 !DEF ALIVE? RES=RKILL IF(HFLG) CALL RSPSUB(595,DV) !DEADER. GO TO 3000 C 2100 IF(DEF-2) 2200,2300,2400 !DEF <2,=2,>2 2200 ATT=MIN0(ATT,3) !SCALE ATT. TBL=DEF1R(ATT) !CHOOSE TABLE. GO TO 2500 C 2300 ATT=MIN0(ATT,4) !SCALE ATT. TBL=DEF2R(ATT) !CHOOSE TABLE. GO TO 2500 C 2400 ATT=ATT-DEF !SCALE ATT. ATT=MIN0(2,MAX0(-2,ATT))+3 TBL=DEF3R(ATT) C 2500 RES=RVECTR(TBL+RND(10)) !GET RESULT. IF(OUT.EQ.0) GO TO 2600 !WAS HE OUT? IF(RES.EQ.RSTAG) GO TO 2550 !YES, STAG--> HES. RES=RSIT !OTHERWISE, SITTING. GO TO 2600 2550 RES=RHES 2600 IF((RES.EQ.RSTAG).AND.(DWEAP.NE.0).AND.PROB(25,PBLOSE)) 1 RES=RLOSE !LOSE WEAPON. C MI=RSTATE(((RMK-1)*9)+RES+1) !CHOOSE TABLE ENTRY. IF(MI.EQ.0) GO TO 3000 I=(MOD(MI,1000)+RND(MI/1000))+MBASE+1 J=DV IF(.NOT.HFLG .AND.(DWEAP.NE.0)) J=ODESC2(DWEAP) D TYPE 2650,RES,MI,I,J,MBASE D2650 FORMAT(' BLOW 2650-- ',5I7) CALL RSPSUB(I,J) !PRESENT RESULT. C BLOW, PAGE 5 C C NOW APPLY RESULT C 3000 GO TO (4000,3100,3200,3300,3400,3500,3600,4000,3200),RES+1 C 3100 IF(HFLG) DEF=-DEF !UNCONSCIOUS. GO TO 4000 C 3200 DEF=0 !KILLED OR SITTING DUCK. GO TO 4000 C 3300 DEF=MAX0(0,DEF-1) !LIGHT WOUND. GO TO 4000 C 3400 DEF=MAX0(0,DEF-2) !SERIOUS WOUND. GO TO 4000 C 3500 IF(HFLG) GO TO 3550 !STAGGERED. AFLAG(H)=AFLAG(H).OR.ASTAG GO TO 4000 C 3550 OFLAG2(V)=OFLAG2(V).OR.STAGBT GO TO 4000 C 3600 CALL NEWSTA(DWEAP,0,HERE,0,0) !LOSE WEAPON. DWEAP=0 IF(HFLG) GO TO 4000 !IF HERO, DONE. DWEAP=IABS(FWIM(0,WEAPBT,0,0,H,.TRUE.)) !GET NEW. IF(DWEAP.NE.0) CALL RSPSUB(605,ODESC2(DWEAP)) C BLOW, PAGE 6 C 4000 BLOW=RES !RETURN RESULT. IF(.NOT.HFLG) GO TO 4500 !HERO? OCAPAC(V)=DEF !STORE NEW CAPACITY. IF(DEF.NE.0) GO TO 4100 !DEAD? OFLAG2(V)=OFLAG2(V).AND. .NOT.FITEBT !YES, NOT FIGHTING. CALL RSPSUB(572,DV) !HE DIES. CALL NEWSTA(V,0,0,0,0) !MAKE HIM DISAPPEAR. IF(RA.EQ.0) RETURN !IF NX TO DO, EXIT. PRSA=DEADXW !LET HIM KNOW. F=OAPPLI(RA,0) RETURN C 4100 IF((RES.NE.ROUT).OR.(RA.EQ.0)) RETURN PRSA=OUTXW !LET HIM BE OUT. F=OAPPLI(RA,0) RETURN C 4500 ASTREN(H)=-10000 !ASSUME DEAD. IF(DEF.NE.0) ASTREN(H)=DEF-OD IF(DEF.GE.OD) GO TO 4600 CTICK(CEVCUR)=30 CFLAG(CEVCUR)=.TRUE. 4600 IF(FIGHTS(H,.TRUE.).GT.0) RETURN ASTREN(H)=1-FIGHTS(H,.FALSE.) !HE'S DEAD. CALL JIGSUP(596) BLOW=-1 RETURN C END C SWORDD- SWORD INTERMOVE DEMON C C DECLARATIONS C SUBROUTINE SWORDD IMPLICIT INTEGER(A-Z) LOGICAL INFEST,FINDXT C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG C C EXITS C COMMON /CURXT/ XTYPE,XROOM1,XSTRNG,XACTIO,XOBJ EQUIVALENCE (XFLAG,XOBJ) C COMMON /XSRCH/ XMIN,XMAX,XDOWN,XUP, 1 XNORTH,XSOUTH,XENTER,XEXIT,XEAST,XWEST C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OINDEX/ GARLI,FOOD,GUNK,COAL,MACHI,DIAMO,TCASE,BOTTL COMMON /OINDEX/ WATER,ROPE,KNIFE,SWORD,LAMP,BLAMP,RUG COMMON /OINDEX/ LEAVE,TROLL,AXE COMMON /OINDEX/ RKNIF,KEYS,ICE,BAR COMMON /OINDEX/ COFFI,TORCH,TBASK,FBASK,IRBOX COMMON /OINDEX/ GHOST,TRUNK,BELL,BOOK,CANDL COMMON /OINDEX/ MATCH,TUBE,PUTTY,WRENC,SCREW,CYCLO,CHALI COMMON /OINDEX/ THIEF,STILL,WINDO,GRATE,DOOR COMMON /OINDEX/ HPOLE,LEAK,RBUTT,RAILI COMMON /OINDEX/ POT,STATU,IBOAT,DBOAT,PUMP,RBOAT COMMON /OINDEX/ STICK,BUOY,SHOVE,BALLO,RECEP,GUANO COMMON /OINDEX/ BROPE,HOOK1,HOOK2,SAFE,SSLOT,BRICK,FUSE COMMON /OINDEX/ GNOME,BLABE,DBALL,TOMB COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE COMMON /OINDEX/ ROBOT,FTREE,BILLS,PORTR,SCOL,ZGNOM COMMON /OINDEX/ EGG,BEGG,BAUBL,CANAR,BCANA COMMON /OINDEX/ YLWAL,RDWAL,PINDR,RBEAM COMMON /OINDEX/ ODOOR,QDOOR,CDOOR,NUM1,NUM8 COMMON /OINDEX/ WARNI,CSLIT,GCARD,STLDR COMMON /OINDEX/ HANDS,WALL,LUNGS,SAILO,AVIAT,TEETH COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,WNORT,GWATE,MASTER C C VILLAINS AND DEMONS C LOGICAL THFFLG,SWDACT,THFACT COMMON /HACK/ THFPOS,THFFLG,THFACT,SWDACT,SWDSTA C C ADVENTURERS C COMMON /AINDEX/ PLAYER,AROBOT,AMASTR C SWORDD, PAGE 2 C IF(OADV(SWORD).NE.PLAYER) GO TO 500 !HOLDING SWORD? NG=2 !ASSUME VILL CLOSE. IF(INFEST(HERE)) GO TO 300 !VILL HERE? NG=1 DO 200 I=XMIN,XMAX,XMIN !NO, SEARCH ROOMS. IF(.NOT.FINDXT(I,HERE)) GO TO 200 !ROOM THAT WAY? GO TO (50,200,50,50),XTYPE !SEE IF ROOM AT ALL. 50 IF(INFEST(XROOM1)) GO TO 300 !CHECK ROOM. 200 CONTINUE NG=0 !NO GLOW. C 300 IF(NG.EQ.SWDSTA) RETURN !ANY STATE CHANGE? CALL RSPEAK(NG+495) !YES, TELL NEW STATE. SWDSTA=NG RETURN C 500 SWDACT=.FALSE. !DROPPED SWORD, RETURN !DISABLE DEMON. END C INFEST- SUBROUTINE TO TEST FOR INFESTED ROOM C C DECLARATIONS C LOGICAL FUNCTION INFEST(R) IMPLICIT INTEGER(A-Z) C C ROOMS C COMMON /RINDEX/ WHOUS,LROOM,CELLA COMMON /RINDEX/ MTROL,MAZE1 COMMON /RINDEX/ MGRAT,MAZ15 COMMON /RINDEX/ FORE1,FORE3,CLEAR,RESER COMMON /RINDEX/ STREA,EGYPT,ECHOR COMMON /RINDEX/ TSHAF COMMON /RINDEX/ BSHAF,MMACH,DOME,MTORC COMMON /RINDEX/ CAROU COMMON /RINDEX/ RIDDL,LLD2,TEMP1,TEMP2,MAINT COMMON /RINDEX/ BLROO,TREAS,RIVR1,RIVR2,RIVR3,MCYCL COMMON /RINDEX/ RIVR4,RIVR5,FCHMP,FALLS,MBARR COMMON /RINDEX/ MRAIN,POG,VLBOT,VAIR1,VAIR2,VAIR3,VAIR4 COMMON /RINDEX/ LEDG2,LEDG3,LEDG4,MSAFE,CAGER COMMON /RINDEX/ CAGED,TWELL,BWELL,ALICE,ALISM,ALITR COMMON /RINDEX/ MTREE,BKENT,BKVW,BKTWI,BKVAU,BKBOX COMMON /RINDEX/ CRYPT,TSTRS,MRANT,MREYE COMMON /RINDEX/ MRA,MRB,MRC,MRG,MRD,FDOOR COMMON /RINDEX/ MRAE,MRCE,MRCW,MRGE,MRGW,MRDW,INMIR COMMON /RINDEX/ SCORR,NCORR,PARAP,CELL,PCELL,NCELL COMMON /RINDEX/ CPANT,CPOUT,CPUZZ C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OINDEX/ GARLI,FOOD,GUNK,COAL,MACHI,DIAMO,TCASE,BOTTL COMMON /OINDEX/ WATER,ROPE,KNIFE,SWORD,LAMP,BLAMP,RUG COMMON /OINDEX/ LEAVE,TROLL,AXE COMMON /OINDEX/ RKNIF,KEYS,ICE,BAR COMMON /OINDEX/ COFFI,TORCH,TBASK,FBASK,IRBOX COMMON /OINDEX/ GHOST,TRUNK,BELL,BOOK,CANDL COMMON /OINDEX/ MATCH,TUBE,PUTTY,WRENC,SCREW,CYCLO,CHALI COMMON /OINDEX/ THIEF,STILL,WINDO,GRATE,DOOR COMMON /OINDEX/ HPOLE,LEAK,RBUTT,RAILI COMMON /OINDEX/ POT,STATU,IBOAT,DBOAT,PUMP,RBOAT COMMON /OINDEX/ STICK,BUOY,SHOVE,BALLO,RECEP,GUANO COMMON /OINDEX/ BROPE,HOOK1,HOOK2,SAFE,SSLOT,BRICK,FUSE COMMON /OINDEX/ GNOME,BLABE,DBALL,TOMB COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE COMMON /OINDEX/ ROBOT,FTREE,BILLS,PORTR,SCOL,ZGNOM COMMON /OINDEX/ EGG,BEGG,BAUBL,CANAR,BCANA COMMON /OINDEX/ YLWAL,RDWAL,PINDR,RBEAM COMMON /OINDEX/ ODOOR,QDOOR,CDOOR,NUM1,NUM8 COMMON /OINDEX/ WARNI,CSLIT,GCARD,STLDR COMMON /OINDEX/ HANDS,WALL,LUNGS,SAILO,AVIAT,TEETH COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,WNORT,GWATE,MASTER C C VILLAINS AND DEMONS C LOGICAL THFFLG,SWDACT,THFACT COMMON /HACK/ THFPOS,THFFLG,THFACT,SWDACT,SWDSTA C C FLAGS C LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF, 1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF, 2 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF, 3 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF, 4 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF, 5 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF, 6 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF, 7 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ BTIEF,BINFF COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP COMMON /FINDEX/ MDIR,MLOC,POLEUF COMMON /FINDEX/ QUESNO,NQATT,CORRCT COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE C IF(.NOT.ENDGMF) INFEST=(OROOM(CYCLO).EQ.R).OR. 1 (OROOM(TROLL).EQ.R).OR. 2 ((OROOM(THIEF).EQ.R).AND.THFACT) IF(ENDGMF) INFEST=(R.EQ.MRG).OR.(R.EQ.MRGE).OR. 1 (R.EQ.MRGW).OR. 2 ((R.EQ.INMIR).AND.(MLOC.EQ.MRG)) RETURN END C GAME- MAIN COMMAND LOOP FOR DUNGEON C C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED C WRITTEN BY R. M. SUPNIK C C DECLARATIONS C SUBROUTINE GAME IMPLICIT INTEGER (A-Z) LOGICAL RMDESC,VAPPLI,RAPPLI,AAPPLI LOGICAL F,PARSE,FINDXT,XVEHIC,LIT LOGICAL*1 SECHO(4),GDTSTR(3) C C PARSER OUTPUT C LOGICAL PRSWON COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD, 1 LTSHFT,BLOC,MUNGRM,HS,EGSCOR,EGMXSC C C MISCELLANEOUS VARIABLES C LOGICAL*1 INLINE COMMON /INPUT/ INLNT,INLINE(78) COMMON /CHAN/ INPCH,OUTCH,DBCH C C ROOMS C COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200), 1 RACTIO(200),RVAL(200),RFLAG(200) INTEGER RRAND(200) EQUIVALENCE (RVAL,RRAND) C COMMON /RINDEX/ WHOUS,LROOM,CELLA COMMON /RINDEX/ MTROL,MAZE1 COMMON /RINDEX/ MGRAT,MAZ15 COMMON /RINDEX/ FORE1,FORE3,CLEAR,RESER COMMON /RINDEX/ STREA,EGYPT,ECHOR COMMON /RINDEX/ TSHAF COMMON /RINDEX/ BSHAF,MMACH,DOME,MTORC COMMON /RINDEX/ CAROU COMMON /RINDEX/ RIDDL,LLD2,TEMP1,TEMP2,MAINT COMMON /RINDEX/ BLROO,TREAS,RIVR1,RIVR2,RIVR3,MCYCL COMMON /RINDEX/ RIVR4,RIVR5,FCHMP,FALLS,MBARR COMMON /RINDEX/ MRAIN,POG,VLBOT,VAIR1,VAIR2,VAIR3,VAIR4 COMMON /RINDEX/ LEDG2,LEDG3,LEDG4,MSAFE,CAGER COMMON /RINDEX/ CAGED,TWELL,BWELL,ALICE,ALISM,ALITR COMMON /RINDEX/ MTREE,BKENT,BKVW,BKTWI,BKVAU,BKBOX COMMON /RINDEX/ CRYPT,TSTRS,MRANT,MREYE COMMON /RINDEX/ MRA,MRB,MRC,MRG,MRD,FDOOR COMMON /RINDEX/ MRAE,MRCE,MRCW,MRGE,MRGW,MRDW,INMIR COMMON /RINDEX/ SCORR,NCORR,PARAP,CELL,PCELL,NCELL COMMON /RINDEX/ CPANT,CPOUT,CPUZZ C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT, 1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT, 2 TOOLBT,TURNBT,ONBT COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT, 1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT, 2 TCHBT,VEHBT,SCHBT C COMMON /OINDEX/ GARLI,FOOD,GUNK,COAL,MACHI,DIAMO,TCASE,BOTTL COMMON /OINDEX/ WATER,ROPE,KNIFE,SWORD,LAMP,BLAMP,RUG COMMON /OINDEX/ LEAVE,TROLL,AXE COMMON /OINDEX/ RKNIF,KEYS,ICE,BAR COMMON /OINDEX/ COFFI,TORCH,TBASK,FBASK,IRBOX COMMON /OINDEX/ GHOST,TRUNK,BELL,BOOK,CANDL COMMON /OINDEX/ MATCH,TUBE,PUTTY,WRENC,SCREW,CYCLO,CHALI COMMON /OINDEX/ THIEF,STILL,WINDO,GRATE,DOOR COMMON /OINDEX/ HPOLE,LEAK,RBUTT,RAILI COMMON /OINDEX/ POT,STATU,IBOAT,DBOAT,PUMP,RBOAT COMMON /OINDEX/ STICK,BUOY,SHOVE,BALLO,RECEP,GUANO COMMON /OINDEX/ BROPE,HOOK1,HOOK2,SAFE,SSLOT,BRICK,FUSE COMMON /OINDEX/ GNOME,BLABE,DBALL,TOMB COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE COMMON /OINDEX/ ROBOT,FTREE,BILLS,PORTR,SCOL,ZGNOM COMMON /OINDEX/ EGG,BEGG,BAUBL,CANAR,BCANA COMMON /OINDEX/ YLWAL,RDWAL,PINDR,RBEAM COMMON /OINDEX/ ODOOR,QDOOR,CDOOR,NUM1,NUM8 COMMON /OINDEX/ WARNI,CSLIT,GCARD,STLDR COMMON /OINDEX/ HANDS,WALL,LUNGS,SAILO,AVIAT,TEETH COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,WNORT,GWATE,MASTER C C ADVENTURERS C COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4), 1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4) C COMMON /AINDEX/ PLAYER,AROBOT,AMASTR C C VERBS C COMMON /VINDEX/ CINTW,DEADXW,FRSTQW,INXW,OUTXW COMMON /VINDEX/ WALKIW,FIGHTW,FOOW COMMON /VINDEX/ MELTW,READW,INFLAW,DEFLAW,ALARMW,EXORCW COMMON /VINDEX/ PLUGW,KICKW,WAVEW,RAISEW,LOWERW,RUBW COMMON /VINDEX/ PUSHW,UNTIEW,TIEW,TIEUPW,TURNW,BREATW COMMON /VINDEX/ KNOCKW,LOOKW,EXAMIW,SHAKEW,MOVEW,TRNONW,TRNOFW COMMON /VINDEX/ OPENW,CLOSEW,FINDW,WAITW,SPINW,BOARDW,UNBOAW,TAKEW COMMON /VINDEX/ INVENW,FILLW,EATW,DRINKW,BURNW COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW COMMON /VINDEX/ DIGW,LEAPW,STAYW,FOLLOW COMMON /VINDEX/ HELLOW,LOOKIW,LOOKUW,PUMPW,WINDW COMMON /VINDEX/ CLMBW,CLMBUW,CLMBDW,TRNTOW C C FLAGS C LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF, 1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF, 2 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF, 3 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF, 4 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF, 5 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF, 6 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF, 7 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ BTIEF,BINFF COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP COMMON /FINDEX/ MDIR,MLOC,POLEUF COMMON /FINDEX/ QUESNO,NQATT,CORRCT COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE C C FUNCTIONS AND DATA C DATA SECHO/'E','C','H','O'/ DATA GDTSTR/'G','D','T'/ C GAME, PAGE 2 C C START UP, DESCRIBE CURRENT LOCATION. C CALL RSPEAK(1) !WELCOME ABOARD. F=RMDESC(3) !START GAME. C C NOW LOOP, READING AND EXECUTING COMMANDS. C 100 WINNER=PLAYER !PLAYER MOVING. TELFLG=.FALSE. !ASSUME NOTHING TOLD. IF(PRSCON.LE.1) CALL RDLINE(INLINE,INLNT,1) !READ COMMAND. C DO 150 I=1,3 !CALL ON GDT? IF(INLINE(I+PRSCON-1).NE.GDTSTR(I)) GO TO 200 150 CONTINUE CALL GDT !YES, INVOKE. GO TO 100 !ONWARD. C 200 MOVES=MOVES+1 PRSWON=PARSE(INLINE,INLNT,.TRUE.) !PARSE INPUT, NORMAL MODE. IF(.NOT.PRSWON) GO TO 400 !PARSE LOSES? IF(XVEHIC(1)) GO TO 400 !VEHICLE HANDLE? C IF(PRSA.EQ.TELLW) GO TO 2000 !TELL? 300 IF((PRSO.EQ.VALUA).OR.(PRSO.EQ.EVERY)) GO TO 900 IF(.NOT.VAPPLI(PRSA)) GO TO 400 !VERB OK? 350 IF(.NOT.ECHOF.AND.(HERE.EQ.ECHOR)) GO TO 1000 F=RAPPLI(RACTIO(HERE)) C 400 CALL XENDMV(TELFLG) !DO END OF MOVE. IF(.NOT.LIT(HERE)) PRSCON=1 GO TO 100 C 900 CALL VALUAC(VALUA) GO TO 350 C GAME, PAGE 3 C C SPECIAL CASE-- ECHO ROOM. C IF INPUT IS NOT 'ECHO' OR A DIRECTION, JUST ECHO. C 1000 CALL RDLINE(INLINE,INLNT,0) !READ LINE. MOVES=MOVES+1 !CHARGE FOR MOVES. DO 1100 I=1,4 !INPUT = ECHO? IF(INLINE(I).NE.SECHO(I)) GO TO 1300 1100 CONTINUE C DO 1200 I=5,78 !REST BLANK? IF(INLINE(I).NE.' ') GO TO 1300 1200 CONTINUE C CALL RSPEAK(571) !KILL THE ECHO. ECHOF=.TRUE. OFLAG2(BAR)=OFLAG2(BAR).AND. .NOT.SCRDBT !LET THIEF STEAL BAR. PRSWON=.TRUE. !FAKE OUT PARSER. PRSCON=1 !FORCE NEW INPUT. GO TO 400 C 1300 PRSWON=PARSE(INLINE,INLNT,.FALSE.) !PARSE INPUT, ECHO MODE. IF(.NOT.PRSWON .OR. (PRSA.NE.WALKW)) 1 GO TO 1400 !WALK? IF(FINDXT(PRSO,HERE)) GO TO 300 !VALID EXIT? C 1400 WRITE(OUTCH,1410) (INLINE(J),J=1,INLNT) !ECHO INPUT. 1410 FORMAT(1X,78A1) TELFLG=.TRUE. !INDICATE OUTPUT. GO TO 1000 !MORE ECHO ROOM. C GAME, PAGE 4 C C SPECIAL CASE-- TELL , NEW COMMAND C NOTE THAT WE CANNOT BE IN THE ECHO ROOM. C 2000 IF((OFLAG2(PRSO).AND.ACTRBT).NE.0) GO TO 2100 !ACTOR? CALL RSPEAK(602) !CANT DO IT. GO TO 350 !VAPPLI SUCCEEDS. C 2100 WINNER=OACTOR(PRSO) !NEW PLAYER. HERE=AROOM(WINNER) !NEW LOCATION. IF(PRSCON.LE.1) GO TO 2700 !ANY INPUT? IF(PARSE(INLINE,INLNT,.TRUE.)) GO TO 2150 !PARSE COMMAND. 2700 I=341 !FAILS. IF(TELFLG) I=604 !GIVE RESPONSE. CALL RSPEAK(I) 2600 WINNER=PLAYER !RESTORE STATE. HERE=AROOM(WINNER) GO TO 350 C 2150 IF(AAPPLI(AACTIO(WINNER))) GO TO 2400 !ACTOR HANDLE? IF(XVEHIC(1)) GO TO 2400 !VEHICLE HANDLE? IF((PRSO.EQ.VALUA).OR.(PRSO.EQ.EVERY)) GO TO 2900 IF(.NOT.VAPPLI(PRSA)) GO TO 2400 !VERB HANDLE? 2350 F=RAPPLI(RACTIO(HERE)) C 2400 CALL XENDMV(TELFLG) !DO END OF MOVE. GO TO 2600 !DONE. C 2900 CALL VALUAC(VALUA) !ALL OR VALUABLES. GO TO 350 C END C XENDMV- EXECUTE END OF MOVE FUNCTIONS. C C DECLARATIONS C SUBROUTINE XENDMV(FLAG) IMPLICIT INTEGER(A-Z) LOGICAL F,CLOCKD,FLAG,XVEHIC C C PARSER OUTPUT C LOGICAL PRSWON COMMON /PRSVEC/ PRSA,PRSO,PRSI,PRSWON,PRSCON C C VILLAINS AND DEMONS C LOGICAL THFFLG,SWDACT,THFACT COMMON /HACK/ THFPOS,THFFLG,THFACT,SWDACT,SWDSTA C IF(.NOT.FLAG) CALL RSPEAK(341) !DEFAULT REMARK. IF(THFACT) CALL THIEFD !THIEF DEMON. IF(PRSWON) CALL FIGHTD !FIGHT DEMON. IF(SWDACT) CALL SWORDD !SWORD DEMON. IF(PRSWON) F=CLOCKD(X) !CLOCK DEMON. IF(PRSWON) F=XVEHIC(2) !VEHICLE READOUT. RETURN END C XVEHIC- EXECUTE VEHICLE FUNCTION C C DECLARATIONS C LOGICAL FUNCTION XVEHIC(N) IMPLICIT INTEGER(A-Z) LOGICAL OAPPLI C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C C ADVENTURERS C COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4), 1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4) C XVEHIC=.FALSE. !ASSUME LOSES. AV=AVEHIC(WINNER) !GET VEHICLE. IF(AV.NE.0) XVEHIC=OAPPLI(OACTIO(AV),N) RETURN END 2 5 8257 585 191 100 190 -1994 -1613 -1615 -1617 -1619 0 0 -1621 0 0 -1622 -1624 -1625 -1626 -1627 -1628 -1629 -1630 -1631 -1632 -1633 -1634 -1635 -1636 -1637 0 -1638 -1639 -1640 -1641 -1642 -1643 -1644 -1646 -1648 -1650 0 -1651 -1654 0 0 0 -1657 -1659 -1662 0 -1664 -1666 -1668 -1671 0 0 -1675 -1677 -1679 -1681 -1683 -1685 -1688 -1694 -1697 -1699 -1703 -1706 -1709 -1710 -1713 -1714 -1715 -1716 -1717 -1718 -1719 -1720 -1723 -1724 -1727 0 0 0 0 -1730 -1732 0 -1735 -1736 -1738 -1741 -1743 -1744 -1745 -1746 -1753 0 0 -1754 -1756 -1760 0 -1762 -1765 0 -1772 -1775 -1779 -1786 -1789 -1794 -1796 -1799 -1802 -1805 -1807 -1810 0 -1812 -1815 -1817 -1819 -1820 0 -1822 -1825 -1830 -1833 -1838 -1847 -1850 -1852 -1855 -1858 -1860 -1863 0 -1868 0 -1871 0 0 -1873 -1883 -1890 -1891 -1894 -1897 -1902 -1907 0 -1910 -1921 -1927 -1933 -1941 -1949 -1951 -1952 -1959 0 -1962 -1965 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 -1969 -1972 0 0 0 0 0 -1975 -1991 0 0 0 0 0 0 0 0 0 0 0 0 1 5 10 15 20 29 39 40 47 54 64 68 71 74 77 78 81 82 86 91 94 95 101 104 108 112 117 118 122 126 129 135 141 146 152 158 167 171 174 188 195 203 206 210 215 220 222 224 227 230 233 236 238 241 243 246 249 252 255 258 260 264 267 269 270 272 275 279 282 286 292 295 299 302 303 307 316 317 318 322 326 331 336 363 366 370 374 378 379 380 382 386 388 395 398 401 403 404 408 411 413 420 422 424 429 432 435 442 447 454 458 462 469 0 474 477 479 481 483 484 493 495 505 507 509 512 0 513 0 515 517 524 529 536 538 539 541 548 575 577 0 578 581 584 588 595 597 600 603 606 609 610 0 0 611 620 621 627 631 634 644 657 678 699 701 713 728 736 744 752 760 768 0 0 0 0 776 803 807 813 815 817 826 831 840 842 0 850 855 859 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 2 0 3 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 5 0 0 0 0 0 11 11 11 11 11 6 0 0 7 8 9 0 0 0 10 0 0 0 0 12 12 0 13 0 0 0 0 0 0 0 0 0 0 14 0 0 0 0 0 0 0 0 0 0 15 15 16 17 18 19 0 0 20 0 0 0 0 0 0 0 0 0 21 22 0 0 0 23 0 0 25 0 27 0 0 0 0 0 0 28 28 29 0 30 0 31 0 32 0 33 0 0 0 0 0 0 0 0 0 0 0 0 34 0 35 0 58 36 0 0 37 0 0 0 0 0 24 0 0 0 0 0 0 0 26 0 48 0 0 47 42 41 40 39 38 51 45 45 44 44 43 43 39 39 39 39 46 50 49 0 0 52 53 54 55 56 57 0 59 60 0 0 0 0 0 0 0 0 0 0 5 0 0 0 0 10 0 0 25 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 30 0 0 0 0 0 0 0 10 25 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 10 0 0 0 0 0 0 0 0 0 0 0 0 0 0 5 10 0 0 0 0 0 0 0 15 0 0 0 0 0 0 0 0 0 0 15 20 0 0 0 0 0 0 0 0 35 0 0 0 0 0 0 0 0 0 0 0 0 0 8192 25632 25632 25632 25632 25664 8256 25664 8192 8192 8192 8192 8192 8192 8192 8192 8192 8192 8192 8192 8192 8192 8192 8192 8192 8192 8192 8192 8192 8192 25632 25632 25632 25632 25632 25632 8192 8192 8704 4128 8704 8704 4128 8192 8192 8192 8192 8192 8192 8192 24576 8192 8192 8192 8192 8192 8192 8192 8192 8192 8192 8192 8192 9216 8192 8192 8192 8192 8192 8192 8192 8192 8192 8192 9216 9216 8192 9216 8192 8192 8192 8192 8192 8192 8192 8192 8192 8192 8192 8192 8192 8192 24576 24576 8192 25600 25600 25088 24576 8192 8192 8192 8192 8192 24576 26144 5664 5664 5664 9728 9728 5664 5664 8192 9728 9728 9728 8192 8224 9728 25632 25120 25632 25632 25632 8192 3104 3104 3104 3104 8192 8192 8192 8192 24576 8192 8192 8192 8192 8192 8224 8320 8320 8192 8192 8192 24608 8192 8192 8192 8192 8192 8192 8192 24576 8192 8208 24592 24592 24592 24592 24592 24592 24592 24592 24592 24592 24592 24592 24592 24592 24592 24592 24592 24592 24592 24592 24592 24592 24592 24592 24592 24592 24592 24592 24592 24592 24576 24576 24576 0 0 0 0 0 0 0 0 0 0 886 3155 7178 10277 -31707 1027 5124 7199 -29440 -2877 7170 3077 1057 -27392 -2878 7170 3077 5152 -31488 -2879 1027 5124 3108 7942 0 63 -18682 0 63 7176 9223 10496 -2880 3845 0 63 -17659 0 63 -22522 3078 7782 -2881 13 -21751 0 66 3082 5202 7424 -2882 -22776 0 66 7177 3665 -2883 1 1537 -2884 1 -27125 -2885 1 7178 1035 5132 -29682 5131 1038 -29683 7180 1038 -23536 7181 1035 -29681 -27634 3089 1037 -26606 -25584 10256 3091 7186 -23530 9245 7186 2063 3092 -27618 2067 7188 -28651 -31724 1042 3096 10263 5148 7194 -24554 3094 7196 -23528 2073 10263 8220 -26598 10020 -2886 65 -26600 7184 6168 3100 9238 -31717 -27622 3094 10266 5143 -25576 7198 8221 2067 -27629 7197 5139 -30619 1055 3105 5152 7199 -23296 -2887 1028 3108 5154 7199 -23296 -2888 1056 3108 5156 7171 -23405 3197 1059 5154 7200 -23296 -2889 1059 4221 5154 7200 -23296 -2890 11033 -2891 65 6149 4131 1060 3108 7201 -27616 5121 10279 3157 -25562 7205 3151 -24532 11304 7210 5669 -2892 275 9776 -2893 275 15912 -2894 6 -31192 -2895 6 1065 5159 9259 10496 -2896 -20224 -2897 1071 11304 15912 -2898 6 -27096 -2899 6 11307 3111 -31699 12330 10280 -23296 -2900 9261 5252 -29146 -2901 275 1066 3116 -25042 0 8 7304 -27603 4137 -23500 8231 3170 -27565 3159 7252 -23466 7224 1078 -29644 7225 1079 -29643 1074 -22481 1079 7219 -22435 5170 -26568 5173 6195 -31649 3122 7226 -31690 3123 -31488 -2902 3128 10249 -31685 5178 8252 -30659 7246 -27589 7227 1086 -22272 -2903 5181 7231 -30654 10304 -29634 -23489 10313 -23480 1093 6211 -29634 5186 7238 9284 -30651 7235 2118 -29626 9286 2119 5186 -25533 10311 1096 7235 5188 9284 -29627 4165 9286 -24504 3138 7238 10305 -27577 2122 5195 -23487 -27575 1097 -26036 -2904 29 3149 9472 -2905 14923 -2906 29 -30133 -2907 29 -24500 -29636 3110 -21936 -2908 7 7248 10321 -23296 -2909 1106 5224 3082 -23296 -2910 7177 1105 5225 -22272 -2911 1626 0 516 5722 0 516 3679 0 516 7681 0 516 8752 0 516 2644 0 516 4665 0 516 6667 0 516 -17864 0 1284 1109 2097 -27565 5157 3156 -22272 -2912 5169 3170 -25344 -2913 5169 3190 1112 -25511 -26537 -29609 1107 -28581 10330 -29092 -2914 10 3215 -25509 9269 3678 -2915 11 -18850 -2916 11 3209 14429 -25507 7251 3127 -23456 7263 -29599 -25504 5168 10346 3158 -31645 5218 1124 -29596 5219 -25501 7198 1638 -2917 13 -22937 -2918 12 5221 -29688 10341 -29508 1105 8297 -23034 -2919 782 1106 5224 -25452 1122 9314 -21397 7274 12394 10348 9472 -2920 -29440 -2921 10349 9472 -2922 -29440 -2923 10352 3182 7285 9472 -2924 -20224 -2925 11373 -27025 -2926 30 11376 -31122 -2927 30 10353 3183 7284 12544 -2928 -23296 -2929 10354 7283 12403 -23296 -2930 11377 1140 -27528 11376 -27533 11373 -24458 5237 -24489 -18312 10354 1139 13431 3705 0 27 -22919 0 27 3194 -25480 4219 9849 0 27 8825 0 27 -24967 0 27 1146 -23428 9341 -22405 10364 5154 -25565 -31608 7299 -20349 12421 -25467 11392 5254 10496 -2931 -24962 0 17 3116 10496 -2932 -17152 -2933 11394 5255 10496 -2934 -24962 0 17 1155 -18301 -31611 5246 -25554 7262 1949 0 119 -18531 0 119 1675 0 1056 5771 0 1056 3723 0 1568 7819 0 1056 2704 0 1056 4752 0 1568 6800 0 1056 8848 0 1056 -17776 0 1568 7306 -27508 -31605 3216 -22272 -2935 7260 -23296 -2936 7310 8330 -29440 -2937 3218 8448 -2938 7424 -2939 -22272 -2940 14481 -25455 10273 -23296 -2941 8341 2198 -27543 1175 5268 -25445 1176 5268 -29541 -27500 -27500 1280 -2942 7829 -2943 1824 3734 -2944 1824 -27492 -31589 15241 0 119 -26743 0 119 1183 10399 -27392 -2945 5278 9374 -31584 1697 0 2080 2721 0 2080 8865 0 2080 -27489 1698 0 2080 2722 0 2080 8866 0 2080 5280 -18767 -2946 2336 1699 0 2080 2723 0 2080 8867 0 2080 5793 0 2080 4769 0 2080 6817 0 2080 -18767 -2947 2336 1700 0 2080 2724 0 2080 8868 0 2080 5794 0 2080 4770 0 2080 6818 0 2080 -18767 -2948 2336 1189 -27485 1190 2214 8358 5796 0 2080 4772 0 2080 -25948 0 2080 1970 0 173 14258 0 173 5797 0 2080 4773 0 2080 -25947 0 2080 14001 -2949 2336 7857 -2950 2336 1186 -27488 14001 -2951 2336 3761 -2952 2336 1186 -27488 14001 -2953 2336 7857 -2954 2336 1187 -27487 14001 -2955 2336 3761 -2956 2336 1187 -27487 14001 -2957 2336 7857 -2958 2336 1188 -27486 14001 -2959 2336 3761 -2960 2336 1188 -27486 1697 0 2592 5793 0 2592 3745 0 2592 7841 0 2592 2721 0 2592 8865 0 2592 4769 0 2592 6817 0 2592 -17759 0 2592 1203 -26714 0 173 7348 3253 1976 0 2988 -27470 5299 -31562 1206 -27469 3253 7348 1207 6072 0 175 -18504 0 175 5302 1280 -2961 -22272 -2962 15286 0 175 1974 0 175 -26701 -2963 2988 -18176 -2964 1280 -2965 6075 0 172 -17477 0 172 5309 7271 -21826 0 3104 1212 -28994 -2966 3373 1726 0 3616 2750 0 3616 3774 0 3616 4798 0 3616 5822 0 3616 6846 0 3616 7869 0 3616 8894 0 3616 -22852 0 3616 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 216 -2185 -2186 -2187 -2188 -2189 -2190 0 -2191 -2192 -2193 -2194 -2195 -2196 -2197 -2198 -2199 0 -2200 -2201 -2203 -2204 -2205 -2206 -2207 -2208 -2209 -2210 0 0 -2211 -2212 -2213 -2214 -2215 -2216 0 -2217 -2218 -2219 -2220 -2221 0 -2222 0 -2223 -2224 -2225 -2226 -2227 -2228 -2229 -2230 -2231 -2232 -2233 -2234 -2235 0 -2236 -2237 -2238 -2240 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 -2241 -2242 -2243 -2244 -2245 -2246 -2247 -2248 0 -2249 -2250 -2251 -2252 -2253 0 0 0 -2256 -2257 -2258 0 -2259 0 -2260 -2261 -2262 -2263 -2264 -2265 -2266 -2267 -2268 -2269 -2270 0 -2271 -2272 -2273 -2275 -2276 -2277 -2278 0 0 0 0 0 -2279 -2281 -2282 0 0 -2283 -2285 -2286 -2287 -2288 -2289 -2290 0 0 0 0 -2291 -2292 0 0 -2293 -2294 -2295 -2296 -2297 -2298 -2299 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 -2300 0 -2301 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 -2302 0 0 0 0 0 -2303 -2304 -2305 -2306 -2307 -2308 -2309 -2310 -2311 -2312 -2313 -2314 -2315 -2316 -2317 -2318 -2319 -2320 -2321 -2322 -2323 -2324 -2325 -2326 -2327 -2328 -2329 -2330 -2331 -2332 -2333 -2334 -2335 -2336 -2337 0 -2338 -2339 -2340 -2341 -2342 0 -2343 -2344 -2345 -2346 -2347 -2348 -2349 -2350 -2351 -2352 -2353 -2354 -2355 -2356 -2357 -2358 -2359 -2360 -2361 -2362 -2363 -2364 -2365 -2366 -2367 -2368 -2369 -2370 -2371 -2372 -2373 -2374 -2375 -2376 -2377 -2378 -2379 -2380 -2381 -2382 -2383 -2384 -2385 -2386 -2387 -2388 -2389 -2390 -2391 -2392 -2393 -2394 -2395 -2396 -2397 -2398 -2399 -2400 -2401 -2402 -2403 -2404 -2405 -2406 -2407 -2408 -2409 -2410 -2411 -2412 -2413 -2414 -2415 -2416 -2417 -2418 -2419 -2420 -2421 -2422 -2423 -2424 -2425 -2426 -2427 -2428 -2429 -2430 -2431 -2432 -2433 -2434 -2435 -2436 -2437 -2438 -2439 -2440 -2441 -2442 -2443 -2444 -2445 -2446 -2447 -2448 -2449 -2450 -2451 -2452 -2453 -2454 -2455 -2456 -2457 -2458 -2459 -2460 -2461 -2462 -2463 -2464 -2465 -2466 -2467 -2468 -2469 -2470 -2471 -2472 -2473 -2474 -2475 -2476 -2477 -2478 -2479 -2480 -2481 -2482 -2483 -2484 -2485 -2486 -2487 -2488 -2489 0 0 0 -2490 -2491 -2492 -2493 -2494 -2495 -2496 -2497 -2498 -2499 -2500 -2501 -2502 -2503 -2504 -2505 -2506 -2507 -2508 -2509 -2510 -2511 -2512 -2513 0 0 0 0 -2514 0 0 0 0 0 0 0 0 0 -2515 -2516 -2517 -2518 -2519 0 0 0 0 0 -2520 -2521 0 0 0 0 0 0 0 0 -2522 -2523 0 -2524 0 0 0 0 0 0 0 0 0 0 -2525 -2526 -2527 -2528 -2529 0 0 0 0 0 0 0 0 0 0 -2531 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 -2533 0 0 0 0 0 0 -2534 0 0 0 0 0 0 0 0 0 0 0 -2535 0 0 0 -2536 0 0 0 0 0 0 0 0 0 0 0 0 -2537 -2539 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 -2542 -2543 0 0 0 -2544 -2545 0 0 -2551 -2555 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 -2561 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 100 0 2 3 101 4 0 5 6 0 7 102 103 0 104 0 0 8 0 0 0 9 9 105 0 0 0 0 10 10 0 0 0 0 0 11 0 0 0 0 106 107 0 0 108 0 0 12 0 0 0 109 13 14 110 0 111 15 16 17 18 18 18 19 0 0 112 0 0 0 0 20 21 21 21 21 113 0 0 0 22 23 0 24 0 114 0 0 0 0 0 115 0 0 25 0 0 0 26 0 0 0 123 27 28 0 0 0 0 0 0 0 130 116 29 0 0 0 0 117 118 118 118 0 0 119 0 0 0 0 120 121 122 122 122 30 0 0 0 0 37 32 0 0 33 34 0 35 0 0 36 36 125 125 125 125 126 126 0 0 41 0 0 42 43 44 45 46 47 48 49 0 0 0 0 129 0 0 0 0 52 0 0 0 0 0 124 0 0 0 0 38 31 0 0 0 39 0 40 40 40 40 101 127 0 50 51 0 128 131 0 0 0 0 -24432 -23552 -23552 -24576 -24560 -24576 -32640 -24576 -30592 -22400 -24320 -24576 -24576 -24576 -24512 -24576 -32256 -24560 -32736 -32768 -24576 -24576 -24572 -32768 -24576 -24576 -24576 -32224 -32224 -32736 -24576 -24576 -24448 -24499 -30720 -32256 -24576 -24576 8320 -24576 -16384 -32224 -24448 -15872 8192 -24576 -8048 -24503 -8176 -8176 -8192 -8176 -32640 -8064 -24572 -24572 -24572 -32736 -24448 -24560 -32736 -32768 -28160 -32254 -28160 4608 -15872 -32256 -32256 -32254 -32768 -32768 -32256 -32256 -32256 -32256 -32256 -32256 -32256 -32256 -32256 -32256 -32256 -32256 8192 8192 -24560 -24560 -24572 -24560 -8176 -24576 -32768 -24448 -24576 -24572 -24576 -32768 -32640 -32768 -32768 -32768 -32768 -8192 -32640 -8176 -32768 -24576 -24576 -24560 -32736 -8176 -24576 -8048 -8048 -8048 -8048 -8176 -11776 -32768 -24576 -8176 -30720 -24576 -32256 -32768 -32256 -32256 -32256 -15872 -15872 -22528 -32736 8192 -32768 -32768 -32768 -23552 -7168 -7168 -7168 -32736 -8176 -32256 -32256 -32256 -32256 -8176 -8176 -15872 -32256 -32736 -24560 -24448 -24448 -24576 -24576 -24576 -32256 -32256 -32256 -32256 -32256 -32256 -32256 -32256 -32256 -32256 -32256 -32256 -32256 4608 -28160 -28160 -28160 -32256 -32256 -32256 -32256 -32256 -32256 -32256 -32256 -32256 -32256 -8176 -32256 -8192 -32256 0 0 -32256 -32256 -24064 -24064 -32256 -32256 -32256 -32768 -32252 -32252 -32256 -32256 -32256 -32256 -32256 -32256 -32256 -30720 -32224 -32256 -32256 -32256 -32256 -32736 -32256 0 0 0 0 0 0 0 32 0 0 0 0 0 0 32 4096 512 512 0 0 32 0 128 512 512 0 0 32 0 8192 0 32 32 0 0 0 8192 0 40 0 0 0 0 0 8192 0 0 8192 0 0 0 0 0 0 0 0 0 0 0 0 0 128 0 0 128 512 0 0 0 0 0 0 0 0 0 0 32 0 0 0 0 0 0 0 0 0 32 2048 0 0 0 0 0 10 0 0 0 -32768 0 0 0 10 1 0 4096 0 0 0 0 0 8 0 9 0 0 0 0 0 0 0 0 0 32 8224 0 0 0 0 0 8224 0 0 0 -32768 -32768 0 0 0 0 0 10 0 0 0 0 9216 0 2048 2048 2048 2048 8192 8192 0 0 128 8 0 8 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 8 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 8 0 0 0 0 0 128 16 16 0 0 0 0 0 0 0 0 0 0 0 0 0 0 128 0 0 0 0 9216 0 0 0 0 0 0 0 0 0 0 5 0 10 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 10 12 9 0 0 0 15 4 3 14 0 0 5 0 0 10 0 0 2 0 15 0 0 0 0 0 0 0 0 0 0 0 0 0 10 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 10 10 0 0 0 0 0 0 0 0 5 0 0 0 0 0 0 0 0 10 0 0 0 15 0 0 0 0 0 0 0 0 0 4 0 0 0 0 0 0 0 6 0 0 0 0 0 0 0 5 0 0 0 0 0 0 0 0 0 0 0 0 0 10 10 0 0 0 0 5 0 1 6 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 15 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 5 0 6 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 5 10 5 0 0 0 8 11 7 6 0 0 3 0 0 10 0 0 5 0 8 0 0 0 0 0 0 0 0 0 0 0 0 0 10 7 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 10 13 0 0 0 0 0 0 0 0 10 0 0 0 0 0 0 0 0 12 0 0 0 10 0 0 0 0 0 0 0 0 0 10 0 0 0 0 0 0 0 6 0 0 0 0 0 0 0 5 0 0 0 0 0 0 0 0 0 0 0 0 0 15 5 0 0 0 0 5 0 1 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 10 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3 5 5 10 20 10 10000 5 10000 5 4 10 5 30 15 5 10000 25 10000 25 20 20 10 10000 15 20 10 10000 10000 10000 5 20 55 20 10000 10000 10 50 40 10 5 10000 10 5 35 5 5 10 5 2 2 2 10000 10 6 10 5 10000 10 15 10000 10 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 15 8 20 20 5 20 2 3 5 10 5 15 20 70 10000 10000 10000 10000 10000 10 10000 1 10000 10 9 1 10000 1 40 10 10 10 10 1 5 5 15 70 10000 60 0 10 5 5 5 5 5 10 0 8 10000 10000 100 10 4 4 4 0 3 5 5 5 5 10 25 5 5 5 20 6 6 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 4 5 4 5 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 15 0 0 0 0 0 50 0 10000 4 0 0 0 0 0 0 0 0 2 0 0 0 0 0 0 0 0 0 0 0 0 0 35 0 50 0 0 0 20 0 0 0 5 0 0 0 0 0 0 0 0 0 10 7 0 0 0 10000 5 0 5 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 100 0 0 0 20 0 0 0 100 6 0 0 0 0 0 15 0 10 0 2 0 0 0 0 2 2 2 2 0 0 0 0 0 10000 0 0 0 0 0 0 0 0 5 0 0 0 0 100 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 20 6 6 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1000 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6 0 0 0 74 78 77 0 8 6 0 7 7 8 8 0 8 36 10 0 16 16 16 16 16 49 92 50 51 45 46 47 44 80 61 76 64 75 83 0 90 93 95 96 40 96 97 97 99 8 99 0 2 100 0 100 100 101 103 105 190 0 5 98 25 8 8 2 91 77 0 93 94 98 79 93 98 100 100 100 100 100 78 120 122 116 106 0 41 0 0 106 120 112 0 118 118 126 0 0 0 131 133 131 135 0 135 0 7 42 0 0 0 134 134 134 134 0 137 137 137 137 0 0 141 140 139 139 139 143 142 146 146 146 144 145 143 144 144 144 144 138 138 147 33 123 110 154 156 155 155 0 147 0 0 0 0 0 177 177 177 177 177 177 177 177 177 177 177 159 160 179 166 185 182 183 183 183 183 183 183 183 183 183 183 188 26000 18500 26000 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 178 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 10 0 0 0 0 0 0 0 0 19 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 39 0 0 0 0 0 0 0 0 0 0 0 53 0 0 54 0 0 0 0 0 0 61 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 90 0 0 0 94 0 0 0 98 98 98 0 0 0 0 105 0 105 0 0 0 0 0 0 0 0 0 116 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 153 0 0 154 155 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 -2562 0 0 -2568 0 0 -2575 0 -2584 -2610 -2634 -2651 0 -2674 0 0 0 0 0 0 0 0 0 0 0 0 -2676 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 -2677 0 0 0 0 0 0 0 0 0 0 0 0 -2697 0 -2719 0 0 0 0 0 -2724 0 -2739 -2740 -2741 -2742 -2743 -2762 0 0 -2764 0 0 0 0 0 0 0 -2768 -2774 0 0 0 0 0 0 0 0 0 0 0 -2780 0 0 0 0 -2799 -2818 -2842 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 -2846 0 -2859 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 15 63 65 66 84 119 146 146 147 172 172 172 173 174 175 189 0 0 0 0 0 6 36 9 122 157 124 125 111 184 186 187 181 186 184 189 0 0 0 0 0 24 0 0 350 0 0 0 0 0 0 0 0 0 0 0 0 -1 0 5 12 0 0 0 0 0 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 0 F T F T T T T T T T T T T T F F T F F T F T T F F 3 19 61 58 0 0 0 0 0 0 0 0 0 14 13 0 0 4 5 3 0 3 2 138 178 0 0 0 0 0 0 0 0 0 193 142 215 0 0 1 2 0 0 3 3 0 0 0 0 0 885 1022 -1 -2 -3 -14 -115 -148 -149 -153 -155 -158 -159 -161 -162 -163 -167 -170 -173 -174 -175 -176 -177 -180 -181 -183 -184 -185 -186 -188 -189 -190 -191 -192 -195 -197 -200 -202 -203 -206 -207 -209 -210 -211 -214 -216 -217 -224 -225 -226 -227 -229 -231 -234 -236 -237 -242 -244 -245 -246 -249 -256 -258 -261 -262 -265 -271 -273 -276 -279 -282 -284 -285 -286 -287 -288 -289 -290 -291 -292 -293 -294 -295 -296 -298 -300 -301 -303 -304 -305 -306 -307 -308 -309 -310 -311 -312 -313 -316 -317 -318 -322 -325 -326 -327 -328 -330 -333 -334 -336 -337 -338 -339 -340 -341 -344 -345 -348 -350 -352 -356 -363 -369 -370 -372 -373 -374 -375 -376 -377 -379 -380 -381 -382 -383 -384 -385 -386 -387 -388 -389 -390 -391 -392 -393 -395 -396 -398 -400 -401 -402 -404 -406 -407 -408 -409 -410 -411 -412 -413 -414 -416 -418 -422 -426 -427 -428 -429 -430 -432 -433 -437 -439 -440 -441 -442 -443 -444 -445 -446 -447 -448 -449 -450 -452 -453 -454 -455 -456 -457 -459 -462 -464 -466 -467 -468 -469 -470 -471 -473 -474 -475 -477 -478 -479 -480 -482 -484 -485 -486 -487 -488 -489 -490 -491 -492 -493 -494 -495 -496 -498 -499 -500 -501 -502 -503 -504 -505 -508 -509 -510 -512 -513 -514 -515 -518 -519 -520 -521 -522 -523 -524 -525 -526 -527 -528 -529 -530 -532 -535 -536 -537 -538 -539 -540 -541 -542 -543 -544 -549 -551 -552 -555 -558 -560 -563 -567 -568 -569 -570 -571 -572 -573 -574 -576 -577 -579 -580 -581 -582 -583 -584 -585 -588 -589 -590 -593 -595 -596 -597 -602 -604 -605 -606 -608 -609 -612 -614 -615 -616 -617 -618 -619 -620 -622 -623 -625 -626 -627 -628 -629 -630 -631 -632 -633 -634 -635 -636 -637 -638 -639 -640 -641 -642 -643 -644 -645 -646 -647 -648 -649 -650 -651 -652 -653 -654 -655 -658 -659 -661 -662 -663 -664 -665 -666 -667 -668 -669 -670 -671 -672 -673 -674 -675 -676 -677 -678 -679 -680 -681 -682 -683 -684 -685 -686 -688 -689 -692 -693 -694 -695 -696 -697 -698 -699 -700 -701 -702 -703 -704 -705 -706 -707 -708 -709 -710 -711 -712 -713 -714 -715 -716 -717 -718 -719 -720 -721 -722 -723 -724 -725 -726 -727 -728 -729 -730 -731 -732 -733 -734 -735 -736 -737 -738 -739 -740 -741 -742 -743 -744 -745 -746 -747 -748 -749 -750 -751 -753 -754 -755 -756 -757 -758 -759 -760 -762 -764 -766 -768 -769 -770 -771 -772 -773 -774 -777 -778 -779 -780 -781 -782 -783 -784 -785 -786 -787 -788 -789 -790 -791 -793 -794 -795 -796 -797 -798 -799 -800 -801 -802 -803 -804 -805 -806 -807 -808 -809 -810 -811 -812 -813 -814 -815 -816 -817 -818 -819 -820 -821 -822 -823 -824 -825 -826 -827 -828 -829 -830 -831 -832 -834 -836 -837 -839 -840 -842 -844 -846 -847 -850 -851 -853 -854 -856 -857 -858 -859 -861 -862 -863 -864 -865 -866 -867 -868 -869 -870 -871 -872 -873 -874 -875 -876 -877 -878 -879 -880 -881 -883 -884 -885 -887 -888 -889 -890 -891 -893 -894 -895 -896 -897 -898 -899 -900 -901 -902 -903 -904 -905 -906 -907 -908 -909 -910 -911 -912 -913 -914 -915 -916 -917 -918 -919 -921 -924 -925 -926 -927 -928 -930 -931 -932 -933 -934 -935 -938 -941 -943 -945 -949 -951 -953 -955 -957 -958 -959 -960 -961 -963 -964 -965 -966 -967 -968 -969 -970 -971 -972 -974 -978 -981 -983 -985 -987 -988 -989 -990 -991 -992 -993 -994 -995 -996 -997 -998 -999 -1000 -1003 -1005 -1007 -1008 -1009 -1010 -1011 -1012 -1013 -1014 -1015 -1019 -1025 -1028 -1029 -1030 -1033 -1037 -1039 -1040 -1041 -1042 -1048 -1049 -1050 -1051 -1052 -1054 -1055 -1056 -1058 -1059 -1060 -1061 -1062 -1064 -1065 -1066 -1067 -1068 -1069 -1070 -1071 -1072 -1073 -1074 -1075 -1076 -1077 -1078 -1079 -1080 -1081 -1082 -1083 -1084 -1088 -1093 -1098 -1099 -1101 -1102 -1103 -1125 -1127 -1129 -1132 -1134 -1136 -1141 -1142 -1143 -1144 -1145 -1146 -1147 -1148 -1149 -1152 -1156 -1161 -1164 -1166 -1168 -1169 -1171 -1176 -1187 -1188 -1189 -1190 -1191 -1192 -1193 -1194 -1195 -1198 -1200 -1201 -1204 -1208 -1218 -1229 -1230 -1231 -1232 -1233 -1234 -1235 -1236 -1237 -1238 -1239 -1241 -1242 -1243 -1244 -1246 -1250 -1252 -1255 -1256 -1260 -1261 -1262 -1263 -1264 -1265 -1266 -1267 -1268 -1269 -1270 -1271 -1272 -1273 -1274 -1275 -1276 -1277 -1278 -1280 -1281 -1296 -1297 -1299 -1300 -1302 -1303 -1304 -1305 -1306 -1307 -1308 -1309 -1310 -1311 -1312 -1313 -1314 -1315 -1316 -1317 -1318 -1319 -1320 -1321 -1329 -1330 -1331 -1332 -1333 -1334 -1335 -1336 -1337 -1338 -1339 -1340 -1341 -1342 -1343 -1344 -1345 -1346 -1347 -1348 -1349 -1350 -1351 -1352 -1353 -1354 -1355 -1356 -1357 -1359 -1361 -1362 -1363 -1364 -1368 -1371 -1372 -1373 -1374 -1375 -1376 -1377 -1378 -1379 -1382 -1383 -1384 -1385 -1386 -1387 -1389 -1390 -1391 -1392 -1393 -1394 -1395 -1396 -1397 -1398 -1399 -1400 -1401 -1402 -1403 -1404 -1405 -1407 -1408 -1409 -1410 -1414 -1417 -1418 -1419 -1420 -1422 -1423 -1424 -1425 -1427 -1429 -1430 -1431 -1432 -1433 -1442 -1443 -1444 -1445 -1446 -1447 -1449 -1450 -1451 -1452 -1453 -1454 -1455 -1456 -1457 -1458 -1459 -1460 -1461 -1462 -1463 -1464 -1465 -1466 -1467 -1468 -1469 -1470 -1471 -1472 -1473 -1474 -1475 -1476 -1477 -1478 -1479 -1480 -1481 -1482 -1483 -1484 -1485 -1486 -1487 -1488 -1489 -1490 -1491 -1492 -1493 -1494 -1495 -1496 -1497 -1498 -1499 -1500 -1501 -1502 -1503 -1504 -1505 -1506 -1507 -1509 -1510 -1511 -1512 -1513 -1514 -1515 -1517 -1519 -1520 -1521 -1522 -1524 -1526 -1527 -1528 -1529 -1530 -1531 -1532 -1533 -1534 -1536 -1537 -1538 -1539 -1540 -1541 -1542 -1543 -1544 -1545 -1546 -1547 -1549 -1550 -1552 -1553 -1554 -1555 -1556 -1557 -1558 -1559 -1560 -1562 -1563 -1564 -1565 -1566 -1568 -1569 -1571 -1572 -1573 -1574 -1576 -1578 -1580 -1581 -1583 -1585 -1586 -1587 -1589 -1591 -1592 -1594 -1596 -1597 -1599 -1601 -1602 -1604 -1606 -1607 -1608 -1609 -1611 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 C INIT-- DUNGEON INITIALIZATION SUBROUTINE C C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED C WRITTEN BY R. M. SUPNIK C C DECLARATIONS C LOGICAL FUNCTION INIT(X) IMPLICIT INTEGER (A-Z) LOGICAL PROTCT C C PARSER OUTPUT C LOGICAL PRSWON COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON C C PARSER STATE C COMMON /ORPHS/ OFLAG,OACT,OSLOT,OPREP,ONAME COMMON /LAST/ LASTIT C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD, 1 LTSHFT,BLOC,MUNGRM,HS,EGSCOR,EGMXSC C C SCREEN OF LIGHT C COMMON /SCREEN/ FROMDR,SCOLRM,SCOLAC C C MESSAGE INDEX C COMMON /RMSG/ MLNT,RTEXT(1050) C C MISCELLANEOUS VARIABLES C COMMON /STAR/ MBASE,STRBIT COMMON /VERS/ VMAJ,VMIN,VEDIT COMMON /TIME/ PLTIME,SHOUR,SMIN,SSEC COMMON /CHAN/ INPCH,OUTCH,DBCH COMMON /DEBUG/ DBGFLG,PRSFLG,GDTFLG COMMON /HYPER/ HFACTR C C ROOMS C COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200), 1 RACTIO(200),RVAL(200),RFLAG(200) INTEGER RRAND(200) EQUIVALENCE (RVAL,RRAND) C COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR, 1 RSACRD,RFILL,RMUNG,RBUCK,RHOUSE,RNWALL,REND C COMMON /RINDEX/ WHOUS,LROOM,CELLA COMMON /RINDEX/ MTROL,MAZE1 COMMON /RINDEX/ MGRAT,MAZ15 COMMON /RINDEX/ FORE1,FORE3,CLEAR,RESER COMMON /RINDEX/ STREA,EGYPT,ECHOR COMMON /RINDEX/ TSHAF COMMON /RINDEX/ BSHAF,MMACH,DOME,MTORC COMMON /RINDEX/ CAROU COMMON /RINDEX/ RIDDL,LLD2,TEMP1,TEMP2,MAINT COMMON /RINDEX/ BLROO,TREAS,RIVR1,RIVR2,RIVR3,MCYCL COMMON /RINDEX/ RIVR4,RIVR5,FCHMP,FALLS,MBARR COMMON /RINDEX/ MRAIN,POG,VLBOT,VAIR1,VAIR2,VAIR3,VAIR4 COMMON /RINDEX/ LEDG2,LEDG3,LEDG4,MSAFE,CAGER COMMON /RINDEX/ CAGED,TWELL,BWELL,ALICE,ALISM,ALITR COMMON /RINDEX/ MTREE,BKENT,BKVW,BKTWI,BKVAU,BKBOX COMMON /RINDEX/ CRYPT,TSTRS,MRANT,MREYE COMMON /RINDEX/ MRA,MRB,MRC,MRG,MRD,FDOOR COMMON /RINDEX/ MRAE,MRCE,MRCW,MRGE,MRGW,MRDW,INMIR COMMON /RINDEX/ SCORR,NCORR,PARAP,CELL,PCELL,NCELL COMMON /RINDEX/ CPANT,CPOUT,CPUZZ C C EXITS C COMMON /EXITS/ XLNT,TRAVEL(900) C COMMON /CURXT/ XTYPE,XROOM1,XSTRNG,XACTIO,XOBJ EQUIVALENCE (XFLAG,XOBJ) C COMMON /XPARS/ XRMASK,XDMASK,XFMASK,XFSHFT,XASHFT, 1 XELNT(4),XNORM,XNO,XCOND,XDOOR,XLFLAG C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OROOM2/ R2LNT,O2(20),R2(20) C COMMON /OINDEX/ GARLI,FOOD,GUNK,COAL,MACHI,DIAMO,TCASE,BOTTL COMMON /OINDEX/ WATER,ROPE,KNIFE,SWORD,LAMP,BLAMP,RUG COMMON /OINDEX/ LEAVE,TROLL,AXE COMMON /OINDEX/ RKNIF,KEYS,ICE,BAR COMMON /OINDEX/ COFFI,TORCH,TBASK,FBASK,IRBOX COMMON /OINDEX/ GHOST,TRUNK,BELL,BOOK,CANDL COMMON /OINDEX/ MATCH,TUBE,PUTTY,WRENC,SCREW,CYCLO,CHALI COMMON /OINDEX/ THIEF,STILL,WINDO,GRATE,DOOR COMMON /OINDEX/ HPOLE,LEAK,RBUTT,RAILI COMMON /OINDEX/ POT,STATU,IBOAT,DBOAT,PUMP,RBOAT COMMON /OINDEX/ STICK,BUOY,SHOVE,BALLO,RECEP,GUANO COMMON /OINDEX/ BROPE,HOOK1,HOOK2,SAFE,SSLOT,BRICK,FUSE COMMON /OINDEX/ GNOME,BLABE,DBALL,TOMB COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE COMMON /OINDEX/ ROBOT,FTREE,BILLS,PORTR,SCOL,ZGNOM COMMON /OINDEX/ EGG,BEGG,BAUBL,CANAR,BCANA COMMON /OINDEX/ YLWAL,RDWAL,PINDR,RBEAM COMMON /OINDEX/ ODOOR,QDOOR,CDOOR,NUM1,NUM8 COMMON /OINDEX/ WARNI,CSLIT,GCARD,STLDR COMMON /OINDEX/ HANDS,WALL,LUNGS,SAILO,AVIAT,TEETH COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,WNORT,GWATE,MASTER C C CLOCK INTERRUPTS C LOGICAL*1 CFLAG COMMON /CEVENT/ CLNT,CTICK(25),CACTIO(25),CFLAG(25) C C VILLAINS AND DEMONS C LOGICAL THFFLG,SWDACT,THFACT COMMON /HACK/ THFPOS,THFFLG,THFACT,SWDACT,SWDSTA COMMON /VILL/ VLNT,VILLNS(4),VPROB(4),VOPPS(4),VBEST(4),VMELEE(4) C C ADVENTURERS C COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4), 1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4) C COMMON /AINDEX/ PLAYER,AROBOT,AMASTR C C FLAGS C LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF, 1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF, 2 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF, 3 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF, 4 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF, 5 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF, 6 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF, 7 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ BTIEF,BINFF COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP COMMON /FINDEX/ MDIR,MLOC,POLEUF COMMON /FINDEX/ QUESNO,NQATT,CORRCT COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE LOGICAL*1 FLAGS(46) INTEGER SWITCH(22) EQUIVALENCE (FLAGS(1),TROLLF) EQUIVALENCE (SWITCH(1),BTIEF) C INIT, PAGE 2 C C FIRST CHECK FOR PROTECTION VIOLATION C IF(PROTCT(X)) GO TO 10000 !PROTECTION VIOLATION? TYPE 10100 !YES, THROW HIM OFF. 10100 FORMAT(' There appears before you a threatening figure clad 1 all over'/' in heavy black armor. His legs seem like the 2 massive trunk'/' of the oak tree. His broad shoulders and 3 helmeted head loom'/' high over your own puny frame, and 4 you realize that his powerful'/' arms could easily crush the 5 very life from your body. There'/' hangs from his belt a 6 veritable arsenal of deadly weapons:'/' sword, mace, ball 7 and chain, dagger, lance, and trident.'/' He speaks with a 8 commanding voice:'//20X,'"You shall not pass."'//' As 9 he grabs you by the neck all grows dim about you.') CALL EXIT C C NOW START INITIALIZATION PROPER C 10000 INIT=.FALSE. !ASSUME INIT FAILS. MMAX=1050 !SET UP ARRAY LIMITS. OMAX=220 RMAX=200 VMAX=4 AMAX=4 CMAX=25 FMAX=46 SMAX=22 XMAX=900 R2MAX=20 DIRMAX=15 C MLNT=0 !INIT ARRAY COUNTERS. OLNT=0 RLNT=0 VLNT=0 ALNT=0 CLNT=0 XLNT=1 R2LNT=0 C LTSHFT=10 !SET UP STATE VARIABLES. MXSCOR=LTSHFT EGSCOR=0 EGMXSC=0 MXLOAD=100 RWSCOR=0 DEATHS=0 MOVES=0 PLTIME=0 MUNGRM=0 HS=0 PRSA=0 !CLEAR PARSE VECTOR. PRSI=0 PRSO=0 PRSCON=1 OFLAG=0 !CLEAR ORPHANS. OACT=0 OSLOT=0 OPREP=0 ONAME=0 THFFLG=.FALSE. !THIEF NOT INTRODUCED BUT THFACT=.TRUE. !IS ACTIVE. SWDACT=.FALSE. !SWORD IS INACTIVE. SWDSTA=0 !SWORD IS OFF. C RECNO=1 !INIT DB FILE POINTER. MBASE=0 !INIT MELEE BASE. INPCH=5 !TTY INPUT OUTCH=5 !TTY OUTPUT. DBCH=2 !DATA BASE. C INIT, PAGE 3 C C INIT ALL ARRAYS. C DO 5 I=1,CMAX !CLEAR CLOCK EVENTS CFLAG(I)=.FALSE. CTICK(I)=0 CACTIO(I)=0 5 CONTINUE C DO 10 I=1,FMAX !CLEAR FLAGS. FLAGS(I)=.FALSE. 10 CONTINUE BUOYF=.TRUE. !SOME START AS TRUE. EGYPTF=.TRUE. CAGETF=.TRUE. MR1F=.TRUE. MR2F=.TRUE. FOLLWF=.TRUE. DO 12 I=1,SMAX !CLEAR SWITCHES. SWITCH(I)=0 12 CONTINUE ORMTCH=4 !NUMBER OF MATCHES. LCELL=1 PNUMB=1 MDIR=270 MLOC=MRB CPHERE=10 C DO 15 I=1,R2MAX !CLEAR ROOM 2 ARRAY. R2(I)=0 O2(I)=0 15 CONTINUE C DO 20 I=1,XMAX !CLEAR TRAVEL ARRAY. TRAVEL(I)=0 20 CONTINUE C DO 30 I=1,VMAX !CLEAR VILLAINS ARRAYS. VOPPS(I)=0 VPROB(I)=0 VILLNS(I)=0 VBEST(I)=0 VMELEE(I)=0 30 CONTINUE C DO 40 I=1,OMAX !CLEAR OBJECT ARRAYS. ODESC1(I)=0 ODESC2(I)=0 ODESCO(I)=0 OREAD(I)=0 OACTIO(I)=0 OFLAG1(I)=0 OFLAG2(I)=0 OFVAL(I)=0 OTVAL(I)=0 OSIZE(I)=0 OCAPAC(I)=0 OCAN(I)=0 OADV(I)=0 OROOM(I)=0 40 CONTINUE C RDESC2=0 !CLEAR DESC BASE PTR. DO 50 I=1,RMAX !CLEAR ROOM ARRAYS. RDESC1(I)=0 RACTIO(I)=0 RFLAG(I)=0 RVAL(I)=0 REXIT(I)=0 50 CONTINUE C DO 60 I=1,MMAX !CLEAR MESSAGE DIRECTORY. RTEXT(I)=0 60 CONTINUE C DO 70 I=1,AMAX !CLEAR ADVENTURER'S ARRAYS. AROOM(I)=0 ASCORE(I)=0 AVEHIC(I)=0 AOBJ(I)=0 AACTIO(I)=0 ASTREN(I)=0 AFLAG(I)=0 70 CONTINUE C DBGFLG=0 PRSFLG=0 GDTFLG=0 C FROMDR=0 !INIT SCOL GOODIES. SCOLRM=0 SCOLAC=0 C INIT, PAGE 4 C C NOW RESTORE FROM EXISTING INDEX FILE. C OPEN(UNIT=1,NAME='DINDX.DAT',TYPE='OLD',READONLY, 1 FORM='FORMATTED',ACCESS='SEQUENTIAL',ERR=1900) READ(1,130) I,J,K !GET VERSION. IF((I.NE.VMAJ).OR.(J.NE.VMIN)) 1 GO TO 1925 !MATCH TO OURS? OPEN(UNIT=DBCH,NAME='DTEXT.DAT',TYPE='OLD',READONLY, 1 FORM='UNFORMATTED',ACCESS='DIRECT', 2 RECORDSIZE=19,DISPOSE='SAVE',ERR=1950) D TYPE 150 D150 FORMAT(' RESTORING FROM "DINDX.DAT"') READ(1,130) MXSCOR,STRBIT,EGMXSC READ(1,130) RLNT,RDESC2,RDESC1,REXIT,RACTIO,RVAL,RFLAG READ(1,130) XLNT,TRAVEL READ(1,130) OLNT,ODESC1,ODESC2,ODESCO,OACTIO,OFLAG1,OFLAG2, 1 OFVAL,OTVAL,OSIZE,OCAPAC,OROOM,OADV,OCAN, 2 OREAD READ(1,130) R2LNT,O2,R2 READ(1,130) CLNT,CTICK,CACTIO READ(1,135) CFLAG READ(1,130) VLNT,VILLNS,VPROB,VOPPS,VBEST,VMELEE READ(1,130) ALNT,AROOM,ASCORE,AVEHIC,AOBJ,AACTIO,ASTREN,AFLAG READ(1,130) MBASE,MLNT,RTEXT C CLOSE(UNIT=1) GO TO 1025 !INIT DONE. C 130 FORMAT(I8) 135 FORMAT(L4) C INIT, PAGE 5 C C THE INTERNAL DATA BASE IS NOW ESTABLISHED. C SET UP TO PLAY THE GAME. C 1025 CALL ITIME(SHOUR,SMIN,SSEC) !GET TIME AND DATE. CALL IDATE(I,J,K) CALL INIRND(I.OR.J.OR.K,SHOUR.OR.SMIN.OR.SSEC) C WINNER=PLAYER THFPOS=OROOM(THIEF) BLOC=OROOM(BALLO) HERE=AROOM(WINNER) LASTIT=AOBJ(PLAYER) INIT=.TRUE. C D TYPE 1050,RLNT,RMAX,XLNT,XMAX,OLNT,OMAX,MLNT,MMAX, D 1 VLNT,VMAX,ALNT,AMAX,CLNT,CMAX,R2LNT,R2MAX D1050 FORMAT(' USED:'/1X,I5,' OF',I5,' ROOMS'/ D 11X,I5,' OF',I5,' EXITS'/ D 21X,I5,' OF',I5,' OBJECTS'/ D 31X,I5,' OF',I5,' MESSAGES'/ D 41X,I5,' OF',I5,' VILLAINS'/ D 51X,I5,' OF',I5,' ADVENTURERS'/ D 61X,I5,' OF',I5,' CLOCK EVENTS'/ D 71X,I5,' OF',I5,' ROOM2 SLOTS') D TYPE 1150,MXSCOR,EGMXSC,RECNO,RDESC2,MBASE,STRBIT D1150 FORMAT(' MAX SCORE=',I5/' EG SCORE=',I5/ D 1' MAX RECNO=',I5/' RDESC2 BASE=',I5/ D 1' MELEE START=',I5/' STAR MASK=',I7) D PAUSE 1 C RETURN C INIT, PAGE 6 C C ERRORS-- INIT FAILS. C 1900 TYPE 910 !DINDX.DAT OPEN ERR TYPE 980 RETURN 1925 TYPE 920,I,J,K,VMAJ,VMIN,VEDIT !WRONG DINDX.DAT VER TYPE 980 RETURN 1950 TYPE 960 !DTEXT.DAT OPEN ERR TYPE 980 RETURN 910 FORMAT(' I can''t open "DINDX.DAT".') 920 FORMAT(' "DINDX.DAT" is version ',I1,'.',I1,A1,'.'/ 1 ' I require version ',I1,'.',I1,A1,'.') 960 FORMAT(' I can''t open "DTEXT.DAT".') 980 FORMAT(' Suddenly a sinister, wraithlike figure appears before 1 you'/' seeming to float in the air. In a low, sorrowful voice 2 he says,'/' "Alas, the very nature of the world has changed, 3 and the dungeon'/' cannot be found. All must now pass away." 4 Raising his oaken staff'/' in farewell, he fades into the 5 spreading darkness. In his place'/' appears a tastefully 6 lettered sign reading:'//23X,'INITIALIZATION FAILURE'// 7' The darkness becomes all encompassing, and your vision fails.') C END C PROTCT-- CHECK FOR USER VIOLATION C C THIS ROUTINE SHOULD BE MODIFIED IF YOU WISH TO ADD SYSTEM C DEPENDANT PROTECTION AGAINST ABUSE. C C AT THE MOMENT, PLAY IS PERMITTED UDER ALL CIRCUMSTANCES. C LOGICAL FUNCTION PROTCT(X) IMPLICIT INTEGER(A-Z) C PROTCT=.TRUE. RETURN END C DUNGEON-- MAIN PROGRAM C C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED C WRITTEN BY R. M. SUPNIK C PROGRAM DUNGEO C C DECLARATIONS C IMPLICIT INTEGER (A-Z) LOGICAL INIT C C PARSER OUTPUT C LOGICAL PRSWON COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON C C PARSER STATE C COMMON /ORPHS/ OFLAG,OACT,OSLOT,OPREP,ONAME COMMON /LAST/ LASTIT COMMON /PV/ ACT,OBJ1,OBJ2,PREP1,PREP2 COMMON /SYNTAX/ SYN(11) COMMON /SYNFLG/ SDIR,SIND,SSTD,SFLIP,SDRIV,SVMASK COMMON /OBJFLG/ VABIT,VRBIT,VTBIT,VCBIT,VEBIT,VFBIT,VPMASK C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD, 1 LTSHFT,BLOC,MUNGRM,HS,EGSCOR,EGMXSC C C SCREEN OF LIGHT STATE C COMMON /SCREEN/ FROMDR,SCOLRM,SCOLAC COMMON /SCREEN/ SCOLDR(8),SCOLWL(12) C C PUZZLE ROOM STATE C COMMON /PUZZLE/ CPDR(16),CPWL(8),CPVEC(64) C C MESSAGE INDEX C COMMON /RMSG/ MLNT,RTEXT(1050) C C MISCELLANEOUS VARIABLES C LOGICAL*1 INBUF COMMON /INPUT/ INLNT,INBUF(78) COMMON /STAR/ MBASE,STRBIT COMMON /VERS/ VMAJ,VMIN,VEDIT COMMON /TIME/ PLTIME,SHOUR,SMIN,SSEC COMMON /BATS/ BATDRP(9) COMMON /CHAN/ INPCH,OUTCH,DBCH COMMON /DEBUG/ DBGFLG,PRSFLG,GDTFLG COMMON /HYPER/ HFACTR C C ROOMS C COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200), 1 RACTIO(200),RVAL(200),RFLAG(200) INTEGER RRAND(200) EQUIVALENCE (RVAL,RRAND) C COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR, 1 RSACRD,RFILL,RMUNG,RBUCK,RHOUSE,RNWALL,REND C COMMON /RINDEX/ WHOUS,LROOM,CELLA COMMON /RINDEX/ MTROL,MAZE1 COMMON /RINDEX/ MGRAT,MAZ15 COMMON /RINDEX/ FORE1,FORE3,CLEAR,RESER COMMON /RINDEX/ STREA,EGYPT,ECHOR COMMON /RINDEX/ TSHAF COMMON /RINDEX/ BSHAF,MMACH,DOME,MTORC COMMON /RINDEX/ CAROU COMMON /RINDEX/ RIDDL,LLD2,TEMP1,TEMP2,MAINT COMMON /RINDEX/ BLROO,TREAS,RIVR1,RIVR2,RIVR3,MCYCL COMMON /RINDEX/ RIVR4,RIVR5,FCHMP,FALLS,MBARR COMMON /RINDEX/ MRAIN,POG,VLBOT,VAIR1,VAIR2,VAIR3,VAIR4 COMMON /RINDEX/ LEDG2,LEDG3,LEDG4,MSAFE,CAGER COMMON /RINDEX/ CAGED,TWELL,BWELL,ALICE,ALISM,ALITR COMMON /RINDEX/ MTREE,BKENT,BKVW,BKTWI,BKVAU,BKBOX COMMON /RINDEX/ CRYPT,TSTRS,MRANT,MREYE COMMON /RINDEX/ MRA,MRB,MRC,MRG,MRD,FDOOR COMMON /RINDEX/ MRAE,MRCE,MRCW,MRGE,MRGW,MRDW,INMIR COMMON /RINDEX/ SCORR,NCORR,PARAP,CELL,PCELL,NCELL COMMON /RINDEX/ CPANT,CPOUT,CPUZZ C C EXITS C COMMON /EXITS/ XLNT,TRAVEL(900) C COMMON /CURXT/ XTYPE,XROOM1,XSTRNG,XACTIO,XOBJ EQUIVALENCE (XFLAG,XOBJ) C COMMON /XPARS/ XRMASK,XDMASK,XFMASK,XFSHFT,XASHFT, 1 XELNT(4),XNORM,XNO,XCOND,XDOOR,XLFLAG C COMMON /XSRCH/ XMIN,XMAX,XDOWN,XUP, 1 XNORTH,XSOUTH,XENTER,XEXIT,XEAST,XWEST C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OROOM2/ R2LNT,O2(20),R2(20) C COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT, 1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT, 2 TOOLBT,TURNBT,ONBT COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT, 1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT, 2 TCHBT,VEHBT,SCHBT C COMMON /OINDEX/ GARLI,FOOD,GUNK,COAL,MACHI,DIAMO,TCASE,BOTTL COMMON /OINDEX/ WATER,ROPE,KNIFE,SWORD,LAMP,BLAMP,RUG COMMON /OINDEX/ LEAVE,TROLL,AXE COMMON /OINDEX/ RKNIF,KEYS,ICE,BAR COMMON /OINDEX/ COFFI,TORCH,TBASK,FBASK,IRBOX COMMON /OINDEX/ GHOST,TRUNK,BELL,BOOK,CANDL COMMON /OINDEX/ MATCH,TUBE,PUTTY,WRENC,SCREW,CYCLO,CHALI COMMON /OINDEX/ THIEF,STILL,WINDO,GRATE,DOOR COMMON /OINDEX/ HPOLE,LEAK,RBUTT,RAILI COMMON /OINDEX/ POT,STATU,IBOAT,DBOAT,PUMP,RBOAT COMMON /OINDEX/ STICK,BUOY,SHOVE,BALLO,RECEP,GUANO COMMON /OINDEX/ BROPE,HOOK1,HOOK2,SAFE,SSLOT,BRICK,FUSE COMMON /OINDEX/ GNOME,BLABE,DBALL,TOMB COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE COMMON /OINDEX/ ROBOT,FTREE,BILLS,PORTR,SCOL,ZGNOM COMMON /OINDEX/ EGG,BEGG,BAUBL,CANAR,BCANA COMMON /OINDEX/ YLWAL,RDWAL,PINDR,RBEAM COMMON /OINDEX/ ODOOR,QDOOR,CDOOR,NUM1,NUM8 COMMON /OINDEX/ WARNI,CSLIT,GCARD,STLDR COMMON /OINDEX/ HANDS,WALL,LUNGS,SAILO,AVIAT,TEETH COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,WNORT,GWATE,MASTER C C CLOCK INTERRUPTS C LOGICAL*1 CFLAG COMMON /CEVENT/ CLNT,CTICK(25),CACTIO(25),CFLAG(25) C COMMON /CINDEX/ CEVCUR,CEVMNT,CEVLNT,CEVMAT,CEVCND, 1 CEVBAL,CEVBRN,CEVFUS,CEVLED,CEVSAF,CEVVLG, 2 CEVGNO,CEVBUC,CEVSPH,CEVEGH, 3 CEVFOR,CEVSCL,CEVZGI,CEVZGO,CEVSTE, 5 CEVMRS,CEVPIN,CEVINQ,CEVFOL C C VILLAINS AND DEMONS C LOGICAL THFFLG,SWDACT,THFACT COMMON /HACK/ THFPOS,THFFLG,THFACT,SWDACT,SWDSTA COMMON /VILL/ VLNT,VILLNS(4),VPROB(4),VOPPS(4),VBEST(4),VMELEE(4) C C ADVENTURERS C COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4), 1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4) C COMMON /AFLAGS/ ASTAG C COMMON /AINDEX/ PLAYER,AROBOT,AMASTR C C VERBS C COMMON /VINDEX/ CINTW,DEADXW,FRSTQW,INXW,OUTXW COMMON /VINDEX/ WALKIW,FIGHTW,FOOW COMMON /VINDEX/ MELTW,READW,INFLAW,DEFLAW,ALARMW,EXORCW COMMON /VINDEX/ PLUGW,KICKW,WAVEW,RAISEW,LOWERW,RUBW COMMON /VINDEX/ PUSHW,UNTIEW,TIEW,TIEUPW,TURNW,BREATW COMMON /VINDEX/ KNOCKW,LOOKW,EXAMIW,SHAKEW,MOVEW,TRNONW,TRNOFW COMMON /VINDEX/ OPENW,CLOSEW,FINDW,WAITW,SPINW,BOARDW,UNBOAW,TAKEW COMMON /VINDEX/ INVENW,FILLW,EATW,DRINKW,BURNW COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW COMMON /VINDEX/ DIGW,LEAPW,STAYW,FOLLOW COMMON /VINDEX/ HELLOW,LOOKIW,LOOKUW,PUMPW,WINDW COMMON /VINDEX/ CLMBW,CLMBUW,CLMBDW,TRNTOW C C FLAGS C LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF, 1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF, 2 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF, 3 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF, 4 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF, 5 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF, 6 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF, 7 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ BTIEF,BINFF COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP COMMON /FINDEX/ MDIR,MLOC,POLEUF COMMON /FINDEX/ QUESNO,NQATT,CORRCT COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE C DUNGEON, PAGE 2 C C DATA STATEMENTS FOR CONSTANT ARRAYS C DATA VMAJ/2/,VMIN/5/,VEDIT/'A'/ C DATA SDIR/"40000/,SIND/"20000/,SSTD/"10000/, 1 SFLIP/"4000/,SDRIV/"2000/,SVMASK/"777/ DATA VABIT/"40000/,VRBIT/"20000/,VTBIT/"10000/, 1 VCBIT/"4000/,VEBIT/"2000/,VFBIT/"1000/,VPMASK/"777/ C DATA BATDRP/66,67,68,69,70,71,72,65,73/ C DATA SCOLDR/"2000,153,"12000,154,"6000,152,"16000,151/ DATA SCOLWL/151,207,"6000,152,208,"16000, 1 153,206,"12000,154,205,"2000/ C DATA HFACTR/500/ C DATA CPDR/"2000,-8,"4000,-7,"6000,1,"10000,9, 1 "12000,8,"14000,7,"16000,-1,"20000,-9/ DATA CPWL/205,-8,206,8,207,1,208,-1/ DATA CPVEC/1,1,1,1,1,1,1,1, 1 1,0,-1,0,0,-1,0,1, 2 1,-1,0,1,0,-2,0,1, 3 1,0,0,0,0,1,0,1, 4 1,-3,0,0,-1,-1,0,1, 5 1,0,0,-1,0,0,0,1, 6 1,1,1,0,0,0,1,1, 7 1,1,1,1,1,1,1,1/ C DATA CEVCUR/1/,CEVMNT/2/,CEVLNT/3/,CEVMAT/4/, 1 CEVCND/5/,CEVBAL/6/,CEVBRN/7/,CEVFUS/8/, 2 CEVLED/9/,CEVSAF/10/,CEVVLG/11/,CEVGNO/12/, 3 CEVBUC/13/,CEVSPH/14/,CEVEGH/15/, 4 CEVFOR/16/,CEVSCL/17/,CEVZGI/18/,CEVZGO/19/, 5 CEVSTE/20/,CEVMRS/21/,CEVPIN/22/,CEVINQ/23/, 6 CEVFOL/24/ C DATA XRMASK/"377/,XDMASK/"76000/,XFMASK/3/ DATA XFSHFT/256/,XASHFT/256/ DATA XNORM/1/,XNO/2/,XCOND/3/,XDOOR/4/ DATA XELNT/1,2,3,3/,XLFLAG/"100000/ DATA XMIN/"2000/,XMAX/"40000/,XUP/"22000/,XDOWN/"24000/ DATA XNORTH/"2000/,XSOUTH/"12000/,XENTER/"32000/,XEXIT/"34000/ DATA XEAST/"6000/,XWEST/"16000/ C DATA PLAYER/1/,AROBOT/2/,AMASTR/3/ DATA ASTAG/"100000/ C DATA RSEEN/"100000/,RLIGHT/"40000/,RLAND/"20000/ DATA RWATER/"10000/,RAIR/"4000/,RSACRD/"2000/,RFILL/"1000/ DATA RMUNG/"400/,RBUCK/"200/,RHOUSE/"100/,RNWALL/"40/,REND/"20/ C DATA WHOUS/2/,LROOM/8/,CELLA/9/ DATA MTROL/10/,MAZE1/11/ DATA MGRAT/25/,MAZ15/30/ DATA FORE1/31/,FORE3/33/,CLEAR/36/,RESER/40/ DATA STREA/42/,EGYPT/44/,ECHOR/49/ DATA TSHAF/61/ DATA BSHAF/76/,MMACH/77/,DOME/79/,MTORC/80/ DATA CAROU/83/ DATA RIDDL/91/,LLD2/94/,TEMP1/96/,TEMP2/97/,MAINT/100/ DATA MCYCL/101/,BLROO/102/,TREAS/103/,RIVR1/107/,RIVR2/108/ DATA RIVR3/109/ DATA RIVR4/112/,RIVR5/113/,FCHMP/114/,MBARR/119/,FALLS/120/ DATA MRAIN/121/,POG/122/,VLBOT/126/,VAIR1/127/,VAIR2/128/ DATA VAIR3/129/,VAIR4/130/ DATA LEDG2/131/,LEDG3/132/,LEDG4/133/,MSAFE/135/,CAGER/140/ DATA CAGED/141/,TWELL/142/,BWELL/143/,ALICE/144/,ALISM/145/ DATA ALITR/146/,MTREE/147/,BKENT/148/ DATA BKVW/151/,BKTWI/153/,BKVAU/154/,BKBOX/155/ DATA CRYPT/157/,TSTRS/158/,MRANT/159/ DATA MREYE/160/,MRA/161/,MRB/162/,MRC/163/,MRG/164/ DATA MRD/165/,FDOOR/166/,MRAE/167/ DATA MRCE/171/,MRCW/172/,MRGE/173/,MRGW/174/,MRDW/176/ DATA INMIR/177/,SCORR/179/ DATA NCORR/182/,PARAP/183/,CELL/184/,PCELL/185/,NCELL/186/ DATA CPANT/188/,CPOUT/189/ DATA CPUZZ/190/ C DATA CINTW/1/,DEADXW/2/,FRSTQW/3/,INXW/4/ DATA OUTXW/5/,WALKIW/6/,FIGHTW/7/,FOOW/8/ C DATA READW/100/,MELTW/101/ DATA INFLAW/102/,DEFLAW/103/,ALARMW/104/,EXORCW/105/ DATA PLUGW/106/,KICKW/107/,WAVEW/108/,RAISEW/109/,LOWERW/110/ DATA RUBW/111/,PUSHW/112/,UNTIEW/113/,TIEW/114/,TIEUPW/115/ DATA TURNW/116/,BREATW/117/,KNOCKW/118/,LOOKW/119/ DATA EXAMIW/120/,SHAKEW/121/,MOVEW/122/,TRNONW/123/,TRNOFW/124/ DATA OPENW/125/,CLOSEW/126/,FINDW/127/,WAITW/128/,SPINW/129/ DATA BOARDW/130/,UNBOAW/131/,TAKEW/132/,INVENW/133/ DATA FILLW/134/,EATW/135/,DRINKW/136/,BURNW/137/ DATA MUNGW/138/,KILLW/139/,ATTACW/141/ DATA SWINGW/140/,WALKW/142/,TELLW/143/,PUTW/144/ DATA DROPW/145/,GIVEW/146/,POURW/147/,THROWW/148/ C DATA DIGW/89/,LEAPW/91/,STAYW/73/,FOLLOW/85/ DATA HELLOW/151/,LOOKIW/152/,LOOKUW/153/,PUMPW/154/ DATA WINDW/155/,CLMBW/156/,CLMBUW/157/,CLMBDW/158/,TRNTOW/159/ C DATA VISIBT/"100000/,READBT/"40000/,TAKEBT/"20000/,DOORBT/"10000/, 1 TRANBT/"4000/,FOODBT/"2000/,NDSCBT/"1000/,DRNKBT/"400/, 2 CONTBT/"200/,LITEBT/"100/,VICTBT/"40/,BURNBT/"20/, 3 FLAMBT/"10/,TOOLBT/"4/,TURNBT/"2/,ONBT/"1/ C DATA FINDBT/"100000/,SLEPBT/"40000/,SCRDBT/"20000/,TIEBT/"10000/, 1 CLMBBT/"4000/,ACTRBT/"2000/,WEAPBT/"1000/,FITEBT/"400/, 2 VILLBT/"200/,STAGBT/"100/,TRYBT/"40/,NOCHBT/"20/, 3 OPENBT/"10/,TCHBT/"4/,VEHBT/"2/,SCHBT/"1/ C DATA GARLI/2/,FOOD/3/,GUNK/4/,COAL/5/,MACHI/7/,DIAMO/8/ DATA TCASE/9/,BOTTL/10/ DATA WATER/11/,ROPE/12/,KNIFE/13/,SWORD/14/,LAMP/15/,BLAMP/16/ DATA RUG/17/,LEAVE/18/,TROLL/19/,AXE/20/ DATA RKNIF/21/,KEYS/23/,BAR/26/,ICE/30/ DATA COFFI/33/,TORCH/34/,TBASK/35/,FBASK/36/,IRBOX/39/ DATA GHOST/42/,TRUNK/45/,BELL/46/,BOOK/47/,CANDL/48/ DATA MATCH/51/,TUBE/54/,PUTTY/55/,WRENC/56/,SCREW/57/ DATA CYCLO/58/,CHALI/59/ DATA THIEF/61/,STILL/62/,WINDO/63/,GRATE/65/,DOOR/66/ DATA HPOLE/71/,RBUTT/79/,LEAK/78/,RAILI/75/ DATA POT/85/,STATU/86/,IBOAT/87/,DBOAT/88/,PUMP/89/,RBOAT/90/ DATA STICK/92/,BUOY/94/,SHOVE/96/,GUANO/97/,BALLO/98/,RECEP/99/ DATA BROPE/101/,HOOK1/102/,HOOK2/103/,SAFE/105/,SSLOT/107/ DATA BRICK/109/,FUSE/110/ DATA GNOME/111/,BLABE/112/,DBALL/113/,TOMB/119/ DATA LCASE/123/,CAGE/124/,RCAGE/125/,SPHER/126/,SQBUT/127/ DATA FLASK/132/,POOL/133/,SAFFR/134/,BUCKE/137/,ORICE/139/ DATA ECAKE/138/,RDICE/140/ DATA BLICE/141/,ROBOT/142/,FTREE/145/,BILLS/148/,PORTR/149/ DATA SCOL/151/,ZGNOM/152/,EGG/154/,BEGG/155/,BAUBL/156/ DATA CANAR/157/,BCANA/158/,YLWAL/159/ DATA RDWAL/161/,PINDR/164/ DATA RBEAM/171/,ODOOR/172/,QDOOR/173/,CDOOR/175/ DATA NUM1/178/ DATA NUM8/185/,WARNI/186/,CSLIT/187/,GCARD/188/,STLDR/189/ DATA ITOBJ/192/,OPLAY/193/,EVERY/194/ DATA VALUA/195/,SAILO/196/,TEETH/197/,WALL/198/ DATA HANDS/200/,LUNGS/201/,AVIAT/202/ DATA WNORT/205/,GWATE/209/,MASTER/215/ C DUNGEON, PAGE 3 C C 1) INITIALIZE DATA STRUCTURES C 2) PLAY GAME C IF(INIT(X)) CALL GAME !IF INIT, PLAY GAME. CALL EXIT !DONE END C PRINCR- PRINT CONTENTS OF ROOM C C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED C WRITTEN BY R. M. SUPNIK C C DECLARATIONS C SUBROUTINE PRINCR(FULL,RM) IMPLICIT INTEGER (A-Z) LOGICAL QEMPTY,QHERE,FULL C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG C C ROOMS C COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200), 1 RACTIO(200),RVAL(200),RFLAG(200) INTEGER RRAND(200) EQUIVALENCE (RVAL,RRAND) C COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR, 1 RSACRD,RFILL,RMUNG,RBUCK,RHOUSE,RNWALL,REND C C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT, 1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT, 2 TOOLBT,TURNBT,ONBT COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT, 1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT, 2 TCHBT,VEHBT,SCHBT C COMMON /OINDEX/ GARLI,FOOD,GUNK,COAL,MACHI,DIAMO,TCASE,BOTTL C C ADVENTURERS C COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4), 1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4) C COMMON /AINDEX/ PLAYER,AROBOT,AMASTR C C FLAGS C LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF LOGICAL*1 GLACMF,ENDGMF,FROBZF,BADLKF,THFENF,SINGSF LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF, 1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF, 2 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF, 3 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF, 4 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF, 5 GLACMF,ENDGMF,FROBZF,BADLKF,THFENF,SINGSF, 6 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF, 7 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ BTIEF,BINFF COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVGUA,RVSND COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP COMMON /FINDEX/ MDIR,MLOC,POLEUF COMMON /FINDEX/ QUESNO,NQATT,CORRCT COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE C PRINCR, PAGE 2 C J=329 !ASSUME SUPERBRIEF FORMAT. DO 500 I=1,OLNT !LOOP ON OBJECTS IF(.NOT.QHERE(I,RM).OR.((OFLAG1(I).AND.(VISIBT+NDSCBT)).NE. 1 VISIBT).OR.(I.EQ.AVEHIC(WINNER))) GO TO 500 IF(.NOT.FULL.AND.(SUPERF.OR.(BRIEFF.AND. 1 ((RFLAG(HERE).AND.RSEEN).NE.0)))) GO TO 200 C C DO LONG DESCRIPTION OF OBJECT. C K=ODESCO(I) !GET UNTOUCHED. IF((K.EQ.0).OR.((OFLAG2(I).AND.TCHBT).NE.0)) K=ODESC1(I) CALL RSPEAK(K) !DESCRIBE. GO TO 500 C DO SHORT DESCRIPTION OF OBJECT. C 200 CALL RSPSUB(J,ODESC2(I)) !YOU CAN SEE IT. J=502 C 500 CONTINUE C C NOW LOOP TO PRINT CONTENTS OF OBJECTS IN ROOM. C DO 1000 I=1,OLNT !LOOP ON OBJECTS. IF(.NOT.QHERE(I,RM).OR.((OFLAG1(I).AND.(VISIBT+NDSCBT)).NE. 1 VISIBT)) GO TO 1000 IF((OFLAG2(I).AND.ACTRBT).NE.0) CALL INVENT(OACTOR(I)) IF((((OFLAG1(I).AND.TRANBT).EQ.0).AND.((OFLAG2(I).AND.OPENBT) 1 .EQ.0)).OR.QEMPTY(I)) GO TO 1000 C C OBJECT IS NOT EMPTY AND IS OPEN OR TRANSPARENT. C J=573 IF(I.NE.TCASE) GO TO 600 !TROPHY CASE? J=574 IF((BRIEFF.OR.SUPERF).AND. .NOT.FULL) GO TO 1000 600 CALL PRINCO(I,J) !PRINT CONTENTS. C 1000 CONTINUE RETURN C END C INVENT- PRINT CONTENTS OF ADVENTURER C C DECLARATIONS C SUBROUTINE INVENT(ADV) IMPLICIT INTEGER (A-Z) LOGICAL QEMPTY C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT, 1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT, 2 TOOLBT,TURNBT,ONBT COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT, 1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT, 2 TCHBT,VEHBT,SCHBT C C C ADVENTURERS C COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4), 1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4) C COMMON /AINDEX/ PLAYER,AROBOT,AMASTR C INVENT, PAGE 2 C I=575 !FIRST LINE. IF(ADV.NE.PLAYER) I=576 !IF NOT ME. DO 10 J=1,OLNT !LOOP IF((OADV(J).NE.ADV).OR.((OFLAG1(J).AND.VISIBT).EQ.0)) 1 GO TO 10 CALL RSPSUB(I,ODESC2(AOBJ(ADV))) I=0 CALL RSPSUB(502,ODESC2(J)) 10 CONTINUE C IF(I.EQ.0) GO TO 25 !ANY OBJECTS? IF(ADV.EQ.PLAYER) CALL RSPEAK(578) !NO, TELL HIM. RETURN C 25 DO 100 J=1,OLNT !LOOP. IF((OADV(J).NE.ADV).OR.((OFLAG1(J).AND.VISIBT).EQ.0).OR. 1 (((OFLAG1(J).AND.TRANBT).EQ.0).AND. 2 ((OFLAG2(J).AND.OPENBT).EQ.0))) GO TO 100 IF(.NOT.QEMPTY(J)) CALL PRINCO(J,573) !IF NOT EMPTY, LIST. 100 CONTINUE RETURN C END C PRINCO- PRINT CONTENTS OF OBJECT C C DECLARATIONS C SUBROUTINE PRINCO(OBJ,DESC) IMPLICIT INTEGER(A-Z) C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C CALL RSPSUB(DESC,ODESC2(OBJ)) !PRINT HEADER. DO 100 I=1,OLNT !LOOP THRU. IF(OCAN(I).EQ.OBJ) CALL RSPSUB(502,ODESC2(I)) 100 CONTINUE RETURN C END C MOVETO- MOVE PLAYER TO NEW ROOM C C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED C WRITTEN BY R. M. SUPNIK C C DECLARATIONS C LOGICAL FUNCTION MOVETO(NR,WHO) IMPLICIT INTEGER (A-Z) LOGICAL NLV,LHR,LNR C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG C C ROOMS C COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200), 1 RACTIO(200),RVAL(200),RFLAG(200) INTEGER RRAND(200) EQUIVALENCE (RVAL,RRAND) C COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR, 1 RSACRD,RFILL,RMUNG,RBUCK,RHOUSE,RNWALL,REND C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OINDEX/ GARLI,FOOD,GUNK,COAL,MACHI,DIAMO,TCASE,BOTTL COMMON /OINDEX/ WATER,ROPE,KNIFE,SWORD,LAMP,BLAMP,RUG COMMON /OINDEX/ LEAVE,TROLL,AXE COMMON /OINDEX/ RKNIF,KEYS,ICE,BAR COMMON /OINDEX/ COFFI,TORCH,TBASK,FBASK,IRBOX COMMON /OINDEX/ GHOST,TRUNK,BELL,BOOK,CANDL COMMON /OINDEX/ MATCH,TUBE,PUTTY,WRENC,SCREW,CYCLO,CHALI COMMON /OINDEX/ THIEF,STILL,WINDO,GRATE,DOOR COMMON /OINDEX/ HPOLE,LEAK,RBUTT,RAILI COMMON /OINDEX/ POT,STATU,IBOAT,DBOAT,PUMP,RBOAT COMMON /OINDEX/ STICK,BUOY,SHOVE,BALLO,RECEP,GUANO COMMON /OINDEX/ BROPE,HOOK1,HOOK2,SAFE,SSLOT,BRICK,FUSE COMMON /OINDEX/ GNOME,BLABE,DBALL,TOMB COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE COMMON /OINDEX/ ROBOT,FTREE,BILLS,PORTR,SCOL,ZGNOM COMMON /OINDEX/ EGG,BEGG,BAUBL,CANAR,BCANA COMMON /OINDEX/ YLWAL,RDWAL,PINDR,RBEAM COMMON /OINDEX/ ODOOR,QDOOR,CDOOR,NUM1,NUM8 COMMON /OINDEX/ WARNI,CSLIT,GCARD,STLDR COMMON /OINDEX/ HANDS,WALL,LUNGS,SAILO,AVIAT,TEETH COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,WNORT,GWATE,MASTER C C ADVENTURERS C COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4), 1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4) C COMMON /AINDEX/ PLAYER,AROBOT,AMASTR C MOVETO, PAGE 2 C MOVETO=.FALSE. !ASSUME FAILS. LHR=(RFLAG(HERE).AND.RLAND).NE.0 !LAND HERE FLAG. LNR=(RFLAG(NR).AND.RLAND).NE.0 !LAND THERE FLAG. J=AVEHIC(WHO) !HIS VEHICLE C IF(J.NE.0) GO TO 100 !IN VEHICLE? IF(LNR) GO TO 500 !NO, GOING TO LAND? CALL RSPEAK(427) !CAN'T GO WITHOUT VEHICLE. RETURN C 100 BITS=0 !ASSUME NOWHERE. IF(J.EQ.RBOAT) BITS=RWATER !IN BOAT? IF(J.EQ.BALLO) BITS=RAIR !IN BALLOON? IF(J.EQ.BUCKE) BITS=RBUCK !IN BUCKET? NLV=(RFLAG(NR).AND.BITS).EQ.0 !GOT WRONG VEHICLE FLAG. IF((.NOT.LNR .AND.NLV) .OR. 1 (LNR.AND.LHR.AND.NLV.AND.(BITS.NE.RLAND))) 2 GO TO 800 !GOT WRONG VEHICLE? C 500 MOVETO=.TRUE. !MOVE SHOULD SUCCEED. IF((RFLAG(NR).AND.RMUNG).EQ.0) GO TO 600 !ROOM MUNGED? CALL RSPEAK(RRAND(NR)) !YES, TELL HOW. RETURN C 600 IF(WHO.NE.PLAYER) CALL NEWSTA(AOBJ(WHO),0,NR,0,0) IF(J.NE.0) CALL NEWSTA(J,0,NR,0,0) HERE=NR AROOM(WHO)=HERE CALL SCRUPD(RVAL(NR)) !SCORE ROOM RVAL(NR)=0 RETURN C 800 CALL RSPSUB(428,ODESC2(J)) !WRONG VEHICLE. RETURN END C SCORE-- PRINT OUT CURRENT SCORE C C DECLARATIONS C SUBROUTINE SCORE(FLG) IMPLICIT INTEGER (A-Z) LOGICAL FLG INTEGER RANK(10),ERANK(5) C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD, 1 LTSHFT,BLOC,MUNGRM,HS,EGSCOR,EGMXSC C COMMON /CHAN/ INPCH,OUTCH,DBCH C C ADVENTURERS C COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4), 1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4) C C FLAGS C LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF, 1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF, 2 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF, 3 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF, 4 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF, 5 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF, 6 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF, 7 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ BTIEF,BINFF COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP COMMON /FINDEX/ MDIR,MLOC,POLEUF COMMON /FINDEX/ QUESNO,NQATT,CORRCT COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE C C FUNCTIONS AND DATA C DATA RANK/20,19,18,16,12,8,4,2,1,0/ DATA ERANK/20,15,10,5,0/ C SCORE, PAGE 2 C AS=ASCORE(WINNER) IF(ENDGMF) GO TO 60 !ENDGAME? IF(FLG) WRITE(OUTCH,100) IF(.NOT.FLG) WRITE(OUTCH,110) IF(MOVES.NE.1) WRITE(OUTCH,120) AS,MXSCOR,MOVES IF(MOVES.EQ.1) WRITE(OUTCH,130) AS,MXSCOR,MOVES DO 10 I=1,10 IF((AS*20/MXSCOR).GE.RANK(I)) GO TO 50 10 CONTINUE 50 CALL RSPEAK(484+I) RETURN C 60 IF(FLG) WRITE(OUTCH,140) IF(.NOT.FLG) WRITE(OUTCH,150) WRITE(OUTCH,120) EGSCOR,EGMXSC,MOVES DO 70 I=1,5 IF((EGSCOR*20/EGMXSC).GE.ERANK(I)) GO TO 80 70 CONTINUE 80 CALL RSPEAK(786+I) RETURN C 100 FORMAT(' Your score would be',$) 110 FORMAT(' Your score is',$) 120 FORMAT('+',I4,' [total of',I4,' points], in',I5,' moves.') 130 FORMAT('+',I4,' [total of',I4,' points], in',I5,' move.') 140 FORMAT(' Your score in the endgame would be',$) 150 FORMAT(' Your score in the endgame is',$) C END C SCRUPD- UPDATE WINNER'S SCORE C C DECLARATIONS C SUBROUTINE SCRUPD(N) IMPLICIT INTEGER (A-Z) C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD, 1 LTSHFT,BLOC,MUNGRM,HS,EGSCOR,EGMXSC C C CLOCK INTERRUPTS C LOGICAL*1 CFLAG COMMON /CEVENT/ CLNT,CTICK(25),CACTIO(25),CFLAG(25) C COMMON /CINDEX/ CEVCUR,CEVMNT,CEVLNT,CEVMAT,CEVCND, 1 CEVBAL,CEVBRN,CEVFUS,CEVLED,CEVSAF,CEVVLG, 2 CEVGNO,CEVBUC,CEVSPH,CEVEGH, 3 CEVFOR,CEVSCL,CEVZGI,CEVZGO,CEVSTE, 5 CEVMRS,CEVPIN,CEVINQ,CEVFOL C C ADVENTURERS C COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4), 1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4) C C FLAGS C LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF, 1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF, 2 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF, 3 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF, 4 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF, 5 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF, 6 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF, 7 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ BTIEF,BINFF COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP COMMON /FINDEX/ MDIR,MLOC,POLEUF COMMON /FINDEX/ QUESNO,NQATT,CORRCT COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE C IF(ENDGMF) GO TO 100 !ENDGAME? ASCORE(WINNER)=ASCORE(WINNER)+N !UPDATE SCORE RWSCOR=RWSCOR+N !UPDATE RAW SCORE IF(ASCORE(WINNER).LT.(MXSCOR-(10*DEATHS))) RETURN CFLAG(CEVEGH)=.TRUE. !TURN ON END GAME CTICK(CEVEGH)=15 RETURN C 100 EGSCOR=EGSCOR+N !UPDATE EG SCORE. RETURN END C FINDXT- FIND EXIT FROM ROOM C C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED C WRITTEN BY R. M. SUPNIK C C DECLARATIONS C LOGICAL FUNCTION FINDXT(DIR,RM) IMPLICIT INTEGER (A-Z) C C ROOMS C COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200), 1 RACTIO(200),RVAL(200),RFLAG(200) INTEGER RRAND(200) EQUIVALENCE (RVAL,RRAND) C C EXITS C COMMON /EXITS/ XLNT,TRAVEL(900) C COMMON /CURXT/ XTYPE,XROOM1,XSTRNG,XACTIO,XOBJ EQUIVALENCE (XFLAG,XOBJ) C COMMON /XPARS/ XRMASK,XDMASK,XFMASK,XFSHFT,XASHFT, 1 XELNT(4),XNORM,XNO,XCOND,XDOOR,XLFLAG C FINDXT=.TRUE. !ASSUME WINS. XI=REXIT(RM) !FIND FIRST ENTRY. IF(XI.EQ.0) GO TO 1000 !NO EXITS? C 100 I=TRAVEL(XI) !GET ENTRY. XROOM1=I.AND.XRMASK !ISOLATE ROOM. XTYPE=(((I.AND..NOT.XLFLAG)/XFSHFT).AND.XFMASK)+1 GO TO (110,120,130,130),XTYPE !BRANCH ON ENTRY. CALL BUG(10,XTYPE) C 130 XOBJ=TRAVEL(XI+2).AND.XRMASK !DOOR/CEXIT- GET OBJ/FLAG. XACTIO=TRAVEL(XI+2)/XASHFT 120 XSTRNG=TRAVEL(XI+1) !DOOR/CEXIT/NEXIT - STRING. 110 XI=XI+XELNT(XTYPE) !ADVANCE TO NEXT ENTRY. IF((I.AND.XDMASK).EQ.DIR) RETURN !MATCH? IF((I.AND.XLFLAG).EQ.0) GO TO 100 !LAST ENTRY? 1000 FINDXT=.FALSE. !YES, LOSE. RETURN END C FWIM- FIND WHAT I MEAN C C DECLARATIONS C INTEGER FUNCTION FWIM(F1,F2,RM,CON,ADV,NOCARE) IMPLICIT INTEGER (A-Z) LOGICAL NOCARE C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT, 1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT, 2 TOOLBT,TURNBT,ONBT COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT, 1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT, 2 TCHBT,VEHBT,SCHBT C FWIM=0 !ASSUME NOTHING. DO 1000 I=1,OLNT !LOOP IF(((RM.EQ.0).OR.(OROOM(I).NE.RM)) .AND. 1 ((ADV.EQ.0).OR.(OADV(I).NE.ADV)) .AND. 2 ((CON.EQ.0).OR.(OCAN(I).NE.CON))) 3 GO TO 1000 C C OBJECT IS ON LIST... IS IT A MATCH? C IF((OFLAG1(I).AND.VISIBT).EQ.0) GO TO 1000 IF((.NOT.NOCARE .AND.((OFLAG1(I).AND.TAKEBT).EQ.0)) .OR. 1 (((OFLAG1(I).AND.F1).EQ.0).AND. 2 ((OFLAG2(I).AND.F2).EQ.0))) GO TO 500 IF(FWIM.EQ.0) GO TO 400 !ALREADY GOT SOMETHING? FWIM=-FWIM !YES, AMBIGUOUS. RETURN C 400 FWIM=I !NOTE MATCH. C C DOES OBJECT CONTAIN A MATCH? C 500 IF((OFLAG2(I).AND.OPENBT).EQ.0) GO TO 1000 !CLOSED? DO 700 J=1,OLNT !NO, SEARCH CONTENTS. IF((OCAN(J).NE.I).OR.((OFLAG1(J).AND.VISIBT).EQ.0) .OR. 1 (((OFLAG1(J).AND.F1).EQ.0).AND. 2 ((OFLAG2(J).AND.F2).EQ.0))) GO TO 700 IF(FWIM.EQ.0) GO TO 600 FWIM=-FWIM RETURN C 600 FWIM=J 700 CONTINUE 1000 CONTINUE RETURN END C YESNO- OBTAIN YES/NO ANSWER C C CALLED BY- C C YES-IS-TRUE=YESNO(QUESTION,YES-STRING,NO-STRING) C LOGICAL FUNCTION YESNO(Q,Y,N) IMPLICIT INTEGER(A-Z) COMMON /CHAN/ INPCH,OUTCH,DBCH C 100 CALL RSPEAK(Q) !ASK READ(INPCH,110) ANS !GET ANSWER 110 FORMAT(A1) IF((ANS.EQ.'Y').OR.(ANS.EQ.'y')) GO TO 200 IF((ANS.EQ.'N').OR.(ANS.EQ.'n')) GO TO 300 CALL RSPEAK(6) !SCOLD. GO TO 100 C 200 YESNO=.TRUE. !YES, CALL RSPEAK(Y) !OUT WITH IT. RETURN C 300 YESNO=.FALSE. !NO, CALL RSPEAK(N) !LIKEWISE. RETURN C END C ROBADV-- STEAL WINNER'S VALUABLES C C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED C WRITTEN BY R. M. SUPNIK C C DECLARATIONS C INTEGER FUNCTION ROBADV(ADV,NR,NC,NA) IMPLICIT INTEGER (A-Z) C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT, 1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT, 2 TOOLBT,TURNBT,ONBT COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT, 1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT, 2 TCHBT,VEHBT,SCHBT C ROBADV=0 !COUNT OBJECTS DO 100 I=1,OLNT IF((OADV(I).NE.ADV).OR.(OTVAL(I).LE.0).OR. 1 ((OFLAG2(I).AND.SCRDBT).NE.0)) GO TO 100 CALL NEWSTA(I,0,NR,NC,NA) !STEAL OBJECT ROBADV=ROBADV+1 100 CONTINUE RETURN END C ROBRM-- STEAL ROOM VALUABLES C C DECLARATIONS C INTEGER FUNCTION ROBRM(RM,PR,NR,NC,NA) IMPLICIT INTEGER (A-Z) LOGICAL PROB,QHERE C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT, 1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT, 2 TOOLBT,TURNBT,ONBT COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT, 1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT, 2 TCHBT,VEHBT,SCHBT C ROBRM=0 !COUNT OBJECTS DO 100 I=1,OLNT !LOOP ON OBJECTS. IF(.NOT. QHERE(I,RM)) GO TO 100 IF((OTVAL(I).LE.0).OR.((OFLAG2(I).AND.SCRDBT).NE.0).OR. 1 ((OFLAG1(I).AND.VISIBT).EQ.0).OR.(.NOT.PROB(PR,PR))) 2 GO TO 50 CALL NEWSTA(I,0,NR,NC,NA) ROBRM=ROBRM+1 OFLAG2(I)=OFLAG2(I).OR.TCHBT GO TO 100 50 IF((OFLAG2(I).AND.ACTRBT).NE.0) 1 ROBRM=ROBRM+ROBADV(OACTOR(I),NR,NC,NA) 100 CONTINUE RETURN END C WINNIN-- SEE IF VILLAIN IS WINNING C C DECLARATIONS C LOGICAL FUNCTION WINNIN(VL,HR) IMPLICIT INTEGER (A-Z) LOGICAL PROB C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C VS=OCAPAC(VL) !VILLAIN STRENGTH PS=VS-FIGHTS(HR,.TRUE.) !HIS MARGIN OVER HERO WINNIN=PROB(90,100) IF(PS.GT.3) RETURN !+3... 90% WINNING WINNIN=PROB(75,85) IF(PS.GT.0) RETURN !>0... 75% WINNING WINNIN=PROB(50,30) IF(PS.EQ.0) RETURN !=0... 50% WINNING WINNIN=PROB(25,25) IF(VS.GT.1) RETURN !ANY VILLAIN STRENGTH. WINNIN=PROB(10,0) RETURN END C FIGHTS-- COMPUTE FIGHT STRENGTH C C DECLARATIONS C INTEGER FUNCTION FIGHTS(H,FLG) IMPLICIT INTEGER (A-Z) LOGICAL FLG C C GAME STATE C COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD, 1 LTSHFT,BLOC,MUNGRM,HS,EGSCOR,EGMXSC C C ADVENTURERS C COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4), 1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4) C C FUNCTIONS AND DATA C DATA SMAX/7/,SMIN/2/ C FIGHTS=SMIN+((((SMAX-SMIN)*ASCORE(H))+(MXSCOR/2))/MXSCOR) IF(FLG) FIGHTS=FIGHTS+ASTREN(H) RETURN END C VILSTR- COMPUTE VILLAIN STRENGTH C C DECLARATIONS C INTEGER FUNCTION VILSTR(V) IMPLICIT INTEGER (A-Z) C C PARSER OUTPUT C LOGICAL PRSWON COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT, 1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT, 2 TOOLBT,TURNBT,ONBT COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT, 1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT, 2 TCHBT,VEHBT,SCHBT C COMMON /OINDEX/ GARLI,FOOD,GUNK,COAL,MACHI,DIAMO,TCASE,BOTTL COMMON /OINDEX/ WATER,ROPE,KNIFE,SWORD,LAMP,BLAMP,RUG COMMON /OINDEX/ LEAVE,TROLL,AXE COMMON /OINDEX/ RKNIF,KEYS,ICE,BAR COMMON /OINDEX/ COFFI,TORCH,TBASK,FBASK,IRBOX COMMON /OINDEX/ GHOST,TRUNK,BELL,BOOK,CANDL COMMON /OINDEX/ MATCH,TUBE,PUTTY,WRENC,SCREW,CYCLO,CHALI COMMON /OINDEX/ THIEF,STILL,WINDO,GRATE,DOOR COMMON /OINDEX/ HPOLE,LEAK,RBUTT,RAILI COMMON /OINDEX/ POT,STATU,IBOAT,DBOAT,PUMP,RBOAT COMMON /OINDEX/ STICK,BUOY,SHOVE,BALLO,RECEP,GUANO COMMON /OINDEX/ BROPE,HOOK1,HOOK2,SAFE,SSLOT,BRICK,FUSE COMMON /OINDEX/ GNOME,BLABE,DBALL,TOMB COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE COMMON /OINDEX/ ROBOT,FTREE,BILLS,PORTR,SCOL,ZGNOM COMMON /OINDEX/ EGG,BEGG,BAUBL,CANAR,BCANA COMMON /OINDEX/ YLWAL,RDWAL,PINDR,RBEAM COMMON /OINDEX/ ODOOR,QDOOR,CDOOR,NUM1,NUM8 COMMON /OINDEX/ WARNI,CSLIT,GCARD,STLDR COMMON /OINDEX/ HANDS,WALL,LUNGS,SAILO,AVIAT,TEETH COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,WNORT,GWATE,MASTER C COMMON /VILL/ VLNT,VILLNS(4),VPROB(4),VOPPS(4),VBEST(4),VMELEE(4) C C FLAGS C LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF, 1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF, 2 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF, 3 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF, 4 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF, 5 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF, 6 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF, 7 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ BTIEF,BINFF COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP COMMON /FINDEX/ MDIR,MLOC,POLEUF COMMON /FINDEX/ QUESNO,NQATT,CORRCT COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE C VILSTR, PAGE 2 C VILSTR=OCAPAC(V) IF(VILSTR.LE.0) RETURN IF((V.NE.THIEF).OR..NOT.THFENF) GO TO 100 THFENF=.FALSE. !THIEF UNENGROSSED. VILSTR=MIN0(VILSTR,2) !NO BETTER THAN 2. C 100 DO 200 I=1,VLNT !SEE IF BEST WEAPON. IF((VILLNS(I).EQ.V).AND.(PRSI.EQ.VBEST(I))) 1 VILSTR=MAX0(1,VILSTR-1) 200 CONTINUE RETURN END C GTTIME-- GET TOTAL TIME PLAYED C C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED C WRITTEN BY R. M. SUPNIK C C DECLARATIONS C SUBROUTINE GTTIME(T) IMPLICIT INTEGER(A-Z) C COMMON /TIME/ PLTIME,SHOUR,SMIN,SSEC C CALL ITIME(H,M,S) T=((H*60)+M)-((SHOUR*60)+SMIN) IF(T.LT.0) T=T+1440 T=T+PLTIME RETURN END C OPNCLS-- PROCESS OPEN/CLOSE FOR DOORS C C DECLARATIONS C LOGICAL FUNCTION OPNCLS(OBJ,SO,SC) IMPLICIT INTEGER (A-Z) LOGICAL QOPEN C C PARSER OUTPUT C LOGICAL PRSWON COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT, 1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT, 2 TOOLBT,TURNBT,ONBT COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT, 1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT, 2 TCHBT,VEHBT,SCHBT C C VERBS C COMMON /VINDEX/ CINTW,DEADXW,FRSTQW,INXW,OUTXW COMMON /VINDEX/ WALKIW,FIGHTW,FOOW COMMON /VINDEX/ MELTW,READW,INFLAW,DEFLAW,ALARMW,EXORCW COMMON /VINDEX/ PLUGW,KICKW,WAVEW,RAISEW,LOWERW,RUBW COMMON /VINDEX/ PUSHW,UNTIEW,TIEW,TIEUPW,TURNW,BREATW COMMON /VINDEX/ KNOCKW,LOOKW,EXAMIW,SHAKEW,MOVEW,TRNONW,TRNOFW COMMON /VINDEX/ OPENW,CLOSEW,FINDW,WAITW,SPINW,BOARDW,UNBOAW,TAKEW COMMON /VINDEX/ INVENW,FILLW,EATW,DRINKW,BURNW COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW COMMON /VINDEX/ DIGW,LEAPW,STAYW,FOLLOW COMMON /VINDEX/ HELLOW,LOOKIW,LOOKUW,PUMPW,WINDW COMMON /VINDEX/ CLMBW,CLMBUW,CLMBDW,TRNTOW C C FUNCTIONS AND DATA C QOPEN(O)=(OFLAG2(O).AND.OPENBT).NE.0 C OPNCLS=.TRUE. !ASSUME WINS. IF(PRSA.EQ.CLOSEW) GO TO 100 !CLOSE? IF(PRSA.EQ.OPENW) GO TO 50 !OPEN? OPNCLS=.FALSE. !LOSE RETURN C 50 IF(QOPEN(OBJ)) GO TO 200 !OPEN... IS IT? CALL RSPEAK(SO) OFLAG2(OBJ)=OFLAG2(OBJ).OR.OPENBT RETURN C 100 IF(.NOT.QOPEN(OBJ)) GO TO 200 !CLOSE... IS IT? CALL RSPEAK(SC) OFLAG2(OBJ)=OFLAG2(OBJ).AND..NOT.OPENBT RETURN C 200 CALL RSPEAK(125+RND(3)) !DUMMY. RETURN END C LIT-- IS ROOM LIT? C C DECLARATIONS C LOGICAL FUNCTION LIT(RM) IMPLICIT INTEGER (A-Z) LOGICAL QHERE C C ROOMS C COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200), 1 RACTIO(200),RVAL(200),RFLAG(200) INTEGER RRAND(200) EQUIVALENCE (RVAL,RRAND) C COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR, 1 RSACRD,RFILL,RMUNG,RBUCK,RHOUSE,RNWALL,REND C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT, 1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT, 2 TOOLBT,TURNBT,ONBT COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT, 1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT, 2 TCHBT,VEHBT,SCHBT C C ADVENTURERS C COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4), 1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4) C LIT=.TRUE. !ASSUME WINS IF((RFLAG(RM).AND.RLIGHT).NE.0) RETURN !ROOM LIT? C DO 1000 I=1,OLNT !LOOK FOR LIT OBJ IF(QHERE(I,RM)) GO TO 100 !IN ROOM? OA=OADV(I) !NO IF(OA.LE.0) GO TO 1000 !ON ADV? IF(AROOM(OA).NE.RM) GO TO 1000 !ADV IN ROOM? C C OBJ IN ROOM OR ON ADV IN ROOM C 100 IF((OFLAG1(I).AND.ONBT).NE.0) RETURN !LIT? IF(((OFLAG1(I).AND.VISIBT).EQ.0).OR. 1 (((OFLAG1(I).AND.TRANBT).EQ.0).AND. 2 ((OFLAG2(I).AND.OPENBT).EQ.0))) GO TO 1000 C C OBJ IS VISIBLE AND OPEN OR TRANSPARENT C DO 500 J=1,OLNT IF((OCAN(J).EQ.I).AND.((OFLAG1(J).AND.ONBT).NE.0)) 1 RETURN 500 CONTINUE 1000 CONTINUE LIT=.FALSE. RETURN END C WEIGHT- RETURNS SUM OF WEIGHT OF QUALIFYING OBJECTS C C DECLARATIONS C INTEGER FUNCTION WEIGHT(RM,CN,AD) IMPLICIT INTEGER (A-Z) LOGICAL QHERE C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C WEIGHT=0 DO 100 I=1,OLNT !OMIT BIG FIXED ITEMS. IF(OSIZE(I).GE.10000) GO TO 100 !IF FIXED, FORGET IT. IF((QHERE(I,RM).AND.(RM.NE.0)).OR. 1 ((OADV(I).EQ.AD).AND.(AD.NE.0))) GO TO 50 J=I !SEE IF CONTAINED. 25 J=OCAN(J) !GET NEXT LEVEL UP. IF(J.EQ.0) GO TO 100 !END OF LIST? IF(J.NE.CN) GO TO 25 50 WEIGHT=WEIGHT+OSIZE(I) 100 CONTINUE RETURN END C GHERE-- IS GLOBAL ACTUALLY IN THIS ROOM? C C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED C WRITTEN BY R. M. SUPNIK C C DECLARATIONS C LOGICAL FUNCTION GHERE(OBJ,RM) IMPLICIT INTEGER(A-Z) C C ROOMS C COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200), 1 RACTIO(200),RVAL(200),RFLAG(200) INTEGER RRAND(200) EQUIVALENCE (RVAL,RRAND) C COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR, 1 RSACRD,RFILL,RMUNG,RBUCK,RHOUSE,RNWALL,REND C COMMON /RINDEX/ WHOUS,LROOM,CELLA COMMON /RINDEX/ MTROL,MAZE1 COMMON /RINDEX/ MGRAT,MAZ15 COMMON /RINDEX/ FORE1,FORE3,CLEAR,RESER COMMON /RINDEX/ STREA,EGYPT,ECHOR COMMON /RINDEX/ TSHAF COMMON /RINDEX/ BSHAF,MMACH,DOME,MTORC COMMON /RINDEX/ CAROU COMMON /RINDEX/ RIDDL,LLD2,TEMP1,TEMP2,MAINT COMMON /RINDEX/ BLROO,TREAS,RIVR1,RIVR2,RIVR3,MCYCL COMMON /RINDEX/ RIVR4,RIVR5,FCHMP,FALLS,MBARR COMMON /RINDEX/ MRAIN,POG,VLBOT,VAIR1,VAIR2,VAIR3,VAIR4 COMMON /RINDEX/ LEDG2,LEDG3,LEDG4,MSAFE,CAGER COMMON /RINDEX/ CAGED,TWELL,BWELL,ALICE,ALISM,ALITR COMMON /RINDEX/ MTREE,BKENT,BKVW,BKTWI,BKVAU,BKBOX COMMON /RINDEX/ CRYPT,TSTRS,MRANT,MREYE COMMON /RINDEX/ MRA,MRB,MRC,MRG,MRD,FDOOR COMMON /RINDEX/ MRAE,MRCE,MRCW,MRGE,MRGW,MRDW,INMIR COMMON /RINDEX/ SCORR,NCORR,PARAP,CELL,PCELL,NCELL COMMON /RINDEX/ CPANT,CPOUT,CPUZZ C COMMON /STAR/ MBASE,STRBIT C GHERE, PAGE 2 C GHERE=.TRUE. !ASSUME WINS. GO TO (1000,1000,1000,1000,1000,1000, 1 1000,1000,1000,1000,1000, 2 2000,3000,4000,5000,5000,5000,6000, 3 7000,8000,9000,9100,8000,10000,11000),OBJ-STRBIT CALL BUG(60,OBJ) C C 1000-- STARS ARE ALWAYS HERE C 1000 RETURN C C 2000-- BIRD C 2000 GHERE=((RM.GE.FORE1).AND.(RM.LT.CLEAR)).OR.(RM.EQ.MTREE) RETURN C C 3000-- TREE C 3000 GHERE=((RM.GE.FORE1).AND.(RM.LT.CLEAR)).AND.(RM.NE.FORE3) RETURN C C 4000-- NORTH WALL C 4000 GHERE=((RM.GE.BKVW).AND.(RM.LE.BKBOX)).OR.(RM.EQ.CPUZZ) RETURN C C 5000-- EAST, SOUTH, WEST WALLS C 5000 GHERE=((RM.GE.BKVW).AND.(RM.LT.BKBOX)).OR.(RM.EQ.CPUZZ) RETURN C C 6000-- GLOBAL WATER C 6000 GHERE=(RFLAG(RM).AND.(RWATER+RFILL)).NE.0 RETURN C C 7000-- GLOBAL GUARDIANS C 7000 GHERE=((RM.GE.MRC).AND.(RM.LE.MRD)).OR. 1 ((RM.GE.MRCE).AND.(RM.LE.MRDW)).OR.(RM.EQ.INMIR) RETURN C C 8000-- ROSE/CHANNEL C 8000 GHERE=((RM.GE.MRA).AND.(RM.LE.MRD)).OR.(RM.EQ.INMIR) RETURN C C 9000-- MIRROR C 9100 PANEL C 9100 IF(RM.EQ.FDOOR) RETURN !PANEL AT FDOOR. 9000 GHERE=((RM.GE.MRA).AND.(RM.LE.MRC)).OR. 1 ((RM.GE.MRAE).AND.(RM.LE.MRCW)) RETURN C C 10000-- MASTER C 10000 GHERE=(RM.EQ.FDOOR).OR.(RM.EQ.NCORR).OR.(RM.EQ.PARAP).OR. 1 (RM.EQ.CELL) RETURN C C 11000-- LADDER C 11000 GHERE=(RM.EQ.CPUZZ) RETURN C END C MRHERE-- IS MIRROR HERE? C C DECLARATIONS C INTEGER FUNCTION MRHERE(RM) IMPLICIT INTEGER(A-Z) C C ROOMS C COMMON /RINDEX/ WHOUS,LROOM,CELLA COMMON /RINDEX/ MTROL,MAZE1 COMMON /RINDEX/ MGRAT,MAZ15 COMMON /RINDEX/ FORE1,FORE3,CLEAR,RESER COMMON /RINDEX/ STREA,EGYPT,ECHOR COMMON /RINDEX/ TSHAF COMMON /RINDEX/ BSHAF,MMACH,DOME,MTORC COMMON /RINDEX/ CAROU COMMON /RINDEX/ RIDDL,LLD2,TEMP1,TEMP2,MAINT COMMON /RINDEX/ BLROO,TREAS,RIVR1,RIVR2,RIVR3,MCYCL COMMON /RINDEX/ RIVR4,RIVR5,FCHMP,FALLS,MBARR COMMON /RINDEX/ MRAIN,POG,VLBOT,VAIR1,VAIR2,VAIR3,VAIR4 COMMON /RINDEX/ LEDG2,LEDG3,LEDG4,MSAFE,CAGER COMMON /RINDEX/ CAGED,TWELL,BWELL,ALICE,ALISM,ALITR COMMON /RINDEX/ MTREE,BKENT,BKVW,BKTWI,BKVAU,BKBOX COMMON /RINDEX/ CRYPT,TSTRS,MRANT,MREYE COMMON /RINDEX/ MRA,MRB,MRC,MRG,MRD,FDOOR COMMON /RINDEX/ MRAE,MRCE,MRCW,MRGE,MRGW,MRDW,INMIR COMMON /RINDEX/ SCORR,NCORR,PARAP,CELL,PCELL,NCELL COMMON /RINDEX/ CPANT,CPOUT,CPUZZ C C FLAGS C LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF, 1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF, 2 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF, 3 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF, 4 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF, 5 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF, 6 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF, 7 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ BTIEF,BINFF COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP COMMON /FINDEX/ MDIR,MLOC,POLEUF COMMON /FINDEX/ QUESNO,NQATT,CORRCT COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE C MRHERE, PAGE 2 C IF((RM.LT.MRAE).OR.(RM.GT.MRDW)) GO TO 100 C C RM IS AN E-W ROOM, MIRROR MUST BE N-S (MDIR= 0 OR 180) C MRHERE=1 !ASSUME MIRROR 1 HERE. IF(MOD(RM-MRAE,2).EQ.(MDIR/180)) MRHERE=2 RETURN C C RM IS NORTH OR SOUTH OF MIRROR. IF MIRROR IS N-S OR NOT C WITHIN ONE ROOM OF RM, LOSE. C 100 MRHERE=0 IF((IABS(MLOC-RM).NE.1).OR.(MOD(MDIR,180).EQ.0)) RETURN C C RM IS WITHIN ONE OF MLOC, AND MDIR IS E-W C MRHERE=1 IF(((RM.LT.MLOC).AND.(MDIR.LT.180)).OR. 1 ((RM.GT.MLOC).AND.(MDIR.GT.180))) MRHERE=2 RETURN END C ENCRYP-- ENCRYPT PASSWORD C C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED C WRITTEN BY R. M. SUPNIK C C DECLARATIONS C SUBROUTINE ENCRYP(INW,OUTW) IMPLICIT INTEGER(A-Z) LOGICAL*1 INW(6),OUTW(6),KEYW(6) INTEGER UINW(6),UKEYW(6) DATA KEYW/'E','C','O','R','M','S'/ C UINWS=0 !UNBIASED INW SUM. UKEYWS=0 !UNBIASED KEYW SUM. J=1 !POINTER IN KEYWORD. DO 100 I=1,6 !UNBIAS, COMPUTE SUMS. UKEYW(I)=KEYW(I)-"100 !STRIP ASCII. IF(INW(J).LE."100) J=1 !RECYCLE ON BAD. UINW(I)=INW(J)-"100 UKEYWS=UKEYWS+UKEYW(I) UINWS=UINWS+UINW(I) J=J+1 100 CONTINUE C USUM=MOD(UINWS,8)+(8*MOD(UKEYWS,8)) !COMPUTE MASK. DO 200 I=1,6 J=(UINW(I).XOR.UKEYW(I).XOR.USUM).AND."37 USUM=MOD(USUM+1,32) IF(J.GT.26) J=MOD(J,26) OUTW(I)=MAX0(1,J)+"100 200 CONTINUE RETURN C END C CPGOTO-- MOVE TO NEXT STATE IN PUZZLE ROOM C C DECLARATIONS C SUBROUTINE CPGOTO(ST) IMPLICIT INTEGER(A-Z) C COMMON /HYPER/ HFACTR C C ROOMS C COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200), 1 RACTIO(200),RVAL(200),RFLAG(200) INTEGER RRAND(200) EQUIVALENCE (RVAL,RRAND) C COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR, 1 RSACRD,RFILL,RMUNG,RBUCK,RHOUSE,RNWALL,REND C COMMON /RINDEX/ WHOUS,LROOM,CELLA COMMON /RINDEX/ MTROL,MAZE1 COMMON /RINDEX/ MGRAT,MAZ15 COMMON /RINDEX/ FORE1,FORE3,CLEAR,RESER COMMON /RINDEX/ STREA,EGYPT,ECHOR COMMON /RINDEX/ TSHAF COMMON /RINDEX/ BSHAF,MMACH,DOME,MTORC COMMON /RINDEX/ CAROU COMMON /RINDEX/ RIDDL,LLD2,TEMP1,TEMP2,MAINT COMMON /RINDEX/ BLROO,TREAS,RIVR1,RIVR2,RIVR3,MCYCL COMMON /RINDEX/ RIVR4,RIVR5,FCHMP,FALLS,MBARR COMMON /RINDEX/ MRAIN,POG,VLBOT,VAIR1,VAIR2,VAIR3,VAIR4 COMMON /RINDEX/ LEDG2,LEDG3,LEDG4,MSAFE,CAGER COMMON /RINDEX/ CAGED,TWELL,BWELL,ALICE,ALISM,ALITR COMMON /RINDEX/ MTREE,BKENT,BKVW,BKTWI,BKVAU,BKBOX COMMON /RINDEX/ CRYPT,TSTRS,MRANT,MREYE COMMON /RINDEX/ MRA,MRB,MRC,MRG,MRD,FDOOR COMMON /RINDEX/ MRAE,MRCE,MRCW,MRGE,MRGW,MRDW,INMIR COMMON /RINDEX/ SCORR,NCORR,PARAP,CELL,PCELL,NCELL COMMON /RINDEX/ CPANT,CPOUT,CPUZZ C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT, 1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT, 2 TOOLBT,TURNBT,ONBT COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT, 1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT, 2 TCHBT,VEHBT,SCHBT C C FLAGS C LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF, 1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF, 2 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF, 3 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF, 4 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF, 5 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF, 6 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF, 7 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ BTIEF,BINFF COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP COMMON /FINDEX/ MDIR,MLOC,POLEUF COMMON /FINDEX/ QUESNO,NQATT,CORRCT COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE C CPGOTO, PAGE 2 C RFLAG(CPUZZ)=RFLAG(CPUZZ).AND..NOT.RSEEN DO 100 I=1,OLNT !RELOCATE OBJECTS. IF((OROOM(I).EQ.CPUZZ).AND. 1 ((OFLAG2(I).AND.(ACTRBT+VILLBT)).EQ.0)) 2 CALL NEWSTA(I,0,CPHERE*HFACTR,0,0) IF(OROOM(I).EQ.(ST*HFACTR)) 1 CALL NEWSTA(I,0,CPUZZ,0,0) 100 CONTINUE CPHERE=ST RETURN C END C CPINFO-- DESCRIBE PUZZLE ROOM C C DECLARATIONS C SUBROUTINE CPINFO(RMK,ST) IMPLICIT INTEGER(A-Z) INTEGER DGM(8),DGMOFT(8),PICT(5) C COMMON /CHAN/ INPCH,OUTCH,DBCH C C PUZZLE ROOM C COMMON /PUZZLE/ CPDR(16),CPWL(8),CPVEC(64) C C FLAGS C LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF, 1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF, 2 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF, 3 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF, 4 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF, 5 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF, 6 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF, 7 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ BTIEF,BINFF COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP COMMON /FINDEX/ MDIR,MLOC,POLEUF COMMON /FINDEX/ QUESNO,NQATT,CORRCT COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE C C FUNCTIONS AND LOCAL DATA C DATA DGMOFT/-9,-8,-7,-1,1,7,8,9/ DATA PICT/'SS','SS','SS',' ','MM'/ DATA QMK/'??'/ C CPINFO, PAGE 2 C CALL RSPEAK(RMK) DO 100 I=1,8 J=DGMOFT(I) DGM(I)=PICT(CPVEC(ST+J)+4) !GET PICTURE ELEMENT. IF((IABS(J).EQ.1).OR.(IABS(J).EQ.8)) GO TO 100 K=8 IF(J.LT.0) K=-8 !GET ORTHO DIR. L=J-K IF((CPVEC(ST+K).NE.0).AND.(CPVEC(ST+L).NE.0)) 1 DGM(I)=QMK 100 CONTINUE WRITE(OUTCH,10) DGM C IF(ST.EQ.10) CALL RSPEAK(870) !AT HOLE? IF(ST.EQ.37) CALL RSPEAK(871) !AT NICHE? I=872 !DOOR OPEN? IF(CPOUTF) I=873 IF(ST.EQ.52) CALL RSPEAK(I) !AT DOOR? IF(CPVEC(ST+1).EQ.-2) CALL RSPEAK(874) !EAST LADDER? IF(CPVEC(ST-1).EQ.-3) CALL RSPEAK(875) !WEST LADDER? RETURN C 10 FORMAT(' |',A2,1X,A2,1X,A2,'|'/, 1' West |',A2,' .. ',A2,'| East',/ 2' |',A2,1X,A2,1X,A2,'|') C END C RESIDENT SUBROUTINES FOR DUNGEON C C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED C WRITTEN BY R. M. SUPNIK C C RSPEAK-- OUTPUT RANDOM MESSAGE ROUTINE C C CALLED BY-- C C CALL RSPEAK(MSGNUM) C SUBROUTINE RSPEAK(N) IMPLICIT INTEGER(A-Z) C CALL RSPSB2(N,0,0) RETURN END C RSPSUB-- OUTPUT RANDOM MESSAGE WITH SUBSTITUTABLE ARGUMENT C C CALLED BY-- C C CALL RSPSUB(MSGNUM,SUBNUM) C SUBROUTINE RSPSUB(N,S1) IMPLICIT INTEGER(A-Z) C CALL RSPSB2(N,S1,0) RETURN END C RSPSB2-- OUTPUT RANDOM MESSAGE WITH SUBSTITUTABLE ARGUMENTS C C CALLED BY-- C C CALL RSPSB2(MSGNUM,S1,S2) C SUBROUTINE RSPSB2(A,B,C) IMPLICIT INTEGER(A-Z) LOGICAL*1 B1(74),B2(74),X1 C C DECLARATIONS C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG C COMMON /RMSG/ MLNT,RTEXT(1050) COMMON /CHAN/ INPCH,OUTCH,DBCH C C CONVERT ALL ARGUMENTS FROM DICTIONARY NUMBERS (IF POSITIVE) C TO ABSOLUTE RECORD NUMBERS. C X=A !SET UP WORK VARIABLES. Y=B Z=C IF(X.GT.0) X=RTEXT(X) !IF >0, LOOK UP IN RTEXT. IF(Y.GT.0) Y=RTEXT(Y) IF(Z.GT.0) Z=RTEXT(Z) X=IABS(X) !TAKE ABS VALUE. Y=IABS(Y) Z=IABS(Z) IF(X.EQ.0) RETURN !ANYTHING TO DO? TELFLG=.TRUE. !SAID SOMETHING. C READ(DBCH'X) OLDREC,B1 !READ FIRST LINE. 100 DO 150 I=1,74 X1=(X.AND.31)+I B1(I)=B1(I).XOR.X1 150 CONTINUE C 200 IF(Y.EQ.0) GO TO 400 !ANY SUBSTITUTABLE? DO 300 I=1,74 !YES, LOOK FOR #. IF(B1(I).EQ.'#') GO TO 1000 300 CONTINUE C 400 DO 500 I=74,1,-1 !BACKSCAN FOR BLANKS. IF(B1(I).NE.' ') GO TO 600 500 CONTINUE C 600 WRITE(OUTCH,650) (B1(J),J=1,I) !OUTPUT LINE. 650 FORMAT(1X,74A1) X=X+1 !ON TO NEXT RECORD. READ(DBCH'X) NEWREC,B1 !READ NEXT RECORD. IF(OLDREC.EQ.NEWREC) GO TO 100 !CONTINUATION? RETURN !NO, EXIT. C C SUBSTITUTION WITH SUBSTITUTABLE AVAILABLE. C I IS INDEX OF # IN B1. C Y IS NUMBER OF RECORD TO SUBSTITUTE. C C PROCEDURE: C 1) COPY REST OF B1 TO B2 C 2) READ SUBSTITUTABLE OVER B1 C 3) RESTORE TAIL OF ORIGINAL B1 C C THE IMPLICIT ASSUMPTION HERE IS THAT THE SUBSTITUTABLE STRING C IS VERY SHORT. C 1000 K2=1 !TO DO 1100 K1=I+1,74 !COPY REST OF B1. B2(K2)=B1(K1) K2=K2+1 1100 CONTINUE C READ(DBCH'Y) J,(B1(K1),K1=I,74) !READ SUB RECORD. DO 1150 K1=I,74 X1=(Y.AND.31)+K1-I+1 B1(K1)=B1(K1).XOR.X1 1150 CONTINUE C DO 1200 J=74,1,-1 !ELIM TRAILING BLANKS. IF(B1(J).NE.' ') GO TO 1300 1200 CONTINUE C 1300 K1=1 !FROM DO 1400 K2=J+1,74 !COPY REST OF B1 BACK. B1(K2)=B2(K1) K1=K1+1 1400 CONTINUE C Y=Z !SET UP FOR NEXT Z=0 !SUBSTITUTION AND GO TO 200 !RECHECK LINE. C END C OBJACT-- APPLY OBJECTS FROM PARSE VECTOR C C DECLARATIONS C LOGICAL FUNCTION OBJACT(X) IMPLICIT INTEGER (A-Z) LOGICAL OAPPLI C C PARSER OUTPUT C LOGICAL PRSWON COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C OBJACT=.TRUE. !ASSUME WINS. IF(PRSI.EQ.0) GO TO 100 !IND OBJECT? IF(OAPPLI(OACTIO(PRSI),0)) RETURN !YES, LET IT HANDLE. C 100 IF(PRSO.EQ.0) GO TO 200 !DIR OBJECT? IF(OAPPLI(OACTIO(PRSO),0)) RETURN !YES, LET IT HANDLE. C 200 OBJACT=.FALSE. !LOSES. RETURN END C BUG-- REPORT FATAL SYSTEM ERROR C C CALLED BY-- C C CALL BUG(NO,PAR) C SUBROUTINE BUG(A,B) IMPLICIT INTEGER(A-Z) C COMMON /DEBUG/ DBGFLG C TYPE 100,A,B IF(DBGFLG.NE.0) RETURN CALL EXIT C 100 FORMAT(' PROGRAM ERROR ',I2,', PARAMETER=',I6) END C NEWSTA-- SET NEW STATUS FOR OBJECT C C CALLED BY-- C C CALL NEWSTA(OBJECT,STRING,NEWROOM,NEWCON,NEWADV) C SUBROUTINE NEWSTA(O,R,RM,CN,AD) IMPLICIT INTEGER(A-Z) C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C CALL RSPEAK(R) OROOM(O)=RM OCAN(O)=CN OADV(O)=AD RETURN END C QHERE-- TEST FOR OBJECT IN ROOM C C DECLARATIONS C LOGICAL FUNCTION QHERE(OBJ,RM) IMPLICIT INTEGER (A-Z) C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OROOM2/ R2LNT,O2(20),R2(20) C QHERE=.TRUE. IF(OROOM(OBJ).EQ.RM) RETURN !IN ROOM? DO 100 I=1,R2LNT !NO, SCH ROOM2. IF((O2(I).EQ.OBJ).AND.(R2(I).EQ.RM)) RETURN 100 CONTINUE QHERE=.FALSE. !NOT PRESENT. RETURN END C QEMPTY-- TEST FOR OBJECT EMPTY C C DECLARATIONS C LOGICAL FUNCTION QEMPTY(OBJ) IMPLICIT INTEGER (A-Z) C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C QEMPTY=.FALSE. !ASSUME LOSE. DO 100 I=1,OLNT IF(OCAN(I).EQ.OBJ) RETURN !INSIDE TARGET? 100 CONTINUE QEMPTY=.TRUE. RETURN END C JIGSUP- YOU ARE DEAD C C DECLARATIONS C SUBROUTINE JIGSUP(DESC) IMPLICIT INTEGER (A-Z) LOGICAL YESNO,MOVETO,QHERE,F INTEGER RLIST(9) C C PARSER OUTPUT C LOGICAL PRSWON COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD, 1 LTSHFT,BLOC,MUNGRM,HS,EGSCOR,EGMXSC C COMMON /CHAN/ INPCH,OUTCH,DBCH COMMON /DEBUG/ DBGFLG C C ROOMS C COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200), 1 RACTIO(200),RVAL(200),RFLAG(200) INTEGER RRAND(200) EQUIVALENCE (RVAL,RRAND) C COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR, 1 RSACRD,RFILL,RMUNG,RBUCK,RHOUSE,RNWALL,REND C COMMON /RINDEX/ WHOUS,LROOM,CELLA COMMON /RINDEX/ MTROL,MAZE1 COMMON /RINDEX/ MGRAT,MAZ15 COMMON /RINDEX/ FORE1,FORE3,CLEAR,RESER COMMON /RINDEX/ STREA,EGYPT,ECHOR COMMON /RINDEX/ TSHAF COMMON /RINDEX/ BSHAF,MMACH,DOME,MTORC COMMON /RINDEX/ CAROU COMMON /RINDEX/ RIDDL,LLD2,TEMP1,TEMP2,MAINT COMMON /RINDEX/ BLROO,TREAS,RIVR1,RIVR2,RIVR3,MCYCL COMMON /RINDEX/ RIVR4,RIVR5,FCHMP,FALLS,MBARR COMMON /RINDEX/ MRAIN,POG,VLBOT,VAIR1,VAIR2,VAIR3,VAIR4 COMMON /RINDEX/ LEDG2,LEDG3,LEDG4,MSAFE,CAGER COMMON /RINDEX/ CAGED,TWELL,BWELL,ALICE,ALISM,ALITR COMMON /RINDEX/ MTREE,BKENT,BKVW,BKTWI,BKVAU,BKBOX COMMON /RINDEX/ CRYPT,TSTRS,MRANT,MREYE COMMON /RINDEX/ MRA,MRB,MRC,MRG,MRD,FDOOR COMMON /RINDEX/ MRAE,MRCE,MRCW,MRGE,MRGW,MRDW,INMIR COMMON /RINDEX/ SCORR,NCORR,PARAP,CELL,PCELL,NCELL COMMON /RINDEX/ CPANT,CPOUT,CPUZZ C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT, 1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT, 2 TOOLBT,TURNBT,ONBT COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT, 1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT, 2 TCHBT,VEHBT,SCHBT C COMMON /OINDEX/ GARLI,FOOD,GUNK,COAL,MACHI,DIAMO,TCASE,BOTTL COMMON /OINDEX/ WATER,ROPE,KNIFE,SWORD,LAMP,BLAMP,RUG COMMON /OINDEX/ LEAVE,TROLL,AXE COMMON /OINDEX/ RKNIF,KEYS,ICE,BAR COMMON /OINDEX/ COFFI,TORCH,TBASK,FBASK,IRBOX COMMON /OINDEX/ GHOST,TRUNK,BELL,BOOK,CANDL COMMON /OINDEX/ MATCH,TUBE,PUTTY,WRENC,SCREW,CYCLO,CHALI COMMON /OINDEX/ THIEF,STILL,WINDO,GRATE,DOOR COMMON /OINDEX/ HPOLE,LEAK,RBUTT,RAILI COMMON /OINDEX/ POT,STATU,IBOAT,DBOAT,PUMP,RBOAT COMMON /OINDEX/ STICK,BUOY,SHOVE,BALLO,RECEP,GUANO COMMON /OINDEX/ BROPE,HOOK1,HOOK2,SAFE,SSLOT,BRICK,FUSE COMMON /OINDEX/ GNOME,BLABE,DBALL,TOMB COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE COMMON /OINDEX/ ROBOT,FTREE,BILLS,PORTR,SCOL,ZGNOM COMMON /OINDEX/ EGG,BEGG,BAUBL,CANAR,BCANA COMMON /OINDEX/ YLWAL,RDWAL,PINDR,RBEAM COMMON /OINDEX/ ODOOR,QDOOR,CDOOR,NUM1,NUM8 COMMON /OINDEX/ WARNI,CSLIT,GCARD,STLDR COMMON /OINDEX/ HANDS,WALL,LUNGS,SAILO,AVIAT,TEETH COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,WNORT,GWATE,MASTER C C ADVENTURERS C COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4), 1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4) C COMMON /AINDEX/ PLAYER,AROBOT,AMASTR C C FLAGS C LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF, 1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF, 2 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF, 3 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF, 4 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF, 5 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF, 6 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF, 7 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ BTIEF,BINFF COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP COMMON /FINDEX/ MDIR,MLOC,POLEUF COMMON /FINDEX/ QUESNO,NQATT,CORRCT COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE C C FUNCTIONS AND DATA C DATA RLIST/8,6,36,35,34,4,34,6,5/ C JIGSUP, PAGE 2 C CALL RSPEAK(DESC) !DESCRIBE SAD STATE. PRSCON=1 !STOP PARSER. IF(DBGFLG.NE.0) RETURN !IF DBG, EXIT. AVEHIC(WINNER)=0 !GET RID OF VEHICLE. IF(WINNER.EQ.PLAYER) GO TO 100 !HIMSELF? CALL RSPSUB(432,ODESC2(AOBJ(WINNER))) !NO, SAY WHO DIED. CALL NEWSTA(AOBJ(WINNER),0,0,0,0) !SEND TO HYPER SPACE. RETURN C 100 IF(ENDGMF) GO TO 900 !NO RECOVERY IN END GAME. IF(DEATHS.GE.2) GO TO 1000 !DEAD TWICE? KICK HIM OFF. IF(.NOT.YESNO(10,9,8)) GO TO 1100 !CONTINUE? C DO 50 J=1,OLNT !TURN OFF FIGHTING. IF(QHERE(J,HERE)) OFLAG2(J)=OFLAG2(J).AND. .NOT.FITEBT 50 CONTINUE C DEATHS=DEATHS+1 CALL SCRUPD(-10) !CHARGE TEN POINTS. F=MOVETO(FORE1,WINNER) !REPOSITION HIM. EGYPTF=.TRUE. !RESTORE COFFIN. IF(OADV(COFFI).EQ.WINNER) CALL NEWSTA(COFFI,0,EGYPT,0,0) OFLAG2(DOOR)=OFLAG2(DOOR).AND. .NOT.TCHBT !RESTORE DOOR. OFLAG1(ROBOT)=(OFLAG1(ROBOT).OR.VISIBT) .AND. .NOT.NDSCBT IF((OROOM(LAMP).NE.0).OR.(OADV(LAMP).EQ.WINNER)) 1 CALL NEWSTA(LAMP,0,LROOM,0,0) !RESTORE LAMP. C C NOW REDISTRIBUTE HIS VALUABLES AND OTHER BELONGINGS. C C THE LAMP HAS BEEN PLACED IN THE LIVING ROOM. C THE FIRST 8 NON-VALUABLES ARE PLACED IN LOCATIONS AROUND THE HOUSE. C HIS VALUABLES ARE PLACED AT THE END OF THE MAZE. C REMAINING NON-VALUABLES ARE PLACED AT THE END OF THE MAZE. C I=1 DO 200 J=1,OLNT !LOOP THRU OBJECTS. IF((OADV(J).NE.WINNER).OR.(OTVAL(J).NE.0)) 1 GO TO 200 !GET HIS NON-VAL OBJS. I=I+1 IF(I.GT.9) GO TO 400 !MOVE TO RANDOM LOCATIONS. CALL NEWSTA(J,0,RLIST(I),0,0) 200 CONTINUE C 400 I=RLNT+1 !NOW MOVE VALUABLES. NONOFL=RAIR+RWATER+RSACRD+REND !DONT MOVE HERE. DO 300 J=1,OLNT IF((OADV(J).NE.WINNER).OR.(OTVAL(J).EQ.0)) 1 GO TO 300 !ON ADV AND VALUABLE? 250 I=I-1 !FIND NEXT ROOM. IF((RFLAG(I).AND.NONOFL).NE.0) GO TO 250 !SKIP IF NONO. CALL NEWSTA(J,0,I,0,0) !YES, MOVE. 300 CONTINUE C DO 500 J=1,OLNT !NOW GET RID OF REMAINDER. IF(OADV(J).NE.WINNER) GO TO 500 450 I=I-1 !FIND NEXT ROOM. IF((RFLAG(I).AND.NONOFL).NE.0) GO TO 450 !SKIP IF NONO. CALL NEWSTA(J,0,I,0,0) 500 CONTINUE RETURN C C CANT OR WONT CONTINUE, CLEAN UP AND EXIT. C 900 CALL RSPEAK(625) !IN ENDGAME, LOSE. GO TO 1100 C 1000 CALL RSPEAK(7) !INVOLUNTARY EXIT. 1100 CALL SCORE(.FALSE.) !TELL SCORE. CLOSE (UNIT=DBCH) CALL EXIT C END C OACTOR- GET ACTOR ASSOCIATED WITH OBJECT C C DECLARATIONS C INTEGER FUNCTION OACTOR(OBJ) IMPLICIT INTEGER(A-Z) C C ADVENTURERS C COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4), 1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4) C DO 100 I=1,ALNT !LOOP THRU ACTORS. OACTOR=I !ASSUME FOUND. IF(AOBJ(I).EQ.OBJ) RETURN !FOUND IT? 100 CONTINUE CALL BUG(40,OBJ) !NO, DIE. RETURN END C PROB- COMPUTE PROBABILITY C C DECLARATIONS C LOGICAL FUNCTION PROB(G,B) IMPLICIT INTEGER(A-Z) C C FLAGS C LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF, 1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF, 2 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF, 3 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF, 4 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF, 5 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF, 6 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF, 7 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ BTIEF,BINFF COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP COMMON /FINDEX/ MDIR,MLOC,POLEUF COMMON /FINDEX/ QUESNO,NQATT,CORRCT COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE C I=G !ASSUME GOOD LUCK. IF(BADLKF) I=B !IF BAD, TOO BAD. PROB=RND(100).LT.I !COMPUTE. RETURN END C RMDESC-- PRINT ROOM DESCRIPTION C C RMDESC PRINTS A DESCRIPTION OF THE CURRENT ROOM. C IT IS ALSO THE PROCESSOR FOR VERBS 'LOOK' AND 'EXAMINE'. C LOGICAL FUNCTION RMDESC(FULL) C C FULL= 0/1/2/3= SHORT/OBJ/ROOM/FULL C C DECLARATIONS C IMPLICIT INTEGER (A-Z) LOGICAL PROB,LIT,RAPPLI C C PARSER OUTPUT C LOGICAL PRSWON COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG C C SCREEN OF LIGHT C COMMON /SCREEN/ FROMDR,SCOLRM,SCOLAC C C ROOMS C COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200), 1 RACTIO(200),RVAL(200),RFLAG(200) INTEGER RRAND(200) EQUIVALENCE (RVAL,RRAND) C COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR, 1 RSACRD,RFILL,RMUNG,RBUCK,RHOUSE,RNWALL,REND C COMMON /XSRCH/ XMIN,XMAX,XDOWN,XUP, 1 XNORTH,XSOUTH,XENTER,XEXIT,XEAST,XWEST C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C C ADVENTURERS C COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4), 1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4) C COMMON /AINDEX/ PLAYER,AROBOT,AMASTR C C VERBS C COMMON /VINDEX/ CINTW,DEADXW,FRSTQW,INXW,OUTXW COMMON /VINDEX/ WALKIW,FIGHTW,FOOW COMMON /VINDEX/ MELTW,READW,INFLAW,DEFLAW,ALARMW,EXORCW COMMON /VINDEX/ PLUGW,KICKW,WAVEW,RAISEW,LOWERW,RUBW COMMON /VINDEX/ PUSHW,UNTIEW,TIEW,TIEUPW,TURNW,BREATW COMMON /VINDEX/ KNOCKW,LOOKW,EXAMIW,SHAKEW,MOVEW,TRNONW,TRNOFW COMMON /VINDEX/ OPENW,CLOSEW,FINDW,WAITW,SPINW,BOARDW,UNBOAW,TAKEW COMMON /VINDEX/ INVENW,FILLW,EATW,DRINKW,BURNW COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW COMMON /VINDEX/ DIGW,LEAPW,STAYW,FOLLOW COMMON /VINDEX/ HELLOW,LOOKIW,LOOKUW,PUMPW,WINDW COMMON /VINDEX/ CLMBW,CLMBUW,CLMBDW,TRNTOW C C FLAGS C LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF, 1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF, 2 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF, 3 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF, 4 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF, 5 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF, 6 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF, 7 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ BTIEF,BINFF COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP COMMON /FINDEX/ MDIR,MLOC,POLEUF COMMON /FINDEX/ QUESNO,NQATT,CORRCT COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE C RMDESC, PAGE 2 C RMDESC=.TRUE. !ASSUME WINS. IF(PRSO.LT.XMIN) GO TO 50 !IF DIRECTION, FROMDR=PRSO !SAVE AND PRSO=0 !CLEAR. 50 IF(HERE.EQ.AROOM(PLAYER)) GO TO 100 !PLAYER JUST MOVE? CALL RSPEAK(2) !NO, JUST SAY DONE. PRSA=WALKIW !SET UP WALK IN ACTION. RETURN C 100 IF(LIT(HERE)) GO TO 300 !LIT? CALL RSPEAK(430) !WARN OF GRUE. RMDESC=.FALSE. RETURN C 300 RA=RACTIO(HERE) !GET ROOM ACTION. IF(FULL.EQ.1) GO TO 600 !OBJ ONLY? I=RDESC2-HERE !ASSUME SHORT DESC. IF((FULL.EQ.0) 1 .AND. (SUPERF.OR.(((RFLAG(HERE).AND.RSEEN).NE.0) 1 .AND. (BRIEFF.OR.PROB(80,80))))) GO TO 400 I=RDESC1(HERE) !USE LONG. IF((I.NE.0).OR.(RA.EQ.0)) GO TO 400 !IF GOT DESC, SKIP. PRSA=LOOKW !PRETEND LOOK AROUND. IF(.NOT.RAPPLI(RA)) GO TO 100 !ROOM HANDLES, NEW DESC? PRSA=FOOW !NOP PARSER. GO TO 500 C 400 CALL RSPEAK(I) !OUTPUT DESCRIPTION. 500 IF(AVEHIC(WINNER).NE.0) CALL RSPSUB(431,ODESC2(AVEHIC(WINNER))) C 600 IF(FULL.NE.2) CALL PRINCR(FULL.NE.0,HERE) RFLAG(HERE)=RFLAG(HERE).OR.RSEEN !INDICATE ROOM SEEN. IF((FULL.NE.0).OR.(RA.EQ.0)) RETURN !ANYTHING MORE? PRSA=WALKIW !GIVE HIM A SURPISE. IF(.NOT.RAPPLI(RA)) GO TO 100 !ROOM HANDLES, NEW DESC? PRSA=FOOW RETURN C END C RAPPLI- ROUTING ROUTINE FOR ROOM APPLICABLES C C DECLARATIONS C LOGICAL FUNCTION RAPPLI(RI) IMPLICIT INTEGER(A-Z) LOGICAL RAPPL1,RAPPL2 DATA NEWRMS/38/ C RAPPLI=.TRUE. !ASSUME WINS. IF(RI.EQ.0) RETURN !IF ZERO, WIN. IF(RI.LT.NEWRMS) RAPPLI=RAPPL1(RI) !IF OLD, PROCESSOR 1. IF(RI.GE.NEWRMS) RAPPLI=RAPPL2(RI) !IF NEW, PROCESSOR 2. RETURN END To: Dungeon Players From: "The Translator" Subj: Game Information Date: 8-OCT-80 This is the first (and last) source release of the PDP-11 version of Dungeon. Please note that Dungeon has been superceded by the game ZORK(tm). The following is an extract from the new product announcement for ZORK in the September, 1980 issue of the RT-11 SIG newsletter: "'ZORK: The Great Underground Empire - Part I' ...was developed by the original authors based on their ZORK (Dungeon) game for the PDP-10. It features a greatly improved parser; command input and transcript output files; SAVEs to any device and file name; and adaptation to different terminal types, including a status line on VT100s. Note: this is not the FORTRAN version that has been available through DECUS. This version has been completely rewritten to run efficiently on small machines - up to 10 times as fast as the DECUS version. ...ZORK runs under RT-ll, HT-ll, or RSTS/E and requires as little as 20K words of memory and a single floppy disk drive. The game package, consisting of an RX01-format diskette and an instruction booklet, is available from Infocom, Inc., P.O. Box 120, Kendall Station, Cambridge, Ma. 02142." ZORK(tm) is a trademark of Infocom, Inc. It is available for several popular personal computers as well as for the PDP-ll. 1. Components Dungeon is a maze-solving game for solitaire play. It runs on any PDP-11 (with 28KW of memory or more) or VAX-11. Dungeon consists of the following files: all operating systems --------------------- DMAIN.FTN -program root DGAME.FTN -main routine DSUB.FTN -resident subroutines DINIT.FTN -initialization routine NP.FOR -parser, part 0 NP1.FOR -parser, part 1 NP2.FOR -parser, part 2 NP3.FOR -parser, part 3 GDT.FTN -game debugging tool VERBS.FTN -principal verbs OBJCTS.FTN -principal objects SVERBS.FTN -simple verbs DVERB1.FTN -auxiliary verbs, part 1 DVERB2.FTN -auxiliary verbs, part 2 all operating systems (continued) --------------------------------- ACTORS.FTN -character processors DEMONS.FTN -demon processors CLOCKR.FTN -clock event processors ROOMS.FOR -room processors NROOMS.FOR -new room processors SOBJS.FOR -simple objects NOBJS.FOR -new objects BALLOP.FOR -balloon processor LIGHTP.FOR -light processors VILLNS.FOR -villain processors DSO1.FOR -overlaid subroutines, part 1 DSO2.FOR -overlaid subroutines, part 2 DSO3.FOR -overlaid subroutines, part 3 DSO4.FOR -overlaid subroutines, part 4 DSO5.FOR -overlaid subroutines, part 5 DSO6.FOR -overlaid subroutines, part 6 DSO7.FOR -overlaid subroutines, part 7 DINDX.DAT -initialization data base DTEXT.DAT -main data base [binary file] DUNGEO.DOC -this file RT11 only --------- RTTIM.FOR -time subroutine RRND.MAC -random number generator RTCMP.COM -compile command file RTBLD.COM -link command file RSTS/E only ----------- RTTIM.FOR -time subroutine RRND.MAC -random number generator RSTSCB.CTL -compile/build batch file RSX11M, RSX11M+ only -------------------- RSXTIM.MAC -time subroutine RRND.MAC -random number generator RSXCMP.CMD -compile command file RSXBLD.CMD -task build command file D.ODL -overlay descriptor file VMS only -------- VMSTIM.FOR -time subroutine VMSRND.MAC -random number generator VMSCMP.COM -compile command file VMSBLD.COM -link command file 2. Installation Instructions, RT11 Before starting, please note that: - Dungeon requires RT11 V3 or later. - Dungeon requires Fortran-IV V2 or later, threaded code option. - Dungeon requires 26KW of user memory (runs under SJ monitor only). - All files (source and object) must reside on the same disk (at least 2500 disk blocks are needed). - Dungeon does not require EIS or floating point. Except for DTEXT.DAT, all files in the distribution kit are ASCII. DTEXT.DAT is a binary file consisting of 76-byte fixed length records. If the distribution kit consists of RT11-compatible media, then PIP can be used to transfer the files. If the distribution kit consists of DOS-compatible media, then FILEX must be used to transfer the files. The /I switch (image binary) must be used to transfer DTEXT.DAT; the /A (ASCII) switch should be used to transfer the other files. To compile Dungeon, issue the following command: .@RTCMP(cr) Several of the compilations will produce warning messages, but none should produce a fatal error. To link the compiled sources, issue the following command: .@RTBLD(cr) The command file assumes that the Fortran-IV object time library has been merged into the system library. If this is not the case, edit RTBLD.COM and add switch /LINKLIBRARY:FORLIB.OBJ to the first command line. It is now possible to run Dungeon: .R DUNGEO(cr) When invoked, Dungeon takes no more than 5-10 seconds to start up. Notes on the executable program: - The only files needed to execute Dungeon are DUNGEO.SAV, DINDX.DAT, and DTEXT.DAT. All other files can be deleted. - Files DINDX.DAT and DTEXT.DAT must reside on logical device SY: (this can be changed with a source edit, see section 8). 3. Installation Instructions, RSTS/E Before starting, please note that: - Dungeon requires RSTS/E V6C or later. - Dungeon requires Fortran-IV V2 or later, threaded code option (operation under Fortran-IV-Plus V2.5 or later will probably work but is not supported). - Dungeon requires 28KW of user memory. - All files (source and object) must reside in the same user area (at least 2500 disk blocks are needed). - Dungeon does not require EIS or floating point. Except for DTEXT.DAT, all files in the distribution kit are ASCII. DTEXT.DAT is a binary file consisting of 76-byte fixed length records. If the distribution kit consists of RT11- or DOS-compatible disks, then FIT can be used to transfer the files. For example (RT11 disk): RUN $FIT(cr) FIT>*.*/RSTS=DK:*.*/RT11(cr) FIT>^Z If the distribution kit consists of DOS-compatible magtape, then PIP can be used to transfer the files, providing that the magtape is assigned as a DOS-label device. For example: ASSIGN MM0:.DOS(cr) RUN $PIP(cr) **.*/AS=MM:*.FTN,*.FOR,*.MAC,*.DOC,*.CTL(cr) **.*/AS=MM:*.CMD,*.COM,*.ODL,DINDX.DAT(cr) **.*/BL=MM:DTEXT.DAT(cr) *^C DEASS MM0:(cr) To compile and link Dungeon, submit control file RSTSCB.CTL to the batch processor: SUBMIT RSTSCB.CTL(cr) Several of the compilations will produce warning messages, but none should produce a fatal error. It is now possible to run Dungeon: RUN DUNGEO(cr) When invoked, Dungeon takes no more than 5-10 seconds to start up. Notes on the executable program: - The only files needed to execute Dungeon are DUNGEO.SAV, DINDX.DAT, and DTEXT.DAT. All other files can be deleted. - Files DINDX.DAT and DTEXT.DAT must reside in the user's area on logical device SY: (this can be changed with a source edit, see section 8). 4. Installation Instructions, RSX11M and RSX11M+ Before starting, please note that: - Dungeon requires RSX11M V3 (RSX11M+ V1) or later. - Dungeon requires Fortran-IV-Plus V2.5 or later (operation under Fortran-IV V2 or later will probably work but is not supported). - Dungeon requires a 32KW user partition (mapped systems only). - All files (source and object) must reside in the same user area (at least 2500 disk blocks are needed). - TKB should invoke BIGTKB.TSK with a large memory increment. - The Fortran-IV-Plus object time library must be merged into the system library (SYSLIB.OLB). Further, the library must be set up to invoke the short error text module ($SHORT) as the default. Task building with a separate object time library produces numerous errors; task building with a resident library or the normal error text module produces an oversize task image. - Dungeon requires EIS but not floating point. Except for DTEXT.DAT, all files in the distribution kit are ASCII. DTEXT.DAT is a binary file consisting of 76-byte fixed length records. If the distribution kit consists of Files-11 compatible media, then PIP can be used to transfer the files. For example: >PIP SY:*.*=MM:*.*(cr) -requires ANSI magtape support If the distribution kit consists of DOS- or RT11-compatible media, then FLX must be used to transfer the files. The /IM:76. switch (image binary fixed length) must be used to transfer DTEXT.DAT; the /FA switch (formatted ASCII) should be used to transfer the other files. For example (DOS magtape): >FLX(cr) FLX>SY:/RS/FA=MM:*.FTN,*.FOR,*.MAC,*.DOC/DO(cr) FLX>SY:/RS/FA=MM:*.CMD,*.COM,*.ODL,DINDX.DAT/DO(cr) FLX>SY:/RS/IM:76.=MM:DTEXT.DAT/DO(cr) FLX>^Z To compile Dungeon, issue the following command: >@RSXCMP(cr) There should be no error messages. To task build the compiled sources, issue the following command: >TKB @RSXBLD(cr) It is now possible to run Dungeon: >RUN DUNGEON(cr) When invoked, Dungeon takes no more than 5-10 seconds to start up. If your system maintains a separate Fortran-IV-Plus object time library (F4POTS.OLB), then you must create a local copy of the system library with the Fortran-IV-Plus object time library merged in and the short error text as the default. The following commands are an example of how such a local copy could be built: >PIP SY:*.*=LB:[1,1]SYSLIB.OLB,F4POTS.OLB(cr) -copy libraries >LBR(cr) -invoke LBR LBR>SHORT.OBJ=F4POTS.OLB/EX:$SHORT(cr) -extract $SHORT LBR>F4POTS.OLB/DE:$SHORT(cr) -delete $SHORT LBR>F4POTS.OBJ=F4POTS.OLB/EX(cr) -extract other modules LBR>SYSLIB.OLB=F4POTS.OBJ(cr) -insert other modules LBR>SYSLIB.OLB/DG:$ERTXT(cr) -delete dup entry LBR>SYSLIB.OLB=SHORT.OBJ/RP(cr) -insert $SHORT LBR>^Z >PIP F4POTS.*;*,SHORT.OBJ;*/DE(cr) Then edit D.ODL to reference the local library instead of the default system library: >TEC D.ODL(cr) *FS[1,1]$SY:$EX$$ Dungeon can now be task built as described above. Notes on the executable program: - The only files needed to execute Dungeon are DUNGEON.TSK, DINDX.DAT, and DTEXT.DAT. All other files can be deleted. - Files DINDX.DAT and DTEXT.DAT must reside in the user's area on logical device SY: (this can be changed with a source edit, see section 8). - Exiting from Dungeon via an MCR ABOrt command instead of the QUIT command will leave file DTEXT.DAT open and locked. The file must be manually unlocked before the game is next invoked: >PIP DTEXT.DAT/UN(cr) 5. Installation Instructions, VMS Before starting, please note that: - Dungeon requires VMS V1 or later. - Dungeon requires VAX Fortran-IV V1 or later. - All files (source and object) must reside in the user's area (at least 2500 disk blocks are needed). Except for DTEXT.DAT, all files in the distribution kit are ASCII. DTEXT.DAT is a binary file consisting of 76-byte fixed length records. If the distribution kit consists of Files-11 compatible media, then COPY can be used to transfer the files. For example: $ COPY MM:*.* *.*(cr) If the distribution kit consists of DOS- or RT11-compatible media, then FLX must be used to transfer the files. The /IM:76. switch (image binary fixed length) must be used to transfer DTEXT.DAT; the /FA switch (formatted ASCII) should be used to transfer the other files. For example (DOS magtape): $ MCR FLX(cr) FLX>SY:/RS/FA=MM:*.FTN,*.FOR,*.MAC,*.DOC/DO(cr) FLX>SY:/RS/FA=MM:*.CMD,*.COM,*.ODL,DINDX.DAT/DO(cr) FLX>SY:/RS/IM:76.=MM:DTEXT.DAT/DO(cr) FLX>^Z To compile Dungeon, issue the following command: $ @VMSCMP(cr) There should be no error messages. To link the compiled sources, issue the following command: $ @VMSBLD(cr) It is now possible to run Dungeon: $ RUN DUNGEON(cr) When invoked, Dungeon takes no more than 5-10 seconds to start up. Notes on the executable program: - The only files needed to execute Dungeon are DUNGEON.EXE, DINDX.DAT, and DTEXT.DAT. All other files can be deleted. - Files DINDX.DAT and DTEXT.DAT must reside in the user's area (this can be changed with a source edit, see section 8). 6. Warnings and Restrictions For those familiar with the MDL version of the game on the ARPAnet, the following is a list of the major incompatabilties: -The first six letters of a word are considered significant, instead of the first five. -The syntax for TELL, ANSWER, and INCANT is different. -Compound objects are not recognized. -Compound commands can be delimited with comma as well as period. Also, the palantir, brochure, and dead man problems are not implemented. 7. Abstract of Informational Printouts SUMMARY ------- Welcome to Dungeon! Dungeon is a game of adventure, danger, and low cunning. In it you will explore some of the most amazing territory ever seen by mortal man. Hardened adventurers have run screaming from the terrors contained within. In Dungeon, the intrepid explorer delves into the forgotten secrets of a lost labyrinth deep in the bowels of the earth, searching for vast treasures long hidden from prying eyes, treasures guarded by fearsome monsters and diabolical traps! No DECsystem should be without one! Dungeon was created at the Programming Technology Division of the MIT Laboratory for Computer Science by Tim Anderson, Marc Blank, Bruce Daniels, and Dave Lebling. It was inspired by the Adventure game of Crowther and Woods, and the Dungeons and Dragons game of Gygax and Arneson. The original version was written in MDL (alias MUDDLE). The current version was translated from MDL into FORTRAN IV by a somewhat paranoid DEC engineer who prefers to remain anonymous. On-line information may be obtained with the commands HELP and INFO. INFO ---- Welcome to Dungeon! You are near a large dungeon, which is reputed to contain vast quantities of treasure. Naturally, you wish to acquire some of it. In order to do so, you must of course remove it from the dungeon. To receive full credit for it, you must deposit it safely in the trophy case in the living room of the house. In addition to valuables, the dungeon contains various objects which may or may not be useful in your attempt to get rich. You may need sources of light, since dungeons are often dark, and weapons, since dungeons often have unfriendly things wandering about. Reading material is scattered around the dungeon as well; some of it is rumored to be useful. To determine how successful you have been, a score is kept. When you find a valuable object and pick it up, you receive a certain number of points, which depends on the difficulty of finding the object. You receive extra points for transporting the treasure safely to the living room and placing it in the trophy case. In addition, some particularly interesting rooms have a value associated with visiting them. The only penalty is for getting yourself killed, which you may do only twice. Of special note is a thief (always carrying a large bag) who likes to wander around in the dungeon (he has never been seen by the light of day). He likes to take things. Since he steals for pleasure rather than profit and is somewhat sadistic, he only takes things which you have seen. Although he prefers valuables, sometimes in his haste he may take something which is worthless. From time to time, he examines his take and discards objects which he doesn't like. He may occas- ionally stop in a room you are visiting, but more often he just wanders through and rips you off (he is a skilled pickpocket). HELP ---- Useful commands: The 'BRIEF' command suppresses printing of long room descriptions for rooms which have been visited. The 'SUPERBRIEF' command suppresses printing of long room descriptions for all rooms. The 'VERBOSE' command restores long descriptions. The 'INFO' command prints information which might give some idea of what the game is about. The 'QUIT' command prints your score and asks whether you wish to continue playing. The 'SAVE' command saves the state of the game for later continuation. The 'RESTORE' command restores a saved game. The 'INVENTORY' command lists the objects in your possession. The 'LOOK' command prints a description of your surroundings. The 'SCORE' command prints your current score and ranking. The 'TIME' command tells you how long you have been playing. The 'DIAGNOSE' command reports on your injuries, if any. Command abbreviations: The 'INVENTORY' command may be abbreviated 'I'. The 'LOOK' command may be abbreviated 'L'. The 'QUIT' command may be abbreviated 'Q'. Containment: Some objects can contain other objects. Many such containers can be opened and closed. The rest are always open. They may or may not be transparent. For you to access (e.g., take) an object which is in a container, the container must be open. For you to see such an object, the container must be either open or transparent. Containers have a capacity, and objects have sizes; the number of objects which will fit therefore depends on their sizes. You may put any object you have access to (it need not be in your hands) into any other object. At some point, the program will attempt to pick it up if you don't already have it, which process may fail if you're carrying too much. Although containers can contain other containers, the program doesn't access more than one level down. Fighting: Occupants of the dungeon will, as a rule, fight back when attacked. In some cases, they may attack even if unprovoked. Useful verbs here are 'ATTACK WITH ', 'KILL', etc. Knife-throwing may or may not be useful. You have a fighting strength which varies with time. Being in a fight, getting killed, and being injured all lower this strength. Strength is regained with time. Thus, it is not a good idea to fight someone immediately after being killed. Other details should become apparent after a few melees or deaths. Command parser: A command is one line of text terminated by a carriage return. For reasons of simplicity, all words are distinguished by their first six letters. All others are ignored. For example, typing 'DISASSEMBLE THE ENCYCLOPEDIA' is not only meaningless, it also creates excess effort for your fingers. Note that this trunca- tion may produce ambiguities in the intepretation of longer words. You are dealing with a fairly stupid parser, which understands the following types of things-- Actions: Among the more obvious of these, such as TAKE, PUT, DROP, etc. Fairly general forms of these may be used, such as PICK UP, PUT DOWN, etc. Directions: NORTH, SOUTH, UP, DOWN, etc. and their various abbreviations. Other more obscure directions (LAND, CROSS) are appropriate in only certain situations. Objects: Most objects have names and can be referenced by them. Adjectives: Some adjectives are understood and required when there are two objects which can be referenced with the same 'name' (e.g., DOORs, BUTTONs). Prepositions: It may be necessary in some cases to include prepositions, but the parser attempts to handle cases which aren't ambiguous without. Thus 'GIVE CAR TO DEMON' will work, as will 'GIVE DEMON CAR'. 'GIVE CAR DEMON' probably won't do anything interesting. When a preposition is used, it should be appropriate; 'GIVE CAR WITH DEMON' won't parse. Sentences: The parser understands a reasonable number of syntactic construc- tions. In particular, multiple commands (separated by commas) can be placed on the same line. Ambiguity: The parser tries to be clever about what to do in the case of actions which require objects that are not explicitly specified. If there is only one possible object, the parser will assume that it should be used. Otherwise, the parser will ask. Most questions asked by the parser can be answered. 8. Source Notes A few notes for source hackers. - The initialization module (DINIT.FTN) includes an access protection function PROTCT. If PROTCT returns a value of .TRUE., the game is permitted to start; if PROTCT returns .FALSE., the game is terminated with a suitably nasty message. At present, PROTCT is a dummy routine and always returns .TRUE.; by tailoring PROTCT, access to the game can be restricted to certain hours or users. - The data base OPEN and READ statements are in the initialization module (DINIT.FTN). The data base file names are simply "DINDX.DAT" and "DTEXT.DAT". These may be freely changed to include logical device names, UIC's, etc. Thus, it is possible to place the data base files on different devices, in a fixed UIC, etc. - Converting the game to another processor is not a straightforward procedure. The game makes heavy use of extended and/or idiosynchratic features of PDP-11 Fortran. Particular nasties include the following: > The game vocabulary is stored in Radix-50 notation. > The game uses the extended I/O commands OPEN and CLOSE. > The game uses LOGICAL*1 variables for character strings. > The game uses logical operators on integers for bitwise binary operations. > The game treats certain arrays and variables as unsigned 16-bit integers (integer overflow may occur). In general, the game was implemented to fit in memory, not to be transported. You're on your own, friend! C TAKE-- BASIC TAKE SEQUENCE C C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED C WRITTEN BY R. M. SUPNIK C C TAKE AN OBJECT (FOR VERBS TAKE, PUT, DROP, READ, ETC.) C LOGICAL FUNCTION TAKE(FLG) C C DECLARATIONS C IMPLICIT INTEGER (A-Z) LOGICAL FLG,OBJACT,OAPPLI,QOPEN,QHERE C C PARSER OUTPUT C LOGICAL PRSWON COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD, 1 LTSHFT,BLOC,MUNGRM,HS,EGSCOR,EGMXSC COMMON /STAR/ MBASE,STRBIT C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT, 1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT, 2 TOOLBT,TURNBT,ONBT COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT, 1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT, 2 TCHBT,VEHBT,SCHBT C C C ADVENTURERS C COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4), 1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4) C COMMON /AINDEX/ PLAYER,AROBOT,AMASTR C C FUNCTIONS AND DATA C QOPEN(O)=(OFLAG2(O).AND.OPENBT).NE.0 C TAKE, PAGE 2 C TAKE=.FALSE. !ASSUME LOSES. OA=OACTIO(PRSO) !GET OBJECT ACTION. IF(PRSO.LE.STRBIT) GO TO 100 !STAR? TAKE=OBJACT(X) !YES, LET IT HANDLE. RETURN C 100 X=OCAN(PRSO) !INSIDE? IF(PRSO.NE.AVEHIC(WINNER)) GO TO 400 !HIS VEHICLE? CALL RSPEAK(672) !DUMMY. RETURN C 400 IF((OFLAG1(PRSO).AND.TAKEBT).NE.0) GO TO 500 !TAKEABLE? IF(.NOT.OAPPLI(OA,0)) CALL RSPEAK(552+RND(5)) RETURN C C OBJECT IS TAKEABLE AND IN POSITION TO BE TAKEN. C 500 IF((X.NE.0).OR. QHERE(PRSO,HERE)) GO TO 600 IF(OADV(PRSO).EQ.WINNER) CALL RSPEAK(557) !ALREADY GOT IT? RETURN C 600 IF(((X.NE.0).AND.(OADV(X).EQ.WINNER)).OR. 1 ((WEIGHT(0,PRSO,WINNER)+OSIZE(PRSO)).LE.MXLOAD)) 2 GO TO 700 CALL RSPEAK(558) !TOO MUCH WEIGHT. RETURN C 700 TAKE=.TRUE. !AT LAST. IF(OAPPLI(OA,0)) RETURN !DID IT HANDLE? CALL NEWSTA(PRSO,0,0,0,WINNER) !TAKE OBJECT FOR WINNER. OFLAG2(PRSO)=OFLAG2(PRSO).OR.TCHBT !HAS BEEN TOUCHED. CALL SCRUPD(OFVAL(PRSO)) !UPDATE SCORE. OFVAL(PRSO)=0 !CANT BE SCORED AGAIN. IF(FLG) CALL RSPEAK(559) !TELL TAKEN. RETURN C END C DROP- DROP VERB PROCESSOR C C DECLARATIONS C LOGICAL FUNCTION DROP(Z) IMPLICIT INTEGER (A-Z) LOGICAL F,PUT,OBJACT C C PARSER OUTPUT C LOGICAL PRSWON COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG C C ROOMS C COMMON /RINDEX/ WHOUS,LROOM,CELLA COMMON /RINDEX/ MTROL,MAZE1 COMMON /RINDEX/ MGRAT,MAZ15 COMMON /RINDEX/ FORE1,FORE3,CLEAR,RESER COMMON /RINDEX/ STREA,EGYPT,ECHOR COMMON /RINDEX/ TSHAF COMMON /RINDEX/ BSHAF,MMACH,DOME,MTORC COMMON /RINDEX/ CAROU COMMON /RINDEX/ RIDDL,LLD2,TEMP1,TEMP2,MAINT COMMON /RINDEX/ BLROO,TREAS,RIVR1,RIVR2,RIVR3,MCYCL COMMON /RINDEX/ RIVR4,RIVR5,FCHMP,FALLS,MBARR COMMON /RINDEX/ MRAIN,POG,VLBOT,VAIR1,VAIR2,VAIR3,VAIR4 COMMON /RINDEX/ LEDG2,LEDG3,LEDG4,MSAFE,CAGER COMMON /RINDEX/ CAGED,TWELL,BWELL,ALICE,ALISM,ALITR COMMON /RINDEX/ MTREE,BKENT,BKVW,BKTWI,BKVAU,BKBOX COMMON /RINDEX/ CRYPT,TSTRS,MRANT,MREYE COMMON /RINDEX/ MRA,MRB,MRC,MRG,MRD,FDOOR COMMON /RINDEX/ MRAE,MRCE,MRCW,MRGE,MRGW,MRDW,INMIR COMMON /RINDEX/ SCORR,NCORR,PARAP,CELL,PCELL,NCELL COMMON /RINDEX/ CPANT,CPOUT,CPUZZ C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT, 1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT, 2 TOOLBT,TURNBT,ONBT COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT, 1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT, 2 TCHBT,VEHBT,SCHBT C C C ADVENTURERS C COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4), 1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4) C C VERBS C COMMON /VINDEX/ CINTW,DEADXW,FRSTQW,INXW,OUTXW COMMON /VINDEX/ WALKIW,FIGHTW,FOOW COMMON /VINDEX/ MELTW,READW,INFLAW,DEFLAW,ALARMW,EXORCW COMMON /VINDEX/ PLUGW,KICKW,WAVEW,RAISEW,LOWERW,RUBW COMMON /VINDEX/ PUSHW,UNTIEW,TIEW,TIEUPW,TURNW,BREATW COMMON /VINDEX/ KNOCKW,LOOKW,EXAMIW,SHAKEW,MOVEW,TRNONW,TRNOFW COMMON /VINDEX/ OPENW,CLOSEW,FINDW,WAITW,SPINW,BOARDW,UNBOAW,TAKEW COMMON /VINDEX/ INVENW,FILLW,EATW,DRINKW,BURNW COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW COMMON /VINDEX/ DIGW,LEAPW,STAYW,FOLLOW COMMON /VINDEX/ HELLOW,LOOKIW,LOOKUW,PUMPW,WINDW COMMON /VINDEX/ CLMBW,CLMBUW,CLMBDW,TRNTOW C DROP, PAGE 2 C DROP=.TRUE. !ASSUME WINS. X=OCAN(PRSO) !GET CONTAINER. IF(X.EQ.0) GO TO 200 !IS IT INSIDE? IF(OADV(X).NE.WINNER) GO TO 1000 !IS HE CARRYING CON? IF((OFLAG2(X).AND.OPENBT).NE.0) GO TO 300 !IS IT OPEN? CALL RSPSUB(525,ODESC2(X)) !CANT REACH. RETURN C 200 IF(OADV(PRSO).NE.WINNER) GO TO 1000 !IS HE CARRYING OBJ? 300 IF(AVEHIC(WINNER).EQ.0) GO TO 400 !IS HE IN VEHICLE? PRSI=AVEHIC(WINNER) !YES, F=PUT(.TRUE.) !DROP INTO VEHICLE. PRSI=0 !DISARM PARSER. RETURN !DONE. C 400 CALL NEWSTA(PRSO,0,HERE,0,0) !DROP INTO ROOM. IF(HERE.EQ.MTREE) CALL NEWSTA(PRSO,0,FORE3,0,0) CALL SCRUPD(OFVAL(PRSO)) !SCORE OBJECT. OFVAL(PRSO)=0 !CANT BE SCORED AGAIN. OFLAG2(PRSO)=OFLAG2(PRSO).OR.TCHBT !HAS BEEN TOUCHED. C IF(OBJACT(X)) RETURN !DID IT HANDLE? I=0 !ASSUME NOTHING TO SAY. IF(PRSA.EQ.DROPW) I=528 IF(PRSA.EQ.THROWW) I=529 IF((I.NE.0).AND.(HERE.EQ.MTREE)) I=659 CALL RSPSUB(I,ODESC2(PRSO)) RETURN C 1000 CALL RSPEAK(527) !DONT HAVE IT. RETURN C END C PUT- PUT VERB PROCESSOR C C DECLARATIONS C LOGICAL FUNCTION PUT(FLG) IMPLICIT INTEGER (A-Z) LOGICAL QOPEN,QHERE,OBJACT,FLG C C PARSER OUTPUT C LOGICAL PRSWON COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG C C MISCELLANEOUS VARIABLES C COMMON /STAR/ MBASE,STRBIT C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT, 1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT, 2 TOOLBT,TURNBT,ONBT COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT, 1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT, 2 TCHBT,VEHBT,SCHBT C C ADVENTURERS C COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4), 1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4) C C VERBS C COMMON /VINDEX/ CINTW,DEADXW,FRSTQW,INXW,OUTXW COMMON /VINDEX/ WALKIW,FIGHTW,FOOW COMMON /VINDEX/ MELTW,READW,INFLAW,DEFLAW,ALARMW,EXORCW COMMON /VINDEX/ PLUGW,KICKW,WAVEW,RAISEW,LOWERW,RUBW COMMON /VINDEX/ PUSHW,UNTIEW,TIEW,TIEUPW,TURNW,BREATW COMMON /VINDEX/ KNOCKW,LOOKW,EXAMIW,SHAKEW,MOVEW,TRNONW,TRNOFW COMMON /VINDEX/ OPENW,CLOSEW,FINDW,WAITW,SPINW,BOARDW,UNBOAW,TAKEW COMMON /VINDEX/ INVENW,FILLW,EATW,DRINKW,BURNW COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW COMMON /VINDEX/ DIGW,LEAPW,STAYW,FOLLOW COMMON /VINDEX/ HELLOW,LOOKIW,LOOKUW,PUMPW,WINDW COMMON /VINDEX/ CLMBW,CLMBUW,CLMBDW,TRNTOW C C FUNCTIONS AND DATA C QOPEN(R)=(OFLAG2(R).AND.OPENBT).NE.0 C PUT, PAGE 2 C PUT=.FALSE. IF((PRSO.LE.STRBIT).AND.(PRSI.LE.STRBIT)) GO TO 200 IF(.NOT.OBJACT(X)) CALL RSPEAK(560) !STAR PUT=.TRUE. RETURN C 200 IF(QOPEN(PRSI).OR.((OFLAG1(PRSI).AND.(DOORBT+CONTBT)).NE.0) 1 .OR.((OFLAG2(PRSI).AND.VEHBT).NE.0)) GO TO 300 CALL RSPEAK(561) !CANT PUT IN THAT. RETURN C 300 IF(QOPEN(PRSI)) GO TO 400 !IS IT OPEN? CALL RSPEAK(562) !NO, JOKE RETURN C 400 IF(PRSO.NE.PRSI) GO TO 500 !INTO ITSELF? CALL RSPEAK(563) !YES, JOKE. RETURN C 500 IF(OCAN(PRSO).NE.PRSI) GO TO 600 !ALREADY INSIDE. CALL RSPSB2(564,ODESC2(PRSO),ODESC2(PRSI)) PUT=.TRUE. RETURN C 600 IF((WEIGHT(0,PRSO,0)+WEIGHT(0,PRSI,0)+OSIZE(PRSO)) 1 .LE.OCAPAC(PRSI)) GO TO 700 !NOT TOO FULL? CALL RSPEAK(565) !THEN CANT DO IT. RETURN C C NOW SEE IF OBJECT (OR ITS CONTAINER) IS IN ROOM C 700 J=PRSO !START SEARCH. 725 IF(QHERE(J,HERE)) GO TO 750 !IS IT HERE? J=OCAN(J) IF(J.NE.0) GO TO 725 !MORE TO DO? GO TO 800 !NO, SCH FAILS. C 750 SVO=PRSO !SAVE PARSER. SVI=PRSI PRSA=TAKEW PRSI=0 IF(.NOT.TAKE(.FALSE.)) RETURN !TAKE OBJECT. PRSA=PUTW PRSO=SVO PRSI=SVI GO TO 1000 C C NOW SEE IF OBJECT IS ON PERSON. C 800 IF(OCAN(PRSO).EQ.0) GO TO 1000 !INSIDE? IF(QOPEN(OCAN(PRSO))) GO TO 900 !OPEN? CALL RSPSUB(566,ODESC2(PRSO)) !LOSE. RETURN C 900 CALL SCRUPD(OFVAL(PRSO)) !SCORE OBJECT. OFVAL(PRSO)=0 OFLAG2(PRSO)=OFLAG2(PRSO).OR.TCHBT !HAS BEEN TOUCHED. CALL NEWSTA(PRSO,0,0,0,WINNER) !TEMPORARILY ON WINNER. C 1000 IF(OBJACT(X)) RETURN !NO, GIVE OBJECT A SHOT. CALL NEWSTA(PRSO,2,0,PRSI,0) !CONTAINED INSIDE. PUT=.TRUE. RETURN C END C VALUAC- HANDLES VALUABLES/EVERYTHING C C DECLARATIONS C SUBROUTINE VALUAC(V) IMPLICIT INTEGER (A-Z) LOGICAL LIT,F,F1,TAKE,PUT,DROP,NOTVAL,QHERE C C PARSER OUTPUT C LOGICAL PRSWON COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT, 1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT, 2 TOOLBT,TURNBT,ONBT COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT, 1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT, 2 TCHBT,VEHBT,SCHBT C C VERBS C COMMON /VINDEX/ CINTW,DEADXW,FRSTQW,INXW,OUTXW COMMON /VINDEX/ WALKIW,FIGHTW,FOOW COMMON /VINDEX/ MELTW,READW,INFLAW,DEFLAW,ALARMW,EXORCW COMMON /VINDEX/ PLUGW,KICKW,WAVEW,RAISEW,LOWERW,RUBW COMMON /VINDEX/ PUSHW,UNTIEW,TIEW,TIEUPW,TURNW,BREATW COMMON /VINDEX/ KNOCKW,LOOKW,EXAMIW,SHAKEW,MOVEW,TRNONW,TRNOFW COMMON /VINDEX/ OPENW,CLOSEW,FINDW,WAITW,SPINW,BOARDW,UNBOAW,TAKEW COMMON /VINDEX/ INVENW,FILLW,EATW,DRINKW,BURNW COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW COMMON /VINDEX/ DIGW,LEAPW,STAYW,FOLLOW COMMON /VINDEX/ HELLOW,LOOKIW,LOOKUW,PUMPW,WINDW COMMON /VINDEX/ CLMBW,CLMBUW,CLMBDW,TRNTOW C C FUNCTIONS AND DATA C NOTVAL(R)=(SAVEP.EQ.V).AND.(OTVAL(R).LE.0) C VALUAC, PAGE 2 C F=.TRUE. !ASSUME NO ACTIONS. I=579 !ASSUME NOT LIT. IF(.NOT.LIT(HERE)) GO TO 4000 !IF NOT LIT, PUNT. I=677 !ASSUME WRONG VERB. SAVEP=PRSO !SAVE PRSO. SAVEH=HERE !SAVE HERE. C 100 IF(PRSA.NE.TAKEW) GO TO 1000 !TAKE EVERY/VALUA? DO 500 PRSO=1,OLNT !LOOP THRU OBJECTS. IF(.NOT.QHERE(PRSO,HERE).OR. 1 ((OFLAG1(PRSO).AND.VISIBT).EQ.0).OR. 2 ((OFLAG2(PRSO).AND.ACTRBT).NE.0).OR. 3 NOTVAL(PRSO)) GO TO 500 IF(((OFLAG1(PRSO).AND.TAKEBT).EQ.0).AND. 1 ((OFLAG2(PRSO).AND.TRYBT).EQ.0)) GO TO 500 F=.FALSE. CALL RSPSUB(580,ODESC2(PRSO)) F1=TAKE(.TRUE.) IF(SAVEH.NE.HERE) RETURN 500 CONTINUE GO TO 3000 C 1000 IF(PRSA.NE.DROPW) GO TO 2000 !DROP EVERY/VALUA? DO 1500 PRSO=1,OLNT IF((OADV(PRSO).NE.WINNER).OR.NOTVAL(PRSO)) 1 GO TO 1500 F=.FALSE. CALL RSPSUB(580,ODESC2(PRSO)) F1=DROP(.TRUE.) IF(SAVEH.NE.HERE) RETURN 1500 CONTINUE GO TO 3000 C 2000 IF(PRSA.NE.PUTW) GO TO 3000 !PUT EVERY/VALUA? DO 2500 PRSO=1,OLNT !LOOP THRU OBJECTS. IF((OADV(PRSO).NE.WINNER) 1 .OR.(PRSO.EQ.PRSI).OR.NOTVAL(PRSO).OR. 2 ((OFLAG1(PRSO).AND.VISIBT).EQ.0)) GO TO 2500 F=.FALSE. CALL RSPSUB(580,ODESC2(PRSO)) F1=PUT(.TRUE.) IF(SAVEH.NE.HERE) RETURN 2500 CONTINUE C 3000 I=581 IF(SAVEP.EQ.V) I=582 !CHOOSE MESSAGE. 4000 IF(F) CALL RSPEAK(I) !IF NOTHING, REPORT. RETURN END C SAVE- SAVE GAME STATE C C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED C WRITTEN BY R. M. SUPNIK C C DECLARATIONS C SUBROUTINE SAVEGM IMPLICIT INTEGER (A-Z) C C PARSER OUTPUT C LOGICAL PRSWON COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD, 1 LTSHFT,BLOC,MUNGRM,HS,EGSCOR,EGMXSC C C SCREEN OF LIGHT C COMMON /SCREEN/ FROMDR,SCOLRM,SCOLAC C C PUZZLE ROOM C COMMON /PUZZLE/ CPDR(16),CPWL(8),CPVEC(64) C C MISCELLANEOUS VARIABLES C COMMON /VERS/ VMAJ,VMIN,VEDIT COMMON /TIME/ PLTIME,SHOUR,SMIN,SSEC C C ROOMS C COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200), 1 RACTIO(200),RVAL(200),RFLAG(200) INTEGER RRAND(200) EQUIVALENCE (RVAL,RRAND) C C EXITS C COMMON /EXITS/ XLNT,TRAVEL(900) C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C C C CLOCK INTERRUPTS C LOGICAL*1 CFLAG COMMON /CEVENT/ CLNT,CTICK(25),CACTIO(25),CFLAG(25) C C C VILLAINS AND DEMONS C LOGICAL THFFLG,SWDACT,THFACT COMMON /HACK/ THFPOS,THFFLG,THFACT,SWDACT,SWDSTA COMMON /VILL/ VLNT,VILLNS(4),VPROB(4),VOPPS(4),VBEST(4),VMELEE(4) C C ADVENTURERS C COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4), 1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4) C C FLAGS C LOGICAL*1 FLAGS(46) INTEGER SWITCH(22) COMMON /FINDEX/ FLAGS,SWITCH C PRSWON=.FALSE. !DISABLE GAME. OPEN (UNIT=1,NAME='DSAVE.DAT',ACCESS='SEQUENTIAL', 1 TYPE='UNKNOWN',FORM='UNFORMATTED',ERR=100) C CALL GTTIME(I) !GET TIME. WRITE(1) VMAJ,VMIN,VEDIT WRITE(1) WINNER,HERE,THFPOS,TELFLG,THFFLG,THFACT, 1 SWDACT,SWDSTA,CPVEC WRITE(1) I,MOVES,DEATHS,RWSCOR,EGSCOR,MXLOAD, 1 LTSHFT,BLOC,MUNGRM,HS,FROMDR,SCOLRM,SCOLAC WRITE(1) ODESC1,ODESC2,OFLAG1,OFLAG2,OFVAL,OTVAL, 1 OSIZE,OCAPAC,OROOM,OADV,OCAN WRITE(1) RVAL,RFLAG WRITE(1) AROOM,ASCORE,AVEHIC,ASTREN,AFLAG WRITE(1) FLAGS,SWITCH,VPROB,CFLAG,CTICK C CLOSE(UNIT=1) CALL RSPEAK(597) RETURN C 100 CALL RSPEAK(598) !CANT DO IT. RETURN END C RESTORE- RESTORE GAME STATE C C DECLARATIONS C SUBROUTINE RSTRGM IMPLICIT INTEGER (A-Z) C C PARSER OUTPUT C LOGICAL PRSWON COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD, 1 LTSHFT,BLOC,MUNGRM,HS,EGSCOR,EGMXSC C C SCREEN OF LIGHT C COMMON /SCREEN/ FROMDR,SCOLRM,SCOLAC C C PUZZLE ROOM C COMMON /PUZZLE/ CPDR(16),CPWL(8),CPVEC(64) C C MISCELLANEOUS VARIABLES C COMMON /VERS/ VMAJ,VMIN,VEDIT COMMON /TIME/ PLTIME,SHOUR,SMIN,SSEC C C ROOMS C COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200), 1 RACTIO(200),RVAL(200),RFLAG(200) INTEGER RRAND(200) EQUIVALENCE (RVAL,RRAND) C C EXITS C COMMON /EXITS/ XLNT,TRAVEL(900) C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C C C CLOCK INTERRUPTS C LOGICAL*1 CFLAG COMMON /CEVENT/ CLNT,CTICK(25),CACTIO(25),CFLAG(25) C C C VILLAINS AND DEMONS C LOGICAL THFFLG,SWDACT,THFACT COMMON /HACK/ THFPOS,THFFLG,THFACT,SWDACT,SWDSTA COMMON /VILL/ VLNT,VILLNS(4),VPROB(4),VOPPS(4),VBEST(4),VMELEE(4) C C ADVENTURERS C COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4), 1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4) C C FLAGS C LOGICAL*1 FLAGS(46) INTEGER SWITCH(22) COMMON /FINDEX/ FLAGS,SWITCH C PRSWON=.FALSE. !DISABLE GAME. OPEN (UNIT=1,NAME='DSAVE.DAT',ACCESS='SEQUENTIAL', 1 TYPE='OLD',READONLY,FORM='UNFORMATTED',ERR=100) C READ(1) I,J,K IF((I.NE.VMAJ).OR.(J.NE.VMIN)) GO TO 200 C READ(1) WINNER,HERE,THFPOS,TELFLG,THFFLG,THFACT, 1 SWDACT,SWDSTA,CPVEC READ(1) PLTIME,MOVES,DEATHS,RWSCOR,EGSCOR,MXLOAD, 1 LTSHFT,BLOC,MUNGRM,HS,FROMDR,SCOLRM,SCOLAC READ(1) ODESC1,ODESC2,OFLAG1,OFLAG2,OFVAL,OTVAL, 1 OSIZE,OCAPAC,OROOM,OADV,OCAN READ(1) RVAL,RFLAG READ(1) AROOM,ASCORE,AVEHIC,ASTREN,AFLAG READ(1) FLAGS,SWITCH,VPROB,CFLAG,CTICK C CLOSE(UNIT=1) CALL RSPEAK(599) RETURN C 100 CALL RSPEAK(598) !CANT DO IT. RETURN C 200 CALL RSPEAK(600) !OBSOLETE VERSION CLOSE (UNIT=1) RETURN END C WALK- MOVE IN SPECIFIED DIRECTION C C DECLARATIONS C LOGICAL FUNCTION WALK(X) IMPLICIT INTEGER(A-Z) LOGICAL FINDXT,QOPEN,LIT,PROB,MOVETO,RMDESC C C PARSER OUTPUT C LOGICAL PRSWON COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG C C ROOMS C COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200), 1 RACTIO(200),RVAL(200),RFLAG(200) INTEGER RRAND(200) EQUIVALENCE (RVAL,RRAND) C COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR, 1 RSACRD,RFILL,RMUNG,RBUCK,RHOUSE,RNWALL,REND C C EXITS C COMMON /CURXT/ XTYPE,XROOM1,XSTRNG,XACTIO,XOBJ EQUIVALENCE (XFLAG,XOBJ) C COMMON /XSRCH/ XMIN,XMAX,XDOWN,XUP, 1 XNORTH,XSOUTH,XENTER,XEXIT,XEAST,XWEST C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT, 1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT, 2 TOOLBT,TURNBT,ONBT COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT, 1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT, 2 TCHBT,VEHBT,SCHBT C LOGICAL*1 CFLAG COMMON /CEVENT/ CLNT,CTICK(25),CACTIO(25),CFLAG(25) C COMMON /CINDEX/ CEVCUR,CEVMNT,CEVLNT,CEVMAT,CEVCND, 1 CEVBAL,CEVBRN,CEVFUS,CEVLED,CEVSAF,CEVVLG, 2 CEVGNO,CEVBUC,CEVSPH,CEVEGH, 3 CEVFOR,CEVSCL,CEVZGI,CEVZGO,CEVSTE, 5 CEVMRS,CEVPIN,CEVINQ,CEVFOL C C VILLAINS AND DEMONS C LOGICAL THFFLG,SWDACT,THFACT COMMON /HACK/ THFPOS,THFFLG,THFACT,SWDACT COMMON /VILL/ VLNT,VILLNS(4),VPROB(4),VOPPS(4),VBEST(4),VMELEE(4) C C ADVENTURERS C COMMON /AINDEX/ PLAYER,AROBOT,AMASTR C C FLAGS C LOGICAL*1 FLAGS(46) EQUIVALENCE (FLAGS(1),TROLLF) LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF, 1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF, 2 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF, 3 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF, 4 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF, 5 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF, 6 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF, 7 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ BTIEF,BINFF COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP COMMON /FINDEX/ MDIR,MLOC,POLEUF COMMON /FINDEX/ QUESNO,NQATT,CORRCT COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE C C FUNCTIONS AND DATA C QOPEN(O)=(OFLAG2(O).AND.OPENBT).NE.0 C WALK, PAGE 2 C WALK=.TRUE. !ASSUME WINS. IF((WINNER.NE.PLAYER).OR.LIT(HERE).OR.PROB(25,25)) 1 GO TO 500 IF(.NOT.FINDXT(PRSO,HERE)) GO TO 450 !INVALID EXIT? GRUE! GO TO (400,200,100,300),XTYPE !DECODE EXIT TYPE. CALL BUG(9,XTYPE) C 100 IF(CXAPPL(XACTIO).NE.0) GO TO 400 !CEXIT... RETURNED ROOM? IF(FLAGS(XFLAG)) GO TO 400 !NO, FLAG ON? 200 CALL JIGSUP(523) !BAD EXIT, GRUE! RETURN C 300 IF(CXAPPL(XACTIO).NE.0) GO TO 400 !DOOR... RETURNED ROOM? IF(QOPEN(XOBJ)) GO TO 400 !NO, DOOR OPEN? CALL JIGSUP(523) !BAD EXIT, GRUE! RETURN C 400 IF(LIT(XROOM1)) GO TO 900 !VALID ROOM, IS IT LIT? 450 CALL JIGSUP(522) !NO, GRUE! RETURN C C ROOM IS LIT, OR WINNER IS NOT PLAYER (NO GRUE). C 500 IF(FINDXT(PRSO,HERE)) GO TO 550 !EXIT EXIST? 525 XSTRNG=678 !ASSUME WALL. IF(PRSO.EQ.XUP) XSTRNG=679 !IF UP, CANT. IF(PRSO.EQ.XDOWN) XSTRNG=680 !IF DOWN, CANT. IF((RFLAG(HERE).AND.RNWALL).NE.0) XSTRNG=524 CALL RSPEAK(XSTRNG) PRSCON=1 !STOP CMD STREAM. RETURN C 550 GO TO (900,600,700,800),XTYPE !BRANCH ON EXIT TYPE. CALL BUG(9,XTYPE) C 700 IF(CXAPPL(XACTIO).NE.0) GO TO 900 !CEXIT... RETURNED ROOM? IF(FLAGS(XFLAG)) GO TO 900 !NO, FLAG ON? 600 IF(XSTRNG.EQ.0) GO TO 525 !IF NO REASON, USE STD. CALL RSPEAK(XSTRNG) !DENY EXIT. PRSCON=1 !STOP CMD STREAM. RETURN C 800 IF(CXAPPL(XACTIO).NE.0) GO TO 900 !DOOR... RETURNED ROOM? IF(QOPEN(XOBJ)) GO TO 900 !NO, DOOR OPEN? IF(XSTRNG.EQ.0) XSTRNG=525 !IF NO REASON, USE STD. CALL RSPSUB(XSTRNG,ODESC2(XOBJ)) PRSCON=1 !STOP CMD STREAM. RETURN C 900 WALK=MOVETO(XROOM1,WINNER) !MOVE TO ROOM. IF(WALK) WALK=RMDESC(0) !DESCRIBE ROOM. RETURN END C CXAPPL- CONDITIONAL EXIT PROCESSORS C C DECLARATIONS C INTEGER FUNCTION CXAPPL(RI) IMPLICIT INTEGER (A-Z) C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG C C PARSER OUTPUT C LOGICAL PRSWON COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON C C PUZZLE ROOM C COMMON /PUZZLE/ CPDR(16),CPWL(8),CPVEC(64) C C ROOMS C COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200), 1 RACTIO(200),RVAL(200),RFLAG(200) INTEGER RRAND(200) EQUIVALENCE (RVAL,RRAND) C COMMON /RINDEX/ WHOUS,LROOM,CELLA COMMON /RINDEX/ MTROL,MAZE1 COMMON /RINDEX/ MGRAT,MAZ15 COMMON /RINDEX/ FORE1,FORE3,CLEAR,RESER COMMON /RINDEX/ STREA,EGYPT,ECHOR COMMON /RINDEX/ TSHAF COMMON /RINDEX/ BSHAF,MMACH,DOME,MTORC COMMON /RINDEX/ CAROU COMMON /RINDEX/ RIDDL,LLD2,TEMP1,TEMP2,MAINT COMMON /RINDEX/ BLROO,TREAS,RIVR1,RIVR2,RIVR3,MCYCL COMMON /RINDEX/ RIVR4,RIVR5,FCHMP,FALLS,MBARR COMMON /RINDEX/ MRAIN,POG,VLBOT,VAIR1,VAIR2,VAIR3,VAIR4 COMMON /RINDEX/ LEDG2,LEDG3,LEDG4,MSAFE,CAGER COMMON /RINDEX/ CAGED,TWELL,BWELL,ALICE,ALISM,ALITR COMMON /RINDEX/ MTREE,BKENT,BKVW,BKTWI,BKVAU,BKBOX COMMON /RINDEX/ CRYPT,TSTRS,MRANT,MREYE COMMON /RINDEX/ MRA,MRB,MRC,MRG,MRD,FDOOR COMMON /RINDEX/ MRAE,MRCE,MRCW,MRGE,MRGW,MRDW,INMIR COMMON /RINDEX/ SCORR,NCORR,PARAP,CELL,PCELL,NCELL COMMON /RINDEX/ CPANT,CPOUT,CPUZZ C C EXITS C COMMON /EXITS/ XLNT,TRAVEL(900) C COMMON /CURXT/ XTYPE,XROOM1,XSTRNG,XACTIO,XOBJ EQUIVALENCE (XFLAG,XOBJ) C COMMON /XPARS/ XRMASK,XDMASK,XFMASK,XFSHFT,XASHFT, 1 XELNT(4),XNORM,XNO,XCOND,XDOOR,XLFLAG C COMMON /XSRCH/ XMIN,XMAX,XDOWN,XUP, 1 XNORTH,XSOUTH,XENTER,XEXIT,XEAST,XWEST C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT, 1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT, 2 TOOLBT,TURNBT,ONBT COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT, 1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT, 2 TCHBT,VEHBT,SCHBT C COMMON /OINDEX/ GARLI,FOOD,GUNK,COAL,MACHI,DIAMO,TCASE,BOTTL COMMON /OINDEX/ WATER,ROPE,KNIFE,SWORD,LAMP,BLAMP,RUG COMMON /OINDEX/ LEAVE,TROLL,AXE COMMON /OINDEX/ RKNIF,KEYS,ICE,BAR COMMON /OINDEX/ COFFI,TORCH,TBASK,FBASK,IRBOX COMMON /OINDEX/ GHOST,TRUNK,BELL,BOOK,CANDL COMMON /OINDEX/ MATCH,TUBE,PUTTY,WRENC,SCREW,CYCLO,CHALI COMMON /OINDEX/ THIEF,STILL,WINDO,GRATE,DOOR COMMON /OINDEX/ HPOLE,LEAK,RBUTT,RAILI COMMON /OINDEX/ POT,STATU,IBOAT,DBOAT,PUMP,RBOAT COMMON /OINDEX/ STICK,BUOY,SHOVE,BALLO,RECEP,GUANO COMMON /OINDEX/ BROPE,HOOK1,HOOK2,SAFE,SSLOT,BRICK,FUSE COMMON /OINDEX/ GNOME,BLABE,DBALL,TOMB COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE COMMON /OINDEX/ ROBOT,FTREE,BILLS,PORTR,SCOL,ZGNOM COMMON /OINDEX/ EGG,BEGG,BAUBL,CANAR,BCANA COMMON /OINDEX/ YLWAL,RDWAL,PINDR,RBEAM COMMON /OINDEX/ ODOOR,QDOOR,CDOOR,NUM1,NUM8 COMMON /OINDEX/ WARNI,CSLIT,GCARD,STLDR COMMON /OINDEX/ HANDS,WALL,LUNGS,SAILO,AVIAT,TEETH COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,WNORT,GWATE,MASTER C COMMON /AINDEX/ PLAYER,AROBOT,AMASTR C C FLAGS C LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF, 1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF, 2 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF, 3 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF, 4 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF, 5 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF, 6 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF, 7 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ BTIEF,BINFF COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP COMMON /FINDEX/ MDIR,MLOC,POLEUF COMMON /FINDEX/ QUESNO,NQATT,CORRCT COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE C CXAPPL, PAGE 2 C CXAPPL=0 !NO RETURN. IF(RI.EQ.0) RETURN !IF NO ACTION, DONE. GO TO (1000,2000,3000,4000,5000,6000,7000, 1 8000,9000,10000,11000,12000,13000,14000),RI CALL BUG(5,RI) C C C1- COFFIN-CURE C 1000 EGYPTF=OADV(COFFI).NE.WINNER !T IF NO COFFIN. RETURN C C C2- CAROUSEL EXIT C C5- CAROUSEL OUT C 2000 IF(CAROFF) RETURN !IF FLIPPED, NOTHING. 2500 CALL RSPEAK(121) !SPIN THE COMPASS. 5000 I=XELNT(XCOND)*RND(8) !CHOOSE RANDOM EXIT. XROOM1=(TRAVEL(REXIT(HERE)+I)).AND.XRMASK CXAPPL=XROOM1 !RETURN EXIT. RETURN C C C3- CHIMNEY FUNCTION C 3000 LITLDF=.FALSE. !ASSUME HEAVY LOAD. J=0 DO 3100 I=1,OLNT !COUNT OBJECTS. IF(OADV(I).EQ.WINNER) J=J+1 3100 CONTINUE C IF(J.GT.2) RETURN !CARRYING TOO MUCH? XSTRNG=446 !ASSUME NO LAMP. IF(OADV(LAMP).NE.WINNER) RETURN !NO LAMP? LITLDF=.TRUE. !HE CAN DO IT. IF((OFLAG2(DOOR).AND.OPENBT).EQ.0) 1 OFLAG2(DOOR)=OFLAG2(DOOR).AND. .NOT.TCHBT RETURN C C C4- FROBOZZ FLAG (MAGNET ROOM, FAKE EXIT) C C6- FROBOZZ FLAG (MAGNET ROOM, REAL EXIT) C 4000 IF(CAROFF) GO TO 2500 !IF FLIPPED, GO SPIN. FROBZF=.FALSE. !OTHERWISE, NOT AN EXIT. RETURN C 6000 IF(CAROFF) GO TO 2500 !IF FLIPPED, GO SPIN. FROBZF=.TRUE. !OTHERWISE, AN EXIT. RETURN C C C7- FROBOZZ FLAG (BANK ALARM) C 7000 FROBZF=(OROOM(BILLS).NE.0).AND.(OROOM(PORTR).NE.0) RETURN C CXAPPL, PAGE 3 C C C8- FROBOZZ FLAG (MRGO) C 8000 FROBZF=.FALSE. !ASSUME CANT MOVE. IF(MLOC.NE.XROOM1) GO TO 8100 !MIRROR IN WAY? IF((PRSO.EQ.XNORTH).OR.(PRSO.EQ.XSOUTH)) GO TO 8200 IF(MOD(MDIR,180).NE.0) GO TO 8300 !MIRROR MUST BE N-S. XROOM1=((XROOM1-MRA)*2)+MRAE !CALC EAST ROOM. IF(PRSO.GT.XSOUTH) XROOM1=XROOM1+1 !IF SW/NW, CALC WEST. 8100 CXAPPL=XROOM1 RETURN C 8200 XSTRNG=814 !ASSUME STRUC BLOCKS. IF(MOD(MDIR,180).EQ.0) RETURN !IF MIRROR N-S, DONE. 8300 LDIR=MDIR !SEE WHICH MIRROR. IF(PRSO.EQ.XSOUTH) LDIR=180 XSTRNG=815 !MIRROR BLOCKS. IF(((LDIR.GT.180).AND..NOT.MR1F).OR. 1 ((LDIR.LT.180).AND..NOT.MR2F)) XSTRNG=816 !MIRROR BROKEN. RETURN C C C9- FROBOZZ FLAG (MIRIN) C 9000 IF(MRHERE(HERE).NE.1) GO TO 9100 !MIRROR 1 HERE? IF(MR1F) XSTRNG=805 !SEE IF BROKEN. FROBZF=MROPNF !ENTER IF OPEN. RETURN C 9100 FROBZF=.FALSE. !NOT HERE, XSTRNG=817 !LOSE. RETURN C CXAPPL, PAGE 4 C C C10- FROBOZZ FLAG (MIRROR EXIT) C 10000 FROBZF=.FALSE. !ASSUME CANT. LDIR=((PRSO-XNORTH)/XNORTH)*45 !XLATE DIR TO DEGREES. IF(.NOT.MROPNF .OR. 1 ((MOD(MDIR+270,360).NE.LDIR).AND.(PRSO.NE.XEXIT))) 2 GO TO 10200 !EXIT VIA MIRROR? XROOM1=((MLOC-MRA)*2)+MRAE+1-(MDIR/180) !ASSUME E-W EXIT. IF(MOD(MDIR,180).EQ.0) GO TO 10100 !IF N-S, OK. XROOM1=MLOC+1 !ASSUME N EXIT. IF(MDIR.GT.180) XROOM1=MLOC-1 !IF SOUTH. 10100 CXAPPL=XROOM1 RETURN C 10200 IF(.NOT.WDOPNF .OR. 1 ((MOD(MDIR+180,360).NE.LDIR).AND.(PRSO.NE.XEXIT))) 2 RETURN !EXIT VIA OPEN DOOR? XROOM1=MLOC+1 !ASSUME N. IF(MDIR.EQ.0) XROOM1=MLOC-1 !IF S. CALL RSPEAK(818) !CLOSE DOOR. WDOPNF=.FALSE. CXAPPL=XROOM1 RETURN C C C11- MAYBE DOOR. NORMAL MESSAGE IS THAT DOOR IS CLOSED. C BUT IF LCELL.NE.4, DOOR ISNT THERE. C 11000 IF(LCELL.NE.4) XSTRNG=678 !SET UP MSG. RETURN C C C12- FROBZF (PUZZLE ROOM MAIN ENTRANCE) C 12000 FROBZF=.TRUE. !ALWAYS ENTER. CPHERE=10 !SET SUBSTATE. RETURN C C C13- CPOUTF (PUZZLE ROOM SIZE ENTRANCE) C 13000 CPHERE=52 !SET SUBSTATE. RETURN C CXAPPL, PAGE 5 C C C14- FROBZF (PUZZLE ROOM TRANSITIONS) C 14000 FROBZF=.FALSE. !ASSSUME LOSE. IF(PRSO.NE.XUP) GO TO 14100 !UP? IF(CPHERE.NE.10) RETURN !AT EXIT? XSTRNG=881 !ASSUME NO LADDER. IF(CPVEC(CPHERE+1).NE.-2) RETURN !LADDER HERE? CALL RSPEAK(882) !YOU WIN. FROBZF=.TRUE. !LET HIM OUT. RETURN C 14100 IF((CPHERE.NE.52).OR.(PRSO.NE.XWEST).OR..NOT.CPOUTF) 1 GO TO 14200 !W EXIT AT DOOR? FROBZF=.TRUE. !YES, LET HIM OUT. RETURN C 14200 DO 14300 I=1,16,2 !LOCATE EXIT. IF(PRSO.EQ.CPDR(I)) GO TO 14400 14300 CONTINUE RETURN !NO SUCH EXIT. C 14400 J=CPDR(I+1) !GET DIRECTIONAL OFFSET. NXT=CPHERE+J !GET NEXT STATE. K=8 !GET ORTHOGONAL DIR. IF(J.LT.0) K=-8 IF((((IABS(J).EQ.1).OR.(IABS(J).EQ.8)).OR. 1 ((CPVEC(CPHERE+K).EQ.0).OR.(CPVEC(NXT-K).EQ.0))).AND. 2 (CPVEC(NXT).EQ.0)) GO TO 14500 !CANT DO IT? RETURN C 14500 CALL CPGOTO(NXT) !MOVE TO STATE. XROOM1=CPUZZ !STAY IN ROOM. CXAPPL=XROOM1 RETURN C END C GDT- GAME DEBUGGING TOOL C C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED C WRITTEN BY R. M. SUPNIK C C DECLARATIONS C SUBROUTINE GDT IMPLICIT INTEGER (A-Z) INTEGER DBGCMD(38),ARGTYP(38) LOGICAL VALID1,VALID2,VALID3 C C PARSER OUTPUT C LOGICAL PRSWON COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON C C PARSER STATE C COMMON /ORPHS/ ORP(5) COMMON /LAST/ LASTIT COMMON /PV/ PVEC(5) COMMON /SYNTAX/ SYN(11) C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD, 1 LTSHFT,BLOC,MUNGRM,HS,EGSCOR,EGMXSC C C SCREEN OF LIGHT C COMMON /SCREEN/ FROMDR,SCOLRM,SCOLAC C C PUZZLE ROOM C COMMON /PUZZLE/ CPDR(16),CPWL(8),CPVEC(64) C C MISCELLANEOUS VARIABLES C COMMON /STAR/ MBASE,STRBIT COMMON /CHAN/ INPCH,OUTCH,DBCH C C MESSAGE INDEX C COMMON /RMSG/ MLNT,RTEXT(1050) C COMMON /DEBUG/ DBGFLG,PRSFLG,GDTFLG C C ROOMS C COMMON /ROOMS/ RLNT,RDESC2,EQR(200,5) C COMMON /RINDEX/ WHOUS,LROOM,CELLA COMMON /RINDEX/ MTROL,MAZE1 COMMON /RINDEX/ MGRAT,MAZ15 COMMON /RINDEX/ FORE1,FORE3,CLEAR,RESER COMMON /RINDEX/ STREA,EGYPT,ECHOR COMMON /RINDEX/ TSHAF COMMON /RINDEX/ BSHAF,MMACH,DOME,MTORC COMMON /RINDEX/ CAROU COMMON /RINDEX/ RIDDL,LLD2,TEMP1,TEMP2,MAINT COMMON /RINDEX/ BLROO,TREAS,RIVR1,RIVR2,RIVR3,MCYCL COMMON /RINDEX/ RIVR4,RIVR5,FCHMP,FALLS,MBARR COMMON /RINDEX/ MRAIN,POG,VLBOT,VAIR1,VAIR2,VAIR3,VAIR4 COMMON /RINDEX/ LEDG2,LEDG3,LEDG4,MSAFE,CAGER COMMON /RINDEX/ CAGED,TWELL,BWELL,ALICE,ALISM,ALITR COMMON /RINDEX/ MTREE,BKENT,BKVW,BKTWI,BKVAU,BKBOX COMMON /RINDEX/ CRYPT,TSTRS,MRANT,MREYE COMMON /RINDEX/ MRA,MRB,MRC,MRG,MRD,FDOOR COMMON /RINDEX/ MRAE,MRCE,MRCW,MRGE,MRGW,MRDW,INMIR COMMON /RINDEX/ SCORR,NCORR,PARAP,CELL,PCELL,NCELL C COMMON /OROOM2/ R2LNT,O2(20),R2(20) C C EXITS C COMMON /EXITS/ XLNT,TRAVEL(900) C C OBJECTS C COMMON /OBJCTS/ OLNT,EQO(220,14) C COMMON /OINDEX/ GARLI,FOOD,GUNK,COAL,MACHI,DIAMO,TCASE,BOTTL COMMON /OINDEX/ WATER,ROPE,KNIFE,SWORD,LAMP,BLAMP,RUG COMMON /OINDEX/ LEAVE,TROLL,AXE COMMON /OINDEX/ RKNIF,KEYS,ICE,BAR COMMON /OINDEX/ COFFI,TORCH,TBASK,FBASK,IRBOX COMMON /OINDEX/ GHOST,TRUNK,BELL,BOOK,CANDL COMMON /OINDEX/ MATCH,TUBE,PUTTY,WRENC,SCREW,CYCLO,CHALI COMMON /OINDEX/ THIEF,STILL,WINDO,GRATE,DOOR COMMON /OINDEX/ HPOLE,LEAK,RBUTT,RAILI COMMON /OINDEX/ POT,STATU,IBOAT,DBOAT,PUMP,RBOAT COMMON /OINDEX/ STICK,BUOY,SHOVE,BALLO,RECEP,GUANO COMMON /OINDEX/ BROPE,HOOK1,HOOK2,SAFE,SSLOT,BRICK,FUSE COMMON /OINDEX/ GNOME,BLABE,DBALL,TOMB COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE COMMON /OINDEX/ ROBOT,FTREE,BILLS,PORTR,SCOL,ZGNOM COMMON /OINDEX/ EGG,BEGG,BAUBL,CANAR,BCANA COMMON /OINDEX/ YLWAL,RDWAL,PINDR,RBEAM COMMON /OINDEX/ ODOOR,QDOOR,CDOOR,NUM1,NUM8 COMMON /OINDEX/ HANDS,WALL,LUNGS,SAILO,AVIAT,TEETH COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,WNORT,GWATE,MASTER C C CLOCK INTERRUPTS C LOGICAL*1 CFLAG COMMON /CEVENT/ CLNT,EQC(25,2),CFLAG(25) C C VILLAINS AND DEMONS C LOGICAL THFFLG,SWDACT,THFACT COMMON /HACK/ THFPOS,THFFLG,THFACT,SWDACT,SWDSTA COMMON /VILL/ VLNT,EQV(4,5) C C ADVENTURERS C COMMON /ADVS/ ALNT,EQA(4,7) C C FLAGS C LOGICAL*1 FLAGS(46) INTEGER SWITCH(22) LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF, 1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF, 2 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF, 3 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF, 4 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF, 5 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF, 6 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF, 7 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ SWITCH EQUIVALENCE (FLAGS(1),TROLLF) C C FUNCTIONS AND DATA C VALID1(A1,L1)=(A1.GT.0).AND.(A1.LE.L1) VALID2(A1,A2,L1)=VALID1(A1,L1).AND.VALID1(A2,L1).AND. 1 (A1.LE.A2) VALID3(A1,L1,A2,L2)=VALID1(A1,L1).AND.VALID1(A2,L2) DATA CMDMAX/38/ DATA DBGCMD/'DR','DO','DA','DC','DX','DH','DL','DV','DF','DS', 1 'AF','HE','NR','NT','NC','ND','RR','RT','RC','RD', 2 'TK','EX','AR','AO','AA','AC','AX','AV','D2','DN', 3 'AN','DM','DT','AH','DP','PD','DZ','AZ'/ DATA ARGTYP/ 2 , 2 , 2 , 2 , 2 , 0 , 0 , 2 , 2 , 0 , 1 1 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 2 1 , 0 , 3 , 3 , 3 , 3 , 1 , 3 , 2 , 2 , 3 1 , 2 , 1 , 0 , 0 , 0 , 0 , 1 / C GDT, PAGE 2 C C FIRST, VALIDATE THAT THE CALLER IS AN IMPLEMENTER. C FMAX=46 !SET ARRAY LIMITS. SMAX=22 C IF(GDTFLG.NE.0) GO TO 2000 !IF OK, SKIP. WRITE(OUTCH,100) !NOT AN IMPLEMENTER. RETURN !BOOT HIM OFF C 100 FORMAT(' You are not an authorized user.') c GDT, PAGE 2A C C HERE TO GET NEXT COMMAND C 2000 WRITE(OUTCH,200) !OUTPUT PROMPT. READ(INPCH,210) CMD !GET COMMAND. IF(CMD.EQ.' ') GO TO 2000 !IGNORE BLANKS. DO 2100 I=1,CMDMAX !LOOK IT UP. IF(CMD.EQ.DBGCMD(I)) GO TO 2300 !FOUND? 2100 CONTINUE 2200 WRITE(OUTCH,220) !NO, LOSE. GO TO 2000 C 200 FORMAT(' GDT>',$) 210 FORMAT(A2) 220 FORMAT(' ?') 230 FORMAT(2I6) 240 FORMAT(I6) 225 FORMAT(' Limits: ',$) 235 FORMAT(' Entry: ',$) 245 FORMAT(' Idx,Ary: ',$) c 2300 GO TO (2400,2500,2600,2700),ARGTYP(I)+1 !BRANCH ON ARG TYPE. GO TO 2200 !ILLEGAL TYPE. C 2700 WRITE(OUTCH,245) !TYPE 3, REQUEST ARRAY COORDS. READ(INPCH,230) J,K GO TO 2400 C 2600 WRITE(OUTCH,225) !TYPE 2, READ BOUNDS. READ(INPCH,230) J,K IF(K.EQ.0) K=J GO TO 2400 C 2500 WRITE(OUTCH,235) !TYPE 1, READ ENTRY NO. READ(INPCH,240) J 2400 GO TO (10000,11000,12000,13000,14000,15000,16000,17000,18000, 1 19000,20000,21000,22000,23000,24000,25000,26000,27000,28000, 2 29000,30000,31000,32000,33000,34000,35000,36000,37000,38000, 3 39000,40000,41000,42000,43000,44000,45000,46000,47000),I GO TO 2200 !WHAT??? C GDT, PAGE 3 C C DR-- DISPLAY ROOMS C 10000 IF(.NOT.VALID2(J,K,RLNT)) GO TO 2200 !ARGS VALID? WRITE(OUTCH,300) !COL HDRS. DO 10100 I=J,K WRITE(OUTCH,310) I,(EQR(I,L),L=1,5) 10100 CONTINUE GO TO 2000 C 300 FORMAT(' RM# DESC1 EXITS ACTION VALUE FLAGS') 310 FORMAT(1X,I3,4(1X,I6),1X,O6) C C DO-- DISPLAY OBJECTS C 11000 IF(.NOT.VALID2(J,K,OLNT)) GO TO 2200 !ARGS VALID? WRITE(OUTCH,320) !COL HDRS DO 11100 I=J,K WRITE(OUTCH,330) I,(EQO(I,L),L=1,14) 11100 CONTINUE GO TO 2000 C 320 FORMAT(' OB# DESC1 DESC2 DESCO ACT FLAGS1 FLAGS2 FVL TVL 1 SIZE CAPAC ROOM ADV CON READ') 330 FORMAT(1X,I3,3I6,I4,2O7,2I4,2I6,1X,3I4,I6) C C DA-- DISPLAY ADVENTURERS C 12000 IF(.NOT.VALID2(J,K,ALNT)) GO TO 2200 !ARGS VALID? WRITE(OUTCH,340) DO 12100 I=J,K WRITE(OUTCH,350) I,(EQA(I,L),L=1,7) 12100 CONTINUE GO TO 2000 C 340 FORMAT(' AD# ROOM SCORE VEHIC OBJECT ACTION STREN FLAGS') 350 FORMAT(1X,I3,6(1X,I6),1X,O6) C C DC-- DISPLAY CLOCK EVENTS C 13000 IF(.NOT.VALID2(J,K,CLNT)) GO TO 2200 !ARGS VALID? WRITE(OUTCH,360) DO 13100 I=J,K WRITE(OUTCH,370) I,(EQC(I,L),L=1,2),CFLAG(I) 13100 CONTINUE GO TO 2000 C 360 FORMAT(' CL# TICK ACTION FLAG') 370 FORMAT(1X,I3,1X,I6,1X,I6,5X,L1) C C DX-- DISPLAY EXITS C 14000 IF(.NOT.VALID2(J,K,XLNT)) GO TO 2200 !ARGS VALID? WRITE(OUTCH,380) !COL HDRS. DO 14100 I=J,K,10 !TEN PER LINE. L=MIN0(I+9,K) !COMPUTE END OF LINE. WRITE(OUTCH,390) I,L,(TRAVEL(L1),L1=I,L) 14100 CONTINUE GO TO 2000 C 380 FORMAT(' RANGE CONTENTS') 390 FORMAT(1X,I3,'-',I3,3X,10O7) C C DH-- DISPLAY HACKS C 15000 WRITE(OUTCH,400) THFPOS,THFFLG,THFACT,SWDACT,SWDSTA GO TO 2000 C 400 FORMAT(' THFPOS=',I6,', THFFLG=',L2,',THFACT=',L2/ 1' SWDACT=',L2,', SWDSTA=',I2) C C DL-- DISPLAY LENGTHS C 16000 WRITE(OUTCH,410) RLNT,XLNT,OLNT,CLNT,VLNT,ALNT,MLNT,R2LNT, 1 MBASE,STRBIT GO TO 2000 C 410 FORMAT(' R=',I6,', X=',I6,', O=',I6,', C=',I6/ 1' V=',I6,', A=',I6,', M=',I6,', R2=',I5/ 2' MBASE=',I6,', STRBIT=',I6) C C DV-- DISPLAY VILLAINS C 17000 IF(.NOT.VALID2(J,K,VLNT)) GO TO 2200 !ARGS VALID? WRITE(OUTCH,420) !COL HDRS DO 17100 I=J,K WRITE(OUTCH,430) I,(EQV(I,L),L=1,5) 17100 CONTINUE GO TO 2000 C 420 FORMAT(' VL# OBJECT PROB OPPS BEST MELEE') 430 FORMAT(1X,I3,5(1X,I6)) C C DF-- DISPLAY FLAGS C 18000 IF(.NOT.VALID2(J,K,FMAX)) GO TO 2200 !ARGS VALID? DO 18100 I=J,K WRITE(OUTCH,440) I,FLAGS(I) 18100 CONTINUE GO TO 2000 C 440 FORMAT(' Flag #',I2,' = ',L1) C C DS-- DISPLAY STATE C 19000 WRITE(OUTCH,450) PRSA,PRSO,PRSI,PRSWON,PRSCON WRITE(OUTCH,460) WINNER,HERE,TELFLG WRITE(OUTCH,470) MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD,LTSHFT,BLOC, 1 MUNGRM,HS,EGSCOR,EGMXSC WRITE(OUTCH,475) FROMDR,SCOLRM,SCOLAC GO TO 2000 C 450 FORMAT(' Parse vector=',3(1X,I6),1X,L6,1X,I6) 460 FORMAT(' Play vector= ',2(1X,I6),1X,L6) 470 FORMAT(' State vector=',9(1X,I6)/14X,2(1X,I6)) 475 FORMAT(' Scol vector= ',1X,O6,2(1X,I6)) C GDT, PAGE 4 C C AF-- ALTER FLAGS C 20000 IF(.NOT.VALID1(J,FMAX)) GO TO 2200 !ENTRY NO VALID? WRITE(OUTCH,480) FLAGS(J) !TYPE OLD, GET NEW. READ(INPCH,490) FLAGS(J) GO TO 2000 C 480 FORMAT(' Old=',L2,6X,'New= ',$) 490 FORMAT(L1) C C 21000-- HELP C 21000 WRITE(OUTCH,900) GO TO 2000 C 900 FORMAT(' Valid commands are:'/' AA- Alter ADVS'/ 1' AC- Alter CEVENT'/' AF- Alter FINDEX'/' AH- Alter HERE'/ 2' AN- Alter switches'/' AO- Alter OBJCTS'/' AR- Alter ROOMS'/ 3' AV- Alter VILLS'/' AX- Alter EXITS'/ 3' AZ- Alter PUZZLE'/' DA- Display ADVS'/ 4' DC- Display CEVENT'/' DF- Display FINDEX'/' DH- Display HACKS'/ 5' DL- Display lengths'/' DM- Display RTEXT'/ 6' DN- Display switches'/ 6' DO- Display OBJCTS'/' DP- Display parser'/ 6' DR- Display ROOMS'/' DS- Display state'/' DT- Display text'/ 7' DV- Display VILLS'/' DX- Display EXITS'/' DZ- Display PUZZLE'/ 8' D2- Display ROOM2'/' EX- Exit'/' HE- Type this message'/ 9' NC- No cyclops'/' ND- No deaths'/' NR- No robber'/ 1' NT- No troll'/' PD- Program detail'/ 1' RC- Restore cyclops'/' RD- Restore deaths'/ 2' RR- Restore robber'/' RT- Restore troll'/' TK- Take.') C C NR-- NO ROBBER C 22000 THFFLG=.FALSE. !DISABLE ROBBER. THFACT=.FALSE. CALL NEWSTA(THIEF,0,0,0,0) !VANISH THIEF. WRITE(OUTCH,500) GO TO 2000 C 500 FORMAT(' No robber.') C C NT-- NO TROLL C 23000 TROLLF=.TRUE. CALL NEWSTA(TROLL,0,0,0,0) WRITE(OUTCH,510) GO TO 2000 C 510 FORMAT(' No troll.') C C NC-- NO CYCLOPS C 24000 CYCLOF=.TRUE. CALL NEWSTA(CYCLO,0,0,0,0) WRITE(OUTCH,520) GO TO 2000 C 520 FORMAT(' No cyclops.') C C ND-- IMMORTALITY MODE C 25000 DBGFLG=1 WRITE(OUTCH,530) GO TO 2000 C 530 FORMAT(' No deaths.') C C RR-- RESTORE ROBBER C 26000 THFACT=.TRUE. WRITE(OUTCH,540) GO TO 2000 C 540 FORMAT(' Restored robber.') C C RT-- RESTORE TROLL C 27000 TROLLF=.FALSE. CALL NEWSTA(TROLL,0,MTROL,0,0) WRITE(OUTCH,550) GO TO 2000 C 550 FORMAT(' Restored troll.') C C RC-- RESTORE CYCLOPS C 28000 CYCLOF=.FALSE. MAGICF=.FALSE. CALL NEWSTA(CYCLO,0,MCYCL,0,0) WRITE(OUTCH,560) GO TO 2000 C 560 FORMAT(' Restored cyclops.') C C RD-- MORTAL MODE C 29000 DBGFLG=0 WRITE(OUTCH,570) GO TO 2000 C 570 FORMAT(' Restored deaths.') C GDT, PAGE 5 C C TK-- TAKE C 30000 IF(.NOT.VALID1(J,OLNT)) GO TO 2200 !VALID OBJECT? CALL NEWSTA(J,0,0,0,WINNER) !YES, TAKE OBJECT. WRITE(OUTCH,580) !TELL. GO TO 2000 C 580 FORMAT(' Taken.') C C EX-- GOODBYE C 31000 PRSCON=1 RETURN C C AR-- ALTER ROOM ENTRY C 32000 IF(.NOT.VALID3(J,RLNT,K,5)) GO TO 2200 !INDICES VALID? WRITE(OUTCH,590) EQR(J,K) !TYPE OLD, GET NEW. READ(INPCH,600) EQR(J,K) GO TO 2000 C 590 FORMAT(' Old= ',I6,6X,'New= ',$) 600 FORMAT(I6) C C AO-- ALTER OBJECT ENTRY C 33000 IF(.NOT.VALID3(J,OLNT,K,14)) GO TO 2200 !INDICES VALID? WRITE(OUTCH,590) EQO(J,K) READ(INPCH,600) EQO(J,K) GO TO 2000 C C AA-- ALTER ADVS ENTRY C 34000 IF(.NOT.VALID3(J,ALNT,K,7)) GO TO 2200 !INDICES VALID? WRITE(OUTCH,590) EQA(J,K) READ(INPCH,600) EQA(J,K) GO TO 2000 C C AC-- ALTER CLOCK EVENTS C 35000 IF(.NOT.VALID3(J,CLNT,K,3)) GO TO 2200 !INDICES VALID? IF(K.EQ.3) GO TO 35500 !FLAGS ENTRY? WRITE(OUTCH,590) EQC(J,K) READ(INPCH,600) EQC(J,K) GO TO 2000 C 35500 WRITE(OUTCH,480) CFLAG(J) READ(INPCH,490) CFLAG(J) GO TO 2000 C GDT, PAGE 6 C C AX-- ALTER EXITS C 36000 IF(.NOT.VALID1(J,XLNT)) GO TO 2200 !ENTRY NO VALID? WRITE(OUTCH,610) TRAVEL(J) READ(INPCH,620) TRAVEL(J) GO TO 2000 C 610 FORMAT(' Old= ',O6,6X,'New= ',$) 620 FORMAT(O6) C C AV-- ALTER VILLAINS C 37000 IF(.NOT.VALID3(J,VLNT,K,5)) GO TO 2200 !INDICES VALID? WRITE(OUTCH,590) EQV(J,K) READ(INPCH,600) EQV(J,K) GO TO 2000 C C D2-- DISPLAY ROOM2 LIST C 38000 IF(.NOT.VALID2(J,K,R2LNT)) GO TO 2200 DO 38100 I=J,K WRITE(OUTCH,630) I,R2(I),O2(I) 38100 CONTINUE GO TO 2000 C 630 FORMAT(' #',I2,' Room=',I6,' Obj=',I6) C C DN-- DISPLAY SWITCHES C 39000 IF(.NOT.VALID2(J,K,SMAX)) GO TO 2200 !VALID? DO 39100 I=J,K WRITE(OUTCH,640) I,SWITCH(I) 39100 CONTINUE GO TO 2000 C 640 FORMAT(' Switch #',I2,' = ',I6) C C AN-- ALTER SWITCHES C 40000 IF(.NOT.VALID1(J,SMAX)) GO TO 2200 !VALID ENTRY? WRITE(OUTCH,590) SWITCH(J) READ(INPCH,600) SWITCH(J) GO TO 2000 C C DM-- DISPLAY MESSAGES C 41000 IF(.NOT.VALID2(J,K,MLNT)) GO TO 2200 !VALID LIMITS? WRITE(OUTCH,380) DO 41100 I=J,K,10 L=MIN0(I+9,K) WRITE(OUTCH,650) I,L,(RTEXT(L1),L1=I,L) 41100 CONTINUE GO TO 2000 C 650 FORMAT(1X,I3,'-',I3,3X,10(1X,I6)) C C DT-- DISPLAY TEXT C 42000 CALL RSPEAK(J) GO TO 2000 C C AH-- ALTER HERE C 43000 WRITE(OUTCH,590) HERE READ(INPCH,600) HERE EQA(1,1)=HERE GO TO 2000 C C DP-- DISPLAY PARSER STATE C 44000 WRITE(OUTCH,660) ORP,LASTIT,PVEC,SYN GO TO 2000 C 660 FORMAT(' ORPHS= ',I7,O7,4I7/ 1' PV= ',O7,4I7/' SYN= ',6O7/15X,5O7) C C PD-- PROGRAM DETAIL DEBUG C 45000 WRITE(OUTCH,610) PRSFLG !TYPE OLD, GET NEW. READ(INPCH,620) PRSFLG GO TO 2000 C C DZ-- DISPLAY PUZZLE ROOM C 46000 DO 46100 I=1,64,8 !DISPLAY PUZZLE WRITE(OUTCH,670) (CPVEC(J),J=I,I+7) 46100 CONTINUE GO TO 2000 C 670 FORMAT(2X,8I3) C C AZ-- ALTER PUZZLE ROOM C 47000 IF(.NOT.VALID1(J,64)) GO TO 2200 !VALID ENTRY? WRITE(OUTCH,590) CPVEC(J) !OUTPUT OLD, READ(OUTCH,600) CPVEC(J) !GET NEW. GO TO 2000 C END C LIGHTP- LIGHT PROCESSOR C C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED C WRITTEN BY R. M. SUPNIK C C DECLARATIONS C LOGICAL FUNCTION LIGHTP(OBJ) IMPLICIT INTEGER (A-Z) LOGICAL QON C C PARSER OUTPUT C LOGICAL PRSWON COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT, 1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT, 2 TOOLBT,TURNBT,ONBT COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT, 1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT, 2 TCHBT,VEHBT,SCHBT C COMMON /OINDEX/ GARLI,FOOD,GUNK,COAL,MACHI,DIAMO,TCASE,BOTTL COMMON /OINDEX/ WATER,ROPE,KNIFE,SWORD,LAMP,BLAMP,RUG COMMON /OINDEX/ LEAVE,TROLL,AXE COMMON /OINDEX/ RKNIF,KEYS,ICE,BAR COMMON /OINDEX/ COFFI,TORCH,TBASK,FBASK,IRBOX COMMON /OINDEX/ GHOST,TRUNK,BELL,BOOK,CANDL COMMON /OINDEX/ MATCH,TUBE,PUTTY,WRENC,SCREW,CYCLO,CHALI COMMON /OINDEX/ THIEF,STILL,WINDO,GRATE,DOOR COMMON /OINDEX/ HPOLE,LEAK,RBUTT,RAILI COMMON /OINDEX/ POT,STATU,IBOAT,DBOAT,PUMP,RBOAT COMMON /OINDEX/ STICK,BUOY,SHOVE,BALLO,RECEP,GUANO COMMON /OINDEX/ BROPE,HOOK1,HOOK2,SAFE,SSLOT,BRICK,FUSE COMMON /OINDEX/ GNOME,BLABE,DBALL,TOMB COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE COMMON /OINDEX/ ROBOT,FTREE,BILLS,PORTR,SCOL,ZGNOM COMMON /OINDEX/ EGG,BEGG,BAUBL,CANAR,BCANA COMMON /OINDEX/ YLWAL,RDWAL,PINDR,RBEAM COMMON /OINDEX/ ODOOR,QDOOR,CDOOR,NUM1,NUM8 COMMON /OINDEX/ WARNI,CSLIT,GCARD,STLDR COMMON /OINDEX/ HANDS,WALL,LUNGS,SAILO,AVIAT,TEETH COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,WNORT,GWATE,MASTER C C CLOCK INTERRUPTS C LOGICAL*1 CFLAG COMMON /CEVENT/ CLNT,CTICK(25),CACTIO(25),CFLAG(25) C COMMON /CINDEX/ CEVCUR,CEVMNT,CEVLNT,CEVMAT,CEVCND, 1 CEVBAL,CEVBRN,CEVFUS,CEVLED,CEVSAF,CEVVLG, 2 CEVGNO,CEVBUC,CEVSPH,CEVEGH, 3 CEVFOR,CEVSCL,CEVZGI,CEVZGO,CEVSTE, 5 CEVMRS,CEVPIN,CEVINQ,CEVFOL C C VERBS C COMMON /VINDEX/ CINTW,DEADXW,FRSTQW,INXW,OUTXW COMMON /VINDEX/ WALKIW,FIGHTW,FOOW COMMON /VINDEX/ MELTW,READW,INFLAW,DEFLAW,ALARMW,EXORCW COMMON /VINDEX/ PLUGW,KICKW,WAVEW,RAISEW,LOWERW,RUBW COMMON /VINDEX/ PUSHW,UNTIEW,TIEW,TIEUPW,TURNW,BREATW COMMON /VINDEX/ KNOCKW,LOOKW,EXAMIW,SHAKEW,MOVEW,TRNONW,TRNOFW COMMON /VINDEX/ OPENW,CLOSEW,FINDW,WAITW,SPINW,BOARDW,UNBOAW,TAKEW COMMON /VINDEX/ INVENW,FILLW,EATW,DRINKW,BURNW COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW COMMON /VINDEX/ DIGW,LEAPW,STAYW,FOLLOW COMMON /VINDEX/ HELLOW,LOOKIW,LOOKUW,PUMPW,WINDW COMMON /VINDEX/ CLMBW,CLMBUW,CLMBDW,TRNTOW C C FLAGS C LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF, 1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF, 2 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF, 3 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF, 4 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF, 5 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF, 6 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF, 7 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ BTIEF,BINFF COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP COMMON /FINDEX/ MDIR,MLOC,POLEUF COMMON /FINDEX/ QUESNO,NQATT,CORRCT COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE C C FUNCTIONS AND DATA C QON(R)=(OFLAG1(R).AND.ONBT).NE.0 C LIGHTP, PAGE 2 C LIGHTP=.TRUE. !ASSUME WINS FLOBTS=FLAMBT+LITEBT+ONBT IF(OBJ.NE.CANDL) GO TO 20000 !CANDLE? IF(ORCAND.NE.0) GO TO 19100 !FIRST REF? ORCAND=1 !YES, CANDLES ARE CTICK(CEVCND)=50 !BURNING WHEN SEEN. C 19100 IF(PRSI.EQ.CANDL) GO TO 10 !IGNORE IND REFS. IF(PRSA.NE.TRNOFW) GO TO 19200 !TURN OFF? I=513 !ASSUME OFF. IF(QON(CANDL)) I=514 !IF ON, DIFFERENT. CFLAG(CEVCND)=.FALSE. !DISABLE COUNTDOWN. OFLAG1(CANDL)=OFLAG1(CANDL).AND. .NOT.ONBT CALL RSPEAK(I) RETURN C 19200 IF((PRSA.NE.BURNW).AND.(PRSA.NE.TRNONW)) GO TO 10 IF((OFLAG1(CANDL).AND.LITEBT).NE.0) GO TO 19300 CALL RSPEAK(515) !CANDLES TOO SHORT. RETURN C 19300 IF(PRSI.NE.0) GO TO 19400 !ANY FLAME? CALL RSPEAK(516) !NO, LOSE. PRSWON=.FALSE. RETURN C 19400 IF((PRSI.NE.MATCH).OR. .NOT.QON(MATCH)) GO TO 19500 I=517 !ASSUME OFF. IF(QON(CANDL)) I=518 !IF ON, JOKE. OFLAG1(CANDL)=OFLAG1(CANDL).OR.ONBT !LITE CANDLES. CFLAG(CEVCND)=.TRUE. !RESUME COUNTDOWN. CALL RSPEAK(I) RETURN C 19500 IF((PRSI.NE.TORCH).OR. .NOT.QON(TORCH)) GO TO 19600 IF(QON(CANDL)) GO TO 19700 !ALREADY ON? CALL NEWSTA(CANDL,521,0,0,0) !NO, VAPORIZE. RETURN C 19600 CALL RSPEAK(519) !CANT LIGHT WITH THAT. RETURN C 19700 CALL RSPEAK(520) !ALREADY ON. RETURN C 20000 IF(OBJ.NE.MATCH) CALL BUG(6,OBJ) IF((PRSA.NE.TRNONW).OR.(PRSO.NE.MATCH)) GO TO 20500 IF(ORMTCH.NE.0) GO TO 20100 !ANY MATCHES LEFT? CALL RSPEAK(183) !NO, LOSE. RETURN C 20100 ORMTCH=ORMTCH-1 !DECREMENT NO MATCHES. OFLAG1(MATCH)=OFLAG1(MATCH).OR.FLOBTS CTICK(CEVMAT)=2 !COUNTDOWN. CALL RSPEAK(184) RETURN C 20500 IF((PRSA.NE.TRNOFW).OR.((OFLAG1(MATCH).AND.ONBT).EQ.0)) 1 GO TO 10 !EXTINGUISH? OFLAG1(MATCH)=OFLAG1(MATCH).AND. .NOT.FLOBTS CTICK(CEVMAT)=0 CALL RSPEAK(185) RETURN C C HERE FOR FALSE RETURN C 10 LIGHTP=.FALSE. RETURN END C NOBJS- NEW OBJECTS PROCESSOR C OBJECTS IN THIS MODULE CANNOT CALL RMINFO, JIGSUP, C MAJOR VERBS, OR OTHER NON-RESIDENT SUBROUTINES C C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED C WRITTEN BY R. M. SUPNIK C C DECLARATIONS C LOGICAL FUNCTION NOBJS(RI,ARG) IMPLICIT INTEGER (A-Z) LOGICAL QOPEN,MOVETO,F LOGICAL QHERE,OPNCLS,MIRPAN C C PARSER OUTPUT C LOGICAL PRSWON COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD, 1 LTSHFT,BLOC,MUNGRM,HS,EGSCOR,EGMXSC C C SCREEN OF LIGHT C COMMON /SCREEN/ FROMDR,SCOLRM,SCOLAC COMMON /SCREEN/ SCOLDR(8),SCOLWL(12) C C PUZZLE ROOM C COMMON /PUZZLE/ CPDR(16),CPWL(8),CPVEC(64) C C MISCELLANEOUS VARIABLES C COMMON /HYPER/ HFACTR C C ROOMS C COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200), 1 RACTIO(200),RVAL(200),RFLAG(200) INTEGER RRAND(200) EQUIVALENCE (RVAL,RRAND) C COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR, 1 RSACRD,RFILL,RMUNG,RBUCK,RHOUSE,RNWALL,REND C COMMON /RINDEX/ WHOUS,LROOM,CELLA COMMON /RINDEX/ MTROL,MAZE1 COMMON /RINDEX/ MGRAT,MAZ15 COMMON /RINDEX/ FORE1,FORE3,CLEAR,RESER COMMON /RINDEX/ STREA,EGYPT,ECHOR COMMON /RINDEX/ TSHAF COMMON /RINDEX/ BSHAF,MMACH,DOME,MTORC COMMON /RINDEX/ CAROU COMMON /RINDEX/ RIDDL,LLD2,TEMP1,TEMP2,MAINT COMMON /RINDEX/ BLROO,TREAS,RIVR1,RIVR2,RIVR3,MCYCL COMMON /RINDEX/ RIVR4,RIVR5,FCHMP,FALLS,MBARR COMMON /RINDEX/ MRAIN,POG,VLBOT,VAIR1,VAIR2,VAIR3,VAIR4 COMMON /RINDEX/ LEDG2,LEDG3,LEDG4,MSAFE,CAGER COMMON /RINDEX/ CAGED,TWELL,BWELL,ALICE,ALISM,ALITR COMMON /RINDEX/ MTREE,BKENT,BKVW,BKTWI,BKVAU,BKBOX COMMON /RINDEX/ CRYPT,TSTRS,MRANT,MREYE COMMON /RINDEX/ MRA,MRB,MRC,MRG,MRD,FDOOR COMMON /RINDEX/ MRAE,MRCE,MRCW,MRGE,MRGW,MRDW,INMIR COMMON /RINDEX/ SCORR,NCORR,PARAP,CELL,PCELL,NCELL COMMON /RINDEX/ CPANT,CPOUT,CPUZZ C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT, 1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT, 2 TOOLBT,TURNBT,ONBT COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT, 1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT, 2 TCHBT,VEHBT,SCHBT C COMMON /OINDEX/ GARLI,FOOD,GUNK,COAL,MACHI,DIAMO,TCASE,BOTTL COMMON /OINDEX/ WATER,ROPE,KNIFE,SWORD,LAMP,BLAMP,RUG COMMON /OINDEX/ LEAVE,TROLL,AXE COMMON /OINDEX/ RKNIF,KEYS,ICE,BAR COMMON /OINDEX/ COFFI,TORCH,TBASK,FBASK,IRBOX COMMON /OINDEX/ GHOST,TRUNK,BELL,BOOK,CANDL COMMON /OINDEX/ MATCH,TUBE,PUTTY,WRENC,SCREW,CYCLO,CHALI COMMON /OINDEX/ THIEF,STILL,WINDO,GRATE,DOOR COMMON /OINDEX/ HPOLE,LEAK,RBUTT,RAILI COMMON /OINDEX/ POT,STATU,IBOAT,DBOAT,PUMP,RBOAT COMMON /OINDEX/ STICK,BUOY,SHOVE,BALLO,RECEP,GUANO COMMON /OINDEX/ BROPE,HOOK1,HOOK2,SAFE,SSLOT,BRICK,FUSE COMMON /OINDEX/ GNOME,BLABE,DBALL,TOMB COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE COMMON /OINDEX/ ROBOT,FTREE,BILLS,PORTR,SCOL,ZGNOM COMMON /OINDEX/ EGG,BEGG,BAUBL,CANAR,BCANA COMMON /OINDEX/ YLWAL,RDWAL,PINDR,RBEAM COMMON /OINDEX/ ODOOR,QDOOR,CDOOR,NUM1,NUM8 COMMON /OINDEX/ WARNI,CSLIT,GCARD,STLDR COMMON /OINDEX/ HANDS,WALL,LUNGS,SAILO,AVIAT,TEETH COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,WNORT,GWATE,MASTER C C CLOCK INTERRUPTS C LOGICAL*1 CFLAG COMMON /CEVENT/ CLNT,CTICK(25),CACTIO(25),CFLAG(25) C COMMON /CINDEX/ CEVCUR,CEVMNT,CEVLNT,CEVMAT,CEVCND, 1 CEVBAL,CEVBRN,CEVFUS,CEVLED,CEVSAF,CEVVLG, 2 CEVGNO,CEVBUC,CEVSPH,CEVEGH, 3 CEVFOR,CEVSCL,CEVZGI,CEVZGO,CEVSTE, 5 CEVMRS,CEVPIN,CEVINQ,CEVFOL C C VILLAINS AND DEMONS C LOGICAL THFFLG,SWDACT,THFACT COMMON /HACK/ THFPOS,THFFLG,THFACT,SWDACT,SWDSTA C C ADVENTURERS C COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4), 1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4) C COMMON /AINDEX/ PLAYER,AROBOT,AMASTR C C VERBS C COMMON /VINDEX/ CINTW,DEADXW,FRSTQW,INXW,OUTXW COMMON /VINDEX/ WALKIW,FIGHTW,FOOW COMMON /VINDEX/ MELTW,READW,INFLAW,DEFLAW,ALARMW,EXORCW COMMON /VINDEX/ PLUGW,KICKW,WAVEW,RAISEW,LOWERW,RUBW COMMON /VINDEX/ PUSHW,UNTIEW,TIEW,TIEUPW,TURNW,BREATW COMMON /VINDEX/ KNOCKW,LOOKW,EXAMIW,SHAKEW,MOVEW,TRNONW,TRNOFW COMMON /VINDEX/ OPENW,CLOSEW,FINDW,WAITW,SPINW,BOARDW,UNBOAW,TAKEW COMMON /VINDEX/ INVENW,FILLW,EATW,DRINKW,BURNW COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW COMMON /VINDEX/ DIGW,LEAPW,STAYW,FOLLOW COMMON /VINDEX/ HELLOW,LOOKIW,LOOKUW,PUMPW,WINDW COMMON /VINDEX/ CLMBW,CLMBUW,CLMBDW,TRNTOW C C FLAGS C LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF, 1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF, 2 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF, 3 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF, 4 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF, 5 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF, 6 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF, 7 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ BTIEF,BINFF COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP COMMON /FINDEX/ MDIR,MLOC,POLEUF COMMON /FINDEX/ QUESNO,NQATT,CORRCT COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE C C FUNCTIONS AND DATA C QOPEN(R)=(OFLAG2(R).AND.OPENBT).NE.0 C NOBJS, PAGE 2 C IF(PRSO.NE.0) ODO2=ODESC2(PRSO) IF(PRSI.NE.0) ODI2=ODESC2(PRSI) AV=AVEHIC(WINNER) NOBJS=.TRUE. C GO TO (1000,2000,3000,4000,5000,6000,7000,8000,9000, 1 10000,11000,12000,13000,14000,15000,16000,17000, 2 18000,19000,20000,21000), 3 (RI-31) CALL BUG(6,RI) C C RETURN HERE TO DECLARE FALSE RESULT C 10 NOBJS=.FALSE. RETURN C C O32-- BILLS C 1000 IF(PRSA.NE.EATW) GO TO 1100 !EAT? CALL RSPEAK(639) !JOKE. RETURN C 1100 IF(PRSA.EQ.BURNW) CALL RSPEAK(640) !BURN? JOKE. GO TO 10 !LET IT BE HANDLED. C NOBJS, PAGE 3 C C O33-- SCREEN OF LIGHT C 2000 TARGET=SCOL !TARGET IS SCOL. 2100 IF(PRSO.NE.TARGET) GO TO 2400 !PRSO EQ TARGET? IF((PRSA.NE.PUSHW).AND.(PRSA.NE.MOVEW).AND. 1 (PRSA.NE.TAKEW).AND.(PRSA.NE.RUBW)) GO TO 2200 CALL RSPEAK(673) !HAND PASSES THRU. RETURN C 2200 IF((PRSA.NE.KILLW).AND.(PRSA.NE.ATTACW).AND. 1 (PRSA.NE.MUNGW)) GO TO 2400 !AGGRESSIVE? CALL RSPSUB(674,ODI2) !PASSES THRU. RETURN C 2400 IF((PRSA.NE.THROWW).OR.(PRSI.NE.TARGET)) GO TO 10 IF(HERE.EQ.BKBOX) GO TO 2600 !THRU SCOL? CALL NEWSTA(PRSO,0,BKBOX,0,0) !NO, THRU WALL. CALL RSPSUB(675,ODO2) !ENDS UP IN BOX ROOM. CTICK(CEVSCL)=0 !CANCEL ALARM. SCOLRM=0 !RESET SCOL ROOM. RETURN C 2600 IF(SCOLRM.EQ.0) GO TO 2900 !TRIED TO GO THRU? CALL NEWSTA(PRSO,0,SCOLRM,0,0) !SUCCESS. CALL RSPSUB(676,ODO2) !ENDS UP SOMEWHERE. CTICK(CEVSCL)=0 !CANCEL ALARM. SCOLRM=0 !RESET SCOL ROOM. RETURN C 2900 CALL RSPEAK(213) !CANT DO IT. RETURN C NOBJS, PAGE 4 C C O34-- GNOME OF ZURICH C 3000 IF((PRSA.NE.GIVEW).AND.(PRSA.NE.THROWW)) GO TO 3200 IF(OTVAL(PRSO).NE.0) GO TO 3100 !THROW A TREASURE? CALL NEWSTA(PRSO,641,0,0,0) !NO, GO POP. RETURN C 3100 CALL NEWSTA(PRSO,0,0,0,0) !YES, BYE BYE TREASURE. CALL RSPSUB(642,ODO2) CALL NEWSTA(ZGNOM,0,0,0,0) !BYE BYE GNOME. CTICK(CEVZGO)=0 !CANCEL EXIT. F=MOVETO(BKENT,WINNER) !NOW IN BANK ENTRANCE. RETURN C 3200 IF((PRSA.NE.ATTACW).AND.(PRSA.NE.KILLW).AND. 1 (PRSA.NE.MUNGW)) GO TO 3300 !AGGRESSIVE? CALL NEWSTA(ZGNOM,643,0,0,0) !VANISH GNOME. CTICK(CEVZGO)=0 !CANCEL EXIT. RETURN C 3300 CALL RSPEAK(644) !GNOME IS IMPATIENT. RETURN C C O35-- EGG C 4000 IF((PRSA.NE.OPENW).OR.(PRSO.NE.EGG)) GO TO 4500 IF(.NOT.QOPEN(EGG)) GO TO 4100 !OPEN ALREADY? CALL RSPEAK(649) !YES. RETURN C 4100 IF(PRSI.NE.0) GO TO 4200 !WITH SOMETHING? CALL RSPEAK(650) !NO, CANT. RETURN C 4200 IF(PRSI.NE.HANDS) GO TO 4300 !WITH HANDS? CALL RSPEAK(651) !NOT RECOMMENDED. RETURN C 4300 I=652 !MUNG MESSAGE. IF(((OFLAG1(PRSI).AND.TOOLBT).NE.0).OR. 1 ((OFLAG2(PRSI).AND.WEAPBT).NE.0)) GO TO 4600 I=653 !NOVELTY 1. IF((OFLAG2(PRSO).AND.FITEBT).NE.0) I=654 !NOVELTY 2. OFLAG2(PRSO)=OFLAG2(PRSO).OR.FITEBT CALL RSPSUB(I,ODI2) RETURN C 4500 IF((PRSA.NE.OPENW).AND.(PRSA.NE.MUNGW)) GO TO 4800 I=655 !YOU BLEW IT. 4600 CALL NEWSTA(BEGG,I,OROOM(EGG),OCAN(EGG),OADV(EGG)) CALL NEWSTA(EGG,0,0,0,0) !VANISH EGG. OTVAL(BEGG)=2 !BAD EGG HAS VALUE. IF(OCAN(CANAR).NE.EGG) GO TO 4700 !WAS CANARY INSIDE? CALL RSPEAK(ODESCO(BCANA)) !YES, DESCRIBE RESULT. OTVAL(BCANA)=1 RETURN C 4700 CALL NEWSTA(BCANA,0,0,0,0) !NO, VANISH IT. RETURN C 4800 IF((PRSA.NE.DROPW).OR.(HERE.NE.MTREE)) GO TO 10 CALL NEWSTA(BEGG,658,FORE3,0,0) !DROPPED EGG. CALL NEWSTA(EGG,0,0,0,0) OTVAL(BEGG)=2 IF(OCAN(CANAR).NE.EGG) GO TO 4700 OTVAL(BCANA)=1 !BAD CANARY. RETURN C NOBJS, PAGE 5 C C O36-- CANARIES, GOOD AND BAD C 5000 IF(PRSA.NE.WINDW) GO TO 10 !WIND EM UP? IF(PRSO.EQ.CANAR) GO TO 5100 !RIGHT ONE? CALL RSPEAK(645) !NO, BAD NEWS. RETURN C 5100 IF(.NOT.SINGSF.AND.((HERE.EQ.MTREE).OR. 1 ((HERE.GE.FORE1).AND.(HERE.LT.CLEAR)))) 2 GO TO 5200 !FIRST SONG IN FOR? CALL RSPEAK(646) !NO, MEDIOCRE NEWS. RETURN C 5200 SINGSF=.TRUE. !SANG SONG. I=HERE IF(I.EQ.MTREE) I=FORE3 !PLACE BAUBLE. CALL NEWSTA(BAUBL,647,I,0,0) RETURN C C O37-- WHITE CLIFFS C 6000 IF((PRSA.NE.CLMBW).AND.(PRSA.NE.CLMBUW).AND. 1 (PRSA.NE.CLMBDW)) GO TO 10 !CLIMB? CALL RSPEAK(648) !OH YEAH? RETURN C C O38-- WALL C 7000 IF((IABS(HERE-MLOC).NE.1).OR.(MRHERE(HERE).NE.0).OR. 1 (PRSA.NE.PUSHW)) GO TO 7100 CALL RSPEAK(860) !PUSHED MIRROR WALL. RETURN C 7100 IF((RFLAG(HERE).AND.RNWALL).EQ.0) GO TO 10 CALL RSPEAK(662) !NO WALL. RETURN C NOBJS, PAGE 6 C C O39-- SONG BIRD GLOBAL C 8000 IF(PRSA.NE.FINDW) GO TO 8100 !FIND? CALL RSPEAK(666) RETURN C 8100 IF(PRSA.NE.EXAMIW) GO TO 10 !EXAMINE? CALL RSPEAK(667) RETURN C C O40-- PUZZLE/SCOL WALLS C 9000 IF(HERE.NE.CPUZZ) GO TO 9500 !PUZZLE WALLS? IF(PRSA.NE.PUSHW) GO TO 10 !PUSH? DO 9100 I=1,8,2 !LOCATE WALL. IF(PRSO.EQ.CPWL(I)) GO TO 9200 9100 CONTINUE CALL BUG(80,PRSO) !WHAT? C 9200 J=CPWL(I+1) !GET DIRECTIONAL OFFSET. NXT=CPHERE+J !GET NEXT STATE. WL=CPVEC(NXT) !GET C(NEXT STATE). GO TO (9300,9300,9300,9250,9350),(WL+4) !PROCESS. C 9250 CALL RSPEAK(876) !CLEAR CORRIDOR. RETURN C 9300 IF(CPVEC(NXT+J).EQ.0) GO TO 9400 !MOVABLE, ROOM TO MOVE? 9350 CALL RSPEAK(877) !IMMOVABLE, NO ROOM. RETURN C 9400 I=878 !ASSUME FIRST PUSH. IF(CPUSHF) I=879 !NOT? CPUSHF=.TRUE. CPVEC(NXT+J)=WL !MOVE WALL. CPVEC(NXT)=0 !VACATE NEXT STATE. CALL CPGOTO(NXT) !ONWARD. CALL CPINFO(I,NXT) !DESCRIBE. CALL PRINCR(.TRUE.,HERE) !PRINT ROOMS CONTENTS. RFLAG(HERE)=RFLAG(HERE).OR.RSEEN RETURN C 9500 IF(HERE.NE.SCOLAC) GO TO 9700 !IN SCOL ACTIVE ROOM? DO 9600 I=1,12,3 TARGET=SCOLWL(I+1) !ASSUME TARGET. IF(SCOLWL(I).EQ.HERE) GO TO 2100 !TREAT IF FOUND. 9600 CONTINUE C 9700 IF(HERE.NE.BKBOX) GO TO 10 !IN BOX ROOM? TARGET=WNORT GO TO 2100 C NOBJS, PAGE 7 C C O41-- SHORT POLE C 10000 IF(PRSA.NE.RAISEW) GO TO 10100 !LIFT? I=749 !ASSUME UP. IF(POLEUF.EQ.2) I=750 !ALREADY UP? CALL RSPEAK(I) POLEUF=2 !POLE IS RAISED. RETURN C 10100 IF((PRSA.NE.LOWERW).AND.(PRSA.NE.PUSHW)) GO TO 10 IF(POLEUF.NE.0) GO TO 10200 !ALREADY LOWERED? CALL RSPEAK(751) !CANT DO IT. RETURN C 10200 IF(MOD(MDIR,180).NE.0) GO TO 10300 !MIRROR N-S? POLEUF=0 !YES, LOWER INTO CALL RSPEAK(752) !CHANNEL. RETURN C 10300 IF((MDIR.NE.270).OR.(MLOC.NE.MRB)) GO TO 10400 POLEUF=0 !LOWER INTO HOLE. CALL RSPEAK(753) RETURN C 10400 CALL RSPEAK(753+POLEUF) !POLEUF = 1 OR 2. POLEUF=1 !NOW ON FLOOR. RETURN C C O42-- MIRROR SWITCH C 11000 IF(PRSA.NE.PUSHW) GO TO 10 !PUSH? IF(MRPSHF) GO TO 11300 !ALREADY PUSHED? CALL RSPEAK(756) !BUTTON GOES IN. DO 11100 I=1,OLNT !BLOCKED? IF(QHERE(I,MREYE).AND.(I.NE.RBEAM)) GO TO 11200 11100 CONTINUE CALL RSPEAK(757) !NOTHING IN BEAM. RETURN C 11200 CFLAG(CEVMRS)=.TRUE. !MIRROR OPENS. CTICK(CEVMRS)=7 MRPSHF=.TRUE. MROPNF=.TRUE. RETURN C 11300 CALL RSPEAK(758) !MIRROR ALREADYOPEN. RETURN C NOBJS, PAGE 8 C C O43-- BEAM FUNCTION C 12000 IF((PRSA.NE.TAKEW).OR.(PRSO.NE.RBEAM)) GO TO 12100 CALL RSPEAK(759) !TAKE BEAM, JOKE. RETURN C 12100 I=PRSO !ASSUME BLK WITH DIROBJ. IF((PRSA.EQ.PUTW).AND.(PRSI.EQ.RBEAM)) GO TO 12200 IF((PRSA.NE.MUNGW).OR.(PRSO.NE.RBEAM).OR. 1 (PRSI.EQ.0)) GO TO 10 !BREAK BEAM WITH X? I=PRSI 12200 IF(OADV(I).NE.WINNER) GO TO 12300 !CARRYING? CALL NEWSTA(I,0,HERE,0,0) !DROP OBJ. CALL RSPSUB(760,ODESC2(I)) RETURN C 12300 J=761 !ASSUME NOT IN ROOM. IF(QHERE(J,HERE)) I=762 !IN ROOM? CALL RSPSUB(J,ODESC2(I)) !DESCRIBE. RETURN C C O44-- BRONZE DOOR C 13000 IF((HERE.EQ.NCELL).OR.((LCELL.EQ.4).AND. 1 ((HERE.EQ.CELL).OR.(HERE.EQ.SCORR)))) 2 GO TO 13100 CALL RSPEAK(763) !DOOR NOT THERE. RETURN C 13100 IF(.NOT.OPNCLS(ODOOR,764,765)) GO TO 10 !OPEN/CLOSE? IF((HERE.EQ.NCELL).AND.QOPEN(ODOOR)) 1 CALL RSPEAK(766) !DESCR VIEW. RETURN C C O45-- QUIZ DOOR C 14000 IF((PRSA.NE.OPENW).AND.(PRSA.NE.CLOSEW)) GO TO 14100 CALL RSPEAK(767) !DOOR WONT MOVE. RETURN C 14100 IF(PRSA.NE.KNOCKW) GO TO 10 !KNOCK? IF(INQSTF) GO TO 14200 !TRIED IT ALREADY? INQSTF=.TRUE. !START INQUISITION. CFLAG(CEVINQ)=.TRUE. CTICK(CEVINQ)=2 QUESNO=RND(8) !SELECT QUESTION. NQATT=0 CORRCT=0 CALL RSPEAK(768) !ANNOUNCE RULES. CALL RSPEAK(769) CALL RSPEAK(770+QUESNO) !ASK QUESTION. RETURN C 14200 CALL RSPEAK(798) !NO REPLY. RETURN C C O46-- LOCKED DOOR C 15000 IF(PRSA.NE.OPENW) GO TO 10 !OPEN? CALL RSPEAK(778) !CANT. RETURN C C O47-- CELL DOOR C 16000 NOBJS=OPNCLS(CDOOR,779,780) !OPEN/CLOSE? RETURN C NOBJS, PAGE 9 C C O48-- DIALBUTTON C 17000 IF(PRSA.NE.PUSHW) GO TO 10 !PUSH? CALL RSPEAK(809) !CLICK. IF(QOPEN(CDOOR)) CALL RSPEAK(810) !CLOSE CELL DOOR. C DO 17100 I=1,OLNT !RELOCATE OLD TO HYPER. IF((OROOM(I).EQ.CELL).AND.((OFLAG1(I).AND.DOORBT).EQ.0)) 1 CALL NEWSTA(I,0,LCELL*HFACTR,0,0) IF(OROOM(I).EQ.(PNUMB*HFACTR)) 1 CALL NEWSTA(I,0,CELL,0,0) !MOVE IN NEW HYPER. 17100 CONTINUE C OFLAG2(ODOOR)=OFLAG2(ODOOR).AND. .NOT.OPENBT OFLAG2(CDOOR)=OFLAG2(CDOOR).AND. .NOT.OPENBT OFLAG1(ODOOR)=OFLAG1(ODOOR).AND. .NOT.VISIBT IF(PNUMB.EQ.4) OFLAG1(ODOOR)=OFLAG1(ODOOR).OR.VISIBT C IF(AROOM(PLAYER).NE.CELL) GO TO 17400 !PLAYER IN CELL? IF(LCELL.NE.4) GO TO 17200 !IN RIGHT CELL? OFLAG1(ODOOR)=OFLAG1(ODOOR).OR. VISIBT F=MOVETO(NCELL,PLAYER) !YES, MOVETO NCELL. GO TO 17400 17200 F=MOVETO(PCELL,PLAYER) !NO, MOVETO PCELL. C 17400 LCELL=PNUMB RETURN C NOBJS, PAGE 10 C C O49-- DIAL INDICATOR C 18000 IF(PRSA.NE.SPINW) GO TO 18100 !SPIN? PNUMB=RND(8)+1 !WHEE! CALL RSPSUB(797,712+PNUMB) RETURN C 18100 IF((PRSA.NE.MOVEW).AND.(PRSA.NE.PUTW).AND. 1 (PRSA.NE.TRNTOW)) GO TO 10 IF(PRSI.NE.0) GO TO 18200 !TURN DIAL TO X? CALL RSPEAK(806) !MUST SPECIFY. RETURN C 18200 IF((PRSI.GE.NUM1).AND.(PRSI.LE.NUM8)) GO TO 18300 CALL RSPEAK(807) !MUST BE DIGIT. RETURN C 18300 PNUMB=PRSI-NUM1+1 !SET UP NEW. CALL RSPSUB(808,712+PNUMB) RETURN C C O50-- GLOBAL MIRROR C 19000 NOBJS=MIRPAN(832,.FALSE.) RETURN C C O51-- GLOBAL PANEL C 20000 IF(HERE.NE.FDOOR) GO TO 20100 !AT FRONT DOOR? IF((PRSA.NE.OPENW).AND.(PRSA.NE.CLOSEW)) GO TO 10 CALL RSPEAK(843) !PANEL IN DOOR, NOGO. RETURN C 20100 NOBJS=MIRPAN(838,.TRUE.) RETURN C C O52-- PUZZLE ROOM SLIT C 21000 IF((PRSA.NE.PUTW).OR.(PRSI.NE.CSLIT)) GO TO 10 IF(PRSO.NE.GCARD) GO TO 21100 !PUT CARD IN SLIT? CALL NEWSTA(PRSO,863,0,0,0) !KILL CARD. CPOUTF=.TRUE. !OPEN DOOR. OFLAG1(STLDR)=OFLAG1(STLDR).AND..NOT.VISIBT !VANISH DOOR. RETURN C 21100 IF(((OFLAG1(PRSO).AND.VICTBT).EQ.0).AND. 1 ((OFLAG2(PRSO).AND.VILLBT).EQ.0)) GO TO 21200 CALL RSPEAK(RND(5)+552) !JOKE FOR VILL, VICT. RETURN C 21200 CALL NEWSTA(PRSO,0,0,0,0) !KILL OBJECT. CALL RSPSUB(864,ODO2) !DESCRIBE. RETURN C END C MIRPAN-- PROCESSOR FOR GLOBAL MIRROR/PANEL C C DECLARATIONS C LOGICAL FUNCTION MIRPAN(ST,PNF) IMPLICIT INTEGER(A-Z) LOGICAL PNF C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG C C PARSER OUTPUT C LOGICAL PRSWON COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON C C VERBS C COMMON /VINDEX/ CINTW,DEADXW,FRSTQW,INXW,OUTXW COMMON /VINDEX/ WALKIW,FIGHTW,FOOW COMMON /VINDEX/ MELTW,READW,INFLAW,DEFLAW,ALARMW,EXORCW COMMON /VINDEX/ PLUGW,KICKW,WAVEW,RAISEW,LOWERW,RUBW COMMON /VINDEX/ PUSHW,UNTIEW,TIEW,TIEUPW,TURNW,BREATW COMMON /VINDEX/ KNOCKW,LOOKW,EXAMIW,SHAKEW,MOVEW,TRNONW,TRNOFW COMMON /VINDEX/ OPENW,CLOSEW,FINDW,WAITW,SPINW,BOARDW,UNBOAW,TAKEW COMMON /VINDEX/ INVENW,FILLW,EATW,DRINKW,BURNW COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW COMMON /VINDEX/ DIGW,LEAPW,STAYW,FOLLOW COMMON /VINDEX/ HELLOW,LOOKIW,LOOKUW,PUMPW,WINDW COMMON /VINDEX/ CLMBW,CLMBUW,CLMBDW,TRNTOW C C FLAGS C LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF, 1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF, 2 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF, 3 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF, 4 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF, 5 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF, 6 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF, 7 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ BTIEF,BINFF COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP COMMON /FINDEX/ MDIR,MLOC,POLEUF COMMON /FINDEX/ QUESNO,NQATT,CORRCT COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE C MIRPAN, PAGE 2 C MIRPAN=.TRUE. NUM=MRHERE(HERE) !GET MIRROR NUM. IF(NUM.NE.0) GO TO 100 !ANY HERE? CALL RSPEAK(ST) !NO, LOSE. RETURN C 100 MRBF=0 !ASSUME MIRROR OK. IF(((NUM.EQ.1).AND..NOT.MR1F).OR. 1 ((NUM.EQ.2).AND..NOT.MR2F)) MRBF=1 IF((PRSA.NE.MOVEW).AND.(PRSA.NE.OPENW)) GO TO 200 CALL RSPEAK(ST+1) !CANT OPEN OR MOVE. RETURN C 200 IF(PNF.OR.((PRSA.NE.LOOKIW).AND.(PRSA.NE.EXAMIW).AND. 1 (PRSA.NE.LOOKW))) GO TO 300 CALL RSPEAK(844+MRBF) !LOOK IN MIRROR. RETURN C 300 IF(PRSA.NE.MUNGW) GO TO 400 !BREAK? CALL RSPEAK(ST+2+MRBF) !DO IT. IF((NUM.EQ.1).AND..NOT.PNF) MR1F=.FALSE. IF((NUM.EQ.2).AND..NOT.PNF) MR2F=.FALSE. RETURN C 400 IF(PNF.OR.(MRBF.EQ.0)) GO TO 500 !BROKEN MIRROR? CALL RSPEAK(846) RETURN C 500 IF(PRSA.NE.PUSHW) GO TO 600 !PUSH? CALL RSPEAK(ST+3+NUM) RETURN C 600 MIRPAN=.FALSE. !CANT HANDLE IT. RETURN C END C RDLINE- READ INPUT LINE C C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED C WRITTEN BY R. M. SUPNIK C C DECLARATIONS C SUBROUTINE RDLINE(INBUF,INLNT,WHO) IMPLICIT INTEGER(A-Z) LOGICAL*1 INBUF(78) C C PARSER OUTPUT C LOGICAL PRSWON COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON C COMMON /CHAN/ INPCH,OUTCH,DBCH C 5 GO TO (90,10),WHO+1 !SEE WHO TO PROMPT FOR. 10 WRITE(OUTCH,50) !PROMPT FOR GAME. 50 FORMAT(' >',$) C 90 READ(INPCH,100) INBUF !GET INPUT. 100 FORMAT(78A1) C DO 200 INLNT=78,1,-1 IF(INBUF(INLNT).NE.' ') GO TO 300 !NOT BLANK? 200 CONTINUE GO TO 5 !TRY AGAIN. C 300 DO 400 I=1,INLNT !CONVERT TO UPPER CASE. IF((INBUF(I).GE.'a').AND.(INBUF(I).LE.'z')) 1 INBUF(I)=INBUF(I)-"40 400 CONTINUE PRSCON=1 !RESTART LEX SCAN. RETURN END C PARSE- TOP LEVEL PARSE ROUTINE C C DECLARATIONS C C THIS ROUTINE DETAILS ON BIT 0 OF PRSFLG C LOGICAL FUNCTION PARSE(INBUF,INLNT,VBFLAG) IMPLICIT INTEGER(A-Z) LOGICAL*1 INBUF(78) LOGICAL LEX,SYNMCH,DFLAG,VBFLAG INTEGER OUTBUF(40) COMMON /DEBUG/ DBGFLG,PRSFLG C C PARSER OUTPUT C LOGICAL PRSWON COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON COMMON /LAST/ LASTIT COMMON /XSRCH/ XMIN,XMAX,XDOWN,XUP, 1 XNORTH,XSOUTH,XENTER,XEXIT,XEAST,XWEST C D DFLAG=(PRSFLG.AND."1).NE.0 PARSE=.FALSE. !ASSUME FAILS. PRSA=0 !ZERO OUTPUTS. PRSI=0 PRSO=0 C IF(.NOT.LEX(INBUF,INLNT,OUTBUF,OUTLNT,VBFLAG)) GO TO 100 IF(SPARSE(OUTBUF,OUTLNT,VBFLAG)) 100,200,300 !DO SYN SCAN. C C PARSE REQUIRES VALIDATION C 200 IF(.NOT.VBFLAG) GO TO 350 !ECHO MODE, FORCE FAIL. IF(.NOT.SYNMCH(X)) GO TO 100 !DO SYN MATCH. IF((PRSO.GT.0).AND.(PRSO.LT.XMIN)) LASTIT=PRSO C C SUCCESSFUL PARSE OR SUCCESSFUL VALIDATION C 300 PARSE=.TRUE. 350 CALL ORPHAN(0,0,0,0,0) !CLEAR ORPHANS. D IF(DFLAG) TYPE 10,PARSE,PRSA,PRSO,PRSI D10 FORMAT(' PARSE RESULTS- ',L7,3I7) RETURN C C PARSE FAILS, DISALLOW CONTINUATION C 100 PRSCON=1 D IF(DFLAG) TYPE 10,PARSE,PRSA,PRSO,PRSI RETURN C END C ORPHAN- SET UP NEW ORPHANS C C DECLARATIONS C SUBROUTINE ORPHAN(O1,O2,O3,O4,O5) IMPLICIT INTEGER(A-Z) COMMON /ORPHS/ A,B,C,D,E C A=O1 !SET UP NEW ORPHANS. B=O2 C=O3 D=O4 E=O5 RETURN END C LEX- LEXICAL ANALYZER C C DECLARATIONS C C THIS ROUTINE DETAILS ON BIT 1 OF PRSFLAG C LOGICAL FUNCTION LEX(INBUF,INLNT,OUTBUF,OP,VBFLAG) IMPLICIT INTEGER(A-Z) LOGICAL*1 INBUF(78),J,DLIMIT(9) INTEGER OUTBUF(40) LOGICAL DFLAG,VBFLAG C C PARSER OUTPUT C LOGICAL PRSWON COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON C COMMON /DEBUG/ DBGFLG,PRSFLG C DATA DLIMIT/'A','Z',"100,'1','9',"22,'-','-',"22/ C DO 100 I=1,40 !CLEAR OUTPUT BUF. OUTBUF(I)=0 100 CONTINUE C D DFLAG=(PRSFLG.AND."2).NE.0 LEX=.FALSE. !ASSUME LEX FAILS. OP=-1 !OUTPUT PTR. 50 OP=OP+2 !ADV OUTPUT PTR. CP=0 !CHAR PTR=0. C 200 IF(PRSCON.GT.INLNT) GO TO 1000 !END OF INPUT? J=INBUF(PRSCON) !NO, GET CHARACTER, PRSCON=PRSCON+1 !ADVANCE PTR. IF(J.EQ.'.') GO TO 1000 !END OF COMMAND? IF(J.EQ.',') GO TO 1000 !END OF COMMAND? IF(J.EQ.' ') GO TO 6000 !SPACE? DO 500 I=1,9,3 !SCH FOR CHAR. IF((J.GE.DLIMIT(I)).AND.(J.LE.DLIMIT(I+1))) 1 GO TO 4000 500 CONTINUE C IF(VBFLAG) CALL RSPEAK(601) !GREEK TO ME, FAIL. RETURN C C END OF INPUT, SEE IF PARTIAL WORD AVAILABLE. C 1000 IF(PRSCON.GT.INLNT) PRSCON=1 !FORCE PARSE RESTART. IF((CP.EQ.0).AND.(OP.EQ.1)) RETURN !ANY RESULTS? IF(CP.EQ.0) OP=OP-2 !ANY LAST WORD? LEX=.TRUE. D IF(DFLAG) TYPE 10,CP,OP,PRSCON,(OUTBUF(I),I=1,OP+1) D10 FORMAT(' LEX RESULTS- ',3I7/1X,10O7) RETURN C C LEGITIMATE CHARACTERS: LETTER, DIGIT, OR HYPHEN. C 4000 J1=J-DLIMIT(I+2) !CVT TO R50. D IF(DFLAG) TYPE 20,J,J1,CP D20 FORMAT(' LEX- CHAR= ',3I7) IF(CP.GE.6) GO TO 200 !IGNORE IF TOO MANY CHAR. K=OP+(CP/3) !COMPUTE WORD INDEX. GO TO (4100,4200,4300),(MOD(CP,3)+1) !BRANCH ON CHAR. 4100 J2=J1*780 !CHAR 1... *780 OUTBUF(K)=OUTBUF(K)+J2+J2 !*1560 (40 ADDED BELOW). 4200 OUTBUF(K)=OUTBUF(K)+(J1*39) !*39 (1 ADDED BELOW). 4300 OUTBUF(K)=OUTBUF(K)+J1 !*1. CP=CP+1 GO TO 200 !GET NEXT CHAR. C C SPACE C 6000 IF(CP.EQ.0) GO TO 200 !ANY WORD YET? GO TO 50 !YES, ADV OP. C END C SPARSE- START OF PARSE C C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED C WRITTEN BY R. M. SUPNIK C C DECLARATIONS C C THIS ROUTINE DETAILS ON BIT 2 OF PRSFLG C INTEGER FUNCTION SPARSE(LBUF,LLNT,VBFLAG) IMPLICIT INTEGER(A-Z) INTEGER LBUF(40) LOGICAL LIT,QHERE,OTEST,DFLAG,VBFLAG C C PARSER OUTPUT C LOGICAL PRSWON COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON C C PARSER STATE C COMMON /ORPHS/ OFLAG,OACT,OSLOT,OPREP,ONAME COMMON /LAST/ LASTIT COMMON /PV/ ACT,O1,O2,P1,P2 INTEGER OBJVEC(2),PRPVEC(2) EQUIVALENCE (OBJVEC(1),O1),(PRPVEC(1),P1) C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG COMMON /DEBUG/ DBGFLG,PRSFLG C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OINDEX/ GARLI,FOOD,GUNK,COAL,MACHI,DIAMO,TCASE,BOTTL COMMON /OINDEX/ WATER,ROPE,KNIFE,SWORD,LAMP,BLAMP,RUG COMMON /OINDEX/ LEAVE,TROLL,AXE COMMON /OINDEX/ RKNIF,KEYS,ICE,BAR COMMON /OINDEX/ COFFI,TORCH,TBASK,FBASK,IRBOX COMMON /OINDEX/ GHOST,TRUNK,BELL,BOOK,CANDL COMMON /OINDEX/ MATCH,TUBE,PUTTY,WRENC,SCREW,CYCLO,CHALI COMMON /OINDEX/ THIEF,STILL,WINDO,GRATE,DOOR COMMON /OINDEX/ HPOLE,LEAK,RBUTT,RAILI COMMON /OINDEX/ POT,STATU,IBOAT,DBOAT,PUMP,RBOAT COMMON /OINDEX/ STICK,BUOY,SHOVE,BALLO,RECEP,GUANO COMMON /OINDEX/ BROPE,HOOK1,HOOK2,SAFE,SSLOT,BRICK,FUSE COMMON /OINDEX/ GNOME,BLABE,DBALL,TOMB COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE COMMON /OINDEX/ ROBOT,FTREE,BILLS,PORTR,SCOL,ZGNOM COMMON /OINDEX/ EGG,BEGG,BAUBL,CANAR,BCANA COMMON /OINDEX/ YLWAL,RDWAL,PINDR,RBEAM COMMON /OINDEX/ ODOOR,QDOOR,CDOOR,NUM1,NUM8 COMMON /OINDEX/ WARNI,CSLIT,GCARD,STLDR COMMON /OINDEX/ HANDS,WALL,LUNGS,SAILO,AVIAT,TEETH COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,WNORT,GWATE,MASTER C C ADVENTURERS C COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4), 1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4) C COMMON /AINDEX/ PLAYER,AROBOT,AMASTR C C VERBS C COMMON /VINDEX/ CINTW,DEADXW,FRSTQW,INXW,OUTXW COMMON /VINDEX/ WALKIW,FIGHTW,FOOW COMMON /VINDEX/ MELTW,READW,INFLAW,DEFLAW,ALARMW,EXORCW COMMON /VINDEX/ PLUGW,KICKW,WAVEW,RAISEW,LOWERW,RUBW COMMON /VINDEX/ PUSHW,UNTIEW,TIEW,TIEUPW,TURNW,BREATW COMMON /VINDEX/ KNOCKW,LOOKW,EXAMIW,SHAKEW,MOVEW,TRNONW,TRNOFW COMMON /VINDEX/ OPENW,CLOSEW,FINDW,WAITW,SPINW,BOARDW,UNBOAW,TAKEW COMMON /VINDEX/ INVENW,FILLW,EATW,DRINKW,BURNW COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW COMMON /VINDEX/ DIGW,LEAPW,STAYW,FOLLOW COMMON /VINDEX/ HELLOW,LOOKIW,LOOKUW,PUMPW,WINDW COMMON /VINDEX/ CLMBW,CLMBUW,CLMBDW,TRNTOW C SPARSE, PAGE 2 C C VOCABULARIES C COMMON /BUZVOC/ BVOC(20) COMMON /PRPVOC/ PVOC(45) COMMON /DIRVOC/ DVOC(75) INTEGER AVOC(450) COMMON /ADJVOC/ AVOC1(184),AVOC2(114),AVOC3(106),AVOCND INTEGER VVOC(950) COMMON /VRBVOC/ VVOC1(92),VVOC1A(108),VVOC1B(38),VVOC2(104), 1 VVOC3(136), 2 VVOC4(116),VVOC5(134),VVOC6(117),VVOC7(89),VVOCND INTEGER OVOC(1050) COMMON /OBJVOC/ OVOC1(159),OVOC2(144),OVOC3(150),OVOC4(128), 1 OVOC5(111),OVOC6(104),OVOC6A(97),OVOC7(127),OVOCND C EQUIVALENCE (VVOC(1),VVOC1(1)) EQUIVALENCE (AVOC(1),AVOC1(1)) EQUIVALENCE (OVOC(1),OVOC1(1)) C C FUNCTIONS AND DATA C OTEST(R)=(R.GT.0).AND.(R.LT.R50MIN) DATA R50MIN/1RA/,R50WAL/3RWAL/ C C BUZZ WORDS-- IGNORED IN SYNTACTIC PROCESSING C DATA BVOC/3RAND,0,2RBY,0,2RIS,0,1RA,0, 1 2RAN,0,3RTHE,0,3RRUN,0,2RGO,0,3RPRO,3RCEE,0,0/ C C PREPOSITIONS-- MAPS PREPOSITIONS TO INDICES C DATA PVOC/3ROVE,1RR,1,3RWIT,1RH,2,3RUSI,2RNG,2,3RTHR,3ROUG,2, 1 2RAT,0,3,2RTO,0,4,2RIN,0,5,3RINS,3RIDE,5,3RINT,1RO,5, 2 3RDOW,1RN,6,2RUP,0,7,3RUND,2RER,8,2ROF,0,9,2RON,0,10, 3 3ROFF,0,11/ C C DIRECTIONS-- MAPS DIRECTIONS TO INDICES C DATA DVOC/1RN,0,"2000,3RNOR,2RTH,"2000,1RS,0,"12000, 1 1RE,0,"6000,3REAS,1RT,"6000,1RW,0,"16000,3RWES,1RT,"16000, 2 2RSE,0,"10000,2RSW,0,"14000, 3 2RNE,0,"4000,2RNW,0,"20000, 4 1RU,0,"22000,2RUP,0,"22000,1RD,0,"24000,3RDOW,1RN,"24000, 5 3RLAU,3RNCH,"26000,3RLAN,1RD,"30000,3RENT,2RER,"32000, 6 3REXI,1RT,"34000,3ROUT,0,"34000,3RLEA,2RVE,"34000, 7 3RTRA,3RVEL,"36000,3RSOU,2RTH,"12000, 8 2RIN,0,"32000, 9 3RCRO,2RSS,"36000/ C SPARSE, PAGE 3 C C ADJECTIVES-- MAPS ADJECTIVES TO OBJECT NUMBERS C C EACH ENTRY IS VARIABLE LENGTH AND CONSISTS OF A TWO WORD C ADJECTIVE IN RADIX-50 FOLLOWED BY ONE OR MORE OBJECT NUMBERS. C NOTE THAT ADJECTIVES CAN BE DISTINGUISHED FROM OBJECTS AS C FOLLOWS-- ALL ADJECTIVES ARE .GE. 1RA (1600), WHILE ALL OBJECTS C ARE .LE. OLNT (255 MAX). C DATA AVOC1/3RBRO,2RWN,1,81,3RELO,3RNGA,1,3RHOT,0,3,3RPEP,3RPER,3, 1 3RVIT,3RREO,4,3RJAD,1RE,6,3RHUG,1RE,8,3RENO,3RRMO,8,122, 2 3RTRO,3RPHY,9,3RCLE,2RAR,10,3RLAR,2RGE,12,26,47,95,96,123, 2 133,135,146,147,150,176,3RNAS,2RTY,13,3RELV,3RISH,14, 2 3RBRA,2RSS,15,16,46,156, 3 3RBRO,3RKEN,16,22,92,113,155,158,3RORI,3RENT,17, 4 3RBLO,3RODY,20,3RRUS,2RTY,21,3RBUR,3RNED,22, 5 3RDEA,1RD,22,3ROLD,0,25,41,44,45,3RLEA,3RTHE,25, 5 3RPLA,3RTIN,26,3RPEA,2RRL,27, 6 3RMOB,1RY,31,3RCRY,3RSTA,32,126, 6 3RGOL,1RD,33,85,104,157,158,188, 7 3RIVO,2RRY,34,3RSAP,3RPHI,37,3RWOO,3RDEN,38,67,136,137, 7 165,173,174,175,3RWOO,1RD,38,67,136,137,165,173,174,175, 7 3RSTE,2REL,39,125,189, 8 3RDEN,3RTED,39,3RFAN,2RCY,40,3RANC,3RIEN,41,44, 9 3RSMA,2RLL,5,46,52,53,89,102,103,153,187, 1 3RBLA,2RCK,47,162,3RTOU,1RR,49, 2 3RVIS,3RCOU,55,3RVIC,3RIOU,62, 3 3RGLA,2RSS,10,126,132,3RTRA,1RP,66/ C DATA AVOC2/3RFRO,2RNT,68,3RSTO,2RNE,69,150,214,3RMAN,3RGLE,72, 1 3RRED,0,79,94,140,161,170,171,3RYEL,3RLOW,80,159, 1 3RBLU,1RE,82,112,114,141, 2 3RVAM,3RPIR,83,3RMAG,2RIC,90, 3 3RSEA,3RWOR,90,3RTAN,0,91,3RSHA,2RRP,92, 4 3RWIC,3RKER,98,3RCLO,2RTH,100, 5 3RBRA,3RIDE,101, 6 3RGAU,2RDY,108,3RSQU,3RARE,109,127,3RCLA,1RY,109, 7 3RSHI,2RNY,110,3RTHI,1RN,110, 8 3RGRE,2REN,115,143,3RPUR,3RPLE,116,3RWHI,2RTE,117,147,160, 9 3RMAR,3RBLE,119,3RCOK,1RE,121,3REMP,2RTY,121, 1 3RROU,2RND,128,3RTRI,3RANG,129, 2 3RRAR,1RE,134,3ROBL,3RONG,135,3REAT,3R$ME,138, 3 3REAT,2RME,138,3RORA,3RNGE,139,3RECC,1RH,141/ C DATA AVOC3/3RROC,2RKY,147,3RSHE,2RER,147, 1 3R200,0,148,3RNEA,1RT,148,3RSHI,3RMME,151, 2 3RZUR,3RICH,152,3RBIR,2RDS,153,154,155, 3 3RENC,3RRUS,154,155,3RBEA,3RUTI,156,3RCLO,3RCKW,157,158, 4 3RMEC,3RHAN,157,158, 5 3RMAH,3ROGA,163,3RPIN,1RE,164,3RLON,1RG,166, 6 3RCEN,3RTER,166,3RSHO,2RRT,167,1RT,0,168, 7 3RCOM,3RPAS,169,211,3RBRO,3RNZE,172,3RCEL,1RL,174,175, 8 3RLOC,3RKED,174,3RSUN,0,177, 8 3RBAR,1RE,200,3RSON,1RG,203, 5 3RNOR,2RTH,205,3RNOR,3RTHE,205,3RSOU,2RTH,206, 6 3RSOU,3RTHE,206,3REAS,1RT,207,3REAS,3RTER,207, 7 3RWES,1RT,208,3RWES,3RTER,208,3RDUN,3RGEO,215/ C DATA AVOCND/-1/ C SPARSE, PAGE 4 C C VERBS-- MAPS VERBS TO SYNTAX SLOTS C C EACH ENTRY IS VARIABLE LENGTH AND CONSISTS OF ONE OR MORE C TWO WORD VERBS IN RADIX-50 FOLLOWED BY A SYNTAX WORD COUNT C FOLLOWED BY ONE OR MORE SYNTAXES. NOTE THAT VERBS CAN BE C DISTINGUISHED FROM WORD COUNTS AS FOLLOWS-- C ALL VERBS ARE .GE. 1RA (1600), WHILE ALL SYNTAX WORD COUNTS C ARE .LE. 255. C C SYNTAX ENTRIES CONSIST OF A FLAG WORD FOLLOWED BY 0, 1, OR 2 C OBJECT DESCRIPTIONS. THE FLAG WORD HAS THE FOLLOWING FORMAT-- C C BIT <14> IF 1, SYNTAX INCLUDES DIRECT OBJECT C BIT <13> IF 1, SYNTAX INCLUDES INDIRECT OBJECT C BIT <12> IF 1, DIRECT OBJECT IS IMPLICIT (STANDARD FORM) C BIT <11> IF 1, DIRECT AND INDIRECT OBJECT MUST BE SWAPPED C AFTER SYNTAX PROCESSING C BIT <10> IF 1, THIS IS DEFAULT SYNTAX FOR ORPHANERY C BITS <8:0> VERB NUMBER FOR VAPPLI C C OBJECT DESCRIPTIONS CONSIST OF A FLAG WORD AND TWO FWIM WORDS. C THE FLAG WORD HAS THE FOLLOWING FORMAT-- C C BIT <14> IF 1, SEARCH ADVENTURER FOR OBJECT C BIT <13> IF 1, SEARCH ROOM FOR OBJECT C BIT <12> IF 1, PARSER WILL TRY TO TAKE OBJECT C BIT <11> IF 1, ADVENTURER MUST HAVE OBJECT C BIT <10> IF 1, QUALIFYING BITS (NORMALLY -1,-1) ARE SAME C AS FWIM BITS C BIT <9> IF 1, OBJECT MUST BE REACHABLE C BITS <8:0> PREPOSITION NUMBER FOR SYNMCH C C THE FWIM WORDS HAVE THE SAME FORMAT AS THE TWO OBJECT FLAG WORDS. C C NOTE THAT BITS 12 AND 11 OF OBJECT DESCRIPTIONS ACTUALLY HAVE C FOUR DISTINCT STATES-- C C BIT 12 BIT 11 MDLDESC INTERPRETATION C ------ ------ ------- --------------- C C 0 0 -- NO PARSER ACTION C 0 1 HAVE ADVENTURER MUST HAVE OBJECT C 1 0 TRY TRY TO TAKE, DONT CARE IF FAIL C 1 1 TAKE TRY TO TAKE, CARE IF FAIL C C SPARSE, PAGE 5 C DATA VVOC1/3RBRI,2REF,1,70,3RVER,3RBOS,1,71, 1 3RSUP,3RERB,1,72,3RSTA,1RY,1,73,3RVER,3RSIO,1,74, 2 3RSWI,1RM,3RBAT,2RHE,3RWAD,1RE,1,75,3RGER,3RONI,1,76, 2 3RULY,3RSSE,3RODY,3RSSE,1,77, 3 3RWEL,1RL,1,78,3RPRA,1RY,1,79,3RTRE,3RASU,1,80, 4 3RTEM,3RPLE,1,81,3RBLA,2RST,1,82,3RSCO,2RRE,1,83, 5 1RQ,0,3RQUI,1RT,1,84,3RHEL,1RP,1,40,3RINF,1RO,1,41, 6 3RHIS,3RTOR,3RUPD,3RATE,1,42,3RBAC,1RK,1,43, 6 3RSIG,1RH,3RMUM,3RBLE,1,44/ C DATA VVOC1A/3RCHO,2RMP,3RLOS,1RE,3RBAR,1RF,1,45, 7 3RDUN,3RGEO,1,46,3RFRO,3RBOZ,1,47,3RFOO,0,3RBLE,3RTCH, 8 3RBAR,0,1,48,3RREP,3RENT,1,49,3RHOU,1RS,3RSCH,3REDU,1,50, 9 3RWIN,0,1,51,3RYEL,1RL,3RSCR,3REAM,3RSHO,2RUT,1,52, 9 3RHOP,0,3RSKI,1RP,1,53,3RFUC,1RK,3RSHI,1RT,3RDAM,1RN, 1 3RCUR,2RSE,1,54,3RZOR,1RK,1,55,3RGRA,3RNIT,1,"50070, 2 3RSAV,1RE,1,149,3RRES,3RTOR,1,150,3RTIM,1RE,1,90, 3 3RDIA,3RGNO,1,94,3REXO,3RRCI,1,105,3RINV,3RENT, 4 1RI,0,1,133,3RWAI,1RT,1,128, 5 3RINC,3RANT,1,95,3RANS,3RWER,1,96/ C DATA VVOC1B/3RAGA,2RIN,1,57,3RNOO,2RBJ,1,58, 1 3RBUG,0,3RGRI,2RPE,3RCOM,3RPLA,1,59, 2 3RFEA,3RTUR,3RCOM,3RMEN,3RSUG,3RGES,3RIDE,1RA,1,60, 3 3RROO,1RM,1,65,3ROBJ,3RECT,1,66,3RRNA,2RME,1,67/ C DATA VVOC2/3RDEF,3RLAT,1,"50147, 1 3RDES,3RCRI,3RWHA,1RT,3REXA,3RMIN,1,"50170, 1 3RFIL,1RL,11,"60206,"61000,"200,0,"61002,"400,0, 1 "40206,"61000,"200,0, 1 3RFIN,1RD,3RSEE,1RK,3RWHE,2RRE,3RSEE,0,4,"40177,"60000,-1,-1, 1 3RFOL,3RLOW,2,"125,"50125, 2 3RKIC,1RK,3RBIT,1RE,3RTAU,2RNT,1,"50153,3RLOW,2RER,1,"50156, 3 3RPUS,1RH,3RPRE,2RSS,1,"50160,3RRIN,1RG,3RPEA,1RL,1,"50127, 4 3RRUB,0,3RCAR,3RESS,3RTOU,2RCH,3RFON,3RDLE,1,"50157, 4 3RSHA,2RKE,1,"50171,3RSPI,1RN,1,"50201, 5 3RUNT,2RIE,3RFRE,1RE,1,"50161,3RWAL,1RK,9,"50216, 5 "40126,"61002,-1,-1,"40126,"61005,-1,-1/ C DATA VVOC3/3RATT,3RACK,3RFIG,2RHT,3RINJ,3RURE,3RHIT,0,3RHUR,1RT, 1 7,"60215,"21000,0,"200,"44002,0,"1000, 2 3RBOA,2RRD,4,"40202,"21000,0,"2, 3 3RBRU,2RSH,3RCLE,2RAN,5,"52130,"70130,"61002,-1,-1, 4 3RBUR,1RN,3RIGN,3RITE,3RINC,3RINE,7,"60211,"61000,"20,0, 5 "64002,"10,0, 6 3RCLI,2RMB,12,"40235,"20007,0,"4000, 6 "40236,"20006,0,"4000,"40234,"20000,0,"4000, 6 3RCLO,2RSE,4,"40176,"61000,"10200,0, 7 3RDIG,0,4,"40131,"44002,"4,0, 8 3RDIS,3REMB,4,"40203,"20000,0,"2, 9 3RDRI,2RNK,3RIMB,3RIBE,3RSWA,3RLLO,4,"40210,"61000,"400,0, 1 3RDRO,1RP,3RREL,3REAS,11,"42221,"41000,-1,-1, 2 "60221,"41000,-1,-1,"61005,-1,-1, 3 3REAT,0,3RCON,3RSUM,3RGOB,3RBLE,3RMUN,2RCH,3RTAS,2RTE, 3 4,"40207,"75000,"2000,0, 4 3REXT,3RING,3RDOU,2RSE,4,"40174,"75000,"100,0/ C DATA VVOC4/3RGIV,1RE,3RHAN,1RD,3RDON,3RATE,11,"72222,"21004, 1 "40,0,"64222,"21000,"40,0,"61000,-1,-1, 2 3RHEL,2RLO,2RHI,0,2,"2227,"50227, 3 3RBLO,1RW,15,"62146,"61007,-1,-1,"61002,"4,0, 4 "40160,"61007,-1,-1,"40165,"61005,-1,-1, 5 3RINF,3RLAT,4,"70146,"61002,"4,0, 6 3RJUM,1RP,3RLEA,1RP,5,"133,"40133,"61001,-1,-1, 7 3RKIL,1RL,3RMUR,3RDER,3RSLA,1RY,3RSTA,1RB,3RDIS,3RPAT, 7 7,"60213,"21000,0,"200, 8 "44002,0,"1000, 9 3RKNO,2RCK,3RRAP,0,12,"42166,"61003,-1,-1, 1 "40166,"61012,-1,-1,"40215,"23006,"40,0, 2 3RLIG,2RHT,11,"42173,"75000,"100,0, 3 "60211,"61000,"100,0,"54002,"10,0, 4 3RLOC,1RK,4,"40134,"20000,-1,-1/ C DATA VVOC5/3RLOO,1RK,1RL,0,3RSTA,2RRE,3RGAZ,1RE, 1 13,"167,"40167,"60003,-1,-1, 1 "40231,"61010,-1,-1,"40230,"60005,-1,-1, 2 3RMEL,1RT,3RLIQ,3RUIF,4,"70145,"61002,"10,0, 3 3RMOV,1RE,4,"40172,"20000,-1,-1, 4 3RPUL,1RL,3RTUG,0,8,"42172,"21000,-1,-1, 5 "40172,"21012,-1,-1, 6 3RMUN,1RG,3RHAC,1RK,3RFRO,1RB,3RDAM,3RAGE, 6 5,"52212,"70212,"44002,-1,-1, 7 3ROPE,1RN,11,"42175,"61000,"10200,0, 7 "60175,"61000,"10200,0,"54002,"4,"1000, 8 3RPIC,1RK,4,"40204,"61007,"20000,"40, 9 3RPLU,1RG,3RGLU,1RE,3RPAT,2RCH,4,"70152,"61002,-1,-1, 1 3RPOK,1RE,3RBRE,2RAK,3RJAB,0,7,"60212,"21000,0,"200, 2 "44002,0,"1000, 3 3RPOU,1RR,3RSPI,2RLL,11,"42223,"42000,"400,0, 4 "60223,"42000,"400,0,"60005,-1,-1, 5 3RPUM,1RP,4,"60232,"60007,-1,-1/ C DATA VVOC6/3RPUT,0,3RINS,3RERT,3RSTU,2RFF,3RPLA,2RCE, 1 8,"72220,"61005,-1,-1, 1 "40221,"61006,-1,-1, 2 3RRAI,2RSE,3RLIF,1RT,5,"52155,"40155,"61007,-1,-1, 3 3RREA,1RD,3RSKI,1RM,11,"42144,"71000,"40000,0, 4 "60144,"71000,"40000,0,"61002,-1,-1, 5 3RSTR,3RIKE,12,"60215,"23000,"40,0, 6 "44002,0,"1000,"42215,"23000,"40,0,"50173, 7 3RSWI,2RNG,3RTHR,3RUST,7,"60214,"44000,0,"1000, 8 "21003,0,"200, 9 3RTAK,1RE,3RGET,0,3RHOL,1RD,3RCAR,2RRY,3RREM,3ROVE, 9 4,"40204,"61000,"20000,"40, 1 3RTEL,1RL,3RCOM,3RMAN,3RREQ,3RUES,4,"40217,"20000,0,"2000, 2 3RTHR,2ROW,3RHUR,1RL,3RCHU,2RCK,14,"60224,"44000,-1,-1, 3 "21003,"40,0,"60224,"44000,-1,-1,"21002,"40,0/ C DATA VVOC7/3RTIE,0,3RFAS,3RTEN,11,"70162,"61004,-1,-1, 1 "60163,"21000,"40,0,"65002,"4,0, 2 3RTUR,1RN,3RSET,0,22,"62164,"61000,"2,0, 3 "64002,"4,0, 4 "40173,"75012,"100,0,"40174,"75013,"100,0, 5 "60237,"61000,"2,0,"20004,-1,-1, 6 3RUNL,3ROCK,7,"60135,"21000,-1,-1, 7 "74002,"4,0, 8 3RWAK,1RE,3RSUR,3RPRI,3RALA,2RRM,3RSTA,3RRTL, 8 8,"42150,"20000,"40,0, 9 "40150,"20007,"40,0, 1 3RWAV,1RE,3RFLA,3RUNT,3RBRA,3RNDI,4,"40154,"40000,-1,-1, 2 3RWIN,1RD,5,"50233,"40233,"61007,-1,-1/ C DATA VVOCND/-1/ C SPARSE, PAGE 6 C C OBJECTS-- MAPS OBJECTS TO OBJECT INDICES C C SAME FORMAT AS AVOC. C DATA OVOC1/3RBAG,0,1,25,100,3RSAC,1RK,1,3RGAR,3RLIC,2, 1 3RCLO,2RVE,2,3RFOO,1RD,3,3RSAN,3RDWI,3,3RLUN,2RCH,3, 2 3RDIN,3RNER,3, 2 3RGUN,1RK,4,55,3RPIE,2RCE,4,143,186,3RSLA,1RG,4,3RCOA,1RL,5, 3 3RPIL,1RE,5,38,78,87,88,122,3RHEA,1RP,5, 3 3RFIG,3RURI,6, 4 3RMAC,3RHIN,7,3RPDP,2R10,7,3RPDP,2R11,7,3RDRY,2RER,7, 5 3RLID,0,7,3RDIA,3RMON,8,3RCAS,1RE,9,123,3RBOT,3RTLE,10,121, 6 3RCON,3RTAI,10,3RWAT,2RER,11,209,3RQUA,3RNTI,11,209, 6 3RLIQ,3RUID,11,209,3RH2O,0,11,209, 7 3RROP,1RE,12,101,3RHEM,1RP,12,3RCOI,1RL,12,110, 8 3RKNI,2RFE,13,21,3RBLA,2RDE,13,14,3RSWO,2RRD,14,3RORC,3RHRI,14, 9 3RGLA,3RMDR,14,3RLAM,1RP,15,16,22,3RLAN,3RTER,15,16,22, 1 3RRUG,0,17,3RCAR,3RPET,17, 2 3RLEA,3RVES,18,3RLEA,1RF,18,3RTRO,2RLL,19, 3 3RAXE,0,20,3RDIN,3RNER,3/ C DATA OVOC2/3RKEY,1RS,23,3RKEY,0,23, 1 3RSET,0,23,3RBON,2RES,24,3RSKE,3RLET,24,3RBOD,1RY,24,73, 2 3RCOI,2RNS,25,3RBAR,0,26,165,168, 3 3RNEC,3RKLA,27,3RPEA,3RRLS,27,3RMIR,3RROR,28,29,212, 4 3RICE,0,30,3RMAS,1RS,30,3RGLA,3RCIE,30,3RRUB,1RY,31, 5 3RTRI,3RDEN,32,3RFOR,1RK,32,3RCOF,3RFIN,33,3RCAS,3RKET,33, 6 3RTOR,2RCH,34,3RCAG,1RE,35,36,124,125,3RDUM,3RBWA,35,36, 7 3RBAS,3RKET,35,36,98,113,3RBRA,3RCEL,37, 8 3RJEW,2REL,37,3RTIM,3RBER,38,3RBOX,0,39,53,105,3RSTR,3RADI,40, 9 3RVIO,3RLIN,40,3RENG,3RRAV,41,3RINS,3RCRI,41,44,3RGHO,2RST,42, 1 3RSPI,3RRIT,42,3RFIE,2RND,42,3RGRA,2RIL,43,3RPRA,3RYER,44,47, 2 3RTRU,2RNK,45,3RCHE,2RST,45,3RBEL,1RL,46, 3 3RBOO,1RK,47,49,114,115,116,117,3RBIB,2RLE,47/ C DATA OVOC3/3RGOO,3RDBO,47,3RCAN,3RDLE,48,3RPAI,1RR,48, 1 3RGUI,3RDEB,49, 1 3RGUI,2RDE,49,3RPAP,2RER,50,122,143,186,3RNEW,3RSPA,50, 2 3RISS,2RUE,50,3RREP,3RORT,50,3RMAG,3RAZI,50,3RNEW,1RS,50, 3 3RMAT,3RCHB,51, 3 3RMAT,2RCH,51,3RMAT,3RCHE,51,3RADV,3RERT,52,3RPAM,3RPHL,52, 4 3RLEA,3RFLE,52,3RBOO,3RKLE,52,3RMAI,3RLBO,53, 5 3RTUB,1RE,54,3RTOO,3RTHP,54,3RPUT,2RTY,55,3RMAT,3RERI,55, 6 3RGLU,1RE,55,3RWRE,3RNCH,56,3RSCR,3REWD,57, 7 3RCYC,3RLOP,58,3RMON,3RSTE,58,3RCHA,3RLIC,59,3RCUP,0,59, 8 3RGOB,3RLET,59,3RPAI,3RNTI,60,149,3RART,0,60,149, 8 3RCAN,3RVAS,60,3RPIC,3RTUR,60,3RWOR,1RK,60, 9 3RMAS,3RTER,60,215,3RTHI,2REF,61,3RROB,3RBER,61, 1 3RCRI,3RMIN,61,3RBAN,3RDIT,61,3RCRO,2ROK,61,3RGEN,1RT,61, 2 3RGEN,3RTLE,61,3RMAN,0,61,3RTHU,1RG,61, 3 3RBAG,3RMAN,61,3RSTI,3RLLE,62/ C DATA OVOC4/3RWIN,3RDOW,63,3RBOL,1RT,64,3RNUT,0,64, 1 3RGRA,2RTE,65,3RGRA,3RTIN,65,3RDOO,1RR,66,67,68,69, 1 164,172,173,174,175,189,3RTRA,3RPDO,66, 2 3RTRA,3RP$D,66,3RSWI,3RTCH,70,76,79,80,81,82,170, 3 3RHEA,1RD,71,120,3RCOR,3RPSE,72,73,3RBOD,3RIES,73, 4 3RDAM,0,74,3RGAT,2RES,74,76,3RGAT,1RE,74,76, 5 3RFCD,0,74,3RRAI,1RL,75,3RRAI,3RLIN,75, 5 3RBUT,3RTON,76,79,80,81,82,127,128,129,170,176, 6 3RBUB,3RBLE,77,3RLEA,1RK,78,3RDRI,1RP,78, 7 3RHOL,1RE,78,107, 9 3RBAT,0,83,3RRAI,3RNBO,84, 1 3RPOT,0,85,3RSTA,3RTUE,86,3RSCU,3RLPT,86,3RROC,1RK,86, 2 3RBOA,1RT,87,88,90,3RPLA,3RSTI,87,88, 3 3RPUM,1RP,89/ C DATA OVOC5/3RAIR,3RPUM,89,3RAIR,3R$PU,89,3RLAB,2REL,91,112, 1 3RFIN,3REPR,91,3RSTI,2RCK,92,3RBAR,3RREL,93,3RBUO,1RY,94, 2 3REME,3RRAL,95,3RSHO,3RVEL,96,3RGUA,2RNO,97,3RCRA,1RP,97, 3 3RSHI,1RT,97,3RHUN,1RK,97,3RBAL,3RLOO,98,113, 4 3RREC,3REPT,99,3RWIR,1RE,101,110, 5 3RHOO,1RK,102,103,3RZOR,3RKMI,104,148,3RCOI,1RN,104, 6 3RSAF,1RE,105,3RCAR,1RD,106,188,3RNOT,1RE,106,186, 7 3RSLO,1RT,107,187,3RCRO,2RWN,108,3RBRI,2RCK,109, 8 3RFUS,1RE,110,3RGNO,2RME,111,152, 1 3RSTA,2RMP,118, 2 3RTOM,1RB,119,3RCRY,2RPT,119,3RGRA,2RVE,119,3RHEA,2RDS,120, 3 3RPOL,2RES,120,3RIMP,3RLEM,120/ C DATA OVOC6/3RLOS,3RERS,120,3RCOK,2RES,121, 1 3RLIS,3RTIN,122,3RSTA,2RCK,122, 2 3RPRI,3RNTO,122, 3 3RSPH,3RERE,126,3RBAL,1RL,126, 4 3RETC,3RHIN,130,131, 5 3RWAL,2RLS,130,131,198,205,206,207,208,3RWAL,1RL, 5 130,131,159,160,161,162,163,164,198,205,206,207,208, 6 3RFLA,2RSK,132,3RPOO,1RL,133,3RSEW,3RAGE,133, 7 3RTIN,0,134,3RSAF,3RFRO,134,3RSPI,3RCES,134,3RTAB,2RLE,135, 8 3RPOS,1RT,136,166,167,3RPOS,2RTS,136,3RBUC,3RKET,137, 9 3RCAK,1RE,138,139,140,141,3RICI,2RNG,139,140,141, 1 3RROB,2ROT,142,3RROB,2RBY,142, 2 3RC3P,1RO,142,3RR2D,1R2,142/ C DATA OVOC6A/3RPAN,2REL,159,160,161,162,163,164,213, 1 3RPOL,1RE,166,167,3RTBA,1RR,168,3RT$B,2RAR,168, 2 3RARR,2ROW,169,3RPOI,2RNT,169,3RBEA,1RM,171, 3 3RDIA,1RL,177,3RSUN,3RDIA,177,1R1,0,178, 4 3RONE,0,178,1R2,0,179,3RTWO,0,179,1R3,0,180, 5 3RTHR,2REE,180,1R4,0,181,3RFOU,1RR,181,1R5,0,182, 6 3RFIV,1RE,182,1R6,0,183,3RSIX,0,183,1R7,0,184, 7 3RSEV,2REN,184,1R8,0,185,3REIG,2RHT,185, 8 3RWAR,3RNIN,186,3RSLI,1RT,187, 3 2RIT,0,192,3RTHA,1RT,192,3RTHI,1RS,192/ C DATA OVOC7/2RME,0,193,3RMYS,3RELF,193,3RCRE,3RTIN,193, 1 3RALL,0,194,3REVE,3RRYT,194, 1 3RTRE,3RASU,195,3RVAL,3RUAB,195,3RSAI,3RLOR,196,3RTEE,2RTH,197, 2 3RGRU,1RE,199,3RHAN,1RD,200,3RHAN,2RDS,200, 3 3RLUN,2RGS,201,3RAIR,0,201,3RAVI,3RATO,202, 4 3RFLY,2RER,202,3RTRE,1RE,144,145,204, 5 3RCLI,2RFF,146,147,3RLED,2RGE,146,147,3RPOR,3RTRA,149, 6 3RSTA,2RCK,148,3RBIL,2RLS,148, 6 3RVAU,2RLT,150,3RCUB,1RE,150,3RLET,3RTER,67,150, 7 3RCUR,3RTAI,151,3RLIG,2RHT,151,3RNES,1RT,153, 8 3REGG,0,154,155,3RBAU,3RBLE,156,3RCAN,3RARY,157,158, 9 3RBIR,1RD,203,3RSON,3RGBI,203, 1 3RGUA,2RRD,210,3RGUA,3RRDI,210,3RROS,1RE,211, 2 3RSTR,3RUCT,212,3RCHA,3RNNE,214, 3 3RKEE,3RPER,215,3RLAD,3RDER,216/ C DATA OVOCND/-1/ C SPARSE, PAGE 7 C C SET UP FOR PARSING C SPARSE=-1 !ASSUME PARSE FAILS. ADJ=0 !CLEAR PARTS HOLDERS. ACT=0 PREP=0 PPTR=0 O1=0 O2=0 P1=0 P2=0 D DFLAG=(PRSFLG.AND."4).NE.0 C BUZLNT=20 PRPLNT=48 DIRLNT=75 C SPARSE, PAGE 8 C C NOW LOOP OVER INPUT BUFFER OF LEXICAL TOKENS. C DO 1000 I=1,LLNT,2 !TWO WORDS/TOKEN. LBUF1=LBUF(I) !GET CURRENT TOKEN. LBUF2=LBUF(I+1) IF(LBUF1.EQ.0) GO TO 1500 !END OF BUFFER? C C CHECK FOR BUZZ WORD C DO 50 J=1,BUZLNT,2 IF((LBUF1.EQ.BVOC(J)).AND.(LBUF2.EQ.BVOC(J+1))) 1 GO TO 1000 !IGNORE BUZZ WORDS. 50 CONTINUE C C CHECK FOR ACTION OR DIRECTION C IF(ACT.NE.0) GO TO 75 !GOT ACTION ALREADY? J=1 !CHECK FOR ACTION. 125 IF((LBUF1.EQ.VVOC(J)).AND.(LBUF2.EQ.VVOC(J+1))) 1 GO TO 3000 150 J=J+2 !ADV TO NEXT SYNONYM. IF(.NOT.OTEST(VVOC(J))) GO TO 125 !ANOTHER VERB? J=J+VVOC(J)+1 !NO, ADVANCE OVER SYNTAX. IF(VVOC(J).NE.-1) GO TO 125 !TABLE DONE? C 75 IF((ACT.NE.0).AND.((VVOC(ACT).NE.R50WAL).OR. 1 (PREP.NE.0))) GO TO 200 !NO ACTION OR WALK? DO 100 J=1,DIRLNT,3 !THEN CHK FOR DIR. IF((LBUF1.EQ.DVOC(J)).AND.(LBUF2.EQ.DVOC(J+1))) 1 GO TO 2000 100 CONTINUE C C NOT AN ACTION, CHECK FOR PREPOSITION, ADJECTIVE, OR OBJECT. C 200 DO 250 J=1,PRPLNT,3 !LOOK FOR PREPOSITION. IF((LBUF1.EQ.PVOC(J)).AND.(LBUF2.EQ.PVOC(J+1))) 1 GO TO 4000 250 CONTINUE C J=1 !LOOK FOR ADJECTIVE. 300 IF((LBUF1.EQ.AVOC(J)).AND.(LBUF2.EQ.AVOC(J+1))) 1 GO TO 5000 J=J+1 325 J=J+1 !ADVANCE TO NEXT ENTRY. IF(OTEST(AVOC(J))) GO TO 325 !A RADIX 50 CONSTANT? IF(AVOC(J).NE.-1) GO TO 300 !POSSIBLY, END TABLE? C J=1 !LOOK FOR OBJECT. 450 IF((LBUF1.EQ.OVOC(J)).AND.(LBUF2.EQ.OVOC(J+1))) 1 GO TO 600 J=J+1 500 J=J+1 IF(OTEST(OVOC(J))) GO TO 500 IF(OVOC(J).NE.-1) GO TO 450 C C NOT RECOGNIZABLE C IF(VBFLAG) CALL RSPEAK(601) RETURN C SPARSE, PAGE 9 C C OBJECT PROCESSING (CONTINUATION OF DO LOOP ON PREV PAGE) C 600 OBJ=GETOBJ(J,ADJ,0) !IDENTIFY OBJECT. D IF(DFLAG) TYPE 60,J,OBJ D60 FORMAT(' SPARSE- OBJ AT ',I6,' OBJ= ',I6) IF(OBJ.LE.0) GO TO 6000 !IF LE, COULDNT. IF(OBJ.NE.ITOBJ) GO TO 650 !"IT"? OBJ=GETOBJ(0,0,LASTIT) !FIND LAST. IF(OBJ.LE.0) GO TO 6000 !IF LE, COULDNT. C 650 IF(PREP.EQ.9) GO TO 8000 !"OF" OBJ? IF(PPTR.EQ.2) GO TO 7000 !TOO MANY OBJS? PPTR=PPTR+1 OBJVEC(PPTR)=OBJ !STUFF INTO VECTOR. PRPVEC(PPTR)=PREP 700 PREP=0 ADJ=0 1000 CONTINUE !AT LAST. C C NOW SOME MISC CLEANUP C 1500 IF(ACT.EQ.0) ACT=OFLAG.AND.OACT !IF NO ACT, STEAL ORPHAN. IF(ACT.EQ.0) GO TO 9000 !IF STILL NONE, PUNT. IF(ADJ.NE.0) GO TO 10000 !IF DANGLING ADJ, PUNT. C IF((OFLAG.NE.0).AND.(OPREP.NE.0).AND.(PREP.EQ.0).AND. 1 (O1.NE.0).AND.(O2.EQ.0).AND.(ACT.EQ.OACT)) 2 GO TO 11000 C SPARSE=0 !PARSE SUCCEEDS. IF(PREP.EQ.0) GO TO 1750 !IF DANGLING PREP, IF((PPTR.EQ.0).OR.(PRPVEC(PPTR).NE.0)) 1 GO TO 12000 !AND HAVE 'PICK FROB UP', PRPVEC(PPTR)=PREP !CVT TO 'PICK UP FROB'. 1750 CONTINUE !WIN. D IF(DFLAG) TYPE 70,ACT,O1,O2,P1,P2 D70 FORMAT(' SPARSE RESULTS- ',5I7) RETURN C SPARSE, PAGE 10 C C SPECIAL PARSE PROCESSORS C C 2000-- DIRECTION C 2000 PRSA=WALKW !VERB IS WALK. PRSO=DVOC(J+2) !GET DIRECTION. SPARSE=1 !WIN TOTALLY. D IF(DFLAG) TYPE 10,J D10 FORMAT(' SPARSE- DIR AT ',I6) RETURN C C 3000-- ACTION C 3000 ACT=J !SAVE INDEX TO VERB. OACT=0 !NO ORPHAN. D IF(DFLAG) TYPE 20,J D20 FORMAT(' SPARSE- ACT AT ',I6) GO TO 1000 !DONE. C C 4000-- PREPOSITION C 4000 IF(PREP.NE.0) GO TO 4500 !ALREADY HAVE ONE? PREP=PVOC(J+2) !NO, GET INDEX. ADJ=0 !NO ADJECTIVE. D IF(DFLAG) TYPE 30,J D30 FORMAT(' SPARSE- PREP AT ',I6) GO TO 1000 C 4500 IF(VBFLAG) CALL RSPEAK(616) !YES, GAG AND LOSE. RETURN C C 5000-- ADJECTIVE C 5000 ADJ=J !SAVE ADJECTIVE. J=ONAME.AND.OFLAG D IF(DFLAG) TYPE 40,ADJ,J D40 FORMAT(' SPARSE- ADJ AT ',I6,' ORPHAN= ',I6) IF((J.NE.0).AND.(I.GE.LLNT)) GO TO 600 GO TO 1000 C C 6000-- UNIDENTIFIABLE OBJECT (INDEX INTO OVOC IS J) C 6000 IF(OBJ.LT.0) GO TO 6100 !IF LT, AMBIGUOUS. I=579 !NOT HERE OR IF(LIT(HERE)) I=618 !NOT LIT. IF(VBFLAG) CALL RSPEAK(I) RETURN !LOSE. C 6100 IF(OBJ.NE.-10000) GO TO 6200 !INSIDE VEHICLE? IF(VBFLAG) CALL RSPSUB(620,ODESC2(AVEHIC(WINNER))) RETURN C 6200 IF(VBFLAG) CALL RSPEAK(619) !CANT DISTINGUISH. IF(ACT.EQ.0) ACT=OFLAG.AND.OACT !IF NO ACT, GET ORPHAN. CALL ORPHAN(-1,ACT,O1,PREP,J) !ORPHAN THE WORLD. RETURN C C 7000-- TOO MANY OBJECTS. C 7000 IF(VBFLAG) CALL RSPEAK(617) RETURN C C 8000-- RANDOMNESS FOR "OF" WORDS C 8000 IF(OBJVEC(PPTR).EQ.OBJ) GO TO 700 !IGNORE IF OK. IF(VBFLAG) CALL RSPEAK(601) RETURN C C 9000-- NO ACTION, PUNT C 9000 IF(O1.EQ.0) GO TO 10000 !ANY DIRECT OBJECT? IF(VBFLAG) CALL RSPSUB(621,ODESC2(O1)) !WHAT TO DO? CALL ORPHAN(-1,0,O1,0,0) RETURN C C 10000-- TOTAL CHOMP C 10000 IF(VBFLAG) CALL RSPEAK(622) !HUH? RETURN C C 11000-- ORPHAN PREPOSITION. CONDITIONS ARE C O1.NE.0, O2=0, PREP=0, ACT=OACT C 11000 IF(OSLOT.NE.0) GO TO 11500 !ORPHAN OBJECT? P1=OPREP !NO, JUST USE PREP. GO TO 1750 C 11500 O2=O1 !YES, USE AS DIRECT OBJ. P2=OPREP O1=OSLOT P1=0 GO TO 1750 C C 12000-- TRUE HANGING PREPOSITION. C ORPHAN FOR LATER. C 12000 CALL ORPHAN(-1,ACT,0,PREP,0) !ORPHAN PREP. GO TO 1750 C END C GETOBJ-- FIND OBJ DESCRIBED BY ADJ, NAME PAIR C C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED C WRITTEN BY R. M. SUPNIK C C DECLARATIONS C C THIS ROUTINE DETAILS ON BIT 3 OF PRSFLG C INTEGER FUNCTION GETOBJ(OIDX,AIDX,SPCOBJ) IMPLICIT INTEGER(A-Z) LOGICAL THISIT,GHERE,LIT,CHOMP,DFLAG C COMMON /OBJFLG/ VABIT,VRBIT,VTBIT,VCBIT,VEBIT,VFBIT,VPMASK C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG C C MISCELLANEOUS VARIABLES C COMMON /STAR/ MBASE,STRBIT COMMON /DEBUG/ DBGFLG,PRSFLG C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT, 1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT, 2 TOOLBT,TURNBT,ONBT COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT, 1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT, 2 TCHBT,VEHBT,SCHBT C C ADVENTURERS C COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4), 1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4) C C VOCABULARIES C COMMON /OBJVOC/ OVOC(1050) C GETOBJ, PAGE 2 C D DFLAG=(PRSFLG.AND."10).NE.0 CHOMP=.FALSE. AV=AVEHIC(WINNER) OBJ=0 !ASSUME DARK. IF(.NOT.LIT(HERE)) GO TO 200 !LIT? C OBJ=SCHLST(OIDX,AIDX,HERE,0,0,SPCOBJ) !SEARCH ROOM. D IF(DFLAG) TYPE 10,OBJ D10 FORMAT(' SCHLST- ROOM SCH ',I6) IF(OBJ) 1000,200,100 !TEST RESULT. 100 IF((AV.EQ.0).OR.(AV.EQ.OBJ).OR. 1 ((OFLAG2(OBJ).AND.FINDBT).NE.0)) GO TO 200 IF(OCAN(OBJ).EQ.AV) GO TO 200 !TEST IF REACHABLE. CHOMP=.TRUE. !PROBABLY NOT. C 200 IF(AV.EQ.0) GO TO 400 !IN VEHICLE? NOBJ=SCHLST(OIDX,AIDX,0,AV,0,SPCOBJ) !SEARCH VEHICLE. D IF(DFLAG) TYPE 20,NOBJ D20 FORMAT(' SCHLST- VEH SCH ',I6) IF(NOBJ) 1100,400,300 !TEST RESULT. 300 CHOMP=.FALSE. !REACHABLE. IF(OBJ.EQ.NOBJ) GO TO 400 !SAME AS BEFORE? IF(OBJ.NE.0) NOBJ=-NOBJ !AMB RESULT? OBJ=NOBJ C 400 NOBJ=SCHLST(OIDX,AIDX,0,0,WINNER,SPCOBJ) !SEARCH ADVENTURER. D IF(DFLAG) TYPE 30,NOBJ D30 FORMAT(' SCHLST- ADV SCH ',I6) IF(NOBJ) 1100,600,500 !TEST RESULT 500 IF(OBJ.NE.0) NOBJ=-NOBJ !AMB RESULT? 1100 OBJ=NOBJ !RETURN NEW OBJECT. 600 IF(CHOMP) OBJ=-10000 !UNREACHABLE. 1000 GETOBJ=OBJ C IF(GETOBJ.NE.0) GO TO 1500 !GOT SOMETHING? DO 1200 I=STRBIT+1,OLNT !NO, SEARCH GLOBALS. IF(.NOT.THISIT(OIDX,AIDX,I,SPCOBJ)) GO TO 1200 IF(.NOT.GHERE(I,HERE)) GO TO 1200 !CAN IT BE HERE? IF(GETOBJ.NE.0) GETOBJ=-I !AMB MATCH? IF(GETOBJ.EQ.0) GETOBJ=I 1200 CONTINUE C 1500 CONTINUE !END OF SEARCH. D IF(DFLAG) TYPE 40,GETOBJ D40 FORMAT(' SCHLST- RESULT ',I6) RETURN END C SCHLST-- SEARCH FOR OBJECT C C DECLARATIONS C INTEGER FUNCTION SCHLST(OIDX,AIDX,RM,CN,AD,SPCOBJ) IMPLICIT INTEGER(A-Z) LOGICAL THISIT,QHERE,NOTRAN,NOVIS C COMMON /STAR/ MBASE,STRBIT C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT, 1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT, 2 TOOLBT,TURNBT,ONBT COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT, 1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT, 2 TCHBT,VEHBT,SCHBT C C FUNCTIONS AND DATA C NOTRAN(O)=((OFLAG1(O).AND.TRANBT).EQ.0).AND. 1 ((OFLAG2(O).AND.OPENBT).EQ.0) NOVIS(O)=((OFLAG1(O).AND.VISIBT).EQ.0) C SCHLST=0 !NO RESULT. DO 1000 I=1,OLNT !SEARCH OBJECTS. IF(NOVIS(I).OR. 1 (((RM.EQ.0).OR.(.NOT.QHERE(I,RM))).AND. 2 ((CN.EQ.0).OR.(OCAN(I).NE.CN)).AND. 3 ((AD.EQ.0).OR.(OADV(I).NE.AD)))) GO TO 1000 IF(.NOT.THISIT(OIDX,AIDX,I,SPCOBJ)) GO TO 200 IF(SCHLST.NE.0) GO TO 2000 !GOT ONE ALREADY? SCHLST=I !NO. C C IF OPEN OR TRANSPARENT, SEARCH THE OBJECT ITSELF. C 200 IF(NOTRAN(I)) GO TO 1000 C C SEARCH IS CONDUCTED IN REVERSE. ALL OBJECTS ARE CHECKED TO C SEE IF THEY ARE AT SOME LEVEL OF CONTAINMENT INSIDE OBJECT 'I'. C IF THEY ARE AT LEVEL 1, OR IF ALL LINKS IN THE CONTAINMENT C CHAIN ARE OPEN, VISIBLE, AND HAVE SEARCHME SET, THEY CAN QUALIFY C AS A POTENTIAL MATCH. C DO 500 J=1,OLNT !SEARCH OBJECTS. IF(NOVIS(J).OR. (.NOT.THISIT(OIDX,AIDX,J,SPCOBJ))) 1 GO TO 500 !VISIBLE & MATCH? X=OCAN(J) !GET CONTAINER. 300 IF(X.EQ.I) GO TO 400 !INSIDE TARGET? IF(X.EQ.0) GO TO 500 !INSIDE ANYTHING? IF(NOVIS(X).OR.NOTRAN(X).OR. 1 ((OFLAG2(X).AND.SCHBT).EQ.0)) GO TO 500 X=OCAN(X) !GO ANOTHER LEVEL. GO TO 300 C 400 IF(SCHLST.NE.0) GO TO 2000 !ALREADY GOT ONE? SCHLST=J !NO. 500 CONTINUE C 1000 CONTINUE RETURN C 2000 SCHLST=-SCHLST !AMB RETURN. RETURN C END C THISIT-- VALIDATE OBJECT VS DESCRIPTION C C DECLARATIONS C LOGICAL FUNCTION THISIT(OIDX,AIDX,OBJ,SPCOBJ) IMPLICIT INTEGER(A-Z) LOGICAL NOTEST C C VOCABULARIES C COMMON /OBJVOC/ OVOC(1050) COMMON /ADJVOC/ AVOC(450) C C FUNCTIONS AND DATA C NOTEST(O)=(O.LE.0).OR.(O.GE.R50MIN) DATA R50MIN/1RA/ C THISIT=.FALSE. !ASSUME NO MATCH. IF((SPCOBJ.NE.0).AND.(OBJ.EQ.SPCOBJ)) GO TO 500 C C CHECK FOR OBJECT NAMES C I=OIDX+1 100 I=I+1 IF(NOTEST(OVOC(I))) RETURN !IF DONE, LOSE. IF(OVOC(I).NE.OBJ) GO TO 100 !IF FAIL, CONT. C IF(AIDX.EQ.0) GO TO 500 !ANY ADJ? I=AIDX+1 200 I=I+1 IF(NOTEST(AVOC(I))) RETURN !IF DONE, LOSE. IF(AVOC(I).NE.OBJ) GO TO 200 !IF FAIL, CONT. C 500 THISIT=.TRUE. RETURN END C SYNMCH-- SYNTAX MATCHER C C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED C WRITTEN BY R. M. SUPNIK C C DECLARATIONS C C THIS ROUTINE DETAILS ON BIT 4 OF PRSFLG C LOGICAL FUNCTION SYNMCH IMPLICIT INTEGER(A-Z) LOGICAL SYNEQL,TAKEIT,DFLAG C C PARSER OUTPUT C LOGICAL PRSWON COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON C COMMON /DEBUG/ DBGFLG,PRSFLG C COMMON /ORPHS/ OFLAG,OACT,OSLOT,OPREP,ONAME COMMON /PV/ ACT,O1,O2,P1,P2 COMMON /SYNTAX/VFLAG,DOBJ,DFL1,DFL2,DFW1,DFW2, 1 IOBJ,IFL1,IFL2,IFW1,IFW2 COMMON /VRBVOC/ VVOC(950) COMMON /SYNFLG/ SDIR,SIND,SSTD,SFLIP,SDRIV,SVMASK COMMON /OBJFLG/ VABIT,VRBIT,VTBIT,VCBIT,VEBIT,VFBIT,VPMASK DATA R50MIN/1RA/ C SYNMCH=.FALSE. D DFLAG=(PRSFLG.AND."20).NE.0 J=ACT !SET UP PTR TO SYNTAX. DRIVE=0 !NO DEFAULT. DFORCE=0 !NO FORCED DEFAULT. QPREP=OFLAG.AND.OPREP !VALID ORPHAN PREP FLAG. 100 J=J+2 !FIND START OF SYNTAX. IF((VVOC(J).LE.0).OR.(VVOC(J).GE.R50MIN)) GO TO 100 LIMIT=J+VVOC(J)+1 !COMPUTE LIMIT. J=J+1 !ADVANCE TO NEXT. C 200 CALL UNPACK(J,NEWJ) !UNPACK SYNTAX. D IF(DFLAG) TYPE 60,O1,P1,DOBJ,DFL1,DFL2 D60 FORMAT(' SYNMCH INPUTS TO SYNEQL- ',5I7) SPREP=DOBJ.AND.VPMASK !SAVE EXPECTED PREP. IF(.NOT.SYNEQL(P1,O1,DOBJ,DFL1,DFL2)) GO TO 1000 D IF(DFLAG) TYPE 60,O2,P2,IOBJ,IFL1,IFL2 SPREP=IOBJ.AND.VPMASK !SAVE EXPECTED PREP. IF(SYNEQL(P2,O2,IOBJ,IFL1,IFL2)) GO TO 6000 C C SYNTAX MATCH FAILS, TRY NEXT ONE. C IF(O2) 3000,500,3000 !IF O2=0, SET DFLT. 1000 IF(O1) 3000,500,3000 !IF O1=0, SET DFLT. 500 IF((QPREP.EQ.0).OR.(QPREP.EQ.SPREP)) DFORCE=J !IF PREP MCH. IF((VFLAG.AND.SDRIV).NE.0) DRIVE=J !IF DRIVER, RECORD. 3000 J=NEWJ IF(J.LT.LIMIT) GO TO 200 !MORE TO DO? C SYNMCH, PAGE 2 C C MATCH HAS FAILED. IF DEFAULT SYNTAX EXISTS, TRY TO SNARF C ORPHANS OR GWIMS, OR MAKE NEW ORPHANS. C D IF(DFLAG) TYPE 20,DRIVE,DFORCE D20 FORMAT(' SYNMCH, DRIVE=',2I6) IF(DRIVE.EQ.0) DRIVE=DFORCE !NO DRIVER? USE FORCE. IF(DRIVE.EQ.0) GO TO 10000 !ANY DRIVER? CALL UNPACK(DRIVE,DFORCE) !UNPACK DFLT SYNTAX. C C TRY TO FILL DIRECT OBJECT SLOT IF THAT WAS THE PROBLEM. C IF(((VFLAG.AND.SDIR).EQ.0).OR.(O1.NE.0)) GO TO 4000 C C FIRST TRY TO SNARF ORPHAN OBJECT. C O1=OFLAG.AND.OSLOT IF(O1.EQ.0) GO TO 3500 !ANY ORPHAN? IF(SYNEQL(P1,O1,DOBJ,DFL1,DFL2)) GO TO 4000 C C ORPHAN FAILS, TRY GWIM. C 3500 O1=GWIM(DOBJ,DFW1,DFW2) !GET GWIM. D IF(DFLAG) TYPE 30,O1 D30 FORMAT(' SYNMCH- DO GWIM= ',I6) IF(O1.GT.0) GO TO 4000 !TEST RESULT. CALL ORPHAN(-1,ACT,0,DOBJ.AND.VPMASK,0) !FAILS, ORPHAN. CALL RSPEAK(623) RETURN C C TRY TO FILL INDIRECT OBJECT SLOT IF THAT WAS THE PROBLEM. C 4000 IF(((VFLAG.AND.SIND).EQ.0).OR.(O2.NE.0)) GO TO 6000 O2=GWIM(IOBJ,IFW1,IFW2) !GWIM. D IF(DFLAG) TYPE 40,O2 D40 FORMAT(' SYNMCH- IO GWIM= ',I6) IF(O2.GT.0) GO TO 6000 IF(O1.EQ.0) O1=OFLAG.AND.OSLOT CALL ORPHAN(-1,ACT,O1,DOBJ.AND.VPMASK,0) CALL RSPEAK(624) RETURN C C TOTAL CHOMP C 10000 CALL RSPEAK(601) !CANT DO ANYTHING. RETURN C SYNMCH, PAGE 3 C C NOW TRY TO TAKE INDIVIDUAL OBJECTS AND C IN GENERAL CLEAN UP THE PARSE VECTOR. C 6000 IF((VFLAG.AND.SFLIP).EQ.0) GO TO 5000 !FLIP? J=O1 !YES. O1=O2 O2=J C 5000 PRSA=VFLAG.AND.SVMASK !GET VERB. PRSO=O1 !GET DIR OBJ. PRSI=O2 !GET IND OBJ. IF(.NOT.TAKEIT(PRSO,DOBJ)) RETURN !TRY TAKE. IF(.NOT.TAKEIT(PRSI,IOBJ)) RETURN !TRY TAKE. SYNMCH=.TRUE. D IF(DFLAG) TYPE 50,SYNMCH,PRSA,PRSO,PRSI,ACT,O1,O2 D50 FORMAT(' SYNMCH- RESULTS ',L1,6I7) RETURN C END C UNPACK- UNPACK SYNTAX SPECIFICATION, ADV POINTER C C DECLARATIONS C SUBROUTINE UNPACK(OLDJ,J) IMPLICIT INTEGER(A-Z) C COMMON /VRBVOC/ VVOC(950) C COMMON /SYNFLG/ SDIR,SIND,SSTD,SFLIP,SDRIV,SVMASK COMMON /OBJFLG/ VABIT,VRBIT,VTBIT,VCBIT,VEBIT,VFBIT,VPMASK COMMON /SYNTAX/ VFLAG,DOBJ,DFL1,DFL2,DFW1,DFW2, 1 IOBJ,IFL1,IFL2,IFW1,IFW2 INTEGER SYN(11) EQUIVALENCE (SYN(1),VFLAG) C DO 10 I=1,11 !CLEAR SYNTAX. SYN(I)=0 10 CONTINUE C VFLAG=VVOC(OLDJ) J=OLDJ+1 IF((VFLAG.AND.SDIR).EQ.0) RETURN !DIR OBJECT? DFL1=-1 !ASSUME STD. DFL2=-1 IF((VFLAG.AND.SSTD).EQ.0) GO TO 100 !STD OBJECT? DFW1=-1 !YES. DFW2=-1 DOBJ=VABIT+VRBIT+VFBIT GO TO 200 C 100 DOBJ=VVOC(J) !NOT STD. DFW1=VVOC(J+1) DFW2=VVOC(J+2) J=J+3 IF((DOBJ.AND.VEBIT).EQ.0) GO TO 200 !VBIT = VFWIM? DFL1=DFW1 !YES. DFL2=DFW2 C 200 IF((VFLAG.AND.SIND).EQ.0) RETURN !IND OBJECT? IFL1=-1 !ASSUME STD. IFL2=-1 IOBJ=VVOC(J) IFW1=VVOC(J+1) IFW2=VVOC(J+2) J=J+3 IF((IOBJ.AND.VEBIT).EQ.0) RETURN !VBIT = VFWIM? IFL1=IFW1 !YES. IFL2=IFW2 RETURN C END C SYNEQL- TEST FOR SYNTAX EQUALITY C C DECLARATIONS C LOGICAL FUNCTION SYNEQL(PREP,OBJ,SPREP,SFL1,SFL2) IMPLICIT INTEGER(A-Z) C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OBJFLG/ VABIT,VRBIT,VTBIT,VCBIT,VEBIT,VFBIT,VPMASK C IF(OBJ.EQ.0) GO TO 100 !ANY OBJECT? SYNEQL=(PREP.EQ.(SPREP.AND.VPMASK)).AND. 1 (((SFL1.AND.OFLAG1(OBJ)).OR. 2 (SFL2.AND.OFLAG2(OBJ))).NE.0) RETURN C 100 SYNEQL=(PREP.EQ.0).AND.(SFL1.EQ.0).AND.(SFL2.EQ.0) RETURN C END C TAKEIT- PARSER BASED TAKE OF OBJECT C C DECLARATIONS C LOGICAL FUNCTION TAKEIT(OBJ,SFLAG) IMPLICIT INTEGER(A-Z) C COMMON /OBJFLG/ VABIT,VRBIT,VTBIT,VCBIT,VEBIT,VFBIT,VPMASK COMMON /STAR/ MBASE,STRBIT C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD, 1 LTSHFT,BLOC,MUNGRM,HS,EGSCOR,EGMXSC C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT, 1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT, 2 TOOLBT,TURNBT,ONBT COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT, 1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT, 2 TCHBT,VEHBT,SCHBT C C ADVENTURERS C COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4), 1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4) C TAKEIT, PAGE 2 C TAKEIT=.FALSE. !ASSUME LOSES. IF((OBJ.EQ.0).OR.(OBJ.GT.STRBIT)) GO TO 4000 !NULL/STARS WIN. ODO2=ODESC2(OBJ) !GET DESC. X=OCAN(OBJ) !GET CONTAINER. IF((X.EQ.0).OR.((SFLAG.AND.VFBIT).EQ.0)) GO TO 500 IF((OFLAG2(X).AND.OPENBT).NE.0) GO TO 500 CALL RSPSUB(566,ODO2) !CANT REACH. RETURN C 500 IF((SFLAG.AND.VRBIT).EQ.0) GO TO 1000 !SHLD BE IN ROOM? IF((SFLAG.AND.VTBIT).EQ.0) GO TO 2000 !CAN BE TAKEN? C C SHOULD BE IN ROOM (VRBIT NE 0) AND CAN BE TAKEN (VTBIT NE 0) C IF(SCHLST(0,0,HERE,0,0,OBJ).LE.0) GO TO 4000 !IF NOT, OK. C C ITS IN THE ROOM AND CAN BE TAKEN. C IF(((OFLAG1(OBJ).AND.TAKEBT).NE.0).AND. 1 ((OFLAG2(OBJ).AND.TRYBT).EQ.0)) GO TO 3000 C C NOT TAKEABLE. IF WE CARE, FAIL. C IF((SFLAG.AND.VCBIT).EQ.0) GO TO 4000 !IF NO CARE, RETURN. CALL RSPSUB(445,ODO2) RETURN C C 1000-- IT SHOULD NOT BE IN THE ROOM. C 2000-- IT CANT BE TAKEN. C 2000 IF((SFLAG.AND.VCBIT).EQ.0) GO TO 4000 !IF NO CARE, RETURN 1000 IF(SCHLST(0,0,HERE,0,0,OBJ).LE.0) GO TO 4000 CALL RSPSUB(665,ODO2) RETURN C TAKEIT, PAGE 3 C C OBJECT IS IN THE ROOM, CAN BE TAKEN BY THE PARSER, C AND IS TAKEABLE IN GENERAL. IT IS NOT A STAR. C TAKING IT SHOULD NOT HAVE SIDE AFFECTS. C IF IT IS INSIDE SOMETHING, THE CONTAINER IS OPEN. C THE FOLLOWING CODE IS LIFTED FROM SUBROUTINE TAKE. C 3000 IF(OBJ.NE.AVEHIC(WINNER)) GO TO 3500 !TAKE VEHICLE? CALL RSPEAK(672) RETURN C 3500 IF(((X.NE.0).AND.(OADV(X).EQ.WINNER)).OR. 1 ((WEIGHT(0,OBJ,WINNER)+OSIZE(OBJ)).LE.MXLOAD)) 2 GO TO 3700 CALL RSPEAK(558) !TOO BIG. RETURN C 3700 CALL NEWSTA(OBJ,559,0,0,WINNER) !DO TAKE. OFLAG2(OBJ)=OFLAG2(OBJ).OR.TCHBT !TOUCHED. CALL SCRUPD(OFVAL(OBJ)) OFVAL(OBJ)=0 C 4000 TAKEIT=.TRUE. !SUCCESS. RETURN C END C GWIM- GET WHAT I MEAN IN AMBIGOUS SITUATIONS C C DECLARATIONS C INTEGER FUNCTION GWIM(SFLAG,SFW1,SFW2) IMPLICIT INTEGER(A-Z) LOGICAL TAKEIT,NOCARE C COMMON /OBJFLG/ VABIT,VRBIT,VTBIT,VCBIT,VEBIT,VFBIT,VPMASK COMMON /STAR/ MBASE,STRBIT C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT, 1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT, 2 TOOLBT,TURNBT,ONBT COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT, 1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT, 2 TCHBT,VEHBT,SCHBT C C ADVENTURERS C COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4), 1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4) C GWIM, PAGE 2 C GWIM=-1 !ASSUME LOSE. AV=AVEHIC(WINNER) NOBJ=0 NOCARE=(SFLAG.AND.VCBIT).EQ.0 C C FIRST SEARCH ADVENTURER C IF((SFLAG.AND.VABIT).NE.0) 1 NOBJ=FWIM(SFW1,SFW2,0,0,WINNER,NOCARE) IF((SFLAG.AND.VRBIT).NE.0) GO TO 100 50 GWIM=NOBJ RETURN C C ALSO SEARCH ROOM C 100 ROBJ=FWIM(SFW1,SFW2,HERE,0,0,NOCARE) IF(ROBJ) 500,50,200 !TEST RESULT. C C ROBJ > 0 C 200 IF((AV.EQ.0).OR.(ROBJ.EQ.AV).OR. 1 ((OFLAG2(ROBJ).AND.FINDBT).NE.0)) GO TO 300 IF(OCAN(ROBJ).NE.AV) GO TO 50 !UNREACHABLE? TRY NOBJ 300 IF(NOBJ.NE.0) RETURN !IF AMBIGUOUS, RETURN. IF(.NOT.TAKEIT(ROBJ,SFLAG)) RETURN !IF UNTAKEABLE, RETURN GWIM=ROBJ 500 RETURN C END C RAPPL2- SPECIAL PURPOSE ROOM ROUTINES, PART 2 C C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED C WRITTEN BY R. M. SUPNIK C C DECLARATIONS C LOGICAL FUNCTION RAPPL2(RI) IMPLICIT INTEGER (A-Z) LOGICAL QOPEN,QHERE,F C C PARSER OUTPUT C LOGICAL PRSWON COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD, 1 LTSHFT,BLOC,MUNGRM,HS,EGSCOR,EGMXSC C C MISCELLANEOUS VARIABLES C COMMON /CHAN/ INPCH,OUTCH,DBCH C C ROOMS C COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200), 1 RACTIO(200),RVAL(200),RFLAG(200) INTEGER RRAND(200) EQUIVALENCE (RVAL,RRAND) C COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR, 1 RSACRD,RFILL,RMUNG,RBUCK,RHOUSE,RNWALL,REND C COMMON /RINDEX/ WHOUS,LROOM,CELLA COMMON /RINDEX/ MTROL,MAZE1 COMMON /RINDEX/ MGRAT,MAZ15 COMMON /RINDEX/ FORE1,FORE3,CLEAR,RESER COMMON /RINDEX/ STREA,EGYPT,ECHOR COMMON /RINDEX/ TSHAF COMMON /RINDEX/ BSHAF,MMACH,DOME,MTORC COMMON /RINDEX/ CAROU COMMON /RINDEX/ RIDDL,LLD2,TEMP1,TEMP2,MAINT COMMON /RINDEX/ BLROO,TREAS,RIVR1,RIVR2,RIVR3,MCYCL COMMON /RINDEX/ RIVR4,RIVR5,FCHMP,FALLS,MBARR COMMON /RINDEX/ MRAIN,POG,VLBOT,VAIR1,VAIR2,VAIR3,VAIR4 COMMON /RINDEX/ LEDG2,LEDG3,LEDG4,MSAFE,CAGER COMMON /RINDEX/ CAGED,TWELL,BWELL,ALICE,ALISM,ALITR COMMON /RINDEX/ MTREE,BKENT,BKVW,BKTWI,BKVAU,BKBOX COMMON /RINDEX/ CRYPT,TSTRS,MRANT,MREYE COMMON /RINDEX/ MRA,MRB,MRC,MRG,MRD,FDOOR COMMON /RINDEX/ MRAE,MRCE,MRCW,MRGE,MRGW,MRDW,INMIR COMMON /RINDEX/ SCORR,NCORR,PARAP,CELL,PCELL,NCELL COMMON /RINDEX/ CPANT,CPOUT,CPUZZ C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT, 1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT, 2 TOOLBT,TURNBT,ONBT COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT, 1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT, 2 TCHBT,VEHBT,SCHBT C COMMON /OINDEX/ GARLI,FOOD,GUNK,COAL,MACHI,DIAMO,TCASE,BOTTL COMMON /OINDEX/ WATER,ROPE,KNIFE,SWORD,LAMP,BLAMP,RUG COMMON /OINDEX/ LEAVE,TROLL,AXE COMMON /OINDEX/ RKNIF,KEYS,ICE,BAR COMMON /OINDEX/ COFFI,TORCH,TBASK,FBASK,IRBOX COMMON /OINDEX/ GHOST,TRUNK,BELL,BOOK,CANDL COMMON /OINDEX/ MATCH,TUBE,PUTTY,WRENC,SCREW,CYCLO,CHALI COMMON /OINDEX/ THIEF,STILL,WINDO,GRATE,DOOR COMMON /OINDEX/ HPOLE,LEAK,RBUTT,RAILI COMMON /OINDEX/ POT,STATU,IBOAT,DBOAT,PUMP,RBOAT COMMON /OINDEX/ STICK,BUOY,SHOVE,BALLO,RECEP,GUANO COMMON /OINDEX/ BROPE,HOOK1,HOOK2,SAFE,SSLOT,BRICK,FUSE COMMON /OINDEX/ GNOME,BLABE,DBALL,TOMB COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE COMMON /OINDEX/ ROBOT,FTREE,BILLS,PORTR,SCOL,ZGNOM COMMON /OINDEX/ EGG,BEGG,BAUBL,CANAR,BCANA COMMON /OINDEX/ YLWAL,RDWAL,PINDR,RBEAM COMMON /OINDEX/ ODOOR,QDOOR,CDOOR,NUM1,NUM8 COMMON /OINDEX/ WARNI,CSLIT,GCARD,STLDR COMMON /OINDEX/ HANDS,WALL,LUNGS,SAILO,AVIAT,TEETH COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,WNORT,GWATE,MASTER C C EXITS C COMMON /XSRCH/ XMIN,XMAX,XDOWN,XUP, 1 XNORTH,XSOUTH,XENTER,XEXIT,XEAST,XWEST C C CLOCK INTERRUPTS C LOGICAL*1 CFLAG COMMON /CEVENT/ CLNT,CTICK(25),CACTIO(25),CFLAG(25) C COMMON /CINDEX/ CEVCUR,CEVMNT,CEVLNT,CEVMAT,CEVCND, 1 CEVBAL,CEVBRN,CEVFUS,CEVLED,CEVSAF,CEVVLG, 2 CEVGNO,CEVBUC,CEVSPH,CEVEGH, 3 CEVFOR,CEVSCL,CEVZGI,CEVZGO,CEVSTE, 5 CEVMRS,CEVPIN,CEVINQ,CEVFOL C COMMON /AINDEX/ PLAYER,AROBOT,AMASTR C C VERBS C COMMON /VINDEX/ CINTW,DEADXW,FRSTQW,INXW,OUTXW COMMON /VINDEX/ WALKIW,FIGHTW,FOOW COMMON /VINDEX/ MELTW,READW,INFLAW,DEFLAW,ALARMW,EXORCW COMMON /VINDEX/ PLUGW,KICKW,WAVEW,RAISEW,LOWERW,RUBW COMMON /VINDEX/ PUSHW,UNTIEW,TIEW,TIEUPW,TURNW,BREATW COMMON /VINDEX/ KNOCKW,LOOKW,EXAMIW,SHAKEW,MOVEW,TRNONW,TRNOFW COMMON /VINDEX/ OPENW,CLOSEW,FINDW,WAITW,SPINW,BOARDW,UNBOAW,TAKEW COMMON /VINDEX/ INVENW,FILLW,EATW,DRINKW,BURNW COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW COMMON /VINDEX/ DIGW,LEAPW,STAYW,FOLLOW COMMON /VINDEX/ HELLOW,LOOKIW,LOOKUW,PUMPW,WINDW COMMON /VINDEX/ CLMBW,CLMBUW,CLMBDW,TRNTOW C C FLAGS C LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF, 1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF, 2 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF, 3 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF, 4 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF, 5 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF, 6 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF, 7 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ BTIEF,BINFF COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP COMMON /FINDEX/ MDIR,MLOC,POLEUF COMMON /FINDEX/ QUESNO,NQATT,CORRCT COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE C C FUNCTIONS AND DATA C QOPEN(R)=(OFLAG2(R).AND.OPENBT).NE.0 DATA NEWRMS/38/ C RAPPL2, PAGE 2 C RAPPL2=.TRUE. GO TO (38000,39000,40000,41000,42000,43000,44000, 1 45000,46000,47000,48000,49000,50000, 2 51000,52000,53000,54000,55000,56000, 3 57000,58000,59000,60000), 2 (RI-NEWRMS+1) CALL BUG(70,RI) RETURN C C R38-- MIRROR D ROOM C 38000 IF(PRSA.EQ.LOOKW) CALL LOOKTO(FDOOR,MRG,0,682,681) RETURN C C R39-- MIRROR G ROOM C 39000 IF(PRSA.EQ.WALKIW) CALL JIGSUP(685) RETURN C C R40-- MIRROR C ROOM C 40000 IF(PRSA.EQ.LOOKW) CALL LOOKTO(MRG,MRB,683,0,681) RETURN C C R41-- MIRROR B ROOM C 41000 IF(PRSA.EQ.LOOKW) CALL LOOKTO(MRC,MRA,0,0,681) RETURN C C R42-- MIRROR A ROOM C 42000 IF(PRSA.EQ.LOOKW) CALL LOOKTO(MRB,0,0,684,681) RETURN C RAPPL2, PAGE 3 C C R43-- MIRROR C EAST/WEST C 43000 IF(PRSA.EQ.LOOKW) CALL EWTELL(HERE,683) RETURN C C R44-- MIRROR B EAST/WEST C 44000 IF(PRSA.EQ.LOOKW) CALL EWTELL(HERE,686) RETURN C C R45-- MIRROR A EAST/WEST C 45000 IF(PRSA.EQ.LOOKW) CALL EWTELL(HERE,687) RETURN C C R46-- INSIDE MIRROR C 46000 IF(PRSA.NE.LOOKW) RETURN !LOOK? CALL RSPEAK(688) !DESCRIBE C C NOW DESCRIBE POLE STATE. C C CASES 1,2-- MDIR=270 & MLOC=MRB, POLE IS UP OR IN HOLE C CASES 3,4-- MDIR=0 V MDIR=180, POLE IS UP OR IN CHANNEL C CASE 5-- POLE IS UP C I=689 !ASSUME CASE 5. IF((MDIR.EQ.270).AND.(MLOC.EQ.MRB)) 1 I=690+MIN0(POLEUF,1) !CASES 1,2. IF(MOD(MDIR,180).EQ.0) 1 I=692+MIN0(POLEUF,1) !CASES 3,4. CALL RSPEAK(I) !DESCRIBE POLE. CALL RSPSUB(694,695+(MDIR/45)) !DESCRIBE ARROW. RETURN C RAPPL2, PAGE 4 C C R47-- MIRROR EYE ROOM C 47000 IF(PRSA.NE.LOOKW) RETURN !LOOK? I=704 !ASSUME BEAM STOP. DO 47100 J=1,OLNT IF(QHERE(J,HERE).AND.(J.NE.RBEAM)) GO TO 47200 47100 CONTINUE I=703 47200 CALL RSPSUB(I,ODESC2(J)) !DESCRIBE BEAM. CALL LOOKTO(MRA,0,0,0,0) !LOOK NORTH. RETURN C C R48-- INSIDE CRYPT C 48000 IF(PRSA.NE.LOOKW) RETURN !LOOK? I=46 !CRYPT IS OPEN/CLOSED. IF(QOPEN(TOMB)) I=12 CALL RSPSUB(705,I) RETURN C C R49-- SOUTH CORRIDOR C 49000 IF(PRSA.NE.LOOKW) RETURN !LOOK? CALL RSPEAK(706) !DESCRIBE. I=46 !ODOOR IS OPEN/CLOSED. IF(QOPEN(ODOOR)) I=12 IF(LCELL.EQ.4) CALL RSPSUB(707,I) !DESCRIBE ODOOR IF THERE. RETURN C C R50-- BEHIND DOOR C 50000 IF(PRSA.NE.WALKIW) GO TO 50100 !WALK IN? CFLAG(CEVFOL)=.TRUE. !MASTER FOLLOWS. CTICK(CEVFOL)=-1 RETURN C 50100 IF(PRSA.NE.LOOKW) RETURN !LOOK? I=46 !QDOOR IS OPEN/CLOSED. IF(QOPEN(QDOOR)) I=12 CALL RSPSUB(708,I) RETURN C RAPPL2, PAGE 5 C C R51-- FRONT DOOR C 51000 IF(PRSA.EQ.WALKIW) CTICK(CEVFOL)=0 !IF EXITS, KILL FOLLOW. IF(PRSA.NE.LOOKW) RETURN !LOOK? CALL LOOKTO(0,MRD,709,0,0) !DESCRIBE SOUTH. I=46 !PANEL IS OPEN/CLOSED. IF(INQSTF) I=12 !OPEN IF INQ STARTED. J=46 !QDOOR IS OPEN/CLOSED. IF(QOPEN(QDOOR)) J=12 CALL RSPSB2(710,I,J) RETURN C C R52-- NORTH CORRIDOR C 52000 IF(PRSA.NE.LOOKW) RETURN !LOOK? I=46 IF(QOPEN(CDOOR)) I=12 !CDOOR IS OPEN/CLOSED. CALL RSPSUB(711,I) RETURN C C R53-- PARAPET C 53000 IF(PRSA.EQ.LOOKW) CALL RSPSUB(712,712+PNUMB) RETURN C C R54-- CELL C 54000 IF(PRSA.NE.LOOKW) RETURN !LOOK? I=721 !CDOOR IS OPEN/CLOSED. IF(QOPEN(CDOOR)) I=722 CALL RSPEAK(I) I=46 !ODOOR IS OPEN/CLOSED. IF(QOPEN(ODOOR)) I=12 IF(LCELL.EQ.4) CALL RSPSUB(723,I) !DESCRIBE. RETURN C C R55-- PRISON CELL C 55000 IF(PRSA.EQ.LOOKW) CALL RSPEAK(724) !LOOK? RETURN C C R56-- NIRVANA CELL C 56000 IF(PRSA.NE.LOOKW) RETURN !LOOK? I=46 !ODOOR IS OPEN/CLOSED. IF(QOPEN(ODOOR)) I=12 CALL RSPSUB(725,I) RETURN C RAPPL2, PAGE 6 C C R57-- NIRVANA AND END OF GAME C 57000 IF(PRSA.NE.WALKIW) RETURN !WALKIN? CALL RSPEAK(726) CALL SCORE(.FALSE.) CLOSE(UNIT=DBCH) CALL EXIT C C R58-- TOMB ROOM C 58000 IF(PRSA.NE.LOOKW) RETURN !LOOK? I=46 !TOMB IS OPEN/CLOSED. IF(QOPEN(TOMB)) I=12 CALL RSPSUB(792,I) RETURN C C R59-- PUZZLE SIDE ROOM C 59000 IF(PRSA.NE.LOOKW) RETURN !LOOK? I=861 !ASSUME DOOR CLOSED. IF(CPOUTF) I=862 !OPEN? CALL RSPEAK(I) !DESCRIBE. RETURN C C R60-- PUZZLE ROOM C 60000 IF(PRSA.NE.LOOKW) RETURN !LOOK? IF(CPUSHF) GO TO 60100 !STARTED PUZZLE? CALL RSPEAK(868) !NO, DESCRIBE. IF((OFLAG2(WARNI).AND.TCHBT).NE.0) CALL RSPEAK(869) RETURN C 60100 CALL CPINFO(880,CPHERE) !DESCRIBE ROOM. RETURN C END C LOOKTO-- DESCRIBE VIEW IN MIRROR HALLWAY C C DECLARATIONS C SUBROUTINE LOOKTO(NRM,SRM,NT,ST,HT) IMPLICIT INTEGER(A-Z) C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG C C FLAGS C LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF, 1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF, 2 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF, 3 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF, 4 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF, 5 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF, 6 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF, 7 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ BTIEF,BINFF COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP COMMON /FINDEX/ MDIR,MLOC,POLEUF COMMON /FINDEX/ QUESNO,NQATT,CORRCT COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE C LOOKTO, PAGE 2 C CALL RSPEAK(HT) !DESCRIBE HALL. CALL RSPEAK(NT) !DESCRIBE NORTH VIEW. CALL RSPEAK(ST) !DESCRIBE SOUTH VIEW. DIR=0 !ASSUME NO DIRECTION. IF(IABS(MLOC-HERE).NE.1) GO TO 200 !MIRROR TO N OR S? IF(MLOC.EQ.NRM) DIR=695 IF(MLOC.EQ.SRM) DIR=699 !DIR=N/S. IF(MOD(MDIR,180).NE.0) GO TO 100 !MIRROR N-S? CALL RSPSUB(847,DIR) !YES, HE SEES PANEL CALL RSPSB2(848,DIR,DIR) !AND NARROW ROOMS. GO TO 200 C 100 M1=MRHERE(HERE) !WHICH MIRROR? MRBF=0 !ASSUME INTACT. IF(((M1.EQ.1).AND..NOT.MR1F).OR. 1 ((M1.EQ.2).AND..NOT.MR2F)) MRBF=1 !BROKEN? CALL RSPSUB(849+MRBF,DIR) !DESCRIBE. IF((M1.EQ.1).AND.MROPNF) CALL RSPEAK(823+MRBF) IF(MRBF.NE.0) CALL RSPEAK(851) C 200 I=0 !ASSUME NO MORE TO DO. IF((NT.EQ.0).AND.((DIR.EQ.0).OR.(DIR.EQ.699))) I=852 IF((ST.EQ.0).AND.((DIR.EQ.0).OR.(DIR.EQ.695))) I=853 IF((NT+ST+DIR).EQ.0) I=854 IF(HT.NE.0) CALL RSPEAK(I) !DESCRIBE HALLS. RETURN C END C EWTELL-- DESCRIBE E/W NARROW ROOMS C C DECLARATIONS C SUBROUTINE EWTELL(RM,ST) IMPLICIT INTEGER(A-Z) LOGICAL M1 C C ROOMS C COMMON /RINDEX/ WHOUS,LROOM,CELLA COMMON /RINDEX/ MTROL,MAZE1 COMMON /RINDEX/ MGRAT,MAZ15 COMMON /RINDEX/ FORE1,FORE3,CLEAR,RESER COMMON /RINDEX/ STREA,EGYPT,ECHOR COMMON /RINDEX/ TSHAF COMMON /RINDEX/ BSHAF,MMACH,DOME,MTORC COMMON /RINDEX/ CAROU COMMON /RINDEX/ RIDDL,LLD2,TEMP1,TEMP2,MAINT COMMON /RINDEX/ BLROO,TREAS,RIVR1,RIVR2,RIVR3,MCYCL COMMON /RINDEX/ RIVR4,RIVR5,FCHMP,FALLS,MBARR COMMON /RINDEX/ MRAIN,POG,VLBOT,VAIR1,VAIR2,VAIR3,VAIR4 COMMON /RINDEX/ LEDG2,LEDG3,LEDG4,MSAFE,CAGER COMMON /RINDEX/ CAGED,TWELL,BWELL,ALICE,ALISM,ALITR COMMON /RINDEX/ MTREE,BKENT,BKVW,BKTWI,BKVAU,BKBOX COMMON /RINDEX/ CRYPT,TSTRS,MRANT,MREYE COMMON /RINDEX/ MRA,MRB,MRC,MRG,MRD,FDOOR COMMON /RINDEX/ MRAE,MRCE,MRCW,MRGE,MRGW,MRDW,INMIR COMMON /RINDEX/ SCORR,NCORR,PARAP,CELL,PCELL,NCELL COMMON /RINDEX/ CPANT,CPOUT,CPUZZ C C FLAGS C LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF, 1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF, 2 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF, 3 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF, 4 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF, 5 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF, 6 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF, 7 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ BTIEF,BINFF COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP COMMON /FINDEX/ MDIR,MLOC,POLEUF COMMON /FINDEX/ QUESNO,NQATT,CORRCT COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE C EWTELL, PAGE 2 C C NOTE THAT WE ARE EAST OR WEST OF MIRROR, AND C MIRROR MUST BE N-S. C M1=(MDIR+(MOD(RM-MRAE,2)*180)).EQ.180 I=819+MOD(RM-MRAE,2) !GET BASIC E/W STRING. IF((M1.AND..NOT.MR1F).OR.(.NOT.M1.AND..NOT.MR2F)) 1 I=I+2 !MIRROR BROKEN? CALL RSPEAK(I) IF(M1.AND.MROPNF) CALL RSPEAK(823+((I-819)/2)) CALL RSPEAK(825) CALL RSPEAK(ST) RETURN C END C OAPPLI- OBJECT SPECIAL ACTION ROUTINES C C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED C WRITTEN BY R. M. SUPNIK C C DECLARATIONS C LOGICAL FUNCTION OAPPLI(RI,ARG) IMPLICIT INTEGER (A-Z) LOGICAL SOBJS,NOBJS LOGICAL QOPEN,QON,LIT LOGICAL MOVETO,RMDESC,CLOCKD LOGICAL THIEFP,CYCLOP,TROLLP,BALLOP,LIGHTP LOGICAL QEMPTY,QHERE,F,OPNCLS C C PARSER OUTPUT C LOGICAL PRSWON COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD, 1 LTSHFT,BLOC,MUNGRM,HS,EGSCOR,EGMXSC C COMMON /BATS/ BATDRP(9) C C PUZZLE ROOM C COMMON /PUZZLE/ CPDR(16),CPWL(8),CPVEC(64) C C ROOMS C COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200), 1 RACTIO(200),RVAL(200),RFLAG(200) INTEGER RRAND(200) EQUIVALENCE (RVAL,RRAND) C COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR, 1 RSACRD,RFILL,RMUNG,RBUCK,RHOUSE,RNWALL,REND C COMMON /RINDEX/ WHOUS,LROOM,CELLA COMMON /RINDEX/ MTROL,MAZE1 COMMON /RINDEX/ MGRAT,MAZ15 COMMON /RINDEX/ FORE1,FORE3,CLEAR,RESER COMMON /RINDEX/ STREA,EGYPT,ECHOR COMMON /RINDEX/ TSHAF COMMON /RINDEX/ BSHAF,MMACH,DOME,MTORC COMMON /RINDEX/ CAROU COMMON /RINDEX/ RIDDL,LLD2,TEMP1,TEMP2,MAINT COMMON /RINDEX/ BLROO,TREAS,RIVR1,RIVR2,RIVR3,MCYCL COMMON /RINDEX/ RIVR4,RIVR5,FCHMP,FALLS,MBARR COMMON /RINDEX/ MRAIN,POG,VLBOT,VAIR1,VAIR2,VAIR3,VAIR4 COMMON /RINDEX/ LEDG2,LEDG3,LEDG4,MSAFE,CAGER COMMON /RINDEX/ CAGED,TWELL,BWELL,ALICE,ALISM,ALITR COMMON /RINDEX/ MTREE,BKENT,BKVW,BKTWI,BKVAU,BKBOX COMMON /RINDEX/ CRYPT,TSTRS,MRANT,MREYE COMMON /RINDEX/ MRA,MRB,MRC,MRG,MRD,FDOOR COMMON /RINDEX/ MRAE,MRCE,MRCW,MRGE,MRGW,MRDW,INMIR COMMON /RINDEX/ SCORR,NCORR,PARAP,CELL,PCELL,NCELL COMMON /RINDEX/ CPANT,CPOUT,CPUZZ C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT, 1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT, 2 TOOLBT,TURNBT,ONBT COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT, 1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT, 2 TCHBT,VEHBT,SCHBT C COMMON /OINDEX/ GARLI,FOOD,GUNK,COAL,MACHI,DIAMO,TCASE,BOTTL COMMON /OINDEX/ WATER,ROPE,KNIFE,SWORD,LAMP,BLAMP,RUG COMMON /OINDEX/ LEAVE,TROLL,AXE COMMON /OINDEX/ RKNIF,KEYS,ICE,BAR COMMON /OINDEX/ COFFI,TORCH,TBASK,FBASK,IRBOX COMMON /OINDEX/ GHOST,TRUNK,BELL,BOOK,CANDL COMMON /OINDEX/ MATCH,TUBE,PUTTY,WRENC,SCREW,CYCLO,CHALI COMMON /OINDEX/ THIEF,STILL,WINDO,GRATE,DOOR COMMON /OINDEX/ HPOLE,LEAK,RBUTT,RAILI COMMON /OINDEX/ POT,STATU,IBOAT,DBOAT,PUMP,RBOAT COMMON /OINDEX/ STICK,BUOY,SHOVE,BALLO,RECEP,GUANO COMMON /OINDEX/ BROPE,HOOK1,HOOK2,SAFE,SSLOT,BRICK,FUSE COMMON /OINDEX/ GNOME,BLABE,DBALL,TOMB COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE COMMON /OINDEX/ ROBOT,FTREE,BILLS,PORTR,SCOL,ZGNOM COMMON /OINDEX/ EGG,BEGG,BAUBL,CANAR,BCANA COMMON /OINDEX/ YLWAL,RDWAL,PINDR,RBEAM COMMON /OINDEX/ ODOOR,QDOOR,CDOOR,NUM1,NUM8 COMMON /OINDEX/ WARNI,CSLIT,GCARD,STLDR COMMON /OINDEX/ HANDS,WALL,LUNGS,SAILO,AVIAT,TEETH COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,WNORT,GWATE,MASTER C C CLOCK INTERRUPTS C LOGICAL*1 CFLAG COMMON /CEVENT/ CLNT,CTICK(25),CACTIO(25),CFLAG(25) C COMMON /CINDEX/ CEVCUR,CEVMNT,CEVLNT,CEVMAT,CEVCND, 1 CEVBAL,CEVBRN,CEVFUS,CEVLED,CEVSAF,CEVVLG, 2 CEVGNO,CEVBUC,CEVSPH,CEVEGH, 3 CEVFOR,CEVSCL,CEVZGI,CEVZGO,CEVSTE, 5 CEVMRS,CEVPIN,CEVINQ,CEVFOL C C ADVENTURERS C COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4), 1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4) C COMMON /AINDEX/ PLAYER,AROBOT,AMASTR C C VERBS C COMMON /VINDEX/ CINTW,DEADXW,FRSTQW,INXW,OUTXW COMMON /VINDEX/ WALKIW,FIGHTW,FOOW COMMON /VINDEX/ MELTW,READW,INFLAW,DEFLAW,ALARMW,EXORCW COMMON /VINDEX/ PLUGW,KICKW,WAVEW,RAISEW,LOWERW,RUBW COMMON /VINDEX/ PUSHW,UNTIEW,TIEW,TIEUPW,TURNW,BREATW COMMON /VINDEX/ KNOCKW,LOOKW,EXAMIW,SHAKEW,MOVEW,TRNONW,TRNOFW COMMON /VINDEX/ OPENW,CLOSEW,FINDW,WAITW,SPINW,BOARDW,UNBOAW,TAKEW COMMON /VINDEX/ INVENW,FILLW,EATW,DRINKW,BURNW COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW COMMON /VINDEX/ DIGW,LEAPW,STAYW,FOLLOW COMMON /VINDEX/ HELLOW,LOOKIW,LOOKUW,PUMPW,WINDW COMMON /VINDEX/ CLMBW,CLMBUW,CLMBDW,TRNTOW C C FLAGS C LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF, 1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF, 2 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF, 3 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF, 4 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF, 5 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF, 6 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF, 7 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ BTIEF,BINFF COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP COMMON /FINDEX/ MDIR,MLOC,POLEUF COMMON /FINDEX/ QUESNO,NQATT,CORRCT COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE C C FUNCTIONS AND DATA C QOPEN(R)=(OFLAG2(R).AND.OPENBT).NE.0 QON(R)=(OFLAG1(R).AND.ONBT).NE.0 DATA MXSMP/99/ C OAPPLI, PAGE 2 C IF(RI.EQ.0) GO TO 10 !ZERO IS FALSE APP. IF(RI.LE.MXSMP) GO TO 100 !SIMPLE OBJECT? IF(PRSO.NE.0) ODO2=ODESC2(PRSO) IF(PRSI.NE.0) ODI2=ODESC2(PRSI) AV=AVEHIC(WINNER) FLOBTS=FLAMBT+LITEBT+ONBT OAPPLI=.TRUE. C GO TO (2000,5000,10000,11000,12000,15000,18000, 1 19000,20000,22000,25000,26000,32000,35000,39000,40000, 2 45000,47000,48000,49000,50000,51000,52000,54000,55000, 3 56000,57000,58000,59000,60000,61000,62000), 3 (RI-MXSMP) CALL BUG(6,RI) C C RETURN HERE TO DECLARE FALSE RESULT C 10 OAPPLI=.FALSE. RETURN C C SIMPLE OBJECTS, PROCESSED EXTERNALLY. C 100 IF(RI.LT.32) OAPPLI=SOBJS(RI,ARG) IF(RI.GE.32) OAPPLI=NOBJS(RI,ARG) RETURN C OAPPLI, PAGE 3 C C O100-- MACHINE FUNCTION C 2000 IF(HERE.NE.MMACH) GO TO 10 !NOT HERE? F OAPPLI=OPNCLS(MACHI,123,124) !HANDLE OPN/CLS. RETURN C C O101-- WATER FUNCTION C 5000 IF(PRSA.NE.FILLW) GO TO 5050 !FILL X WITH Y IS PRSA=PUTW !MADE INTO I=PRSI PRSI=PRSO PRSO=I !PUT Y IN X. I=ODI2 ODI2=ODO2 ODO2=I 5050 IF((PRSO.EQ.WATER).OR.(PRSO.EQ.GWATE)) GO TO 5100 CALL RSPEAK(561) !WATER IS IND OBJ, RETURN !PUNT. C 5100 IF(PRSA.NE.TAKEW) GO TO 5400 !TAKE WATER? IF((OADV(BOTTL).EQ.WINNER).AND.(OCAN(PRSO).NE.BOTTL)) 1 GO TO 5500 !TAKE, NOT IN BOTTLE. IF(OCAN(PRSO).EQ.0) GO TO 5200 !INSIDE ANYTHING? IF(QOPEN(OCAN(PRSO))) GO TO 5200 !YES, OPEN? CALL RSPEAK(525,ODESC2(OCAN(PRSO))) !INSIDE, CLOSED, PUNT. RETURN C 5200 CALL RSPEAK(615) !NOT INSIDE OR OPEN, RETURN !SLIPS THRU FINGERS. C 5400 IF(PRSA.NE.PUTW) GO TO 5700 !PUT WATER IN X? IF((AV.NE.0).AND.(PRSI.EQ.AV)) GO TO 5800 !IN VEH? IF(PRSI.EQ.BOTTL) GO TO 5500 !IN BOTTLE? CALL RSPSUB(297,ODI2) !WONT GO ELSEWHERE. CALL NEWSTA(PRSO,0,0,0,0) !VANISH WATER. RETURN C 5500 IF(QOPEN(BOTTL)) GO TO 5550 !BOTTLE OPEN? CALL RSPEAK(612) !NO, LOSE. RETURN C 5550 IF(QEMPTY(BOTTL)) GO TO 5600 !OPEN, EMPTY? CALL RSPEAK(613) !NO, ALREADY FULL. RETURN C 5600 CALL NEWSTA(WATER,614,0,BOTTL,0) !TAKE WATER TO BOTTLE. RETURN C 5700 IF((PRSA.NE.DROPW).AND.(PRSA.NE.POURW).AND. 1 (PRSA.NE.GIVEW)) GO TO 5900 !DROP, POUR, GIVE? IF(AV.NE.0) GO TO 5800 !INTO VEHICLE? CALL NEWSTA(PRSO,133,0,0,0) !NO, VANISHES. RETURN C 5800 CALL NEWSTA(WATER,0,0,AV,0) !WATER INTO VEHICLE. CALL RSPSUB(296,ODESC2(AV)) !DESCRIBE. RETURN C 5900 IF(PRSA.NE.THROWW) GO TO 10 !LAST CHANCE, THROW? CALL NEWSTA(PRSO,132,0,0,0) !VANISHES. RETURN C OAPPLI, PAGE 4 C C O102-- LEAF PILE C 10000 IF(PRSA.NE.BURNW) GO TO 10500 !BURN? IF(OROOM(PRSO).EQ.0) GO TO 10100 !WAS HE CARRYING? CALL NEWSTA(PRSO,158,0,0,0) !NO, BURN IT. RETURN C 10100 CALL NEWSTA(PRSO,0,HERE,0,0) !DROP LEAVES. CALL JIGSUP(159) !BURN HIM. RETURN C 10500 IF(PRSA.NE.MOVEW) GO TO 10600 !MOVE? CALL RSPEAK(2) !DONE. RETURN C 10600 IF((PRSA.NE.LOOKUW).OR.(RVCLR.NE.0)) GO TO 10 CALL RSPEAK(344) !LOOK UNDER? RETURN C C O103-- TROLL, DONE EXTERNALLY. C 11000 OAPPLI=TROLLP(ARG) !TROLL PROCESSOR. RETURN C C O104-- RUSTY KNIFE. C 12000 IF(PRSA.NE.TAKEW) GO TO 12100 !TAKE? IF(OADV(SWORD).EQ.WINNER) CALL RSPEAK(160) !PULSE SWORD. GO TO 10 C 12100 IF((((PRSA.NE.ATTACW).AND.(PRSA.NE.KILLW)).OR. 1 (PRSI.NE.RKNIF)).AND. 2 (((PRSA.NE.SWINGW).AND.(PRSA.NE.THROWW)).OR. 3 (PRSO.NE.RKNIF))) GO TO 10 CALL NEWSTA(RKNIF,0,0,0,0) !KILL KNIFE. CALL JIGSUP(161) !KILL HIM. RETURN C OAPPLI, PAGE 5 C C O105-- GLACIER C 15000 IF(PRSA.NE.THROWW) GO TO 15500 !THROW? IF(PRSO.NE.TORCH) GO TO 15400 !TORCH? CALL NEWSTA(ICE,169,0,0,0) !MELT ICE. ODESC1(TORCH)=174 !MUNG TORCH. ODESC2(TORCH)=173 OFLAG1(TORCH)=OFLAG1(TORCH).AND. .NOT.FLOBTS CALL NEWSTA(TORCH,0,STREA,0,0) !MOVE TORCH. GLACRF=.TRUE. !GLACIER GONE. IF(.NOT.LIT(HERE)) CALL RSPEAK(170) !IN DARK? RETURN C 15400 CALL RSPEAK(171) !JOKE IF NOT TORCH. RETURN C 15500 IF((PRSA.NE.MELTW).OR.(PRSO.NE.ICE)) GO TO 10 IF((OFLAG1(PRSI).AND.FLOBTS).EQ.FLOBTS) GO TO 15600 CALL RSPSUB(298,ODI2) !CANT MELT WITH THAT. RETURN C 15600 GLACMF=.TRUE. !PARTIAL MELT. IF(PRSI.NE.TORCH) GO TO 15700 !MELT WITH TORCH? ODESC1(TORCH)=174 !MUNG TORCH. ODESC2(TORCH)=173 OFLAG1(TORCH)=OFLAG1(TORCH).AND. .NOT.FLOBTS 15700 CALL JIGSUP(172) !DROWN. RETURN C C O106-- BLACK BOOK C 18000 IF(PRSA.NE.OPENW) GO TO 18100 !OPEN? CALL RSPEAK(180) !JOKE. RETURN C 18100 IF(PRSA.NE.CLOSEW) GO TO 18200 !CLOSE? CALL RSPEAK(181) RETURN C 18200 IF(PRSA.NE.BURNW) GO TO 10 !BURN? CALL NEWSTA(PRSO,0,0,0,0) !FATAL JOKE. CALL JIGSUP(182) RETURN C OAPPLI, PAGE 6 C C O107-- CANDLES, PROCESSED EXTERNALLY C 19000 OAPPLI=LIGHTP(CANDL) RETURN C C O108-- MATCHES, PROCESSED EXTERNALLY C 20000 OAPPLI=LIGHTP(MATCH) RETURN C C O109-- CYCLOPS, PROCESSED EXTERNALLY. C 22000 OAPPLI=CYCLOP(ARG) !CYCLOPS RETURN C C O110-- THIEF, PROCESSED EXTERNALLY C 25000 OAPPLI=THIEFP(ARG) RETURN C C O111-- WINDOW C 26000 OAPPLI=OPNCLS(WINDO,208,209) !OPEN/CLS WINDOW. RETURN C C O112-- PILE OF BODIES C 32000 IF(PRSA.NE.TAKEW) GO TO 32500 !TAKE? CALL RSPEAK(228) !CANT. RETURN C 32500 IF((PRSA.NE.BURNW).AND.(PRSA.NE.MUNGW)) GO TO 10 IF(ONPOLF) RETURN !BURN OR MUNG? ONPOLF=.TRUE. !SET HEAD ON POLE. CALL NEWSTA(HPOLE,0,LLD2,0,0) CALL JIGSUP(229) !BEHEADED. RETURN C C O113-- VAMPIRE BAT C 35000 CALL RSPEAK(50) !TIME TO FLY, JACK. F=MOVETO(BATDRP(RND(9)+1),WINNER) !SELECT RANDOM DEST. F=RMDESC(0) RETURN C OAPPLI, PAGE 7 C C O114-- STICK C 39000 IF(PRSA.NE.WAVEW) GO TO 10 !WAVE? IF(HERE.EQ.MRAIN) GO TO 39500 !ON RAINBOW? IF((HERE.EQ.POG).OR.(HERE.EQ.FALLS)) GO TO 39200 CALL RSPEAK(244) !NOTHING HAPPENS. RETURN C 39200 OFLAG1(POT)=OFLAG1(POT).OR.VISIBT !MAKE GOLD VISIBLE. RAINBF=.NOT. RAINBF !COMPLEMENT RAINBOW. I=245 !ASSUME OFF. IF(RAINBF) I=246 !IF ON, SOLID. CALL RSPEAK(I) !DESCRIBE. RETURN C 39500 RAINBF=.FALSE. !ON RAINBOW, CALL JIGSUP(247) !TAKE A FALL. RETURN C C O115-- BALLOON, HANDLED EXTERNALLY C 40000 OAPPLI=BALLOP(ARG) RETURN C C O116-- HEADS C 45000 IF(PRSA.NE.HELLOW) GO TO 45100 !HELLO HEADS? CALL RSPEAK(633) !TRULY BIZARRE. RETURN C 45100 IF(PRSA.EQ.READW) GO TO 10 !READ IS OK. CALL NEWSTA(LCASE,260,LROOM,0,0) !MAKE LARGE CASE. I=ROBADV(WINNER,0,LCASE,0)+ROBRM(HERE,100,0,LCASE,0) CALL JIGSUP(261) !KILL HIM. RETURN C OAPPLI, PAGE 8 C C O117-- SPHERE C 47000 IF(CAGESF.OR.(PRSA.NE.TAKEW)) GO TO 10 !TAKE? IF(WINNER.NE.PLAYER) GO TO 47500 !ROBOT TAKE? CALL RSPEAK(263) !NO, DROP CAGE. IF(OROOM(ROBOT).NE.HERE) GO TO 47200 !ROBOT HERE? F=MOVETO(CAGED,WINNER) !YES, MOVE INTO CAGE. CALL NEWSTA(ROBOT,0,CAGED,0,0) !MOVE ROBOT. AROOM(AROBOT)=CAGED OFLAG1(ROBOT)=OFLAG1(ROBOT).OR.NDSCBT !DONT DESCRIBE ROBOT. CTICK(CEVSPH)=10 !GET OUT IN 10 OR ELSE. RETURN C 47200 CALL NEWSTA(SPHER,0,0,0,0) !YOURE DEAD. RFLAG(CAGER)=RFLAG(CAGER).OR.RMUNG !MUNG CAGE ROOM. RRAND(CAGER)=147 CALL JIGSUP(148) !MUNG PLAYER. RETURN C 47500 CALL NEWSTA(SPHER,0,0,0,0) !ROBOT TRIED, CALL NEWSTA(ROBOT,264,0,0,0) !KILL HIM. CALL NEWSTA(CAGE,0,HERE,0,0) !INSERT MANGLED CAGE. RETURN C C O118-- GEOMETRICAL BUTTONS C 48000 IF(PRSA.NE.PUSHW) GO TO 10 !PUSH? I=PRSO-SQBUT+1 !GET BUTTON INDEX. IF((I.LE.0).OR.(I.GE.4)) GO TO 10 !A BUTTON? IF(WINNER.NE.PLAYER) GO TO (48100,48200,48300),I CALL JIGSUP(265) !YOU PUSHED, YOU DIE. RETURN C 48100 I=267 IF(CAROZF) I=266 !SPEED UP? CAROZF=.TRUE. CALL RSPEAK(I) RETURN C 48200 I=266 !ASSUME NO CHANGE. IF(CAROZF) I=268 CAROZF=.FALSE. CALL RSPEAK(I) RETURN C 48300 CAROFF=.NOT.CAROFF !FLIP CAROUSEL. IF(.NOT.QHERE(IRBOX,CAROU)) RETURN !IRON BOX IN CAROUSEL? CALL RSPEAK(269) !YES, THUMP. OFLAG1(IRBOX)=OFLAG1(IRBOX).XOR.VISIBT !COMPLEMENT VISIBILITY. IF(CAROFF) RFLAG(CAROU)=RFLAG(CAROU).AND. .NOT.RSEEN RETURN C C O119-- FLASK FUNCTION C 49000 IF(PRSA.EQ.OPENW) GO TO 49100 !OPEN? IF((PRSA.NE.MUNGW).AND.(PRSA.NE.THROWW)) GO TO 10 CALL NEWSTA(FLASK,270,0,0,0) !KILL FLASK. 49100 RFLAG(HERE)=RFLAG(HERE).OR.RMUNG !MUNG ROOM. RRAND(HERE)=271 CALL JIGSUP(272) !POISONED. RETURN C C O120-- BUCKET FUNCTION C 50000 IF(ARG.NE.2) GO TO 10 !READOUT? IF((OCAN(WATER).NE.BUCKE).OR.BUCKTF) GO TO 50500 BUCKTF=.TRUE. !BUCKET AT TOP. CTICK(CEVBUC)=100 !START COUNTDOWN. CALL NEWSTA(BUCKE,290,TWELL,0,0) !REPOSITION BUCKET. GO TO 50900 !FINISH UP. C 50500 IF((OCAN(WATER).EQ.BUCKE).OR..NOT.BUCKTF) GO TO 10 BUCKTF=.FALSE. CALL NEWSTA(BUCKE,291,BWELL,0,0) !BUCKET AT BOTTOM. 50900 IF(AV.NE.BUCKE) RETURN !IN BUCKET? F=MOVETO(OROOM(BUCKE),WINNER) !MOVE ADVENTURER. F=RMDESC(0) !DESCRIBE ROOM. RETURN C OAPPLI, PAGE 9 C C O121-- EATME CAKE C 51000 IF((PRSA.NE.EATW).OR.(PRSO.NE.ECAKE).OR. 1 (HERE.NE.ALICE)) GO TO 10 !EAT CAKE IN ALICEROOM? CALL NEWSTA(ECAKE,273,0,0,0) !VANISH CAKE. OFLAG1(ROBOT)=OFLAG1(ROBOT).AND. .NOT.VISIBT !VANISH ROBOT. DO 51100 I=1,OLNT !MAKE OBJECTS BIG. IF((OROOM(I).NE.ALICE).OR.(OSIZE(I).EQ.10000)) 1 GO TO 51100 OSIZE(I)=OSIZE(I)*64 OROOM(I)=ALISM 51100 CONTINUE OAPPLI=MOVETO(ALISM,WINNER) !MOVE TO ALICE SMALL. RETURN C C O122-- ICINGS C 52000 IF(PRSA.NE.READW) GO TO 52200 !READ? I=274 !CANT READ. IF(PRSI.NE.0) I=275 !THROUGH SOMETHING? IF(PRSI.EQ.BOTTL) I=276 !THROUGH BOTTLE? IF(PRSI.EQ.FLASK) I=277+(PRSO-ORICE) !THROUGH FLASK? CALL RSPEAK(I) !READ FLASK. RETURN C 52200 IF((PRSA.NE.THROWW).OR.(PRSO.NE.RDICE).OR.(PRSI.NE.POOL)) 1 GO TO 52300 !THROW RDICE AT POOL? CALL NEWSTA(POOL,280,0,0,0) !VANISH POOL. OFLAG1(SAFFR)=OFLAG1(SAFFR).OR.VISIBT !MATERIALIZE SPICES. RETURN C 52300 IF((HERE.NE.ALICE).AND.(HERE.NE.ALISM).AND.(HERE.NE.ALITR)) 1 GO TO 10 !IN WONDERLAND? IF(((PRSA.NE.EATW).AND.(PRSA.NE.THROWW)).OR. 1 (PRSO.NE.ORICE)) GO TO 52400 !THROW ORANGE ICE? CALL NEWSTA(ORICE,0,0,0,0) !VANISH ORANGE ICE. RFLAG(HERE)=RFLAG(HERE).OR.RMUNG !VANISH ROOM. RRAND(HERE)=281 CALL JIGSUP(282) !VANISH ADVENTURER. RETURN C 52400 IF((PRSA.NE.EATW).OR.(PRSO.NE.BLICE)) 1 GO TO 10 !EAT BLUE ICE? CALL NEWSTA(BLICE,283,0,0,0) !VANISH BLUE ICE. IF(HERE.NE.ALISM) GO TO 52500 !IN REDUCED ROOM? OFLAG1(ROBOT)=OFLAG1(ROBOT).OR.VISIBT !MATERIALIZE ROBOT. DO 52450 I=1,OLNT !ENLARGE WORLD. IF((OROOM(I).NE.HERE).OR.(OSIZE(I).EQ.10000)) 1 GO TO 52450 OROOM(I)=ALICE OSIZE(I)=OSIZE(I)/64 52450 CONTINUE OAPPLI=MOVETO(ALICE,WINNER) !RETURN RETURN C 52500 CALL JIGSUP(284) !ENLARGED IN WRONG ROOM. RETURN C C O123-- BRICK C 54000 IF(PRSA.NE.BURNW) GO TO 10 !BURN? CALL JIGSUP(150) !BOOM! RETURN C C O124-- MYSELF C 55000 IF(PRSA.NE.GIVEW) GO TO 55100 !GIVE? CALL NEWSTA(PRSO,2,0,0,PLAYER) !DONE. RETURN C 55100 IF(PRSA.NE.TAKEW) GO TO 55200 !TAKE? CALL RSPEAK(286) !JOKE. RETURN C 55200 IF((PRSA.NE.KILLW).AND.(PRSA.NE.MUNGW)) GO TO 10 CALL JIGSUP(287) !KILL, NO JOKE. RETURN C OAPPLI, PAGE 10 C C O125-- PANELS INSIDE MIRROR C 56000 IF(PRSA.NE.PUSHW) GO TO 10 !PUSH? IF(POLEUF.NE.0) GO TO 56100 !SHORT POLE UP? I=731 !NO, WONT BUDGE. IF(MOD(MDIR,180).EQ.0) I=732 !DIFF MSG IF N-S. CALL RSPEAK(I) !TELL WONT MOVE. RETURN C 56100 IF(MLOC.NE.MRG) GO TO 56200 !IN GDN ROOM? CALL RSPEAK(733) !YOU LOSE. CALL JIGSUP(685) RETURN C 56200 I=831 !ROTATE L OR R. IF((PRSO.EQ.RDWAL).OR.(PRSO.EQ.YLWAL)) I=830 CALL RSPEAK(I) !TELL DIRECTION. MDIR=MOD(MDIR+45+(270*(I-830)),360) !CALCULATE NEW DIR. CALL RSPSUB(734,695+(MDIR/45)) !TELL NEW DIR. IF(WDOPNF) CALL RSPEAK(730) !IF PANEL OPEN, CLOSE. WDOPNF=.FALSE. RETURN !DONE. C C O126-- ENDS INSIDE MIRROR C 57000 IF(PRSA.NE.PUSHW) GO TO 10 !PUSH? IF(MOD(MDIR,180).EQ.0) GO TO 57100 !MIRROR N-S? CALL RSPEAK(735) !NO, WONT BUDGE. RETURN C 57100 IF(PRSO.NE.PINDR) GO TO 57300 !PUSH PINE WALL? IF(((MLOC.EQ.MRC).AND.(MDIR.EQ.180)).OR. 1 ((MLOC.EQ.MRD).AND.(MDIR.EQ.0)).OR. 2 (MLOC.EQ.MRG)) GO TO 57200 !IN VIEW OF GDN? CALL RSPEAK(736) !NO, OPENS. WDOPNF=.TRUE. !INDICATE OPEN. CFLAG(CEVPIN)=.TRUE. !TIME OPENING. CTICK(CEVPIN)=5 RETURN C 57200 CALL RSPEAK(737) !GDN SEES YOU, DIE. CALL JIGSUP(685) RETURN C 57300 NLOC=MLOC-1 !NEW LOC IF SOUTH. IF(MDIR.EQ.0) NLOC=MLOC+1 !NEW LOC IF NORTH. IF((NLOC.GE.MRA).AND.(NLOC.LE.MRD)) GO TO 57400 CALL RSPEAK(738) !HAVE REACHED END. RETURN C 57400 I=699 !ASSUME SOUTH. IF(MDIR.EQ.0) I=695 !NORTH. J=739 !ASSUME SMOOTH. IF(POLEUF.NE.0) J=740 !POLE UP, WOBBLES. CALL RSPSUB(J,I) !DESCRIBE. MLOC=NLOC IF(MLOC.NE.MRG) RETURN !NOW IN GDN ROOM? C IF(POLEUF.NE.0) GO TO 57500 !POLE UP, GDN SEES. IF(MROPNF.OR.WDOPNF) GO TO 57600 !DOOR OPEN, GDN SEES. IF(MR1F.AND.MR2F) RETURN !MIRRORS INTACT, OK. CALL RSPEAK(742) !MIRRORS BROKEN, DIE. CALL JIGSUP(743) RETURN C 57500 CALL RSPEAK(741) !POLE UP, DIE. CALL JIGSUP(743) RETURN C 57600 CALL RSPEAK(744) !DOOR OPEN, DIE. CALL JIGSUP(743) RETURN C OAPPLI, PAGE 11 C C O127-- GLOBAL GUARDIANS C 58000 IF((PRSA.NE.ATTACW).AND.(PRSA.NE.KILLW).AND. 1 (PRSA.NE.MUNGW)) GO TO 58100 !AGGRESSIVE? CALL JIGSUP(745) !LOSE. RETURN C 58100 IF(PRSA.NE.HELLOW) GO TO 10 !HELLO? CALL RSPEAK(746) !NO REPLY. RETURN C C O128-- GLOBAL MASTER C 59000 IF((PRSA.NE.ATTACW).AND.(PRSA.NE.KILLW).AND. 1 (PRSA.NE.MUNGW)) GO TO 59100 !AGGRESSIVE? CALL JIGSUP(747) !BAD IDEA. RETURN C 59100 IF(PRSA.NE.TAKEW) GO TO 10 !TAKE? CALL RSPEAK(748) !JOKE. RETURN C C O129-- NUMERAL FIVE (FOR JOKE) C 60000 IF(PRSA.NE.TAKEW) GO TO 10 !TAKE FIVE? CALL RSPEAK(419) !TIME PASSES. DO 60100 I=1,3 !WAIT A WHILE. IF(CLOCKD(X)) RETURN 60100 CONTINUE RETURN C C O130-- CRYPT FUNCTION C 61000 IF(.NOT.ENDGMF) GO TO 45000 !IF NOT EG, DIE. IF(PRSA.NE.OPENW) GO TO 61100 !OPEN? I=793 IF(QOPEN(TOMB)) I=794 CALL RSPEAK(I) OFLAG2(TOMB)=OFLAG2(TOMB).OR.OPENBT !NOW TOMB WITH VIEW. RETURN C 61100 IF(PRSA.NE.CLOSEW) GO TO 45000 !CLOSE? I=795 IF(QOPEN(TOMB)) I=796 CALL RSPEAK(I) OFLAG2(TOMB)=OFLAG2(TOMB).AND..NOT.OPENBT IF(HERE.EQ.CRYPT) CTICK(CEVSTE)=3 !IF IN CRYPT, START EG. RETURN C OAPPLI, PAGE 12 C C O131-- GLOBAL LADDER C 62000 IF((CPVEC(CPHERE+1).EQ.-2).OR.(CPVEC(CPHERE-1).EQ.-3)) 1 GO TO 62100 !LADDER HERE? CALL RSPEAK(865) !NO, LOSE. RETURN C 62100 IF((PRSA.EQ.CLMBW).OR.(PRSA.EQ.CLMBUW)) GO TO 62200 CALL RSPEAK(866) !CLIMB IT? RETURN C 62200 IF((CPHERE.EQ.10).AND.(CPVEC(CPHERE+1).EQ.-2)) 1 GO TO 62300 !AT EXIT? CALL RSPEAK(867) !NO, HIT YOUR HEAD. RETURN C 62300 F=MOVETO(CPANT,WINNER) !TO ANTEROOM. F=RMDESC(3) !DESCRIBE. RETURN C END C RAPPL1- SPECIAL PURPOSE ROOM ROUTINES, PART 1 C C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED C WRITTEN BY R. M. SUPNIK C C DECLARATIONS C LOGICAL FUNCTION RAPPL1(RI) IMPLICIT INTEGER (A-Z) LOGICAL QOPEN,QON,QHERE,PROB,F LOGICAL MOVETO,LIT C C PARSER OUTPUT C LOGICAL PRSWON COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD, 1 LTSHFT,BLOC,MUNGRM,HS,EGSCOR,EGMXSC C C SCREEN OF LIGHT C COMMON /SCREEN/ FROMDR,SCOLRM,SCOLAC COMMON /SCREEN/ SCOLDR(8),SCOLWL(12) C C MISCELLANEOUS VARIABLES C COMMON /BATS/ BATDRP(9) C C ROOMS C COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200), 1 RACTIO(200),RVAL(200),RFLAG(200) INTEGER RRAND(200) EQUIVALENCE (RVAL,RRAND) C COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR, 1 RSACRD,RFILL,RMUNG,RBUCK,RHOUSE,RNWALL,REND C COMMON /RINDEX/ WHOUS,LROOM,CELLA COMMON /RINDEX/ MTROL,MAZE1 COMMON /RINDEX/ MGRAT,MAZ15 COMMON /RINDEX/ FORE1,FORE3,CLEAR,RESER COMMON /RINDEX/ STREA,EGYPT,ECHOR COMMON /RINDEX/ TSHAF COMMON /RINDEX/ BSHAF,MMACH,DOME,MTORC COMMON /RINDEX/ CAROU COMMON /RINDEX/ RIDDL,LLD2,TEMP1,TEMP2,MAINT COMMON /RINDEX/ BLROO,TREAS,RIVR1,RIVR2,RIVR3,MCYCL COMMON /RINDEX/ RIVR4,RIVR5,FCHMP,FALLS,MBARR COMMON /RINDEX/ MRAIN,POG,VLBOT,VAIR1,VAIR2,VAIR3,VAIR4 COMMON /RINDEX/ LEDG2,LEDG3,LEDG4,MSAFE,CAGER COMMON /RINDEX/ CAGED,TWELL,BWELL,ALICE,ALISM,ALITR COMMON /RINDEX/ MTREE,BKENT,BKVW,BKTWI,BKVAU,BKBOX COMMON /RINDEX/ CRYPT,TSTRS,MRANT,MREYE COMMON /RINDEX/ MRA,MRB,MRC,MRG,MRD,FDOOR COMMON /RINDEX/ MRAE,MRCE,MRCW,MRGE,MRGW,MRDW,INMIR COMMON /RINDEX/ SCORR,NCORR,PARAP,CELL,PCELL,NCELL COMMON /RINDEX/ CPANT,CPOUT,CPUZZ C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT, 1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT, 2 TOOLBT,TURNBT,ONBT COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT, 1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT, 2 TCHBT,VEHBT,SCHBT C COMMON /OINDEX/ GARLI,FOOD,GUNK,COAL,MACHI,DIAMO,TCASE,BOTTL COMMON /OINDEX/ WATER,ROPE,KNIFE,SWORD,LAMP,BLAMP,RUG COMMON /OINDEX/ LEAVE,TROLL,AXE COMMON /OINDEX/ RKNIF,KEYS,ICE,BAR COMMON /OINDEX/ COFFI,TORCH,TBASK,FBASK,IRBOX COMMON /OINDEX/ GHOST,TRUNK,BELL,BOOK,CANDL COMMON /OINDEX/ MATCH,TUBE,PUTTY,WRENC,SCREW,CYCLO,CHALI COMMON /OINDEX/ THIEF,STILL,WINDO,GRATE,DOOR COMMON /OINDEX/ HPOLE,LEAK,RBUTT,RAILI COMMON /OINDEX/ POT,STATU,IBOAT,DBOAT,PUMP,RBOAT COMMON /OINDEX/ STICK,BUOY,SHOVE,BALLO,RECEP,GUANO COMMON /OINDEX/ BROPE,HOOK1,HOOK2,SAFE,SSLOT,BRICK,FUSE COMMON /OINDEX/ GNOME,BLABE,DBALL,TOMB COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE COMMON /OINDEX/ ROBOT,FTREE,BILLS,PORTR,SCOL,ZGNOM COMMON /OINDEX/ EGG,BEGG,BAUBL,CANAR,BCANA COMMON /OINDEX/ YLWAL,RDWAL,PINDR,RBEAM COMMON /OINDEX/ ODOOR,QDOOR,CDOOR,NUM1,NUM8 COMMON /OINDEX/ WARNI,CSLIT,GCARD,STLDR COMMON /OINDEX/ HANDS,WALL,LUNGS,SAILO,AVIAT,TEETH COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,WNORT,GWATE,MASTER C C CLOCK INTERRUPTS C LOGICAL*1 CFLAG COMMON /CEVENT/ CLNT,CTICK(25),CACTIO(25),CFLAG(25) C COMMON /CINDEX/ CEVCUR,CEVMNT,CEVLNT,CEVMAT,CEVCND, 1 CEVBAL,CEVBRN,CEVFUS,CEVLED,CEVSAF,CEVVLG, 2 CEVGNO,CEVBUC,CEVSPH,CEVEGH, 3 CEVFOR,CEVSCL,CEVZGI,CEVZGO,CEVSTE, 5 CEVMRS,CEVPIN,CEVINQ,CEVFOL C LOGICAL THFFLG,THFACT,SWDACT COMMON /HACK/ THFPOS,THFFLG,THFACT,SWDACT C C ADVENTURERS C COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4), 1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4) C COMMON /AINDEX/ PLAYER,AROBOT,AMASTR C C VERBS C COMMON /VINDEX/ CINTW,DEADXW,FRSTQW,INXW,OUTXW COMMON /VINDEX/ WALKIW,FIGHTW,FOOW COMMON /VINDEX/ MELTW,READW,INFLAW,DEFLAW,ALARMW,EXORCW COMMON /VINDEX/ PLUGW,KICKW,WAVEW,RAISEW,LOWERW,RUBW COMMON /VINDEX/ PUSHW,UNTIEW,TIEW,TIEUPW,TURNW,BREATW COMMON /VINDEX/ KNOCKW,LOOKW,EXAMIW,SHAKEW,MOVEW,TRNONW,TRNOFW COMMON /VINDEX/ OPENW,CLOSEW,FINDW,WAITW,SPINW,BOARDW,UNBOAW,TAKEW COMMON /VINDEX/ INVENW,FILLW,EATW,DRINKW,BURNW COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW COMMON /VINDEX/ DIGW,LEAPW,STAYW,FOLLOW COMMON /VINDEX/ HELLOW,LOOKIW,LOOKUW,PUMPW,WINDW COMMON /VINDEX/ CLMBW,CLMBUW,CLMBDW,TRNTOW C C FLAGS C LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF, 1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF, 2 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF, 3 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF, 4 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF, 5 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF, 6 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF, 7 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ BTIEF,BINFF COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP COMMON /FINDEX/ MDIR,MLOC,POLEUF COMMON /FINDEX/ QUESNO,NQATT,CORRCT COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE C C FUNCTIONS AND DATA C QOPEN(R)=(OFLAG2(R).AND.OPENBT).NE.0 QON(R)=(OFLAG1(R).AND.ONBT).NE.0 C RAPPL1, PAGE 2 C RAPPL1=.TRUE. !USUALLY IGNORED. IF(RI.EQ.0) RETURN !RETURN IF NAUGHT. C !SET TO FALSE FOR C !NEW DESC NEEDED. GO TO (1000,2000,3000,4000,5000,6000,7000,8000,9000,10000, 1 11000,12000,13000,14000,15000,16000,17000,18000,19000,20000, 2 21000,22000,23000,24000,25000,26000,27000,28000,29000,30000, 3 31000,32000,33000,34000,35000,36000,37000),RI CALL BUG(1,RI) C C R1-- EAST OF HOUSE. DESCRIPTION DEPENDS ON STATE OF WINDOW C 1000 IF(PRSA.NE.LOOKW) RETURN !LOOK? I=13 !ASSUME CLOSED. IF(QOPEN(WINDO)) I=12 !IF OPEN, AJAR. CALL RSPSUB(11,I) !DESCRIBE. RETURN C C R2-- KITCHEN. SAME VIEW FROM INSIDE. C 2000 IF(PRSA.NE.LOOKW) RETURN !LOOK? I=13 !ASSUME CLOSED. IF(QOPEN(WINDO)) I=12 !IF OPEN, AJAR. CALL RSPSUB(14,I) !DESCRIBE. RETURN C C R3-- LIVING ROOM. DESCRIPTION DEPENDS ON MAGICF (STATE OF C DOOR TO CYCLOPS ROOM), RUG (MOVED OR NOT), DOOR (OPEN OR CLOSED) C 3000 IF(PRSA.NE.LOOKW) GO TO 3500 !LOOK? I=15 !ASSUME NO HOLE. IF(MAGICF) I=16 !IF MAGICF, CYCLOPS HOLE. CALL RSPEAK(I) !DESCRIBE. I=17+ORRUG !ASSUME INITIAL STATE. IF(QOPEN(DOOR)) I=I+2 !DOOR OPEN? CALL RSPEAK(I) !DESCRIBE. RETURN C C NOT A LOOK WORD. REEVALUATE TROPHY CASE. C 3500 IF((PRSA.NE.TAKEW).AND.((PRSA.NE.PUTW).OR.(PRSI.NE.TCASE))) 1 RETURN !IF NOT TAKE OR PUT. ASCORE(WINNER)=RWSCOR !SCORE TROPHY CASE. DO 3600 I=1,OLNT !RETAIN RAW SCORE AS WELL. J=I !FIND OUT IF IN CASE. 3550 J=OCAN(J) !TRACE OWNERSHIP. IF(J.EQ.0) GO TO 3600 IF(J.NE.TCASE) GO TO 3550 !DO ALL LEVELS. ASCORE(WINNER)=ASCORE(WINNER)+OTVAL(I) 3600 CONTINUE CALL SCRUPD(0) !SEE IF ENDGAME TRIG. RETURN C RAPPL1, PAGE 3 C C R4-- CELLAR. SHUT DOOR AND BAR IT IF HE JUST WALKED IN. C 4000 IF(PRSA.NE.LOOKW) GO TO 4500 !LOOK? CALL RSPEAK(21) !DESCRIBE CELLAR. RETURN C 4500 IF(PRSA.NE.WALKIW) RETURN !WALKIN? IF((OFLAG2(DOOR).AND.(OPENBT+TCHBT)).NE.OPENBT) RETURN OFLAG2(DOOR)=(OFLAG2(DOOR).OR.TCHBT).AND. .NOT.OPENBT CALL RSPEAK(22) !SLAM AND BOLT DOOR. RETURN C C R5-- MAZE11. DESCRIBE STATE OF GRATING. C 5000 IF(PRSA.NE.LOOKW) RETURN !LOOK? CALL RSPEAK(23) !DESCRIBE. I=24 !ASSUME LOCKED. IF(GRUNLF) I=26 !UNLOCKED? IF(QOPEN(GRATE)) I=25 !OPEN? CALL RSPEAK(I) !DESCRIBE GRATE. RETURN C C R6-- CLEARING. DESCRIBE CLEARING, MOVE LEAVES. C 6000 IF(PRSA.NE.LOOKW) GO TO 6500 !LOOK? CALL RSPEAK(27) !DESCRIBE. IF(RVCLR.EQ.0) RETURN !LEAVES MOVED? I=28 !YES, ASSUME GRATE CLOSED. IF(QOPEN(GRATE)) I=29 !OPEN? CALL RSPEAK(I) !DESCRIBE GRATE. RETURN C 6500 IF((RVCLR.NE.0).OR.(QHERE(LEAVE,CLEAR).AND. 1 ((PRSA.NE.MOVEW).OR.(PRSO.NE.LEAVE)))) RETURN CALL RSPEAK(30) !MOVE LEAVES, REVEAL GRATE. RVCLR=1 !INDICATE LEAVES MOVED. RETURN C RAPPL1, PAGE 4 C C R7-- RESERVOIR SOUTH. DESCRIPTION DEPENDS ON LOW TIDE FLAG. C 7000 IF(PRSA.NE.LOOKW) RETURN !LOOK? I=31 !ASSUME FULL. IF(LWTIDF) I=32 !IF LOW TIDE, EMPTY. CALL RSPEAK(I) !DESCRIBE. CALL RSPEAK(33) !DESCRIBE EXITS. RETURN C C R8-- RESERVOIR. STATE DEPENDS ON LOW TIDE FLAG. C 8000 IF(PRSA.NE.LOOKW) RETURN !LOOK? I=34 !ASSUME FULL. IF(LWTIDF) I=35 !IF LOW TIDE, EMTPY. CALL RSPEAK(I) !DESCRIBE. RETURN C C R9-- RESERVOIR NORTH. ALSO DEPENDS ON LOW TIDE FLAG. C 9000 IF(PRSA.NE.LOOKW) RETURN !LOOK? I=36 !YOU GET THE IDEA. IF(LWTIDF) I=37 CALL RSPEAK(I) CALL RSPEAK(38) RETURN C C R10-- GLACIER ROOM. STATE DEPENDS ON MELTED, VANISHED FLAGS. C 10000 IF(PRSA.NE.LOOKW) RETURN !LOOK? CALL RSPEAK(39) !BASIC DESCRIPTION. I=0 !ASSUME NO CHANGES. IF(GLACMF) I=40 !PARTIAL MELT? IF(GLACRF) I=41 !COMPLETE MELT? CALL RSPEAK(I) !DESCRIBE. RETURN C C R11-- FOREST ROOM C 11000 IF(PRSA.EQ.WALKIW) CFLAG(CEVFOR)=.TRUE. !IF WALK IN, BIRDIE. RETURN C C R12-- MIRROR ROOM. STATE DEPENDS ON MIRROR INTACT. C 12000 IF(PRSA.NE.LOOKW) RETURN !LOOK? CALL RSPEAK(42) !DESCRIBE. IF(MIRRMF) CALL RSPEAK(43) !IF BROKEN, NASTY REMARK. RETURN C RAPPL1, PAGE 5 C C R13-- CAVE2 ROOM. BLOW OUT CANDLES WITH 50% PROBABILITY. C 13000 IF(PRSA.NE.WALKIW) RETURN !WALKIN? IF(PROB(50,50).OR.(OADV(CANDL).NE.WINNER).OR. 1 .NOT.QON(CANDL)) RETURN !BLOW EM OUT? OFLAG1(CANDL)=OFLAG1(CANDL).AND. .NOT. ONBT !YES. CALL RSPEAK(47) !TELL OF WINDS. CFLAG(CEVCND)=.FALSE. !HALT CANDLE COUNTDOWN. RETURN C C R14-- BOOM ROOM. BLOW HIM UP IF CARRYING FLAMING OBJECT. C 14000 J=ODESC2(CANDL) !ASSUME CANDLE. IF((OADV(CANDL).EQ.WINNER).AND.QON(CANDL)) GO TO 14100 J=ODESC2(TORCH) !ASSUME TORCH. IF((OADV(TORCH).EQ.WINNER).AND.QON(TORCH)) GO TO 14100 J=ODESC2(MATCH) IF((OADV(MATCH).EQ.WINNER).AND.QON(MATCH)) GO TO 14100 RETURN !SAFE C 14100 IF(PRSA.NE.TRNONW) GO TO 14200 !TURN ON? CALL RSPSUB(294,J) !BOOM! CALL JIGSUP(44) RETURN C 14200 IF(PRSA.NE.WALKIW) RETURN !WALKIN? CALL RSPSUB(295,J) !BOOM! CALL JIGSUP(44) RETURN C C R15-- NO-OBJS. SEE IF EMPTY HANDED, SCORE LIGHT SHAFT. C 15000 EMPTHF=.TRUE. !ASSUME TRUE. DO 15100 I=1,OLNT !SEE IF CARRYING. IF(OADV(I).EQ.WINNER) EMPTHF=.FALSE. 15100 CONTINUE C IF((HERE.NE.BSHAF).OR.(.NOT.LIT(HERE))) RETURN CALL SCRUPD(LTSHFT) !SCORE LIGHT SHAFT. LTSHFT=0 !NEVER AGAIN. RETURN C RAPPL1, PAGE 6 C C R16-- MACHINE ROOM. DESCRIBE MACHINE. C 16000 IF(PRSA.NE.LOOKW) RETURN !LOOK? I=46 !ASSUME LID CLOSED. IF(QOPEN(MACHI)) I=12 !IF OPEN, OPEN. CALL RSPSUB(45,I) !DESCRIBE. RETURN C C R17-- BAT ROOM. UNLESS CARRYING GARLIC, FLY AWAY WITH ME... C 17000 IF(PRSA.NE.LOOKW) GO TO 17500 !LOOK? CALL RSPEAK(48) !DESCRIBE ROOM. IF(OADV(GARLI).EQ.WINNER) CALL RSPEAK(49) !BAT HOLDS NOSE. RETURN C 17500 IF((PRSA.NE.WALKIW).OR.(OADV(GARLI).EQ.WINNER)) RETURN CALL RSPEAK(50) !TIME TO FLY, JACK. F=MOVETO(BATDRP(RND(9)+1),WINNER) !SELECT RANDOM DEST. RAPPL1=.FALSE. !INDICATE NEW DESC NEEDED. RETURN C C R18-- DOME ROOM. STATE DEPENDS ON WHETHER ROPE TIED TO RAILING. C 18000 IF(PRSA.NE.LOOKW) GO TO 18500 !LOOK? CALL RSPEAK(51) !DESCRIBE. IF(DOMEF) CALL RSPEAK(52) !IF ROPE, DESCRIBE. RETURN C 18500 IF(PRSA.EQ.LEAPW) CALL JIGSUP(53) !DID HE JUMP??? RETURN C C R19-- TORCH ROOM. ALSO DEPENDS ON WHETHER ROPE TIED TO RAILING. C 19000 IF(PRSA.NE.LOOKW) RETURN !LOOK? CALL RSPEAK(54) !DESCRIBE. IF(DOMEF) CALL RSPEAK(55) !IF ROPE, DESCRIBE. RETURN C C R20-- CAROUSEL ROOM. SPIN HIM OR KILL HIM. C 20000 IF(PRSA.NE.LOOKW) GO TO 20500 !LOOK? CALL RSPEAK(56) !DESCRIBE. IF(.NOT.CAROFF) CALL RSPEAK(57) !IF NOT FLIPPED, SPIN. RETURN C 20500 IF((PRSA.EQ.WALKIW).AND.CAROZF) CALL JIGSUP(58) !WALKED IN. RETURN C RAPPL1, PAGE 7 C C R21-- LLD ROOM. HANDLE EXORCISE, DESCRIPTIONS. C 21000 IF(PRSA.NE.LOOKW) GO TO 21500 !LOOK? CALL RSPEAK(59) !DESCRIBE. IF(.NOT.LLDF) CALL RSPEAK(60) !IF NOT VANISHED, GHOSTS. RETURN C 21500 IF(PRSA.NE.EXORCW) RETURN !EXORCISE? IF((OADV(BELL).EQ.WINNER).AND.(OADV(BOOK).EQ.WINNER).AND. 1 (OADV(CANDL).EQ.WINNER).AND.QON(CANDL)) GO TO 21600 CALL RSPEAK(62) !NOT EQUIPPED. RETURN C 21600 IF(QHERE(GHOST,HERE)) GO TO 21700 !GHOST HERE? CALL JIGSUP(61) !NOPE, EXORCISE YOU. RETURN C 21700 CALL NEWSTA(GHOST,63,0,0,0) !VANISH GHOST. LLDF=.TRUE. !OPEN GATE. RETURN C C R22-- LLD2-ROOM. IS HIS HEAD ON A POLE? C 22000 IF(PRSA.NE.LOOKW) RETURN !LOOK? CALL RSPEAK(64) !DESCRIBE. IF(ONPOLF) CALL RSPEAK(65) !ON POLE? RETURN C C R23-- DAM ROOM. DESCRIBE RESERVOIR, PANEL. C 23000 IF(PRSA.NE.LOOKW) RETURN !LOOK? CALL RSPEAK(66) !DESCRIBE. I=67 IF(LWTIDF) I=68 CALL RSPEAK(I) !DESCRIBE RESERVOIR. CALL RSPEAK(69) !DESCRIBE PANEL. IF(GATEF) CALL RSPEAK(70) !BUBBLE IS GLOWING. RETURN C C R24-- TREE ROOM C 24000 IF(PRSA.NE.LOOKW) RETURN !LOOK? CALL RSPEAK(660) !DESCRIBE. I=661 !SET FLAG FOR BELOW. DO 24200 J=1,OLNT !DESCRIBE OBJ IN FORE3. IF(.NOT.QHERE(J,FORE3).OR.(J.EQ.FTREE)) GO TO 24200 CALL RSPEAK(I) !SET STAGE, I=0 CALL RSPSUB(502,ODESC2(J)) !DESCRIBE. 24200 CONTINUE RETURN C RAPPL1, PAGE 8 C C R25-- CYCLOPS-ROOM. DEPENDS ON CYCLOPS STATE, ASLEEP FLAG, MAGIC FLAG. C 25000 IF(PRSA.NE.LOOKW) RETURN !LOOK? CALL RSPEAK(606) !DESCRIBE. I=607 !ASSUME BASIC STATE. IF(RVCYC.GT.0) I=608 !>0? HUNGRY. IF(RVCYC.LT.0) I=609 !<0? THIRSTY. IF(CYCLOF) I=610 !ASLEEP? IF(MAGICF) I=611 !GONE? CALL RSPEAK(I) !DESCRIBE. IF(.NOT.CYCLOF .AND.(RVCYC.NE.0)) 1 CALL RSPEAK(193+IABS(RVCYC)) !CYCLOPS IS ANNOYED. RETURN C C R26-- BANK BOX ROOM. C 26000 IF(PRSA.NE.WALKIW) RETURN !SURPRISE HIM. DO 26100 I=1,8,2 !SCOLRM DEPENDS ON IF(FROMDR.EQ.SCOLDR(I)) SCOLRM=SCOLDR(I+1) 26100 CONTINUE !ENTRY DIRECTION. RETURN C C R27-- TREASURE ROOM. C 27000 IF((PRSA.NE.WALKIW).OR. .NOT.THFACT) 1 RETURN !WALKIN, THIEF ACTIVE? IF(OROOM(THIEF).NE.HERE) 1 CALL NEWSTA(THIEF,82,HERE,0,0) !NO, MATERIALIZE HIM. THFPOS=HERE !RESET SEARCH PATTERN. OFLAG2(THIEF)=OFLAG2(THIEF).OR.FITEBT !HE'S ANGRY. IF(OROOM(CHALI).EQ.HERE) 1 OFLAG1(CHALI)=OFLAG1(CHALI).AND..NOT.TAKEBT C C VANISH EVERYTHING IN ROOM C J=0 !ASSUME NOTHING TO VANISH. DO 27200 I=1,OLNT IF((I.EQ.CHALI).OR.(I.EQ.THIEF).OR..NOT.QHERE(I,HERE)) 1 GO TO 27200 !HERE? J=83 !FLAG BYEBYE. OFLAG1(I)=OFLAG1(I).AND..NOT.VISIBT !AWAY IT GOES. 27200 CONTINUE CALL RSPEAK(J) !DESCRIBE. RETURN C C R28-- CLIFF FUNCTION. SEE IF CARRYING INFLATED BOAT. C 28000 DEFLAF=OADV(RBOAT).NE.WINNER !TRUE IF NOT CARRYING. RETURN C RAPPL1, PAGE 9 C C R29-- RIVR4 ROOM. PLAY WITH BUOY. C 29000 IF(.NOT.BUOYF.OR.(OADV(BUOY).NE.WINNER)) RETURN CALL RSPEAK(84) !GIVE HINT, BUOYF=.FALSE. !THEN DISABLE. RETURN C C R30-- OVERFALLS. DOOM. C 30000 IF(PRSA.NE.LOOKW) CALL JIGSUP(85) !OVER YOU GO. RETURN C C R31-- BEACH ROOM. DIG A HOLE. C 31000 IF((PRSA.NE.DIGW).OR.(PRSO.NE.SHOVE)) RETURN RVSND=RVSND+1 !INCREMENT DIG STATE. GO TO (31100,31100,31100,31400,31500),RVSND !PROCESS STATE. CALL BUG(2,RVSND) C 31100 CALL RSPEAK(85+RVSND) !1-3... DISCOURAGE HIM. RETURN C 31400 I=89 !ASSUME DISCOVERY. IF((OFLAG1(STATU).AND.VISIBT).NE.0) I=88 !ALREADY DONE. CALL RSPEAK(I) OFLAG1(STATU)=OFLAG1(STATU).OR.VISIBT !MATERIALIZE STATUE. RETURN C 31500 RVSND=0 !5... SAND COLLAPSES CALL JIGSUP(90) !AND SO DOES HE. RETURN C C R32-- TCAVE ROOM. DIG A HOLE IN GUANO. C 32000 IF((PRSA.NE.DIGW).OR.(PRSO.NE.SHOVE)) RETURN I=91 !ASSUME NO GUANO. IF(.NOT. QHERE(GUANO,HERE)) GO TO 32100 !IS IT HERE? RVGUA=MIN0(4,RVGUA+1) !YES, SET NEW STATE. I=91+RVGUA !GET NASTY REMARK. 32100 CALL RSPEAK(I) !DESCRIBE. RETURN C C R33-- FALLS ROOM C 33000 IF(PRSA.NE.LOOKW) RETURN !LOOK? CALL RSPEAK(96) !DESCRIBE. I=97 !ASSUME NO RAINBOW. IF(RAINBF) I=98 !GOT ONE? CALL RSPEAK(I) !DESCRIBE. RETURN C RAPPL1, PAGE 10 C C R34-- LEDGE FUNCTION. LEDGE CAN COLLAPSE. C 34000 IF(PRSA.NE.LOOKW) RETURN !LOOK? CALL RSPEAK(100) !DESCRIBE. I=102 !ASSUME SAFE ROOM OK. IF((RFLAG(MSAFE).AND.RMUNG).NE.0) I=101 !IF MUNGED, ROOM GONE. CALL RSPEAK(I) !DESCRIBE. RETURN C C R35-- SAFE ROOM. STATE DEPENDS ON WHETHER SAFE BLOWN. C 35000 IF(PRSA.NE.LOOKW) RETURN !LOOK? CALL RSPEAK(104) !DESCRIBE. I=105 !ASSUME OK. IF(SAFEF) I=106 !BLOWN? CALL RSPEAK(I) !DESCRIBE. RETURN C C R36-- MAGNET ROOM. DESCRIBE, CHECK FOR SPINDIZZY DOOM. C 36000 IF(PRSA.NE.LOOKW) GO TO 36500 !LOOK? CALL RSPEAK(107) !DESCRIBE. RETURN C 36500 IF((PRSA.NE.WALKIW).OR. .NOT.CAROFF) RETURN !WALKIN ON FLIPPED? IF(CAROZF) GO TO 36600 !ZOOM? CALL RSPEAK(108) !NO, SPIN HIS COMPASS. RETURN C 36600 I=58 !SPIN HIS INSIDES. IF(WINNER.NE.PLAYER) I=99 !SPIN ROBOT. CALL JIGSUP(I) !DEAD. RETURN C C R37-- CAGE ROOM. IF SOLVED CAGE, MOVE TO OTHER CAGE ROOM. C 37000 IF(CAGESF) F=MOVETO(CAGER,WINNER) !IF SOLVED, MOVE. RETURN C END .TITLE RND - RANDOM NUMBER GENERATOR .SBTTL STOLEN FROM FORTRAN-IV-PLUS RUNTIME SYSTEM .ENABL AMA ; .GLOBL INIRND,RND ; ;THIS PACKAGE CONSISTS OF TWO SUBROUTINES: ; ;INIRND- INIT RANDOM NUMBER GENERATOR ;RND- GENERATE RANDOM INTEGER ; ;CALLING SEQUENCES- ; ; CALL INIRND(SEED1,SEED2) ; ; N=RND(MAX) ; INIRND: MOV @2(R5),LONUM ;PICK UP SEEDS. MOV @4(R5),HINUM RTS PC ; LONUM: .WORD 0 HINUM: .WORD 0 ; RND: MOV LONUM,R3 ;GET LOW SEED. BNE 10$ ;IF NE, OK. MOV HINUM,R2 ;GET HIGH SEED. BNE 20$ ;IF NE, OK. MOV #3,R3 ;BOTH ZERO, RESEED WITH 2**16+3. MOV #1,R2 BR 20$ ; 10$: MOV HINUM,R2 ;SEED NOW IN R2:R3. 20$: MOV R3,R0 ;MULTIPLY BY 2**16 (LEFT SHIFT 16). CLR R1 ADD R3,R1 ;+3 (ADD IN 3 TIMES). ADC R0 ADD R2,R0 ADD R3,R1 ADC R0 ADD R2,R0 ADD R3,R1 ADC R0 ADD R2,R0 MOV R1,LONUM ;SAVE RESULTS. MOV R0,HINUM ; MOV R0,R1 CLR R0 MOV #16.,R2 ;PREPARE FOR DIVIDE. ASL R1 30$: ROL R0 ;ROTATE DIVIDEND. CMP @2(R5),R0 ;SUBTRACT WORK? BHI 40$ ;IF HI, NO. SUB @2(R5),R0 SEC 40$: ROL R1 ;ONWARD. DEC R2 BNE 30$ RTS PC ; .END $JOB/NAME=DUNGEO $! $!Job to compile and link Dungeon under RSTS/E $! $!First compile Fortran-IV modules $! $RUN $FORTRA DMAIN=DMAIN.FTN/S/V DGAME=DGAME.FTN/S/V DSUB=DSUB.FTN/S/V DINIT=DINIT.FTN/S/V GDT=GDT.FTN/S/V NP=NP.FOR/S/V NP1=NP1.FOR/S/V NP2=NP2.FOR/S/V NP3=NP3.FOR/S/V VERBS=VERBS.FTN/S/V OBJCTS=OBJCTS.FTN/S/V SVERBS=SVERBS.FTN/S/V DVERB1=DVERB1.FTN/S/V DVERB2=DVERB2.FTN/S/V ACTORS=ACTORS.FTN/S/V DEMONS=DEMONS.FTN/S/V CLOCKR=CLOCKR.FTN/S/V ROOMS=ROOMS.FOR/S/V NROOMS=NROOMS.FOR/S/V SOBJS=SOBJS.FOR/S/V NOBJS=NOBJS.FOR/S/V BALLOP=BALLOP.FOR/S/V LIGHTP=LIGHTP.FOR/S/V VILLNS=VILLNS.FOR/S/V DSO1=DSO1.FOR/S/V DSO2=DSO2.FOR/S/V DSO3=DSO3.FOR/S/V DSO4=DSO4.FOR/S/V DSO5=DSO5.FOR/S/V DSO6=DSO6.FOR/S/V DSO7=DSO7.FOR/S/V RTTIM=RTTIM.FOR/S/V $! $!Next assemble Macro-11 modules $! $RUN $MACRO RRND=RRND $! $!Finally link all components $! $RUN $LINK DUNGEO=DMAIN,DGAME,DSUB,RRND,RTTIM/F/B:1200// DINIT,GDT/O:1 NP,NP1,NP2,NP3/O:1 VERBS,OBJCTS/O:1 SVERBS/O:2 DVERB1/O:2 DVERB2/O:2 ACTORS/O:2 DEMONS/O:2 CLOCKR/O:2 ROOMS/O:3 NROOMS/O:3 SOBJS/O:3 NOBJS/O:3 BALLOP,LIGHTP,VILLNS/O:3 DSO1/O:4 DSO2/O:4 DSO3/O:4 DSO4/O:4 DSO5/O:4 DSO6/O:4 DSO7/O:4// $! $!Done $! $EOJ LINK/INCLU/PRO/MAP:NL:/BOT:1200/EXE:DUNGEO DMAIN,DGAME,DSUB,RRND,RTTIM DINIT,GDT/O:1 NP,NP1,NP2,NP3/O:1 VERBS,OBJCTS/O:1 SVERBS/O:2 DVERB1/O:2 DVERB2/O:2 ACTORS/O:2 DEMONS/O:2 CLOCKR/O:2 ROOMS/O:3 NROOMS/O:3 SOBJS/O:3 NOBJS/O:3 BALLOP,LIGHTP,VILLNS/O:3 DSO1/O:4 DSO2/O:4 DSO3/O:4 DSO4/O:4 DSO5/O:4 DSO6/O:4 DSO7/O:4// $SHORT COM/NOLINE DMAIN.FTN,DGAME.FTN,DSUB.FTN COM/NOLINE DINIT.FTN COM/NOLINE NP,NP1,NP2,NP3 COM/NOLINE/NOVEC GDT.FTN COM/NOLINE VERBS.FTN,OBJCTS.FTN COM/NOLINE SVERBS.FTN,DVERB1.FTN,DVERB2.FTN,ACTORS.FTN,DEMONS.FTN,CLOCKR.FTN COM/NOLINE ROOMS.FOR,NROOMS.FOR COM/NOLINE SOBJS.FOR,NOBJS.FOR,BALLOP.FOR,LIGHTP.FOR,VILLNS.FOR COM/NOLINE DSO1.FOR,DSO2.FOR,DSO3.FOR,DSO4.FOR,DSO5.FOR,DSO6.FOR,DSO7.FOR COM/NOLINE RTTIM.FOR COM RRND.MAC C ITIME- RETURN TIME IN HOURS, MINUTES, AND SECONDS C C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED C WRITTEN BY R. M. SUPNIK C C DECLARATIONS C SUBROUTINE ITIME(H,M,S) IMPLICIT INTEGER(A-Z) INTEGER*4 T C CALL GTIM(T) !GET TIME IN TICKS. CALL CVTTIM(T,H,M,S,TK) !CONVERT TO H,M,S,TICKS. RETURN END ;@1[)eoO0v_nEe{1|SUłb zߨ+0A-j5cӇw[>o>R!mݡ# ɮt\UuQ |ܲX^t['ǠǙ=Ę8礞`#^ћH841~>8/S'.NfBF`} n̔ ^kUe\6ӑHTǣXWB#ǸoHpOBPPOVfV;ӹ&R)#A;5U=t%^WtSٛ@Ͼ>X xXuɠ3=ӆ\rl'F]:Xb΀ނc$>,`f0A&g7&Θ@9Pnڸ)7 iNdi|%OG'PW&ǟw-hjCn