      PROGRAM QORK
C
C DUNGEON-- MAIN PROGRAM
C
C       PROGRAM DUNGEON (ALIAS ZORK/QORK)
C       ------- -------
C
C       2015.04.01 Stephen O. Lidie, LUCC
C           x86_64, pgf77/ifort/gfortran version,
C           tested on Mac OS X and CentOS 6.x.
C       1989.11.03 Stephen O. Lidie, LUCC
C           NOS/VE 1.4.x version
C
C DECLARATIONS
C
        implicit integer (A-Z)
        LOGICAL INIT,PROTCT
        COMMON /PRS/INIT
C
C    PLAY GAME
C
        open (unit=5, file='/dev/tty')

        IF(PROTCT(X)) GO TO 100
        write (6, 10)
10      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
     8a'     ,' commanding voice:'//20x,'''You shall not pass.'''//' As'
     9          ,' he grabs you by the neck all grows dim about you.')
        CALL EXIT
C
  100 CALL PRS0
      IF(INIT) GOTO 200
        write (6, 110)
110     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 f
     7ails.')
        CALL EXIT
C
200     CALL GAME
        CALL EXIT
        END
         BLOCK DATA
        implicit integer (A-Z)
*        LOGICAL INIT,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
        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,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
C
C MESSAGE INDEX
C
        COMMON /RMSG/ MLNT,RTEXT(800)
C
C MISCELLANEOUS VARIABLES
C
        COMMON /STAR/ MBASE,STRBIT
        COMMON /VERS/ VMAJ,VMIN,VEDIT
        COMMON /ZTIMES/ PLTIME,SHOUR,SMIN,SSEC
        COMMON /BATS/ BATDRP(9)
        COMMON /CHAN/ INPCH,OUTCH,DBCH
        COMMON /DEBUG/ DBGFLG,PRSFLG
C
C ROOMS
C
        COMMON /ROOMS/ RLNT,RDESC1(150),RDESC2(150),REXIT(150),
     1       RACTIO(150),RVAL(150),RFLAG(150),RRAND(150)
C
        COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR,
     1       RSACRD,RFILL,RMUNG,RBUCK,RHOUSE
C
        COMMON /RVARS/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA
C
        COMMON /RINDEX/ WHOUS,LROOM,CELLA
        COMMON /RINDEX/ MTROL,MAZE1
        COMMON /RINDEX/ MGRAT,MAZ15
        COMMON /RINDEX/ FORE1,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,WHITEC1,WHITEC2
C
C EXITS
C
        COMMON /EXITS/ XLNT,TRAVEL(625)
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
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
C
        COMMON /OROOM2/ R2LNT,O2(6),R2(6)
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,ECHOBT,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
        COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT
        COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE
        COMMON /OINDEX/ ROBOT,LUNGS,SAILO,AVIAT,TEETH
        COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,STAFF,SPIDER,TAPEST,WEB
C
C CLOCK INTERRUPTS
C
        LOGICAL CFLAG
        COMMON /CEVENT/ CLNT,CTICK(20),CACTIO(20),CFLAG(20)
C
        COMMON /CINDEX/ CEVCUR,CEVMNT,CEVLNT,CEVMAT,CEVCND,
     1       CEVBAL,CEVBRN,CEVFUS,CEVLED,CEVSAF,CEVVLG,
     2       CEVGNO,CEVBUC,CEVSPH,CEVEGH
C
C VILLAINS AND DEMONS
C
        LOGICAL THFFLG,SWDACT,THFACT
        COMMON /HACK/ THFPOS,THFFLG,THFACT,SWDACT,SWDSTA
        COMMON /VILL/ VLNT,VILLNS(5),VPROB(5),VOPPS(5)
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
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
        COMMON /VINDEX/ TAKEW,INVENW,FILLW,EATW,DRINKW,BURNW
        COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW
        COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW
        COMMON /VINDEX/ DIGW,LEAPW
C
C FLAGS
C
        LOGICAL FLAGS(35)
        LOGICAL TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
        LOGICAL DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
        LOGICAL MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
        LOGICAL EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
        LOGICAL GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
        LOGICAL GLACMF,FROBZF,ENDGMF,CYCLOF2,BUGF
        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,CYCLOF2,BUGF
        COMMON /FINDEX/ BTIEF,BINFF
C
      COMMON /LAIR/NTIMES
C VOCABULARIES

        integer*8 bvoc
        COMMON /BUZVOC/ BVOC(10)

        integer*8 pvoc
        COMMON /PRPVOC/ PVOC(32)

        integer*8 dvoc
        COMMON /DIRVOC/ DVOC(60)

        INTEGER*8 AVOC(200),avoc1,avoc2,avocnd
        COMMON /ADJVOC/ AVOC1(116),AVOC2(77),AVOCND

        INTEGER*8 VVOC(640),vvoc1,vvoc1a,vvoc2,vvoc3,vvoc4
        integer*8 vvoc5,vvoc6,vvoc7,vvocnd
        COMMON /VRBVOC/ VVOC1(67),VVOC1A(69),VVOC2(53),VVOC3(94),
     1          VVOC4(99),VVOC5(93),VVOC6(85),VVOC7(70),VVOCND

        INTEGER*8 OVOC(580), ovoc1, ovoc2, ovoc3, ovoc4, ovoc5
        integer*8 ovoc6,ovoc7,ovocnd
        COMMON /OBJVOC/ OVOC1(106),OVOC2(96),OVOC3(94),OVOC4(85),
     1          OVOC5(72),OVOC6(68),OVOC7(51),OVOCND
C
        EQUIVALENCE (VVOC(1),VVOC1(1))
        EQUIVALENCE (AVOC(1),AVOC1(1))
        EQUIVALENCE (OVOC(1),OVOC1(1))
        EQUIVALENCE (FLAGS(1),TROLLF)
C DUNGEON, PAGE 2
C
C DATA STATEMENTS FOR CONSTANT ARRAYS
C
      DATA BRIEFF,SUPERF/.FALSE.,.FALSE./
      DATA NTIMES/0/
      DATA VMAJ,VMIN,VEDIT/4,0,1hB/
C
        DATA SDIR/'40000'O/,SIND/'20000'O/,SSTD/'10000'O/,
     1             SFLIP/'4000'O/,SDRIV/'2000'O/,SVMASK/'777'O/
        DATA VABIT/'40000'O/,VRBIT/'20000'O/,VTBIT/'10000'O/,
     1             VCBIT/'4000'O/,VEBIT/'2000'O/,VPMASK/'777'O/
C
        DATA BATDRP/66,67,68,69,70,71,72,65,73/
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/
C
        DATA XRMASK/'377'O/,XDMASK/'76000'O/,XFMASK/3/
        DATA XFSHFT/256/,XASHFT/256/
        DATA XNORM/1/,XNO/2/,XCOND/3/,XDOOR/4/
        DATA XELNT/1,2,3,3/,XLFLAG/'100000'O/
        DATA XMIN/'2000'O/,XMAX/'40000'O/,XDOWN/'24000'O/
C
        DATA PLAYER/1/,AROBOT/2/
        DATA ASTAG/'100000'O/
C
        DATA RSEEN/'100000'O/,RLIGHT/'40000'O/,RLAND/'20000'O/
        DATA RWATER/'10000'O/,RAIR/'4000'O/,RSACRD/'2000'O/,RFILL/ '1000
     +'O/
        DATA RMUNG/'400'O/,RBUCK/'200'O/,RHOUSE/'100'O/
C
        DATA WHOUS/2/,LROOM/8/,CELLA/9/
        DATA MTROL/10/,MAZE1/11/
        DATA MGRAT/25/,MAZ15/30/
        DATA FORE1/31/,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/,WHITEC1/147/,WHITEC2/148/
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/
C
      DATA VISIBT/'100000'O/,READBT/'40000'O/,TAKEBT/'20000'O/,
     1       DOORBT/'10000'O/,
     1           TRANBT/'4000'O/,FOODBT/'2000'O/,NDSCBT/'1000'O/,DRNKBT/
     2'400'O/,               CONTBT/'200'O/,LITEBT/'100'O/,VICTBT/'40'O/
     3,BURNBT/'20'O/,                FLAMBT/'10'O/,TOOLBT/4/,TURNBT/2/,O
     3NBT/1/
C
        DATA FINDBT/'100000'O/,SLEPBT/'40000'O/,SCRDBT/'20000'O/,
     1       TIEBT/'10000'O/,
     1            ECHOBT/'4000'O/,ACTRBT/'2000'O/,WEAPBT/'1000'O/,FITEBT
     2/'400'O/,              VILLBT/'200'O/,STAGBT/'100'O/,TRYBT/'40'O/,
     3NOCHBT/'20'O/,                 OPENBT/'10'O/,TCHBT/4/,VEHBT/2/,SCH
     3BT/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/24/,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/
        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, ROBOT, ITOBJ, OPLAY, EVERY/141, 142, 150, 151, 152/
      DATA VALUA, SAILO, TEETH/153, 154, 155/
      DATA LUNGS, AVIAT, STAFF,SPIDER,TAPEST,WEB/159, 160, 144,145,146,1
     +47/
C
C BUZZ WORDS--  IGNORED IN SYNTACTIC PROCESSING
C
        DATA BVOC/3hand,2hby,2his,3hone,1ha,
     1     2han,3hthe,3hrun,2hgo,6hprocee/
C
C PREPOSITIONS--        MAPS PREPOSITIONS TO INDICES
C
        DATA PVOC/4hover,1,4hwith,2,5husing,2,6hthroug,2,
     1       2hat,3,2hto,4,2hin,5,6hinside,5,4hinto,5,
     2       4hdown,6,2hup,7,5hunder,8,2hof,9,2hon,10,
     3       3hoff,11,0,0/
c
C DIRECTIONS--  MAPS DIRECTIONS TO INDICES
C
        DATA DVOC/1hn,'2000'o,5hnorth,'2000'o,1hs,'4000'o,
     1       1he,'6000'o,4heast,'6000'o,1hw,'10000'o,4hwest,'10000'o,
     2       2hse,'12000'o,6hsouthe,'12000'o,2hsw,'14000'o,
     3       2hne,'16000'o,6hnorthe,'16000'o,2hnw,'20000'o,
     4       1hu,'22000'o,2hup,'22000'o,1hd,'24000'o,4hdown,'24000'o,
     5       6hlaunch,'26000'o,4hland,'30000'o,5henter,'32000'o,
     6       4hexit,'34000'o,3hout,'34000'o,5hleave,'34000'o,
     7       6htravel,'36000'o,5hclimb, '40000'o,5hsouth,'4000'o,
     8       6hsouthw,'14000'o,6hnorthw,'20000'o,2hin,'32000'o,
     9       5hcross,'36000'o/

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. "A (1600)", WHILE ALL OBJECTS
C ARE .LE. OLNT (255 MAX).
C
       DATA AVOC1/5hbrown,1,81,6helonga,1,3hhot,3,6hpepper,3,
     1       6hvitreo,4,4hjade,6,4hhuge,8,6henormo,8,122,
     2       6htrophy,9,5hclear,10,5hlarge,12,26,47,95,96,123,
     2    133,135,5hnasty,13,6helvish,14,5hbrass,15,16,46,
     3       6hbroken,16,92,113,6horient,17,
     4       6hbloody,20,5hrusty,24,6hburned,22,
     5       4hdead,22,6hbroken,22,3hold,25,41,44,45,6hleathe,25,
     5       6hplatin,26,5hpearl,27,
     6       4hmoby,31,6hcrysta,32,126,4hgold,33,85,104,
     7       5hivory,34,6hsapphi,37,6hwooden,38,67,136,137,
     7       4hiron,39,125,
     8       6hdented,39,5hfancy,40,6hancien,41,44,
     9       5hsmall,5,46,52,53,89,102,103,
     1       5hblack,47,4htour,49,
     2       6hviscou,55,6hviciou,62,
     3       5hglass,10,126,132,4htrap,66/
C
        DATA AVOC2/5hfront,68,5hstone,69,6hmangle,72,
     1      3hred,79,94,140,6hyellow,80,4hblue,82,112,114,141,
     2      6hvampir,83,5hmagic,90,
     3      6hseawor,90,3htan,91,5hsharp,92,
     4      6hwicker,98,5hcloth,100,
     5      6hbraide,101,
     6      5hgaudy,108,6hsquare,109,127,4hclay,109,
     7      5hshiny,110,4hthin,110,
     8      5hgreen,115,143,6hpurple,116,5hwhite,117,
     9      6hmarble,119,4hcoke,121,
     1      5hround,128,6htriang,129,
     2      4hrare,134,6hoblong,135,6heat$me,138,
     3      5heatme,138,6horange,139,4hecch,141,
     +      4hdark,148,5hlight,149,  2*0 /
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. "A (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
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/5hbrief,1,70,6hunbrie,1,71,
     1       6hsuperb,1,72,6hunsupe,1,73,6hversio,1,74,
     2       4hswim,5hbathe,4hwade,1,75,6hgeroni,1,76,
     3       6hulysse,6hodysse,6hsinbad,1,77,
     4       4hwell,1,78,4hpray,1,79,6htreasu,1,80,
     5       6htemple,1,81,5hblast,1,82,5hscore,1,83,
     6       6hfinish,4hquit,1,84,4hhelp,1,50,4hinfo,1,51,
     7       6hhistor,6hupdate,1,52,4hback,1,53,
     8       4hsigh,6hmumble,1,54/
c
        data vvoc1a/5hchomp,4hlose,4hbarf,1,55,
     1       6hdungeo,1,56,6hfroboz,1,57,3hfoo,6hbletch,
     2       6hjargon,1,58,6hrepent,1,59,5hhours,6hschedu,1,60,
     3       3hwin,1,61,4hyell,6hscream,5hshout,1,62,
     4       3hhop,4hskip,1,63,4hfuck,4hshit,4hdamn,
     5       5hcurse,1,64,4hqork,1,65,6hgranit,1,'50102'o,
     6       4hsave,1,149,6hrestor,1,150,4htime,1,90,
     7       6hdiagno,1,94,6hexorci,1,105,6hinvent,
     8       1hi,1,133,4hwait,1,128/
C
        DATA VVOC2/6hdeflat,1,'50147'o,
     1       6hdescri,4hwhat,5hwhats,6hexamin,1,'50170'o,
     1       4hfill,1,'50206'o,4hfind,4hseek,3hsee,1,'50177'o,
     2       4hkick,4hbite,5htaunt,1,'50153'o,5hlower,1,'50156'o,
     3       4hpush,5hpress,1,'50160'o,4hring,4hpeal,1,'50127'o,
     4       3hrub,6hcaress,5htouch,6hfondle,1,'50157'o,
     4       5hshake,1,'50171'o,4hspin,1,'50201'o,
     5       5huntie,4hfree,6hreleas,1,'50161'o,4hwalk,1,'50216'o/
c
        DATA VVOC3/6hattack,5hfight,6hinjure,3hhit,4hhurt,
     1       7,'60215'o,'20000'o,0,'200'O,'44002'O,0,'1000'O,
     2       5hboard,4,'40202'O,'20000'O,0,'2'O,
     3       5hbrush,5hclean,5,'52130'O,'70130'O,'64002'O,-1,-1,
     4       4hburn,6hignite,6hincine,7,'60211'O,'60000'O,
     5       '20'O,0, '64002'O,'10'O,0,
     6       5hclose,4,'40176'O,'60000'O,'10200'O,
     70,     3hdig,4,'40131'O,'44002'O,'4'O,
     80,     6hdisemb,4,'40203'O, '20000'O,0,'2'O,
     9       5hdrink,6himbibe,6hswallo,4,'40210'o,'60000'o,'400'o,0,
     1       4hdrop,11, '42221'o,'40000'o,-1,-1,'60221'O,
     2       '40000'O,-1,-1,'60005'o,-1,-1,3heat,
     +       6hconsum,6hgobble,5hmunch,5htaste,
     + 4,'40207'O,'74000'O,'2000'O,0,
     + 6hexting,5hdouse,4,'40174'O,'74000'O,'100'O,0/
C
        DATA VVOC4/4hgive,4hhand,6hdonate,11,'72222'O,'20004'O,
     1         '40'O,0,'64222'O,'20000'O,'40'O,0,'60000'O,-1,-1,
     2       5hhello,2hhi,2,'2126'O,'50126'O,
     3       4hblow,15,'62146'O,'60007'O,-1,-1,'60002'O,'4'O,0,
     4                             '40160'O,'60007'O,-1,-1,'40165'O, '60
     5005'O,-1,-1,                   6hinflat,4,'70146'O,'60002'O,'4'O,0
     6,                                    4hjump,4hleap,5hvault,5, '133
     7'O,'40133'O,'60001'O,-1,-1,                4hkill,6hmurder,4hslay,
     7       4hstab,6hdispat,                          7,'60213'O, '2000
     80'O,0,'200'O,                                        '44002'O,0, '
     91000'O,                                          5hknock,3hrap,12,
     1'42166'O,'60003'O,-1,-1,                                    '40166
     2'o,'60012'o,-1,-1,'40215'o,'22006'o,'40'o,0,
     3       5hlight,11,'42173'O,'74000'O,'100'O,0,
     4         '60211'O,'60000'O,'100'O,0,'54002'O,'10'O,0,
     4       4hlock,4,'40134'O,'20000'O,-1,-1/
C
        DATA VVOC5/4hlook,1hl,5hstare,4hgaze,
     +9,'167'O,'40167'O,'60003'O,-1,-1,
     1             '40125'O,'60010'O,-1,-1,
     2       4hmelt,6hliquif,4,'70145'O,'60002'O,'10'O,0,
     3       4hmove,4,'40172'O,'20000'O,-1,-1,
     4       4hpull,3htug,8,'42172'O,'20000'O,-1,-1,
     5                               '40172'O,'20012'O,-1,-1,
     6       4hmung,4hhack,4hfrob,6hdamage,
     6                                   5,'52212'O,'70212'O,'44002'O,-1
     7,-1,                               4hopen,4,'40175'O,'60000'O, '10
     8200'O,0,                                 4hpick,4,'40204'O, '60007
     9'O,-1,-1,                                    4hplug,4hglue,5hpatch
     1,4,'70152'O,'60002'O,-1,-1,                      4hpoke,5hbreak,
     2       3hjab,7,'60212'O,'20000'O,0,'200'O, 
     3  '44002'O,0,'1000'O,
     4       4hpour,5hspill,11,'42223'O,'42000'O,'400'O,0,
     4 '60223'O,'42000'O,'400'O,0,'60005'O,-1,-1/
C
        DATA VVOC6/3hput,6hinsert,5hstuff,5hplace,
     1       8,'72220'O,'60005'O,-1,-1,
     1           '40221'O,'60006'O,-1,-1,
     2       5hraise,4hlift,5,'52155'O,'40155'O,'60007'O,-1,-1,
     3       4hread,4hscan,4hskim,11,'42144'O,'70000'O,'40000'O,
     40,                         '60144'O,'70000'O,'40000'O,0,'60002'O,-
     51,-1,                        6hstrike,12,'60215'O,'22000'O,'40'O,0
     6,                                        '44002'O,0,'1000'O, '4221
     75'O,'22000'O,'40'O,0,'50173'O,               5hswing,6hthrust,7, '
     860214'O,'44000'O,0,'1000'O,                            '20003'O,0,
     9'200'o,                                            4htake,3hget,
     1       4hhold,5hcarry,1,'50204'o,          4htell,6hcomman
     2,6hreques,4,'40217'O,'20000'O,0,'2000'O,               5hthrow,
     3       4hhurl,5hchuck,7,'60224'O,'44000'O,-1,-1,                           
     3'20003'O,0,'40'O/
C
      DATA VVOC7/3htie,4hknot,6hfasten,11,'70162'O,'60004'O,-1,-1,
     1           '60163'O,'20000'O,'40'O,0,'64002'O,'4'O,0,
     2       4hturn,3hset,22,'62164'O,'60000'O,'2'O,0,
     3                           '64002'O,'4'O,0,
     4                               '40173'O,'74012'O,'100'O,0,'40174'O
     5,'74013'O,'100'O,0,                        '60201'O,'60000'O,'2'O,
     60,'20004'O,-1,-1,                            6hunlock,7,'60135'O, 
     7'20000'O,-1,-1,                                         '74002'O,'
     84'O,0,                                               4hwake,
     8       6hsurpri,5halarm,6hstartl,
     9  8, '42150'O,'20000'O,'40'O,0,                                            
     1'40150'O,'20007'O,'40'O,0,
     1       4hwave,6hflaunt,6hbrandi,4,'40154'O,'40000'O,-1,-1/
C
        DATA VVOCND/-1/
C SPARSE, PAGE 6
C
C OBJECTS--     MAPS OBJECTS TO OBJECT INDICES
C
C NOTE THAT IF AN OBJECT INDEX INCLUDES A BSTARB OBJECT,
C THE STAR MUST COME FIRST.
C SAME FORMAT AS AVOC.
C
        DATA OVOC1/3hbag,1,25,100,4hsack,1,6hgarlic,2,
     1       5hclove,2,4hfood,3,6hsandwi,3,5hlunch,3,
     2       4hgunk,4,55,5hpiece,4,143,4hslag,4,4hcoal,5,
     3       4hpile,5,78,87,88,122,4hheap,5,
     3       6hfiguri,6,
     4       6hmachin,7,5hpdp10,7,5hpdp11,7,5hdryer,7,
     5       3hlid,7,6hdiamon,8,4hcase,9,123,6hbottle,10,123,
     6       6hcontai,10,5hwater,11,6hquanti,11,6hliquid,11,
     7       3hh2o,11,4hrope,12,101,4hhemp,12,4hcoil,12,110,
     8       5hknife,13,24,5hblade,13,14,5hsword,14,6horchri,14,
     9       6hglamdr,14,4hlamp,15,16,22,6hlanter,15,16,22,
     1       3hrug,17,6hcarpet,17,
     2       6hleaves,18,4hleaf,18,5htroll,19,
     3       3haxe,20,6hdinner,3/
c
        data ovoc2/4hkeys,23,
     1       3hset,23,5hbones,21,6hskelet,21,4hbody,21,73,
     2       5hcoins,25,3hbar,26,
     3       6hneckla,27,6hmirror,28,29,
     4       3hice,30,4hmass,30,6hglacie,30,4hruby,31,
     5       6htriden,32,4hfork,32,6hcoffin,33,6hcasket,33,
     6       5htorch,34,4hcage,35,36,124,125,6hdumbwa,35,36,
     7       6hbasket,35,36,98,113,6hbracel,37,
     8       5hjewel,37,6htimber,38,3hbox,39,53,105,6hstradi,40,
     9       6hviolin,40,6hengrav,41,6hinscri,41,44,5hghost,42,
     1       6hspirit,42,5hfiend,42,5hgrail,43,6hprayer,44,47,
     2       5htrunk,45,5hchest,45,4hbell,46,
     3       4hbook,47,49,114,115,116,117,5hbible,47/
c
        data ovoc3/6hgoodbo,47,6hcandle,48,4hpair,48,
     1       6hguideb,49,
     1       5hguide,49,5hpaper,50,122,143,6hnewspa,50,
     2       5hissue,50,6hreport,50,6hmagazi,50,4hnews,50,
     3       6hmatchb,51,
     3       5hmatch,51,6hmatche,51,6hadvert,52,6hpamphl,52,
     4       6hleafle,52,6hbookle,52,6hmailbo,53,
     5       4htube,54,6htoothp,54,5hputty,55,6hmateri,55,
     6       4hglue,55,6hwrench,56,6hscrewd,57,
     7       6hcyclop,58,6hmonste,58,6hchalic,59,3hcup,59,
     8       6hgoblet,59,6hpainti,60,3hart,60,6hcanvas,60,
     9       6hmaster,60,5hthief,61,6hrobber,61,
     1       6hcrimin,61,6hbandit,61,5hcrook,61,4hgent,61,
     2       6hgentle,61,3hman,61,4hthug,61,
     3       6hbagman,61,6hstille,62/
C
        DATA OVOC4/6hwindow,63,4hbolt,64,3hnut,64,
     1       5hgrate,65,6hgratin,65,4hdoor,66,67,68,69,
     2       6htrapdo,66,6htrap$d,66,6hswitch,70,76,79,80,81,82,
     3       4hhead,71,120,6hcorpse,72,73,6hbodies,73,
     4       3hdam,74,5hgates,74,4hgate,74,
     5       3hfcd,74,4hrail,75,6hrailin,75,
     5       6hbutton,76,79,80,81,82,127,128,129,
     6       6hbubble,77,4hleak,78,4hdrip,78,
     7       4hhole,78,107,
     9       3hbat,83,6hrainbo,84,
     1       3hpot,85,6hstatue,86,6hsculpt,86,4hrock,86,
     2       4hboat,87,88,90,6hplasti,87,88,
     3       4hpump,89/
C
        DATA OVOC5/6hairpum,89,6hair$pu,89,5hlabel,91,112,
     1       6hfinepr,91,5hstick,92,6hbarrel,93,4hbuoy,94,
     2       6hemeral,95,6hshovel,96,5hguano,97,4hcrap,97,
     3       4hshit,97,4hhunk,97,6hballoo,98,113,
     4       6hrecept,99,4hwire,101,110,
     5       4hhook,102,103,6hqorkmi,104,4hcoin,104,
     6       4hsafe,105,4hcard,106,4hnote,106,
     7       4hslot,107,5hcrown,108,5hbrick,109,
     8       4hfuse,110,5hgnome,111,
     1       5hstamp,118,
     2       4htomb,119,5hcrypt,119,5hgrave,119,5hheads,120,
     3       5hpoles,120,6himplem,120/
C
        DATA OVOC6/6hlosers,120,5hcokes,121,
     1     6hlistin,122,5hstack,122,
     2       6hprinto,122,
     3       6hsphere,126,4hball,126,
     4       6hetchin,130,131,
     5       5hwalls,156,130,131,4hwall,156,130,131,
     6       5hflask,132,4hpool,133,6hsewage,133,
     7       3htin,134,6hsaffro,134,6hspices,134,5htable,135,
     8       4hpost,136,5hposts,136,6hbucket,137,
     9       4hcake,138,139,140,141,5hicing,139,140,141,
     1       5hrobot,142,5hrobby,142,
     2       4hc3po,142,4hr2d2,142,
     3       2hit,150,4hthat,150,4hthis,150/
c
        data ovoc7/2hme,151,6hmyself,151,6hcretin,151,
     1     3hall,152,6heveryt,152,
     1     6htreasu,153,6hvaluab,153,6hsailor,154,5hteeth,155,
     2     4hgrue,157,4hhand,158,5hhands,158,
     3     5hlungs,159,3hair,159,6hbreath,159,6haviato,160,
     4     5hflyer,160,5hstaff,144,6hspider,145,6htapest,146,3hweb,147
     + ,6hkangar,148,149,3hnet,138,4hlens,141,5hpouch,133/
c
        DATA OVOCND/-1/
         END





        SUBROUTINE RDLINE(INBUF,INLNT,WHO)
        implicit integer(A-Z)
C RDLINE-       READ INPUT LINE
C
C DECLARATIONS
C
        INTEGER INBUF(78)
c      INTEGER INBUF0(170)
        REAL RSLT
        character*4 holl2char
        COMMON /CHAN/ INPCH,OUTCH,DBCH
C
        GO TO (90,10,20),WHO+1
      CALL GOTOER
   10 CONTINUE
c      write ( OUTCH, 50 )
c 50      FORMAT('Qork>$')
      write( outch, 51 )
 51   format(" ")
      write(outch,'(A$)') "Qork>"
      GOTO 90
C
20      WRITE(OUTCH,60)
 60      FORMAT('Yes, Master>')
C
   90 READ ( INPCH, 100 ,END=400, err=400) INBUF
c10000 IF ( EOF ( INPCH ) .NE. 0 ) GOTO 400
10000 continue
c      print *, "have EOF, now what, goto 400   ????"
  100 FORMAT ( BZ,170A1 )

      INLNT = 1

        DO 200 INLNT=1,78
        write( holl2char, 124 ) inbuf(79-inlnt)
 124    format( a4 )
*          IF(INBUF(79-INLNT).NE." ") GO TO 300
          IF( holl2char .NE." ") GO TO 300
200     CONTINUE
        GO TO 10
C
300     INLNT=79-INLNT
c        print 306, inlnt,inbuf
c 306    format("return inlnt=",i2, ", inbuf=", 78a1)
        RETURN

  400 WRITE ( OUTCH, 401 )
  401 FORMAT ( 1X,'I cannot hear you!' )
      close(5)
      open(unit=5, file='/dev/tty')
      GOTO 10
        END





        LOGICAL FUNCTION PARSE(INBUF,INLNT)
        implicit integer(A-Z)
C PARSE-       TOP LEVEL PARSE ROUTINE
C
C DECLARATIONS
C
C THIS ROUTINE DETAILS ON BIT 0 OF PRSFLG
C
        INTEGER INBUF(78)
        LOGICAL LEX,SYNMCH,DFLAG
        INTEGER*8 OUTBUF(40)
        COMMON /DEBUG/ DBGFLG,PRSFLG
C
C PARSER OUTPUT
C
        LOGICAL PRSWON
        COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON
C
C       DFLAG=(PRSFLG.AND.1B).NE.0
        PARSE=.FALSE.
        PRSA=0
        PRSI=0
        PRSO=0
C
c        print 2, inlnt, inbuf
c 2      format("in PARSE, c=", i6, ", inbuf=", 78a1)
        IF(.NOT.LEX(INBUF(1),INLNT,OUTBUF(1),OUTLNT)) GO TO 100
*        print 123, OUTLNT, OUTBUF(1),outbuf(2),outbuf(3),outbuf(4)
* 123    format( "CALL SPARSE outlnt=",i2, ",outbuf(1-4)='",a8,"'",
*     + "'",a8,"'",a8,"'",a8,"'")
        IF(SPARSE(OUTBUF,OUTLNT)) 100,200,300
C
C PARSE REQUIRES VALIDATION
C
200     IF(.NOT.SYNMCH(X)) GO TO 100
C
C SUCCESSFUL PARSE OR SUCCESSFUL VALIDATION
C
300     CALL ORPHAN(0,0,0,0,0)
         PARSE=.TRUE.
100     CONTINUE
c        PRINT 10,PARSE,PRSA,PRSO,PRSI
c10     FORMAT(" PARSE RESULTS- ",L7,3I7)
        RETURN
C
        END



      logical function lex ( inbuf, inbufc, outbuf, outbufc )
c
c  Complete re-write, eliminating all the hardware specific shifts,
c  masks, ORs and ANDs. Yuck!  SOL
c
c  Get a command from the adventurer:  snarf out space-separated words
c  from the INBUFC a1 characters in INBUF and pack them, maximum of 6
c  characters per word, into a8 integer words in OUTBUF.
c
c  Note: convert integer to character, make all lower case, then convert
c  character to integer for return and compatability with 40 years ago.
c
      implicit integer (a-z)
      integer*8 outbuf(40)
      integer inbuf(78)
      character*78 in
      character*78 in0
      character*78 word

      lex = .false.

* Convert integer to character.      
      write( in0, 1 ) (inbuf(i), i=1,78)

* Lower case everything.
      do i = 1, len(in0)
#if (! defined __GFORTRAN__)
          j = ichar(in0(i:i))
          if (j>= ichar("A") .and. j<=ichar("Z") ) then
             in(i:i) = char(ichar(in0(i:i))+32)
          else
               in(i:i) = in0(i:i)
          end if
#else
          j = iachar(in0(i:i))
          if (j>= iachar("A") .and. j<=iachar("Z") ) then
             in(i:i) = achar(iachar(in0(i:i))+32)
          else
               in(i:i) = in0(i:i)
          end if
#endif
      end do

      inc = 1
      outbufc = 0

 100  continue
      word = ""
      wordc = 1

* Skip leading spaces.
      do 201 c = inc, 78
         if( in(c:c) .ne. " " ) goto 202
         inc = inc + 1
 201  continue
 202  continue
      if ( c .gt. 78 ) return

*  Collect non-space characters in WORD.
      do 301 c = inc, 78
         if( in(c:c) .eq. " " ) goto 302
         word(wordc:wordc) = in(c:c)
         wordc = wordc + 1
         inc = inc + 1
 301  continue
 302  continue
      if ( c .gt. 78 ) return

      if ( word .ne. "" ) then
         outbufc = outbufc + 1
         read( word(1:6), 2 ) outbuf(outbufc)
         lex = .true.
         if ( outbufc .gt. 40 ) return
      endif

      goto 100

 1    format( 78a1 )
 2    format( a6 )
      
      end





*        LOGICAL FUNCTION LEX(INBUF,INLNT,OUTBUF,OP)
*        implicit integer(A-Z)
C LEX- LEXICAL ANALYZER
c
c Pack a1 characters from integer INBUF to a8 characters OUTBUF.
C
C DECLARATIONS
C
C THIS ROUTINE DETAILS ON BIT 1 OF PRSFLAG
C
*        INTEGER INBUF(78)
*      INTEGER*8 OUTBUF(40)
*      INTEGER*8 J
*      character*1 j2
*        LOGICAL DFLAG
*        COMMON /DEBUG/ DBGFLG,PRSFLG
C
c        print 1, outbuf(1)
c 1      format("in LEX,outbuf(1)='",a8,"'")
*        DO 100 I=1,40
*           OUTBUF(I)= "        "
* 100            CONTINUE
c        print 2, outbuf(1)
c 2      format("in LEX, CLEAAR outbuf(1)='",a8,"'")
C
C       DFLAG=(PRSFLG.AND.2B).NE.0
*        LEX=.FALSE.
*        OP=0
*        IP=0
* 50           OP=OP+1
*        CP=0
*C
* 200         IP=IP+1
*        IF(IP.GT.INLNT) GO TO 1000
*        J=INBUF(IP)
*        j2=char(j)
c        print 201, j,j2
c 201    format("lex char='", a8, "' , =", a1)
*        IF(J2.EQ.".") GO TO 1000
*        IF(j2.EQ. ' ') GO TO 6000
c        if ( j .eq. '20202020'x) goto 6000
C       IF(J1.NE.0) GO TO 4000
C
C       CALL RSPEAK(601)
C       RETURN
*      GOTO 4000
C
C END OF INPUT, SEE IF PARTIAL WORD AVAILABLE.
C
* 1000     IF((CP.EQ.0).AND.(OP.EQ.1)) RETURN
*      IF(CP.EQ.0) OP=OP-1
*        LEX=.TRUE.
C       PRINT 10,CP,OP,(OUTBUF(I),I=1,OP+1)
C10     FORMAT(" LEX RESULTS- ",2I7/1X,10I7)
*        RETURN
C
C LEGITIMATE CHARACTERS: LETTER, DIGIT, OR HYPHEN.
C
* 4000       CONTINUE
c       IF(DFLAG) PRINT 20,J,J1,CP
c20     FORMAT(" LEX- CHAR= ",3I7)
*        IF(CP.GE.6) GO TO 200
*        K=OP+(CP/8)*
*
*      CN = (MOD(CP,8)+1) * 8
* 
c      print 4301, cn, k, j
c 4301 format("cn=",i3, ", k=", i3, ", j='", z12, "'!")
*
*      j = j .and. .not. '20'x
*      j = j .and. '377'O
c      print 4302, j
c 4302 format("j=", z12)
*
c      outbuf(k) = outbuf(k) .and. (.not. shift('377'O, (cn-8)))
c      frog = shift(j,(cn-8))
c      print 4311, frog
c 4311 format("FROG=", z20)
*
c      outbuf(k) = outbuf(k) .and. (.not. shift('377'O, (cn-8)))
*#if defined(__INTEL_COMPILER)
*      OUTBUF(K) = OUTBUF(K) .OR. ISHFTC(j,(CN-8))
*#elif defined (__PGI_COMPILER)
*      OUTBUF(K) = OUTBUF(K) .OR. shift(j,(CN-8))
*#else
*#error FORTRAN Compiler not defined
*#endif
*
c see if any zero characters
*      
*
c      outbuf(k) = outbuf(k) .and. .not. '2020202020202020'x
*
c      print 4400, k, outbuf(k), j
c 4400 format("k=", i6, ", outbuf(k)='", a8, "', j='", a1,"'")
*        CP=CP+1
*        GO TO 200
C
C SPACE
C
* 6000       continue
*        IF(CP.EQ.0) GO TO 200
*        GO TO 50
C
*        END





        SUBROUTINE ORPHAN(O1,O2,O3,O4,O5)
        implicit integer(A-Z)
C ORPHAN- SET UP NEW ORPHANS
C
C DECLARATIONS
C
        COMMON /ORPHS/ A,B,C,D,E
C
        A=O1
        B=O2
        C=O3
        D=O4
        E=O5
        RETURN
        END





        INTEGER FUNCTION SPARSE(LBUF,LLNT)
        implicit integer(A-Z)
C SPARSE-       START OF PARSE
C
C DECLARATIONS
C
C THIS ROUTINE DETAILS ON BIT 2 OF PRSFLG
C
        INTEGER*8 LBUF(40), lbuf1, lbuf2
        LOGICAL LIT,OTEST,DFLAG
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(160),ODESC2(160),ODESCO(160),
     1          OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2          OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3          OADV(160),OCAN(160),OREAD(160),ORAND(160)
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
        COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT
        COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE
        COMMON /OINDEX/ ROBOT,LUNGS,SAILO,AVIAT,TEETH
        COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,STAFF,SPIDER,TAPEST,WEB
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
        COMMON /VINDEX/ TAKEW,INVENW,FILLW,EATW,DRINKW,BURNW
        COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW
        COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW
        COMMON /VINDEX/ DIGW,LEAPW
C SPARSE, PAGE 2
C
C VOCABULARIES
C
        integer*8 bvoc,pvoc,dvoc,avoc,vvoc,ovoc
        COMMON /BUZVOC/ BVOC(10)
        COMMON /PRPVOC/ PVOC(32)
        COMMON /DIRVOC/ DVOC(60)
        COMMON /ADJVOC/ AVOC(194)
        COMMON /VRBVOC/ VVOC(631)
        COMMON /OBJVOC/ OVOC(573)

        integer*8 r
        character*4, holl2char
C
        OTEST(R)=(R.GT.0).AND.(R.LT.1600)
C SPARSE, PAGE 7
C
C SET UP FOR PARSING
C

c        print *, "in sparse"
c        print 1, bvoc(1)
c 1      format("bvoc[1](and)='",a8,"'" )
c        print 2, lbuf(1), lbuf(2)
c 2      format("lbuf(1)='",a8,"',lbuf(2)='",a8,"'")
 


        SPARSE=-1
        ADJ=0
        ACT=0
        PREP=0
        PPTR=0
        O1=0
        O2=0
        P1=0
        P2=0
C       DFLAG=(PRSFLG.AND.4B).NE.0
C
        BUZLNT=10
        PRPLNT=32
        DIRLNT=60
C SPARSE, PAGE 8
C
C NOW LOOP OVER INPUT BUFFER OF LEXICAL TOKENS.
C
        DO 1000 I=1,LLNT
          LBUF1=LBUF(I)

C         LBUF2=LBUF(I+1)
C     IF(LBUF1.EQ.8H           )LBUF1=0
C     IF(LBUF2.EQ.8H           )LBUF2=0
          write( holl2char, 124 ) lbuf1
 124      format( a4 )
*          IF(LBUF1.EQ.8H           ) GO TO 1500
          IF( holl2char .EQ." " ) GO TO 1500
C
C CHECK FOR BUZZ WORD
C
          DO 50 J=1,BUZLNT
          IF((LBUF1.EQ.BVOC(J)))
     1       GO TO 1000
50        CONTINUE
C
C CHECK FOR ACTION OR DIRECTION
C
          IF(ACT.NE.0) GO TO 200
          DO 100 J=1,DIRLNT,2
            IF((LBUF1.EQ.DVOC(J)))
     1       GO TO 2000
100       CONTINUE
C
          J=1
 125      continue
c          print 45, lbuf1,j,vvoc(j)
c45        format("lbuf1='", a8, "', vvoc(", i3, "='",a8,"'")
          IF (LBUF1 .EQ. VVOC(J))
     1       GO TO 3000
150       J=J+1
          IF(.NOT.OTEST(VVOC(J))) GO TO 125
          J=J+VVOC(J)+1
          IF(VVOC(J).NE.-1) GO TO 125
C
C NOT AN ACTION, CHECK FOR PREPOSITION, ADJECTIVE, OR OBJECT.
C
200       DO 250 J=1,PRPLNT,2
            IF((LBUF1.EQ.PVOC(J)))
     1       GO TO 4000
250       CONTINUE
C
          J=1
300       IF((LBUF1.EQ.AVOC(J)))
     1       GO TO 5000
C         J=J+1
325       J=J+1
          IF(OTEST(AVOC(J))) GO TO 325
          IF(AVOC(J).NE.-1) GO TO 300
C
          J=1
450       IF((LBUF1.EQ.OVOC(J)))
     1       GO TO 600
C         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
          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)
C         PRINT 60,J,OBJ
C60       FORMAT(" SPARSE- OBJ AT ",I6,"  OBJ= ",I6)
          IF(OBJ.LE.0) GO TO 6000
          IF(OBJ.EQ.ITOBJ) OBJ=LASTIT
          LASTIT=OBJ
C
          IF(PREP.EQ.9) GO TO 8000
          IF(PPTR.EQ.2) GO TO 7000
          PPTR=PPTR+1
          OBJVEC(PPTR)=OBJ
          PRPVEC(PPTR)=PREP
700       PREP=0
          ADJ=0
1000    CONTINUE
C
C NOW SOME MISC CLEANUP
C
1500    IF(ACT.EQ.0) ACT=AND(OFLAG,OACT)
        IF(ACT.EQ.0) GO TO 9000
        IF(ADJ.NE.0) GO TO 10000
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
        IF(PREP.EQ.0) GO TO 1750
        IF (PPTR.EQ.0) RETURN
        IF (PRPVEC(PPTR).NE.0) RETURN
        PRPVEC(PPTR)=PREP
1750    SPARSE=0
c        PRINT 70,ACT,O1,O2,P1,P2
c70     FORMAT(" SPARSE RESULTS- ",5I7)
        RETURN
C SPARSE, PAGE 10
C
C SPECIAL PARSE PROCESSORS
C
C 2000--        DIRECTION
C
2000    PRSA=WALKW
        PRSO=DVOC(J+1)
        SPARSE=1
C        PRINT 10,J
C10     FORMAT(" SPARSE- DIR AT ",I6)
        RETURN
C
C 3000--        ACTION
C
3000    ACT=J
c        PRINT 20,J
c20     FORMAT(" SPARSE- ACT AT ",I6)
        GO TO 1000
C
C 4000--        PREPOSITION
C
4000    IF(PREP.NE.0) GO TO 4500
        PREP=PVOC(J+1)
C        PRINT 30,J
C30     FORMAT(" SPARSE- PREP AT ",I6)
        GO TO 1000
C
4500    CALL RSPEAK(616)
        RETURN
C
C 5000--        ADJECTIVE
C
5000    ADJ=J
        J=AND(ONAME,OFLAG)
C        PRINT 40,ADJ,J
C40     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
        I=579
        IF(LIT(HERE)) I=618
        CALL RSPEAK(I)
        RETURN
C
6100    IF(OBJ.NE.-10000) GO TO 6200
        CALL RSPSUB(620,ODESC2(AVEHIC(WINNER)))
        RETURN
C
6200    CALL RSPSUB(619,0)
        IF(ACT.EQ.0) ACT=AND(OFLAG,OACT)
        CALL ORPHAN(-1,ACT,O1,PREP,J)
        RETURN
C
C 7000--        TOO MANY OBJECTS.
C
7000    CALL RSPEAK(617)
        RETURN
C
C 8000--        RANDOMNESS FOR BOFB WORDS
C
8000    IF(OBJVEC(PPTR).EQ.OBJ) GO TO 700
        CALL RSPEAK(601)
        RETURN
C
C 9000--        NO ACTION, PUNT
C
9000    IF(O1.EQ.0) GO TO 10000
        CALL RSPSUB(621,ODESC2(O1))
        CALL ORPHAN(-1,0,O1,0,0)
        RETURN
C
C 10000--       TOTAL CHOMP
C
10000   CALL RSPEAK(622)
        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
        P1=OPREP
        GO TO 1750
C
11500   O2=O1
        P2=OPREP
        O1=OSLOT
        P1=0
        GO TO 1750
       END
        INTEGER FUNCTION GETOBJ(OIDX,AIDX)
        implicit integer(A-Z)
C GETOBJ--      FIND OBJ DESCRIBED BY ADJ, NAME PAIR
C
C DECLARATIONS
C
C THIS ROUTINE DETAILS ON BIT 3 OF PRSFLG
C
        LOGICAL LIT,CHOMP,DFLAG
C
        COMMON /OBJFLG/ VABIT,VRBIT,VTBIT,VCBIT,VEBIT,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(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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,ECHOBT,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
        integer*8 ovoc
        COMMON /OBJVOC/ OVOC(573)
C GETOBJ, PAGE 2
C
C       DFLAG=(PRSFLG.AND.10B).NE.0
        CHOMP=.FALSE.
        AV=AVEHIC(WINNER)
        OBJ=0
        IF(.NOT.LIT(HERE)) GO TO 200
C
        OBJ=SCHLST(OIDX,AIDX,HERE,0,0,0)
C       IF(DFLAG) PRINT 10,OBJ
C10     FORMAT(" SCHLST- ROOM SCH ",I6)
        IF(OBJ) 1000,200,100
100     IF((AV.EQ.0).OR.(AV.EQ.OBJ).OR.
     1       ((OFLAG2(OBJ)*FINDBT).NE.0)) GO TO 200
        IF(OCAN(OBJ).EQ.AV) GO TO 200
        CHOMP=.TRUE.
C
200     IF(AV.EQ.0) GO TO 400
        NOBJ=SCHLST(OIDX,AIDX,0,AV,0,0)
C       IF(DFLAG) PRINT 20,NOBJ
C20     FORMAT(" SCHLST- VEH SCH  ",I6)
        IF(NOBJ) 1100,400,300
300     CHOMP=.FALSE.
        IF(OBJ.EQ.NOBJ) GO TO 400
        IF(OBJ.NE.0) NOBJ=-NOBJ
        OBJ=NOBJ
C
400     NOBJ=SCHLST(OIDX,AIDX,0,0,WINNER,0)
C       IF(DFLAG) PRINT 30,NOBJ
C30     FORMAT(" SCHLST- ADV SCH  ",I6)
        IF(NOBJ) 1100,600,500
500     IF(OBJ.NE.0) NOBJ=-NOBJ
1100    OBJ=NOBJ
600     IF(CHOMP) OBJ=-10000
1000    GETOBJ=OBJ
C
         IF((GETOBJ.EQ.0).AND.(OVOC(OIDX+1).GE.STRBIT))
     1       GETOBJ=OVOC(OIDX+1)
C       IF(DFLAG) PRINT 40,GETOBJ
C40     FORMAT(" SCHLST- RESULT   ",I6)
        RETURN
        END
        INTEGER FUNCTION SCHLST(OIDX,AIDX,RM,CN,AD,SPCOBJ)
        implicit integer(A-Z)
C SCHLST--     SEARCH FOR OBJECT
C
C DECLARATIONS
C
        LOGICAL THISIT,QHERE,NOTRAN,NOVIS
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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,ECHOBT,ACTRBT,
     1       WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
     2       TCHBT,VEHBT,SCHBT

        NOTRAN(O)=(AND(OFLAG1(O),TRANBT).EQ.0).AND.
     1       (AND(OFLAG2(O),OPENBT).EQ.0)
        NOVIS(O)=(AND(OFLAG1(O),VISIBT).EQ.0)
C
        SCHLST=0
        DO 1000 I=1,OLNT
          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
          SCHLST=I
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
            IF(NOVIS(J).OR. (.NOT.THISIT(OIDX,AIDX,J,SPCOBJ)))
     1       GO TO 500
            X=OCAN(J)
300         IF(X.EQ.I) GO TO 400
            IF(X.EQ.0) GO TO 500
            IF(NOVIS(X).OR.NOTRAN(X).OR.
     1       (AND(OFLAG2(X),SCHBT).EQ.0)) GO TO 500
            X=OCAN(X)
            GO TO 300
C
400         IF(SCHLST.NE.0) GO TO 2000
            SCHLST=J
500       CONTINUE
C
1000    CONTINUE
        RETURN
C
2000    SCHLST=-SCHLST
        RETURN
C
        END
        LOGICAL FUNCTION THISIT(OIDX,AIDX,OBJ,SPCOBJ)
        implicit integer(A-Z)
C THISIT--     VALIDATE OBJECT VS DESCRIPTION
C
C DECLARATIONS
C
        LOGICAL NOTEST
C
C VOCABULARIES
C
        integer*8 OVOC, AVOC
        COMMON /OBJVOC/ OVOC(573)
        COMMON /ADJVOC/ AVOC(194)

        integer*8 o

        NOTEST(O)=(O.LE.0).OR.(O.GE.R50MIN)

        DATA R50MIN/'3100'O/
C
        THISIT=.FALSE.
        IF((SPCOBJ.NE.0).AND.(OBJ.EQ.SPCOBJ)) GO TO 500
C
C CHECK FOR OBJECT NAMES
C
      I = OIDX
100     I=I+1
        IF(NOTEST(OVOC(I))) RETURN
        IF(OVOC(I).NE.OBJ) GO TO 100
C
        IF(AIDX.EQ.0) GO TO 500
      I = AIDX
200     I=I+1
        IF(NOTEST(AVOC(I))) RETURN
        IF(AVOC(I).NE.OBJ) GO TO 200
C
500     THISIT=.TRUE.
        RETURN
        END
        LOGICAL FUNCTION SYNMCH     (X)
        implicit integer(A-Z)
C SYNMCH--      SYNTAX MATCHER
C
C DECLARATIONS
C
C THIS ROUTINE DETAILS ON BIT 4 OF PRSFLG
C
        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
        integer*8 VVOC
        COMMON /VRBVOC/ VVOC(631)
        COMMON /SYNFLG/ SDIR,SIND,SSTD,SFLIP,SDRIV,SVMASK
        DATA R50MIN/'3100'O/
C
        SYNMCH=.FALSE.
C       DFLAG=(PRSFLG.AND."20).NE.0
        J=ACT
        DRIVE=0
100     J=J+1
        IF((VVOC(J).LE.0).OR.(VVOC(J).GE.R50MIN)) GO TO 100
        LIMIT=J+VVOC(J)+1
        J=J+1
C
200     CALL UNPACK(J,NEWJ)
C        PRINT 60,O1,P1,DOBJ,DFL1,DFL2
C60     FORMAT(" SYNMCH INPUTS TO SYNEQL- ",5I7)
        IF(.NOT.SYNEQL(P1,O1,DOBJ,DFL1,DFL2)) GO TO 1000
C       IF(DFLAG) PRINT 60,O2,P2,IOBJ,IFL1,IFL2
        IF(SYNEQL(P2,O2,IOBJ,IFL1,IFL2)) GO TO 6000
C
C SYNTAX MATCH FAILS, TRY NEXT ONE.
C
        IF(O2) 3000,500,3000
1000    IF(O1) 3000,500,3000
500     IF(DRIVE.EQ.0) DRIVE=J
        IF(AND(VFLAG,SDRIV).NE.0) DRIVE=J
3000    J=NEWJ
        IF(J.LT.LIMIT) GO TO 200
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
C       PRINT 20,DRIVE
C20     FORMAT(" SYNMCH, DRIVE=",I6)
        IF(DRIVE.EQ.0) GO TO 10000
        CALL UNPACK(DRIVE,X)
C
C TRY TO FILL DIRECT OBJECT SLOT IF THAT WAS THE PROBLEM.
C
        IF((AND(VFLAG,SDIR).EQ.0).OR.(O1.NE.0)) GO TO 4000
C
C FIRST TRY TO SNARF ORPHAN OBJECT.
C
        O1=AND(OFLAG,OSLOT)
        IF(O1.EQ.0) GO TO 3500
        IF(SYNEQL(P1,O1,DOBJ,DFL1,DFL2)) GO TO 4000
C
C ORPHAN FAILS, TRY GWIM.
C
3500    O1=GWIM(DOBJ,DFW1,DFW2)
C        PRINT 30,O1
C30     FORMAT(" SYNMCH- DO GWIM= ",I6)
        IF(O1.GT.0) GO TO 4000
        CALL ORPHAN(-1,ACT,0,0,0)
        CALL RSPEAK(623)
        RETURN
C
C TRY TO FILL INDIRECT OBJECT SLOT IF THAT WAS THE PROBLEM.
C
4000    IF((AND(VFLAG,SIND).EQ.0).OR.(O2.NE.0)) GO TO 6000
        O2=GWIM(IOBJ,IFW1,IFW2)
C        PRINT 40,O2
C40     FORMAT(" SYNMCH- IO GWIM= ",I6)
        IF(O2.GT.0) GO TO 4000
        CALL ORPHAN(-1,ACT,O1,0,0)
        CALL RSPEAK(624)
        RETURN
C
C TOTAL CHOMP
C
10000   CALL RSPEAK(601)
        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(AND(VFLAG,SFLIP).EQ.0) GO TO 5000
        J=O1
        O1=O2
        O2=J
C
5000    PRSA=AND(VFLAG,SVMASK)
        PRSO=O1
        PRSI=O2
        IF(.NOT.TAKEIT(PRSO,DOBJ)) RETURN
        IF(.NOT.TAKEIT(PRSI,IOBJ)) RETURN
        SYNMCH=.TRUE.
C        PRINT 50,SYNMCH,PRSA,PRSO,PRSI,ACT,O1,O2
C50     FORMAT(" SYNMCH- RESULTS ",L1,6I7)
        RETURN
C
        END
        SUBROUTINE UNPACK(OLDJ,J)
        implicit integer(A-Z)
C UNPACK-      UNPACK SYNTAX SPECIFICATION, ADV POINTER
C
C DECLARATIONS
C
C
        integer*8 VVOC
        COMMON /VRBVOC/ VVOC(631)
C
        COMMON /SYNFLG/ SDIR,SIND,SSTD,SFLIP,SDRIV,SVMASK
        COMMON /OBJFLG/ VABIT,VRBIT,VTBIT,VCBIT,VEBIT,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
          SYN(I)=0
10      CONTINUE
C

        VFLAG=VVOC(OLDJ)
        J=OLDJ+1
        IF(AND(VFLAG,SDIR).EQ.0) RETURN
        DFL1= CONCAT(0,COMPL(0),35,35,36)
        DFL2=CONCAT(0,COMPL(0),35,35,36)
        IF(AND(VFLAG,SSTD).EQ.0) GO TO 100
        DFW1=CONCAT(0,COMPL(0),35,35,36)
        DFW2=CONCAT(0,COMPL(0),35,35,36)
        DOBJ=VABIT+VRBIT
        GO TO 200
C
100     DOBJ=VVOC(J)
        DFW1=VVOC(J+1)
        DFW2=VVOC(J+2)
        J=J+3
        IF(AND(DOBJ,VEBIT).EQ.0) GO TO 200
        DFL1=DFW1
        DFL2=DFW2
C
200     IF(AND(VFLAG,SIND).EQ.0) RETURN
        IFL1=CONCAT(0,COMPL(0),35,35,36)
        IFL2=CONCAT(0,COMPL(0),35,35,36)
        IOBJ=VVOC(J)
        IFW1=VVOC(J+1)
        IFW2=VVOC(J+2)
        J=J+3
        IF(AND(IOBJ,VEBIT).EQ.0) RETURN
        IFL1=IFW1
        IFL2=IFW2
        RETURN
C
        END
        LOGICAL FUNCTION SYNEQL(PREP,OBJ,SPREP,SFL1,SFL2)
        implicit integer(A-Z)
C SYNEQL-      TEST FOR SYNTAX EQUALITY
C
C DECLARATIONS
C
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
C
        COMMON /OBJFLG/ VABIT,VRBIT,VTBIT,VCBIT,VEBIT,VPMASK
C
        IF(OBJ.EQ.0) GO TO 100
        SYNEQL=(PREP.EQ.AND(SPREP,VPMASK)).AND.
     1       (OR(AND(SFL1,OFLAG1(OBJ)),
     2         AND(SFL2,OFLAG2(OBJ))).NE.0)
        RETURN
C
100     SYNEQL=(PREP.EQ.0).AND.(SFL1.EQ.0).AND.(SFL2.EQ.0)
        RETURN
C
        END
        LOGICAL FUNCTION TAKEIT(OBJ,SFLAG)
        implicit integer(A-Z)
C TAKEIT-      PARSER BASED TAKE OF OBJECT
C
C DECLARATIONS
C
C
        COMMON /OBJFLG/ VABIT,VRBIT,VTBIT,VCBIT,VEBIT,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
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
C
        COMMON /OROOM2/ R2LNT,O2(6),R2(6)
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,ECHOBT,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=.TRUE.
        IF((OBJ.EQ.0).OR.(OBJ.GE.STRBIT)) RETURN
        IF(AND(SFLAG,VRBIT).EQ.0) GO TO 1000
        IF(AND(SFLAG,VTBIT).EQ.0) GO TO 2000
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) RETURN
C
C ITS IN THE ROOM AND CAN BE TAKEN
C
        IF(AND(OFLAG1(OBJ),TAKEBT).NE.0) GO TO 3000
C
C NOT TAKEABLE.  IF WE CARE, FAIL.
C
        IF(AND(SFLAG,VCBIT).EQ.0) RETURN
        CALL RSPSUB(445,ODESC2(OBJ))
        TAKEIT=.FALSE.
        RETURN
C
C 1000--        IT SHOULD NOT BE IN THE ROOM.
C 2000--        IT CANT BE TAKEN.
C
2000    IF(AND(SFLAG,VCBIT).EQ.0) RETURN
1000    TAKEIT=SCHLST(0,0,HERE,0,0,OBJ).LE.0
        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 IF IT IS INSIDE SOMETHING, THE CONTAINER IS OPEN OR
C TRANSPARENT.
C
C THE FOLLOWING CODE IS LIFTED FROM SUBROUTINE TAKE.
C
3000    TAKEIT=.FALSE.
        X=OCAN(OBJ)
        IF(X.EQ.0) GO TO 3200
        IF(AND(OFLAG2(X),OPENBT).NE.0) GO TO 3200
        CALL RSPEAK(526)
        RETURN
C
3200    IF(OBJ.NE.AVEHIC(WINNER)) GO TO 3500
        CALL RSPEAK(553)
        RETURN
C
3500    IF (X.NE.0) THEN
        IF (OADV(X).EQ.WINNER) THEN
            GOTO 3700
        ENDIF
        ENDIF
        IF ((WEIGHT(0,OBJ,WINNER)+OSIZE(OBJ)).LE.MXLOAD) THEN
            GOTO 3700
        ENDIF
        CALL RSPEAK(558)
        RETURN

C
3700    TAKEIT=.TRUE.
        CALL NEWSTA(OBJ,559,0,0,WINNER)
        OFLAG2(OBJ)=OR(OFLAG2(OBJ),TCHBT)
        CALL SCRUPD(OFVAL(OBJ))
        OFVAL(OBJ)=0
        RETURN
C
        END
        INTEGER FUNCTION GWIM(SFLAG,SFW1,SFW2)
        implicit integer(A-Z)
C GWIM- GET WHAT I MEAN IN AMBIGOUS SITUATIONS
C
C DECLARATIONS
C
        LOGICAL TAKEIT,NOCARE
C
        COMMON /OBJFLG/ VABIT,VRBIT,VTBIT,VCBIT,VEBIT,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(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
C
        COMMON /OROOM2/ R2LNT,O2(6),R2(6)
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,ECHOBT,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
        AV=AVEHIC(WINNER)
        NOBJ=0
        NOCARE=AND(SFLAG,VCBIT).EQ.0
C
C FIRST SEARCH ADVENTURER
C
        IF(AND(SFLAG,VABIT).NE.0)
     1       NOBJ=FWIM(SFW1,SFW2,0,0,WINNER,NOCARE)
        IF(AND(SFLAG,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
C
C ROBJ > 0
C
200     IF((AV.EQ.0).OR.(ROBJ.EQ.AV).OR.
     1       (AND(OFLAG2(ROBJ),FINDBT).NE.0)) GO TO 300
        IF(OCAN(ROBJ).NE.AV) GO TO 50
300     IF(NOBJ.NE.0) RETURN
        IF(.NOT.TAKEIT(ROBJ,SFLAG)) RETURN
        GWIM=ROBJ
500     RETURN
C
        END





       INTEGER FUNCTION RND(X)
       INTEGER X

C Return random integer 0 .. X                                                                                                                 
#if (! defined __GFORTRAN__)                                                                                                                  
       integer r
       r = irandm( 0 )
       rnd = mod(r, x )
#else
       real r
       r = rand( 0 )
       rnd =  int( r * x )
#endif
       END

        SUBROUTINE PRINCR(FULL,RM)
        implicit integer (A-Z)
C PRINCR- PRINT CONTENTS OF ROOM
C
C DECLARATIONS
C
        LOGICAL QEMPTY,QHERE,FULL
C
C GAME STATE
C
        LOGICAL TELFLG
        COMMON /PLAY/ WINNER,HERE,TELFLG
C
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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,ECHOBT,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
C
C FLAGS
C
       LOGICAL FLAGS(35)
        LOGICAL TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
        LOGICAL DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
        LOGICAL MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
        LOGICAL EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
        LOGICAL GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
        LOGICAL GLACMF,FROBZF,ENDGMF,CYCLOF2,BUGF
        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,CYCLOF2,BUGF
        COMMON /FINDEX/ BTIEF,BINFF
        EQUIVALENCE (FLAGS(1),TROLLF)
C PRINCR, PAGE 2
C
        DO 500 I=1,OLNT
          IF(.NOT.QHERE(I,RM).OR.(AND(OFLAG1(I),(VISIBT+NDSCBT)).NE.
     1       VISIBT).OR.(I.EQ.AVEHIC(WINNER))) GO TO 500
C
C DO LONG DESCRIPTION OF OBJECT.
C
          K=ODESCO(I)
          IF((K.EQ.0).OR.(AND(OFLAG2(I),TCHBT).NE.0)) K=ODESC1(I)
          CALL RSPEAK(K)
500     CONTINUE
C
C NOW LOOP TO PRINT CONTENTS OF OBJECTS IN ROOM.
C
        DO 1000 I=1,OLNT
          IF(.NOT.QHERE(I,RM).OR.(AND(OFLAG1(I),(VISIBT+NDSCBT)).NE.
     1       VISIBT)) GO TO 1000
          IF(AND(OFLAG2(I),ACTRBT).NE.0) CALL INVENT(ORAND(I))
          IF(((AND(OFLAG1(I),TRANBT).EQ.0).AND.(AND(OFLAG2(I),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
          J=574
          IF((BRIEFF.OR.SUPERF).AND. .NOT.FULL) GO TO 1000
600       CALL RSPSUB(J,ODESC2(I))
C
          DO 700 J=1,OLNT
            IF((OCAN(J).EQ.I).AND.(ODESC2(I).NE.0))
     1       CALL RSPSUB(502,ODESC2(J))
700       CONTINUE
C
1000    CONTINUE
        RETURN
C
        END
        SUBROUTINE INVENT(ADV)
        implicit integer (A-Z)
C INVENT- PRINT CONTENTS OF ADVENTURER
C
C DECLARATIONS
C
        LOGICAL QEMPTY
C
C GAME STATE
C
        LOGICAL TELFLG
        COMMON /PLAY/ WINNER,HERE,TELFLG
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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,ECHOBT,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
C INVENT, PAGE 2
C
        I=575
        IF(ADV.NE.PLAYER) I=576
        DO 10 J=1,OLNT
          IF((OADV(J).NE.ADV).OR.(AND(OFLAG1(J),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
        IF(ADV.EQ.PLAYER) CALL RSPEAK(578)
        RETURN
C
25      DO 100 J=1,OLNT
          IF((OADV(J).NE.ADV).OR.(AND(OFLAG1(J),VISIBT).EQ.0).OR.
     1       ((AND(OFLAG1(J),TRANBT).EQ.0).AND.
     2       (AND(OFLAG2(J),OPENBT).EQ.0))) GO TO 100
          IF(QEMPTY(J)) GO TO 100
          CALL RSPSUB(573,ODESC2(J))
          DO 50 K=1,OLNT
            IF(OCAN(K).EQ.J) CALL RSPSUB(502,ODESC2(K))
50        CONTINUE
100     CONTINUE
        RETURN
C
        END
        LOGICAL FUNCTION MOVETO(NR)
        implicit integer (A-Z)
C MOVETO- MOVE PLAYER TO NEW ROOM
C
C DECLARATIONS
C
        LOGICAL NLV,LHR,LNR
C
C GAME STATE
C
        LOGICAL TELFLG
        COMMON /PLAY/ WINNER,HERE,TELFLG
C
C ROOMS
C
        COMMON /ROOMS/ RLNT,RDESC1(150),RDESC2(150),REXIT(150),
     1       RACTIO(150),RVAL(150),RFLAG(150),RRAND(150)
C
        COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR,
     1       RSACRD,RFILL,RMUNG,RBUCK,RHOUSE
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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
C
        MOVETO=.FALSE.
        LHR=AND(RFLAG(HERE),RLAND).NE.0
        LNR=AND(RFLAG(NR),RLAND).NE.0
        J=AVEHIC(WINNER)
C
        IF(J.NE.0) GO TO 100
        IF(LNR) GO TO 500
        CALL RSPEAK(427)
        RETURN
C
100     NLV=AND(RFLAG(NR),ORAND(J)).EQ.0
        IF((.NOT.LNR .AND.NLV) .OR.
     1       (LNR.AND.LHR.AND.NLV.AND.(ORAND(J).NE.RLAND)))
     2       GO TO 800
C
500     MOVETO=.TRUE.
        IF(AND(RFLAG(NR),RMUNG).EQ.0) GO TO 600
        CALL RSPEAK(RRAND(NR))
        RETURN
C
600     IF(WINNER.NE.PLAYER) CALL NEWSTA(AOBJ(WINNER),0,NR,0,0)
        IF(J.NE.0) CALL NEWSTA(J,0,NR,0,0)
        HERE=NR
        AROOM(WINNER)=HERE
        CALL SCRUPD(RVAL(NR))
        RVAL(NR)=0
        RETURN
C
800     CALL RSPSUB(428,ODESC2(J))
        RETURN
        END
        SUBROUTINE SCORE(FLG)
        implicit integer (A-Z)
C SCORE-- PRINT OUT CURRENT SCORE
C
C DECLARATIONS
C
        LOGICAL FLG
        INTEGER RANK(10)
C
C GAME STATE
C
        LOGICAL TELFLG
        COMMON /PLAY/ WINNER,HERE,TELFLG
        COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD,
     1       LTSHFT,BLOC,MUNGRM,HS
C
C FLAGS
C
        LOGICAL FLAGS(35)
        LOGICAL TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
        LOGICAL DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
        LOGICAL MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
        LOGICAL EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
        LOGICAL GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
        LOGICAL GLACMF,FROBZF,ENDGMF,CYCLOF2,BUGF
        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,CYCLOF2,BUGF
        COMMON /FINDEX/ BTIEF,BINFF
        EQUIVALENCE (FLAGS(1),TROLLF)
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)
        DATA RANK/20,19,18,16,12,8,4,2,1,0/
C
        AS=ASCORE(WINNER)
        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
      IF (.NOT. ENDGMF) GOTO 5
      I = 1
      if ( as .eq. 600 ) i = 657 - 484
      GOTO 50

    5 CONTINUE
        DO 10 I=1,10
          IF((AS*20/MXSCOR).GE.RANK(I)) GO TO 50
10      CONTINUE
50      CALL RSPEAK(484+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.')
C
        END
        SUBROUTINE SCRUPD(N)
        implicit integer (A-Z)
C SCRUPD- UPDATE WINNERBS SCORE
C
C DECLARATIONS
C
C
C GAME STATE
C
        LOGICAL TELFLG
        COMMON /PLAY/ WINNER,HERE,TELFLG
        COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD,
     1       LTSHFT,BLOC,MUNGRM,HS
C
C CLOCK INTERRUPTS
C
        LOGICAL CFLAG
        COMMON /CEVENT/ CLNT,CTICK(20),CACTIO(20),CFLAG(20)
C
        COMMON /CINDEX/ CEVCUR,CEVMNT,CEVLNT,CEVMAT,CEVCND,
     1       CEVBAL,CEVBRN,CEVFUS,CEVLED,CEVSAF,CEVVLG,
     2       CEVGNO,CEVBUC,CEVSPH,CEVEGH
C
C ADVENTURERS
C
        COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4),
     1       AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4)
C
        ASCORE(WINNER)=ASCORE(WINNER)+N
        RWSCOR=RWSCOR+N
        IF(ASCORE(WINNER).LT.(MXSCOR-(10*DEATHS))) RETURN
      IF ( CFLAG(CEVEGH) ) RETURN
        CFLAG(CEVEGH)=.TRUE.
        CTICK(CEVEGH)=15
        RETURN
        END
        LOGICAL FUNCTION FINDXT(DIR,RM)
        implicit integer (A-Z)
C FINDXT- FIND EXIT FROM ROOM
C
C DECLARATIONS
C
C
C ROOMS
C
        COMMON /ROOMS/ RLNT,RDESC1(150),RDESC2(150),REXIT(150),
     1       RACTIO(150),RVAL(150),RFLAG(150),RRAND(150)
C
C EXITS
C
        COMMON /EXITS/ XLNT,TRAVEL(625)
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.
        XI=REXIT(RM)
        IF(XI.EQ.0) GO TO 1000
C
100     I=TRAVEL(XI)
        XROOM1=AND(I,XRMASK)
C        XTYPE=AND(INT(AND(I,COMPL(XLFLAG)))/XFSHFT,XFMASK)+1
#if defined(__INTEL_COMPILER) || (defined __GFORTRAN__)
      XTYPE = and( ISHFTC(I,-8), XFMASK ) + 1
#elif defined (__PGI_COMPILER)
      XTYPE = ( SHIFT(I,-8) .AND. XFMASK ) + 1
#else
#error FORTRAN Compiler not defined
#endif
        GO TO (110,120,130,130),XTYPE
      CALL GOTOER
        CALL BUG(10,XTYPE)
C
130     XOBJ=AND(TRAVEL(XI+2),XRMASK)
        XACTIO=TRAVEL(XI+2)/XASHFT
120     XSTRNG=TRAVEL(XI+1)
110     XI=XI+XELNT(XTYPE)
C      PRINT 124,XI,XTYPE,XOBJ,XACTIO,XDMASK,XLFLAG,XRMASK,XASHFT,XROOM1
C  124 FORMAT(" XI,XTYPE,XOBJ,XACTIO,XDMASK,XLFLAG,XRMASK,XROOM1=",
C     +I3,1X,I3,1X,I3,1X,I3,/,1X,3(O20,1X),/," XROOM1=",I4)
        IF(AND(I,XDMASK).EQ.DIR) RETURN
        IF(AND(I,XLFLAG).EQ.0) GO TO 100
1000    FINDXT=.FALSE.
        RETURN
        END
        INTEGER FUNCTION FWIM(F1,F2,RM,CON,ADV,NOCARE)
        implicit integer (A-Z)
C FWIM- FIND WHAT I MEAN
C
C DECLARATIONS
C
        LOGICAL NOCARE
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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,ECHOBT,ACTRBT,
     1       WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
     2       TCHBT,VEHBT,SCHBT
C
        FWIM=0
        DO 1000 I=1,OLNT
          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(AND(OFLAG1(I),VISIBT).EQ.0) GO TO 1000
          IF((.NOT.NOCARE .AND.(AND(OFLAG1(I),TAKEBT).EQ.0)) .OR.
     1       ((AND(OFLAG1(I),F1).EQ.0).AND.
     2        (AND(OFLAG2(I),F2).EQ.0))) GO TO 500
          IF(FWIM.EQ.0) GO TO 400
          FWIM=-FWIM
          RETURN
C
400       FWIM=I
C
C DOES OBJECT CONTAIN A MATCH?
C
500       IF(AND(OFLAG2(I),OPENBT).EQ.0) GO TO 1000
          DO 700 J=1,OLNT
            IF((OCAN(J).NE.I).OR.(AND(OFLAG1(J),VISIBT).NE.0) .OR.
     1       ((AND(OFLAG1(I),F1).EQ.0).AND.
     2        (AND(OFLAG2(I),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
        LOGICAL FUNCTION YESNO(Q,Y,N)
        implicit integer(A-Z)
        character*3 ans
C YESNO- OBTAIN YES/NO ANSWER
C
C CALLED BY-
C
C       YES-IS-TRUE=YESNO(QUESTION,YES-STRING,NO-STRING)
C
        COMMON /CHAN/ INPCH,OUTCH,DBCH
C
100     CALL RSPEAK(Q)
        READ(INPCH,110,END=400) ANS
  110 FORMAT( A3  )
10000   IF((ANS.EQ."Y").OR.(ANS.EQ."YE").OR.(ANS.EQ."YES")) GO TO 200
        IF((ANS.EQ."N").OR.(ANS.EQ."NO").OR.(ANS.EQ."NO ")) GO TO 300
      IF((ANS.EQ."y").OR.(ANS.EQ."ye").OR.(ANS.EQ."yes"))GOTO 200
      IF((ANS.EQ."n").OR.(ANS.EQ."no").OR.(ANS.EQ."no  "))GOTO 300
        CALL RSPEAK(6)
        GO TO 100
C
200     YESNO=.TRUE.
        CALL RSPEAK(Y)
        RETURN

 400    continue
        close(5)
        open(5, file="/dev/tty")
        goto 100
C
300     YESNO=.FALSE.
        CALL RSPEAK(N)

        RETURN
C
        END
        INTEGER FUNCTION ROBADV(ADV,NR,NC,NA)
        implicit integer (A-Z)
C ROBADV-- STEAL WINNER"S VALUABLES
C
C DECLARATIONS
C
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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,ECHOBT,ACTRBT,
     1       WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
     2       TCHBT,VEHBT,SCHBT
C
        ROBADV=0
        DO 100 I=1,OLNT
          IF((OADV(I).NE.ADV).OR.(OTVAL(I).LE.0).OR.
     1       (AND(OFLAG2(I),SCRDBT).NE.0)) GO TO 100
          CALL NEWSTA(I,0,NR,NC,NA)
          ROBADV=ROBADV+1
100     CONTINUE
        RETURN
        END
        INTEGER FUNCTION ROBRM(RM,PR,NR,NC,NA)
        implicit integer (A-Z)
C ROBRM-- STEAL ROOM VALUABLES
C
C DECLARATIONS
C
        LOGICAL PROB,QHERE
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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,ECHOBT,ACTRBT,
     1       WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
     2       TCHBT,VEHBT,SCHBT
        PROB(X)=(RND(100).LT.X)
C
        ROBRM=0
        DO 100 I=1,OLNT
          IF(.NOT. QHERE(I,RM)) GO TO 100
          IF((OTVAL(I).LE.0).OR.(AND(OFLAG2(I),SCRDBT).NE.0).OR.
     1       (AND(OFLAG1(I),VISIBT).EQ.0).OR.(.NOT.PROB(PR)))
     2       GO TO 50
          CALL NEWSTA(I,0,NR,NC,NA)
          ROBRM=ROBRM+1
          OFLAG2(I)=OR(OFLAG2(I),TCHBT)
          GO TO 100
50        IF(AND(OFLAG2(I),ACTRBT).NE.0)
     1       ROBRM=ROBRM+ROBADV(ORAND(I),NR,NC,NA)
100     CONTINUE
        RETURN
        END
        LOGICAL FUNCTION WINNIN(VL,HR)
        implicit integer (A-Z)
C WINNIN-- SEE IF VILLAIN IS WINNING
C
C DECLARATIONS
C
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
C
        VS=OCAPAC(VL)
        PS=VS-FIGHTS(HR,.TRUE.)
        I=90
        IF(PS.GT.3) GO TO 100
        I=75
        IF(PS.GT.0) GO TO 100
        I=50
        IF(PS.EQ.0) GO TO 100
        I=25
        IF(VS.GT.1) GO TO 100
        I=10
100     WINNIN=(RND(100).LT.I)
        RETURN
        END
        INTEGER FUNCTION FIGHTS(H,FLG)
        implicit integer (A-Z)
C FIGHTS-- COMPUTE FIGHT STRENGTH
C
C DECLARATIONS
C
        LOGICAL FLG
C
C GAME STATE
C
        COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD,
     1       LTSHFT,BLOC,MUNGRM,HS
C
C ADVENTURERS
C
        COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4),
     1       AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4)
        DATA SMAX/7/,SMIN/2/
C
        FIGHTS=SMIN+((((SMAX-SMIN)*ASCORE(H))+(MXSCOR/2))/MXSCOR)
        IF(FLG) FIGHTS=FIGHTS+ASTREN(H)
        RETURN
        END
        LOGICAL FUNCTION OPNCLS(OBJ,SO,SC)
        implicit integer (A-Z)
C OPNCLS-- PROCESS OPEN/CLOSE FOR DOORS
C
C DECLARATIONS
C
        LOGICAL QOPEN
C
C PARSER OUTPUT
C
        LOGICAL PRSWON
        COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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,ECHOBT,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
        COMMON /VINDEX/ TAKEW,INVENW,FILLW,EATW,DRINKW,BURNW
        COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW
        COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW
        COMMON /VINDEX/ DIGW,LEAPW
        QOPEN(O)=AND(OFLAG2(O),OPENBT).NE.0
C
        OPNCLS=.TRUE.
        IF(PRSA.EQ.CLOSEW) GO TO 100
        IF(PRSA.EQ.OPENW) GO TO 50
        OPNCLS=.FALSE.
        RETURN
C
   50 IF(QOPEN(OBJ)) GO TO 200
        CALL RSPEAK(SO)
        OFLAG2(OBJ)=OR(OFLAG2(OBJ),OPENBT)
        RETURN
C
100     IF(.NOT.QOPEN(OBJ)) GO TO 200
        CALL RSPEAK(SC)
        OFLAG2(OBJ)=AND(OFLAG2(OBJ),COMPL(OPENBT))
        RETURN
C
200     CALL RSPEAK(125+RND(3))
        RETURN
        END
        LOGICAL FUNCTION LIT(RM)
        implicit integer (A-Z)
C LIT-- IS ROOM LIT?
C
C DECLARATIONS
C
        LOGICAL QHERE
C
C ROOMS
C
        COMMON /ROOMS/ RLNT,RDESC1(150),RDESC2(150),REXIT(150),
     1       RACTIO(150),RVAL(150),RFLAG(150),RRAND(150)
C
        COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR,
     1       RSACRD,RFILL,RMUNG,RBUCK,RHOUSE
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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,ECHOBT,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.
        IF(AND(RFLAG(RM),RLIGHT).NE.0) RETURN
C
        DO 1000 I=1,OLNT
          IF(QHERE(I,RM)) GO TO 100
          OA=OADV(I)
          IF(OA.LE.0) GO TO 1000
          IF(AROOM(OA).NE.RM) GO TO 1000
C
C OBJ IN ROOM OR ON ADV IN ROOM
C
100       IF(AND(OFLAG1(I),ONBT).NE.0) RETURN
          IF((AND(OFLAG1(I),VISIBT).EQ.0).OR.
     1       ((AND(OFLAG1(I),TRANBT).EQ.0).AND.
     2       (AND(OFLAG2(I),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.(AND(OFLAG1(J),ONBT).NE.0))
     1       RETURN
500       CONTINUE
1000    CONTINUE
        LIT=.FALSE.
        RETURN
        END
        INTEGER FUNCTION WEIGHT(RM,CN,AD)
        implicit integer (A-Z)
C WEIGHT- RETURNS SUM OF WEIGHT OF QUALIFYING OBJECTS
C
C DECLARATIONS
C
        LOGICAL QHERE
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
C
        WEIGHT=0
        DO 100 I=1,OLNT
          IF(OSIZE(I).GE.10000) GO TO 100
          IF((QHERE(I,RM).AND.(RM.NE.0)).OR.
     1       ((OADV(I).EQ.AD).AND.(AD.NE.0))) GO TO 50
          J=I
25        J=OCAN(J)
          IF(J.EQ.0) GO TO 100
          IF(J.NE.CN) GO TO 25
50        WEIGHT=WEIGHT+OSIZE(I)
100     CONTINUE
        RETURN
        END
        SUBROUTINE RSPEAK(N)
        implicit integer(A-Z)
C RSPEAK-- OUTPUT RANDOM MESSAGE ROUTINE
C
C CALLED BY--
C
C       CALL RSPEAK(MSGNUM)
C
C
        CALL RSPSB2(N,0,0)
        RETURN
        END
C RSPSUB-- OUTPUT RANDOM MESSAGE WITH SUBSTITUTABLE ARGUMENT
C
        SUBROUTINE RSPSUB(N,S1)
        implicit integer(A-Z)
C CALLED BY--
C
C       CALL RSPSUB(MSGNUM,SUBNUM)
C
C
        CALL RSPSB2(N,S1,0)
        RETURN
        END
        SUBROUTINE RSPSB2(A,B,C)
        implicit integer(A-Z)
C RSPSB2-- OUTPUT RANDOM MESSAGE WITH SUBSTITUTABLE ARGUMENTS
C
C CALLED BY--
C
C       CALL RSPSB2(MSGNUM,S1,S2)
C
        INTEGER B1(170),B2(170)
C
C DECLARATIONS
C
        LOGICAL TELFLG
        COMMON /PLAY/ WINNER,HERE,TELFLG
C
        COMMON /RMSG/ MLNT,RTEXT(800)
        COMMON /CHAN/ INPCH,OUTCH,DBCH

        character*4 holl2char
C
C CONVERT ALL ARGUMENTS FROM DICTIONARY NUMBERS (IF POSITIVE)
C TO ABSOLUTE RECORD NUMBERS.
C
        X=A
        Y=B
        Z=C
        IF(X.GT.0) X=RTEXT(X)
        IF(Y.GT.0) Y=RTEXT(Y)
        IF(Z.GT.0) Z=RTEXT(Z)
        X=IABS(X)
        Y=IABS(Y)
        Z=IABS(Z)
        IF(X.EQ.0) RETURN
        TELFLG=.TRUE.
      NL = 0
C
      READ( 2, 100, REC=X ) OLDREC, (B1(IXYZ), IXYZ=1, 170)
100   FORMAT( A8 , 170a1 )
200   IF( Y .EQ. 0 ) GOTO 400
        DO 300 I=1,170
           write( holl2char, 124 ) b1(i)
 124       format( a4 )
*          IF(B1(I).EQ."#") GO TO 1000
          if( holl2char .EQ."#") GO TO 1000
300     CONTINUE
C
400     DO 500 I=1,170
           write( holl2char, 124 ) b1(171-i)
*           IF(B1(171-I).NE." ") GO TO 600
           IF( holl2char .NE." ") GO TO 600
500     CONTINUE
600    I=171-I
      WRITE(OUTCH,650)(B1(IFROG),IFROG=1,I)
  650 FORMAT ( 170a1 )
      NL = NL + 1
      READ( 2, 100, REC=X+NL ) NEWREC, (B1(IXYZ), IXYZ=1, 170)
      IF( NEWREC .EQ. OLDREC ) GOTO 200

700   CONTINUE
      RETURN
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
      IFROG = I+1
        DO 1100 K1=IFROG,170
          B2(K2)=B1(K1)
          K2=K2+1
1100    CONTINUE
C
      READ( 2, 100, REC=Y ) IFROG, (B1(IXYZ), IXYZ=I,170)
C
        DO 1200 J=1,170
           write( holl2char, 124 ) b1(171-j)
*          IF(B1(171-J).NE." ") GO TO 1300
          IF( holl2char .NE." ") GO TO 1300
1200    CONTINUE
1300   J=171-J
        K1=1
      ICLAM = J+1
        DO 1400 K2=ICLAM,170
          B1(K2)=B2(K1)
          K1=K1+1
1400    CONTINUE
C
        Y=Z
        Z=0
C
C     RESTORE ORIGNAL MESSAGE FOR *RNL* IN CASE OF MULTI-LINE
C     SUBSTITUTABLE MESSAGES.  SKIP *NL* LINES, AS THEY HAVE
C     ALREADY BEEN PROCESSED.
C
      READ( 2, 100, REC=X ) IFROG, (B2(IXYZ), IXYZ=1, 170)
      IF(NL.EQ.0) GOTO 200
      DO 1500 ICLAM = 1, NL
 1500 READ( 2, 100, REC=X+ICLAM ) IFROG, (B2(IXYZ), IXYZ=1, 170)
        GO TO 200
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(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
C
        OBJACT=.TRUE.
        IF(PRSI.EQ.0) GO TO 100
        RA=OACTIO(PRSI)
        IF(RA.EQ.0) GO TO 100
        IF(OAPPLI(RA,0)) RETURN
C
100     IF(PRSO.EQ.0) GO TO 200
        RA=OACTIO(PRSO)
        IF(RA.EQ.0) GO TO 200
        IF(OAPPLI(RA,0)) RETURN
C
200     OBJACT=.FALSE.
        RETURN
        END
      SUBROUTINE BUG(A,B)
        implicit integer(A-Z)
C BUG-- REPORT FATAL SYSTEM ERROR
C
C CALLED BY--
C
C       CALL BUG(NO,PAR)
C
C
        COMMON /DEBUG/ DBGFLG
C
        PRINT 100,A,B
        
        IF(DBGFLG.NE.0) RETURN
        CALL EXIT

100     FORMAT(' PROGRAM ERROR ',I12,', PARAMETER=',I6)
        END
        SUBROUTINE NEWSTA(O,R,RM,CN,AD)
        implicit integer(A-Z)
C NEWSTA-- SET NEW STATUS FOR OBJECT
C
C CALLED BY--
C
C       CALL NEWSTA(OBJECT,STRING,NEWROOM,NEWCON,NEWADV)
C
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
C
        CALL RSPEAK(R)
        OROOM(O)=RM
        OCAN(O)=CN
        OADV(O)=AD
        RETURN
        END
        LOGICAL FUNCTION QHERE(OBJ,RM)
        implicit integer (A-Z)
C QHERE-- TEST FOR OBJECT IN ROOM
C
C DECLARATIONS
C
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
C
        COMMON /OROOM2/ R2LNT,O2(6),R2(6)
C
        QHERE=.TRUE.
        IF(OROOM(OBJ).EQ.RM) RETURN
        DO 100 I=1,R2LNT
          IF((O2(I).EQ.OBJ).AND.(R2(I).EQ.RM)) RETURN
100     CONTINUE
        QHERE=.FALSE.
        RETURN
        END
        LOGICAL FUNCTION QEMPTY(OBJ)
        implicit integer (A-Z)
C QEMPTY-- TEST FOR OBJECT EMPTY
C
C DECLARATIONS
C
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
C
        QEMPTY=.FALSE.
        DO 100 I=1,OLNT
          IF(OCAN(I).EQ.OBJ) RETURN
100     CONTINUE
        QEMPTY=.TRUE.
        RETURN
        END
        SUBROUTINE JIGSUP(DESC)
        implicit integer (A-Z)
C JIGSUP- YOU ARE DEAD
C
C DECLARATIONS
C
        LOGICAL YESNO,MOVETO,F
        INTEGER RLIST(9)
C
C GAME STATE
C
        LOGICAL TELFLG
        COMMON /PLAY/ WINNER,HERE,TELFLG
        COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD,
     1       LTSHFT,BLOC,MUNGRM,HS
C
        COMMON /CHAN/ INPCH,OUTCH,DBCH
        COMMON /DEBUG/ DBGFLG
C
C ROOMS
C
        COMMON /ROOMS/ RLNT
C
        COMMON /RINDEX/ WHOUS,LROOM,CELLA
        COMMON /RINDEX/ MTROL,MAZE1
        COMMON /RINDEX/ MGRAT,MAZ15
        COMMON /RINDEX/ FORE1,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,WHITEC1,WHITEC2
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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,ECHOBT,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
        COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT
        COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE
        COMMON /OINDEX/ ROBOT,LUNGS,SAILO,AVIAT,TEETH
        COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,STAFF,SPIDER,TAPEST,WEB
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
C
C FLAGS
C
        LOGICAL FLAGS(35)
        LOGICAL TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
        LOGICAL DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
        LOGICAL MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
        LOGICAL EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
        LOGICAL GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
        LOGICAL GLACMF,FROBZF,ENDGMF,CYCLOF2,BUGF
        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,CYCLOF2,BUGF
        COMMON /FINDEX/ BTIEF,BINFF
        EQUIVALENCE (FLAGS(1),TROLLF)

        DATA RLIST/8,6,36,35,34,4,34,6,5/
C JIGSUP, PAGE 2
C
        CALL RSPEAK(DESC)
        IF(DBGFLG.NE.0) RETURN
        AVEHIC(WINNER)=0
        IF(WINNER.EQ.PLAYER) GO TO 100
        CALL RSPSUB(432,ODESC2(AOBJ(WINNER)))
        CALL NEWSTA(AOBJ(WINNER),0,0,0,0)
        RETURN
C
100     IF(DEATHS.GE.2) GO TO 1000
        IF(.NOT.YESNO(10,9,8)) GO TO 1100
        DEATHS=DEATHS+1
        CALL SCRUPD(-10)
        F=MOVETO(FORE1)
        EGYPTF=.TRUE.
        IF(OADV(COFFI).EQ.WINNER) CALL NEWSTA(COFFI,0,EGYPT,0,0)
        OFLAG2(DOOR)=AND(OFLAG2(DOOR),COMPL(TCHBT))
        IF((OROOM(LAMP).NE.0).OR.(OADV(LAMP).EQ.WINNER))
     1       CALL NEWSTA(LAMP,0,LROOM,0,0)
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
          IF((OADV(J).NE.WINNER).OR.(OTVAL(J).NE.0))
     1       GO TO 200
          I=I+1
          IF(I.GT.9) GO TO 400
          CALL NEWSTA(J,0,RLIST(I),0,0)
200     CONTINUE
C
400     I=RLNT
        DO 300 J=1,OLNT
          IF((OADV(J).NE.WINNER).OR.(OTVAL(J).EQ.0))
     1       GO TO 300
          CALL NEWSTA(J,0,I,0,0)
          I=I-1
300     CONTINUE
C
        DO 500 J=1,OLNT
          IF(OADV(J).NE.WINNER) GO TO 500
          CALL NEWSTA(J,0,I,0,0)
          I=I-1
500     CONTINUE
        RETURN
C
C CANT OR WONT CONTINUE, CLEAN UP AND EXIT.
C
1000    CALL RSPEAK(7)
1100    CALL SCORE(.FALSE.)
C       CLOSE (DBCH,DISP=KEEP)
        CALL EXIT
C
        END
        SUBROUTINE GAME
        implicit integer (A-Z)
C GAME- MAIN COMMAND LOOP FOR DUNGEON
C
C DECLARATIONS
C
        LOGICAL RMINFO,VAPPLI,RAPPLI,AAPPLI
        LOGICAL F,PARSE,FINDXT,XVEHIC
        INTEGER SECHO(4),GRDSTR(6),INLINE(78)
        REAL RSLT
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
C
C MISCELLANEOUS VARIABLES
C
        COMMON /CHAN/ INPCH,OUTCH,DBCH
C
C ROOMS
C
        COMMON /ROOMS/ RLNT,RDESC1(150),RDESC2(150),REXIT(150),
     1       RACTIO(150),RVAL(150),RFLAG(150),RRAND(150)
C
        COMMON /RINDEX/ WHOUS,LROOM,CELLA
        COMMON /RINDEX/ MTROL,MAZE1
        COMMON /RINDEX/ MGRAT,MAZ15
        COMMON /RINDEX/ FORE1,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,WHITEC1,WHITEC2
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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,ECHOBT,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
        COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT
        COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE
        COMMON /OINDEX/ ROBOT,LUNGS,SAILO,AVIAT,TEETH
        COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,STAFF,SPIDER,TAPEST,WEB
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
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
        COMMON /VINDEX/ TAKEW,INVENW,FILLW,EATW,DRINKW,BURNW
        COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW
        COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW
        COMMON /VINDEX/ DIGW,LEAPW
C
C FLAGS
C
        LOGICAL FLAGS(35)
        LOGICAL TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
        LOGICAL DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
        LOGICAL MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
        LOGICAL EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
        LOGICAL GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
        LOGICAL GLACMF,FROBZF,ENDGMF,CYCLOF2,BUGF
        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,CYCLOF2,BUGF
        COMMON /FINDEX/ BTIEF,BINFF
        EQUIVALENCE (FLAGS(1),TROLLF)


c DEBUG *8
        COMMON /SYNFLG/ SDIR,SIND,SSTD,SFLIP,SDRIV,SVMASK
C VOCABULARIES

        integer*8 bvoc
        COMMON /BUZVOC/ BVOC(10)

        integer*8 pvoc
        COMMON /PRPVOC/ PVOC(32)

        integer*8 dvoc
        COMMON /DIRVOC/ DVOC(60)

        INTEGER*8 AVOC(200),avoc1,avoc2,avocnd
        COMMON /ADJVOC/ AVOC1(116),AVOC2(77),AVOCND

        INTEGER*8 VVOC(640),vvoc1,vvoc1a,vvoc2,vvoc3,vvoc4
        integer*8 vvoc5,vvoc6,vvoc7,vvocnd
        COMMON /VRBVOC/ VVOC1(67),VVOC1A(69),VVOC2(53),VVOC3(94),
     1          VVOC4(99),VVOC5(93),VVOC6(85),VVOC7(70),VVOCND

        INTEGER*8 OVOC(580), ovoc1, ovoc2, ovoc3, ovoc4, ovoc5
        integer*8 ovoc6,ovoc7,ovocnd
        COMMON /OBJVOC/ OVOC1(106),OVOC2(96),OVOC3(94),OVOC4(85),
     1          OVOC5(72),OVOC6(68),OVOC7(51),OVOCND
C
        EQUIVALENCE (VVOC(1),VVOC1(1))
        EQUIVALENCE (AVOC(1),AVOC1(1))
        EQUIVALENCE (OVOC(1),OVOC1(1))
        EQUIVALENCE (FLAGS(1),TROLLF)
C

        character*4 holl2char

        DATA SECHO/1hE,1hC,1hH,1hO/
        DATA GRDSTR/1hG,1hU,1hA,1hR,1hD,1hI/
C GAME, PAGE 2
C
C START UP, DESCRIBE CURRENT LOCATION.
C
        CALL RSPEAK(1)
        F=RMINFO(.TRUE.)
C
C NOW LOOP, READING AND EXECUTING COMMANDS.
C
100     WINNER=PLAYER
        TELFLG=.FALSE.

c      print 191, sdir
c 191  format("sdir(40000)      =", o9)
c      print 192, ovoc7(37)
c 192  format("ovoc7[37](spider)='", a8, "'")
*      print 193, vvoc7(41)
* 193  format("vvoc7[41](unlock)='", a8, "'")
*      print 1931, vvoc7(42)
* 1931 format("vvoc7[42](7)='", i8, "'")
*      print 1932, vvoc7(43)
* 1932 format("vvoc7[43](60135)='", o8, "'")
c      print 194, avoc2(64)
c 194  format("avoc2[64](eat$me)='", a8, "'")
c      print 195, dvoc(17)
c 195  format("dvoc[17](southe) ='", a8, "'")
c      print 196, pvoc(17)
c 196  format("pvoc[17](into)   ='", a8, "'")
c      print 197, bvoc(10)
c 197  format("bvoc[10](procee) ='", a8, "'")


        CALL RDLINE(INLINE,INLNT,1)
c        print 106, inlnt, inline
c 106    format("GAME c=",i6, ", inline=", 78a1, "!")
C
        DO 150 I=1,6
          IF(INLINE(I).NE.GRDSTR(I)) GO TO 200
150     CONTINUE
        CALL GUARD
        GO TO 100
C
200     MOVES=MOVES+1
c        print *, "game calling PARSE now"
        PRSWON=PARSE(INLINE(1),INLNT)
        IF(.NOT.PRSWON) GO TO 400
        IF(XVEHIC(1)) GO TO 400
C
        F=(PRSA.EQ.LOOKW)
        IF(PRSA.EQ.TELLW) GO TO 2000
300     IF((PRSO.EQ.VALUA).OR.(PRSO.EQ.EVERY)) GO TO 900
        IF(.NOT.VAPPLI(PRSA)) GO TO 400
350     IF(.NOT.ECHOF.AND.(HERE.EQ.ECHOR)) GO TO 1000
        IF(.NOT.F.AND.RACTIO(HERE).NE.0) F=RAPPLI(RACTIO(HERE))
C
400     CALL XENDMV(TELFLG)
      IF (ENDGMF) CALL ENDGAME
        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)
*        print 1001, inlnt, inline
* 1001   format("RDLINE 1 c=",i6, ", inline=", 78a1, "!")
        MOVES=MOVES+1
        DO 1100 I=1,4
          IF(INLINE(I).NE.SECHO(I)) GO TO 1300
1100    CONTINUE
C
        DO 1200 I=5,78
           write( holl2char, 124 ) inline(i)
 124       format( a4 )
*          IF(INLINE(I).NE." ") GO TO 1300
          IF( holl2char .NE." ") GO TO 1300
1200    CONTINUE
C
        CALL RSPEAK(571)
        ECHOF=.TRUE.
        OFLAG2(BAR)=AND(OFLAG2(BAR),COMPL(SCRDBT))
        PRSWON=.TRUE.
        GO TO 400
C
1300    PRSWON=PARSE(INLINE(1),INLNT)
        IF(.NOT.PRSWON .OR. (PRSA.NE.WALKW) .OR. (PRSO.EQ.0))
     1       GO TO 1400
        IF(FINDXT(PRSO,HERE)) GO TO 300
C
1400    WRITE(OUTCH,1410) (INLINE(J),J=1,INLNT)
1410    FORMAT(78A1)
        TELFLG=.TRUE.
        GO TO 1000
C GAME, PAGE 4
C
C SPECIAL CASE-- TELL <ACTOR> "NEW COMMAND"
C NOTE THAT WE CANNOT BE IN THE ECHO ROOM.
C
2000    IF(AND(OFLAG2(PRSO),ACTRBT).NE.0) GO TO 2100
        CALL RSPEAK(602)
        GO TO 350
C
2100    WINNER=ORAND(PRSO)
        HERE=AROOM(WINNER)
        CALL RDLINE(INLINE,INLNT,WINNER)
*        print 2101, inlnt, inline
* 2101   format("RDLINE 2 c=",i6, ", inline=", 78a1, "!")
        IF(PARSE(INLINE(1),INLNT)) GO TO 2150
2700    I=341
        IF(TELFLG) I=604
        CALL RSPEAK(I)
2600    WINNER=PLAYER
        HERE=AROOM(WINNER)
        GO TO 350
C
2150    RA=AACTIO(WINNER)
        IF(RA.EQ.0) GO TO 2175
        IF(AAPPLI(RA)) GO TO 2400
2175    IF(XVEHIC(1)) GO TO 2400
        IF((PRSO.EQ.VALUA).OR.(PRSO.EQ.EVERY)) GO TO 2900
        IF(.NOT.VAPPLI(PRSA)) GO TO 2400
2350    IF(RACTIO(HERE).NE.0) F=RAPPLI(RACTIO(HERE))
C
2400    CALL XENDMV(TELFLG)
        GO TO 2600
C
2900    CALL VALUAC(VALUA)
        GO TO 2350
C
        END



      SUBROUTINE ENDGAME
      implicit integer (A-Z)
C
C     HANDLE THE ADVENTURER'S ENDGAME.
C
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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,ECHOBT,ACTRBT,
     1       WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
     2       TCHBT,VEHBT,SCHBT
C
C FLAGS
C
        LOGICAL FLAGS(35)
        LOGICAL TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
        LOGICAL DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
        LOGICAL MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
        LOGICAL EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
        LOGICAL GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
        LOGICAL GLACMF,FROBZF,ENDGMF,CYCLOF2,BUGF
        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,CYCLOF2,BUGF
        COMMON /FINDEX/ BTIEF,BINFF
        EQUIVALENCE (FLAGS(1),TROLLF)
C
C GAME STATE
C
        LOGICAL TELFLG
        COMMON /PLAY/ WINNER,HERE,TELFLG
        COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD,
     1       LTSHFT,BLOC,MUNGRM,HS
C
C ROOMS
C
        COMMON /ROOMS/ RLNT,RDESC1(150),RDESC2(150),REXIT(150),
     1       RACTIO(150),RVAL(150),RFLAG(150),RRAND(150)
C
        COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR,
     1       RSACRD,RFILL,RMUNG,RBUCK,RHOUSE
C
C CLOCK INTERRUPTS
C
        LOGICAL CFLAG
        COMMON /CEVENT/ CLNT,CTICK(20),CACTIO(20),CFLAG(20)
C
        COMMON /CINDEX/ CEVCUR,CEVMNT,CEVLNT,CEVMAT,CEVCND,
     1       CEVBAL,CEVBRN,CEVFUS,CEVLED,CEVSAF,CEVVLG,
     2       CEVGNO,CEVBUC,CEVSPH,CEVEGH
C
        COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4),
     1       AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4)
C
C
      LOGICAL INIT
      LOGICAL RMINFO
      logical xyzzy, moveto
C
C     IF THE READING MATERIAL FOR THE LEAFLET HAS CHANGED, THEN
C     SIMPLY RETURN, AS THE ENDGAME HAS ALREADY BEEN INITIALIZED.
C
      IF ( OREAD(52) .EQ. 120) RETURN
*
*     GET OUR WINNER OUT OF ANY VEHICHLE SHE MAY BE IN....
*
      AVEHIC(WINNER) = 0
C
C     MAKE SURE KANGS ARE SEEN.
C
      RFLAG(5) = AND( RFLAG(5), COMPL(RSEEN) )
C
C     UPDATE MAXSCORE WITH ENDGAME BONUS POINTS.
C
C     25 POINTS FOR ENTERING IMPLEMENTERS TOMB,
C     25 POINTS FOR GETTING IN CRYPT.
C
      MXSCOR = MXSCOR + 50
C
C     INIT ROOM VALUE TO 25 POINTS (TOMB ROOM = 137).
C
      RVAL(137) = 25
C
C     MOVE ADVENTERER TO WEST SIDE OF HOUSE (ROOM 2).
C     PUT LEAFLET IN MAILBOX.  SET UP NEW
C     READING MATERIAL, AND CLOSE BOX.
C
C     OBJ 52 = LEAFLET.
C     OBJ 53 = MAILBOX.
C
*      CALL MOVETO (2)
      xyzzy = moveto( 2 )
      CALL NEWSTA (52,0,0,53,0)
      OFLAG2(53) = 0
      OREAD(52) = 120
      INIT = RMINFO(.TRUE.)
C
C     MAKE CYCLOPS DISSAPPEAR.
C
      CALL NEWSTA(58,0,0,0,0)
      CALL RSPEAK(639)
C
C     MORE ENDGAME SETUP.
C
C     OBJ 133 (SEWAGE) NOW BECOMES THE KANGS POUCH.
C
      ODESC1(133) = 0
      ODESC2(133) = 652
      OROOM(133)  = 0
      OCAN(133)   = 0
      OCAPAC(133) = 1
      OACTIO(133) = 0
      OFLAG1(133) = '101200'O
      OFLAG2(133) = 0
      OADV(133)   = 0
C
C     OBJ 138 (EATME CAKE) NOW BECOMES THE MYLAR NET.
C
      ODESC1(138) = 640
      ODESC2(138) = 641
      OREAD(138)  = 642
      OROOM(138)  = 125
      OCAN(138)   = 0
      OACTIO(138) = 128
      OFLAG1(138) = '164020'O
      OFLAG2(138) = 0
      OADV(138)   = 0
C
C     OBJ 141 (BLUE CAKE) NOW BECOMES THE MAGNIFYING GLASS.
C
      ODESC1(141) = 643
      ODESC2(141) = 644
      OREAD(141)  = 645
      OROOM(141)  = 0
      OCAN(141)   = 0
      OACTIO(141) = 0
      OFLAG1(141) = '164000'O
      OFLAG2(141) = 0
      OADV(141)   = 0
C
C     SET UP KANGAROO CLOCK EVENTS.
C
C     CEVENT 16 = DARK COLORED KANGAROO.
C     CEVENT 17 = LIGHT COLORED KANGAROO.
C
C     THE TICK COUNTS ARE DIFFERENT SO THE KANGAROOS
C     BOUNCE IN A DIFFERNET CYCLE.
C
      CFLAG(16) = .TRUE.
      CFLAG(17) = .TRUE.
      CTICK(16) = 2
      CTICK(17) = 5
      RETURN
      END
        SUBROUTINE XENDMV(FLAG)
        implicit integer(A-Z)
C XENDMV-      EXECUTE END OF MOVE FUNCTIONS.
C
C DECLARATIONS
C
        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)
        IF(THFACT) CALL THIEFD
        IF(PRSWON) CALL FIGHTD
        IF(SWDACT) CALL SWORDD
        IF(PRSWON) F=CLOCKD(X)
        IF(PRSWON) F=XVEHIC(2)
        RETURN
        END
        LOGICAL FUNCTION XVEHIC(N)
        implicit integer(A-Z)
C XVEHIC- EXECUTE VEHICLE FUNCTION
C
C DECLARATIONS
C
        LOGICAL OAPPLI
C
C GAME STATE
C
        LOGICAL TELFLG
        COMMON /PLAY/ WINNER,HERE,TELFLG
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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.
        AV=AVEHIC(WINNER)
        IF(AV.EQ.0) RETURN
        AV=OACTIO(AV)
        IF(AV.NE.0) XVEHIC=OAPPLI(AV,N)
        RETURN
        END
        LOGICAL FUNCTION PROTCT(X)
        implicit integer(A-Z)
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, A RESPONSE FROM THE USER IS EXPECTED.
C
        INTEGER WORD(6), SECRET(6)
        INTEGER HOUR, I
C        REAL TME
        DATA SECRET/1hF,1hU,1hZ,1hB,1hA,1hT/
C
C       THE USER MUST ENTER AN APPROPRIATE RESPONSE TO A QUESTION THAT
C       IS NOT ASKED.
C

        PROTCT = .TRUE.
      RETURN
C       HOUR = IFIX(TIME(1)/(60*60*60))
C       HOUR = AMOD(HOUR, 6)
        write (6, '(a)') "\nWelcome.  Perchance, what is the password?"
        READ (*,100, END=10000)WORD
100     FORMAT(BZ,6A1)
10000   DO 20 I = 1,6
          IF (SECRET(I) .NE. WORD(I)) PROTCT = .FALSE.
20      CONTINUE
        END



        SUBROUTINE GUARD
        implicit integer (A-Z)
C GUARD- GUARDIAN OF THE DUNGEON (GAME DEBUGGING TOOL)
C
C DECLARATIONS
C
        INTEGER LINE(10),PASSWD(5),DBGCMD(36),ARGTYP(36)
        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
C
C MESSAGE INDEX
C
        COMMON /RMSG/ MLNT,RTEXT(800)
C
        COMMON /DEBUG/ DBGFLG,PRSFLG
C
C ROOMS
C
        COMMON /ROOMS/ RLNT,EQR(150,7)
C
        COMMON /RVARS/ EQN(5)
C
        COMMON /RINDEX/ WHOUS,LROOM,CELLA
        COMMON /RINDEX/ MTROL,MAZE1
        COMMON /RINDEX/ MGRAT,MAZ15
        COMMON /RINDEX/ FORE1,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,WHITEC1,WHITEC2
C
        COMMON /OROOM2/ R2LNT,O2(6),R2(6)
C
C EXITS
C
        COMMON /EXITS/ XLNT,TRAVEL(625)
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,EQO(160,15)
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
        COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT
        COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE
        COMMON /OINDEX/ ROBOT,LUNGS,SAILO,AVIAT,TEETH
        COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,STAFF,SPIDER,TAPEST,WEB
C
C CLOCK INTERRUPTS
C
        LOGICAL CFLAG
        COMMON /CEVENT/ CLNT,EQC(20,2),CFLAG(20)
C
C VILLAINS AND DEMONS
C
        LOGICAL THFFLG,SWDACT,THFACT
        COMMON /HACK/ THFPOS,THFFLG,THFACT,SWDACT,SWDSTA
        COMMON /VILL/ VLNT,EQV(5,3)
C
C ADVENTURERS
C
        COMMON /ADVS/ ALNT,EQA(4,7)
C
C FLAGS
C
        LOGICAL FLAGS(35)
        INTEGER SWITCH(2)
        LOGICAL TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
        LOGICAL DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
        LOGICAL MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
        LOGICAL EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
        LOGICAL GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
        LOGICAL GLACMF,FROBZF,ENDGMF,CYCLOF2,BUGF
        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,CYCLOF2,BUGF
        COMMON /FINDEX/ BTIEF,BINFF
        COMMON /CHAN/ INPCH,OUTCH,DBCH
        EQUIVALENCE (FLAGS(1),TROLLF)
        EQUIVALENCE (SWITCH(1),BTIEF)

        character*4 holl2char

        DATA CMDMAX/36/
        DATA PASSWD/4hEXPL,4hURIB,4hUSON,4hION ,
     1       4hTKMG/
        DATA DBGCMD/2hDR,2hDO,2hDA,2hDC,2hDX,2hDH,2hDL,2hDV,2hDF,2hDS,
     1       2hAF,2hHE,2hNR,2hNT,2hNC,2hND,2hRR,2hRT,2hRC,2hRD,
     2       2hTK,2hEX,2hAR,2hAO,2hAA,2hAC,2hAX,2hAV,2hD2,2hDN,
     3       2hAN,2hDM,2hDT,2hAH,2hDP,2hPD/
        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 ,  0 ,
     3         1 ,  2 ,  1 ,  0 ,  0 ,  0 /

        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)
C GUARD, PAGE 2
C
C FIRST, VALIDATE THAT THE CALLER IS AN IMPLEMENTER.
C
        PRINT 100
        READ( inpch, 110, END=10001 ) LINE
10001   DO 1000 I=1,5
          IF(LINE(I).NE.PASSWD(I)) GO TO 1100
1000    CONTINUE
        write( outch, 120 )
        GO TO 2000
C
1100    CALL JIGSUP(182)
        RETURN
C
100     FORMAT('A booming voice calls out, ''Who summons the Guardian'/
     1 'of the Dungeon?  State your name, cat, and serial number.''')
110     FORMAT(BZ,5a4)
120     FORMAT('At your service.')
C
C HERE TO GET NEXT COMMAND
C
2000    write(outch,'(A$)') "GDN>"

        READ ( inpch, 210, END=10002 ) CMD
        write( holl2char, 124 ) cmd
 124    format( a4 )
*10002   IF(CMD.EQ."  ") GO TO 2000
10002   IF( holl2char.EQ."  ") GO TO 2000
        DO 2100 I=1,CMDMAX
          IF(CMD.EQ.DBGCMD(I)) GO TO 2300
2100    CONTINUE
2200    PRINT 220
        GO TO 2000
C
200     FORMAT(' GDN>')
210     FORMAT(BZ,A2)
220     FORMAT(' ?')
225     FORMAT(' LIMITS:   ')
235     FORMAT(' ENTRY:    ')
245     FORMAT(' IDX,ARY:  ')
C
2300    GO TO (2400,2500,2600,2700),ARGTYP(I)+1
      CALL GOTOER
        GO TO 2200
C
2700    PRINT 245
        READ (*,*,END=10003)J,K
10003   GO TO 2400
C
2600    PRINT 225
        READ (*,*,END=10004)J,K
10004   IF(K.EQ.0) K=J
        GO TO 2400
C
2500    PRINT 235
         READ (*,*,END=2400 )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),I
      CALL GOTOER
        GO TO 2200
C GUARD, PAGE 3
C
C DR-- DISPLAY ROOMS
C
10000   IF(.NOT.VALID2(J,K,RLNT)) GO TO 2200
        PRINT 300
        DO 10100 I=J,K
          PRINT 310,I,(EQR(I,L),L=1,7)
10100   CONTINUE
        GO TO 2000
C
300     FORMAT(' RM#  DESC1  DESC2  EXITS ACTION  VALUE  FLAGS   MUNG')
310     FORMAT(1X,I3,5(1X,I6),1X,O6,1X,I6)
C
C DO-- DISPLAY OBJECTS
C
11000   IF(.NOT.VALID2(J,K,OLNT)) GO TO 2200
        PRINT 320
        DO 11100 I=J,K
          PRINT 330,I,(EQO(I,L),L=1,15)
11100   CONTINUE
        GO TO 2000
C
320     FORMAT(' OB# DESC1 DESC2 DESCO ACT FLAGS1 FLAGS2 FVL TVL
     1  SIZE CAPAC ROOM ADV CON  READ  RAND')
330     FORMAT(1X,I3,3I6,I4,2O7,2I4,2I6,1X,3I4,2I6)
C
C DA-- DISPLAY ADVENTURERS
C
12000   IF(.NOT.VALID2(J,K,ALNT)) GO TO 2200
        PRINT 340
        DO 12100 I=J,K
          PRINT 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
        PRINT 360
        DO 13100 I=J,K
          PRINT 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
        PRINT 380
        DO 14100 I=J,K,10
          L=MIN0(I+9,K)
          PRINT 390,I,L,(TRAVEL(L1),L1=I,L)
14100   CONTINUE
        GO TO 2000
C
380     FORMAT('   RANGE   CONTENTS')
390     FORMAT(1X,I3,'-',I3,3X,10(I8,1X))
C
C DH-- DISPLAY HACKS
C
15000   PRINT 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   PRINT 410,RLNT,XLNT,OLNT,CLNT,VLNT,ALNT,MLNT,R2LNT
        GO TO 2000
C
410     FORMAT(' R=',I6,', X=',I6,', O=',I6,', C=',I6/
     1' V=',I6,', A=',I6,', M=',I6,', R2=',I5)
C
C DV-- DISPLAY VILLAINS
C
17000   IF(.NOT.VALID2(J,K,VLNT)) GO TO 2200
        PRINT 420
        DO 17100 I=J,K
          PRINT 430,I,(EQV(I,L),L=1,3)
17100   CONTINUE
        GO TO 2000
C
420     FORMAT(' VL# OBJECT   PROB   OPPS')
430     FORMAT(1X,I3,3(1X,I6))
C
C DF-- DISPLAY FLAGS
C
18000   IF(.NOT.VALID2(J,K,37)) GO TO 2200
        DO 18100 I=J,K
          IF(I.LE.35) PRINT 440,I,FLAGS(I)
          IF(I.GT.35) PRINT 445,I,SWITCH(I-35)
18100   CONTINUE
        GO TO 2000
C
440     FORMAT(' FLAG #',I2,' = ',L1)
445     FORMAT(' FLAG #',I2,' = ',I6)
C
C DS-- DISPLAY STATE
C
19000   PRINT *,PRSA,PRSO,PRSI,PRSWON,PRSCON
        PRINT *,WINNER,HERE,TELFLG
        PRINT *,MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD,LTSHFT,BLOC,
     1       MUNGRM,HS
        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))
C GUARD, PAGE 4
C
C AF-- ALTER FLAGS
C
20000   IF(.NOT.VALID1(J,37)) GO TO 2200
        IF(J.GT.35) GO TO 20200
        PRINT 480,FLAGS(J)
        READ (*,490,END=10005)FLAGS(J)
10005   GO TO 2000
C
20200   PRINT 590,SWITCH(J-35)
        READ (*,600,END=10006)SWITCH(J-35)
10006   GO TO 2000
C
480     FORMAT(' OLD=',L2,6X,'NEW= ')
490     FORMAT(BZ,L1)
C
C 21000-- HELP
C
21000   PRINT 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 RVARS'/' AO- ALTER OBJCTS'/' AR- ALTER ROOMS'/
     3' AV- ALTER VILLS'/' AX- ALTER EXITS'/' DA- DISPLAY ADVS'/
     4' DC- DISPLAY CEVENT'/' DF- DISPLAY FINDEX'/' DH- DISPLAY HACKS'/
     5' DL- DISPLAY LENGTHS'/' DM- DISPLAY RTEXT'/' DN- DISPLAY RVARS'/
     6' DO- DISPLAY OBJCTS'/' DP- DISPLAY PARSER'/
     6' DR- DISPLAY ROOMS'/' DS- DISPLAY STATE'/
     7' DT- DISPLAY TEXT'/' DV- DISPLAY VILLS'/' DX- DISPLAY EXITS'/
     +' D2- DISPLAY ROOM2'/' EX- EXIT'/' HE- TYPE THIS LIST'/
     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.
        THFACT=.FALSE.
        CALL NEWSTA(THIEF,0,0,0,0)
        PRINT 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)
        PRINT 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)
        PRINT 520
        GO TO 2000
C
520     FORMAT(' NO CYCLOPS.')
C
C ND-- IMMORTALITY MODE
C
25000   DBGFLG=1
        PRINT 530
        GO TO 2000
C
530     FORMAT(' NO DEATHS.')
C
C RR-- RESTORE ROBBER
C
26000   THFACT=.TRUE.
        PRINT 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)
        PRINT 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)
        PRINT 560
        GO TO 2000
C
560     FORMAT(' RESTORED CYCLOPS.')
C
C RD-- MORTAL MODE
C
29000   DBGFLG=0
        PRINT 570
        GO TO 2000
C
570     FORMAT(' RESTORED DEATHS.')
C GUARD, PAGE 5
C
C TK-- TAKE
C
30000   IF(.NOT.VALID1(J,OLNT)) GO TO 2200
        CALL NEWSTA(J,0,0,0,WINNER)
        PRINT 580
        GO TO 2000
C
580     FORMAT(' TAKEN.')
C
C EX-- GOODBYE
C
31000   RETURN
C
C AR--  ALTER ROOM ENTRY
C
32000   IF(.NOT.VALID3(J,RLNT,K,7)) GO TO 2200
        PRINT 590,EQR(J,K)
        READ (*,600,END=10007)EQR(J,K)
10007   GO TO 2000
C
590     FORMAT(' OLD= ',I6,6X,'NEW= ')
600     FORMAT(BZ,I6)
C
C AO-- ALTER OBJECT ENTRY
C
33000   IF(.NOT.VALID3(J,OLNT,K,15)) GO TO 2200
        PRINT 590,EQO(J,K)
        READ (*,600,END=10008)EQO(J,K)
10008   GO TO 2000
C
C AA-- ALTER ADVS ENTRY
C
34000   IF(.NOT.VALID3(J,ALNT,K,7)) GO TO 2200
        PRINT 590,EQA(J,K)
        READ (*,600,END=10009)EQA(J,K)
10009   GO TO 2000
C
C AC-- ALTER CLOCK EVENTS
C
35000   IF(.NOT.VALID3(J,CLNT,K,3)) GO TO 2200
        IF(K.EQ.3) GO TO 35500
        PRINT 590,EQC(J,K)
        READ (*,600,END=10010)EQC(J,K)
10010   GO TO 2000
C
35500   PRINT 480,CFLAG(J)
        READ (*,490,END=10011)CFLAG(J)
10011   GO TO 2000
C
C AX-- ALTER EXITS
C
36000   IF(.NOT.VALID1(J,XLNT)) GO TO 2200
        PRINT 610,TRAVEL(J)
        READ (*,620,END=10012)TRAVEL(J)
10012   GO TO 2000
C
610     FORMAT(' OLD= ',O6,6X,'NEW= ')
620     FORMAT(BZ,O6)
C
C AV-- ALTER VILLAINS
C
37000   IF(.NOT.VALID3(J,VLNT,K,3)) GO TO 2200
        PRINT 590,EQV(J,K)
        READ (*,600,END=10013)EQV(J,K)
10013   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
          PRINT 630,I,R2(I),O2(I)
38100   CONTINUE
        GO TO 2000
C
630     FORMAT(' #',I2,'   ROOM=',I6,'   OBJ=',I6)
C
C DN-- DISPLAY RVARS
C
39000   PRINT 640,EQN
        GO TO 2000
C
640     FORMAT(' RVARS=',5(1X,I6))
C
C AN-- ALTER RVARS
C
40000   IF(.NOT.VALID1(J,5)) GO TO 2200
        PRINT 590,EQN(J)
        READ (*,600,END=10014)EQN(J)
10014   GO TO 2000
C
C DM-- DISPLAY MESSAGES
C
41000   IF(.NOT.VALID2(J,K,MLNT)) GO TO 2200
        PRINT 380
        DO 41100 I=J,K,10
          L=MIN0(I+9,K)
          PRINT 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   PRINT 590,HERE
C       READ (*,600,END=10015)HERE
        READ (*,*,END=10015)HERE
10015   EQA(1,1)=HERE
        GO TO 2000
C
C DP--  DISPLAY PARSER STATE
C
44000   PRINT 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   PRINT 610,PRSFLG
        READ (*,620,END=10016)PRSFLG
10016   GO TO 2000
C
        END
        LOGICAL FUNCTION RMINFO(FULL)
        implicit integer (A-Z)
C RMINFO-- PRINT ROOM DESCRIPTION
C
C RMINFO PRINTS A DESCRIPTION OF THE CURRENT ROOM.
C IT IS ALSO THE PROCESSOR FOR VERBS "LOOK" AND "EXAMINE".
C
C
C DECLARATIONS
C
        LOGICAL FULL,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 ROOMS
C
        COMMON /ROOMS/ RLNT,RDESC1(150),RDESC2(150),REXIT(150),
     1       RACTIO(150),RVAL(150),RFLAG(150),RRAND(150)
C
        COMMON /RFLAG/ RSEEN
C
        COMMON /XSRCH/ XMIN,XMAX,XDOWN
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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
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
        COMMON /VINDEX/ TAKEW,INVENW,FILLW,EATW,DRINKW,BURNW
        COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW
        COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW
        COMMON /VINDEX/ DIGW,LEAPW
C
C FLAGS
C
        LOGICAL FLAGS(35)
        LOGICAL TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
        LOGICAL DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
        LOGICAL MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
        LOGICAL EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
        LOGICAL GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
        LOGICAL GLACMF,FROBZF,ENDGMF,CYCLOF2,BUGF
        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,CYCLOF2,BUGF
        COMMON /FINDEX/ BTIEF,BINFF
        EQUIVALENCE (FLAGS(1),TROLLF)
        PROB(X)=(RND(100).LT.X)
C RMINFO, PAGE 2
C
        RMINFO=.TRUE.
        TELFLG=.TRUE.
        IF(PRSO.GE.XMIN) PRSO=0
        IF(HERE.EQ.AROOM(PLAYER)) GO TO 100
        CALL RSPEAK(2)
        PRSA=WALKIW
        RETURN
C
100     IF(LIT(HERE)) GO TO 300
        CALL RSPEAK(430)
        RMINFO=.FALSE.
        RETURN
C
300     RA=RACTIO(HERE)
        I=RDESC2(HERE)
        IF(.NOT.FULL .AND. (SUPERF.OR.((AND(RFLAG(HERE),RSEEN).NE.0)
     1       .AND. (BRIEFF.OR.PROB(80))))) GO TO 400
        I=RDESC1(HERE)
        IF((I.NE.0).OR.(RA.EQ.0)) GO TO 400
        PRSA=LOOKW
        IF(.NOT.RAPPLI(RA)) GO TO 100
        PRSA=FOOW
        GO TO 500
C
  400 CONTINUE
        CALL RSPEAK(I)
500     RFLAG(HERE)=OR(RFLAG(HERE),RSEEN)
        IF(AVEHIC(WINNER).NE.0) CALL RSPSUB(431,ODESC2(AVEHIC(WINNER)))
        CALL PRINCR(FULL,HERE)
        IF(FULL.OR.(RA.EQ.0)) RETURN
        PRSA=WALKIW
        IF(.NOT.RAPPLI(RA)) GO TO 100
        PRSA=FOOW
        RETURN
C
        END
        LOGICAL FUNCTION RAPPLI(RI)
        implicit integer (A-Z)
C RAPPLI- SPECIAL PURPOSE ROOM ROUTINES
C
C DECLARATIONS
C
        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
C
C MISCELLANEOUS VARIABLES
C
        COMMON /BATS/ BATDRP(9)
C
C ROOMS
C
        COMMON /ROOMS/ RLNT,RDESC1(150),RDESC2(150),REXIT(150),
     1       RACTIO(150),RVAL(150),RFLAG(150),RRAND(150)
C
        COMMON /RVARS/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA
C
        COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR,
     1       RSACRD,RFILL,RMUNG,RBUCK,RHOUSE
C
        COMMON /RINDEX/ WHOUS,LROOM,CELLA
        COMMON /RINDEX/ MTROL,MAZE1
        COMMON /RINDEX/ MGRAT,MAZ15
        COMMON /RINDEX/ FORE1,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,WHITEC1,WHITEC2
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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,ECHOBT,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
        COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT
        COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE
        COMMON /OINDEX/ ROBOT,LUNGS,SAILO,AVIAT,TEETH
        COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,STAFF,SPIDER,TAPEST,WEB
C
C CLOCK INTERRUPTS
C
        LOGICAL CFLAG
        COMMON /CEVENT/ CLNT,CTICK(20),CACTIO(20),CFLAG(20)
C
        COMMON /CINDEX/ CEVCUR,CEVMNT,CEVLNT,CEVMAT,CEVCND,
     1       CEVBAL,CEVBRN,CEVFUS,CEVLED,CEVSAF,CEVVLG,
     2       CEVGNO,CEVBUC,CEVSPH,CEVEGH
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
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
        COMMON /VINDEX/ TAKEW,INVENW,FILLW,EATW,DRINKW,BURNW
        COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW
        COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW
        COMMON /VINDEX/ DIGW,LEAPW
C
C FLAGS
C
        LOGICAL FLAGS(35)
        LOGICAL TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
        LOGICAL DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
        LOGICAL MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
        LOGICAL EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
        LOGICAL GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
        LOGICAL GLACMF,FROBZF,ENDGMF,CYCLOF2,BUGF
        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,CYCLOF2,BUGF
        COMMON /FINDEX/ BTIEF,BINFF
        EQUIVALENCE (FLAGS(1),TROLLF)
        QOPEN(R)=AND(OFLAG2(R),OPENBT).NE.0
        QON(R)=AND(OFLAG1(R),ONBT).NE.0
        PROB(R)=(RND(100).LT.R)
C RAPPLI, PAGE 2
C
        RAPPLI=.TRUE.
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 GOTOER
        CALL BUG(1,RI)
C
C R1--  EAST OF HOUSE.  DESCRIPTION DEPENDS ON STATE OF WINDOW
C
1000    IF(PRSA.NE.LOOKW) RETURN
        I=13
        IF(QOPEN(WINDO)) I=12
        CALL RSPSUB(11,I)
 1001 CONTINUE
      IF (.NOT. ENDGMF) RETURN
C
C     ENDGAME IN PROGRESS.  PROCESS BOUNCING KANGAROOS.
C
      DO 1010 I = 16, 17
C
C     OBJECT 148-149 ARE THE KANGAROO TWINS....
C     CEVENT 16 = DARK COLORED KANG.
C     CEVENT 17 = LIGHT COLORED KANG.
C
      IF (.NOT. CFLAG(I)) GOTO 1010
C
 1005 IFROG = ((CTICK(I) * 2) ) / 3
      CALL RSPSUB((646+IFROG),ODESC2(148-16+I))
      OROOM(148-16+I) = 0
 1010 CONTINUE
      RETURN
C
C R2--  KITCHEN.  SAME VIEW FROM INSIDE.
C
2000    IF(PRSA.NE.LOOKW) RETURN
        I=13
        IF(QOPEN(WINDO)) I=12
        CALL RSPSUB(14,I)
        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
        I=15
        IF(MAGICF) I=16
        CALL RSPEAK(I)
        I=17+ORAND(RUG)
        IF(QOPEN(DOOR)) I=I+2
        CALL RSPEAK(I)
        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
        ASCORE(WINNER)=RWSCOR
        DO 3600 I=1,OLNT
          IF(OCAN(I).EQ.TCASE) ASCORE(WINNER)=ASCORE(WINNER)+OTVAL(I)
3600    CONTINUE
        RETURN
C RAPPLI, 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
        CALL RSPEAK(21)
        RETURN
C
4500    IF(PRSA.NE.WALKIW) RETURN
        IF(AND(OFLAG2(DOOR),(OPENBT+TCHBT)).NE.OPENBT) RETURN
        OFLAG2(DOOR)=AND(OR(OFLAG2(DOOR),TCHBT),COMPL(OPENBT))
        CALL RSPEAK(22)
        RETURN
C
C R5--  MAZE11.  DESCRIBE STATE OF GRATING.
C
5000    IF(PRSA.NE.LOOKW) RETURN
        CALL RSPEAK(23)
        I=24
        IF(GRUNLF) I=26
        IF(QOPEN(GRATE)) I=25
        CALL RSPEAK(I)
        RETURN
C
C R6--  CLEARING.  DESCRIBE CLEARING, MOVE LEAVES.
C
6000    IF(PRSA.NE.LOOKW) GO TO 6500
        CALL RSPEAK(27)
        IF(RVCLR.EQ.0) RETURN
        I=28
        IF(QOPEN(GRATE)) I=29
        CALL RSPEAK(I)
        RETURN
C
6500    IF((RVCLR.NE.0).OR.(QHERE(LEAVE,CLEAR).AND.
     1       ((PRSA.NE.MOVEW).OR.(PRSO.NE.LEAVE)))) RETURN
        CALL RSPEAK(30)
        RVCLR=1
        RETURN
C RAPPLI, PAGE 4
C
C R7--  RESERVOIR SOUTH.  DESCRIPTION DEPENDS ON LOW TIDE FLAG.
C
7000    IF(PRSA.NE.LOOKW) RETURN
        I=31
        IF(LWTIDF) I=32
        CALL RSPEAK(I)
        CALL RSPEAK(33)
        RETURN
C
C R8--  RESERVOIR.  STATE DEPENDS ON LOW TIDE FLAG.
C
8000    IF(PRSA.NE.LOOKW) RETURN
        I=34
        IF(LWTIDF) I=35
        CALL RSPEAK(I)
        RETURN
C
C R9--  RESERVOIR NORTH.  ALSO DEPENDS ON LOW TIDE FLAG.
C
9000    IF(PRSA.NE.LOOKW) RETURN
        I=36
        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
        CALL RSPEAK(39)
        I=0
        IF(GLACMF) I=40
        IF(GLACRF) I=41
        CALL RSPEAK(I)
        RETURN
C
C R11-- WHITE CLIFF LAIR.  CYCLOPS IS THERE IFF CHASED FROM
C       CYCLOPS ROOM (SINBAD).
C
11000 CONTINUE
      IF(PRSA .NE. LOOKW) RETURN
      CALL RSPEAK(629)
      IF(.NOT. (QHERE(CYCLO,HERE))) RETURN
      I = 607
      IF(RVCYC .GT. 0) I = 608
      IF(RVCYC .LT. 0) I = 609
      IF(CYCLOF2) I = 610
      CALL RSPEAK(I)
      IF(.NOT. CYCLOF2 .AND. (RVCYC .NE. 0))
     + CALL RSPEAK(193 + IABS(RVCYC))
      RETURN
C
C R12-- MIRROR ROOM.  STATE DEPENDS ON MIRROR INTACT.
C
12000   IF(PRSA.NE.LOOKW) RETURN
        CALL RSPEAK(42)
        IF(MIRRMF) CALL RSPEAK(43)
        RETURN
C RAPPLI, PAGE 5
C
C R13-- CAVE2 ROOM.  BLOW OUT CANDLES WITH 50  PROBABILITY.
C
13000   IF(PRSA.NE.WALKIW) RETURN
        IF(PROB(50).OR.(OADV(CANDL).NE.WINNER).OR.
     1       .NOT.QON(CANDL)) RETURN
        OFLAG1(CANDL)=AND(OFLAG1(CANDL),COMPL(ONBT))
        CALL RSPEAK(47)
        CFLAG(CEVCND)=.FALSE.
        RETURN
C
C R14-- BOOM ROOM.  BLOW HIM UP IF CARRYING FLAMING OBJECT.
C
14000   J=ODESC2(CANDL)
        IF((OADV(CANDL).EQ.WINNER).AND.QON(CANDL)) GO TO 14100
        J=ODESC2(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
C
14100   IF(PRSA.NE.TRNONW) GO TO 14200
        CALL RSPSUB(294,J)
        CALL JIGSUP(44)
        RETURN
C
14200   IF(PRSA.NE.WALKIW) RETURN
        CALL RSPSUB(295,J)
        CALL JIGSUP(44)
        RETURN
C
C R15-- NO-OBJS.  SEE IF EMPTY HANDED, SCORE LIGHT SHAFT.
C
15000   EMPTHF=.TRUE.
        DO 15100 I=1,OLNT
          IF(OADV(I).EQ.WINNER) EMPTHF=.FALSE.
15100   CONTINUE
C
        IF((HERE.NE.BSHAF).OR.(.NOT.LIT(HERE))) RETURN
        CALL SCRUPD(LTSHFT)
        LTSHFT=0
        RETURN
C RAPPLI, PAGE 6
C
C R16-- MACHINE ROOM.  DESCRIBE MACHINE.
C
16000   IF(PRSA.NE.LOOKW) RETURN
        I=46
        IF(QOPEN(MACHI)) I=12
        CALL RSPSUB(45,I)
        RETURN
C
C R17-- BAT ROOM.  UNLESS CARRYING GARLIC, FLY AWAY WITH ME...
C
17000   IF(PRSA.NE.LOOKW) GO TO 17500
        CALL RSPEAK(48)
        IF(OADV(GARLI).EQ.WINNER) CALL RSPEAK(49)
        RETURN
C
17500   IF((PRSA.NE.WALKIW).OR.(OADV(GARLI).EQ.WINNER)) RETURN
        CALL RSPEAK(50)
        F=MOVETO(BATDRP(RND(9)+1))
        RAPPLI=.FALSE.
        RETURN
C
C R18-- DOME ROOM.  STATE DEPENDS ON WHETHER ROPE TIED TO RAILING.
C
18000   IF(PRSA.NE.LOOKW) GO TO 18500
        CALL RSPEAK(51)
        IF(DOMEF) CALL RSPEAK(52)
        RETURN
C
18500   IF(PRSA.EQ.LEAPW) CALL JIGSUP(53)
        RETURN
C
C R19-- TORCH ROOM.  ALSO DEPENDS ON WHETHER ROPE TIED TO RAILING.
C
19000   IF(PRSA.NE.LOOKW) RETURN
        CALL RSPEAK(54)
        IF(DOMEF) CALL RSPEAK(55)
        RETURN
C
C R20-- CAROUSEL ROOM.  SPIN HIM OR KILL HIM.
C
20000   IF(PRSA.NE.LOOKW) GO TO 20500
        CALL RSPEAK(56)
        IF(.NOT.CAROFF) CALL RSPEAK(57)
        RETURN
C
20500   IF((PRSA.EQ.WALKIW).AND.CAROZF) CALL JIGSUP(58)
        RETURN
C RAPPLI, PAGE 7
C
C R21-- LLD ROOM.  HANDLE EXORCISE, DESCRIPTIONS.
C
21000   IF(PRSA.NE.LOOKW) GO TO 21500
        CALL RSPEAK(59)
        IF(.NOT.LLDF) CALL RSPEAK(60)
        RETURN
C
21500   IF(PRSA.NE.EXORCW) RETURN
        IF((OADV(BELL).EQ.WINNER).AND.(OADV(BOOK).EQ.WINNER).AND.
     1       (OADV(CANDL).EQ.WINNER)) GO TO 21600
        CALL RSPEAK(62)
        RETURN
C
21600   IF(QHERE(GHOST,HERE)) GO TO 21700
        CALL JIGSUP(61)
        RETURN
C
21700   CALL NEWSTA(GHOST,63,0,0,0)
        LLDF=.TRUE.
        RETURN
C
C R22-- LLD2-ROOM.  IS HIS HEAD ON A POLE?
C
22000   IF(PRSA.NE.LOOKW) RETURN
        CALL RSPEAK(64)
        IF(ONPOLF) CALL RSPEAK(65)
        RETURN
C
C R23-- DAM ROOM.  DESCRIBE RESERVOIR, PANEL.
C
23000   IF(PRSA.NE.LOOKW) RETURN
        CALL RSPEAK(66)
        I=67
        IF(LWTIDF) I=68
        CALL RSPEAK(I)
        CALL RSPEAK(69)
        IF(GATEF) CALL RSPEAK(70)
        RETURN
C
C R24-- SPIDER ROOM.
C
24000 CONTINUE
      BUGF = .FALSE.
      IF (PRSA .NE. LOOKW) GOTO 24020
      CALL RSPEAK(630)
      I = 631
      IF (OADV(FLASK) .NE. WINNER) GOTO 24010
      I = 632
      BUGF = .TRUE.

24010 CALL RSPEAK(I)
      RETURN

24020 IF (OADV(FLASK) .EQ. WINNER) BUGF = .TRUE.
      RETURN
C RAPPLI, PAGE 8
C
C R25-- CYCLOPS-ROOM.  DEPENDS ON CYCLOPS STATE, ASLEEP FLAG, MAGIC FLAG
C
25000   IF(PRSA.NE.LOOKW) RETURN
        CALL RSPEAK(606)
      IF(.NOT. (QHERE(CYCLO,HERE))) GOTO 25100
        I=607
        IF(RVCYC.GT.0) I=608
        IF(RVCYC.LT.0) I=609
        IF(CYCLOF) I=610
        IF(MAGICF) I=611
        CALL RSPEAK(I)
        IF(.NOT.CYCLOF .AND.(RVCYC.NE.0))
     1       CALL RSPEAK(193+IABS(RVCYC))
        RETURN
25100 CONTINUE
      IF(MAGICF) CALL RSPEAK(611)
      RETURN
C
C R26-- DECOMMITTED.
C
26000   RETURN
C
C R27-- TREASURE ROOM.
C
27000   IF((PRSA.NE.WALKIW).OR. .NOT.THFACT)
     1       RETURN
        IF(OROOM(THIEF).NE.HERE)
     1       CALL NEWSTA(THIEF,82,HERE,0,0)
        THFPOS=HERE
        OFLAG2(THIEF)=OR(OFLAG2(THIEF),FITEBT)
        IF(OROOM(CHALI).EQ.HERE)
     1       OFLAG1(CHALI)=AND(OFLAG1(CHALI),COMPL(TAKEBT))
C
C       VANISH EVERYTHING IN ROOM
C
        J=0
        DO 27200 I=1,OLNT
          IF((I.EQ.CHALI).OR.(I.EQ.THIEF).OR..NOT.QHERE(I,HERE))
     1       GO TO 27200
          J=83
          OFLAG1(I)=AND(OFLAG1(I),COMPL(VISIBT))
27200   CONTINUE
        CALL RSPEAK(J)
        RETURN
C
C R28-- CLIFF FUNCTION.  SEE IF CARRYING INFLATED BOAT.
C
28000   DEFLAF=OADV(RBOAT).NE.WINNER
        RETURN
C RAPPLI, PAGE 9
C
C R29-- RIVR4 ROOM.  PLAY WITH BUOY.
C
29000   IF(.NOT.BUOYF.OR.(OADV(BUOY).NE.WINNER)) RETURN
        CALL RSPEAK(84)
        BUOYF=.FALSE.
        RETURN
C
C R30-- OVERFALLS.  DOOM.
C
30000   IF(PRSA.NE.LOOKW) CALL JIGSUP(85)
        RETURN
C
C R31-- BEACH ROOM.  DIG A HOLE.
C
31000   IF((PRSA.NE.DIGW).OR.(PRSO.NE.SHOVE)) RETURN
        RVSND=RVSND+1
        GO TO (31100,31100,31100,31400,31500),RVSND
      CALL GOTOER
        CALL BUG(2,RVSND)
C
31100   CALL RSPEAK(85+RVSND)
        RETURN
C
31400   I=89
        IF(AND(OFLAG1(STATU),VISIBT).NE.0) I=88
        CALL RSPEAK(I)
        OFLAG1(STATU)=OR(OFLAG1(STATU),VISIBT)
        RETURN
C
31500   RVSND=0
        CALL JIGSUP(90)
        RETURN
C
C R32-- TCAVE ROOM.  DIG A HOLE IN GUANO.
C
32000   IF((PRSA.NE.DIGW).OR.(PRSO.NE.SHOVE)) RETURN
        I=91
        IF(.NOT. QHERE(GUANO,HERE)) GO TO 32100
        RVGUA=MIN0(4,RVGUA+1)
        I=91+RVGUA
32100   CALL RSPEAK(I)
        RETURN
C
C R33-- FALLS ROOM
C
33000   IF(PRSA.NE.LOOKW) RETURN
        CALL RSPEAK(96)
        I=97
        IF(RAINBF) I=98
        CALL RSPEAK(I)
        RETURN
C RAPPLI, PAGE 10
C
C R34-- LEDGE FUNCTION.  LEDGE CAN COLLAPSE.
C
34000   IF(PRSA.NE.LOOKW) RETURN
        CALL RSPEAK(100)
        I=102
        IF(AND(RFLAG(MSAFE),RMUNG).NE.0) I=101
        CALL RSPEAK(I)
        RETURN
C
C R35-- SAFE ROOM.  STATE DEPENDS ON WHETHER SAFE BLOWN.
C
35000   IF(PRSA.NE.LOOKW) RETURN
        CALL RSPEAK(104)
        I=105
        IF(SAFEF) I=106
        CALL RSPEAK(I)
        RETURN
C
C R36-- MAGNET ROOM.  DESCRIBE, CHECK FOR SPINDIZZY DOOM.
C
36000   IF(PRSA.NE.LOOKW) GO TO 36500
        CALL RSPEAK(107)
        RETURN
C
36500   IF((PRSA.NE.WALKIW).OR. .NOT.CAROFF) RETURN
        IF(CAROZF) GO TO 36600
        CALL RSPEAK(108)
        RETURN
C
36600   CALL JIGSUP(58)
        RETURN
C
C R37-- CAGE ROOM.  IF SOLVED CAGE, MOVE TO OTHER CAGE ROOM.
C
37000   IF(CAGESF) F=MOVETO(CAGER)
        RETURN
C
        END
        LOGICAL FUNCTION SOBJS(RI,ARG)
        implicit integer (A-Z)
C SOBJS-        SIMPLE OBJECTS PROCESSOR
C       OBJECTS IN THIS MODULE CANNOT CALL RMINFO, JIGSUP,
C       MAJOR VERBS, OR OTHER NON-RESIDENT SUBROUTINES
C
C DECLARATIONS
C
        LOGICAL QOPEN
        LOGICAL MOVETO,OPNCLS
        LOGICAL 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
C
C ROOMS
C
        COMMON /ROOMS/ RLNT,RDESC1(150),RDESC2(150),REXIT(150),
     1       RACTIO(150),RVAL(150),RFLAG(150),RRAND(150)
C
        COMMON /RVARS/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA
C
        COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR,
     1       RSACRD,RFILL,RMUNG,RBUCK,RHOUSE
C
        COMMON /RINDEX/ WHOUS,LROOM,CELLA
        COMMON /RINDEX/ MTROL,MAZE1
        COMMON /RINDEX/ MGRAT,MAZ15
        COMMON /RINDEX/ FORE1,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,WHITEC1,WHITEC2
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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,ECHOBT,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
        COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT
        COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE
        COMMON /OINDEX/ ROBOT,LUNGS,SAILO,AVIAT,TEETH
        COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,STAFF,SPIDER,TAPEST,WEB
C
C CLOCK INTERRUPTS
C
        LOGICAL CFLAG
        COMMON /CEVENT/ CLNT,CTICK(20),CACTIO(20),CFLAG(20)
C
        COMMON /CINDEX/ CEVCUR,CEVMNT,CEVLNT,CEVMAT,CEVCND,
     1       CEVBAL,CEVBRN,CEVFUS,CEVLED,CEVSAF,CEVVLG,
     2       CEVGNO,CEVBUC,CEVSPH,CEVEGH
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
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
        COMMON /VINDEX/ TAKEW,INVENW,FILLW,EATW,DRINKW,BURNW
        COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW
        COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW
        COMMON /VINDEX/ DIGW,LEAPW
C
C FLAGS
C
        LOGICAL FLAGS(35)
        LOGICAL TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
        LOGICAL DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
        LOGICAL MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
        LOGICAL EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
        LOGICAL GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
        LOGICAL GLACMF,FROBZF,ENDGMF,CYCLOF2,BUGF
        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,CYCLOF2,BUGF
        COMMON /FINDEX/ BTIEF,BINFF
        EQUIVALENCE (FLAGS(1),TROLLF)
        QOPEN(R)=AND(OFLAG2(R),OPENBT).NE.0
C SOBJS, PAGE 2
C
        IF(PRSO.NE.0.AND.PRSO.LE.160) ODO2=ODESC2(PRSO)
        IF(PRSI.NE.0.AND.PRSI.LE.160) ODI2=ODESC2(PRSI)
        AV=AVEHIC(WINNER)
        SOBJS=.TRUE.
C
        GO TO (1000,3000,4000,6000,7000,8000,9000,
     1 13000,14000,16000,17000,
     2 21000,23000,24000,27000,28000,29000,30000,
     3 31000,33000,34000,36000,37000,38000,
     4 41000,42000,43000,44000,46000,
     5 53000,56000),
     6       RI
      CALL GOTOER
        CALL BUG(6,RI)
C
C RETURN HERE TO DECLARE FALSE RESULT
C
10      SOBJS=.FALSE.
        RETURN
C SOBJS, PAGE 3
C
C O1--  GUNK FUNCTION
C
1000    IF(OCAN(GUNK).EQ.0) GO TO 10
        CALL NEWSTA(GUNK,122,0,0,0)
        RETURN
C
C O2--  TROPHY CASE
C
3000    IF(PRSA.NE.TAKEW) GO TO 10
        CALL RSPEAK(128)
        RETURN
C
C O3--  BOTTLE FUNCTION
C
4000    IF(PRSA.NE.THROWW) GO TO 4100
        CALL NEWSTA(PRSO,129,0,0,0)
        RETURN
C
4100    IF(PRSA.NE.MUNGW) GO TO 10
        IF(OADV(PRSO).NE.WINNER) GO TO 4150
        CALL NEWSTA(PRSO,130,0,0,0)
        RETURN
C
4150    IF(.NOT.QHERE(PRSO,HERE)) GO TO 10
        CALL NEWSTA(PRSO,131,0,0,0)
        RETURN
C SOBJS, PAGE 4
C
C O4--  ROPE FUNCTION
C
6000    IF(HERE.EQ.DOME) GO TO 6100
        DOMEF=.FALSE.
        IF(PRSA.NE.UNTIEW) GO TO 6050
        CALL RSPEAK(134)
        RETURN
C
6050    IF(PRSA.NE.TIEW) GO TO 10
        CALL RSPEAK(135)
        RETURN
C
6100    IF((PRSA.NE.TIEW).OR.(PRSI.NE.RAILI)) GO TO 6200
        IF(DOMEF) GO TO 6150
        DOMEF=.TRUE.
        OFLAG1(ROPE)=OR(OFLAG1(ROPE),NDSCBT)
        CALL NEWSTA(ROPE,137,DOME,0,0)
        RETURN
C
6150    CALL RSPEAK(136)
        RETURN
C
6200    IF(PRSA.NE.UNTIEW) GO TO 6300
        IF(DOMEF) GO TO 6250
        CALL RSPEAK(138)
        RETURN
C
6250    DOMEF=.FALSE.
        OFLAG1(ROPE)=AND(OFLAG1(ROPE),COMPL(NDSCBT))
        CALL RSPEAK(139)
        RETURN
C
6300    IF(DOMEF.OR.(PRSA.NE.DROPW)) GO TO 6400
        CALL NEWSTA(ROPE,140,MTORC,0,0)
        RETURN
C
6400    IF((PRSA.NE.TAKEW).OR. .NOT.DOMEF) GO TO 10
        CALL RSPEAK(141)
        RETURN
C
C O5--  SWORD FUNCTION
C
7000    IF((PRSA.EQ.TAKEW).AND.(WINNER.EQ.PLAYER))
     1       SWDACT=.TRUE.
        GO TO 10
C
C O6--  LANTERN
C
8000    IF(PRSA.NE.THROWW) GO TO 8100
        CALL NEWSTA(LAMP,142,0,0,0)
        CALL NEWSTA(BLAMP,0,HERE,0,0)
        RETURN
C
8100    IF(PRSA.EQ.TRNONW) CFLAG(CEVLNT)=.TRUE.
        IF(PRSA.EQ.TRNOFW) CFLAG(CEVLNT)=.FALSE.
        GO TO 10
C
C O7--  RUG FUNCTION
C
9000    IF(PRSA.NE.RAISEW) GO TO 9100
        CALL RSPEAK(143)
        RETURN
C
9100    IF(PRSA.NE.TAKEW) GO TO 9200
        CALL RSPEAK(144)
        RETURN
C
9200    IF(PRSA.NE.MOVEW) GO TO 10
        CALL RSPEAK(145+ORAND(RUG))
        ORAND(RUG)=1
        OFLAG1(DOOR)=OR(OFLAG1(DOOR),VISIBT)
        RETURN
C SOBJS, PAGE 5
C
C O8--  SKELETON
C
13000   I=ROBRM(HERE,100,LLD2,0,0)+ROBADV(WINNER,LLD2,0,0)
        IF(I.NE.0) CALL RSPEAK(162)
        RETURN
C
C O9--  MIRROR
C
14000   IF(MIRRMF.OR.(PRSA.NE.RUBW)) GO TO 14500
        MROOM=COMPL(EQUIV(HERE,1))
        DO 14100 I=1,OLNT
          IF(OROOM(I).EQ.HERE) OROOM(I)=-1
          IF(OROOM(I).EQ.MROOM) OROOM(I)=HERE
          IF(OROOM(I).EQ.-1) OROOM(I)=MROOM
14100   CONTINUE
        F=MOVETO(MROOM)
        CALL RSPEAK(163)
        RETURN
C
14500   IF((PRSA.NE.LOOKW).AND.(PRSA.NE.EXAMIW)) GO TO 14600
        I=164
        IF(MIRRMF) I=165
        CALL RSPEAK(I)
        RETURN
C
14600   IF(PRSA.NE.TAKEW) GO TO 14700
        CALL RSPEAK(166)
        RETURN
C
14700   IF((PRSA.NE.MUNGW).AND.(PRSA.NE.THROWW)) GO TO 10
        I=167
        IF(MIRRMF) I=168
        MIRRMF=.TRUE.
        CALL RSPEAK(I)
        RETURN
C SOBJS, PAGE 6
C
C O10-- DUMBWAITER
C
16000   IF(PRSA.NE.RAISEW) GO TO 16100
        IF(CAGETF) GO TO 16300
        CALL NEWSTA(TBASK,175,TSHAF,0,0)
        CALL NEWSTA(FBASK,0,BSHAF,0,0)
        CAGETF=.TRUE.
        RETURN
C
16100   IF(PRSA.NE.LOWERW) GO TO 16200
        IF(.NOT.CAGETF) GO TO 16300
        CALL NEWSTA(TBASK,176,BSHAF,0,0)
        CALL NEWSTA(FBASK,0,TSHAF,0,0)
        CAGETF=.FALSE.
        RETURN
C
16200   IF(PRSA.NE.TAKEW) GO TO 10
        CALL RSPEAK(177)
        RETURN
C
16300   CALL RSPEAK(125+RND(3))
        RETURN
C
C O11-- GHOST FUNCTION
C
17000   I=178
        IF(PRSO.NE.GHOST) I=179
        CALL RSPEAK(I)
        RETURN
C SOBJS, PAGE 7
C
C O12-- TUBE
C
21000   IF((PRSA.NE.PUTW).OR.(PRSI.NE.TUBE)) GO TO 10
        CALL RSPEAK(186)
        RETURN
C
C O13-- CHALICE
C
23000   IF((PRSA.NE.TAKEW).OR.(OCAN(PRSO).NE.0).OR.
     1       (OROOM(PRSO).NE.TREAS).OR.(OROOM(THIEF).NE.TREAS).OR.
     2       (AND(OFLAG2(THIEF),FITEBT).EQ.0).OR.
     3       .NOT. THFACT) GO TO 10
        CALL RSPEAK(204)
        RETURN
C
C O14-- PAINTING
C
24000   IF(PRSA.NE.MUNGW) GO TO 10
        CALL RSPEAK(205)
        OFVAL(PRSO)=0
        OTVAL(PRSO)=0
        ODESC1(PRSO)=207
        ODESC2(PRSO)=206
        RETURN
C SOBJS, PAGE 8
C
C O15-- BOLT
C
27000   IF(PRSA.NE.TURNW) GO TO 10
        IF(PRSI.NE.WRENC) GO TO 27500
        IF(GATEF) GO TO 27100
        CALL RSPEAK(210)
        RETURN
C
27100   IF(LWTIDF) GO TO 27200
        LWTIDF=.TRUE.
        CALL RSPEAK(211)
        OFLAG2(COFFI)=AND(OFLAG2(COFFI),COMPL(SCRDBT))
        OFLAG1(TRUNK)=OR(OFLAG1(TRUNK),VISIBT)
        RFLAG(RESER)=AND(OR(RFLAG(RESER),RLAND),COMPL(RWATER))
        RETURN
C
27200   LWTIDF=.FALSE.
        CALL RSPEAK(212)
        IF(QHERE(TRUNK,RESER)) OFLAG1(TRUNK)=AND(OFLAG1(TRUNK)
     1       ,COMPL(VISIBT))
        RFLAG(RESER)=AND(OR(RFLAG(RESER),RWATER),COMPL(RLAND))
        RETURN
C
27500   CALL RSPSUB(299,ODI2)
        RETURN
C
C O16-- GRATING
C
28000   IF((HERE.NE.CLEAR).OR.(RVCLR.NE.0)) GO TO 28100
        CALL RSPEAK(213)
        RETURN
C
28100   IF(GRUNLF) GO TO 28200
        CALL RSPEAK(214)
        RETURN
C
28200   I=215
        IF(HERE.NE.CLEAR) I=216
        SOBJS=OPNCLS(GRATE,I,217)
        RETURN
C
C O17-- TRAP DOOR
C
29000   IF(HERE.NE.LROOM) GO TO 29100
        SOBJS=OPNCLS(DOOR,218,219)
        RETURN
C
29100   IF(HERE.NE.CELLA) GO TO 10
        I=220
        IF(PRSA.NE.OPENW) I=125+RND(3)
        CALL RSPEAK(I)
        RETURN
C
C O18-- DURABLE DOOR
C
30000   I=0
        IF(PRSA.EQ.OPENW) I=221
        IF(PRSA.EQ.BURNW) I=222
        IF(PRSA.EQ.MUNGW) I=223+RND(3)
        IF(I.EQ.0) GO TO 10
        CALL RSPEAK(I)
        RETURN
C
C O19-- MASTER SWITCH
C
31000   IF(PRSA.NE.TURNW) GO TO 10
        IF(PRSI.NE.SCREW) GO TO 31500
        IF(QOPEN(MACHI)) GO TO 31600
        CALL RSPEAK(226)
        IF(OCAN(COAL).NE.MACHI) GO TO 31400
        CALL NEWSTA(COAL,0,0,0,0)
        CALL NEWSTA(DIAMO,0,0,MACHI,0)
        RETURN
C
31400   DO 31450 I=1,OLNT
          IF(OCAN(I).NE.MACHI) GO TO 31450
          CALL NEWSTA(I,0,0,0,0)
          CALL NEWSTA(GUNK,0,0,MACHI,0)
31450   CONTINUE
        RETURN
C
31500   CALL RSPSUB(300,ODI2)
        RETURN
C
31600   CALL RSPEAK(227)
        RETURN
C SOBJS, PAGE 9
C
C O20-- LEAK
C
33000   IF((PRSO.NE.LEAK).OR.(PRSA.NE.PLUGW).OR.(RVMNT.LE.0))
     1       GO TO 10
        IF(PRSI.NE.PUTTY) GO TO 33100
        RVMNT=-1
        CTICK(CEVMNT)=0
        CALL RSPEAK(577)
        RETURN
C
33100   CALL RSPSUB(301,ODI2)
        RETURN
C
C O21-- DROWNING BUTTONS
C
34000   IF(PRSA.NE.PUSHW) GO TO 10
        GO TO (34100,34200,34300,34400),(PRSO-RBUTT+1)
      CALL GOTOER
        GO TO 10
C
34100   RFLAG(HERE)=COMPL(EQUIV(RFLAG(HERE),RLIGHT))
        I=230
        IF(AND(RFLAG(HERE),RLIGHT).NE.0) I=231
        CALL RSPEAK(I)
        RETURN
C
34200   GATEF=.TRUE.
        CALL RSPEAK(232)
        RETURN
C
34300   GATEF=.FALSE.
        CALL RSPEAK(232)
        RETURN
C
34400   IF(RVMNT.NE.0) GO TO 34500
        CALL RSPEAK(233)
        RVMNT=1
        CTICK(CEVMNT)=-1
        RETURN
C
34500   CALL RSPEAK(234)
        RETURN
C
C O22-- INFLATABLE BOAT
C
36000   IF(PRSA.NE.INFLAW) GO TO 10
        IF(OROOM(IBOAT).NE.0) GO TO 36100
        CALL RSPEAK(235)
        RETURN
C
36100   IF(PRSI.NE.PUMP) GO TO 36200
        CALL NEWSTA(IBOAT,0,0,0,0)
        CALL NEWSTA(RBOAT,236,HERE,0,0)
        DEFLAF=.FALSE.
        RETURN
C
36200   I=237
        IF(PRSI.NE.LUNGS) I=303
        CALL RSPSUB(I,ODI2)
        RETURN
C
C O23-- DEFLATED BOAT
C
37000   IF(PRSA.NE.INFLAW) GO TO 37100
        CALL RSPEAK(238)
        RETURN
C
37100   IF(PRSA.NE.PLUGW) GO TO 10
        IF(PRSI.NE.PUTTY) GO TO 33100
        CALL NEWSTA(IBOAT,239,OROOM(DBOAT),OCAN(DBOAT),OADV(DBOAT))
        CALL NEWSTA(DBOAT,0,0,0,0)
        RETURN
C SOBJS, PAGE 10
C
C O24-- RUBBER BOAT
C
38000   IF(ARG.NE.0) GO TO 10
        IF((PRSA.NE.BOARDW).OR.(OADV(STICK).NE.WINNER)) GO TO 38100
        CALL NEWSTA(RBOAT,0,0,0,0)
        CALL NEWSTA(DBOAT,240,HERE,0,0)
        DEFLAF=.TRUE.
        RETURN
C
38100   IF(PRSA.NE.DEFLAW) GO TO 10
        IF(AV.EQ.RBOAT) GO TO 38200
        IF(OROOM(RBOAT).EQ.0) GO TO 38300
        CALL NEWSTA(IBOAT,241,HERE,0,0)
        CALL NEWSTA(RBOAT,0,0,0,0)
        DEFLAF=.TRUE.
        RETURN
C
38200   CALL RSPEAK(242)
        RETURN
C
38300   CALL RSPEAK(243)
        RETURN
C
C O25-- BRAIDED ROPE
C
41000   IF((PRSA.NE.TIEW).OR.(PRSO.NE.BROPE).OR.
     1       ((PRSI.NE.HOOK1).AND.(PRSI.NE.HOOK2)))
     2       GO TO 41500
        BTIEF=PRSI
        CFLAG(CEVBAL)=.FALSE.
        CALL RSPEAK(248)
        RETURN
C
41500   IF((PRSA.NE.UNTIEW).OR.(PRSO.NE.BROPE)) GO TO 10
        IF(BTIEF.NE.0) GO TO 41600
        CALL RSPEAK(249)
        RETURN
C
41600   CALL RSPEAK(250)
        BTIEF=0
        CTICK(CEVBAL)=3
        CFLAG(CEVBAL)=.TRUE.
        RETURN
C
C O26-- SAFE
C
42000   I=0
        IF(PRSA.EQ.TAKEW) I=251
        IF((PRSA.EQ.OPENW).AND.SAFEF) I=253
        IF((PRSA.EQ.OPENW).AND..NOT.SAFEF) I=254
        IF((PRSA.EQ.CLOSEW).AND.SAFEF) I=253
        IF((PRSA.EQ.CLOSEW).AND..NOT.SAFEF) I=255
        IF(I.EQ.0) GO TO 10
        CALL RSPEAK(I)
        RETURN
C
C O27-- FUSE
C
43000   IF(PRSA.NE.BURNW) GO TO 10
        CALL RSPEAK(256)
        CTICK(CEVFUS)=2
        RETURN
C
C O28-- GNOME
C
44000   IF((PRSA.NE.GIVEW).AND.(PRSA.NE.THROWW)) GO TO 44500
        IF(OTVAL(PRSO).EQ.0) GO TO 44100
        CALL RSPSUB(257,ODO2)
        CALL NEWSTA(PRSO,0,0,0,0)
        GNODRF=.TRUE.
        RETURN
C
44100   CALL RSPSUB(258,ODO2)
        CALL NEWSTA(PRSO,0,0,0,0)
        RETURN
C
44500   CALL RSPEAK(259)
        IF(.NOT.GNOMEF) CTICK(CEVGNO)=5
        GNOMEF=.TRUE.
        RETURN
C
C O29-- COKE BOTTLES
C
46000   IF((PRSA.NE.THROWW).AND.(PRSA.NE.MUNGW)) GO TO 10
        CALL NEWSTA(PRSO,262,0,0,0)
        RETURN
C SOBJS, PAGE 11
C
C
C O30-- ROBOT
C
53000   IF(PRSA.NE.GIVEW) GO TO 53200
        CALL NEWSTA(PRSO,0,0,0,AROBOT)
        CALL RSPSUB(302,ODO2)
        RETURN
C
53200   IF((PRSA.NE.MUNGW).AND.(PRSA.NE.THROWW)) GO TO 10
        CALL NEWSTA(ROBOT,285,0,0,0)
        RETURN
C
C O31-- GRUE
C
56000   IF(PRSA.NE.EXAMIW) GO TO 56100
        CALL RSPEAK(288)
        RETURN
C
56100   IF(PRSA.NE.FINDW) GO TO 10
        CALL RSPEAK(289)
        RETURN
C
        END
        LOGICAL FUNCTION VAPPLI(RI)
        implicit integer (A-Z)
C VAPPLI- MAIN VERB PROCESSING ROUTINE
C
C DECLARATIONS
C
        LOGICAL LIT,OBJACT
        LOGICAL QEMPTY,RMINFO,CLOCKD
        LOGICAL QOPEN,EDIBLE,DRKBLE
        LOGICAL TAKE,PUT,DROP,WALK
        LOGICAL QHERE,SVERBS,F,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
        COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD,
     1       LTSHFT,BLOC,MUNGRM,HS
C
C ROOMS
C
        COMMON /ROOMS/ RLNT,RDESC1(150),RDESC2(150),REXIT(150),
     1       RACTIO(150),RVAL(150),RFLAG(150),RRAND(150)
C
        COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR,
     1       RSACRD,RFILL,RMUNG,RBUCK,RHOUSE
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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,ECHOBT,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
        COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT
        COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE
        COMMON /OINDEX/ ROBOT,LUNGS,SAILO,AVIAT,TEETH
        COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,STAFF,SPIDER,TAPEST,WEB
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
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
        COMMON /VINDEX/ TAKEW,INVENW,FILLW,EATW,DRINKW,BURNW
        COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW
        COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW
        COMMON /VINDEX/ DIGW,LEAPW

        QOPEN(R)=AND(OFLAG2(R),OPENBT).NE.0
        EDIBLE(R)=AND(OFLAG1(R),FOODBT).NE.0
        DRKBLE(R)=AND(OFLAG1(R),DRNKBT).NE.0

        DATA MXNOP/49/,MXSMP/99/
C VAPPLI, PAGE 2
C
        VAPPLI=.TRUE.
        IF(PRSA.EQ.WALKW)GO TO 1012
        IF(PRSO.GT.0) ODO2=ODESC2(PRSO)
        IF(PRSI.GT.0) ODI2=ODESC2(PRSI)
 1012   CONTINUE
        AV=AVEHIC(WINNER)
        RMK=372+RND(6)
C
        IF(RI.EQ.0) CALL BUG(7,RI)
        IF(RI.LE.MXNOP) RETURN
        IF(RI.LE.MXSMP) GO TO 100
        GO TO (18000,20000,
     2       22000,23000,24000,25000,26000,27000,28000,29000,30000,
     3 31000,32000,33000,34000,35000,36000,38000,39000,40000,
     4 41000,42000,43000,44000,45000,46000,47000,48000,49000,50000,
     5 51000,52000,53000,55000,56000,58000,59000,60000,
     6             63000,64000,65000,66000,68000,69000,70000,
     7 71000,72000,73000,74000,77000,78000),
     8       (RI-MXSMP)
      CALL GOTOER
        CALL BUG(7,RI)
C
C ALL VERB PROCESSORS RETURN HERE TO DECLARE FAILURE.
C
10      VAPPLI=.FALSE.
        RETURN
C
C SIMPLE VERBS ARE HANDLED EXTERNALLY.
C
 100    continue
        VAPPLI=SVERBS(RI)
        RETURN
C VAPPLI, PAGE 3
C
C V100--        READ.  OUR FIRST REAL VERB.
C
18000   IF(LIT(HERE)) GO TO 18100
        CALL RSPEAK(356)
        RETURN
C
18100   IF(PRSI.EQ.0) GO TO 18200
        IF(AND(OFLAG1(PRSI),TRANBT).NE.0) GO TO 18200
        CALL RSPSUB(357,ODI2)
        RETURN
C
18200   IF(AND(OFLAG1(PRSO),READBT).NE.0) GO TO 18300
        CALL RSPSUB(358,ODO2)
        RETURN
C
18300   IF(.NOT.OBJACT(X)) CALL RSPEAK(OREAD(PRSO))
        RETURN
C
C V101--        MELT.  UNLESS OBJECT HANDLES, JOKE.
C
20000   IF(.NOT.OBJACT(X)) CALL RSPSUB(361,ODO2)
        RETURN
C
C V102--        INFLATE.  WORKS ONLY WITH BOATS.
C
22000   IF(OBJACT(X)) RETURN
        I=368
        IF(PRSO.EQ.RBOAT) I=367
        CALL RSPEAK(I)
        RETURN
C
C V103--        DEFLATE.
C
23000   IF(OBJACT(X)) RETURN
        CALL RSPEAK(369)
        RETURN
C VAPPLI, PAGE 4
C
C V104--        ALARM.  IF SLEEPING, WAKE HIM UP.
C
24000   IF(AND(OFLAG2(PRSO),SLEPBT).EQ.0) GO TO 24100
        VAPPLI=OBJACT(X)
        RETURN
C
24100   CALL RSPSUB(370,ODO2)
        RETURN
C
C V105--        EXORCISE.  OBJECTS HANDLE.
C
25000   F=OBJACT(X)
        RETURN
C
C V106--        PLUG.  LET OBJECTS HANDLE.
C
26000   IF(.NOT.OBJACT(X)) CALL RSPEAK(371)
        RETURN
C
C V107--        KICK.  IF OBJECT IGNORES, JOKE.
C
27000   IF(.NOT.OBJACT(X)) CALL RSPSB2(378,ODO2,RMK)
        RETURN
C
C V108--        WAVE.  SAME.
C
28000   IF(.NOT.OBJACT(X)) CALL RSPSB2(379,ODO2,RMK)
        RETURN
C
C V109,V110--   RAISE, LOWER.  SAME.
C
29000   CONTINUE
30000   IF(.NOT.OBJACT(X)) CALL RSPSB2(380,ODO2,RMK)
        RETURN
C
C V111--        RUB.  SAME.
C
31000   IF(.NOT.OBJACT(X)) CALL RSPSB2(381,ODO2,RMK)
        RETURN
C
C V112--        PUSH.  SAME.
C
32000   IF(.NOT.OBJACT(X)) CALL RSPSB2(382,ODO2,RMK)
        RETURN
C VAPPLI, PAGE 5
C
C V113--        UNTIE.  IF OBJECT IGNORES, JOKE.
C
33000   IF(OBJACT(X)) RETURN
        I=383
        IF(AND(OFLAG2(PRSO),TIEBT).EQ.0) I=384
        CALL RSPEAK(I)
        RETURN
C
C V114--        TIE.  NEVER REALLY WORKS.
C
34000   IF(AND(OFLAG2(PRSO),TIEBT).NE.0) GO TO 34100
        CALL RSPEAK(385)
        RETURN
C
34100   IF(.NOT.OBJACT(X)) CALL RSPSUB(386,ODO2)
        RETURN
C
C V115--        TIE UP.  NEVER REALLY WORKS.
C
35000   IF(AND(OFLAG2(PRSI),TIEBT).NE.0) GO TO 35100
        CALL RSPSUB(387,ODO2)
        RETURN
C
35100   I=388
        IF(AND(OFLAG2(PRSO),VILLBT).EQ.0) I=389
        CALL RSPSUB(I,ODO2)
        RETURN
C
C V116--        TURN.  OBJECT MUST HANDLE.
C
36000   IF(AND(OFLAG1(PRSO),TURNBT).NE.0) GO TO 36100
        CALL RSPEAK(390)
        RETURN
C
36100   IF(AND(OFLAG1(PRSI),TOOLBT).NE.0) GO TO 36200
        CALL RSPSUB(391,ODI2)
        RETURN
C
36200   VAPPLI=OBJACT(X)
        RETURN
C
C V117--        BREATHE.  BECOMES INFLATE WITH LUNGS.
C
38000   PRSA=INFLAW
        PRSI=LUNGS
        GO TO 22000
C
C V118--        KNOCK.  MOSTLY JOKE.
C
39000   IF(OBJACT(X)) RETURN
        I=394
        IF(AND(OFLAG1(PRSO),DOORBT).EQ.0) I=395
        CALL RSPSUB(I,ODO2)
        RETURN
C
C V119--        LOOK.
C
40000   IF(PRSO.NE.0) GO TO 41500
        VAPPLI=RMINFO(.TRUE.)
        RETURN
C
C V120--        EXAMINE.
C
41000   IF(PRSO.NE.0) GO TO 41500
        VAPPLI=RMINFO(.FALSE.)
        RETURN
C
41500   IF(OBJACT(X)) RETURN
        I=OREAD(PRSO)
        IF(I.EQ.0) I=429
        CALL RSPSUB(I,ODO2)
        PRSA=FOOW
        RETURN
C
C V121--        SHAKE.  IF HOLLOW OBJECT, SOME ACTION.
C
42000   IF(OBJACT(X)) RETURN
        IF(QEMPTY(PRSO)) GO TO 10
        IF(QOPEN(PRSO)) GO TO 42300
        CALL RSPSUB(396,ODO2)
        RETURN
C
42300   DO 42500 I=1,OLNT
          IF(OCAN(I).NE.PRSO) GO TO 42500
          CALL NEWSTA(I,0,HERE,0,0)
          IF(AV.NE.0) CALL NEWSTA(I,0,0,AV,0)
42500   CONTINUE
        CALL RSPSUB(397,ODO2)
        RETURN
C
C V122--        MOVE.  MOSTLY JOKES.
C
43000   IF(PRSO.EQ.0) GO TO 10
        IF(QHERE(PRSO,HERE)) GO TO 43100
        CALL RSPEAK(398)
        RETURN
C
43100   IF(.NOT.OBJACT(X)) CALL RSPSUB(399,ODO2)
        RETURN
C VAPPLI, PAGE 6
C
C V123--        TURN ON.
C
44000   F=LIT(HERE)
        IF(OBJACT(X)) GO TO 44300
        IF((AND(OFLAG1(PRSO),LITEBT).NE.0).AND.
     1       (OADV(PRSO).EQ.WINNER)) GO TO 44100
        CALL RSPEAK(400)
        RETURN
C
44100   IF(AND(OFLAG1(PRSO),ONBT).EQ.0) GO TO 44200
        CALL RSPEAK(401)
        RETURN
C
44200   OFLAG1(PRSO)=OR(OFLAG1(PRSO),ONBT)
        CALL RSPSUB(404,ODO2)
44300   IF(.NOT.F .AND.LIT(HERE)) F=RMINFO(.FALSE.)
        RETURN
C
C V124--        TURN OFF.
C
45000   IF(OBJACT(X)) GO TO 45300
        IF((AND(OFLAG1(PRSO),LITEBT).NE.0).AND.
     1       (OADV(PRSO).EQ.WINNER)) GO TO 45100
        CALL RSPEAK(402)
        RETURN
C
45100   IF(AND(OFLAG1(PRSO),ONBT).NE.0) GO TO 45200
        CALL RSPEAK(403)
        RETURN
C
45200   OFLAG1(PRSO)=AND(OFLAG1(PRSO),COMPL(ONBT))
        CALL RSPSUB(405,ODO2)
45300   IF(.NOT.LIT(HERE)) CALL RSPEAK(406)
        RETURN
C
C V125--        OPEN.  A FINE MESS.
C
46000   IF(OBJACT(X)) RETURN
        IF(AND(OFLAG1(PRSO),CONTBT).NE.0) GO TO 46100
46050   CALL RSPSUB(407,ODO2)
        RETURN
C
46100   IF(OCAPAC(PRSO).NE.0) GO TO 46200
        CALL RSPSUB(408,ODO2)
        RETURN
C
46200   IF(.NOT.QOPEN(PRSO)) GO TO 46225
        CALL RSPEAK(412)
        RETURN
C
46225   OFLAG2(PRSO)=OR(OFLAG2(PRSO),OPENBT)
        IF((AND(OFLAG1(PRSO),TRANBT).NE.0).OR.QEMPTY(PRSO))
     1       GO TO 46300
        CALL RSPSUB(410,ODO2)
        DO 46250 I=1,OLNT
          IF(OCAN(I).EQ.PRSO) CALL RSPSUB(502,ODESC2(I))
46250   CONTINUE
        RETURN
C
46300   CALL RSPEAK(409)
        RETURN
C
C V126--        CLOSE.
C
47000   IF(OBJACT(X)) RETURN
        IF(AND(OFLAG1(PRSO),CONTBT).EQ.0) GO TO 46050
        IF(OCAPAC(PRSO).NE.0) GO TO 47100
        CALL RSPSUB(411,ODO2)
        RETURN
C
47100   IF(QOPEN(PRSO)) GO TO 47200
        CALL RSPEAK(413)
        RETURN
C
47200   OFLAG2(PRSO)=AND(OFLAG2(PRSO),COMPL(OPENBT))
        CALL RSPEAK(414)
        RETURN
C VAPPLI, PAGE 7
C
C V127--        FIND.  BIG MEGILLA.
C
48000   IF(OBJACT(X)) RETURN
        IF(PRSO.EQ.0) GO TO 10
        I=415
        IF(QHERE(PRSO,HERE)) GO TO 48300
        IF(OADV(PRSO).EQ.WINNER) GO TO 48200
        J=OCAN(PRSO)
        IF(J.EQ.0) GO TO 10
        IF(((AND(OFLAG1(J),TRANBT).EQ.0).AND.
     2 (.NOT.QOPEN(J).OR.(AND(OFLAG1(J),(DOORBT+CONTBT)).EQ.0))))
     3       GO TO 10
        I=417
        IF(QHERE(J,HERE)) GO TO 48100
        IF(OADV(J).NE.WINNER) GO TO 10
        I=418
48100   CALL RSPSUB(I,ODESC2(J))
        RETURN
C
48200   I=416
48300   CALL RSPSUB(I,ODO2)
        RETURN
C
C V128--        WAIT.  RUN CLOCK DEMON.
C
49000   CALL RSPEAK(419)
        DO 49100 I=1,3
          IF(CLOCKD(X)) RETURN
49100   CONTINUE
        RETURN
C
C V129--        SPIN.  NOT IMPLEMENTED.
C
50000   RETURN
C
C V130--        BOARD.  WORKS WITH VEHICLES.
C
51000   IF(QHERE(PRSO,HERE)) GO TO 51100
        CALL RSPSUB(420,ODO2)
        RETURN
C
51100   IF(AND(OFLAG2(PRSO),VEHBT).NE.0) GO TO 51200
        CALL RSPSUB(421,ODO2)
        RETURN
C
51200   IF(AV.EQ.0) GO TO 51300
        CALL RSPSUB(422,ODO2)
        RETURN
C
51300   IF(OBJACT(X)) RETURN
        CALL RSPSUB(423,ODO2)
        AVEHIC(WINNER)=PRSO
        IF(WINNER.NE.PLAYER) OCAN(AOBJ(WINNER))=PRSO
        RETURN
C
C V131--        DISEMBARK.
C
52000   IF(AV.EQ.PRSO) GO TO 52100
        CALL RSPEAK(424)
        RETURN
C
52100   IF(OBJACT(X)) RETURN
        IF(AND(RFLAG(HERE),RLAND).NE.0) GO TO 52200
        CALL RSPEAK(425)
        RETURN
C
52200   AVEHIC(WINNER)=0
        CALL RSPEAK(426)
        IF(WINNER.NE.PLAYER) CALL NEWSTA(AOBJ(WINNER),0,HERE,0,0)
        RETURN
C
C V132--        TAKE.  HANDLED EXTERNALLY.
C
53000   VAPPLI=TAKE(.TRUE.)
        RETURN
C
C V133--        INVENTORY.  PROCESSED EXTERNALLY.
C
55000   CALL INVENT(WINNER)
        RETURN
C VAPPLI, PAGE 8
C
C V134--        FILL.  STRANGE DOINGS WITH WATER.
C
56000   IF(OBJACT(X)) RETURN
        IF((PRSI.EQ.0).OR.(PRSI.EQ.WATER)) GO TO 56100
        CALL RSPSB2(444,ODO2,ODI2)
        RETURN
C
56100   IF((AND(RFLAG(HERE),(RFILL+RWATER)).NE.0).OR.
     1 ((OCAN(WATER).EQ.AV).AND.(AV.NE.0)).OR.
     2 QHERE(WATER,HERE)) GO TO 56200
        CALL RSPEAK(446)
        RETURN
C
56200   PRSA=TAKEW
        PRSI=PRSO
        PRSO=WATER
        VAPPLI=OAPPLI(OACTIO(WATER),0)
        RETURN
C
C V135,V136--   EAT/DRINK
C
58000   CONTINUE
59000   IF(OBJACT(X)) RETURN
        IF(EDIBLE(PRSO).AND.(OADV(PRSO).EQ.WINNER))
     1       GO TO 59200
        IF(DRKBLE(PRSO).AND.(OCAN(PRSO).NE.0))
     1       GO TO 59400
59100   I=453
        IF(EDIBLE(PRSO).OR.DRKBLE(PRSO)) I=454
        CALL RSPSUB(I,ODO2)
        RETURN
C
59200   IF(PRSA.EQ.DRINKW) GO TO 59300
        CALL NEWSTA(PRSO,455,0,0,0)
        RETURN
C
59300   CALL RSPEAK(456)
        RETURN
C
59400   IF(OADV(OCAN(PRSO)).NE.WINNER) GO TO 59100
        IF(QOPEN(OCAN(PRSO))) GO TO 59500
        CALL RSPEAK(457)
        RETURN
C
59500   CALL NEWSTA(PRSO,458,0,0,0)
        RETURN
C
C V137--        BURN.  COMPLICATED.
C
60000   IF(AND(OFLAG1(PRSI),(FLAMBT+LITEBT+ONBT)).NE.
     1       (FLAMBT+LITEBT+ONBT)) GO TO 60400
        IF(OBJACT(X)) RETURN
        IF(AV.NE.BALLO) GO TO 60050
        IF(OAPPLI(OACTIO(BALLO),0)) RETURN
60050   IF(AND(OFLAG1(PRSO),BURNBT).EQ.0) GO TO 60300
        IF(OADV(PRSO).NE.WINNER) GO TO 60100
        CALL RSPSUB(459,ODO2)
        CALL JIGSUP(460)
        RETURN
C
60100   J=OCAN(PRSO)
        IF(QHERE(PRSO,HERE).OR. ((AV.NE.0).AND.(J.EQ.AV)))
     1       GO TO 60200
        IF(J.EQ.0) GO TO 60150
        IF(.NOT.QOPEN(J)) GO TO 60150
        IF(QHERE(J,HERE).OR.((AV.NE.0).AND.(OCAN(J).EQ.AV)))
     1       GO TO 60200
60150   CALL RSPEAK(461)
        RETURN
C
60200   CALL RSPSUB(462,ODO2)
        CALL NEWSTA(PRSO,0,0,0,0)
        RETURN
C
60300   CALL RSPSUB(463,ODO2)
        RETURN
C
60400   CALL RSPSUB(301,ODI2)
        RETURN
C VAPPLI, PAGE 9
C
C V138--        MUNG.  GO TO COMMON ATTACK CODE.
C
63000   I=466
        IF(AND(OFLAG2(PRSO),VILLBT).NE.0) GO TO 66300
        IF(.NOT.OBJACT(X)) CALL RSPSB2(466,ODO2,RMK)
        RETURN
C
C V139--        KILL.  GO TO COMMON ATTACK CODE.
C
64000   I=467
        GO TO 66100
C
C V140--        SWING.  INVERT OBJECTS, FALL THRU TO ATTACK.
C
65000   J=PRSO
        PRSO=PRSI
        PRSI=J
        J=ODO2
        ODO2=ODI2
        ODI2=J
        PRSA=ATTACW
C
C V141--        ATTACK.  FALL THRU TO ATTACK CODE.
C
66000   I=468
C
C COMMON MUNG/ATTACK/SWING/KILL CODE.
C
66100   IF(PRSO.NE.0) GO TO 66200
        CALL RSPEAK(469)
        RETURN
C
66200   IF(AND(OFLAG2(PRSO),VILLBT).NE.0) GO TO 66300
        CALL RSPSUB(470,ODO2)
        RETURN
C
66300   J=471
        IF(PRSI.EQ.0) GO TO 66500
        IF(AND(OFLAG2(PRSI),WEAPBT).EQ.0) GO TO 66400
        IF(.NOT.OBJACT(X))
     1 I=BLOW(PLAYER,PRSO,ORAND(PRSI),.TRUE.,0)
        RETURN
C
66400   J=472
66500   CALL RSPSB2(I,ODO2,J)
        RETURN
C VAPPLI, PAGE 10
C
C V142--        WALK.  PROCESSED EXTERNALLY.
C
68000   VAPPLI=WALK(X)
        RETURN
C
C V143--        TELL.  PROCESSED IN GAME.
C
69000   CALL RSPEAK(603)
        RETURN
C
C V144--        PUT.  PROCESSED EXTERNALLY.
C
70000   VAPPLI=PUT(.TRUE.)
        RETURN
C
C V145,V146,V147,V148-- DROP/GIVE/POUR/THROW
C
71000   CONTINUE
72000   CONTINUE
73000   CONTINUE
74000   VAPPLI=DROP(.FALSE.)
        RETURN
C
C V149--        SAVE
C
77000   CALL SAVEGM( 1 )
        RETURN
C
C V150--        RESTORE
C
78000   CALL RSTRGM
        RETURN
C
        END
        LOGICAL FUNCTION AAPPLI(RI)
        implicit integer (A-Z)
C AAPPLI- APPLICABLES FOR ADVENTURERS
C
C DECLARATIONS
C
        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,RDESC1(150),RDESC2(150),REXIT(150),
     1       RACTIO(150),RVAL(150),RFLAG(150),RRAND(150)
C
        COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR,
     1       RSACRD,RFILL,RMUNG,RBUCK,RHOUSE
C
        COMMON /RINDEX/ WHOUS,LROOM,CELLA
        COMMON /RINDEX/ MTROL,MAZE1
        COMMON /RINDEX/ MGRAT,MAZ15
        COMMON /RINDEX/ FORE1,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,WHITEC1,WHITEC2
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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,ECHOBT,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
        COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT
        COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE
        COMMON /OINDEX/ ROBOT,LUNGS,SAILO,AVIAT,TEETH
        COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,STAFF,SPIDER,TAPEST,WEB
C
C CLOCK INTERRUPTS
C
        LOGICAL CFLAG
        COMMON /CEVENT/ CLNT,CTICK(20),CACTIO(20),CFLAG(20)
C
        COMMON /CINDEX/ CEVCUR,CEVMNT,CEVLNT,CEVMAT,CEVCND,
     1       CEVBAL,CEVBRN,CEVFUS,CEVLED,CEVSAF,CEVVLG,
     2       CEVGNO,CEVBUC,CEVSPH,CEVEGH
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
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
        COMMON /VINDEX/ TAKEW,INVENW,FILLW,EATW,DRINKW,BURNW
        COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW
        COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW
        COMMON /VINDEX/ DIGW,LEAPW
C
C FLAGS
C
        LOGICAL FLAGS(35)
        LOGICAL TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
        LOGICAL DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
        LOGICAL MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
        LOGICAL EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
        LOGICAL GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
        LOGICAL GLACMF,FROBZF,ENDGMF,CYCLOF2,BUGF
        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,CYCLOF2,BUGF
        COMMON /FINDEX/ BTIEF,BINFF
        EQUIVALENCE (FLAGS(1),TROLLF)
C AAPPLI, PAGE 2
C
        AAPPLI=.TRUE.
        GO TO (1000),RI
      CALL GOTOER
        CALL BUG(11,RI)
C
C A1--  ROBOT.  PROCESS MOST COMMANDS GIVEN TO ROBOT.
C
1000    IF((PRSA.NE.RAISEW).OR.(PRSO.NE.CAGE)) GO TO 1200
        CFLAG(CEVSPH)=.FALSE.
        WINNER=PLAYER
        F=MOVETO(CAGER)
        CALL NEWSTA(CAGE,567,CAGER,0,0)
        CALL NEWSTA(ROBOT,0,CAGER,0,0)
        AROOM(AROBOT)=CAGER
        CAGESF=.TRUE.
        OFLAG1(CAGE)=AND(OR(OFLAG1(CAGE),TAKEBT) ,COMPL(NDSCBT))
        OFLAG1(ROBOT)=AND(OFLAG1(ROBOT),COMPL(NDSCBT))
        OFLAG1(SPHER)=OR(OFLAG1(SPHER),TAKEBT)
        RETURN
C
1200    IF((PRSA.NE.DRINKW).AND.(PRSA.NE.EATW)) GO TO 1300
        CALL RSPEAK(568)
        RETURN
C
1300    IF(PRSA.NE.READW) GO TO 1400
        CALL RSPEAK(569)
        RETURN
C
1400    AAPPLI=.FALSE.
        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)) RETURN
        AAPPLI=.TRUE.
        CALL RSPEAK(570)
        RETURN
C
        END
        SUBROUTINE THIEFD
        implicit integer (A-Z)
C THIEFD-      INTERMOVE THIEF DEMON
C
C DECLARATIONS
C
        LOGICAL DFLAG,ONCE,PROB,QHERE,QSTILL,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,RDESC1(150),RDESC2(150),REXIT(150),
     1       RACTIO(150),RVAL(150),RFLAG(150),RRAND(150)
C
        COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR,
     1       RSACRD,RFILL,RMUNG,RBUCK,RHOUSE
C
        COMMON /RINDEX/ WHOUS,LROOM,CELLA
        COMMON /RINDEX/ MTROL,MAZE1
        COMMON /RINDEX/ MGRAT,MAZ15
        COMMON /RINDEX/ FORE1,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,WHITEC1,WHITEC2
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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,ECHOBT,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
        COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT
        COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE
        COMMON /OINDEX/ ROBOT,LUNGS,SAILO,AVIAT,TEETH
C
C VILLAINS AND DEMONS
C
        LOGICAL THFFLG,SWDACT,THFACT
        COMMON /HACK/ THFPOS,THFFLG,THFACT,SWDACT,SWDSTA
C
C FLAGS
C
        LOGICAL FLAGS(35)
        LOGICAL TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
        LOGICAL DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
        LOGICAL MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
        LOGICAL EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
        LOGICAL GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
        LOGICAL GLACMF,FROBZF,ENDGMF,CYCLOF2,BUGF
        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,CYCLOF2,BUGF
        COMMON /FINDEX/ BTIEF,BINFF
        EQUIVALENCE (FLAGS(1),TROLLF)

        QSTILL(R)=(QHERE(STILL,R).OR.(OADV(STILL).EQ.-THIEF))
        PROB(R)=(RND(100).LT.R)
C THIEFD, PAGE 2
C
C       DFLAG=(PRSFLG.AND.100000B).NE.0          SET UP DETAIL FLAG.
        ONCE=.FALSE.
1025    RHERE=OROOM(THIEF)
        IF(RHERE.NE.0) THFPOS=RHERE
C
        IF(THFPOS.EQ.HERE) GO TO 1100
        IF(THFPOS.NE.TREAS) GO TO 1400
C
C THIEF IS IN TREASURE ROOM, AND WINNER IS NOT.
C
C       IF(DFLAG) PRINT 10
C10     FORMAT(" THIEFD-- IN TREASURE ROOM")
        IF(RHERE.EQ.0) GO TO 1050
        CALL NEWSTA(THIEF,0,0,0,0)
        RHERE=0
        IF(QSTILL(TREAS)) CALL NEWSTA(STILL,0,0,THIEF,0)
1050    I=ROBADV(-THIEF,THFPOS,0,0)
        GO TO 1700
C
C THIEF AND WINNER IN SAME ROOM.
C
1100    IF(THFPOS.EQ.TREAS) GO TO 1700
C       IF(DFLAG) PRINT 20
C20     FORMAT(" THIEFD-- IN ADV ROOM")
        IF(THFFLG) GO TO 1300
        IF((RHERE.NE.0).OR.PROB(70)) GO TO 1150
        IF(OCAN(STILL).NE.THIEF) GO TO 1700
        CALL NEWSTA(THIEF,583,THFPOS,0,0)
        THFFLG=.TRUE.
        RETURN
C
1150    IF((RHERE.EQ.0).OR.(AND(OFLAG2(THIEF),FITEBT).EQ.0))
     1       GO TO 1200
       IF(WINNIN(THIEF,WINNER)) GO TO 1175
        CALL NEWSTA(THIEF,584,0,0,0)
        OFLAG2(THIEF)=AND(OFLAG2(THIEF),COMPL(FITEBT))
        IF(QSTILL(THFPOS)) CALL NEWSTA(STILL,0,0,THIEF,0)
        RETURN
C
1175    IF(PROB(90)) GO TO 1700
C
1200    IF((RHERE.EQ.0).OR.PROB(70)) GO TO 1250
        CALL NEWSTA(THIEF,585,0,0,0)
        IF(QSTILL(THFPOS)) CALL NEWSTA(STILL,0,0,THIEF,0)
        RETURN
C
1300    IF(RHERE.EQ.0) GO TO 1700
1250    IF(PROB(70)) RETURN
        THFFLG=.TRUE.
        NR=ROBRM(THFPOS,100,0,0,-THIEF)+ROBADV(WINNER,0,0,-THIEF)
        I=586
        IF(RHERE.NE.0) I=588
        IF(NR.NE.0) I=I+1
        CALL NEWSTA(THIEF,I,0,0,0)
        IF(QSTILL(THFPOS))
     1       CALL NEWSTA(STILL,0,0,THIEF,0)
        RHERE=0
        GO TO 1700
C
C NOT IN ADVENTURERS ROOM.
C
1400    CALL NEWSTA(THIEF,0,0,0,0)
        RHERE=0
C       IF(DFLAG) PRINT 30,THFPOS
C30     FORMAT(" THIEFD-- IN ROOM ",I4)
        IF(QSTILL(THFPOS))
     1       CALL NEWSTA(STILL,0,0,THIEF,0)
        IF(AND(RFLAG(THFPOS),RSEEN).EQ.0) GO TO 1700
        I=ROBRM(THFPOS,75,0,0,-THIEF)
        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
          IF(.NOT.QHERE(I,THFPOS).OR.PROB(60).OR.
     1       (AND(OFLAG1(I),(VISIBT+TAKEBT)).NE.(VISIBT+TAKEBT)))
     2       GOTO 1450
          CALL RSPSUB(590,ODESC2(I))
          IF(PROB(40)) GO TO 1700
          CALL NEWSTA(I,0,0,0,-THIEF)
          OFLAG2(I)=OR(OFLAG2(I),TCHBT)
          GO TO 1700
1450    CONTINUE
        GO TO 1700
C
1500    DO 1550 I=1,OLNT
          IF(.NOT.QHERE(I,THFPOS).OR.(OTVAL(I).NE.0).OR.PROB(80).OR.
     1       (AND(OFLAG1(I),(VISIBT+TAKEBT)).NE.(VISIBT+TAKEBT)))
     2       GOTO 1550
          CALL NEWSTA(I,0,0,0,-THIEF)
          OFLAG2(I)=OR(OFLAG2(I),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
        IF(THFPOS.LE.0) THFPOS=RLNT
        IF(AND(RFLAG(THFPOS),(RLAND+RSACRD)).NE.RLAND)
     1       GO TO 1750
        THFFLG=.FALSE.
        GO TO 1025
C
C ALL DONE.
C
1800    IF(THFPOS.EQ.TREAS) RETURN
        J=591
        IF(THFPOS.NE.HERE) J=0
        DO 1850 I=1,OLNT
          IF((OADV(I).NE.-THIEF).OR.PROB(70).OR.
     1       (OTVAL(I).GT.0)) GO TO 1850
          CALL NEWSTA(I,J,THFPOS,0,0)
          J=0
1850    CONTINUE
        RETURN
C
        END
        LOGICAL FUNCTION BALLOP(ARG)
        implicit integer (A-Z)
C BALLOP-       BALLOON FUNCTION
C
C DECLARATIONS
C
        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
C
C ROOMS
C
        COMMON /ROOMS/ RLNT,RDESC1(150),RDESC2(150),REXIT(150),
     1       RACTIO(150),RVAL(150),RFLAG(150),RRAND(150)
C
        COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR,
     1       RSACRD,RFILL,RMUNG,RBUCK,RHOUSE
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(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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,ECHOBT,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
        COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT
        COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE
        COMMON /OINDEX/ ROBOT,LUNGS,SAILO,AVIAT,TEETH
        COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,STAFF,SPIDER,TAPEST,WEB
C
C CLOCK INTERRUPTS
C
        LOGICAL CFLAG
        COMMON /CEVENT/ CLNT,CTICK(20),CACTIO(20),CFLAG(20)
C
        COMMON /CINDEX/ CEVCUR,CEVMNT,CEVLNT,CEVMAT,CEVCND,
     1       CEVBAL,CEVBRN,CEVFUS,CEVLED,CEVSAF,CEVVLG,
     2       CEVGNO,CEVBUC,CEVSPH,CEVEGH
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
        COMMON /VINDEX/ TAKEW,INVENW,FILLW,EATW,DRINKW,BURNW
        COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW
        COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW
        COMMON /VINDEX/ DIGW,LEAPW
C
C FLAGS
C
        LOGICAL FLAGS(35)
        LOGICAL TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
        LOGICAL DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
        LOGICAL MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
        LOGICAL EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
        LOGICAL GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
        LOGICAL GLACMF,FROBZF,ENDGMF,CYCLOF2,BUGF
        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,CYCLOF2,BUGF
        COMMON /FINDEX/ BTIEF,BINFF
        EQUIVALENCE (FLAGS(1),TROLLF)
C BALLOP, PAGE 2
C
        BALLOP=.TRUE.
        IF(ARG.NE.2) GO TO 200
        IF(PRSA.NE.LOOKW) GO TO 10
        IF(BINFF.NE.0) GO TO 50
        CALL RSPEAK(543)
        GO TO 100
50      CALL RSPSUB(544,ODESC2(BINFF))
100     IF(BTIEF.NE.0) CALL RSPEAK(545)
        RETURN
C
200     IF(ARG.NE.1) GO TO 500
        IF(PRSA.NE.WALKW) GO TO 300
        IF(FINDXT(PRSO,HERE)) GO TO 250
        CALL RSPEAK(546)
        RETURN
C
250     IF(BTIEF.EQ.0) GO TO 275
        CALL RSPEAK(547)
        RETURN
C
275     IF(XTYPE.NE.XNORM) GO TO 10
        IF(AND(RFLAG(XROOM1),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))
        RETURN
C
350     IF((PRSA.NE.PUTW).OR.(PRSI.NE.RECEP).OR.QEMPTY(RECEP))
     1       GO TO 10
        CALL RSPEAK(549)
        RETURN
C
500     IF((PRSA.NE.UNBOAW).OR.(AND(RFLAG(HERE),RLAND).EQ.0))
     1       GO TO 600
        IF(BINFF.NE.0) CTICK(CEVBAL)=3
        GO TO 10
C
600     IF((PRSA.NE.BURNW).OR.(OCAN(PRSO).NE.RECEP)) GO TO 10
        CALL RSPSUB(550,ODESC2(PRSO))
        CTICK(CEVBRN)=OSIZE(PRSO)*20
        OFLAG1(PRSO)=AND(OR(OFLAG1(PRSO),(ONBT+FLAMBT+LITEBT)),
     1       COMPL(TAKEBT+READBT))
        IF(BINFF.NE.0) RETURN
        CALL NEWSTA(BLABE,0,0,BALLO,0)
        BINFF=PRSO
        CTICK(CEVBAL)=3
        CALL RSPEAK(551)
        RETURN
C
        END
        LOGICAL FUNCTION CLOCKD(X)
        implicit integer (A-Z)
C CLOCKD- CLOCK DEMON FOR INTERMOVE CLOCK EVENTS
C
C DECLARATIONS
C
C
C CLOCK INTERRUPTS
C
        LOGICAL CFLAG
        COMMON /CEVENT/ CLNT,CTICK(20),CACTIO(20),CFLAG(20)
C
        DO 100 I=1,CLNT
          IF(.NOT.CFLAG(I) .OR.(CTICK(I).EQ.0)) GO TO 100
          IF(CTICK(I).LT.0) GO TO 50
          CTICK(I)=CTICK(I)-1
          IF(CTICK(I).NE.0) GO TO 100
          CLOCKD=.TRUE.
50        CALL CEVAPP(CACTIO(I))
100     CONTINUE
        RETURN
C
        END
        SUBROUTINE CEVAPP(RI)
        implicit integer (A-Z)
C CEVAPP- CLOCK EVENT APPLICABLES
C
C DECLARATIONS
C
        INTEGER CNDTCK(10),LMPTCK(12)
*        LOGICAL RMINFO,QOPEN,F,QLEDGE,QVAIR,QHERE,MOVETO
        LOGICAL RMINFO,QOPEN,F,QLEDGE,QHERE,MOVETO
C
C GAME STATE
C
        LOGICAL TELFLG
        COMMON /PLAY/ WINNER,HERE,TELFLG
        COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD,
     1       LTSHFT,BLOC,MUNGRM,HS
C
C ROOMS
C
        COMMON /ROOMS/ RLNT,RDESC1(150),RDESC2(150),REXIT(150),
     1       RACTIO(150),RVAL(150),RFLAG(150),RRAND(150)
C
        COMMON /RVARS/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA
C
        COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR,
     1       RSACRD,RFILL,RMUNG,RBUCK,RHOUSE
C
        COMMON /RINDEX/ WHOUS,LROOM,CELLA
        COMMON /RINDEX/ MTROL,MAZE1
        COMMON /RINDEX/ MGRAT,MAZ15
        COMMON /RINDEX/ FORE1,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,WHITEC1,WHITEC2
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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,ECHOBT,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
        COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT
        COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE
        COMMON /OINDEX/ ROBOT,LUNGS,SAILO,AVIAT,TEETH
        COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,STAFF,SPIDER,TAPEST,WEB
C
C CLOCK INTERRUPTS
C
        LOGICAL CFLAG
        COMMON /CEVENT/ CLNT,CTICK(20),CACTIO(20),CFLAG(20)
C
        COMMON /CINDEX/ CEVCUR,CEVMNT,CEVLNT,CEVMAT,CEVCND,
     1       CEVBAL,CEVBRN,CEVFUS,CEVLED,CEVSAF,CEVVLG,
     2       CEVGNO,CEVBUC,CEVSPH,CEVEGH
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
C
C FLAGS
C
        LOGICAL FLAGS(35)
        LOGICAL TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
        LOGICAL DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
        LOGICAL MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
        LOGICAL EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
        LOGICAL GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
        LOGICAL GLACMF,FROBZF,ENDGMF,CYCLOF2,BUGF
        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,CYCLOF2,BUGF
        COMMON /FINDEX/ BTIEF,BINFF
        EQUIVALENCE (FLAGS(1),TROLLF)

        QOPEN(R)=AND(OFLAG2(R),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
        GO TO (1000,2000,3000,4000,5000,6000,7000,8000,9000,10000,
     +11000,12000,13000,14000,15000,16000,17000),RI
      CALL GOTOER
        CALL BUG(3,RI)
C
C CEV1--        CURE CLOCK.  LET PLAYER SLOWLY RECOVER.
C
1000    ASTREN(PLAYER)=MIN0(0,ASTREN(PLAYER)+1)
        IF(ASTREN(PLAYER).GE.0) RETURN
        CTICK(CEVCUR)=30
        RETURN
C
C CEV2--        MAINT-ROOM WITH LEAK.  RAISE THE WATER LEVEL.
C
2000    IF(HERE.EQ.MAINT) CALL RSPEAK(71+(RVMNT/2))
        RVMNT=RVMNT+1
        IF(RVMNT.LE.16) RETURN
        CTICK(CEVMNT)=0
        RFLAG(MAINT)=OR(RFLAG(MAINT),RMUNG)
        RRAND(MAINT)=80
        IF(HERE.EQ.MAINT) CALL JIGSUP(81)
        RETURN
C
C CEV3--        LANTERN.  DESCRIBE GROWING DIMNESS.
C
3000    continue
        if ( endgmf ) return
        CALL LITINT(LAMP,CEVLNT,LMPTCK,12)
        RETURN
C
C CEV4--        MATCH.  OUT IT GOES.
C
4000    CALL RSPEAK(153)
        OFLAG1(MATCH)=AND(OFLAG1(MATCH),COMPL(ONBT))
        RETURN
C
C CEV5--        CANDLE.  DESCRIBE GROWING DIMNESS.
C
5000    CALL LITINT(CANDL,CEVCND,CNDTCK,10)
        RETURN
C CEVAPP, PAGE 3
C
C CEV6--        BALLOON
C
6000    CTICK(CEVBAL)=3
        F=AVEHIC(WINNER).EQ.BALLO
        IF(BLOC.EQ.VLBOT) GO TO 6800
        IF(QLEDGE(BLOC)) GO TO 6700
        IF(QOPEN(RECEP).AND.(BINFF.NE.0))
     1       GO TO 6500
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
        BLOC=VLBOT
        CALL NEWSTA(BALLO,0,BLOC,0,0)
        IF(F) GO TO 6200
        IF(QLEDGE(HERE)) CALL RSPEAK(530)
        RETURN
C
6200    F=MOVETO(BLOC)
        IF(BINFF.EQ.0) GO TO 6250
        CALL RSPEAK(531)
        F=RMINFO(.FALSE.)
        RETURN
C
6250    CALL NEWSTA(BALLO,532,0,0,0)
        CALL NEWSTA(DBALL,0,BLOC,0,0)
        AVEHIC(WINNER)=0
        CFLAG(CEVBAL)=.FALSE.
        CFLAG(CEVBRN)=.FALSE.
        BINFF=0
        BTIEF=0
        RETURN
C
6300    BLOC=BLOC-1
        CALL NEWSTA(BALLO,0,BLOC,0,0)
        IF(F) GO TO 6400
        IF(QLEDGE(HERE)) CALL RSPEAK(533)
        RETURN
C
6400    F=MOVETO(BLOC)
        CALL RSPEAK(534)
        F=RMINFO(.FALSE.)
        RETURN
C
C BALLOON IS IN MIDAIR AND IS INFLATED, UP-UP-AND-AWAY
C
6500    IF(BLOC.NE.VAIR4) GO TO 6600
        CTICK(CEVBRN)=0
        CTICK(CEVBAL)=0
        BINFF=0
        BTIEF=0
        BLOC=VLBOT
        CALL NEWSTA(BALLO,0,0,0,0)
        CALL NEWSTA(DBALL,0,BLOC,0,0)
        IF(F) GO TO 6550
        IF(QLEDGE(HERE)) CALL RSPEAK(535)
        RETURN
C
6550    CALL JIGSUP(536)
        RETURN
C
6600    BLOC=BLOC+1
        CALL NEWSTA(BALLO,0,BLOC,0,0)
        IF(F) GO TO 6650
        IF(QLEDGE(HERE)) CALL RSPEAK(537)
        RETURN
C
6650    F=MOVETO(BLOC)
        CALL RSPEAK(538)
        F=RMINFO(.FALSE.)
        RETURN
C
C ON LEDGE, GOES TO MIDAIR ROOM WHETHER INFLATED OR NOT.
C
6700    BLOC=BLOC+(VAIR2-LEDG2)
        CALL NEWSTA(BALLO,0,BLOC,0,0)
        IF(F) GO TO 6750
        IF(QLEDGE(HERE)) CALL RSPEAK(539)
        CTICK(CEVVLG)=10
        RETURN
C
6750    F=MOVETO(BLOC)
        CALL RSPEAK(540)
        F=RMINFO(.FALSE.)
        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
        CALL NEWSTA(BALLO,0,BLOC,0,0)
        IF(F) GO TO 6850
        IF(QLEDGE(HERE)) CALL RSPEAK(541)
        RETURN
C
6850    F=MOVETO(BLOC)
        CALL RSPEAK(542)
        F=RMINFO(.FALSE.)
        RETURN
C CEVAPP, PAGE 4
C
C CEV7--        BALLOON BURNUP
C
7000    DO 7100 I=1,OLNT
          IF((RECEP.EQ.OCAN(I)).AND.(AND(OFLAG1(I),FLAMBT).NE.0))
     1       GO TO 7200
7100    CONTINUE
        CALL BUG(4,0)
C
7200    CALL NEWSTA(I,0,0,0,0)
        BINFF=0
        IF(HERE.EQ.BLOC) CALL RSPSUB(292,ODESC2(I))
        RETURN
C
C CEV8--        FUSE FUNCTION
C
8000    IF(OCAN(FUSE).NE.BRICK) GO TO 8500
        BR=OROOM(BRICK)
        BC=OCAN(BRICK)
        IF((BR.EQ.0).AND.(BC.NE.0)) BR=OROOM(BC)
        CALL NEWSTA(FUSE,0,0,0,0)
        CALL NEWSTA(BRICK,0,0,0,0)
        IF((BR.NE.0).AND.(BR.NE.HERE)) GO TO 8100
C
        RFLAG(HERE)=OR(RFLAG(HERE),RMUNG)
        RRAND(HERE)=114
        CALL JIGSUP(150)
        RETURN
C
8100    CALL RSPEAK(151)
        MUNGRM=BR
        CTICK(CEVSAF)=5
        IF(BR.NE.MSAFE) GO TO 8200
        IF(BC.NE.SSLOT) RETURN
        CALL NEWSTA(SSLOT,0,0,0,0)
        OFLAG2(SAFE)=OR(OFLAG2(SAFE),OPENBT)
        SAFEF=.TRUE.
        RETURN
C
8200    DO 8250 I=1,OLNT
          IF(QHERE(I,BR) .AND. (AND(OFLAG1(I),TAKEBT).NE.0))
     1       CALL NEWSTA(I,0,0,0,0)
8250    CONTINUE
        IF(BR.NE.LROOM) RETURN
        DO 8300 I=1,OLNT
          IF(OCAN(I).EQ.TCASE) CALL NEWSTA(I,0,0,0,0)
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)
        RETURN
C CEVAPP, PAGE 5
C
C CEV9--        LEDGE MUNGE.
C
9000    RFLAG(LEDG4)=OR(RFLAG(LEDG4),RMUNG)
        RRAND(LEDG4)=109
        IF(HERE.EQ.LEDG4) GO TO 9100
        CALL RSPEAK(110)
        RETURN
C
9100    IF(AVEHIC(WINNER).NE.0) GO TO 9200
        CALL JIGSUP(111)
        RETURN
C
9200    IF(BTIEF.NE.0) GO TO 9300
        CALL RSPEAK(112)
        RETURN
C
9300    BLOC=VLBOT
        CALL NEWSTA(BALLO,0,0,0,0)
        CALL NEWSTA(DBALL,0,BLOC,0,0)
        BTIEF=0
        BINFF=0
        CFLAG(CEVBAL)=.FALSE.
        CFLAG(CEVBRN)=.FALSE.
        CALL JIGSUP(113)
        RETURN
C
C CEV10--       SAFE MUNG.
C
10000   RFLAG(MUNGRM)=OR(RFLAG(MUNGRM),RMUNG)
        RRAND(MUNGRM)=114
        IF(HERE.EQ.MUNGRM) GO TO 10100
        CALL RSPEAK(115)
        IF(MUNGRM.EQ.MSAFE) CTICK(CEVLED)=8
        RETURN
C
10100   I=116
        IF(AND(RFLAG(HERE),RHOUSE).NE.0) I=117
        CALL JIGSUP(I)
        RETURN
C CEVAPP, PAGE 6
C
C CEV11--       VOLCANO GNOME
C
11000   IF(QLEDGE(HERE)) GO TO 11100
        CTICK(CEVVLG)=1
        RETURN
C
11100   CALL NEWSTA(GNOME,118,HERE,0,0)
        RETURN
C
C CEV12--       VOLCANO GNOME DISAPPEARS
C
12000   CALL NEWSTA(GNOME,149,0,0,0)
        RETURN
C
C CEV13--       BUCKET.
C
13000   IF(OCAN(WATER).EQ.BUCKE)
     1       CALL NEWSTA(WATER,0,0,0,0)
        RETURN
C
C CEV14--       SPHERE.  IF EXPIRES, HE"S TRAPPED.
C
14000   RFLAG(CAGER)=OR(RFLAG(CAGER),RMUNG)
        RRAND(CAGER)=147
        CALL JIGSUP(148)
        RETURN
C
C CEV15--       END GAME HERALD.
C
15000   ENDGMF=.TRUE.
        CALL RSPEAK(119)
        RETURN
C
C     CEV16 -- DARK KANGAROO.
C     MOVE KANG TO EAST SIDE OF HOUSE.
C
16000 CONTINUE
      CALL NEWSTA(148,0,5,0,0)
      CTICK(16) = 5
      RETURN
C
C     CEV17 -- LIGHT KANGAROO.
C     MOVE KANG TO EAST SIDE OF HOUSE.
C
17000 CONTINUE
      CALL NEWSTA(149,0,5,0,0)
      CTICK(17) = 5
      RETURN
C
        END
        SUBROUTINE LITINT(OBJ,CEV,TICKS,TICKLN)
        implicit integer (A-Z)
C LITINT-      LIGHT INTERRUPT PROCESSOR
C
C DECLARATIONS
C
        INTEGER TICKS(TICKLN)
C
C GAME STATE
C
        LOGICAL TELFLG
        COMMON /PLAY/ WINNER,HERE,TELFLG
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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,ECHOBT,ACTRBT,
     1       WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
     2       TCHBT,VEHBT,SCHBT
C
C
C CLOCK INTERRUPTS
C
        LOGICAL CFLAG
        COMMON /CEVENT/ CLNT,CTICK(20),CACTIO(20),CFLAG(20)
C
        ORAND(OBJ)=ORAND(OBJ)+1
        CTICK(CEV)=TICKS(ORAND(OBJ))
        IF(CTICK(CEV).NE.0) GO TO 100
        OFLAG1(OBJ)=AND(OFLAG1(OBJ),COMPL(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(ORAND(OBJ)+(TICKLN/2)))
        RETURN
C
        END
        SUBROUTINE FIGHTD
        implicit integer (A-Z)
C FIGHTD- INTERMOVE FIGHT DEMON
C
C DECLARATIONS
C
        LOGICAL PROB,OAPPLI,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
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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,ECHOBT,ACTRBT,
     1       WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
     2       TCHBT,VEHBT,SCHBT
C
C VILLAINS AND DEMONS
C
        COMMON /VILL/ VLNT,VILLNS(5),VPROB(5),VOPPS(5)
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
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
        COMMON /VINDEX/ TAKEW,INVENW,FILLW,EATW,DRINKW,BURNW
        COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW
        COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW
        COMMON /VINDEX/ DIGW,LEAPW

        DATA ROUT/1/
        PROB(R)=(RND(100).LT.R)
C FIGHTD, PAGE 2
C
        DO 2400 I=1,VLNT
          VOPPS(I)=0
          OBJ=VILLNS(I)
          RA=OACTIO(OBJ)
          IF(HERE.NE.OROOM(OBJ)) GO TO 2200
          IF(OCAPAC(OBJ).GE.0) GO TO 2050
          IF((VPROB(I).EQ.0).OR..NOT.PROB(VPROB(I)))
     1       GO TO 2025
          OCAPAC(OBJ)=IABS(OCAPAC(OBJ))
          VPROB(I)=0
          IF(RA.EQ.0) GO TO 2400
          PRSA=INXW
          F=OAPPLI(RA,0)
          GO TO 2400
C
2025      VPROB(I)=VPROB(I)+10
          GO TO 2400
C
2050      IF(AND(OFLAG2(OBJ),FITEBT).EQ.0) GO TO 2100
          VOPPS(I)=OBJ
          GO TO 2400
C
2100      IF(RA.EQ.0) GO TO 2400
          PRSA=FRSTQW
          IF(.NOT.OAPPLI(RA,0)) GO TO 2400
          OFLAG2(OBJ)=OR(OFLAG2(OBJ),FITEBT)
          VOPPS(I)=OBJ
          GO TO 2400
C
2200      IF((AND(OFLAG2(OBJ),FITEBT).EQ.0).OR.(RA.EQ.0))
     1       GO TO 2300
          PRSA=FIGHTW
          F=OAPPLI(RA,0)
2300      AFLAG(PLAYER)=AND(AFLAG(PLAYER),COMPL(ASTAG))
          OFLAG2(OBJ)=AND(OFLAG2(OBJ),COMPL(STAGBT+FITEBT))
          IF((OCAPAC(OBJ).GE.0).OR.(RA.EQ.0))
     1       GO TO 2400
          PRSA=INXW
          F=OAPPLI(RA,0)
          OCAPAC(OBJ)=IABS(OCAPAC(OBJ))
2400    CONTINUE
C FIGHTD, PAGE 3
C
C NOW DO ACTUAL COUNTERBLOWS.
C
        OUT=0
2600    DO 2700 I=1,VLNT
          J=VOPPS(I)
          IF(J.EQ.0) GO TO 2700
          RA=OACTIO(J)
          IF(RA.EQ.0) GO TO 2650
          PRSA=FIGHTW
          IF(OAPPLI(RA,0)) GO TO 2700
2650      RES=BLOW(PLAYER,J,ORAND(J),.FALSE.,OUT)
          IF(RES.LT.0) RETURN
          IF(RES.EQ.ROUT) OUT=2+RND(3)
2700    CONTINUE
        OUT=OUT-1
        IF(OUT.GT.0) GO TO 2600
        RETURN
C
        END
        INTEGER FUNCTION BLOW(H,V,RMK,HFLG,OUT)
        implicit integer (A-Z)
C BLOW- STRIKE BLOW
C
C DECLARATIONS
C
        LOGICAL HFLG,OAPPLI,F
        INTEGER DEF1R(3),DEF2R(4),DEF3R(5)
        INTEGER RVECTR(66),RSTATE(45)
C BLOW, PAGE 2
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(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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,ECHOBT,ACTRBT,
     1       WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
     2       TCHBT,VEHBT,SCHBT
C
C
C CLOCK INTERRUPTS
C
        LOGICAL CFLAG
        COMMON /CEVENT/ CLNT,CTICK(20),CACTIO(20),CFLAG(20)
C
        COMMON /CINDEX/ CEVCUR,CEVMNT,CEVLNT,CEVMAT,CEVCND,
     1       CEVBAL,CEVBRN,CEVFUS,CEVLED,CEVSAF,CEVVLG,
     2       CEVGNO,CEVBUC,CEVSPH,CEVEGH
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
C
C VERBS
C
        COMMON /VINDEX/ CINTW,DEADXW,FRSTQW,INXW,OUTXW
        COMMON /VINDEX/ WALKIW,FIGHTW,FOOW
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)
        DV=ODESC2(V)
        BLOW=RMISS
C       PRINT 10,H,V,RMK,HFLG,OUT
C10     FORMAT(" BLOW 10-- ",3I7,L7,I7)
        IF(.NOT.HFLG) GO TO 1000
C
C HERO IS ATTACKER, VILLAIN IS DEFENDER.
C
        OFLAG2(V)=OR(OFLAG2(V),FITEBT)
        IF(AND(AFLAG(H),ASTAG).EQ.0) GO TO 100
        CALL RSPEAK(591)
        AFLAG(H)=AND(AFLAG(H),COMPL(ASTAG))
        RETURN
C
100     ATT=FIGHTS(H,.TRUE.)
        OA=ATT
        DEF=OCAPAC(V)
        OD=DEF
        DWEAP=0
        DO 200 I=1,OLNT
          IF((OCAN(I).EQ.V).AND.(AND(OFLAG2(I),WEAPBT).NE.0))
     1       DWEAP=I
200     CONTINUE
        IF(V.EQ.AOBJ(PLAYER)) GO TO 300
        IF(DEF.NE.0) GO TO 2000
        CALL RSPSUB(592,DV)
        RETURN
C
300     CALL JIGSUP(593)
        RETURN
C
C VILLAIN IS ATTACKER, HERO IS DEFENDER.
C
1000    AFLAG(H)=AND(AFLAG(H),COMPL(ASTAG))
        IF(AND(OFLAG2(V),STAGBT).EQ.0) GO TO 1200
        OFLAG2(V)=AND(OFLAG2(V),COMPL(STAGBT))
        CALL RSPSUB(594,DV)
        RETURN
C
1200    ATT=OCAPAC(V)
        OA=ATT
        DEF=FIGHTS(H,.TRUE.)
        IF(DEF.LE.0) RETURN
        OD=FIGHTS(H,.FALSE.)
        DWEAP=IABS(FWIM(0,WEAPBT,0,0,H,.TRUE.))
C BLOW, PAGE 4
C
C PARTIES ARE NOW EQUIPPED.  DEF CANNOT BE ZERO.
C ATT MUST BE > 0.
C
2000    CONTINUE
C       PRINT 2050,ATT,OA,DEF,OD,DWEAP
C2050   FORMAT(" BLOW 2050-- ",5I7)
        IF(DEF.GT.0) GO TO 2100
        RES=RKILL
        IF(HFLG) CALL RSPSUB(595,DV)
        GO TO 3000
C
2100    IF(DEF-2) 2200,2300,2400
2200    ATT=MIN0(ATT,3)
        TBL=DEF1R(ATT)
        GO TO 2500
C
2300    ATT=MIN0(ATT,4)
        TBL=DEF2R(ATT)
        GO TO 2500
C
2400    ATT=ATT-DEF
        ATT=MIN0(2,MAX0(-2,ATT))+3
        TBL=DEF3R(ATT)
C
2500    RES=RVECTR(TBL+RND(10))
        IF(OUT.EQ.0) GO TO 2600
        IF(RES.EQ.RSTAG) GO TO 2550
        RES=RSIT
        GO TO 2600
2550    RES=RHES
2600    IF((RES.EQ.RSTAG).AND.(DWEAP.NE.0).AND.(RND(100).LT.25))
     1       RES=RLOSE
C
        MI=RSTATE(((RMK-1)*9)+RES+1)
        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)
C       PRINT 2650,RES,MI,I,J,MBASE
C2650   FORMAT(" BLOW 2650-- ",5I7)
        CALL RSPSUB(I,J)
C BLOW, PAGE 5
C
C NOW APPLY RESULT
C
3000    GO TO (4000,3100,3200,3300,3400,3500,3600,4000,3200),RES+1
      CALL GOTOER
C
3100    IF(HFLG) DEF=-DEF
        GO TO 4000
C
3200    DEF=0
        GO TO 4000
C
3300    DEF=MAX0(0,DEF-1)
        GO TO 4000
C
3400    DEF=MAX0(0,DEF-2)
        GO TO 4000
C
3500    IF(HFLG) GO TO 3550
        AFLAG(H)=OR(AFLAG(H),ASTAG)
        GO TO 4000
C
3550    OFLAG2(V)=OR(OFLAG2(V),STAGBT)
        GO TO 4000
C
3600    CALL NEWSTA(DWEAP,0,HERE,0,0)
        DWEAP=0
        IF(HFLG) GO TO 4000
        DWEAP=IABS(FWIM(0,WEAPBT,0,0,H,.TRUE.))
        IF(DWEAP.NE.0) CALL RSPSUB(605,ODESC2(DWEAP))
C BLOW, PAGE 6
C
4000    BLOW=RES
        IF(.NOT.HFLG) GO TO 4500
        OCAPAC(V)=DEF
        IF(DEF.NE.0) GO TO 4100
        OFLAG2(V)=AND(OFLAG2(V),COMPL(FITEBT))
        CALL RSPSUB(572,DV)
        CALL NEWSTA(V,0,0,0,0)
        IF(RA.EQ.0) RETURN
        PRSA=DEADXW
        F=OAPPLI(RA,0)
        RETURN
C
4100    IF((RES.NE.ROUT).OR.(RA.EQ.0)) RETURN
        PRSA=OUTXW
        F=OAPPLI(RA,0)
        RETURN
C
4500    ASTREN(H)=-10000
        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.)
        CALL JIGSUP(596)
        BLOW=-1
        RETURN
C
        END
        SUBROUTINE SWORDD
        implicit integer(A-Z)
C SWORDD- SWORD INTERMOVE DEMON
C
C DECLARATIONS
C
        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
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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
        COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT
        COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE
        COMMON /OINDEX/ ROBOT,LUNGS,SAILO,AVIAT,TEETH
        COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,STAFF,SPIDER,TAPEST,WEB
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
        INFEST(R)=(OROOM(CYCLO).EQ.R).OR.(OROOM(TROLL).EQ.R)
     1       .OR.((OROOM(THIEF).EQ.R).AND.THFACT)
C SWORDD, PAGE 2
C
        IF(OADV(SWORD).NE.PLAYER) GO TO 500
        NG=2
        IF(INFEST(HERE)) GO TO 300
        NG=1
        DO 200 I=XMIN,XMAX,XMIN
          IF(.NOT.FINDXT(I,HERE)) GO TO 200
          GO TO (50,200,50,50),XTYPE
      CALL GOTOER
50        IF(INFEST(XROOM1)) GO TO 300
200     CONTINUE
        NG=0
C
300     IF(NG.EQ.SWDSTA) RETURN
        CALL RSPEAK(NG+495)
        SWDSTA=NG
        RETURN
C
500     SWDACT=.FALSE.
        RETURN
        END
        LOGICAL FUNCTION TAKE(FLG)
        implicit integer (A-Z)
C TAKE-- BASIC TAKE SEQUENCE
C
C TAKE AN OBJECT (FOR VERBS TAKE, PUT, DROP, READ, ETC.)
C
C
C DECLARATIONS
C
        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
        COMMON /STAR/ MBASE,STRBIT
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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,ECHOBT,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

        QOPEN(O)=AND(OFLAG2(O),OPENBT).NE.0
C TAKE, PAGE 2
C
        TAKE=.FALSE.
        OA=OACTIO(PRSO)
        IF(PRSO.LE.STRBIT) GO TO 100
        TAKE=OBJACT(X)
        RETURN
C
100     X=OCAN(PRSO)
        IF(X.EQ.0) GO TO 300
        IF((AND(OFLAG1(X),VISIBT).NE.0) .AND. (QOPEN(X).OR.
     1       (AND(OFLAG1(X),TRANBT).NE.0))) GO TO 200
        CALL RSPEAK(552)
        RETURN
C
200     IF(QOPEN(X)) GO TO 300
        CALL RSPEAK(526)
        RETURN
C
300     IF(PRSO.NE.AVEHIC(WINNER)) GO TO 400
        CALL RSPEAK(553)
        RETURN
C
400     IF(AND(OFLAG1(PRSO),TAKEBT).NE.0) GO TO 500
        IF(OA.EQ.0) GO TO 450
        IF(OAPPLI(OA,0)) RETURN
450     CALL RSPEAK(554+RND(3))
        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)
        RETURN

C
600     MXLOAD=MXLOAD
        IF (X.NE.0) THEN
        IF (OADV(X).EQ.WINNER) THEN
            GOTO 700
        ENDIF
        ENDIF
        IF ((WEIGHT(0,PRSO,WINNER)+OSIZE(PRSO)).LE.MXLOAD) THEN
            GOTO 700
        ENDIF
        CALL RSPEAK(558)
        RETURN
C
700     TAKE=.TRUE.
        IF(OA.EQ.0) GO TO 800
        IF(OAPPLI(OA,0)) RETURN
800     CALL NEWSTA(PRSO,0,0,0,WINNER)
        OFLAG2(PRSO)=OR(OFLAG2(PRSO),TCHBT)
        CALL SCRUPD(OFVAL(PRSO))
        OFVAL(PRSO)=0
        IF(FLG) CALL RSPEAK(559)
        RETURN
C
        END
        LOGICAL FUNCTION DROP(Z)
        implicit integer (A-Z)
C DROP- DROP VERB PROCESSOR
C
C DECLARATIONS
C
        LOGICAL F,PUT,OBJACT,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
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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,ECHOBT,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
        COMMON /VINDEX/ TAKEW,INVENW,FILLW,EATW,DRINKW,BURNW
        COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW
        COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW
        COMMON /VINDEX/ DIGW,LEAPW
C DROP, PAGE 2
C
        DROP=.TRUE.
        X=OCAN(PRSO)
        IF(X.EQ.0) GO TO 200
        IF(OADV(X).NE.WINNER) GO TO 1000
        IF(AND(OFLAG2(X),OPENBT).NE.0) GO TO 300
        CALL RSPEAK(526)
        RETURN
C
200     IF(OADV(PRSO).NE.WINNER) GO TO 1000
300     IF(AVEHIC(WINNER).EQ.0) GO TO 400
        PRSI=AVEHIC(WINNER)
        F=PUT(.FALSE.)
        GO TO 500
C
400     CALL NEWSTA(PRSO,0,HERE,0,0)
500     IF(OBJACT(X)) RETURN
        I=0
        IF(PRSA.EQ.DROPW) I=528
        IF(PRSA.EQ.THROWW) I=529
        CALL RSPEAK(I)
        RETURN
C
1000    CALL RSPEAK(527)
        RETURN
C
        END
        LOGICAL FUNCTION PUT(FLG)
        implicit integer (A-Z)
C PUT- PUT VERB PROCESSOR
C
C DECLARATIONS
C
        LOGICAL QOPEN,QHERE,OBJACT,FLG,TAKE
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(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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,ECHOBT,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
        COMMON /VINDEX/ TAKEW,INVENW,FILLW,EATW,DRINKW,BURNW
        COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW
        COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW
        COMMON /VINDEX/ DIGW,LEAPW
        QOPEN(R)=AND(OFLAG2(R),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)
        PUT=.TRUE.
        RETURN
C
200     IF(QOPEN(PRSI).OR.(AND(OFLAG1(PRSI),(DOORBT+CONTBT)).NE.0)
     1       .OR.(AND(OFLAG2(PRSI),VEHBT).NE.0)) GO TO 300
        CALL RSPEAK(561)
        RETURN
C
300     IF(QOPEN(PRSI)) GO TO 400
        CALL RSPEAK(562)
        RETURN
C
400     IF(PRSO.NE.PRSI) GO TO 500
        CALL RSPEAK(563)
        RETURN
C
500     IF(OCAN(PRSO).NE.PRSI) GO TO 600
        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
        CALL RSPEAK(565)
        RETURN
C
C NOW SEE IF OBJECT (OR ITS CONTAINER) IS IN ROOM
C
700     J=PRSO
725     IF(QHERE(J,HERE)) GO TO 750
        J=OCAN(J)
        IF(J.NE.0) GO TO 725
        GO TO 800
C
750     SVO=PRSO
        SVI=PRSI
        PRSA=TAKEW
        PRSI=0
        IF(.NOT.TAKE(.FALSE.)) RETURN
        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
        IF(QOPEN(OCAN(PRSO))) GO TO 900
        CALL RSPSUB(566,ODESC2(PRSO))
        RETURN
C
900     CALL SCRUPD(OFVAL(PRSO))
        OFVAL(PRSO)=0
        CALL NEWSTA(PRSO,0,0,0,WINNER)
C
1000    IF(.NOT.FLG) GO TO 1100
        IF(OBJACT(X)) RETURN
1100    CALL NEWSTA(PRSO,2,0,PRSI,0)
        PUT=.TRUE.
        RETURN
C
        END
        SUBROUTINE VALUAC(V)
        implicit integer (A-Z)
C VALUAC- HANDLES VALUABLES/EVERYTHING
C
C DECLARATIONS
C
        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(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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,ECHOBT,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
        COMMON /VINDEX/ TAKEW,INVENW,FILLW,EATW,DRINKW,BURNW
        COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW
        COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW
        COMMON /VINDEX/ DIGW,LEAPW
        NOTVAL(R)=(SAVEP.EQ.V).AND.(OTVAL(R).LE.0)
C VALUAC, PAGE 2
C
        F=.TRUE.
        SAVEP=PRSO
        SAVEH=HERE
        IF(LIT(HERE)) GO TO 100
        CALL RSPEAK(579)
        RETURN
C
100     IF(PRSA.NE.TAKEW) GO TO 1000
        DO 500 PRSO=1,OLNT
          IF(.NOT.QHERE(PRSO,HERE).OR.
     1       (AND(OFLAG1(PRSO),VISIBT).EQ.0).OR.
     2       (AND(OFLAG2(PRSO),ACTRBT).NE.0).OR.
     3       NOTVAL(PRSO)) GO TO 500
          IF((AND(OFLAG1(PRSO),TAKEBT).EQ.0).AND.
     1       (AND(OFLAG2(PRSO),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
        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) RETURN
        DO 2500 PRSO=1,OLNT
          IF((OADV(PRSO).NE.WINNER)
     1       .OR.(PRSO.EQ.PRSI).OR.NOTVAL(PRSO).OR.
     2       (AND(OFLAG1(PRSO),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
        IF(F) CALL RSPEAK(I)
        RETURN
        END




      integer*8 function  walltm ()

*   Return elapsed wall clock time in seconds since beginning of Unix Epoch.

      implicit integer*8 (a-z)
      common /walltime/ accwt, runwt

      call system( "/bin/date +%s > /tmp/QorkEpochTime" )
      open( unit=9, file="/tmp/QorkEpochTime", status="old" )
      read( 9, '(i20)' ) walltm
      close( unit=9 )
      end



      subroutine tmh ( tm, tmc, v, msg )

*   TIME helper: nicely format and pack days, hours, minutes or seconds
*   in V with message MSG into character variable TM using cursor TMC.

      implicit integer (a-z)
      character*(*) tm, msg
      character*120 fmt

      if ( v .ne. 0 ) then
         le = int( log10( float( v ) ) + 1 )
         write( fmt, 1 ) le
 1       format( "(i", i6, ")" )
         write( tm(tmc:tmc+le), fmt ) v
         tmc = tmc + le
         tm(tmc:tmc+len(msg)) = msg
         tmc = tmc + len( msg )
         if ( v .ne. 1 ) then
            tm(tmc:tmc+1) = "s"
            tmc = tmc + 1
         endif
         tm(tmc:tmc+2) = ", "
         tmc = tmc + 2
      endif

      end




        SUBROUTINE SAVEGM( makecopy )

*   makecopy is ZERO only for the initial game save state.

        implicit integer (A-Z)
      COMMON /RMSG/MLNT,RTEXT(800)
      COMMON /STAR/MBASE,STRBIT
      COMMON /OROOM2/R2LNT,O2(6),R2(6)
C SAVE- SAVE GAME STATE
C
C DECLARATIONS
C
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
C
C MISCELLANEOUS VARIABLES
C
        COMMON /VERS/ VMAJ,VMIN,VEDIT
        COMMON /ZTIMES/ PLTIME,SHOUR,SMIN,SSEC
C
C ROOMS
C
        COMMON /ROOMS/ RLNT,RDESC1(150),RDESC2(150),REXIT(150),
     1       RACTIO(150),RVAL(150),RFLAG(150),RRAND(150)
C
C EXITS
C
        COMMON /EXITS/ XLNT,TRAVEL(625)
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
C
C
C CLOCK INTERRUPTS
C
        LOGICAL CFLAG
        COMMON /CEVENT/ CLNT,CTICK(20),CACTIO(20),CFLAG(20)
C
C
C VILLAINS AND DEMONS
C
        LOGICAL THFFLG,SWDACT,THFACT
        COMMON /HACK/ THFPOS,THFFLG,THFACT,SWDACT,SWDSTA
        COMMON /VILL/ VLNT,VILLNS(5),VPROB(5),VOPPS(5)
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 FLAGS(35)
        LOGICAL TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
        LOGICAL DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
        LOGICAL MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
        LOGICAL EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
        LOGICAL GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
        LOGICAL GLACMF,FROBZF,ENDGMF,CYCLOF2,BUGF
        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,CYCLOF2,BUGF
        COMMON /FINDEX/ BTIEF,BINFF
      COMMON /LAIR/NTIMES
      COMMON /RVARS/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA
      COMMON /DBRIO/ RECNUM, LRN
      integer*8 accwt, runwt, walltm
      common /walltime/ accwt, runwt
        EQUIVALENCE (FLAGS(1),TROLLF)

c Game save state date, score and moves.
        character*19 qd
        character*12 scoremoves

        PRSWON=.FALSE.
      REWIND 3
        WRITE(3) VMAJ,VMIN,VEDIT
        WRITE(3) WINNER,HERE,THFPOS,TELFLG,THFFLG,THFACT,
     1       SWDACT,SWDSTA
        WRITE(3) PLTIME,MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD,
     1       LTSHFT,BLOC,MUNGRM,HS
        WRITE(3) ODESC1,ODESC2,OFLAG1,OFLAG2,OFVAL,OTVAL,
     1       OSIZE,OCAPAC,OROOM,OADV,OCAN,ORAND
        WRITE(3) RVAL,RFLAG,RRAND
        WRITE(3) AROOM,ASCORE,AVEHIC,ASTREN,AFLAG
        WRITE(3) FLAGS,BINFF,BTIEF,VPROB,CFLAG,CTICK
        WRITE(3) MXSCOR,STRBIT
        WRITE(3) RLNT,RDESC1,RDESC2,REXIT,RACTIO,RVAL,RFLAG,RRAND
        WRITE(3) XLNT,TRAVEL
        WRITE(3) OLNT,ODESC1,ODESC2,ODESCO,OACTIO,OFLAG1,OFLAG2,
     1       OFVAL,OTVAL,OSIZE,OCAPAC,OROOM,OADV,OCAN,
     2       OREAD,ORAND
        WRITE(3) R2LNT,O2,R2
        WRITE(3) CLNT,CTICK,CACTIO,CFLAG
        WRITE(3) VLNT,VILLNS,VPROB,VOPPS
        WRITE(3) ALNT,AROOM,ASCORE,AVEHIC,AOBJ,AACTIO,ASTREN,AFLAG
        WRITE(3) MBASE,MLNT,RTEXT
        WRITE(3) NTIMES,RVMNT,RVCLR,RVCYC,RVSND,RVGUA
        write( 3 ) recnum
        accwt = walltm() - runwt + accwt
        if ( makecopy .eq. 0 ) accwt = 0
        write( 3 ) accwt
        runwt = walltm()
        ENDFILE 3
        close(unit=3)

      if ( makecopy .eq. 1 ) then
c Make a backup copy of the game save state.
         write( scoremoves, 123 ) ascore(winner), moves
 123     format( "-", i3.3,"-", i7.7 )
         call qdate( qd )
         call system( "/bin/cp Qork.save Qork.save-" // qd //
     +     scoremoves )
         open (unit=3, file='Qork.save', form='unformatted')
      endif

C
        CALL RSPEAK(597)
        RETURN
C
        END




        SUBROUTINE RSTRGM
        implicit integer (A-Z)
      COMMON /RMSG/MLNT,RTEXT(800)
      COMMON /STAR/MBASE,STRBIT
      COMMON /OROOM2/R2LNT,O2(6),R2(6)
C RESTORE- RESTORE GAME STATE
C
C DECLARATIONS
C
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
C
C MISCELLANEOUS VARIABLES
C
        COMMON /VERS/ VMAJ,VMIN,VEDIT
        COMMON /ZTIMES/ PLTIME,SHOUR,SMIN,SSEC
C
C ROOMS
C
        COMMON /ROOMS/ RLNT,RDESC1(150),RDESC2(150),REXIT(150),
     1       RACTIO(150),RVAL(150),RFLAG(150),RRAND(150)
C
C EXITS
C
        COMMON /EXITS/ XLNT,TRAVEL(625)
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
C
C
C CLOCK INTERRUPTS
C
        LOGICAL CFLAG
        COMMON /CEVENT/ CLNT,CTICK(20),CACTIO(20),CFLAG(20)
C
C
C VILLAINS AND DEMONS
C
        LOGICAL THFFLG,SWDACT,THFACT
        COMMON /HACK/ THFPOS,THFFLG,THFACT,SWDACT,SWDSTA
        COMMON /VILL/ VLNT,VILLNS(5),VPROB(5),VOPPS(5)
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 FLAGS(35)
        LOGICAL TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
        LOGICAL DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
        LOGICAL MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
        LOGICAL EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
        LOGICAL GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
        LOGICAL GLACMF,FROBZF,ENDGMF,CYCLOF2,BUGF
        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,CYCLOF2,BUGF
        COMMON /FINDEX/ BTIEF,BINFF
      COMMON /LAIR/NTIMES
      COMMON /RVARS/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA
      COMMON /DBRIO/ RECNUM, LRN
      character*170, crecnum, crecnumchk
      integer*8 accwt, runwt, walltm
      common /walltime/ accwt, runwt
        EQUIVALENCE (FLAGS(1),TROLLF)
C
        PRSWON=.FALSE.
C
      REWIND 3
        READ(3,END=10000) I,J,K
10000   IF((I.NE.VMAJ).OR.(J.NE.VMIN)) GO TO 200
C
        READ(3,END=10001) WINNER,HERE,THFPOS,TELFLG,THFFLG,THFACT,
     1                 SWDACT,SWDSTA
10001   READ(3,END=10002) PLTIME,MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD,
     1                 LTSHFT,BLOC,MUNGRM,HS
10002   READ(3,END=10003) ODESC1,ODESC2,OFLAG1,OFLAG2,OFVAL,OTVAL,
     1                 OSIZE,OCAPAC,OROOM,OADV,OCAN,ORAND
10003   READ(3,END=10004) RVAL,RFLAG,RRAND
10004   READ(3,END=10005) AROOM,ASCORE,AVEHIC,ASTREN,AFLAG
10005   READ(3,END=10006) FLAGS,BINFF,BTIEF,VPROB,CFLAG,CTICK
10006   READ(3,END=10007) MXSCOR,STRBIT
10007   READ(3,END=10008) RLNT,RDESC1,RDESC2,REXIT,RACTIO,RVAL,RFLAG,RRA
     +ND
10008   READ(3,END=10009) XLNT,TRAVEL
10009   READ(3,END=10010) OLNT,ODESC1,ODESC2,ODESCO,OACTIO,OFLAG1,OFLAG2
     1,                OFVAL,OTVAL,OSIZE,OCAPAC,OROOM,OADV,OCAN,
     2                 OREAD,ORAND
10010   READ(3,END=10011) R2LNT,O2,R2
10011   READ(3,END=10012) CLNT,CTICK,CACTIO,CFLAG
10012   READ(3,END=10013) VLNT,VILLNS,VPROB,VOPPS
10013   READ(3,END=10014) ALNT,AROOM,ASCORE,AVEHIC,AOBJ,AACTIO,ASTREN,AF
     +LAG
10014   READ(3,END=10015) MBASE,MLNT,RTEXT
10015 READ(3,END=10016) NTIMES,RVMNT,RVCLR,RVCYC,RVSND,RVGUA
C
10016 continue
      read( 3, end=10017) recnum
10017 continue
      read( 3, end=10018 ) accwt
10018 continue
      runwt = walltm()

* Check game saved state and random text database for consistency.

*      print *, "restored recnum from save state=", recnum
      write( crecnumchk, "(a,i7)" ), "MAXRECNUM=", recnum
*      print *,"crecnumchk=",crecnumchk
*      print *, "now compare crecnumchk with crecnum from textdb"
      read( 2, '(a8, a)', rec=recnum ) idummy, crecnum
*      print *,"crecnum from textdb=",crecnum
      if ( crecnumchk .ne. crecnum ) then
         write( 6, 190 ) " "
 190     format( a )
         write( 6, 191 )
 191     format(
     +'An Engineer has detected a serious inconsistency in the internal'
     +/'state of the Dungeon; if you think that matters are weird now,'/
     +'the situation will become even stranger. To tell the truth, you'/
     +'should start your adventure over ... so long!'
     +)
         write( 6, 190 ) " "
         call exit
      endif

      CALL RSPEAK(599)
        RETURN
C
200   CONTINUE
      CALL RSPEAK( 600 )
      RETURN
C
        END
        LOGICAL FUNCTION WALK(X)
        implicit integer(A-Z)
C WALK- MOVE IN SPECIFIED DIRECTION
C
C DECLARATIONS
C
        LOGICAL FINDXT,QOPEN,LIT,PROB,MOVETO,RMINFO
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 EXITS
C
        COMMON /CURXT/ XTYPE,XROOM1,XSTRNG,XACTIO,XOBJ
        EQUIVALENCE (XFLAG,XOBJ)
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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,ECHOBT,ACTRBT,
     1       WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
     2       TCHBT,VEHBT,SCHBT
C
        LOGICAL CFLAG
        COMMON /CEVENT/ CLNT,CTICK(20),CACTIO(20),CFLAG(20)
C
        COMMON /CINDEX/ CEVCUR,CEVMNT,CEVLNT,CEVMAT,CEVCND,
     1       CEVBAL,CEVBRN,CEVFUS,CEVLED,CEVSAF,CEVVLG,
     2       CEVGNO,CEVBUC,CEVSPH,CEVEGH
C
C VILLAINS AND DEMONS
C
        LOGICAL THFFLG,SWDACT,THFACT
        COMMON /HACK/ THFPOS,THFFLG,THFACT,SWDACT
        COMMON /VILL/ VLNT,VILLNS(5),VPROB(5),VOPPS(5)
C
C ADVENTURERS
C
        COMMON /AINDEX/ PLAYER,AROBOT
C
C FLAGS
C
        LOGICAL FLAGS(35)
        LOGICAL TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
        LOGICAL DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
        LOGICAL MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
        LOGICAL EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
        LOGICAL GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
        LOGICAL GLACMF,FROBZF,ENDGMF,CYCLOF2,BUGF
        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,CYCLOF2,BUGF
        COMMON /FINDEX/ BTIEF,BINFF
        EQUIVALENCE (FLAGS(1),TROLLF)
        QOPEN(O)=AND(OFLAG2(O),OPENBT).NE.0
        PROB(O)=(RND(100).LT.O)
C WALK, PAGE 2
C
        WALK=.TRUE.
        IF((WINNER.NE.PLAYER).OR.LIT(HERE).OR.PROB(25))
     1       GO TO 500
        IF(.NOT.FINDXT(PRSO,HERE)) GO TO 450
        GO TO (400,200,100,300),XTYPE
      CALL GOTOER
        CALL BUG(9,XTYPE)
C
100     IF(XACTIO.EQ.0) GO TO 150
        IF(CXAPPL(XACTIO).NE.0) GO TO 400
150     IF(FLAGS(XFLAG)) GO TO 400
200     CALL JIGSUP(523)
        RETURN
C
300     IF(XACTIO.EQ.0) GO TO 350
        IF(CXAPPL(XACTIO).NE.0) GO TO 400
350     IF(QOPEN(XOBJ)) GO TO 400
        CALL JIGSUP(523)
        RETURN
C
400     IF(LIT(XROOM1)) GO TO 900
450     CALL JIGSUP(522)
        RETURN
C
C ROOM IS LIT, OR WINNER IS NOT PLAYER (NO GRUE).
C
500     IF(FINDXT(PRSO,HERE)) GO TO 550
        CALL RSPEAK(524)
        RETURN
C
550     GO TO (900,600,700,800),XTYPE
      CALL GOTOER
        CALL BUG(9,XTYPE)
C
600     CALL RSPEAK(XSTRNG)
        RETURN
C
700     IF(XACTIO.EQ.0) GO TO 750
        IF(CXAPPL(XACTIO).NE.0) GO TO 900
750     IF(FLAGS(XFLAG)) GO TO 900
        IF(XSTRNG.EQ.0) XSTRNG=524
        CALL RSPEAK(XSTRNG)
        RETURN
C
800     IF(XACTIO.EQ.0) GO TO 850
        IF(CXAPPL(XACTIO).NE.0) GO TO 900
850     IF(QOPEN(XOBJ)) GO TO 900
        IF(XSTRNG.EQ.0) XSTRNG=525
        CALL RSPSUB(XSTRNG,ODESC2(XOBJ))
        RETURN
C
900     WALK=MOVETO(XROOM1)
        IF(WALK) WALK=RMINFO(.FALSE.)
        RETURN
        END
        INTEGER FUNCTION CXAPPL(RI)
        implicit integer (A-Z)
C CXAPPL- CONDITIONAL EXIT PROCESSORS
C
C DECLARATIONS
C
C
C GAME STATE
C
        LOGICAL TELFLG
        COMMON /PLAY/ WINNER,HERE,TELFLG
C
C ROOMS
C
        COMMON /ROOMS/ RLNT,RDESC1(150),RDESC2(150),REXIT(150),
     1       RACTIO(150),RVAL(150),RFLAG(150),RRAND(150)
C
C EXITS
C
        COMMON /EXITS/ XLNT,TRAVEL(625)
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(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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,ECHOBT,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
        COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT
        COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE
        COMMON /OINDEX/ ROBOT,LUNGS,SAILO,AVIAT,TEETH
        COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,STAFF,SPIDER,TAPEST,WEB
C
        COMMON /AINDEX/ PLAYER,AROBOT
C
C FLAGS
C
        LOGICAL FLAGS(35)
        LOGICAL TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
        LOGICAL DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
        LOGICAL MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
        LOGICAL EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
        LOGICAL GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
        LOGICAL GLACMF,FROBZF,ENDGMF,CYCLOF2,BUGF
        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,CYCLOF2,BUGF
        COMMON /FINDEX/ BTIEF,BINFF
        EQUIVALENCE (FLAGS(1),TROLLF)
C CXAPPL, PAGE 2
C
        CXAPPL=0
        GO TO (1000,2000,3000,4000,5000),RI
      CALL GOTOER
        CALL BUG(5,RI)
C
C C1- COFFIN-CURE
C
1000    EGYPTF=OADV(COFFI).NE.WINNER
        RETURN
C
C C2- CAROUSEL EXIT
C C5- CAROUSEL OUT
C
2000    IF(CAROFF) RETURN
2500    CALL RSPEAK(121)
5000    I=XELNT(XCOND)*RND(8)
        XROOM1=AND((TRAVEL(REXIT(HERE)+I)),XRMASK)
        CXAPPL=XROOM1
        RETURN
C
C C3- CHIMNEY FUNCTION
C
3000    LITLDF=.FALSE.
        J=0
        DO 3100 I=1,OLNT
          IF(OADV(I).EQ.WINNER) J=J+1
3100    CONTINUE
C
        IF((J.GT.2).OR.(OADV(LAMP).NE.WINNER)) RETURN
        LITLDF=.TRUE.
        IF(AND(OFLAG2(DOOR),OPENBT).EQ.0)
     1       OFLAG2(DOOR)=AND(OFLAG2(DOOR),COMPL(TCHBT))
        RETURN
C
C C4- FROBOZZ FLAG (MAGNET ROOM)
C
4000    FROBZF=(WINNER.NE.PLAYER).OR. .NOT.CAROFF
        IF(FROBZF) RETURN
        GO TO 2500
C
        END
        LOGICAL FUNCTION LIGHTP(OBJ)
        implicit integer (A-Z)
C LIGHTP-       LIGHT PROCESSOR
C
C DECLARATIONS
C
        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(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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,ECHOBT,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
        COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT
        COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE
        COMMON /OINDEX/ ROBOT,LUNGS,SAILO,AVIAT,TEETH
        COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,STAFF,SPIDER,TAPEST,WEB
C
C CLOCK INTERRUPTS
C
        LOGICAL CFLAG
        COMMON /CEVENT/ CLNT,CTICK(20),CACTIO(20),CFLAG(20)
C
        COMMON /CINDEX/ CEVCUR,CEVMNT,CEVLNT,CEVMAT,CEVCND,
     1       CEVBAL,CEVBRN,CEVFUS,CEVLED,CEVSAF,CEVVLG,
     2       CEVGNO,CEVBUC,CEVSPH,CEVEGH
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
        COMMON /VINDEX/ TAKEW,INVENW,FILLW,EATW,DRINKW,BURNW
        COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW
        COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW
        COMMON /VINDEX/ DIGW,LEAPW
        QON(R)=AND(OFLAG1(R),ONBT).NE.0
C LIGHTP, PAGE 2
C
        LIGHTP=.TRUE.
        FLOBTS=FLAMBT+LITEBT+ONBT
        IF(OBJ.NE.CANDL) GO TO 20000
        IF(ORAND(CANDL).NE.0) GO TO 19100
        ORAND(CANDL)=1
        CTICK(CEVCND)=50
C
19100   IF(PRSA.NE.TRNOFW) GO TO 19200
        I=513
        IF(QON(CANDL)) I=514
        CFLAG(CEVCND)=.FALSE.
        OFLAG1(CANDL)=AND(OFLAG1(CANDL),COMPL(ONBT))
        CALL RSPEAK(I)
        RETURN
C
19200   IF(((PRSA.NE.BURNW).OR.(PRSO.NE.CANDL)).AND.
     1       (PRSA.NE.TRNONW)) GO TO 10
        IF(AND(OFLAG1(CANDL),LITEBT).NE.0) GO TO 19300
        CALL RSPEAK(515)
        RETURN
C
19300   IF(PRSI.NE.0) GO TO 19400
        CALL RSPEAK(516)
        PRSWON=.FALSE.
        RETURN
C
19400   IF((PRSI.NE.MATCH).OR. .NOT.QON(MATCH)) GO TO 19500
        I=517
        IF(QON(CANDL)) I=518
        OFLAG1(CANDL)=OR(OFLAG1(CANDL),ONBT)
        CFLAG(CEVCND)=.TRUE.
        CALL RSPEAK(I)
        RETURN
C
19500   IF((PRSI.NE.TORCH).OR. .NOT.QON(TORCH)) GO TO 19600
        IF(QON(CANDL)) GO TO 19700
        CALL NEWSTA(CANDL,521,0,0,0)
        RETURN
C
19600   CALL RSPEAK(519)
        RETURN
C
19700   CALL RSPEAK(520)
        RETURN
C
20000   IF(OBJ.NE.MATCH) CALL BUG(6,OBJ)
        IF((PRSA.NE.TRNONW).OR.(PRSO.NE.MATCH)) GO TO 20500
        IF(ORAND(MATCH).NE.0) GO TO 20100
        CALL RSPEAK(183)
        RETURN
C
20100   ORAND(MATCH)=ORAND(MATCH)-1
        OFLAG1(MATCH)=OR(OFLAG1(MATCH),FLOBTS)
        CTICK(CEVMAT)=2
        CALL RSPEAK(184)
        RETURN
C
20500   IF((PRSA.NE.TRNOFW).OR.(AND(OFLAG1(MATCH),ONBT).EQ.0))
     1       GO TO 10
        OFLAG1(MATCH)=AND(OFLAG1(MATCH),COMPL(FLOBTS))
        CTICK(CEVMAT)=0
        CALL RSPEAK(185)
        RETURN
C
C HERE FOR FALSE RETURN
C
10      LIGHTP=.FALSE.
        RETURN
        END
        LOGICAL FUNCTION OAPPLI(RI,ARG)
        implicit integer (A-Z)
C OAPPLI- OBJECT SPECIAL ACTION ROUTINES
C
C DECLARATIONS
C
        LOGICAL SOBJS
*        LOGICAL QOPEN,QON,PROB,LIT
        LOGICAL QOPEN,LIT
        LOGICAL MOVETO,RMINFO
        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
C
        COMMON /BATS/ BATDRP(9)
C
C ROOMS
C
        COMMON /ROOMS/ RLNT,RDESC1(150),RDESC2(150),REXIT(150),
     1       RACTIO(150),RVAL(150),RFLAG(150),RRAND(150)
C
        COMMON /RVARS/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA
C
        COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR,
     1       RSACRD,RFILL,RMUNG,RBUCK,RHOUSE
C
        COMMON /RINDEX/ WHOUS,LROOM,CELLA
        COMMON /RINDEX/ MTROL,MAZE1
        COMMON /RINDEX/ MGRAT,MAZ15
        COMMON /RINDEX/ FORE1,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,WHITEC1,WHITEC2
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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,ECHOBT,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
        COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT
        COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE
        COMMON /OINDEX/ ROBOT,LUNGS,SAILO,AVIAT,TEETH
        COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,STAFF,SPIDER,TAPEST,WEB
C
C CLOCK INTERRUPTS
C
        LOGICAL CFLAG
        COMMON /CEVENT/ CLNT,CTICK(20),CACTIO(20),CFLAG(20)
C
        COMMON /CINDEX/ CEVCUR,CEVMNT,CEVLNT,CEVMAT,CEVCND,
     1       CEVBAL,CEVBRN,CEVFUS,CEVLED,CEVSAF,CEVVLG,
     2       CEVGNO,CEVBUC,CEVSPH,CEVEGH
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
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
        COMMON /VINDEX/ TAKEW,INVENW,FILLW,EATW,DRINKW,BURNW
        COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW
        COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW
        COMMON /VINDEX/ DIGW,LEAPW
C
C FLAGS
C
        LOGICAL FLAGS(35)
        LOGICAL TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
        LOGICAL DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
        LOGICAL MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
        LOGICAL EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
        LOGICAL GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
        LOGICAL GLACMF,FROBZF,ENDGMF,CYCLOF2,BUGF
        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,CYCLOF2,BUGF
        COMMON /FINDEX/ BTIEF,BINFF
        EQUIVALENCE (FLAGS(1),TROLLF)

*        PROB(R)=(RND(100).LT.R)
        QOPEN(R)=AND(OFLAG2(R),OPENBT).NE.0
*        QON(R)=AND(OFLAG1(R),ONBT).NE.0
        DATA MXSMP/99/
C OAPPLI, PAGE 2
C
        IF(RI.LE.MXSMP) GO TO 100
        IF(PRSO.NE.0.AND.PRSO.LE.160) ODO2=ODESC2(PRSO)
        IF(PRSI.NE.0.AND.PRSI.LE.160) ODI2=ODESC2(PRSI)
 1012   CONTINUE
        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,
     +45000,47000,48000,49000,50000,51000,52000,54000,55000,
     +56000,57000,58000,59000),
     3       (RI-MXSMP)
      CALL GOTOER
        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     OAPPLI=SOBJS(RI,ARG)
        RETURN
C OAPPLI, PAGE 3
C
C O100--        MACHINE FUNCTION
C
2000    IF(HERE.NE.MMACH) GO TO 10
        OAPPLI=OPNCLS(MACHI,123,124)
        RETURN
C
C O101--        WATER FUNCTION
C
5000    IF(PRSA.NE.THROWW) GO TO 5100
        CALL NEWSTA(PRSO,132,0,0,0)
        RETURN
C
5100    IF((PRSA.NE.DROPW).AND.(PRSA.NE.POURW).AND.(PRSA.NE.GIVEW))
     1       GO TO 5200
        IF(AV.NE.0) GO TO 5150
        CALL NEWSTA(PRSO,133,0,0,0)
        RETURN
C
5150    CALL NEWSTA(PRSO,0,0,AV,0)
        CALL RSPSUB(296,ODESC2(AV))
        RETURN
C
5200    IF((PRSA.NE.TAKEW).AND.(PRSA.NE.PUTW)) GO TO 10
        IF((AV.EQ.PRSI).AND.(AV.NE.0)) GO TO 5150
        IF((PRSI.NE.0).AND.(PRSI.NE.BOTTL)) GO TO 5300
        IF(OADV(BOTTL).NE.WINNER) GO TO 5400
        I=612
        IF(.NOT.QOPEN(BOTTL)) GO TO 5250
        I=613
        IF(.NOT.QEMPTY(BOTTL)) GO TO 5250
        I=614
        CALL NEWSTA(PRSO,0,0,BOTTL,0)
5250    CALL RSPEAK(I)
        RETURN
C
5300    CALL RSPSUB(297,ODI2)
        CALL NEWSTA(PRSO,0,0,0,0)
        RETURN
C
C BOTTLE NOT ON WINNER.
C
5400    IF((OCAN(PRSO).EQ.BOTTL).AND.(PRSA.EQ.TAKEW).AND.
     1       (PRSI.EQ.0)) GO TO 5500
        CALL RSPEAK(615)
        RETURN
C
5500    IF(QHERE(BOTTL,HERE)) GO TO 5600
        CALL RSPSUB(566,ODESC2(BOTTL))
        RETURN
C
5600    CALL NEWSTA(BOTTL,559,0,0,WINNER)
        RETURN
C OAPPLI, PAGE 4
C
C O102--        LEAF PILE
C
10000   IF(PRSA.NE.BURNW) GO TO 10500
        IF(OROOM(PRSO).EQ.0) GO TO 10100
        CALL NEWSTA(PRSO,158,0,0,0)
        RETURN
C
10100   CALL NEWSTA(PRSO,0,HERE,0,0)
        CALL JIGSUP(159)
        RETURN
C
10500   IF(PRSA.NE.MOVEW) GO TO 10
        CALL RSPEAK(2)
        RETURN
C
C O103--        TROLL, DONE EXTERNALLY.
C
11000   OAPPLI=TROLLP(ARG)
        RETURN
C
C O104--        RUSTY KNIFE.
C
12000   IF(PRSA.NE.TAKEW) GO TO 12100
        IF(OADV(SWORD).EQ.WINNER) CALL RSPEAK(160)
      IF (.NOT. ENDGMF) GOTO 10
C
C     IF IN CRYPT WITH LENS, COMPLETE ENDGAME.
C
      IF (HERE .NE. 137) GOTO 10
      IF ( (OADV(141).NE.WINNER) .OR. (OADV(SWORD).NE.WINNER) ) GOTO 10
      CALL SCRUPD(25)
      CALL RSPEAK(654)
      CALL SCORE (.FALSE.)
      CALL EXIT
C
12100   IF((PRSA.NE.ATTACW).AND.(PRSA.NE.KILLW).AND.
     1       (PRSA.NE.SWINGW).AND.
     2       ((PRSA.NE.THROWW).OR.(PRSI.EQ.0))) GO TO 10
        CALL NEWSTA(RKNIF,0,0,0,0)
        CALL JIGSUP(161)
        RETURN
C OAPPLI, PAGE 5
C
C O105--        GLACIER
C
15000   IF(PRSA.NE.THROWW) GO TO 15500
        IF(PRSO.NE.TORCH) GO TO 15400
        CALL NEWSTA(ICE,169,0,0,0)
        ODESC1(TORCH)=174
        ODESC2(TORCH)=173
        OFLAG1(TORCH)=AND(OFLAG1(TORCH),COMPL(FLOBTS))
        CALL NEWSTA(TORCH,0,STREA,0,0)
        GLACRF=.TRUE.
        IF(.NOT.LIT(HERE)) CALL RSPEAK(170)
        RETURN
C
15400   CALL RSPEAK(171)
        RETURN
C
15500   IF((PRSA.NE.MELTW).OR.(PRSO.NE.ICE)) GO TO 10
        IF(AND(OFLAG1(PRSI),FLOBTS).NE.FLOBTS) GO TO 15600
        CALL RSPSUB(298,ODI2)
        RETURN
C
15600   GLACMF=.TRUE.
        IF(PRSI.NE.TORCH) GO TO 15700
        ODESC1(TORCH)=174
        ODESC2(TORCH)=173
        OFLAG1(TORCH)=AND(OFLAG1(TORCH),COMPL(FLOBTS))
15700   CALL JIGSUP(172)
        RETURN
C
C O106--        BLACK BOOK
C
18000   IF(PRSA.NE.OPENW) GO TO 18100
        CALL RSPEAK(180)
        RETURN
C
18100   IF(PRSA.NE.CLOSEW) GO TO 18200
        CALL RSPEAK(181)
        RETURN
C
18200   IF(PRSA.NE.BURNW) GO TO 10
        CALL NEWSTA(PRSO,0,0,0,0)
        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)
        RETURN
C
C O110--        THIEF, PROCESSED EXTERNALLY
C
25000   OAPPLI=THIEFP(ARG)
        RETURN
C
C O111--        WINDOW
C
26000   OAPPLI=OPNCLS(WINDO,208,209)
        RETURN
C
C O112--        PILE OF BODIES
C
32000   IF(PRSA.NE.TAKEW) GO TO 32500
        CALL RSPEAK(228)
        RETURN
C
32500   IF((PRSA.NE.BURNW).AND.(PRSA.NE.MUNGW)) GO TO 10
        IF(ONPOLF) RETURN
        ONPOLF=.TRUE.
        CALL NEWSTA(HPOLE,0,LLD2,0,0)
        CALL JIGSUP(229)
        RETURN
C
C O113--        VAMPIRE BAT
C
35000   CALL RSPEAK(50)
        F=MOVETO(BATDRP(RND(9)+1))
        F=RMINFO(.FALSE.)
        RETURN
C OAPPLI, PAGE 7
C
C O114--        STICK
C
39000   IF(PRSA.NE.WAVEW) GO TO 10
        IF(HERE.EQ.MRAIN) GO TO 39500
        IF((HERE.EQ.POG).OR.(HERE.EQ.FALLS)) GO TO 39200
        CALL RSPEAK(244)
        RETURN
C
39200   OFLAG1(POT)=OR(OFLAG1(POT),VISIBT)
        RAINBF=.NOT. RAINBF
        I=245
        IF(RAINBF) I=246
        CALL RSPEAK(I)
        RETURN
C
39500   RAINBF=.FALSE.
        CALL JIGSUP(247)
        RETURN
C
C O115--        BALLOON, HANDLED EXTERNALLY
C
40000   OAPPLI=BALLOP(ARG)
        RETURN
C
C O116--        HEADS
C
45000   IF(PRSA.EQ.READW) GO TO 10
        CALL NEWSTA(LCASE,260,LROOM,0,0)
        I=ROBADV(WINNER,0,LCASE,0)+ROBRM(HERE,100,0,LCASE,0)
        CALL JIGSUP(261)
        RETURN
C OAPPLI, PAGE 8
C
C O117--        SPHERE
C
47000   IF(CAGESF.OR.(PRSA.NE.TAKEW)) GO TO 10
        IF(WINNER.NE.PLAYER) GO TO 47500
        CALL RSPEAK(263)
        IF(OROOM(ROBOT).NE.HERE) GO TO 47200
        F=MOVETO(CAGED)
        CALL NEWSTA(ROBOT,0,CAGED,0,0)
        AROOM(AROBOT)=CAGED
        OFLAG1(ROBOT)=OR(OFLAG1(ROBOT),NDSCBT)
        CTICK(CEVSPH)=10
        RETURN
C
47200   CALL NEWSTA(SPHER,0,0,0,0)
        RFLAG(CAGER)=OR(RFLAG(CAGER),RMUNG)
        RRAND(CAGER)=147
        CALL JIGSUP(148)
        RETURN
C
47500   CALL NEWSTA(SPHER,0,0,0,0)
        CALL NEWSTA(ROBOT,264,0,0,0)
        CALL NEWSTA(RCAGE,0,HERE,0,0)
        RETURN
C
C O118--        GEOMETRICAL BUTTONS
C
48000   IF(PRSA.NE.PUSHW) GO TO 10
        I=PRSO-SQBUT+1
        IF((I.LE.0).OR.(I.GE.4)) GO TO 10
        IF(WINNER.NE.PLAYER) THEN
      GO TO (48100,48200,48300),I
      CALL GOTOER
      ENDIF
        CALL JIGSUP(265)
        RETURN
C
48100   I=267
        IF(CAROZF) I=266
        CAROZF=.TRUE.
        CALL RSPEAK(I)
        RETURN
C
48200   I=266
        IF(CAROZF) I=268
        CAROZF=.FALSE.
        CALL RSPEAK(I)
        RETURN
C
48300   CAROFF=.NOT.CAROFF
        IF(.NOT.QHERE(IRBOX,CAROU)) RETURN
        CALL RSPEAK(269)
C COMPLEMENT VISIBILITY
        OFLAG1(IRBOX)=COMPL(EQUIV(OFLAG1(IRBOX),VISIBT))
        RETURN
C
C O119--        FLASK FUNCTION
C
49000   continue
        if ( prsa .ne. readw ) goto 49050
        if ( prsi .ne. flask ) goto 49050
        if ( prso .ne. tube ) goto 49050
        i = 655
        if ( ocan(55) .NE. tube) i= 656
        call rspeak( i )
        return

49050   continue
        IF(PRSA.EQ.OPENW) GO TO 49100
        IF((PRSA.NE.MUNGW).AND.(PRSA.NE.THROWW)) GO TO 10
        CALL NEWSTA(FLASK,270,0,0,0)
49100   RFLAG(HERE)=OR(RFLAG(HERE),RMUNG)
        RRAND(HERE)=271
        CALL JIGSUP(272)
        RETURN
C
C O120--        BUCKET FUNCTION
C
50000   IF(ARG.NE.2) GO TO 10
        IF((OCAN(WATER).NE.BUCKE).OR.BUCKTF) GO TO 50500
        BUCKTF=.TRUE.
        CTICK(CEVBUC)=100
        CALL NEWSTA(BUCKE,290,TWELL,0,0)
        GO TO 50900
C
50500   IF((OCAN(WATER).EQ.BUCKE).OR..NOT.BUCKTF) GO TO 10
        BUCKTF=.FALSE.
        CALL NEWSTA(BUCKE,291,BWELL,0,0)
50900   IF(AV.NE.BUCKE) RETURN
        F=MOVETO(OROOM(BUCKE))
        F=RMINFO(.FALSE.)
        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
        CALL NEWSTA(ECAKE,273,0,0,0)
        DO 51100 I=1,OLNT
          IF(OROOM(I).NE.ALICE) GO TO 51100
          IF(OSIZE(I).NE.10000) OSIZE(I)=OSIZE(I)*64
          OROOM(I)=ALISM
51100   CONTINUE
        OAPPLI=MOVETO(ALISM)
        RETURN
C
C O122--        ICINGS
C
52000   IF(PRSA.NE.READW) GO TO 52200
        I=274
        IF(PRSI.NE.0) I=275
        IF(PRSI.EQ.BOTTL) I=276
        IF(PRSI.EQ.FLASK) I=277+(PRSO-ORICE)
        CALL RSPEAK(I)
        RETURN
C
52200   IF((PRSA.NE.THROWW).OR.(PRSO.NE.RDICE).OR.(PRSI.NE.POOL))
     1       GO TO 52300
        CALL NEWSTA(POOL,280,0,0,0)
        OFLAG1(SAFFR)=OR(OFLAG1(SAFFR),VISIBT)
        RETURN
C
52300   IF((HERE.NE.ALICE).AND.(HERE.NE.ALISM).AND.(HERE.NE.ALITR))
     1       GO TO 10
        IF(((PRSA.NE.EATW).AND.(PRSA.NE.THROWW)).OR.
     1       (PRSO.NE.ORICE)) GO TO 52400
        CALL NEWSTA(ORICE,0,0,0,0)
        RFLAG(HERE)=OR(RFLAG(HERE),RMUNG)
        RRAND(HERE)=281
        CALL JIGSUP(282)
        RETURN
C
52400   IF((PRSA.NE.EATW).OR.(PRSO.NE.BLICE))
     1       GO TO 10
        CALL NEWSTA(BLICE,283,0,0,0)
        IF(HERE.NE.ALISM) GO TO 52500
        DO 52450 I=1,OLNT
          IF(OROOM(I).NE.HERE) GO TO 52450
          OROOM(I)=ALICE
          IF(OSIZE(I).NE.10000) OSIZE(I)=OSIZE(I)/64
52450   CONTINUE
        OAPPLI=MOVETO(ALICE)
        RETURN
C
52500   CALL JIGSUP(284)
        RETURN
C
C O123--        BRICK
C
54000   IF(PRSA.NE.BURNW) GO TO 10
        CALL JIGSUP(150)
        RETURN
C
C O124--        MYSELF
C
55000   IF(PRSA.NE.GIVEW) GO TO 55100
        CALL NEWSTA(PRSO,2,0,0,PLAYER)
        RETURN
C
55100   IF(PRSA.NE.TAKEW) GO TO 55200
        CALL RSPEAK(286)
        RETURN
C
55200   IF((PRSA.NE.KILLW).AND.(PRSA.NE.MUNGW)) GO TO 10
        CALL JIGSUP(287)
        RETURN
C
56000 CONTINUE
C   - O125, SPIDER.
      IFROG = RND(3)
      CALL JIGSUP(633+IFROG)
      RETURN
C
57000 CONTINUE
C     0 126, SPIDER WEB.
C
C     DUE TO MY INHERENT LAZYNESS, I HAVE USED THE FOLLOWING
C     HARD-WIRED NUMBERS:
C
C     ROOM 150 = WEB ROOM.
C     OBJ  147 = SPIDER WEB.
C     OBJ  146 = SILK TAPESTRY.
C     OBJ   11 = H20 (DON*T ALLOW WATER TO STICK IN WEB).
C     OBJ   55 = VISCOUS MATERIAL (CAN*T STICK IN WEB AND MUST
C                BE IN TUBE TO GET TAPESTRY).
C
      IF (HERE .NE. 150) GOTO 10
      IF ( (PRSA .NE. THROWW) .OR. (PRSI .NE. 147) ) GOTO 57010
C
C     DON*T LET H20 OR PUTTY STICK IN WEB.
C
      IF ( (PRSO .EQ. 11) .OR. (PRSO .EQ. 55) ) GOTO 10
      OCAN(PRSO) = PRSI
      OROOM(PRSO) = 0
      CALL RSPSUB(637,ODESC2(PRSO))
      IF (PRSO .NE. TUBE)RETURN
C
C     PUTTY (VISCOUS MATERIAL) MUST BE IN TUBE.
C
      IF (OCAN(55) .NE. TUBE) RETURN
      OCAN(146) = 0
      OROOM(146) = HERE
      CALL RSPSUB(638,ODESC2(146))
      RETURN
C
57010 IF ( (PRSA .NE. RUBW) .OR. (PRSO .NE. 147) ) GOTO 10
      CALL JIGSUP(636)
      RETURN
C
58000 CONTINUE
C
C     O127 - KANGAROO PROCESSING.
C
C     DARK KANGAROO  = OBJ 148.
C     LIGHT KANGAROO = OBJ 149.
C     E. SIDE OF HOUSE = ROOM 5.
C     MYLAR NET = OBJ 138.
C     GLASS LENS = OBJ 141.
C     CEVENT 16 = DARK COLORED KANG (OBJ 148).
C     CEVENT 17 = LIGHT COLORED KANG (OBJ 149).
C
      IF (HERE .NE. 5) GOTO 10
      IF ( (PRSA .NE. THROWW) .OR. (PRSO .NE. 138) ) GOTO 58010
      I = 16
      IF (PRSI .EQ. 149) I = 17
      IF (OROOM(PRSI) .NE. HERE) GOTO 10
      CFLAG(I) = .FALSE.
      CALL RSPSUB(650,ODESC2(148-16+I))
C
C     PLACE NETTED KANG IN NET, MOVE IT OUT OF THE ROOM.
C
      OCAN(148-16+I) = 138
      OROOM(148-16+I) = 0
C
C     IF LIGHT KANGAROO NETTED, THEN LENS APPEARS.
C     BRING POUCH OUT OF LIMBO.
C
      OROOM(133) = HERE
      IF (I .NE. 17) RETURN
C
C     DON*T PUT LENS IN POUCH IF IT HAS ALREADY BEEN TAKEN.
C
      IF ( AND(OFLAG2(141),TCHBT) .NE. 0 ) RETURN
      OCAN(141) = 133
      RETURN
C
58010 CONTINUE
      IF (PRSA .NE. RUBW) GOTO 10
      CALL RSPEAK(653)
      RETURN
C
C     O 128 - NET.
C
59000 CONTINUE
      IF ( (PRSA.NE.TAKEW) .AND. (PRSA.NE.READW) ) GOTO 10
      I = 0
      IF ( (OCAN(148).NE.0) .OR. (OCAN(149).NE.0) ) I = 1
      OCAN(148) = 0
      OCAN(149) = 0
      CFLAG(16) = .TRUE.
      CFLAG(17) = .TRUE.
      IF (I .EQ. 0) GOTO 10
      CALL RSPEAK(651)
C
C     THE KANG HAS JUST ESCAPED FROM THE NET. TAKE THE LENS
C     OUT OF THE POUCH. CLOSE THE POUCH AND REMOVE IT.
C
      OCAN(141) = 0
      OROOM(133) = 0
      OFLAG2(133) = AND(OFLAG2(133),COMPL(OPENBT))
      GOTO 10
        END
        LOGICAL FUNCTION SVERBS(RI)
        implicit integer (A-Z)
C SVERBS-       SIMPLE VERBS PROCESSOR
C       ALL VERBS IN THIS ROUTINE MUST BE INDEPENDANT
C       OF OBJECT ACTIONS
C
C DECLARATIONS
C
        LOGICAL MOVETO,YESNO
        LOGICAL RMINFO
        LOGICAL QOPEN
        LOGICAL FINDXT,QHERE,F
        INTEGER JOKES(20)
        REAL RSLT
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
C
C MISCELLANEOUS VARIABLES
C
        COMMON /VERS/ VMAJ,VMIN,VEDIT
        COMMON /CHAN/ INPCH,OUTCH,DBCH
C
C ROOMS
C
        COMMON /ROOMS/ RLNT,RDESC1(150),RDESC2(150),REXIT(150),
     1       RACTIO(150),RVAL(150),RFLAG(150),RRAND(150)
C
        COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR,
     1       RSACRD,RFILL,RMUNG,RBUCK,RHOUSE
C
        COMMON /RVARS/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA
C
        COMMON /RINDEX/ WHOUS,LROOM,CELLA
        COMMON /RINDEX/ MTROL,MAZE1
        COMMON /RINDEX/ MGRAT,MAZ15
        COMMON /RINDEX/ FORE1,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,WHITEC1,WHITEC2
C
C EXITS
C
        COMMON /EXITS/ XLNT,TRAVEL(625)
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
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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,ECHOBT,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
        COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT
        COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE
        COMMON /OINDEX/ ROBOT,LUNGS,SAILO,AVIAT,TEETH
        COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,STAFF,SPIDER,TAPEST,WEB
C
C CLOCK INTERRUPTS
C
        LOGICAL CFLAG
        COMMON /CEVENT/ CLNT,CTICK(20),CACTIO(20),CFLAG(20)
C
        COMMON /CINDEX/ CEVCUR,CEVMNT,CEVLNT,CEVMAT,CEVCND,
     1       CEVBAL,CEVBRN,CEVFUS,CEVLED,CEVSAF,CEVVLG,
     2       CEVGNO,CEVBUC,CEVSPH,CEVEGH
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
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
        COMMON /VINDEX/ TAKEW,INVENW,FILLW,EATW,DRINKW,BURNW
        COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW
        COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW
        COMMON /VINDEX/ DIGW,LEAPW
C
C FLAGS
C
        LOGICAL FLAGS(35)
        LOGICAL TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
        LOGICAL DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
        LOGICAL MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
        LOGICAL EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
        LOGICAL GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
        LOGICAL GLACMF,FROBZF,ENDGMF,CYCLOF2,BUGF
        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,CYCLOF2,BUGF
        COMMON /FINDEX/ BTIEF,BINFF
      COMMON /LAIR/NTIMES
      integer*8 accwt, runwt, playtm, walltm
      common /walltime/ accwt, runwt
      character*120 tm, tmp
      EQUIVALENCE (FLAGS(1),TROLLF)
      DATA MXNOP/49/,MXJOKE/69/
      DATA JOKES/4,5,3,304,305,306,307,308,309,310,
     1       311,312,313,5314,5319,324,325,0,0,0/
        QOPEN(R)=AND(OFLAG2(R),OPENBT).NE.0
C SVERBS, PAGE 2
C
        SVERBS=.TRUE.
        IF(PRSO.NE.0) ODO2=ODESC2(PRSO)
        IF(PRSI.NE.0) ODI2=ODESC2(PRSI)
C
        IF(RI.EQ.0) CALL BUG(7,RI)
        IF(RI.LE.MXNOP) RETURN
        IF(RI.LE.MXJOKE) GO TO 100
        GO TO (1000,2000,3000,4000,5000,6000,7000,8000,9000,10000,
     1 11000,12000,13000,14000,15000,16000,17000,18000,19000,20000,
     3 21000,22000,23000,24000,25000),
     8       (RI-MXJOKE)
      CALL GOTOER
        CALL BUG(7,RI)
C
C ALL VERB PROCESSORS RETURN HERE TO DECLARE FAILURE.
C
10      SVERBS=.FALSE.
        RETURN
C
C JOKE PROCESSOR.
C FIND PROPER ENTRY IN JOKES, USE IT TO SELECT STRING TO PRINT.
C
100     I=JOKES(RI-MXNOP)
        J=I/1000
        IF(J.NE.0) I=MOD(I,1000)+RND(J)
        CALL RSPEAK(I)
        RETURN
C SVERBS, PAGE 3
C
C V70-- BRIEF.  SET FLAG.
C
1000    BRIEFF=.TRUE.
        CALL RSPEAK(326)
        RETURN
C
C V71-- UNBRIEF.  CLEAR FLAG.
C
2000    BRIEFF=.FALSE.
        SUPERF=.FALSE.
        CALL RSPEAK(327)
        RETURN
C
C V72-- SUPERBRIEF.  SET FLAG.
C
3000    SUPERF=.TRUE.
        CALL RSPEAK(328)
        RETURN
C
C V73-- UNSUPERBRIEF.  CLEAR FLAG.
C
4000    SUPERF=.FALSE.
        CALL RSPEAK(329)
        RETURN
C
C V74-- VERSION.  PRINT INFO.
C
5000    CALL RSPEAK(3)
        TELFLG=.TRUE.
        RETURN
C
C V75-- SWIM.  ALWAYS A JOKE.
C
6000    I=330
        IF(AND(RFLAG(HERE),(RWATER+RFILL)).EQ.0)
     1       I=331+RND(3)
        CALL RSPEAK(I)
        RETURN
C
C V76-- GERONIMO.  IF IN BARREL, FATAL, ELSE JOKE.
C
7000    IF(HERE.EQ.MBARR) GO TO 7100
        CALL RSPEAK(334)
        RETURN
C
7100    CALL JIGSUP(335)
        RETURN
C
C V77-- SINBAD ET AL.  CHASE CYCLOPS, ELSE JOKE.
C
8000    IF((HERE.EQ.MCYCL).AND.QHERE(CYCLO,HERE)) GO TO 8100
      IF ((HERE.EQ.WHITEC2) .AND. QHERE(CYCLO,HERE)) GOTO 8200
        CALL RSPEAK(336)
        RETURN
C
 8100 CONTINUE
      CALL NEWSTA(CYCLO,337,148,0,0)
      CYCLOF2 = .FALSE.
        CYCLOF=.TRUE.
        MAGICF=.TRUE.
      RETURN

 8200 CONTINUE
      NTIMES = NTIMES + 1
      IF ( NTIMES .GE. 4) GOTO 8300
      CALL RSPEAK(625+NTIMES)
      RETURN

 8300 CONTINUE
      CALL NEWSTA(CYCLO,625,0,0,0)
      CYCLOF2 = .TRUE.
      CYCLOF = .TRUE.
        OFLAG2(CYCLO)=AND(OFLAG2(CYCLO),COMPL(FITEBT))
        RETURN
C
C V78-- WELL.  OPEN DOOR, ELSE JOKE.
C
9000    IF(RIDDLF.OR.(HERE.NE.RIDDL)) GO TO 9100
        RIDDLF=.TRUE.
        CALL RSPEAK(338)
        RETURN
C
9100    CALL RSPEAK(339)
        RETURN
C
C V79-- PRAY.  IF IN TEMP2, POOF
C
10000   IF(HERE.NE.TEMP2) GO TO 10050
        IF(MOVETO(FORE1)) GO TO 10100
10050   CALL RSPEAK(340)
        RETURN
C
10100   F=RMINFO(.TRUE.)
        RETURN
C
C V80-- TREASURE.  IF IN TEMP1, POOF
C
11000   IF(HERE.NE.TEMP1) GO TO 11050
        IF(MOVETO(TREAS)) GO TO 10100
11050   CALL RSPEAK(341)
        RETURN
C
C V81-- TEMPLE.  IF IN TREAS, POOF
C
12000   IF(HERE.NE.TREAS) GO TO 12050
        IF(MOVETO(TEMP1)) GO TO 10100
12050   CALL RSPEAK(341)
        RETURN
C
C V82-- BLAST.  USUALLY A JOKE.
C
13000   I=342
        IF(PRSO.EQ.SAFE) I=252
        CALL RSPEAK(I)
        RETURN
C
C V83-- SCORE.  PRINT SCORE.
C
14000   CALL SCORE(.FALSE.)
        RETURN
C
C V84-- QUIT.  FINISH OUT THE GAME.
C
15000   CALL SCORE(.TRUE.)
        IF(.NOT.YESNO(343,0,0)) RETURN
C     CLOSE (DBCH,DISP=KEEP)
        CALL EXIT
C SVERBS, PAGE 4
C
C V85-- LOOK UNDER.  WORKS ONLY FOR RUG, LEAVES.
C
16000   IF((PRSO.EQ.RUG).AND.(ORAND(PRSO).EQ.0).AND.
     1       .NOT.QOPEN(DOOR)) GO TO 16100
        IF((PRSO.NE.LEAVE).OR.(RVCLR.NE.0)) GO TO 10
        CALL RSPEAK(344)
        RETURN
C
16100   CALL RSPEAK(345)
        RETURN
C
C V86-- HELLO.  MANY NUANCES.
C
17000   continue
        IF(PRSO.NE.0) GO TO 17100
        CALL RSPEAK(346+RND(4))
        RETURN
C
17100   IF(PRSO.NE.AVIAT) GO TO 17200
        CALL RSPEAK(350)
        RETURN
C
17200   IF(PRSO.NE.SAILO) GO TO 17300
        HS=HS+1
        I=351
        IF(MOD(HS,10).EQ.0) I=352
        IF(MOD(HS,20).EQ.0) I=353
        CALL RSPEAK(I)
        RETURN
C
17300   I=354
        IF(AND(OFLAG2(PRSO),VILLBT).EQ.0) I=355
        CALL RSPSUB(I,ODO2)
        RETURN
C
C V87-- RING.  A JOKE.
C
18000   I=359
        IF(PRSO.EQ.BELL) I=360
        CALL RSPEAK(I)
        RETURN
C
C V88-- BRUSH.  JOKE WITH OBSCURE TRAP.
C
19000   IF(PRSO.EQ.TEETH) GO TO 19100
        CALL RSPEAK(362)
        RETURN
C
19100   IF(PRSI.NE.0) GO TO 19200
        CALL RSPEAK(363)
        RETURN
C
19200   IF((PRSI.EQ.PUTTY).AND.(OADV(PUTTY).EQ.WINNER))
     1       GO TO 19300
        CALL RSPSUB(364,ODI2)
        RETURN
C
19300   CALL JIGSUP(365)
        RETURN
C SVERBS, PAGE 5
C
C V89-- DIG.  UNLESS SHOVEL, A JOKE.
C
20000   IF(PRSO.EQ.SHOVE) RETURN
        I=392
        IF(AND(OFLAG1(PRSO),TOOLBT).EQ.0) I=393
        CALL RSPSUB(I,ODO2)
        RETURN
C
C V90-- TIME.  PRINT OUT DURATION OF GAME.
C
21000 CONTINUE
      WRITE(OUTCH,21005)
*      print *, "runwt=", runwt, ", accwt=", accwt
      playtm = walltm() - runwt + accwt
      days = int( playtm / ( 24*60*60 ) )
      hours = mod( ( playtm / (60*60) ) , 24 )
      mins = mod( ( playtm / 60 ) , 60 )
      secs = mod( playtm , 60 )

* Format TIME for humans, and replace last ", " with " and ".

      tm = ""
      tmc = 1
      call tmh( tm, tmc, days, " day" )
      call tmh( tm, tmc, hours, " hour" )
      call tmh( tm, tmc, mins, " minute" )
      call tmh( tm, tmc, secs, " second" )
      tmc = tmc - 2
      tm(tmc:tmc+2) = ""
      le = tmc - 1
      do 21001 i = le, 1, -1
         if ( tm(i:i) .eq. "," ) then
            tmp = tm(i+1:le)
            tm(i:i+3) = " and"
            tm(i+4:le+3) = tmp(1:le-i)
            tmc = tmc + 3
            goto 21002
         endif
21001  continue
21002  continue
       write( outch, 21006 ) tm(1:tmc-1)
21006  format("In any case, your Qork-time for this game amounts to appr
     +oximately",/, a,"." )
      TELFLG=.TRUE.
      RETURN
C
21005 FORMAT('Time is an abstraction of the human mind which has no mean
     +ing here.')
C
C V91-- LEAP.  USUALLY A JOKE, WITH A CATCH.
C
22000   IF(PRSO.EQ.0) GO TO 22200
        IF(QHERE(PRSO,HERE)) GO TO 22100
        CALL RSPEAK(447)
        RETURN
C
22100   IF(AND(OFLAG2(PRSO),VILLBT).EQ.0) GO TO 22300
        CALL RSPSUB(448,ODO2)
        RETURN
C
22200   IF(.NOT.FINDXT(XDOWN,HERE)) GO TO 22300
        IF(XTYPE.EQ.XNO) GO TO 22400
        IF(XTYPE.NE.XCOND) GO TO 22300
        IF(.NOT.FLAGS(XFLAG)) GO TO 22400
22300   CALL RSPEAK(314+RND(5))
        RETURN
C
22400   CALL JIGSUP(449+RND(4))
        RETURN
C SVERBS, PAGE 6
C
C V92-- LOCK.
C
23000   IF((PRSO.EQ.GRATE).AND.(HERE.EQ.MGRAT))
     1       GO TO 23200
23100   CALL RSPEAK(464)
        RETURN
C
23200   GRUNLF=.FALSE.
        CALL RSPEAK(214)
        TRAVEL(REXIT(HERE)+1)=214
        RETURN
C
C V93-- UNLOCK
C
24000   IF((PRSO.NE.GRATE).OR.(HERE.NE.MGRAT))
     1       GO TO 23100
        IF(PRSI.EQ.KEYS) GO TO 24200
        CALL RSPSUB(465,ODI2)
        RETURN
C
24200   GRUNLF=.TRUE.
        CALL RSPEAK(217)
        TRAVEL(REXIT(HERE)+1)=217
        RETURN
C
C V94-- DIAGNOSE.
C
25000   I=FIGHTS(WINNER,.FALSE.)
        J=ASTREN(WINNER)
        K=MIN0(I+J,4)
        IF(.NOT.CFLAG(CEVCUR)) J=0
        L=MIN0(4,IABS(J))
        CALL RSPEAK(473+L)
        I=(30*(-J-1))+CTICK(CEVCUR)
        IF(J.NE.0) WRITE(OUTCH,25100) I
25100   FORMAT('You will be cured after ',I3,' moves.')
        CALL RSPEAK(478+K)
        IF(DEATHS.NE.0) CALL RSPEAK(482+DEATHS)
        RETURN
C
        END
        LOGICAL FUNCTION TROLLP(ARG)
        implicit integer (A-Z)
C TROLLP-       TROLL FUNCTION
C
C DECLARATIONS
C
        LOGICAL 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(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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,ECHOBT,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
        COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT
        COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE
        COMMON /OINDEX/ ROBOT,LUNGS,SAILO,AVIAT,TEETH
        COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,STAFF,SPIDER,TAPEST,WEB
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
        COMMON /VINDEX/ TAKEW,INVENW,FILLW,EATW,DRINKW,BURNW
        COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW
        COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW
        COMMON /VINDEX/ DIGW,LEAPW
C
C FLAGS
C
        LOGICAL FLAGS(35)
        LOGICAL TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
        LOGICAL DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
        LOGICAL MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
        LOGICAL EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
        LOGICAL GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
        LOGICAL GLACMF,FROBZF,ENDGMF,CYCLOF2,BUGF
        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,CYCLOF2,BUGF
        COMMON /FINDEX/ BTIEF,BINFF
        EQUIVALENCE (FLAGS(1),TROLLF)
C TROLLP, PAGE 2
C
        TROLLP=.TRUE.
        IF(PRSA.NE.FIGHTW) GO TO 1100
        IF(OCAN(AXE).EQ.TROLL) GO TO 10
        I=433
        IF(.NOT.QHERE(AXE,HERE)) GO TO 1050
        I=434
        CALL NEWSTA(AXE,0,0,TROLL,0)
1050    IF(QHERE(TROLL,HERE)) CALL RSPEAK(I)
        RETURN
C
1100    IF(PRSA.NE.DEADXW) GO TO 1200
        TROLLF=.TRUE.
        RETURN
C
1200    IF(PRSA.NE.OUTXW) GO TO 1300
        TROLLF=.TRUE.
        OFLAG1(AXE)=AND(OFLAG1(AXE),COMPL(VISIBT))
        ODESC1(TROLL)=435
        RETURN
C
1300    IF(PRSA.NE.INXW) GO TO 1400
        TROLLF=.FALSE.
        OFLAG1(AXE)=OR(OFLAG1(AXE),VISIBT)
        ODESC1(TROLL)=436
        IF(QHERE(TROLL,HERE)) CALL RSPEAK(437)
        RETURN
C
1400    IF(PRSA.NE.FRSTQW) GO TO 1500
        TROLLP=(RND(100).LT.33)
        RETURN
C
1500    IF((PRSA.NE.MOVEW).AND.(PRSA.NE.TAKEW).AND.(PRSA.NE.MUNGW)
     1       .AND.(PRSA.NE.THROWW).AND.(PRSA.NE.GIVEW)) GO TO 10
        IF(OCAPAC(TROLL).GE.0) GO TO 1550
        OCAPAC(TROLL)=-OCAPAC(TROLL)
        OFLAG1(AXE)=OR(OFLAG1(AXE),VISIBT)
        TROLLF=.FALSE.
        ODESC1(TROLL)=436
        CALL RSPEAK(437)
C
1550    IF((PRSA.NE.TAKEW).AND.(PRSA.NE.MOVEW)) GO TO 1600
        CALL RSPEAK(438)
        RETURN
C
1600    IF(PRSA.NE.MUNGW) GO TO 1700
        CALL RSPEAK(439)
        RETURN
C
1700    IF(PRSO.EQ.0) GO TO 10
        I=440
        IF(PRSA.EQ.GIVEW) I=441
        CALL RSPSUB(I,ODESC2(PRSO))
        IF(PRSO.EQ.KNIFE) GO TO 1900
        CALL NEWSTA(PRSO,442,0,0,0)
        RETURN
C
1900    CALL RSPEAK(443)
        OFLAG2(TROLL)=OR(OFLAG2(TROLL),FITEBT)
        RETURN
C
10      TROLLP=.FALSE.
        RETURN
        END
        LOGICAL FUNCTION CYCLOP(ARG)
        implicit integer (A-Z)
C CYCLOP-      CYCLOPS FUNCTION
C
C DECLARATIONS
C
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
        COMMON /RVARS/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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,ECHOBT,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
        COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT
        COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE
        COMMON /OINDEX/ ROBOT,LUNGS,SAILO,AVIAT,TEETH
        COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,STAFF,SPIDER,TAPEST,WEB
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
        COMMON /VINDEX/ TAKEW,INVENW,FILLW,EATW,DRINKW,BURNW
        COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW
        COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW
        COMMON /VINDEX/ DIGW,LEAPW
C
C FLAGS
C
        LOGICAL FLAGS(35)
        LOGICAL TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
        LOGICAL DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
        LOGICAL MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
        LOGICAL EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
        LOGICAL GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
        LOGICAL GLACMF,FROBZF,ENDGMF,CYCLOF2,BUGF
        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,CYCLOF2,BUGF
        COMMON /FINDEX/ BTIEF,BINFF
        EQUIVALENCE (FLAGS(1),TROLLF)
C CYCLOP, PAGE 2
C
        CYCLOP=.TRUE.
        IF(.NOT.CYCLOF) GO TO 100
      IF(.NOT. CYCLOF2) GOTO 100
        IF((PRSA.NE.ALARMW).AND.(PRSA.NE.MUNGW).AND.
     1       (PRSA.NE.BURNW).AND.(PRSA.NE.FIGHTW)) GO TO 10
        CYCLOF=.FALSE.
      CYCLOF2=.FALSE.
        CALL RSPEAK(187)
        RVCYC=IABS(RVCYC)
        OFLAG2(CYCLO)=AND(OR(OFLAG2(CYCLO),FITEBT),COMPL(SLEPBT))
        RETURN
C
100     IF((PRSA.EQ.FIGHTW).OR.(PRSA.EQ.FRSTQW)) GO TO 10
        IF(IABS(RVCYC).LE.5) GO TO 200
        RVCYC=0
        CALL JIGSUP(188)
        RETURN
C
200     IF(PRSA.NE.GIVEW) GO TO 500
        IF((PRSO.NE.FOOD).OR.(RVCYC.LT.0)) GO TO 300
        CALL NEWSTA(FOOD,189,0,0,0)
        RVCYC=MIN0(-1,-RVCYC)
        RETURN
C
300     IF(PRSO.NE.WATER) GO TO 400
        IF(RVCYC.GE.0) GO TO 350
        CALL NEWSTA(PRSO,190,0,0,0)
        CYCLOF=.TRUE.
      CYCLOF2=.TRUE.
        OFLAG2(CYCLO)=AND(OR(OFLAG2(CYCLO),SLEPBT),COMPL(FITEBT))
        RETURN
C
350     CALL RSPEAK(191)
10      CYCLOP=.FALSE.
        RETURN
C
400     I=192
        IF(PRSO.EQ.GARLI) I=193
450     CALL RSPEAK(I)
        IF(RVCYC.LT.0) RVCYC=RVCYC-1
        IF(RVCYC.GE.0) RVCYC=RVCYC+1
        IF(.NOT.CYCLOF) CALL RSPEAK(193+IABS(RVCYC))
        RETURN
C
500     I=0
        IF((PRSA.EQ.THROWW).OR.(PRSA.EQ.MUNGW)) I=200+RND(2)
        IF(PRSA.EQ.TAKEW) I=202
        IF(PRSA.EQ.TIEW) I=203
        IF(I) 10,10,450
C
        END
        LOGICAL FUNCTION THIEFP(ARG)
        implicit integer (A-Z)
C THIEFP-      THIEF FUNCTION
C
C DECLARATIONS
C
        LOGICAL QHERE,PROB
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,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,WHITEC1,WHITEC2
C
C OBJECTS
C
        COMMON /OBJCTS/ OLNT,ODESC1(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
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,ECHOBT,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
        COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT
        COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE
        COMMON /OINDEX/ ROBOT,LUNGS,SAILO,AVIAT,TEETH
        COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,STAFF,SPIDER,TAPEST,WEB
C
C CLOCK INTERRUPTS
C
        LOGICAL CFLAG
        COMMON /CEVENT/ CLNT,CTICK(20),CACTIO(20),CFLAG(20)
C
        COMMON /CINDEX/ CEVCUR,CEVMNT,CEVLNT,CEVMAT,CEVCND,
     1       CEVBAL,CEVBRN,CEVFUS,CEVLED,CEVSAF,CEVVLG,
     2       CEVGNO,CEVBUC,CEVSPH,CEVEGH
C
C VILLAINS AND DEMONS
C
        LOGICAL THFFLG,SWDACT,THFACT
        COMMON /HACK/ THFPOS,THFFLG,THFACT,SWDACT
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
        COMMON /VINDEX/ TAKEW,INVENW,FILLW,EATW,DRINKW,BURNW
        COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW
        COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW
        COMMON /VINDEX/ DIGW,LEAPW
        PROB(R)=(RND(100).LT.R)
C THIEFP, PAGE 2
C
        THIEFP=.TRUE.
        IF(PRSA.NE.FIGHTW) GO TO 100
        IF(OCAN(STILL).EQ.THIEF) GO TO 10
        IF(QHERE(STILL,THFPOS)) GO TO 50
        CALL NEWSTA(THIEF,0,0,0,0)
        IF(QHERE(THIEF,HERE)) CALL RSPEAK(498)
        RETURN
C
50      CALL NEWSTA(STILL,0,0,THIEF,0)
        IF(QHERE(THIEF,HERE)) CALL RSPEAK(499)
        RETURN
C
100     IF(PRSA.NE.DEADXW) GO TO 200
        THFACT=.FALSE.
        OFLAG1(CHALI)=OR(OFLAG1(CHALI),TAKEBT)
        J=0
        DO 125 I=1,OLNT
125       IF(OADV(I).EQ.-THIEF) J=500
        CALL RSPEAK(J)
C
        J=501
        DO 150 I=1,OLNT
          IF((I.EQ.CHALI).OR.(I.EQ.THIEF).OR.(HERE.NE.TREAS)
     1       .OR. .NOT.QHERE(I,HERE)) GO TO 135
          OFLAG1(I)=OR(OFLAG1(I),VISIBT)
          CALL RSPSUB(J,ODESC2(I))
          J=502
          GO TO 150
C
135       IF(OADV(I).EQ.-THIEF) CALL NEWSTA(I,0,HERE,0,0)
150     CONTINUE
        RETURN
C
200     IF(PRSA.NE.FRSTQW) GO TO 300
        THIEFP=PROB(20)
        RETURN
C
300     IF(PRSA.NE.OUTXW) GO TO 400
        THFACT=.FALSE.
        ODESC1(THIEF)=504
        OFLAG1(STILL)=AND(OFLAG1(STILL),COMPL(VISIBT))
        OFLAG1(CHALI)=OR(OFLAG1(CHALI),TAKEBT)
        RETURN
C
400     IF(PRSA.NE.INXW) GO TO 500
        IF(QHERE(THIEF,HERE)) CALL RSPEAK(505)
        THFACT=.TRUE.
        ODESC1(THIEF)=503
        OFLAG1(STILL)=OR(OFLAG1(STILL),VISIBT)
        IF((HERE.EQ.TREAS).AND.QHERE(CHALI,HERE))
     1       OFLAG1(CHALI)=AND(OFLAG1(CHALI),COMPL(TAKEBT))
        RETURN
C
500     IF(PRSA.NE.TAKEW) GO TO 600
        CALL RSPEAK(506)
        RETURN
C
600     IF((PRSA.NE.THROWW).OR.(PRSO.NE.KNIFE).OR.
     1       (AND(OFLAG2(THIEF),FITEBT).NE.0)) GO TO 700
        IF(PROB(10)) GO TO 650
        CALL RSPEAK(507)
        OFLAG2(THIEF)=OR(OFLAG2(THIEF),FITEBT)
        RETURN
C
650     J=508
        DO 675 I=1,OLNT
          IF(OADV(I).NE.-THIEF) GO TO 675
          J=509
          CALL NEWSTA(I,0,HERE,0,0)
675     CONTINUE
        CALL NEWSTA(THIEF,J,0,0,0)
        RETURN
C
700     IF((PRSA.NE.THROWW).AND.(PRSA.NE.GIVEW).OR.
     1       (PRSO.EQ.THIEF)) GO TO 10
        IF(OCAPAC(THIEF).GE.0) GO TO 750
        OCAPAC(THIEF)=-OCAPAC(THIEF)
        THFACT=.TRUE.
        OFLAG1(STILL)=OR(OFLAG1(STILL),VISIBT)
        ODESC1(THIEF)=503
        CALL RSPEAK(510)
C
750     IF((PRSO.NE.BRICK).OR.(OCAN(FUSE).NE.BRICK).OR.
     1       (CTICK(CEVFUS).EQ.0)) GO TO 800
        CALL RSPEAK(511)
        RETURN
C
800     CALL NEWSTA(PRSO,0,0,0,-THIEF)
        CALL RSPSUB(512,ODESC2(PRSO))
        RETURN
C
10      THIEFP=.FALSE.
        RETURN
        END
      SUBROUTINE WRR( UNIT, RSPIDX )
      implicit integer ( A-Z )
      COMMON /DBRIO/ RECNUM, LRN
      DATA RECNUM, LRN/ 1, 0 /
      LRN = LRN + 1
      RSPIDX = RECNUM
      RETURN
      END
      SUBROUTINE WRI( UNIT, LINE, NUM )
      implicit integer ( A-Z )
      DIMENSION LINE(170)
      COMMON /DBRIO/ RECNUM, LRN
      WRITE( UNIT, '(A8 ,170a1)', REC=RECNUM ) LRN, LINE
      RECNUM = RECNUM + 1
      RETURN
      END
      INTEGER FUNCTION CONCAT ()
      implicit integer (A-Z)
*      CONCAT = '0000 0000 7777 7777 7777'O
      CONCAT = '0000 0000 0077 7777 7777'O
      RETURN
      END
      INTEGER FUNCTION EQUIV (A, B)
      implicit integer (A-Z)
      EQUIV = COMPL( XOR(A,B) )
      RETURN
      END




      SUBROUTINE PRS0
      implicit integer (A-Z)
      integer i, j
      LOGICAL INIT
      COMMON /PRS/INIT
      COMMON /DBRIO/ RECNUM, LRN
C INIT-- DUNGEON INITIALIZATION SUBROUTINE
C
C DECLARATIONS
C
        INTEGER LINE(170),SDIR(16),CDIR(16)
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
C
C MESSAGE INDEX
C
        COMMON /RMSG/ MLNT,RTEXT(800)
C
C MISCELLANEOUS VARIABLES
C
        COMMON /STAR/ MBASE,STRBIT
        COMMON /VERS/ VMAJ,VMIN,VEDIT
        COMMON /ZTIMES/ PLTIME,SHOUR,SMIN,SSEC
        COMMON /CHAN/ INPCH,OUTCH,DBCH
        COMMON /DEBUG/ DBGFLG,PRSFLG
C
C ROOMS
C
        COMMON /ROOMS/ RLNT,RDESC1(150),RDESC2(150),REXIT(150),
     1       RACTIO(150),RVAL(150),RFLAG(150),RRAND(150)
C
        COMMON /RVARS/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA
C
C EXITS
C
        COMMON /EXITS/ XLNT,TRAVEL(625)
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(160),ODESC2(160),ODESCO(160),
     1       OACTIO(160),OFLAG1(160),OFLAG2(160),OFVAL(160),
     2       OTVAL(160),OSIZE(160),OCAPAC(160),OROOM(160),
     3       OADV(160),OCAN(160),OREAD(160),ORAND(160)
C
        COMMON /OROOM2/ R2LNT,O2(6),R2(6)
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
        COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT
        COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE
        COMMON /OINDEX/ ROBOT,LUNGS,SAILO,AVIAT,TEETH
        COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,STAFF,SPIDER,TAPEST,WEB
C
C CLOCK INTERRUPTS
C
        LOGICAL CFLAG
        COMMON /CEVENT/ CLNT,CTICK(20),CACTIO(20),CFLAG(20)
C
C VILLAINS AND DEMONS
C
        LOGICAL THFFLG,SWDACT,THFACT
        COMMON /HACK/ THFPOS,THFFLG,THFACT,SWDACT,SWDSTA
        COMMON /VILL/ VLNT,VILLNS(5),VPROB(5),VOPPS(5)
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
C
C FLAGS
C
        LOGICAL FLAGS(35)
        LOGICAL TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
        LOGICAL DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
        LOGICAL MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
        LOGICAL EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
        LOGICAL GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
        LOGICAL GLACMF,FROBZF,ENDGMF,CYCLOF2,BUGF
        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,CYCLOF2,BUGF
        COMMON /FINDEX/ BTIEF,BINFF
        integer*8 accwt, runwt
        common /walltime/ accwt, runwt
        EQUIVALENCE (FLAGS(1),TROLLF)
        LOGICAL THERE
        DIMENSION DAT(5),TXT(5),DDAT(5),IDAT(5),IDDAT(5)

        DATA SDIR/2hN ,2hS ,2hE ,2hW ,2hSE,2hSW,2hNE,2hNW,
     1       2hU ,2hD ,2hLA,2hLN,2hEN,2hEX,2hCR,2hCL/
        DATA CDIR/'2000'O,'4000'O,'6000'O,'10000'O,'12000'O,
     1  '14000'O,'16000'O,'20000'O,'22000'O,'24000'O,'26000'O,
     2  '30000'O,'32000'O,'34000'O,'36000'O,'40000'O /
C INIT, PAGE 2
C

c ENV variable BUILD_Qork determines when to rebuild the database:
c 0 = use existing
c 1 = build a new version
      character*80 envvalue
      character*4 holl2char
      character*170, crecnum

      INIT=.FALSE.
        MMAX=800
        OMAX=160
        RMAX=150
        VMAX=5
        AMAX=4
        CMAX=20
      FMAX = 35
      XMAX=625
        R2MAX=6
        DIRMAX=16
C
        MLNT=0
        OLNT=0
        RLNT=0
        VLNT=0
        ALNT=0
        CLNT=0
        XLNT=1
        R2LNT=0
C
        LTSHFT=10
        MXSCOR=LTSHFT
        MXLOAD=100
        RWSCOR=0
        DEATHS=0
        MOVES=0
        PLTIME=0
        MUNGRM=0
        HS=0
        PRSA=0
        PRSI=0
        PRSO=0
        PRSCON=0
        OFLAG=0
        OACT=0
        OSLOT=0
        OPREP=0
        ONAME=0
        THFFLG=.FALSE.
        THFACT=.TRUE.
        SWDACT=.FALSE.
        SWDSTA=0
C
        RECNO=1
        MBASE=0
        INPCH=5
        OUTCH=6
        DBCH=2
C INIT, PAGE 3
C
C INIT ALL ARRAYS.
C
        DO 5 I=1,CMAX
          CFLAG(I)=.FALSE.
          CTICK(I)=0
          CACTIO(I)=0
5       CONTINUE
C
        DO 10 I=1,FMAX
          FLAGS(I)=.FALSE.
10      CONTINUE
        BUOYF=.TRUE.
      CYCLOF2 = .TRUE.
        EGYPTF=.TRUE.
        CAGETF=.TRUE.
        BTIEF=0
        BINFF=0
C
        DO 15 I=1,R2MAX
          R2(I)=0
          O2(I)=0
15      CONTINUE
C
        DO 20 I=1,XMAX
          TRAVEL(I)=0
20      CONTINUE
C
        DO 30 I=1,VMAX
          VOPPS(I)=0
          VPROB(I)=0
          VILLNS(I)=0
30      CONTINUE
C
C
        DO 40 I=1,OMAX
          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
          ORAND(I)=0
40      CONTINUE
C
        DO 50 I=1,RMAX
          RDESC1(I)=0
          RDESC2(I)=0
          RACTIO(I)=0
          RFLAG(I)=0
          RVAL(I)=0
          RRAND(I)=0
          REXIT(I)=0
50      CONTINUE
C
        DO 60 I=1,MMAX
          RTEXT(I)=0
60      CONTINUE
C
        DO 70 I=1,AMAX
          AROOM(I)=0
          ASCORE(I)=0
          AVEHIC(I)=0
          AOBJ(I)=0
          AACTIO(I)=0
          ASTREN(I)=0
          AFLAG(I)=0
70      CONTINUE
C
        RVMNT=0
        RVCLR=0
        RVCYC=0
        RVSND=0
        RVGUA=0
C
        DBGFLG=0
        PRSFLG=0
* Accumulated walltime playing the game.
        accwt = 0
        runwt = 0

c Initialize random number generator.
#if (! defined __GFORTRAN__ )
      ijkl = irandm( time() )
#else
      call srand( time() )
#endif

c Check Build_Qork environment variable and convert to an integer, must be 0 or 1.
        call getenv( "BUILD_Qork", envvalue)
        read(envvalue, 71) i
 71     format(i1)
        i = i + 1
c      CALL SSWTCH(1,I)

      GOTO (1600,75),I
      CALL GOTOER
*
*     IF SWITCH 1 IS OFF INITIALIZE THE DATA BASE FILE AND CREATE
*     A SAVE VERSION OF THE GAME.
*
*     IF SWITCH 1 IS ON THEN THE RANDOM DATA BASE FILE IS ALREADY
*     LOCAL AND A SAVED GAME STATE IS AROUND TO RESTORE.  ALL THIS
*     IS GUARANTEED AND IS DUE TO THE FRONT-END PROCEDURE.
*
   75 CONTINUE
        PRINT 185
 185    FORMAT('Creating new ''Qork.text.db''')
      open (unit=1, file='src/Qork.text', status='old')
      OPEN( UNIT=2, STATUS='NEW', ACCESS='DIRECT', FORM='FORMATTED',
     +      RECL=180, FILE='etc/Qork.text.db' )
      open (unit=3, file='etc/Qork.save.init', form='unformatted')
C
C RETURN HERE TO READ NEXT SECTION HEADER.
C
80      CALL READJL(I,LINE)
c      PRINT 90,I,LINE
c90     FORMAT("After readjl, i=", I3,1X,"line=",170a1,"!")
C
        IF(I.EQ.0) GO TO 80
        IF(I.LT.0) GO TO 1000
        PRINT 125,I
 125    FORMAT("Initializing section #",I4)
        IF(I.LE.8) GO TO 100
        GO TO (400,500,600,700,800,900),(I-8)
      CALL GOTOER
        CALL BUG(12,I)
C
C TEXT SECTION.  WRITE TEXT OUT TO DB FILE, NOTE INITIAL RECORD
C NUMBER IN APPROPRIATE ARRAY.
C
100     PREVJ=0
110     CALL READJL(J,LINE)
c        PRINT 91,J,LINE
c 91     format("text section j=",i2, ", line=", 170a1, "!")
        IF(J.EQ.0) GO TO 110
        IF(J.LT.0) GO TO 80
        IF(J.EQ.PREVJ) GO TO 300
        GO TO (210,220,230,240,250,260,270,280),I
      CALL GOTOER
        CALL BUG(12,I)
C
C SECTION 1-- RANDOM REMARKS.
C
210     IF(J.GT.MMAX) CALL BUG(13,J)
        IF(RTEXT(J).NE.0) CALL BUG(14,J)
          CALL   WRR(2,RTEXT(J))
        MBASE=MAX0(MBASE,J)
        GO TO 300
C
C SECTION 2-- MELEE MESSAGES
C
220     K=J+MBASE
        IF(K.GT.MMAX) CALL BUG(13,K)
        IF(RTEXT(K).NE.0) CALL BUG(14,K)
          CALL   WRR(2,RTEXT(K))
        MLNT=MAX0(MLNT,K)
        GO TO 300
C
C SECTION 3-- LONG ROOM DESCRIPTIONS
C
230     IF(J.GT.RMAX) CALL BUG(15,J)
        IF(RDESC1(J).NE.0) CALL BUG(16,J)
      CALL WRR(2,RDESC1(J))
        GO TO 300
C
C SECTION 4-- SHORT ROOM DESCRIPTIONS
C
240     IF(J.GT.RMAX) CALL BUG(17,J)
        IF(RDESC2(J).NE.0) CALL BUG(18,J)
      CALL WRR(2,RDESC2(J))
        GO TO 300
C
C SECTION 5-- LONG OBJECT DESCRIPTIONS
C
250     IF(J.GT.OMAX) CALL BUG(19,J)
        IF(ODESC1(J).NE.0) CALL BUG(20,J)
      CALL WRR(2,ODESC1(J))
        GO TO 300
C
C SECTION 6-- SHORT OBJECT DESCRIPTIONS
C
260     IF(J.GT.OMAX) CALL BUG(21,J)
        IF(ODESC2(J).NE.0) CALL BUG(22,J)
      CALL WRR(2,ODESC2(J))
        GO TO 300
C
C SECTION 7-- UNTOUCHED OBJECT DESCRIPTIONS
C
270     IF(J.GT.OMAX) CALL BUG(23,J)
        IF(ODESCO(J).NE.0) CALL BUG(24,J)
      CALL WRR(2,ODESCO(J))
        GO TO 300
C
C SECTION 8-- READING MATERIAL
C
280     IF(J.GT.OMAX) CALL BUG(25,J)
        IF(OREAD(J).NE.0) CALL BUG(26,J)
      CALL WRR(2,OREAD(J))
        GO TO 300
C
C HERE TO WRITE OUT CURRENT LINE OF TEXT.
C
  300 CONTINUE
      CALL WRI(2,LINE,170)
        PREVJ=J
        GO TO 110
C INIT, PAGE 5
C
C SECTION 9-- ROOM DATA
C
 400    continue
c        print *, "ROOM DATA"
        CALL READJL(J,LINE)
c        print 401, j, rmax, line
c 401    format("  AFTER READJL j=",i2,", rmax=",i10,", line=", 170a1)
        IF(J.LT.0) GO TO 80
        IF(J.EQ.0) GO TO 400
        IF(J.GT.RMAX) CALL BUG(28,J)
        RLNT=MAX0(RLNT,J)
C
c        print *, "before rdrmnm"
        CALL RDRMNM(RACTIO(J),RVAL(J),RFLAG(J))
c        print *, "after rdrmnm"
C425    FORMAT(2(I3,1X),O5,1X,I3)
        MXSCOR=MXSCOR+RVAL(J)
        PREVX=0
C
C HERE TO LOOP ON EXIT DESCRIPTIONS
C
405     CALL RDEXIT(DIR,XTYPE,XROOM1)
c       PRINT 415 ,DIR,XTYPE,XROOM1
c415    FORMAT(A2,2(I3,1X))
        write( holl2char, 124 ) dir
 124    format(a4)
*        IF(DIR.EQ."  ") GO TO 400
        IF( holl2char .EQ."  ") GO TO 400
        DO 410 K=1,DIRMAX
          IF(DIR.EQ.SDIR(K)) GO TO 420
410     CONTINUE
        CALL BUG(29,DIR)
C
C HAVE TRANSLATED DIRECTION, VALIDATE OTHER FIELDS.
C
420     IF((XTYPE.LE.0).OR.(XTYPE.GT.(XFMASK+1))) CALL BUG(30,XTYPE)
        IF(XROOM1.GT.RMAX) CALL BUG(31,XROOM1)
        IF(REXIT(J).EQ.0) REXIT(J)=XLNT
        IF((XLNT+XELNT(XTYPE)).GT.XMAX) CALL BUG(32,XLNT)
        TRAVEL(XLNT)=-(CDIR(K)+((XTYPE-1)*XFSHFT)+XROOM1+XLFLAG)
        IF(PREVX.NE.0) TRAVEL(PREVX)=(TRAVEL(PREVX)+XLFLAG)
        GO TO (480,470,460,450),XTYPE
      CALL GOTOER
        CALL BUG(30,XTYPE)
C
C DOOR ENTRY-- READ OBJECT,APPLICABLE,STRING
C
450     CALL RDOAL(XOBJ,XACTIO,LINE)
C455    FORMAT(2(I3,1X),78A1)
        IF((XOBJ.LE.0).OR.(XOBJ.GT.OMAX)) CALL BUG(34,XOBJ)
        GO TO 468
C
C CONDITIONAL EXIT ENTRY-- READ FLAG,APPLICABLE,STRING
C
460     CALL RDOAL(XOBJ,XACTIO,LINE)
C465    FORMAT(2(I3,1X),78A1)
        IF((XOBJ.LE.0).OR.(XOBJ.GT.FMAX)) CALL BUG(35,XOBJ)
468     TRAVEL(XLNT+2)=-((XACTIO*XASHFT)+XOBJ)
        GO TO 478
C
C NO EXIT ENTRY-- READ STRING
C
470     READ(1,475,END=  478) LINE
475     FORMAT(BZ,170a1)
*  478 IF(LINE(1) .EQ. " ")GOTO 480
 478    continue
        write( holl2char, 124 ) line(1)
        IF(holl2char .EQ. " ")GOTO 480
      IFROG = XLNT+1
      CALL WRR(2,TRAVEL(IFROG))
      CALL WRI(2,LINE,170)
C
C COMMON PROCESSING, ADVANCE OVER ENTRY.
C
480     PREVX=XLNT
        XLNT=XLNT+XELNT(XTYPE)
        GO TO 405
C INIT, PAGE 6
C SECTION 11-- GLOBAL OBJECTS
C SECTION 10-- NORMAL OBJECTS
C
  600 CALL READJL(J,LINE)
      STRBIT = J
      GOTO 505
500     CALL READJL(J,LINE)
  505 IF (J .LT. 0) GOTO 80
        IF(J.EQ.0) GO TO 500
        IF(J.GT.OMAX) CALL BUG(27,J)
        OLNT=MAX0(OLNT,J)
C
        CALL RDOBJS(OROOM(J),K,OCAN(J),OACTIO(J),OFLAG1(J),
     1       OFLAG2(J),OFVAL(J),OTVAL(J),OSIZE(J),OCAPAC(J),
     2       ORAND(J))
C560    FORMAT(4(I8,1X),2(O8,1X),5(I8,1X))
C
        MXSCOR=MXSCOR+OFVAL(J)+OTVAL(J)
C
        IF(K.EQ.0) GO TO 500
        R2LNT=R2LNT+1
        IF(R2LNT.GT.R2MAX) CALL BUG(33,R2LNT)
        O2(R2LNT)=J
        R2(R2LNT)=K
        GO TO 500
C
C SECTION 12-- VILLAINS
C
700     CALL READJL(J,LINE)
        IF(J.LT.0) GO TO 80
        IF(J.EQ.0) GO TO 700
        VLNT=VLNT+1
        IF(VLNT.GT.VMAX) CALL BUG(36,VLNT)
        VILLNS(VLNT)=J
        GO TO 700
C
C SECTION 13-- CLOCK EVENTS
C
800     CALL READJL(J,LINE)
        IF(J.LT.0) GO TO 80
        IF(J.EQ.0) GO TO 800
        IF(J.GT.CMAX) CALL BUG(37,J)
        CLNT=MAX0(CLNT,J)
C
        CALL RDCLOK(CACTIO(J),CTICK(J),CFLAG(J))
C890    FORMAT(2(I3,1X),L1)
        GO TO 800
C
C SECTION 14-- ADVENTURERS
C
900     CALL READJL(J,LINE)
        IF(J.LT.0) GO TO 80
        IF(J.EQ.0) GO TO 900
        IF(J.GT.AMAX) CALL BUG(38,J)
        ALNT=MAX0(ALNT,J)
C
        CALL RDADVS(AROOM(J),AOBJ(J),AACTIO(J),ASTREN(J))
C990    FORMAT(4(I3,1X))
        GO TO 900
C INIT, PAGE 7
C
C INITIALIZATION IS COMPLETE.
C WRITE OUT NEW INDEX FILE FOR NEXT TIME AROUND.
C
1000  CONTINUE
      CALL WRR( 2, IDUMMY )
      CALL WRI( 2, "Z", 170 )
C
        WINNER=PLAYER
        THFPOS=OROOM(THIEF)
        BLOC=OROOM(BALLO)
        HERE=AROOM(WINNER)
        LASTIT=AOBJ(PLAYER)
        INIT=.TRUE.
        write( crecnum, "(a,i7)" ), "MAXRECNUM=", recnum
*        print *, "crecnum=",crecnum
        WRITE( 2, '(A8 ,a)', REC=RECNUM ) lrn, crecnum
C
        PRINT 1050,RLNT,RMAX,XLNT,XMAX,OLNT,OMAX,MLNT,MMAX,
     +         VLNT,VMAX,ALNT,AMAX,CLNT,CMAX,R2LNT,R2MAX
 1050   FORMAT('Used:'/1x,I5,' of',I5,' rooms'/
     +  1X,I5,' of',I5,' exits'/
     +  1X,I5,' of',I5,' objects'/
     +  1X,I5,' of',I5,' messages'/
     +  1X,I5,' of',I5,' villains'/
     +  1X,I5,' of',I5,' adventurers'/
     +  1X,I5,' of',I5,' clock events'/
     +  1X,I5,' of',I5,' room2 slots')
        PRINT 1150,MXSCOR,RECNUM,MBASE,STRBIT
 1150   FORMAT('Max score   =',I5/'Max recno   =',I5/
     +   'Melee start =',I5/'Star mask   =',I5)
C
C     COMPLEMENT APPROPRIATE ARRAYS TO INDICATE TO *RSPEAK* THAT
C     WE HAVE AN ACTUAL DISK ADDRESS (RSA) FOR HIM.  POSITIVE
C     NUMBERS INDICATE AN ACTUAL MESSAGE NUMBER...
C
      DO 1501 I = 1, MMAX
 1501 RTEXT(I) = - RTEXT(I)
      DO 1502 I = 1, RMAX
      RDESC1(I) = - RDESC1(I)
 1502 RDESC2(I) = - RDESC2(I)
      DO 1503 I = 1, OMAX
      ODESC1(I) = - ODESC1(I)
      ODESC2(I) = - ODESC2(I)
      ODESCO(I) = - ODESCO(I)
 1503 OREAD(I) = - OREAD(I)
      DO 1504 I = 1, XMAX
      IF(TRAVEL(I) .EQ. 0) GOTO 1504
      TRAVEL(I) = - TRAVEL(I)
 1504 CONTINUE
C
      print 126
 126  format("Creating new 'Qork.save.init'")
      CALL SAVEGM( 0 )
      CLOSE( UNIT=2, STATUS='KEEP', IOSTAT=IIOS )
      CALL EXIT
C
 1600 CONTINUE
      OPEN( UNIT=2, STATUS='OLD', ACCESS='DIRECT', FORM='FORMATTED',
     +      RECL=180, FILE='Qork.text.db' )
      open (unit=3, file='Qork.save', form='unformatted',status='old')
      CALL RSTRGM
      INIT = .TRUE.

* DEBUG - move poison flask and tube of viscous material to front of house.
*      OROOM(132)  = 2
*      oroom(54) = 2

        RETURN
C
        END




      INTEGER FUNCTION NUMBR(IN,I,BASE)
      INTEGER IN(172),I,BASE
      INTEGER COMMA, BLANK
      INTEGER NUMS(10)
      DATA NUMS/1h0,1h1,1h2,1h3,1h4,1h5,1h6,1h7,1h8,1h9/
      DATA COMMA,BLANK/1h, ,1h /
      NUMBR=0
      IF (I.GT.172) RETURN
      DO 10 I=I,172
10    IF (IN(I).NE.BLANK) GO TO 20
      RETURN
20    DO 40 I=I,172
      J=IN(I)
      DO 30 K=1,10
30    IF (J.EQ.NUMS(K)) GO TO 40
      GO TO 50
40    NUMBR=NUMBR*BASE+K-1
50    DO 60 I=I,172
60    IF (IN(I).EQ.COMMA) GO TO 70
70    I=I+1
      RETURN
      END
      SUBROUTINE READJL(J,LINE)
      INTEGER J,LINE(170)
      INTEGER IN(172)
      INTEGER BLANK, MINUS
      DATA BLANK, MINUS/1h , 1h-/
      READ(1,99,END=10000)IN
c      print 98, in(1),in
c 98   format("in readjl, in(1)=", a1, ", in=", 172a1,"!")
99    FORMAT(BZ,172a1)
10000 IF (IN(1).NE.MINUS) GO TO 10
      J=-1
      RETURN
10    I=1
      J=NUMBR(IN,I,10)
c      print *, "number j=", j
      DO 20 K=1,170
20    LINE(K)=BLANK
      IF (I.GT.172) RETURN
      K=0
c      print *, "transfer in to line"
      DO 30 I=I,172
      K=K+1
      IF (K.GT.170) RETURN
c      print *, "k=",k, ", i=",i
30    LINE(K)=IN(I)
c      print 33, j, line
c 33   format("before return j=",i2, ",  line=", 170a1)
      RETURN
      END
      SUBROUTINE RDRMNM(RACT,RVAL,RFLG)
      INTEGER RACT,RVAL,RFLG
      INTEGER IN(172)
      INTEGER NUMBR
      READ(1,99,END=10000)IN
99    FORMAT(BZ,172a1)
10000 I=1
      RACT=NUMBR(IN(1),I,10)
      RVAL=NUMBR(IN(1),I,10)
      RFLG=NUMBR(IN(1),I,8)
      RETURN
      END
      SUBROUTINE RDEXIT(DIR,XTYPE,XROOM1)
      INTEGER DIR,XTYPE,XROOM1
      INTEGER IN(172)
      INTEGER BLANK
      INTEGER NUMBR
      DATA BLANK /1h /
      READ(1,99,END=10000)DIR,(IN(I),I=1,170)
99    FORMAT(BZ,A2,170a1)
10000 IN(171)=BLANK
      IN(172)=BLANK
      I=1
      XTYPE =NUMBR(IN(1),I,10)
      XROOM1=NUMBR(IN(1),I,10)
      RETURN
      END
      SUBROUTINE RDOAL(XOBJ,XACTIO,LINE)
      INTEGER XOBJ,XACTIO,LINE(170)
      INTEGER IN(172)
      INTEGER BLANK
      DATA BLANK/1h /
      READ(1,99,END=10000)IN
99    FORMAT(BZ,172a1)
10000 DO 10 I=1,170
10    LINE(I)=BLANK
      I=1
      XOBJ=NUMBR(IN,I,10)
      XACTIO=NUMBR(IN,I,10)
      IF (I.GT.172) RETURN
      J=0
      DO 20 I=I,172
      J=J+1
20    LINE(J)=IN(I)
      RETURN
      END
      SUBROUTINE RDOBJS(A,B,C,D,O,P,V,W,X,Y,Z)
      INTEGER A,B,C,D,O,P,V,W,X,Y,Z
      INTEGER IN(172)
      READ(1,99,END=10000)IN
99    FORMAT(BZ,172a1)
10000 I=1
      A=NUMBR(IN,I,10)
      B=NUMBR(IN,I,10)
      C=NUMBR(IN,I,10)
      D=NUMBR(IN,I,10)
      O=NUMBR(IN,I,8)
      P=NUMBR(IN,I,8)
      V=NUMBR(IN,I,10)
      W=NUMBR(IN,I,10)
      X=NUMBR(IN,I,10)
      Y=NUMBR(IN,I,10)
      Z=NUMBR(IN,I,10)
      RETURN
      END
      SUBROUTINE RDCLOK(CACTIO,CTICK,CFLAG)
      INTEGER CACTIO,CTICK
      LOGICAL CFLAG
      INTEGER IN(172)
      INTEGER BLANK, TRUE
      DATA BLANK, TRUE/1h , 1hT/
      READ(1,99,END=10000)IN
99    FORMAT(BZ,172a1)
10000 I=1
      CACTIO=NUMBR(IN,I,10)
      CTICK =NUMBR(IN,I,10)
      CFLAG=.FALSE.
      IF (I.GT.172) RETURN
      DO 10 I=I,172
10    IF (IN(I).NE.BLANK) GO TO 20
      RETURN
20    IF (IN(I).EQ.TRUE) CFLAG=.TRUE.
      RETURN
      END
      SUBROUTINE RDADVS(AROOM,AOBJ,AACTIO,ASTREN)
      INTEGER AROOM,AOBJ,AACTIO,ASTREN
      INTEGER IN(172)
      READ(1,99,END=10000)IN
99    FORMAT(BZ,172a1)
10000 I=1
      AROOM =NUMBR(IN,I,10)
      AOBJ=NUMBR(IN,I,10)
      AACTIO=NUMBR(IN,I,10)
      ASTREN=NUMBR(IN,I,10)
      RETURN
      END
      



      subroutine gotoer
      print *, "computed goto error"
      return
      end
      



      subroutine qdate( qd )

c     Return current date/time as character*19 '2015.04.01-01:02:03'

      implicit integer (a-z)
      character*24 fd
      character*19 qd
      character*2 mm, montht(12), dd
      character*3 monthf(12)
      data monthf/'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
     1            'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'/
      data montht/'01',  '02',  '03',  '04',  '05',  '06',
     1            '07',  '08',  '09',  '10',  '11',  '12'/

      call fdate(fd)

      mm = '??'
      do 100 i = 1, 12
         if( monthf(i) .eq. fd(5:7) ) mm = montht(i)
 2       format(bz,i2)
 100  continue

      dd = '??'
      dd = fd(9:10)
      if ( dd(1:1) .eq. ' ' ) then
         dd = '0' // dd(2:2)
      endif

      qd = fd(21:24) // '.' // mm // '.' // dd // '-' //
     1   fd(12:19)

      end




#if defined(__INTEL_COMPILER) || (defined __GFORTRAN__)
      integer function compl (in)
      compl = not( in)
      return
      end
#elif defined (__PGI_COMPILER)
#else
#error FORTRAN Compiler not defined
#endif




*          IDENT  RIO                                                    095960
*          SYSCOM             DEFINE RA. SYMBOLS                         000120
*          ENTRY  CLOSE       CLOSE RANDOM DATA BASE FILE                095970
*          ENTRY  RDR         READ RANDOM RECORD FROM DATA BASE          095980
*          ENTRY  OPEN        OPEN RANDOM DATA BASE FILE                 095990
*          ENTRY  WRR         WRITE EOR AND SET ADDRESS OF INDEX         096000
*          ENTRY  WRI         WRITE DATA TO RANDOM DATA BASE FILE        096010
*          ENTRY  RNL         READ NEXT LINE FROM DATA BASE              096020
*096030    
* TAPE2    RFILEC BUF,101B,FET=15                                        096040
* CLOSE    BSS    1           CALL CLOSE(UNIT)                           096050
*          SX6    0                                                      096060
*          EQ     COM                                                    096070
* OPEN     BSS    1           CALL OPEN(UNIT)                            096080
*          SX6    1                                                      096090
*          EQ     COM                                                    096100
* WRR      BSS    1           CALL WRR(UNIT,INDEX ADDRESS)               096110
*          SX6    2                                                      096120
*          EQ     COM                                                    096130
* WRI      BSS    1           CALL WRI(UNIT,FWA,LEN)                     096140
*          SX6    3                                                      096150
*          EQ     COM                                                    096160
* RDR      BSS    1           CALL RDR(UNIT,FWA,LEN,PRU,EOF)             096170
*          SX6    4                                                      096180
*          EQ     COM                                                    096190
* RNL      BSS    1           CALL RNL(UNIT,FWA,LEN,EOF)                 096200
*          SX6    5                                                      096210
*          EQ     COM                                                    096220
*096230    
* COM      SA6    SAVO        SAVE ORDINAL                               096240
*          SB1    1                                                      096250
*          SX6    A1                                                     096260
*          SA6    ARGP                                                   096270
*          RECALL TAPE2                                                  096280
*          SA1    SAVO                                                   096290
*          SB7    X1                                                     096300
*          JP     TBL+B7                                                 096310
*096320    
* TBL      EQ     CLOP                                                   096330
*          EQ     OPEP                                                   096340
*          EQ     WRRP                                                   096350
*          EQ     WRIP                                                   096360
*          EQ     RDRP                                                   096370
*          EQ     RNLP                                                   096380
*096390    
* CLOP     BSS    0                                                      096400
*          WRITER TAPE2,RCL
*          EQ     CLOSE                                                  096420
* OPEP     OPEN   TAPE2,WRITE,R                                          096430
*          SA1    TAPE2+1
*          MX0    -1
*          LX0    47-0
*          BX6    -X0+X1      SET RANDOM BIT
*          SA6    A1
*          EQ     OPEN                                                   096440
* WRRP     BSS    0                                                      096450
*          WRITER TAPE2,RCL
*          SA1    TAPE2+1                                                096470
*          SX6    X1                                                     096480
*          SA6    A1+B1                                                  096490
*          SA6    A6+B1       EMPTY BUFFER                               096500
*          SA1    ARGP                                                   096510
*          SA1    X1+B1                                                  096520
*          BX6    X1                                                     096530
*          SA6    TAPE2+6     SET ADDRESS FOR RETURN OF RSA              096540
*          EQ     WRR                                                    096550
* WRIP     SA4    ARGP                                                   096560
*          SA3    X4+B1                                                  096570
*          SA5    X4+2                                                   096580
*          SA5    X5                                                     096590
*          WRITES TAPE2,X3,X5                                            096600
*          EQ     WRI                                                    096610
* RDRP     SA1    ARGP                                                   096620
*          SA2    X1+B1       (X2) = ADDR OF FWA                         096630
*          SA3    A2+B1       (X3) = ADDR OF LEN                         096640
*          SA4    A3+B1       (X4) = ADDR OF RECORD NUMBER               096650
*          SA4    X4          (X4) = RECORD NUMBER                       096660
*          BX6    X4                                                     096670
*          SA6    TAPE2+6     SET RANDOM ADDRESS IN FET                  096680
*          SA1    TAPE2+1                                                096690
*          SX6    X1                                                     096700
*          SA6    A1+B1       IN = FIRST                                 096710
*          SA6    A6+B1       OUT = FIRST                                096720
*          READ   TAPE2,R                                                096730
*          SA1    ARGP                                                   096740
*          SA2    X1+B1       (X2) ADDR OF FWA                           096750
*          SA3    A2+B1       (X3) = ADDR OF LEN                         096760
*          SA3    X3          (X3) = NUMBER OF CAHRS                     096770
*          READS  TAPE2,X2,X3                                            096780
*      SA2 ARGP                                                          096790
*          SA2 X2+4   (X2) = ADDR OF IEOF                                096800
*          BX6 X1                                                        096810
*          SA6 X2     RETURN STATUS OF READ (EOF)                        096820
*          EQ     RDR                                                    096830
* RNLP     SA1    ARGP        (X1) = ADDR OF UNIT NUMBER                 096840
*          SA2    X1+B1       (X2) = ADDR OF ARRAY                       096850
*          SA3    A2+B1       (X3) = ADDR OF LEN                         096860
*          SA3    X3          (X3) = LEN                                 096870
*          READS  TAPE2,X2,X3 READ NEXT LINE                             096880
*          SA2    ARGP                                                   096890
*          SA2    X2+3        (X2) = ADDR OF IEOF                        096900
*          BX6    X1                                                     096910
*          SA6    X2                                                     096920
*          EQ     RNL                                                    096930
* BUF      BSS    101B                                                   096940
* SAVO     BSS    1                                                      096950
* ARGP     BSS    1                                                      096960
* COMCLIB  XTEXT  COMCRDS                                                096970
* COMCLIB  XTEXT  COMCWTS                                                096980
* COMCLIB  XTEXT  COMCRDW                                                096990
* COMCLIB  XTEXT  COMCWTW                                                097000
*          END                                                           097010
*          IDENT  CONCAT                                                 097020
*          ENTRY  CONCAT                                                 097030
* CONCAT   BSS    1                                                      097040
*      MX6 24                                                            097050
*      BX6 -X6                                                           097060
*          EQ     CONCAT                                                 097070
*          END                                                           097080
