C Parser for DUNGEON
C
C COPYRIGHT 1980, 1990, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA.
C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
C WRITTEN BY R. M. SUPNIK
C
C 29-Sep-94     RMS     Fixed bugs in PLAY WITH, ALL BUT, GWIM, THISIT, IT.
C                       Fixed vocabularly for ROCK, LIGHT, GATES, STACK,
C                       BLIND.  Added COUNT, PERUSE, BLESSING, GHOSTS,
C                       SPIRITS, CLIFFS, CORPSES, OUTPUT, CHIMNEY,
C                       ZORKMID adjective, DIGBT flag.
C 30-Jan-94     RMS     Fixed bug in error message.
C 30-Jun-92     RMS     Changed file names to lower case.
C 29-Jun-92     RMS     Removed extraneous declaration from SPARSE.
C                       Added dummy argument to SYNMCH.
C
C RDLINE-       Read input line
C
C Declarations
C
      SUBROUTINE RDLINE(INLINE,INLEN,WHO)
      IMPLICIT INTEGER(A-Z)
      INCLUDE 'dparam.for'
      CHARACTER*(TEXLNT) INLINE
C
      LUCVT=ICHAR('A')-ICHAR('a')               ! case conversion factor.
5     GO TO (90,10),WHO+1                       ! see who to prompt for.
10    WRITE(OUTCH,50)                           ! prompt for game.
50    FORMAT(' >',$)
C
90    READ(INPCH,100,END=5) INLINE              ! get input.
100   FORMAT(A)
C
      INLEN=NBLEN(INLINE)                       ! len w/o trailing blanks.
      IF(INLEN.LE.0) GO TO 5                    ! anything left?
      DO 400 I=1,INLEN                          ! convert to upper case.
        IF((INLINE(I:I).GE.'a').AND.(INLINE(I:I).LE.'z'))
     1INLINE(I:I)=CHAR(ICHAR(INLINE(I:I))+LUCVT)
400   CONTINUE
      PRSCON=1                                  ! restart lex scan.
      RETURN
      END

C PARSE-        Top level parse routine
C
C Declarations
C
C This routine details on bit 0 of PRSFLG
C
      LOGICAL FUNCTION PARSE(INLINE,INLEN,VBFLAG)
      IMPLICIT INTEGER(A-Z)
      INCLUDE 'dparam.for'
      CHARACTER*(TEXLNT) INLINE
      CHARACTER*(WRDLNT) OUTBUF(LEXMAX),BAKBUF(LEXMAX)
      LOGICAL LEX,SYNMCH,DFLAG,VBFLAG
      SAVE BAKBUF,BAKLEN
      DATA BAKBUF(1)/'L'/,BAKLEN/1/
C
      DFLAG=(PRSFLG.AND.1).NE.0
      PARSE=.FALSE.                             ! assume fails.
      PRSA=0                                    ! zero outputs.
      PRSI=0
      PRSO=0
C
      IF(.NOT.LEX(INLINE,INLEN,OUTBUF,OUTLEN,VBFLAG)) GO TO 1000
      IF((OUTLEN.NE.1).OR.(OUTBUF(1).NE.'AGAIN')) GO TO 100
      DO 50 I=1,LEXMAX                          ! use previous
        OUTBUF(I)=BAKBUF(I)
50    CONTINUE
      OUTLEN=BAKLEN                             ! buffer and length.
100   IF(SPARSE(OUTBUF,OUTLEN,VBFLAG)) 1000,200,300 ! do syn scan.
C
C Parse requires validation
C
200   IF(.NOT.VBFLAG) GO TO 350                 ! echo mode, force fail.
      IF(.NOT.SYNMCH(X)) GO TO 1000             ! do syn match.
      IF(PRSO.EQ.BUNOBJ) LASTIT=BUNVEC(1)       ! record for "it".
      IF((PRSO.GT.0).AND.(PRSO.LT.BUNOBJ)) LASTIT=PRSO
C
C Successful parse or successful validation
C
300   PARSE=.TRUE.
350   CALL ORPHAN(0,0,0,0,0,' ',0,0)            ! clear orphans.
      DO 400 I=1,LEXMAX                         ! save command
        BAKBUF(I)=OUTBUF(I)
400   CONTINUE
      BAKLEN=OUTLEN                             ! save length
      IF(DFLAG) WRITE(OUTCH,500) PARSE,PRSA,PRSO,PRSI
500   FORMAT(' PARSE RESULTS- ',L7,3I7)
      RETURN
C
C Parse fails, disallow continuation
C
1000  PRSCON=1
      IF(DFLAG) WRITE(OUTCH,500) PARSE,PRSA,PRSO,PRSI
      RETURN
C
      END

C LEX-  Lexical analyzer
C
C Declarations
C
C This routine details on bit 1 of PRSFLG
C
      LOGICAL FUNCTION LEX(INLINE,INLEN,OUTBUF,OP,VBFLAG)
      IMPLICIT INTEGER(A-Z)
      INCLUDE 'dparam.for'
      CHARACTER*(TEXLNT) INLINE
      CHARACTER*(WRDLNT) OUTBUF(LEXMAX)
      CHARACTER*1 J
      LOGICAL DFLAG,VBFLAG
C
      DFLAG=(PRSFLG.AND.2).NE.0
      LEX=.FALSE.                               ! assume lex fails.
      OP=0                                      ! output ptr.
      DO 10 I=1,LEXMAX                          ! clear output buf.
        OUTBUF(I)=' '
10    CONTINUE
C
50    OP=OP+1                                   ! adv output ptr.
      CP=0                                      ! char ptr=0.
C
200   IF(PRSCON.GT.INLEN) GO TO 2000            ! end of input?
      J=INLINE(PRSCON:PRSCON)                   ! no, get character,
      IF((J.EQ.'"').OR.(J.EQ.'''')) GO TO 3000! substring?
      PRSCON=PRSCON+1                           ! advance ptr.
      IF(J.EQ.' ') GO TO 1000                   ! space?
      IF((J.EQ.'.').OR.(J.EQ.';').OR.
     1 (J.EQ.'!').or.(J.EQ.'?')) GO TO 2000     ! end of command?
      IF(J.EQ.',') GO TO 4000                   ! comma?
      IF(OP.GT.LEXMAX) GO TO 5000               ! too many tokens?
      CP=CP+1                                   ! adv char ptr.
      IF(CP.LE.WRDLNT) OUTBUF(OP)(CP:CP)=J      ! insert char in word.
      GO TO 200
C
C Space.
C
1000  IF(CP.EQ.0) GO TO 200                     ! any word yet?
      GO TO 50                                  ! yes, adv op.
C
C End of input, see if partial word available.
C
2000  IF(PRSCON.GT.INLEN) PRSCON=1              ! force parse restart.
      IF((CP.EQ.0).AND.(OP.EQ.1)) RETURN        ! any results?
      IF(CP.EQ.0) OP=OP-1                       ! any last word?
      LEX=.TRUE.
      IF(DFLAG) WRITE(OUTCH,2020) CP,OP,PRSCON,(OUTBUF(I),I=1,OP)
2020  FORMAT(' LEX RESULTS- ',3I7/1X,8(A,1X))
      RETURN
C
C Substring, J is delimiter.
C
3000  IF(SUBLNT.NE.0) GO TO 3400                ! already got one?
3100  PRSCON=PRSCON+1                           ! skip initial quote.
      IF(PRSCON.GT.INLEN) GO TO 3500            ! any more characters?
      IF(INLINE(PRSCON:PRSCON).EQ.' ') GO TO 3100 ! skip blanks.
      K=INDEX(INLINE(PRSCON:INLEN),J)           ! find closing quote.
      IF(K.LE.1) GO TO 3500                     ! none or empty?
      SUBBUF=INLINE(PRSCON:PRSCON+K-2)          ! set up substring buffer,
      SUBLNT=K-1                                ! length.
      PRSCON=PRSCON+K                           ! skip over string.
      IF(DFLAG) WRITE(OUTCH,3030) SUBLNT,SUBBUF(1:SUBLNT)
3030  FORMAT(' SUBSTRING- ',I7,' "',A,'"')
      GO TO 1000                                ! treat as end of word.
C
3400  IF(VBFLAG) CALL RSPEAK(1046)              ! multiple substrings.
      RETURN
C
3500  IF(VBFLAG) CALL RSPEAK(616)               ! bad substring.
      RETURN                                    ! fails.
C
C Comma.
C
4000  IF(CP.NE.0) OP=OP+1                       ! if partial word, go to next.
      IF(OP.EQ.1) GO TO 4500                    ! no first word? die.
      IF(OP.GT.LEXMAX) GO TO 5000               ! too many tokens?
      OUTBUF(OP)='AND'                          ! insert 'AND'.
      GO TO 50                                  ! start new word
C
4500  IF(VBFLAG) CALL RSPEAK(1047)              ! misplaced comma.
      RETURN
C
C Too many tokens.
C
5000  IF(VBFLAG) CALL RSPEAK(1048)              ! too many tokens.
      RETURN
C
      END

C SPARSE-       Start of parse
C
C Declarations
C
C This routine details on bit 2 of PRSFLG
C
      INTEGER FUNCTION SPARSE(LBUF,LLNT,VBFLAG)
      IMPLICIT INTEGER(A-Z)
      INCLUDE 'dparam.for'
      CHARACTER*(WRDLNT) LBUF(LEXMAX),WORD,LCWORD,LCIFY
      CHARACTER*(WRDLNT+2) LCWRD1
      LOGICAL LIT,DFLAG,VBFLAG,ANDFLG,BUNFLG
      INTEGER OBJVEC(2),PRPVEC(2)
      EQUIVALENCE (OBJVEC(1),OBJ1),(PRPVEC(1),PREP1)

C SPARSE, PAGE 2
C
C Vocabularies
C
C Buzz words--  ignored in syntactic processing
C
      DATA BWORD/'BY','IS','A','AN','THE',
     1'TODAY','MY','YOUR','OUR','HIS'/
C
C Prepositions--        maps prepositions to indices
C
      DATA PWORD/'OVER','WITH','USING','AT','TO',
     1'IN','INSIDE','INTO','DOWN','UP',
     2'UNDER','OF','ON','OFF','FOR',
     3'FROM','OUT','THROUGH',' ',' '/
C
      DATA PVOC/1,2,2,3,4,
     15,5,5,6,7,
     28,9,10,11,12,
     313,13,14,0,0/
C
C Directions--  maps directions to indices
C
      DATA DWORD/'N','NORTH','S','SOUTH',
     1'E','EAST','W','WEST',
     2'SE','SW','NE','NW',
     4'U','UP','D','DOWN',
     5'LAUNCH','LAND','EXIT','OUT',
     6'TRAVEL','IN','CROSS',' ',' '/
C
      DATA DVOC/XNORTH,XNORTH,XSOUTH,XSOUTH,
     1XEAST,XEAST,XWEST,XWEST,
     2XSE,XSW,XNE,XNW,
     4XUP,XUP,XDOWN,XDOWN,
     5XLAUN,XLAND,XEXIT,XEXIT,
     6XCROSS,XENTER,XCROSS,0,0/

C SPARSE, PAGE 3
C
C Adjectives--  maps adjectives to object numbers
C
C Each string entry in aword corresponds to a list of one or more
C object numbers in AVOC.  Object entries are delimited by the first
C object being positive, and all subsequent objects in the same entry
C being negative.
C
      DATA (AWORD(I),I=1,40) /
     1'BROWN','ELONGATE','HOT','PEPPER',
     1'VITREOUS','JADE','HUGE','ENORMOUS',
     2'TROPHY','CLEAR','LARGE','NASTY',
     3'ELVISH','BRASS','BROKEN','ORIENTAL',
     4'BLOODY','RUSTY','BURNED-O','DEAD',
     5'OLD','LEATHER','PLATINUM','PEARL',
     6'MOBY','CRYSTAL','GOLD','IVORY',
     7'SAPPHIRE','WOODEN','WOOD','STEEL',
     8'DENTED','FANCY','ANCIENT','SMALL',
     9'BLACK','TOUR','VISCOUS','VICIOUS'/
C
      DATA (AVOC(I),I=1,112) /
     11,-81,-133,1,3,-190,3,
     14,6,8,8,-122,
     29,10,12,-26,-47,-95,-96,-123,-133,-135,-144,-145,
     2-150,-176,-191,13,-19,
     314,15,-16,-46,-156,-190,16,-22,-38,-92,-113,-155,-158,17,
     420,24,-205,22,22,
     525,-41,-44,-45,-208,25,26,27,
     631,32,-126,-206,-209,33,-85,-104,-157,-158,-188,34,
     737,38,-67,-75,-93,-136,-137,-165,-173,-174,-175,-197,-204,
     738,-67,-136,-137,-165,-173,-174,-175,
     739,-105,-124,-125,-189,
     839,40,41,-44,5,-46,-52,-53,-89,-102,-103,-153,-187,
     947,-162,49,55,62/
C
      DATA (AWORD(I),I=41,80) /
     1'GLASS','TRAP','FRONT','STONE',
     1'MANGLED','RED','YELLOW','BLUE',
     2'VAMPIRE','MAGIC','SEAWORTH','TAN',
     3'SHARP','WICKER','CLOTH','BRAIDED',
     4'GAUDY','SQUARE','CLAY','SHINY',
     5'THIN','GREEN','PURPLE','WHITE',
     6'MARBLE','COKE','EMPTY','ROUND',
     7'TRIANGUL','RARE','OBLONG','EAT-ME',
     8'EATME','ORANGE','ECCH','ROCKY',
     9'SHEER','200','NEAT','SHIMMERI'/
C
      DATA (AVOC(I),I=113,179) /
     110,-126,-132,-206,-209,66,68,69,-150,-278,
     1          72,-124,79,-94,-140,-161,-170,-171,-190,-209,
     180,-159,82,-112,-114,-141,-206,
     283,90,-281,90,91,
     392,98,100,101,
     4108,109,-127,109,110,
     5110,77,-115,-143,116,117,-126,-147,-160,-266,
     6119,121,121,128,
     7129,134,135,138,
     8138,139,141,146,
     9146,148,148,151/
C
      DATA (AWORD(I),I=81,120) /
     1'ZURICH','BIRDS','ENCRUSTE','BEAUTIFU',
     1'CLOCKWOR','MECHANIC','MAHOGANY','PINE',
     2'LONG','CENTER','SHORT','T',
     3'COMPASS','BRONZE','CELL','LOCKED',
     4'SUN','BARE','SONG','NORTH',
     5'NORTHERN','SOUTH','SOUTHERN','EAST',
     6'EASTERN','WEST','WESTERN','DUNGEON',
     7'FREE','GRANITE','LOWERED','VOLCANO',
     8'MAN-SIZE','METAL','PLASTIC','SILVER',
     9'USED','USELESS','SEEING','ONE-EYED'/
C
      DATA (AVOC(I),I=180,238) /
     1152,153,-154,-155,154,-155,86,-156,
     1157,-158,157,-158,163,164,
     2166,166,167,168,
     3169,-275,172,174,-175,174,
     4177,259,267,269,
     5269,270,270,271,
     6271,67,-272,67,-272,279,
     7195,-262,265,36,111,
     893,64,-99,-200,-201,77,-87,-88,-90,59,
     922,22,126,-206,-209,58/
C
      DATA (AWORD(I),I=121,160) /
     1'HOLY','HAND-HEL','UNRUSTY','PLAIN',
     1'PRICELES','SANDY','GIGANTIC','LINE-PRI',
     2'FLATHEAD','FINE','SHADY','SUSPICIO',
     3'CROSS','TOOL','CONTROL','DON',
     4'WOODS','GOLDEN','OAK','BARRED',
     5'DUSTY','NARROW','IRON','WELCOME',
     6'RUBBER','SKELETON','ALL','ZORKMID',
     712*' '/
C
      DATA (AVOC(I),I=239,282) /
     143,89,13,13,
     1104,192,122,122,
     2118,91,61,61,
     3165,193,194,196,
     4196,157,-158,197,198,-210,
     5204,199,205,207,
     6207,23,253,-254,104,-148,
     712*0/

C SPARSE, PAGE 4
C
C OBJECTS--     Maps objects to object indices,
C               same format as AVOC.
C
      DATA (OWORD(I),I=1,40) /
     1'BAG','SACK','GARLIC','CLOVE',
     1'FOOD','SANDWICH','LUNCH','DINNER',
     2'GUNK','PIECE','SLAG','COAL',
     3'PILE','HEAP','FIGURINE','MACHINE',
     4'PDP10','VAX','DRYER','LID',
     5'DIAMOND','CASE','BOTTLE','CONTAINE',
     6'WATER','QUANTITY','LIQUID','H2O',
     7'ROPE','HEMP','COIL','KNIFE',
     8'BLADE','SWORD','ORCHRIST','GLAMDRIN',
     9'LAMP','LANTERN','RUG','CARPET'/
C
      DATA (OVOC(I),I=1,71) /
     11,-25,-100,1,2,2,
     13,3,3,3,
     24,-55,4,-143,-186,-282,4,5,
     35,-18,-38,-72,-73,-87,-88,-122,-148,5,6,7,
     47,7,7,7,-200,-201,
     58,9,-123,10,-121,10,
     611,-273,11,-273,11,-273,11,-273,
     712,-101,-282,12,12,-110,13,-24,
     813,-14,14,14,14,
     915,-16,-22,15,-16,-22,17,17/
C
      DATA (OWORD(I),I=41,80) /
     1'LEAVES','LEAF','TROLL','AXE',
     1'PRAYER','KEYS','KEY','SET',
     2'BONES','SKELETON','BODY','COINS',
     3'BAR','NECKLACE','PEARLS','MIRROR',
     4'ICE','MASS','GLACIER','RUBY',
     5'TRIDENT','FORK','COFFIN','CASKET',
     6'TORCH','CAGE','DUMBWAIT','BASKET',
     7'BRACELET','JEWEL','TIMBER','BOX',
     8'STRADIVA','VIOLIN','ENGRAVIN','INSCRIPT',
     9'GHOST','SPIRIT','FIEND','GRAIL'/
C
      DATA (OVOC(I),I=72,130) /
     118,18,19,-111,20,
     144,-47,23,23,-205,23,
     221,21,21,-72,-73,25,
     326,-165,-168,27,27,28,-29,-276,
     430,30,30,31,
     532,32,33,33,
     634,35,-36,-124,-125,35,-36,35,-36,-98,-113,
     737,37,38,39,-53,-105,
     840,40,41,41,-44,
     942,42,42,43/
C
      DATA (OWORD(I),I=81,120) /
     1'TRUNK','CHEST','BELL','BOOK',
     1'BIBLE','GOODBOOK','CANDLES','PAIR',
     2'GUIDEBOO','GUIDE','PAPER','NEWSPAPE',
     3'ISSUE','REPORT','MAGAZINE','NEWS',
     4'MATCHBOO','MATCH','MATCHES','ADVERTIS',
     5'PAMPHLET','LEAFLET','BOOKLET','MAILBOX',
     6'TUBE','TOOTHPAS','PUTTY','MATERIAL',
     7'GLUE','WRENCH','SCREWDRI','CYCLOPS',
     8'MONSTER','CHALICE','CUP','GOBLET',
     9'PAINTING','ART','CANVAS','PICTURE'/
C
      DATA (OVOC(I),I=131,182) /
     145,45,-193,46,-190,47,-49,-114,-115,-116,-117,
     147,47,48,48,
     249,49,50,-122,-143,-186,50,
     350,50,50,50,
     451,51,51,52,
     552,52,52,53,
     654,54,55,55,
     755,56,57,58,
     858,59,59,59,
     960,-149,60,-149,60,60/
C
      DATA (OWORD(I),I=121,160) /
     1'WORK','MASTERPI','THIEF','ROBBER',
     1'CRIMINAL','BANDIT','CROOK','GENT',
     2'GENTLEMA','MAN','INDIVIDU','BAGMAN',
     3'STILETTO','WINDOW','BOLT','NUT',
     4'GRATE','GRATING','DOOR','TRAP-DOO',
     5'SWITCH','HEAD','CORPSE','BODIES',
     6'DAM','GATES','GATE','FCD',
     7'RAIL','RAILING','BUTTON','BUBBLE',
     8'LEAK','DRIP','HOLE','BAT',
     9'RAINBOW','POT','STATUE','SCULPTUR'/
C
      DATA (OVOC(I),I=183,258) /
     160,60,61,61,
     161,61,61,61,
     261,61,61,61,
     362,63,-198,-210,64,64,
     465,65,66,-67,-68,-69,-119,-164,
     4-172,-173,-174,-175,-189,-197,66,
     570,-79,-80,-81,-82,-170,71,-120,72,-73,72,-73,
     674,74,-76,74,-76,74,
     775,75,76,-79,-80,-81,-82,-127,-128,-129,-170,-176,77,
     878,-191,78,78,-107,-202,-203,83,
     984,85,86,86/
C
      DATA (OWORD(I),I=161,200) /
     1'ROCK','BOAT','PLASTIC','PUMP',
     1'AIRPUMP','AIR-PUMP','LABEL','FINEPRIN',
     2'STICK','BARREL','BUOY','EMERALD',
     3'SHOVEL','GUANO','CRAP','SHIT',
     4'HUNK','BALLOON','RECEPTAC','WIRE',
     5'HOOK','ZORKMID','COIN','SAFE',
     6'CARD','NOTE','SLOT','CROWN',
     7'BRICK','FUSE','GNOME','STAMP',
     8'TOMB','CRYPT','GRAVE','HEADS',
     9'POLES','IMPLEMEN','LOSERS','COKES'/
C
      DATA (OVOC(I),I=259,312) /
     186,87,-88,-90,87,-88,-90,89,
     189,89,91,-112,91,
     292,93,94,95,
     396,97,97,97,
     497,98,-113,99,101,-110,
     5102,-103,104,-148,104,105,
     6106,-188,106,-186,107,-187,108,
     7109,110,111,-152,118,-196,
     8119,119,119,120,
     9120,120,120,121/
C
      DATA (OWORD(I),I=201,240) /
     1'LISTINGS','OUTPUT','PRINTOUT','SPHERE',
     1'BALL','ETCHING','WALLS','WALL',
     2'FLASK','POOL','SEWAGE','TIN',
     3'SAFFRON','SPICES','TABLE','POST',
     4'POSTS','BUCKET','CAKE','ICING',
     5'ROBOT','ROBBY','C3PO','R2D2',
     6'PANEL','POLE','TBAR','T-BAR',
     7'ARROW','POINT','BEAM','DIAL',
     8'SUNDIAL','1','ONE','2',
     9'TWO','3','THREE','4'/
C
      DATA (OVOC(I),I=313,387) /
     1122,122,122,126,-206,-209,
     1126,130,-131,130,-131,-257,130,-131,-159,
     1-160,-161,-162,-163,-164,-257,-265,-269,-270,-271,-272,
     2132,133,133,134,
     3134,134,135,-204,136,-166,-167,
     4136,137,138,-139,-140,-141,139,-140,-141,
     5142,142,142,142,
     6159,-160,-161,-162,-163,-164,-194,-277,120,-166,-167,168,168,
     7169,169,171,177,
     8177,178,178,179,
     9179,180,180,181/
C
      DATA (OWORD(I),I=241,280) /
     1'FOUR','5','FIVE','6',
     1'SIX','7','SEVEN','8',
     2'EIGHT','WARNING','SLIT','IT',
     3'THAT','THIS','ME','MYSELF',
     4'CRETIN','ALL','EVERYTHI','TREASURE',
     5'VALUABLE','SAILOR','TEETH','GRUE',
     6'HAND','HANDS','LUNGS','AIR',
     7'AVIATOR','FLYER','TREE','CLIFF',
     8'LEDGE','PORTRAIT','STACK','BILLS',
     9'VAULT','CUBE','LETTERIN','CURTAIN'/
C
      DATA (OVOC(I),I=388,432) /
     1181,182,182,183,
     1183,184,184,185,
     2185,186,187,250,
     3250,250,251,251,
     4251,252,252,253,
     5253,255,256,258,
     6259,259,260,260,
     7261,261,144,-145,-268,146,-147,
     8146,149,122,-148,148,
     9150,150,67,-150,151/
C
      DATA (OWORD(I),I=281,320) /
     1'LIGHT','NEST','EGG','BAUBLE',
     1'CANARY','BIRD','SONGBIRD','GUARD',
     2'GUARDIAN','ROSE','STRUCTUR','CHANNEL',
     3'KEEPER','LADDER','BROCHURE','WISH',
     4'GROUND','EARTH','SAND','WELL',
     5'SLIDE','CHUTE','HOUSE','BOTTLES',
     6'BUNCH','PALANTIR','STONE','FLINT',
     7'POSSESSI','GOOP','BEACH','GRIP',
     8'HANDGRIP','PRINT','ETCHINGS','CRACK',
     9'KEYHOLE','MAT','STOVE','PLATINUM'/
C
      DATA (OVOC(I),I=433,485) /
     115,-151,-171,153,154,-155,156,
     1157,-158,267,267,274,
     2274,275,276,278,
     3279,280,195,-262,263,
     4264,264,192,-264,281,
     5283,283,266,121,
     6121,126,-206,-209,126,-206,-209,51,
     7254,133,192,167,
     8167,91,-122,130,-131,199,
     9202,-203,207,208,26/
C
      DATA (OWORD(I),I=321,360) /
     1'HIM','SELF','GOLD','SAPPHIRE',
     1'IVORY','MASTER','CANDLE','JADE',
     2'SCREEN','BLESSING','GHOSTS','SPIRITS',
     3'CORPSES','JEWELS','CLIFFS','CHIMNEY',
     424*' '/
C
      DATA (OVOC(I),I=486,529) /
     1250,251,85,-104,37,
     134,279,48,6,
     2151,263,42,42,
     372,-73,37,-45,146,-147,211,
     424*0/

C SPARSE, PAGE 5
C
C VERBS--       Maps verbs to syntax slots
C
C Vocabulary entries are variable length and consist of one
C or more words.  If an entry contains more than one word,
C all but the last are prefaced with an '*'.  The preferred
C string for error messages should be first.
C
C Syntax entries consist of a flag word followed by 0, 1, or 2
C Object descriptions.  The flag word has the following format--
C
C bit <14>      if 1, syntax includes direct object
C bit <13>      if 1, syntax includes indirect object
C bit <12>      if 1, direct object is implicit (standard form)
C bit <11>      if 1, direct and indirect object must be swapped
C                       after syntax processing
C bit <10>      if 1, this is default syntax for orphanery
C bits <8:0>    verb number for VAPPLI
C
C Object descriptions consist of a flag word and two FWIM words.
C The flag word has the following format--
C
C bit <14>      if 1, search adventurer for object
C bit <13>      if 1, search room for object
C bit <12>      if 1, parser will try to take object
C bit <11>      if 1, adventurer must have object
C bit <10>      if 1, qualifying bits (normally -1,-1) are same
C                       as FWIM bits
C bit <9>       if 1, object must be reachable
C bits <8:0>    preposition number for SYNMCH
C
C The FWIM words have the same format as the two object flag words.
C
C Note that bits 12 and 11 of object descriptions actually have
C four distinct states--
C
C       bit 12  bit 11  mdldesc         interpretation
C       ------  ------  -------         ---------------
C
C         0       0      --             no parser action
C         0       1      HAVE           adventurer must have object
C         1       0      TRY            try to take, dont care if fail
C         1       1      TAKE           try to take, care if fail
C

C SPARSE, PAGE 6
C
      DATA (VWORD(I),I=1,43) /
     1'BRIEF','VERBOSE','SUPERBRI','STAY',
     1'VERSION','*SWIM','*BATHE','WADE',
     2'GERONIMO','*ULYSSES','ODYSSEUS','*PLUGH','XYZZY',
     3'PRAY','TREASURE','TEMPLE','BLAST',
     4'SCORE','*QUIT','*GOODBYE','*Q','BYE','HELP',
     5'INFO','*HISTORY','UPDATE','BACK',
     6'*MUMBLE','SIGH','*CHOMP','*LOSE',
     7'BARF','DUNGEON','FROBOZZ','*FOO',
     8'*BLETCH','BAR','REPENT','*HOURS',
     9'SCHEDULE','WIN','*YELL','*SCREAM'/
C
      DATA (VVOC(I),I=1,54) /
     11,70,1,71,1,72,1,73,
     11,74,1,75,
     21,76,1,77,1,56,
     31,79,1,80,1,81,1,82,
     41,83,1,84,1,40,
     51,41,1,42,1,43,
     61,44,
     71,45,1,46,1,47,
     81,48,1,49,
     91,50,1,51/
C
      DATA (VWORD(I),I=44,86) /
     1'SHOUT','*HOP','SKIP','*CURSE',
     1'*SHIT','*DAMN','FUCK','ZORK',
     2'WISH','SAVE','RESTORE','TIME',
     3'DIAGNOSE','EXORCISE','*LIST','*I','INVENTOR',
     4'WAIT','INCANT','*ANSWER','RESPOND','AGAIN',
     5'NOOBJ','*BUG','*GRIPE','COMPLAIN',
     6'*FEATURE','*COMMENT','*IDEA','SUGGESTI',
     7'ROOM','*OBJECTS','OBJ','RNAME','DEFLATE',
     8'*EXAMINE','*WHAT','DESCRIBE','FILL',
     9'*FIND','*SEEK','*WHERE','SEE'/
C
      DATA (VVOC(I),I=55,120) /
     11,52,1,53,
     11,54,1,55,
     21,169,1,149,1,150,1,90,
     31,94,1,105,1,133,
     41,128,1,95,1,96,1,57,
     51,58,1,59,
     61,60,
     71,65,1,66,1,67,1,8#50147,
     84,8#40170,8#60000,-1,-1,
     811,8#60206,8#61000,8#200,0,8#61002,-1,-1,
     88#40206,8#61000,8#200,0,
     94,8#40177,8#60000,-1,-1/
C
      DATA (VWORD(I),I=87,131) /
     1'FOLLOW','*KICK','*BITE','TAUNT',
     1'LOWER','*PUSH','PRESS','*RING',
     2'PEAL','*RUB','*FEEL','*CARESS','*TOUCH',
     3'FONDLE','SHAKE','SPIN','*UNTIE',
     4'FREE','*WALK','*RUN','*PROCEED','GO','*ATTACK','*FIGHT',
     5'*INJURE','*HIT','HURT','BOARD',
     6'*BRUSH','CLEAN','*BURN','*IGNITE',
     7'INCINERA','CLIMB','CLOSE','DIG',
     8'DISEMBAR','*DRINK','*IMBIBE','SWALLOW',
     9'*DROP','RELEASE','*EAT','*GOBBLE','*CONSUME'/
C
      DATA (VVOC(I),I=121,278) /
     12,8#125,8#50125,1,8#50153,
     11,8#50156,9,8#50160,8#40160,8#61012,-1,-1,
     18#40241,8#61010,-1,-1,
     25,8#52127,8#70127,8#61002,-1,-1,
     31,8#50157,1,8#50171,1,8#50201,
     411,8#42161,8#61000,0,8#10000,
     48#60242,8#61000,0,8#10000,8#61015,-1,-1,
     49,8#50216,8#40126,8#61016,-1,-1,8#40126,8#61005,-1,-1,
     57,8#60215,8#21000,0,8#200,8#44002,0,8#1000,
     54,8#40202,8#21000,0,2,
     65,8#52130,8#70130,8#61002,-1,-1,
     77,8#60211,8#61000,8#20,0,8#64002,8#10,0,
     712,8#40235,8#20007,0,8#4000,8#40236,8#20006,0,8#4000,
     78#40234,8#20000,0,8#4000,
     74,8#40176,8#61000,8#10200,0,
     721,8#60131,8#20005,0,8#40000,8#44002,4,0,
     7          8#60131,8#20016,0,8#40000,8#44002,4,0,
     7          8#60131,8#20000,0,8#40000,8#44002,4,0,
     88,8#40203,8#20000,0,2,8#40203,8#20015,0,2,
     84,8#40210,8#61000,8#400,0,
     925,8#42221,8#41000,-1,-1,
     98#60220,8#41000,-1,-1,8#61005,-1,-1,
     98#60220,8#41000,-1,-1,8#61006,-1,-1,
     98#60220,8#41000,-1,-1,8#61016,-1,-1/
C
      DATA (VWORD(I),I=132,172) /
     1'*MUNCH','TASTE','*DOUSE','EXTINGUI',
     1'*GIVE','*HAND','DONATE','*HELLO',
     2'HI','BLOW','INFLATE','*JUMP',
     3'LEAP','*KILL','*MURDER','*SLAY',
     4'*STAB','DISPATCH','*KNOCK','RAP',
     5'LIGHT','LOCK','*LOOK','*L','*STARE',
     6'GAZE','*MELT','LIQUIFY','MOVE',
     7'*PULL','TUG','*DESTROY','*MUNG',
     8'*BREAK','DAMAGE','OPEN','PICK',
     9'*PLUG','*GLUE','PATCH','*POKE'/
C
      DATA (VVOC(I),I=279,450) /
     14,8#40207,8#75000,8#2000,0,
     14,8#40174,8#75000,8#100,0,
     111,8#72222,8#21004,8#40,0,8#64222,8#21000,8#40,0,
     18#61000,-1,-1,
     22,8#2227,8#50227,
     215,8#62146,8#61007,-1,-1,8#61002,4,0,
     28#40122,8#61007,-1,-1,8#40165,8#61005,-1,-1,
     24,8#70146,8#61002,4,0,
     35,8#133,8#40133,8#61001,-1,-1,
     47,8#60213,8#21000,0,8#200,8#44002,0,8#1000,
     412,8#42166,8#61003,-1,-1,8#40166,8#61012,-1,-1,
     48#40215,8#23006,8#40,0,
     511,8#42173,8#75000,8#100,0,8#60211,8#61000,8#100,0,
     58#54002,8#10,0,
     57,8#60134,8#20000,-1,-1,8#74002,4,0,
     631,8#167,8#40170,8#60003,-1,-1,8#40231,8#61010,-1,-1,
     68#40230,8#60005,-1,-1,8#40230,8#60016,-1,-1,
     68#60144,8#60003,-1,-1,8#61002,-1,-1,
     68#60144,8#60003,-1,-1,8#61016,-1,-1,
     64,8#70145,8#61002,8#10,0,
     64,8#40172,8#20000,-1,-1,
     78,8#42172,8#21000,-1,-1,8#40172,8#21012,-1,-1,
     85,8#52212,8#70212,8#44002,-1,-1,
     811,8#42175,8#61000,8#10200,0,8#60175,8#61000,8#10200,0,
     88#54002,4,8#1000,
     84,8#40204,8#61007,8#20000,8#40,
     94,8#70152,8#61002,-1,-1/
C
      DATA (VWORD(I),I=173,212) /
     1'*BLIND','JAB','*POUR','SPILL',
     1'PUMP','*PUT','*INSERT','*STUFF',
     2'PLACE','*RAISE','LIFT','*READ',
     3'*PERUSE','SKIM','STRIKE','*SWING',
     4'THRUST','*TAKE','*HOLD','*CARRY',
     5'REMOVE','*TELL','*COMMAND','REQUEST',
     6'*THROW','*HURL','CHUCK','*TIE',
     7'FASTEN','*TURN','SET','UNLOCK',
     8'*WAKE','*ALARM','*STARTLE','SURPRISE',
     9'*WAVE','*FLAUNT','BRANDISH','WIND'/
C
      DATA (VVOC(I),I=451,654) /
     17,8#60212,8#21000,0,8#200,8#44002,0,8#1000,
     125,8#42223,8#41000,8#400,0,
     18#60223,8#41000,8#400,0,8#61005,-1,-1,
     18#60223,8#41000,8#400,0,8#61016,-1,-1,
     18#60240,8#41000,8#400,0,8#61012,-1,-1,
     14,8#60232,8#60007,-1,-1,
     216,8#72220,8#61005,-1,-1,8#70220,8#61016,-1,-1,
     28#40221,8#61006,-1,-1,8#70241,8#61010,-1,-1,
     25,8#52155,8#40155,8#61007,-1,-1,
     318,8#42144,8#71000,8#40000,0,
     38#60144,8#71000,8#40000,0,8#61002,-1,-1,
     38#60144,8#71000,8#40000,0,8#61016,-1,-1,
     312,8#60215,8#23000,8#40,0,8#44002,0,8#1000,
     38#42215,8#23000,8#40,0,8#50173,
     47,8#60214,8#44000,0,8#1000,8#21003,0,8#200,
     511,8#42204,8#61000,8#20000,8#40,
     58#60204,8#61000,8#20000,0,8#61015,-1,-1,
     54,8#40217,8#20000,0,8#2000,
     621,8#62224,8#44000,-1,-1,8#21003,8#40,0,
     68#60224,8#44000,-1,-1,8#21016,8#40,0,
     68#60220,8#44000,-1,-1,8#61005,-1,-1,
     711,8#70162,8#61004,-1,-1,8#60163,8#21007,8#40,0,
     78#65002,4,0,
     722,8#62164,8#61000,2,0,8#64002,4,0,
     78#40173,8#75012,8#100,0,8#40174,8#75013,8#100,0,
     78#60237,8#61000,2,0,8#20004,-1,-1,
     77,8#60135,8#21000,-1,-1,8#74002,4,0,
     88,8#42150,8#20000,8#40,0,8#40150,8#20007,8#40,0,
     94,8#40154,8#40000,-1,-1,
     95,8#50233,8#40233,8#61007,-1,-1/
C
      DATA (VWORD(I),I=213,240)/
     1'ENTER','LEAVE','*MAKE','BUILD',
     1'*OIL','*GREASE','LUBRICAT','PLAY',
     2'SEND','SLIDE','*SMELL','SNIFF',
     3'SQUEEZE','GET','COUNT',13*' '/
C
      DATA (VVOC(I),I=655,722) /
     12,167,8#50126,2,168,8#50220,1,8#50243,
     14,8#70244,8#41002,-1,-1,
     15,8#50245,8#70245,8#75002,4,0,
     24,8#40246,8#61014,-1,-1,
     24,8#70241,8#61010,-1,-1,1,8#50105,
     31,8#50104,19,8#42204,8#61000,8#20000,8#40,
     38#40202,8#21005,0,2,8#40203,8#21015,0,2,
     38#60204,8#61000,8#20000,8#40,8#61015,-1,-1,
     31,8#50141,13*0/

C SPARSE, PAGE 7
C
C Set up for parsing
C
      SPARSE=-1                                 ! assume parse fails.
      ADJ=0                                     ! clear parts holders.
      ACT=0
      PREP=0
      PPTR=0
      OBJ1=0
      OBJ2=0
      PREP1=0
      PREP2=0
      LOBJ=0
      ANDFLG=.FALSE.
      BUNFLG=.FALSE.
      DFLAG=(PRSFLG.AND.4).NE.0

C SPARSE, PAGE 8
C
C Now loop over input buffer of lexical tokens.
C
      I=0
10    I=I+1                                     ! do 1000 i=1,llnt
        WORD=LBUF(I)                            ! get current token.
        ERRVOC=0                                ! assume won't find
        IF(WORD.EQ.' ') GO TO 1000              ! blank? ignore.
        IF(WORD.EQ.'AND') GO TO 1500            ! 'AND'?
        IF((WORD.EQ.'EXCEPT').OR.(WORD.EQ.'BUT')) GO TO 2500
C
C Check for buzz word
C
        DO 50 J=1,BWMAX
          IF(WORD.EQ.BWORD(J)) GO TO 1000       ! if match, ignore.
50      CONTINUE
C
C Check for action or direction
C
        J=1                                     ! check for action.
        DO 70 K=1,VWMAX
          IF(VWORD(K)(1:1).EQ.'*') GO TO 65     ! synonym?
          IF(WORD.EQ.VWORD(K)) GO TO 2000       ! match to base word?
          J=J+VVOC(J)+1                         ! skip over syntax.
          GO TO 70
65        IF(WORD.EQ.VWORD(K)(2:WRDLNT)) GO TO 2000 ! synonym match?
70      CONTINUE
C
75      IF((ADJ.NE.0).OR.(PREP.NE.0).OR.(OBJ1.NE.0)) GO TO 200
        IF(ACT.EQ.0) GO TO 80                   ! any verb yet?
        IF((VVOC(ACT+1).AND.SVMASK).NE.WALKW) GO TO 200 ! walk?
80      DO 100 J=1,DWMAX                        ! then chk for dir.
          IF(WORD.EQ.DWORD(J)) GO TO 3000       ! match to direction?
100     CONTINUE
C
C Not an action, check for preposition, adjective, or object.
C
200     DO 250 J=1,PWMAX                        ! look for preposition.
          IF(WORD.EQ.PWORD(J)) GO TO 4000       ! match to preposition?
250     CONTINUE
C
        J=1                                     ! look for adjective.
        DO 350 K=1,AWMAX
          IF(WORD.EQ.AWORD(K)) GO TO 5000       ! match to adjective?
300       J=J+1                                 ! advance to next entry.
          IF(AVOC(J).LT.0) GO TO 300            ! found next entry yet?
350     CONTINUE
C
400     J=1                                     ! look for object.
        DO 550 K=1,OWMAX
          IF(WORD.EQ.OWORD(K)) GO TO 6000       ! match to object?
500       J=J+1                                 ! advance to next entry.
          IF(OVOC(J).LT.0) GO TO 500            ! found next entry yet?
550     CONTINUE
C
C Not recognizable
C
        IF(.NOT.VBFLAG) RETURN                  ! if mute, return
        LCWORD=LCIFY(WORD,1)                    ! convert to lower case
        WRITE(OUTCH,600) LCWORD(1:NBLEN(LCWORD)) ! don't recognize
600     FORMAT(' I don''t understand "',A,'".')
        CALL RSPEAK(ERRVOC)                     ! if extra verb, say so
800     TELFLG=.TRUE.                           ! something said.
        BUNSUB=0                                ! no valid EXCEPT clause.
        RETURN

C SPARSE, PAGE 9
C
1000  IF(I.LT.LLNT) GO TO 10                    ! end of do loop
C
C At end of parse, check for:
C       1. dangling adjective
C       2. bunched object
C       3. simple directions
C       4. orphan preposition
C       5. dangling preposition
C
      IF(ADJ.NE.0) GO TO 4500                   ! dangling adjective?
      IF(BUNFLG) OBJ1=BUNOBJ                    ! bunched object?
      IF(BUNFLG.AND.(BUNSUB.NE.0).AND.(BUNLNT.EQ.0))
     1GO TO 13200                               ! except for nothing?
      IF(ACT.EQ.0) ACT=OFLAG.AND.OACT           ! if no action, take orphan.
      IF(ACT.EQ.0) GO TO 10000                  ! no action, punt.
      IF(((VVOC(ACT+1).AND.SVMASK).NE.WALKW).OR.(OBJ1.LT.XMIN))
     1GO TO 1100                                ! simple direction?
      IF ((OBJ2.NE.0).OR.(PREP1.NE.0).OR.(PREP2.NE.0))
     1GO TO 1050                                ! no extra junk?
      PRSA=WALKW                                ! yes, win totally.
      PRSO=OBJ1
      SPARSE=1                                  ! special return value.
      RETURN
C
1050  IF(VBFLAG) CALL RSPEAK(618)               ! direction+junk, fail.
      GO TO 800                                 ! clean up state.
C
1100  IF((OFLAG.NE.0).AND.(OPREP.NE.0).AND.(PREP.EQ.0).AND.
     1(OBJ1.NE.0).AND.(OBJ2.EQ.0).AND.(ACT.EQ.OACT))
     2GO TO 11000
C
      IF(PREP.EQ.0) GO TO 1200                  ! if dangling prep,
      IF(PPTR.EQ.0) GO TO 12000                 ! and no object, die;
      IF(PRPVEC(PPTR).NE.0) GO TO 12000         ! and prep already, die;
      PRPVEC(PPTR)=PREP                         ! cvt to 'pick up frob'.
1200  SPARSE=0                                  ! parse succeeds.
      IF(DFLAG) WRITE(OUTCH,1310) ACT,OBJ1,OBJ2,PREP1,PREP2
1310  FORMAT(' SPARSE RESULTS- ',5I7)
      RETURN

C SPARSE, PAGE 10
C
C 1500--        AND
C
1500  IF(ADJ.NE.0) GO TO 4100                   ! dangling adj? treat as obj.
      IF((PREP.NE.0).OR.(PPTR.NE.1)) GO TO 8000 ! prep or not dir obj?
      ANDFLG=.TRUE.                             ! flag 'AND'.
      GO TO 1000                                ! done.
C
C 2000--        Action
C
2000  IF(ACT.EQ.0) GO TO 2100                   ! got one already?
      ERRVOC=624                                ! flag for error report.
      GO TO 75                                  ! try to construe differently.
C
2100  ACT=J                                     ! save index to verb.
      OACT=0                                    ! no orphan.
      ANDFLG=.FALSE.                            ! clear 'AND' flag.
      IF(DFLAG) WRITE(OUTCH,2020) J
2020  FORMAT(' SPARSE- ACT AT ',I6)
      GO TO 1000                                ! done.
C
C 2500--        EXCEPT/BUT
C
2500  IF(ADJ.NE.0) GO TO 4100                   ! dangling adjective?
      IF(ANDFLG.OR.BUNFLG.OR.(PPTR.NE.1).OR.
     1(I.GE.LLNT)) GO TO 13000                  ! not in right place?
      IF(LBUF(I+1).NE.'FOR') GO TO 2600         ! except for?
      I=I+1                                     ! skip over.
      IF(I.GE.LLNT) GO TO 13000                 ! out of text?
2600  IF((OBJ1.NE.EVERY).AND.(OBJ1.NE.VALUA).AND.
     1 (OBJ1.NE.POSSE)) GO TO 13100             ! "collective" EXCEPT?
      ANDFLG=.TRUE.                             ! force next object
      BUNFLG=.TRUE.                             ! into bunch vector.
      BUNLNT=0                                  ! start at top.
      BUNSUB=OBJ1                               ! remember collective.
      GO TO 1000                                ! on to next word.
C
C 3000--        Direction
C               Don't need to check for ambiguous use as adjective;
C               only possible overlap is north/south/east/west wall;
C               and global wall takes is found if no adjective given.
C
3000  OBJ=DVOC(J)                               ! save direction.
      ACT=1                                     ! find value for action.
3600  IF(VVOC(ACT).EQ.0) CALL BUG(310,ACT)      ! can't find walk.
      IF((VVOC(ACT+1).AND.SVMASK).EQ.WALKW) GO TO 6300 ! treat as obj.
      ACT=ACT+VVOC(ACT)+1                       ! to next syntax entry.
      GO TO 3600
C
C 4000--        Preposition (or dangling adjective at end of parse)
C
4000  IF(ADJ.EQ.0) GO TO 4600                   ! dangling adjective?
4100  I=I-1                                     ! back up parse stream.
4500  WORD=AWORD(ADJPTR)                        ! get adjective string.
      ADJ=0                                     ! now an object.
      GO TO 400                                 ! go search object words.
C
4600  IF(ANDFLG) GO TO 8000                     ! 'AND' pending?
      IF(PREP.NE.0) GO TO 1000                  ! already have one? ignore.
      PREP=PVOC(J)                              ! no, get index.
      IF(DFLAG) WRITE(OUTCH,4030) J
4030  FORMAT(' SPARSE- PREP AT ',I6)
      GO TO 1000
C
C 5000--        Adjective
C
5000  ADJ=J                                     ! save adjective.
      ADJPTR=K                                  ! save string pointer.
      IF((I.LT.LLNT).OR.(OFLAG.EQ.0).OR.(ONAME.EQ.' '))
     1GO TO 1000                                ! last word + orphan string?
      IF(DFLAG) WRITE(OUTCH,5040) ADJ,ONAME     ! have orphan.
5040  FORMAT(' SPARSE- ADJ AT ',I6,' ORPHAN= ',A)
      WORD=ONAME                                ! get object string.
      GO TO 400                                 ! go search object names.
C
C 6000--        Object
C
6000  OBJ=GETOBJ(J,ADJ,0)                       ! identify object.
      IF(DFLAG) WRITE(OUTCH,6010) J,OBJ
6010  FORMAT(' SPARSE- OBJ AT ',I6,'  OBJ= ',I6)
      IF(OBJ.LE.0) GO TO 7000                   ! if le, couldnt.
      IF(OBJ.NE.ITOBJ) GO TO 6100               ! "it"?
      IF((OFLAG.AND.OOBJ1).NE.0) LASTIT=OFLAG.AND.OOBJ1 ! orphan?
      OBJ=GETOBJ(0,0,LASTIT)                    ! find it.
      IF(OBJ.LE.0) GO TO 7500                   ! if le, couldnt.
C
6100  IF(PREP.NE.9) GO TO 6200                  ! "of" obj?
      IF((LOBJ.EQ.OBJ).OR.(LOBJ.EQ.OCAN(OBJ))) GO TO 6500 ! same as prev?
      IF((LOBJ.EQ.EVERY).AND.((OBJ.EQ.VALUA).OR.(OBJ.EQ.POSSE)))
     1GO TO 6350                                ! all of "collective"?
6150  IF(VBFLAG) CALL RSPEAK(601)               ! doesn't work
      GO TO 800                                 ! clean up state.
C
6200  IF(.NOT.ANDFLG) GO TO 6300                ! 'AND' pending?
      IF(BUNFLG) GO TO 6250                     ! first object?
      BUNVEC(1)=OBJVEC(PPTR)                    ! put preceding obj in vector.
      BUNLNT=1
      BUNFLG=.TRUE.                             ! flag bunch of objects.
      BUNSUB=0                                  ! no EXCEPT/BUT clause.
6250  BUNLNT=BUNLNT+1                           ! advance bunch pointer.
      IF(BUNLNT.GT.BUNMAX) GO TO 9000           ! too many objects?
      BUNVEC(BUNLNT)=OBJ                        ! add to bunch vector.
      GO TO 6500
C
6300  IF(PPTR.EQ.2) GO TO 9000                  ! too many objs?
      PPTR=PPTR+1
      PRPVEC(PPTR)=PREP
6350  OBJVEC(PPTR)=OBJ                          ! stuff into vector.
6500  PREP=0
      ADJ=0
      ANDFLG=.FALSE.                            ! no pending 'AND'.
      LOBJ=OBJ                                  ! record last object.
      GO TO 1000

C SPARSE, PAGE 11
C
C 7000--        Unidentifiable object (index into OVOC is J)
C
7000  LCWORD=LCIFY(WORD,1)                      ! convert obj to lower case.
      LCWRD1=' '                                ! assume no adjective
      IF(ADJ.NE.0) LCWRD1=' '//LCIFY(AWORD(ADJPTR),1)//' '
      IF(OBJ.LT.0) GO TO 7200                   ! ambiguous or unreachable?
      IF(LIT(HERE)) GO TO 7100                  ! lit?
      IF(VBFLAG) CALL RSPEAK(579)               ! not lit, report.
      GO TO 800                                 ! go clean up state.
C
7100  IF(VBFLAG) WRITE(OUTCH,7110)
     1LCWRD1(1:NBLEN(LCWRD1)+1),LCWORD(1:NBLEN(LCWORD))
7110  FORMAT(' I can''t see any',A,A,' here.')
      GO TO 800                                 ! go clean up state.
C
7200  IF(OBJ.NE.-10000) GO TO 7300              ! inside vehicle?
      IF(VBFLAG) CALL RSPSUB(620,ODESC2(AVEHIC(WINNER)))
      GO TO 800                                 ! go clean up state.
C
7300  IF(ACT.EQ.0) ACT=OFLAG.AND.OACT           ! if no act, get orphan.
      CALL ORPHAN(-1,ACT,PREP1,OBJ1,PREP,WORD,0,0) ! orphan the world.
      IF(VBFLAG) WRITE(OUTCH,7310)
     1LCWRD1(1:NBLEN(LCWRD1)+1),LCWORD(1:NBLEN(LCWORD))
7310  FORMAT(' Which',A,A,' do you mean?')
      GO TO 800                                 ! go clean up state.
C
C 7500--        Unidentifiable 'IT' (last direct object is LASTIT).
C
7500  IF(OBJ.LT.0) GO TO 7200                   ! if lt, must be unreachable.
      IF(LIT(HERE)) GO TO 7600                  ! lit?
      IF(VBFLAG) CALL RSPEAK(1076)              ! lose.
      GO TO 800                                 ! go clean up state.
C
7600  IF(VBFLAG) CALL RSPSUB(1077,ODESC2(LASTIT)) ! don't see it.
      GO TO 800                                 ! go clean up state.
C
C 8000--        Misplaced 'AND'.
C
8000  IF(VBFLAG) CALL RSPEAK(1049)
      GO TO 800                                 ! go clean up state.
C
C 9000--        Too many objects.
C
9000  IF(VBFLAG) CALL RSPEAK(617)
      GO TO 800                                 ! go clean up state.
C
C 10000--       No action, punt.
C
10000 IF(OBJ1.EQ.0) GO TO 10100                 ! any direct object?
      IF(VBFLAG) CALL RSPSUB(621,ODESC2(OBJ1))          ! what to do?
      CALL ORPHAN(-1,0,PREP1,OBJ1,0,' ',0,0)
      RETURN
C
10100 IF(VBFLAG) CALL RSPEAK(622)               ! huh?
      GO TO 800                                 ! go clean up state.
C
C 11000--       Orphan preposition.  Conditions are
C               OBJ1.NE.0, OBJ2=0, PREP=0, ACT=OACT
C
11000 IF(OOBJ1.NE.0) GO TO 11500                ! orphan object?
      PREP1=OPREP                               ! no, just use prep.
      GO TO 1200
C
11500 OBJ2=OBJ1                                 ! yes, use as direct obj.
      PREP2=OPREP
      OBJ1=OOBJ1
      PREP1=OPREP1
      GO TO 1200
C
C 12000--       True hanging preposition, no objects yet.
C
12000 CALL ORPHAN(-1,ACT,0,0,PREP,' ',0,0)      ! orphan prep.
      GO TO 1200
C
C 13000--       EXCEPT/BUT errors.
C
13000 LCWORD=LCIFY(WORD,1)
      IF(VBFLAG) WRITE(OUTCH,13010) LCWORD(1:NBLEN(LCWORD)) ! wrong place.
13010 FORMAT(' Misplaced "',A,'".')
      GO TO 800                                 ! go clean up state.
C
13100 LCWORD=LCIFY(WORD,2)                       ! wrong case.
      IF(VBFLAG) WRITE(OUTCH,13110) LCWORD(1:NBLEN(LCWORD)) ! not coll.
13110 FORMAT(' "',A,'" can only be used with "everything",',
     1' "valuables", or "possessions".')
      GO TO 800                                 ! go clean up state.
C
13200 IF(VBFLAG) CALL RSPEAK(619)               ! no objects.
      GO TO 800                                 ! go clean up state.
C
      END

C GETOBJ--      Find obj described by adj, name pair
C
C Declarations
C
C This routine details on bit 3 of PRSFLG
C
      INTEGER FUNCTION GETOBJ(OIDX,AIDX,SPCOBJ)
      IMPLICIT INTEGER(A-Z)
      INCLUDE 'dparam.for'
      LOGICAL THISIT,GHERE,LIT,CHOMP,DFLAG,NOADJS
C
      DFLAG=(PRSFLG.AND.8).NE.0
      CHOMP=.FALSE.
      AV=AVEHIC(WINNER)
      OBJ=0                                     ! assume dark.
      IF(.NOT.LIT(HERE)) GO TO 200              ! lit?
C
      OBJ=SCHLST(OIDX,AIDX,HERE,0,0,SPCOBJ)     ! search room.
      IF(DFLAG) WRITE(OUTCH,10) OBJ
10    FORMAT(' SCHLST- ROOM SCH ',I6)
      IF(OBJ) 1000,200,100                      ! test result.
100   IF((AV.EQ.0).OR.(AV.EQ.OBJ).OR.(OCAN(OBJ).EQ.AV).OR.
     1((OFLAG2(OBJ).AND.FINDBT).NE.0)) GO TO 200
      CHOMP=.TRUE.                              ! not reachable.
C
200   IF(AV.EQ.0) GO TO 400                     ! in vehicle?
      NOBJ=SCHLST(OIDX,AIDX,0,AV,0,SPCOBJ)      ! search vehicle.
      IF(DFLAG) WRITE(OUTCH,220) NOBJ
220   FORMAT(' SCHLST- VEH SCH  ',I6)
      IF(NOBJ) 800,400,300                      ! test result.
300   CHOMP=.FALSE.                             ! reachable.
      IF(OBJ.EQ.NOBJ) GO TO 400                 ! same as before?
      IF(OBJ.NE.0) NOBJ=-NOBJ                   ! amb result?
      OBJ=NOBJ
C
400   NOBJ=SCHLST(OIDX,AIDX,0,0,WINNER,SPCOBJ)          ! search adventurer.
      IF(DFLAG) WRITE(OUTCH,430) NOBJ
430   FORMAT(' SCHLST- ADV SCH  ',I6)
      IF(NOBJ) 800,900,500                      ! test result
500   IF(OBJ.EQ.0) GO TO 800                    ! any previous? no, use nobj.
      IF(AIDX.NE.0) GO TO 600                   ! yes, amb, any adj?
      IF(NOADJS(OBJ).NEQV.NOADJS(NOBJ)) GO TO 700 ! both adj or no adj?
600   OBJ=-NOBJ                                 ! ambiguous result.
      GO TO 900
700   IF(NOADJS(OBJ)) GO TO 900                 ! if old no adj, use old.
800   OBJ=NOBJ                                  ! return new object.
900   IF(CHOMP) OBJ=-10000                      ! unreachable.
1000  GETOBJ=OBJ
C
      IF(GETOBJ.NE.0) GO TO 1500                ! got something?
      DO 1200 I=STRBIT+1,OLNT                   ! no, search globals.
        IF(.NOT.THISIT(OIDX,AIDX,I,SPCOBJ)) GO TO 1200
        IF(.NOT.GHERE(I,HERE)) GO TO 1200       ! can it be here?
        IF(GETOBJ.EQ.0) GO TO 1150              ! got one yet?
        IF(AIDX.NE.0) GO TO 1050                ! yes, no adj?
        IF(NOADJS(GETOBJ).NEQV.NOADJS(I)) GO TO 1100 ! only one with no adj?
1050    GETOBJ=-I                               ! ambiguous
        GO TO 1200
1100    IF(NOADJS(GETOBJ)) GO TO 1200           ! if old no adj, retain.
1150    GETOBJ=I                                ! new is target.
1200  CONTINUE
C
1500  CONTINUE                                  ! end of search.
      IF(DFLAG) WRITE(OUTCH,1540) GETOBJ
1540  FORMAT(' SCHLST- RESULT   ',I6)
      RETURN
      END

C SCHLST--      Search for object
C
C Declarations
C
      INTEGER FUNCTION SCHLST(OIDX,AIDX,RM,CN,AD,SPCOBJ)
      IMPLICIT INTEGER(A-Z)
      INCLUDE 'dparam.for'
      LOGICAL THISIT,QHERE,NOTRAN,NOVIS,AEMPTY,NOADJS
C
C Functions and data
C
      NOTRAN(O)=((OFLAG1(O).AND.TRANBT).EQ.0).AND.
     1((OFLAG2(O).AND.OPENBT).EQ.0)
      NOVIS(O)=((OFLAG1(O).AND.VISIBT).EQ.0)
C
      SCHLST=0                                  ! no result.
      AEMPTY=.FALSE.                            ! no ambiguous empty.
      DO 1000 I=1,OLNT                          ! search objects.
        IF(NOVIS(I).OR.
     1(((RM.EQ.0).OR.(.NOT.QHERE(I,RM))).AND.
     2 ((CN.EQ.0).OR.(OCAN(I).NE.CN)).AND.
     3 ((AD.EQ.0).OR.(OADV(I).NE.AD)))) GO TO 1000
        IF(.NOT.THISIT(OIDX,AIDX,I,SPCOBJ)) GO TO 200
        IF(SCHLST.EQ.0) GO TO 150               ! got one already?
        IF(AIDX.NE.0) GO TO 2000                ! adj? then ambiguous
        IF(NOADJS(I)) GO TO 100                 ! new have no adj?
        AEMPTY=.TRUE.                           ! no, old might, flag.
        GO TO 200
100     IF(NOADJS(SCHLST)) GO TO 2000           ! old have no adj?
150     SCHLST=I                                ! new is unique, or
     	                                  ! new has no adj, old does.
C
C If open or transparent, search the object itself.
C
200     IF(NOTRAN(I)) GO TO 1000
C
C Search is conducted in reverse.  All objects are checked to
C See if they are at some level of containment inside object 'I'.
C If they are at level 1, or if all links in the containment
C chain are open, visible, and have SEARCHME set, they can qualify
C as a potential match.
C
        DO 500 J=1,OLNT                         ! search objects.
          IF(NOVIS(J).OR. (.NOT.THISIT(OIDX,AIDX,J,SPCOBJ)))
     1GO TO 500                                 ! visible & match?
          X=OCAN(J)                             ! get container.
300       IF(X.EQ.I) GO TO 400                  ! inside target?
          IF(X.EQ.0) GO TO 500                  ! inside anything?
          IF(NOVIS(X).OR.NOTRAN(X).OR.
     1((OFLAG2(X).AND.SCHBT).EQ.0)) GO TO 500
          X=OCAN(X)                             ! go another level.
          GO TO 300
C
400       IF(SCHLST.EQ.0) GO TO 450             ! already got one?
          IF(AIDX.NE.0) GO TO 2000              ! adj? then ambiguous.
          IF(NOADJS(J)) GO TO 425               ! new have no adj?
          AEMPTY=.TRUE.                         ! no, ambiguous empty.
          GO TO 500
425       IF(NOADJS(SCHLST)) GO TO 2000         ! old have no adj? then amb.
450       SCHLST=J                              ! new is unique, or
     	                                  ! new has no adj, and old does.
500     CONTINUE
C
1000  CONTINUE
      IF(.NOT.AEMPTY.OR.(SCHLST.EQ.0)) RETURN   ! if none or not amb, done.
      IF(NOADJS(SCHLST)) RETURN                 ! if amb, and no adj, done.
2000  SCHLST=-SCHLST                            ! amb return.
      RETURN
C
      END

C THISIT--      Validate object vs description
C
C Declarations
C
      LOGICAL FUNCTION THISIT(OIDX,AIDX,OBJ,SPCOBJ)
      IMPLICIT INTEGER(A-Z)
      INCLUDE 'dparam.for'
C
      THISIT=.FALSE.                            ! assume no match.
      IF((SPCOBJ.NE.0).AND.(OBJ.EQ.SPCOBJ)) GO TO 500
C
C Check for object names
C
      IF(OIDX.EQ.0) RETURN                      ! no obj? lose.
      I=OIDX
100   IF(IABS(OVOC(I)).EQ.OBJ) GO TO 200        ! found it?
      I=I+1                                     ! adv to next.
      IF(OVOC(I).LT.0) GO TO 100                ! still part of list?
      RETURN                                    ! if done, lose.
C
200   IF(AIDX.EQ.0) GO TO 500                   ! no adj? done.
      I=AIDX
300   IF(IABS(AVOC(I)).EQ.OBJ) GO TO 500        ! found it?
      I=I+1                                     ! adv to next.
      IF(AVOC(I).LT.0) GO TO 300                ! still part of list?
      RETURN                                    ! if done, lose.
C
500   THISIT=.TRUE.
      RETURN
      END

C SYNMCH--      Syntax matcher
C
C Declarations
C
C This routine details on bit 4 of PRSFLG
C
      LOGICAL FUNCTION SYNMCH(X)
      IMPLICIT INTEGER(A-Z)
      INCLUDE 'dparam.for'
      LOGICAL SYNEQL,TAKEIT,DFLAG
      CHARACTER*(TEXLNT) STR
      CHARACTER*(WRDLNT) FINDVB,FINDPR,LCIFY,LCWORD
      CHARACTER*(WRDLNT+2) LCPRP1,LCPRP2

C SYNMCH, PAGE 2
C
      SYNMCH=.FALSE.
      DFLAG=(PRSFLG.AND.16).NE.0
      J=ACT                                     ! set up ptr to syntax.
      DRIVE=0                                   ! no default.
      DFORCE=0                                  ! no forced default.
      QPREP=OFLAG.AND.OPREP                     ! valid orphan prep flag.
      LIMIT=J+VVOC(J)+1                         ! compute limit.
      J=J+1                                     ! advance to next.
C
200   CALL UNPACK(J,NEWJ)                       ! unpack syntax.
      IF(DFLAG) WRITE(OUTCH,210) J,OBJ1,PREP1,DOBJ,DFL1,DFL2
210   FORMAT(' SYNMCH DOBJ INPUTS TO SYNEQL- ',6I7)
      SPREP=DOBJ.AND.VPMASK                     ! save expected prep.
      IF(SYNEQL(PREP1,OBJ1,DOBJ,DFL1,DFL2)) GO TO 1000
C
C Direct syntax match fails, try direct as indirect.
C
      IF((OBJ2.NE.0).OR.(OBJ1.EQ.0).OR.
     1(.NOT.SYNEQL(PREP1,OBJ1,IOBJ,IFL1,IFL2)))
     2GO TO 500                                 ! try direct as indirect.
      OBJ2=OBJ1                                 ! move direct to indirect.
      PREP2=PREP1
      OBJ1=0                                    ! no direct.
      PREP1=0
      DRIVE=J                                   ! save as driver.
      GO TO 3100                                ! go try to get direct obj
C
C Direct syntax match and direct-as-indirect fail.
C
500   IF(OBJ1.NE.0) GO TO 3000                  ! if direct obj, on to next.
      GO TO 2500                                ! go do defaults.
C
C Direct syntax match succeeded, try indirect.
C
1000  IF(DFLAG) WRITE(OUTCH,1010) J,OBJ2,PREP2,IOBJ,IFL1,IFL2
1010  FORMAT(' SYNMCH IOBJ INPUTS TO SYNEQL- ',6I7)
      SPREP=IOBJ.AND.VPMASK                     ! save expected prep.
      IF(SYNEQL(PREP2,OBJ2,IOBJ,IFL1,IFL2)) GO TO 6000
C
C Indirect syntax match fails.
C
      IF(OBJ2.NE.0) GO TO 3000                  ! if ind object, on to next.
2500  IF((QPREP.EQ.0).OR.(QPREP.EQ.SPREP)) DFORCE=J      ! if prep mch.
      IF((VFLAG.AND.SDRIV).NE.0) DRIVE=J        ! if driver, record.
      IF(DFLAG) WRITE(OUTCH,2510) J,QPREP,SPREP,DFORCE,DRIVE
2510  FORMAT(' SYNMCH DEFAULT SYNTAXES- ',5I7)
3000  J=NEWJ
      IF(J.LT.LIMIT) GO TO 200                  ! more to do?

C SYNMCH, PAGE 3
C
C Match has failed.  If default syntax exists, try to snarf
C orphans or GWIMs, or make new orphans.
C
3100  IF(DFLAG) WRITE(OUTCH,3110) DRIVE,DFORCE,OBJ1,OBJ2
3110  FORMAT(' SYNMCH, DRIVE=',2I6,'  OBJECTS =',2I6)
      IF(DRIVE.EQ.0) DRIVE=DFORCE               ! no driver? use force.
      IF(DRIVE.EQ.0) GO TO 10000                ! any driver?
      CALL UNPACK(DRIVE,DFORCE)                 ! unpack dflt syntax.
      LCWORD=LCIFY(FINDVB(DRIVE),2)             ! get verb string.
      LCPRP1=' '//LCIFY(FINDPR(DOBJ.AND.VPMASK),1)//' '
      LCPRP2=' '//LCIFY(FINDPR(IOBJ.AND.VPMASK),1)//' '
C
C Try to fill direct object slot if that was the problem.
C
      IF(((VFLAG.AND.SDIR).EQ.0).OR.(OBJ1.NE.0)) GO TO 4000
      OBJ1=OFLAG.AND.OOBJ1
      IF(OBJ1.EQ.0) GO TO 3500                  ! any orphan?
      IF(SYNEQL(OPREP1,OBJ1,DOBJ,DFL1,DFL2)) GO TO 4000
C
C Orphan fails, try GWIM.
C
3500  OBJ1=GWIM(DOBJ,DFW1,DFW2)                 ! get gwim.
      IF(DFLAG) WRITE(OUTCH,3530) OBJ1
3530  FORMAT(' SYNMCH- DO GWIM= ',I6)
      IF(OBJ1.GT.0) GO TO 4000                  ! test result.
      CALL ORPHAN(-1,ACT,0,0,DOBJ.AND.VPMASK,' ',PREP2,OBJ2) ! fails, orphan.
      BUNSUB=0                                  ! no EXCEPT clause.
      IF(OBJ2.GT.0) GO TO 3800                  ! if iobj, go print.
3700  WRITE(OUTCH,3750)
     1LCWORD(1:NBLEN(LCWORD)),LCPRP1(1:NBLEN(LCPRP1)+1)
3750  FORMAT(1X,A,A,'what?')
      TELFLG=.TRUE.
      RETURN
C
3800  X=IABS(ODESC2(OBJ2))                      ! get iobj description.
      READ(DBCH,REC=X) J,STR                    ! read data base.
      CALL TXCRYP(X,STR)                        ! decrypt the line.
      WRITE(OUTCH,3880) LCWORD(1:NBLEN(LCWORD)),
     1LCPRP1(1:NBLEN(LCPRP1)+1),
     2LCPRP2(1:NBLEN(LCPRP2)+1),STR(1:NBLEN(STR))
3880  FORMAT(1X,A,A,'what',A,'the ',A,'?')
      TELFLG=.TRUE.
      RETURN

C SYNMCH, PAGE 4
C
C Try to fill indirect object slot if that was the problem.
C
4000  IF(((VFLAG.AND.SIND).EQ.0).OR.(OBJ2.NE.0)) GO TO 6000
      OBJ2=OFLAG.AND.OOBJ2
      IF(OBJ2.EQ.0) GO TO 4500                  ! any orphan?
      IF(SYNEQL(OPREP2,OBJ2,IOBJ,IFL1,IFL2)) GO TO 6000
C
C Orphan fails, try GWIM.
C
4500  OBJ2=GWIM(IOBJ,IFW1,IFW2)                 ! gwim.
      IF(DFLAG) WRITE(OUTCH,4550) OBJ2
4550  FORMAT(' SYNMCH- IO GWIM= ',I6)
      IF(OBJ2.GT.0) GO TO 6000
      IF(OBJ1.GT.0) GO TO 4600                  ! if dobj, go print.
      CALL ORPHAN(-1,ACT,OFLAG.AND.OPREP1,
     1OFLAG.AND.OOBJ1,IOBJ.AND.VPMASK,' ',0,0)
      GO TO 3700
C
C Error with direct object available.
C
4600  CALL ORPHAN(-1,ACT,PREP1,OBJ1,IOBJ.AND.VPMASK,' ',0,0)
      X=IABS(ODESC2(OBJ1))                      ! get dobj description.
      READ(DBCH,REC=X) J,STR                    ! read data base.
      CALL TXCRYP(X,STR)                        ! decrypt the line.
      WRITE(OUTCH,4660) LCWORD(1:NBLEN(LCWORD)),
     1LCPRP1(1:NBLEN(LCPRP1)+1),
     2STR(1:NBLEN(STR)),LCPRP2(1:NBLEN(LCPRP2)+1)
4660  FORMAT(1X,A,A,'the ',A,A,'what?')
      TELFLG=.TRUE.
      RETURN
C
C Total chomp.
C
10000 CALL RSPEAK(601)                          ! cant do anything.
      BUNSUB=0
      RETURN

C SYNMCH, PAGE 5
C
C Now try to take individual objects and
C in general clean up the parse vector.
C
6000  IF((VFLAG.AND.SFLIP).EQ.0) GO TO 7000     ! flip?
      J=OBJ1                                    ! yes.
      OBJ1=OBJ2
      OBJ2=J
C
7000  PRSA=VFLAG.AND.SVMASK                     ! get verb.
      PRSO=OBJ1                                 ! get dir obj.
      PRSI=OBJ2                                 ! get ind obj.
      IF(.NOT.TAKEIT(PRSO,DOBJ)) RETURN         ! try take.
      IF(.NOT.TAKEIT(PRSI,IOBJ)) RETURN         ! try take.
      SYNMCH=.TRUE.
      IF(DFLAG) WRITE(OUTCH,7050) SYNMCH,PRSA,PRSO,PRSI,ACT,OBJ1,OBJ2
7050  FORMAT(' SYNMCH- RESULTS ',L1,6I7)
      RETURN
C
      END

C UNPACK-       Unpack syntax specification, adv pointer
C
C Declarations
C
      SUBROUTINE UNPACK(OLDJ,J)
      IMPLICIT INTEGER(A-Z)
      INCLUDE 'dparam.for'
C
      DO 10 I=1,11                              ! clear syntax.
        SYN(I)=0
10    CONTINUE
C
      VFLAG=VVOC(OLDJ)
      J=OLDJ+1
      IF((VFLAG.AND.SDIR).EQ.0) RETURN          ! dir object?
      DFL1=-1                                   ! assume std.
      DFL2=-1
      IF((VFLAG.AND.SSTD).EQ.0) GO TO 100       ! std object?
      DFW1=-1                                   ! yes.
      DFW2=-1
      DOBJ=VABIT+VRBIT+VFBIT
      GO TO 200
C
100   DOBJ=VVOC(J)                              ! not std.
      DFW1=VVOC(J+1)
      DFW2=VVOC(J+2)
      J=J+3
      IF((DOBJ.AND.VEBIT).EQ.0) GO TO 200       ! vbit = vfwim?
      DFL1=DFW1                                 ! yes.
      DFL2=DFW2
C
200   IF((VFLAG.AND.SIND).EQ.0) RETURN          ! ind object?
      IFL1=-1                                   ! assume std.
      IFL2=-1
      IOBJ=VVOC(J)
      IFW1=VVOC(J+1)
      IFW2=VVOC(J+2)
      J=J+3
      IF((IOBJ.AND.VEBIT).EQ.0) RETURN          ! vbit = vfwim?
      IFL1=IFW1                                 ! yes.
      IFL2=IFW2
      RETURN
C
      END

C SYNEQL-       Test for syntax equality
C
C Declarations
C
      LOGICAL FUNCTION SYNEQL(PREP,OBJ,SPREP,SFL1,SFL2)
      IMPLICIT INTEGER(A-Z)
      INCLUDE 'dparam.for'
C
      IF(OBJ.EQ.0) GO TO 100                    ! any object?
      SYNEQL=(PREP.EQ.(SPREP.AND.VPMASK)).AND.
     1(((SFL1.AND.OFLAG1(OBJ)).OR.
     2  (SFL2.AND.OFLAG2(OBJ))).NE.0)
      RETURN
C
100   SYNEQL=(PREP.EQ.0).AND.(SFL1.EQ.0).AND.(SFL2.EQ.0)
      RETURN
C
      END

C TAKEIT-       Parser based take of object
C
C Declarations
C
      LOGICAL FUNCTION TAKEIT(OBJ,SFLAG)
      IMPLICIT INTEGER(A-Z)
      INCLUDE 'dparam.for'
      LOGICAL TAKE,LIT
C
      TAKEIT=.FALSE.                            ! assume loses.
      IF((OBJ.EQ.0).OR.(OBJ.GT.STRBIT).OR.DEADF)
     1GO TO 4000                                ! null/stars/dead win.
      ODO2=ODESC2(OBJ)                          ! get desc.
      X=OCAN(OBJ)                               ! get container.
      IF((X.EQ.0).OR.((SFLAG.AND.VFBIT).EQ.0)) GO TO 500
      IF((OFLAG2(X).AND.OPENBT).NE.0) GO TO 500
      CALL RSPSUB(566,ODO2)                     ! cant reach.
      RETURN
C
500   IF((SFLAG.AND.VRBIT).EQ.0) GO TO 1000     ! shld be in room?
      IF((SFLAG.AND.VTBIT).EQ.0) GO TO 2000     ! can be taken?
C
C Should be in room (VRBIT NE 0) and can be taken (VTBIT NE 0)
C
      IF(SCHLST(0,0,HERE,0,0,OBJ).LE.0) GO TO 4000 ! if not, ok.
C
C Its in the room and can be taken.
C
      IF((OFLAG1(OBJ).AND.TAKEBT).NE.0) GO TO 3000
C
C Not takeable.  If we care, fail.
C
      IF((SFLAG.AND.VCBIT).EQ.0) GO TO 4000     ! if no care, return.
      CALL RSPSUB(445,ODO2)
      RETURN
C
C 1000--        It should not be in the room.
C 2000--        It cant be taken.
C
2000  IF((SFLAG.AND.VCBIT).EQ.0) GO TO 4000     ! if no care, return
1000  IF(SCHLST(0,0,HERE,0,0,OBJ).LE.0) GO TO 4000
      I=665                                     ! assume player.
      IF(WINNER.NE.PLAYER) I=1082
      CALL RSPSUB(I,ODO2)                       ! doesn't have it.
      RETURN
C
C 3000--        Take object.
C
3000  IF(LIT(HERE)) GO TO 3500                  ! lit?
      CALL RSPEAK(579)                          ! can't do it.
      RETURN
C
3500  SVA=PRSA                                  ! save parse vector
      SVO=PRSO
      SVI=PRSI
      PRSA=TAKEW                                ! make 'take obj'
      PRSO=OBJ
      PRSI=0                                    ! no indirect object
      TAKEIT=TAKE(.TRUE.)                       ! try to take object
      PRSA=SVA                                  ! restore parse vector.
      PRSO=SVO
      PRSI=SVI
      RETURN
C
C 4000--        Win on general principles.
C
4000  TAKEIT=.TRUE.
      RETURN
C
      END

C GWIM- Get what I mean in ambiguous situations
C
C Declarations
C
      INTEGER FUNCTION GWIM(SFLAG,SFW1,SFW2)
      IMPLICIT INTEGER(A-Z)
      INCLUDE 'dparam.for'
      LOGICAL TAKEIT,NOCARE,LIT
C
      GWIM=0                                    ! no result.
      IF(DEADF) RETURN                          ! dead? gwim disabled.
      AV=AVEHIC(WINNER)
      NOCARE=(SFLAG.AND.VCBIT).EQ.0
C
C First search adventurer
C
      IF((SFLAG.AND.VABIT).NE.0)
     1GWIM=FWIM(SFW1,SFW2,0,0,WINNER,NOCARE)
      IF((GWIM.LT.0).OR..NOT.LIT(HERE).OR.
     1 ((SFLAG.AND.VRBIT).EQ.0)) RETURN
C
C Also search room
C
100   ROBJ=FWIM(SFW1,SFW2,HERE,0,0,NOCARE)
      IF(ROBJ) 500,600,200                      ! test result.
C
C ROBJ > 0: if prev object, fail
C
200   IF((AV.EQ.0).OR.(ROBJ.EQ.AV).OR.
     1((OFLAG2(ROBJ).AND.FINDBT).NE.0)) GO TO 300
      IF(OCAN(ROBJ).NE.AV) RETURN               ! unreachable? use prev obj.
C
300   IF(GWIM.EQ.0) GO TO 400                   ! prev obj?
      GWIM=-GWIM                                ! yes, ambiguous.
      RETURN
C
400   IF(.NOT.TAKEIT(ROBJ,SFLAG)) RETURN        ! if untakeable, return prev.
500   GWIM=ROBJ                                 ! return room seach.
600   RETURN
C
      END

C NOADJS-       See if any adjectives for object
C
C Declarations
C
      LOGICAL FUNCTION NOADJS(OBJ)
      IMPLICIT INTEGER(A-Z)
      INCLUDE 'dparam.for'
C
      NOADJS=.FALSE.                            ! assume false.
      DO 100 I=1,AVMAX                          ! search adj.
        IF(IABS(AVOC(I)).EQ.OBJ) RETURN         ! found adjective?
        IF(AVOC(I).EQ.0) GO TO 200              ! end of list?
100   CONTINUE
200   NOADJS=.TRUE.                             ! true.
      RETURN
C
      END

C LCIFY-        "Lower case"-ify a string for printing
C
C Declarations
C
      CHARACTER*(*) FUNCTION LCIFY(STRING,START)
      IMPLICIT INTEGER(A-Z)
      CHARACTER*(*) STRING
C
      LCIFY=STRING                              ! assume input = output.
      K=LEN(STRING)                             ! get input length.
      IF(START.GT.K) RETURN                     ! anything to convert?
C
      ULCVT=ICHAR('a')-ICHAR('A')               ! conversion factor
      DO 100 I=START,K                          ! loop on characters
        IF((STRING(I:I).GE.'A').AND.(STRING(I:I).LE.'Z'))
     1LCIFY(I:I)=CHAR(ICHAR(STRING(I:I))+ULCVT)
100   CONTINUE
      RETURN
C
      END

C FINDVB-       Find verb string corresponding to syntax.
C
C Declarations
C
      CHARACTER*(*) FUNCTION FINDVB(SYNTAX)
      IMPLICIT INTEGER(A-Z)
      INCLUDE 'dparam.for'
C
      J=1
      DO 100 K=1,VWMAX                          ! loop through verbs
        NEWJ=J+VVOC(J)+1                        ! start of next syntax
        IF((J.LE.SYNTAX).AND.(SYNTAX.LT.NEWJ)) GO TO 200
        IF(VWORD(K)(1:1).NE.'*') J=NEWJ         ! if last synonym, advance.
100   CONTINUE
      FINDVB=' '                                ! disaster
      RETURN
C
200   FINDVB=VWORD(K)                           ! return string
      IF(VWORD(K)(1:1).EQ.'*') FINDVB=VWORD(K)(2:WRDLNT)
      RETURN
C
      END

C FINDPR-       Find preposition string corresponding to index.
C
C Declarations
C
      CHARACTER*(*) FUNCTION FINDPR(PREPNO)
      IMPLICIT INTEGER(A-Z)
      INCLUDE 'dparam.for'
C
      DO 100 I=1,PWMAX                          ! loop through prepositions.
        IF(PVOC(I).EQ.PREPNO) GO TO 200
100   CONTINUE
      FINDPR=' '
      RETURN
C
200   FINDPR=PWORD(I)
      RETURN
C
      END
