1 C Parser for DUNGEON
   2 C
   3 C COPYRIGHT 1980, 1990, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA.
   4 C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
   5 C WRITTEN BY R. M. SUPNIK
   6 C
   7 C 29-Sep-94         RMS       Fixed bugs in PLAY WITH, ALL BUT, GWIM, THISIT, IT.
   8 C                             Fixed vocabularly for ROCK, LIGHT, GATES, STACK,
   9 C                             BLIND.  Added COUNT, PERUSE, BLESSING, GHOSTS,
  10 C                             SPIRITS, CLIFFS, CORPSES, OUTPUT, CHIMNEY,
  11 C                             ZORKMID adjective, DIGBT flag.
  12 C 30-Jan-94         RMS       Fixed bug in error message.
  13 C 30-Jun-92         RMS       Changed file names to lower case.
  14 C 29-Jun-92         RMS       Removed extraneous declaration from SPARSE.
  15 C                             Added dummy argument to SYNMCH.
  16 C
  17 C RDLINE- Read input line
  18 C
  19 C Declarations
  20 C
  21           SUBROUTINE RDLINE(INLINE,INLEN,WHO)
  22           IMPLICIT INTEGER(A-Z)
  23           %include dparam
  24           CHARACTER*(TEXLNT) INLINE
  25 C
  26           LUCVT=ICHAR('A')-ICHAR('a')             ! case conversion factor.
  27 5         GO TO (90,10),WHO+1                     ! see who to prompt for.
  28 10        WRITE(OUTCH,50)                                   ! prompt for game.
  29 50        FORMAT(' >',$)
  30 C
  31 90        READ(INPCH,100,END=5) INLINE            ! get input.
  32 100       FORMAT(A)
  33 C
  34           INLEN=NBLEN(INLINE)                     ! len w/o trailing blanks.
  35           IF(INLEN.LE.0) GO TO 5                            ! anything left?
  36           DO 400 I=1,INLEN                        ! convert to upper case.
  37             IF((INLINE(I:I).GE.'a').AND.(INLINE(I:I).LE.'z'))
  38           &         INLINE(I:I)=CHAR(ICHAR(INLINE(I:I))+LUCVT)
  39 400       CONTINUE
  40           PRSCON=1                                ! restart lex scan.
  41           RETURN
  42           END
  43 C page
  44 C PARSE-  Top level parse routine
  45 C
  46 C Declarations
  47 C
  48 C This routine details on bit 0 of PRSFLG
  49 C
  50           LOGICAL FUNCTION PARSE(INLINE,INLEN,VBFLAG)
  51           IMPLICIT INTEGER(A-Z)
  52           %include dparam
  53           CHARACTER*(TEXLNT) INLINE
  54           CHARACTER*(WRDLNT) OUTBUF(LEXMAX),BAKBUF(LEXMAX)
  55           LOGICAL LEX,SYNMCH,DFLAG,VBFLAG
  56           SAVE BAKBUF,BAKLEN
  57           DATA BAKBUF(1)/'L'/,BAKLEN/1/
  58 C
  59 C old     DFLAG=(PRSFLG.AND.1).NE.0
  60           DFLAG=AND(PRSFLG,1).NE.0
  61           PARSE=.FALSE.                                     ! assume fails.
  62           PRSA=0                                            ! zero outputs.
  63           PRSI=0
  64           PRSO=0
  65 C
  66           IF(.NOT.LEX(INLINE,INLEN,OUTBUF,OUTLEN,VBFLAG)) GO TO 1000
  67           IF((OUTLEN.NE.1).OR.(OUTBUF(1).NE.'AGAIN')) GO TO 100
  68           DO 50 I=1,LEXMAX                        ! use previous
  69             OUTBUF(I)=BAKBUF(I)
  70 50        CONTINUE
  71           OUTLEN=BAKLEN                                     ! buffer and length.
  72 100       IF(SPARSE(OUTBUF,OUTLEN,VBFLAG)) 1000,200,300     ! do syn scan.
  73 C
  74 C Parse requires validation
  75 C
  76 200       IF(.NOT.VBFLAG) GO TO 350               ! echo mode, force fail.
  77           IF(.NOT.SYNMCH(X)) GO TO 1000           ! do syn match.
  78           IF(PRSO.EQ.BUNOBJ) LASTIT=BUNVEC(1)     ! record for "it".
  79           IF((PRSO.GT.0).AND.(PRSO.LT.BUNOBJ)) LASTIT=PRSO
  80 C
  81 C Successful parse or successful validation
  82 C
  83 300       PARSE=.TRUE.
  84 350       CALL ORPHAN(0,0,0,0,0,' ',0,0)                    ! clear orphans.
  85           DO 400 I=1,LEXMAX                       ! save command
  86             BAKBUF(I)=OUTBUF(I)
  87 400       CONTINUE
  88           BAKLEN=OUTLEN                                     ! save length
  89           IF(DFLAG) WRITE(OUTCH,500) PARSE,PRSA,PRSO,PRSI
  90 500       FORMAT(' PARSE RESULTS- ',L7,3I7)
  91           RETURN
  92 C
  93 C Parse fails, disallow continuation
  94 C
  95 1000      PRSCON=1
  96           IF(DFLAG) WRITE(OUTCH,500) PARSE,PRSA,PRSO,PRSI
  97           RETURN
  98 C
  99           END
 100 C page
 101 C LEX-    Lexical analyzer
 102 C
 103 C Declarations
 104 C
 105 C This routine details on bit 1 of PRSFLG
 106 C
 107           LOGICAL FUNCTION LEX(INLINE,INLEN,OUTBUF,OP,VBFLAG)
 108           IMPLICIT INTEGER(A-Z)
 109           %include dparam
 110           CHARACTER*(TEXLNT) INLINE
 111           CHARACTER*(WRDLNT) OUTBUF(LEXMAX)
 112           CHARACTER*1 J
 113           LOGICAL DFLAG,VBFLAG
 114 C
 115 C old     DFLAG=(PRSFLG.AND.2).NE.0
 116           DFLAG=AND(PRSFLG,2).NE.0
 117           LEX=.FALSE.                                       ! assume lex fails.
 118           OP=0                                              ! output ptr.
 119           DO 10 I=1,LEXMAX                        ! clear output buf.
 120             OUTBUF(I)=' '
 121 10        CONTINUE
 122 C
 123 50        OP=OP+1                                           ! adv output ptr.
 124           CP=0                                              ! char ptr=0.
 125 C
 126 200       IF(PRSCON.GT.INLEN) GO TO 2000                    ! end of input?
 127           J=INLINE(PRSCON:PRSCON)                           ! no, get character,
 128           IF((J.EQ.'"').OR.(J.EQ.'''')) GO TO 3000! substring?
 129           PRSCON=PRSCON+1                                   ! advance ptr.
 130           IF(J.EQ.' ') GO TO 1000                           ! space?
 131           IF((J.EQ.'.').OR.(J.EQ.';').OR.
 132           &  (J.EQ.'!').or.(J.EQ.'?')) GO TO 2000 ! end of command?
 133           IF(J.EQ.',') GO TO 4000                           ! comma?
 134           IF(OP.GT.LEXMAX) GO TO 5000             ! too many tokens?
 135           CP=CP+1                                           ! adv char ptr.
 136           IF(CP.LE.WRDLNT) OUTBUF(OP)(CP:CP)=J    ! insert char in word.
 137           GO TO 200
 138 C
 139 C Space.
 140 C
 141 1000      IF(CP.EQ.0) GO TO 200                             ! any word yet?
 142           GO TO 50                                ! yes, adv op.
 143 C
 144 C End of input, see if partial word available.
 145 C
 146 2000      IF(PRSCON.GT.INLEN) PRSCON=1            ! force parse restart.
 147           IF((CP.EQ.0).AND.(OP.EQ.1)) RETURN      ! any results?
 148           IF(CP.EQ.0) OP=OP-1                     ! any last word?
 149           LEX=.TRUE.
 150           IF(DFLAG) WRITE(OUTCH,2020) CP,OP,PRSCON,(OUTBUF(I),I=1,OP)
 151 2020      FORMAT(' LEX RESULTS- ',3I7/1X,8(A,1X))
 152           RETURN
 153 C
 154 C Substring, J is delimiter.
 155 C
 156 3000      IF(SUBLNT.NE.0) GO TO 3400              ! already got one?
 157 3100      PRSCON=PRSCON+1                                   ! skip initial quote.
 158           IF(PRSCON.GT.INLEN) GO TO 3500                    ! any more characters?
 159           IF(INLINE(PRSCON:PRSCON).EQ.' ') GO TO 3100       ! skip blanks.
 160           K=INDEX(INLINE(PRSCON:INLEN),J)                   ! find closing quote.
 161           IF(K.LE.1) GO TO 3500                             ! none or empty?
 162           SUBBUF=INLINE(PRSCON:PRSCON+K-2)        ! set up substring buffer,
 163           SUBLNT=K-1                                        ! length.
 164           PRSCON=PRSCON+K                                   ! skip over string.
 165           IF(DFLAG) WRITE(OUTCH,3030) SUBLNT,SUBBUF(1:SUBLNT)
 166 3030      FORMAT(' SUBSTRING- ',I7,' "',A,'"')
 167           GO TO 1000                                        ! treat as end of word.
 168 C
 169 3400      IF(VBFLAG) CALL RSPEAK(1046)            ! multiple substrings.
 170           RETURN
 171 C
 172 3500      IF(VBFLAG) CALL RSPEAK(616)             ! bad substring.
 173           RETURN                                            ! fails.
 174 C
 175 C Comma.
 176 C
 177 4000      IF(CP.NE.0) OP=OP+1                     ! if partial word, go to next.
 178           IF(OP.EQ.1) GO TO 4500                            ! no first word? die.
 179           IF(OP.GT.LEXMAX) GO TO 5000             ! too many tokens?
 180           OUTBUF(OP)='AND'                        ! insert 'AND'.
 181           GO TO 50                                ! start new word
 182 C
 183 4500      IF(VBFLAG) CALL RSPEAK(1047)            ! misplaced comma.
 184           RETURN
 185 C
 186 C Too many tokens.
 187 C
 188 5000      IF(VBFLAG) CALL RSPEAK(1048)            ! too many tokens.
 189           RETURN
 190 C
 191           END
 192 C page
 193 C SPARSE- Start of parse
 194 C
 195 C Declarations
 196 C
 197 C This routine details on bit 2 of PRSFLG
 198 C
 199           INTEGER FUNCTION SPARSE(LBUF,LLNT,VBFLAG)
 200           IMPLICIT INTEGER(A-Z)
 201           %include dparam
 202           CHARACTER*(WRDLNT) LBUF(LEXMAX),WORD,LCWORD,LCIFY
 203           CHARACTER*(WRDLNT+2) LCWRD1
 204           LOGICAL LIT,DFLAG,VBFLAG,ANDFLG,BUNFLG
 205           INTEGER OBJVEC(2),PRPVEC(2)
 206           EQUIVALENCE (OBJVEC(1),OBJ1),(PRPVEC(1),PREP1)
 207 C page
 208 C SPARSE, PAGE 7
 209 C
 210 C Set up for parsing
 211 C
 212           SPARSE=-1                               ! assume parse fails.
 213           ADJ=0                                             ! clear parts holders.
 214           ACT=0
 215           PREP=0
 216           PPTR=0
 217           OBJ1=0
 218           OBJ2=0
 219           PREP1=0
 220           PREP2=0
 221           LOBJ=0
 222           ANDFLG=.FALSE.
 223           BUNFLG=.FALSE.
 224 C old     DFLAG=(PRSFLG.AND.4).NE.0
 225           DFLAG=AND(PRSFLG,4).NE.0
 226 C page
 227 C SPARSE, PAGE 8
 228 C
 229 C Now loop over input buffer of lexical tokens.
 230 C
 231           I=0
 232 10        I=I+1                                             ! do 1000 i=1,llnt
 233             WORD=LBUF(I)                                    ! get current token.
 234             ERRVOC=0                                        ! assume won't find
 235             IF(WORD.EQ.' ') GO TO 1000            ! blank? ignore.
 236             IF(WORD.EQ.'AND') GO TO 1500                    ! 'AND'?
 237             IF((WORD.EQ.'EXCEPT').OR.(WORD.EQ.'BUT')) GO TO 2500
 238 C
 239 C Check for buzz word
 240 C
 241             DO 50 J=1,BWMAX
 242               IF(WORD.EQ.BWORD(J)) GO TO 1000     ! if match, ignore.
 243 50          CONTINUE
 244 C
 245 C Check for action or direction
 246 C
 247             J=1                                             ! check for action.
 248             DO 70 K=1,VWMAX
 249               IF(VWORD(K)(1:1).EQ.'*') GO TO 65   ! synonym?
 250               IF(WORD.EQ.VWORD(K)) GO TO 2000     ! match to base word?
 251               J=J+VVOC(J)+1                       ! skip over syntax.
 252               GO TO 70
 253 65            IF(WORD.EQ.VWORD(K)(2:WRDLNT)) GO TO 2000 ! synonym match?
 254 70          CONTINUE
 255 C
 256 75          IF((ADJ.NE.0).OR.(PREP.NE.0).OR.(OBJ1.NE.0)) GO TO 200
 257             IF(ACT.EQ.0) GO TO 80                           ! any verb yet?
 258 C old       IF((VVOC(ACT+1).AND.SVMASK).NE.WALKW) GO TO 200 ! walk?
 259             IF(AND(VVOC(ACT+1),SVMASK).NE.WALKW) GO TO 200  ! walk?
 260 80          DO 100 J=1,DWMAX                      ! then chk for dir.
 261               IF(WORD.EQ.DWORD(J)) GO TO 3000     ! match to direction?
 262 100         CONTINUE
 263 C
 264 C Not an action, check for preposition, adjective, or object.
 265 C
 266 200         DO 250 J=1,PWMAX                      ! look for preposition.
 267               IF(WORD.EQ.PWORD(J)) GO TO 4000     ! match to preposition?
 268 250         CONTINUE
 269 C
 270             J=1                                             ! look for adjective.
 271             DO 350 K=1,AWMAX
 272               IF(WORD.EQ.AWORD(K)) GO TO 5000     ! match to adjective?
 273 300           J=J+1                               ! advance to next entry.
 274               IF(AVOC(J).LT.0) GO TO 300                    ! found next entry yet?
 275 350         CONTINUE
 276 C
 277 400         J=1                                             ! look for object.
 278             DO 550 K=1,OWMAX
 279               IF(WORD.EQ.OWORD(K)) GO TO 6000     ! match to object?
 280 500           J=J+1                               ! advance to next entry.
 281               IF(OVOC(J).LT.0) GO TO 500                    ! found next entry yet?
 282 550         CONTINUE
 283 C
 284 C Not recognizable
 285 C
 286             IF(.NOT.VBFLAG) RETURN                ! if mute, return
 287             LCWORD=LCIFY(WORD,1)                            ! convert to lower case
 288             WRITE(OUTCH,600) LCWORD(1:NBLEN(LCWORD)) ! don't recognize
 289 600         FORMAT(' I don''t understand "',A,'".')
 290             CALL RSPEAK(ERRVOC)                             ! if extra verb, say so
 291 800         TELFLG=.TRUE.                                   ! something said.
 292             BUNSUB=0                                        ! no valid EXCEPT clause.
 293             RETURN
 294 C page
 295 C SPARSE, PAGE 9
 296 C
 297 1000      IF(I.LT.LLNT) GO TO 10                            ! end of do loop
 298 C
 299 C At end of parse, check for:
 300 C         1. dangling adjective
 301 C         2. bunched object
 302 C         3. simple directions
 303 C         4. orphan preposition
 304 C         5. dangling preposition
 305 C
 306           IF(ADJ.NE.0) GO TO 4500                           ! dangling adjective?
 307           IF(BUNFLG) OBJ1=BUNOBJ                            ! bunched object?
 308           IF(BUNFLG.AND.(BUNSUB.NE.0).AND.(BUNLNT.EQ.0))
 309           &         GO TO 13200                             ! except for nothing?
 310 C old     IF(ACT.EQ.0) ACT=OFLAG.AND.OACT                   ! if no action, take orphan.
 311           IF(ACT.EQ.0) ACT=AND(OFLAG,OACT)                  ! if no action, take orphan.
 312           IF(ACT.EQ.0) GO TO 10000                ! no action, punt.
 313 C old     IF(((VVOC(ACT+1).AND.SVMASK).NE.WALKW).OR.(OBJ1.LT.XMIN))
 314 C old     &         GO TO 1100                              ! simple direction?
 315           IF((AND(VVOC(ACT+1),SVMASK).NE.WALKW).OR.(OBJ1.LT.XMIN))
 316           &         GO TO 1100                              ! simple direction?
 317           IF ((OBJ2.NE.0).OR.(PREP1.NE.0).OR.(PREP2.NE.0))
 318           &         GO TO 1050                              ! no extra junk?
 319           PRSA=WALKW                                        ! yes, win totally.
 320           PRSO=OBJ1
 321           SPARSE=1                                ! special return value.
 322           RETURN
 323 C
 324 1050      IF(VBFLAG) CALL RSPEAK(618)             ! direction+junk, fail.
 325           GO TO 800                               ! clean up state.
 326 C
 327 1100      IF((OFLAG.NE.0).AND.(OPREP.NE.0).AND.(PREP.EQ.0).AND.
 328           &         (OBJ1.NE.0).AND.(OBJ2.EQ.0).AND.(ACT.EQ.OACT))
 329           &         GO TO 11000
 330 C
 331           IF(PREP.EQ.0) GO TO 1200                ! if dangling prep,
 332           IF(PPTR.EQ.0) GO TO 12000               ! and no object, die;
 333           IF(PRPVEC(PPTR).NE.0) GO TO 12000       ! and prep already, die;
 334           PRPVEC(PPTR)=PREP                       ! cvt to 'pick up frob'.
 335 1200      SPARSE=0                                ! parse succeeds.
 336           IF(DFLAG) WRITE(OUTCH,1310) ACT,OBJ1,OBJ2,PREP1,PREP2
 337 1310      FORMAT(' SPARSE RESULTS- ',5I7)
 338           RETURN
 339 C page
 340 C SPARSE, PAGE 10
 341 C
 342 C 1500--  AND
 343 C
 344 1500      IF(ADJ.NE.0) GO TO 4100                           ! dangling adj? treat as obj.
 345           IF((PREP.NE.0).OR.(PPTR.NE.1)) GO TO 8000         ! prep or not dir obj?
 346           ANDFLG=.TRUE.                                     ! flag 'AND'.
 347           GO TO 1000                                        ! done.
 348 C
 349 C 2000--  Action
 350 C
 351 2000      IF(ACT.EQ.0) GO TO 2100                           ! got one already?
 352           ERRVOC=624                                        ! flag for error report.
 353           GO TO 75                                ! try to construe differently.
 354 C
 355 2100      ACT=J                                             ! save index to verb.
 356           OACT=0                                            ! no orphan.
 357           ANDFLG=.FALSE.                                    ! clear 'AND' flag.
 358           IF(DFLAG) WRITE(OUTCH,2020) J
 359 2020      FORMAT(' SPARSE- ACT AT ',I6)
 360           GO TO 1000                                        ! done.
 361 C
 362 C 2500--  EXCEPT/BUT
 363 C
 364 2500      IF(ADJ.NE.0) GO TO 4100                           ! dangling adjective?
 365           IF(ANDFLG.OR.BUNFLG.OR.(PPTR.NE.1).OR.
 366           &         (I.GE.LLNT)) GO TO 13000      ! not in right place?
 367           IF(LBUF(I+1).NE.'FOR') GO TO 2600       ! except for?
 368           I=I+1                                             ! skip over.
 369           IF(I.GE.LLNT) GO TO 13000               ! out of text?
 370 2600      IF((OBJ1.NE.EVERY).AND.(OBJ1.NE.VALUA).AND.
 371           &  (OBJ1.NE.POSSE)) GO TO 13100                   ! "collective" EXCEPT?
 372           ANDFLG=.TRUE.                                     ! force next object
 373           BUNFLG=.TRUE.                                     ! into bunch vector.
 374           BUNLNT=0                                ! start at top.
 375           BUNSUB=OBJ1                                       ! remember collective.
 376           GO TO 1000                                        ! on to next word.
 377 C
 378 C 3000--  Direction
 379 C                   Don't need to check for ambiguous use as adjective;
 380 C                   only possible overlap is north/south/east/west wall;
 381 C                   and global wall takes is found if no adjective given.
 382 C
 383 3000      OBJ=DVOC(J)                                       ! save direction.
 384           ACT=1                                             ! find value for action.
 385 3600      IF(VVOC(ACT).EQ.0) CALL BUG(310,ACT)    ! can't find walk.
 386 C old     IF((VVOC(ACT+1).AND.SVMASK).EQ.WALKW) GO TO 6300 ! treat as obj.
 387           IF(AND(VVOC(ACT+1),SVMASK).EQ.WALKW) GO TO 6300 ! treat as obj.
 388           ACT=ACT+VVOC(ACT)+1                     ! to next syntax entry.
 389           GO TO 3600
 390 C
 391 C 4000--  Preposition (or dangling adjective at end of parse)
 392 C
 393 4000      IF(ADJ.EQ.0) GO TO 4600                           ! dangling adjective?
 394 4100      I=I-1                                             ! back up parse stream.
 395 4500      WORD=AWORD(ADJPTR)                      ! get adjective string.
 396           ADJ=0                                             ! now an object.
 397           GO TO 400                               ! go search object words.
 398 C
 399 4600      IF(ANDFLG) GO TO 8000                             ! 'AND' pending?
 400           IF(PREP.NE.0) GO TO 1000                ! already have one? ignore.
 401           PREP=PVOC(J)                                      ! no, get index.
 402           IF(DFLAG) WRITE(OUTCH,4030) J
 403 4030      FORMAT(' SPARSE- PREP AT ',I6)
 404           GO TO 1000
 405 C
 406 C 5000--  Adjective
 407 C
 408 5000      ADJ=J                                             ! save adjective.
 409           ADJPTR=K                                ! save string pointer.
 410           IF((I.LT.LLNT).OR.(OFLAG.EQ.0).OR.(ONAME.EQ.' '))
 411           &         GO TO 1000                              ! last word + orphan string?
 412           IF(DFLAG) WRITE(OUTCH,5040) ADJ,ONAME   ! have orphan.
 413 5040      FORMAT(' SPARSE- ADJ AT ',I6,' ORPHAN= ',A)
 414           WORD=ONAME                                        ! get object string.
 415           GO TO 400                               ! go search object names.
 416 C
 417 C 6000--  Object
 418 C
 419 6000      OBJ=GETOBJ(J,ADJ,0)                     ! identify object.
 420           IF(DFLAG) WRITE(OUTCH,6010) J,OBJ
 421 6010      FORMAT(' SPARSE- OBJ AT ',I6,'  OBJ= ',I6)
 422           IF(OBJ.LE.0) GO TO 7000                           ! if le, couldnt.
 423           IF(OBJ.NE.ITOBJ) GO TO 6100             ! "it"?
 424 C old     IF((OFLAG.AND.OOBJ1).NE.0) LASTIT=OFLAG.AND.OOBJ1 ! orphan?
 425           IF(AND(OFLAG,OOBJ1).NE.0) LASTIT=AND(OFLAG,OOBJ1) ! orphan?
 426           OBJ=GETOBJ(0,0,LASTIT)                            ! find it.
 427           IF(OBJ.LE.0) GO TO 7500                           ! if le, couldnt.
 428 C
 429 6100      IF(PREP.NE.9) GO TO 6200                ! "of" obj?
 430           IF((LOBJ.EQ.OBJ).OR.(LOBJ.EQ.OCAN(OBJ))) GO TO 6500         ! same as prev?
 431           IF((LOBJ.EQ.EVERY).AND.((OBJ.EQ.VALUA).OR.(OBJ.EQ.POSSE)))
 432           &         GO TO 6350                              ! all of "collective"?
 433 6150      IF(VBFLAG) CALL RSPEAK(601)             ! doesn't work
 434           GO TO 800                               ! clean up state.
 435 C
 436 6200      IF(.NOT.ANDFLG) GO TO 6300              ! 'AND' pending?
 437           IF(BUNFLG) GO TO 6250                             ! first object?
 438           BUNVEC(1)=OBJVEC(PPTR)                            ! put preceding obj in vector.
 439           BUNLNT=1
 440           BUNFLG=.TRUE.                                     ! flag bunch of objects.
 441           BUNSUB=0                                ! no EXCEPT/BUT clause.
 442 6250      BUNLNT=BUNLNT+1                                   ! advance bunch pointer.
 443           IF(BUNLNT.GT.BUNMAX) GO TO 9000                   ! too many objects?
 444           BUNVEC(BUNLNT)=OBJ                      ! add to bunch vector.
 445           GO TO 6500
 446 C
 447 6300      IF(PPTR.EQ.2) GO TO 9000                ! too many objs?
 448           PPTR=PPTR+1
 449           PRPVEC(PPTR)=PREP
 450 6350      OBJVEC(PPTR)=OBJ                        ! stuff into vector.
 451 6500      PREP=0
 452           ADJ=0
 453           ANDFLG=.FALSE.                                    ! no pending 'AND'.
 454           LOBJ=OBJ                                ! record last object.
 455           GO TO 1000
 456 C page
 457 C SPARSE, PAGE 11
 458 C
 459 C 7000--  Unidentifiable object (index into OVOC is J)
 460 C
 461 7000      LCWORD=LCIFY(WORD,1)                              ! convert obj to lower case.
 462           LCWRD1=' '                                        ! assume no adjective
 463           IF(ADJ.NE.0) LCWRD1=' '//LCIFY(AWORD(ADJPTR),1)//' '
 464           IF(OBJ.LT.0) GO TO 7200                           ! ambiguous or unreachable?
 465           IF(LIT(HERE)) GO TO 7100                ! lit?
 466           IF(VBFLAG) CALL RSPEAK(579)             ! not lit, report.
 467           GO TO 800                               ! go clean up state.
 468 C
 469 7100      IF(VBFLAG) WRITE(OUTCH,7110)
 470           &         LCWRD1(1:NBLEN(LCWRD1)+1),LCWORD(1:NBLEN(LCWORD))
 471 7110      FORMAT(' I can''t see any',A,A,' here.')
 472           GO TO 800                               ! go clean up state.
 473 C
 474 7200      IF(OBJ.NE.-10000) GO TO 7300            ! inside vehicle?
 475           IF(VBFLAG) CALL RSPSUB(620,ODESC2(AVEHIC(WINNER)))
 476           GO TO 800                               ! go clean up state.
 477 C
 478 C old 7300          IF(ACT.EQ.0) ACT=OFLAG.AND.OACT                   ! if no act, get orphan.
 479 7300      IF(ACT.EQ.0) ACT=AND(OFLAG,OACT)                  ! if no act, get orphan.
 480           CALL ORPHAN(-1,ACT,PREP1,OBJ1,PREP,WORD,0,0)      ! orphan the world.
 481           IF(VBFLAG) WRITE(OUTCH,7310)
 482           &         LCWRD1(1:NBLEN(LCWRD1)+1),LCWORD(1:NBLEN(LCWORD))
 483 7310      FORMAT(' Which',A,A,' do you mean?')
 484           GO TO 800                               ! go clean up state.
 485 C
 486 C 7500--  Unidentifiable 'IT' (last direct object is LASTIT).
 487 C
 488 7500      IF(OBJ.LT.0) GO TO 7200                           ! if lt, must be unreachable.
 489           IF(LIT(HERE)) GO TO 7600                ! lit?
 490           IF(VBFLAG) CALL RSPEAK(1076)            ! lose.
 491           GO TO 800                               ! go clean up state.
 492 C
 493 7600      IF(VBFLAG) CALL RSPSUB(1077,ODESC2(LASTIT))       ! don't see it.
 494           GO TO 800                               ! go clean up state.
 495 C
 496 C 8000--  Misplaced 'AND'.
 497 C
 498 8000      IF(VBFLAG) CALL RSPEAK(1049)
 499           GO TO 800                               ! go clean up state.
 500 C
 501 C 9000--  Too many objects.
 502 C
 503 9000      IF(VBFLAG) CALL RSPEAK(617)
 504           GO TO 800                               ! go clean up state.
 505 C
 506 C 10000-- No action, punt.
 507 C
 508 10000     IF(OBJ1.EQ.0) GO TO 10100               ! any direct object?
 509           IF(VBFLAG) CALL RSPSUB(621,ODESC2(OBJ1))          ! what to do?
 510           CALL ORPHAN(-1,0,PREP1,OBJ1,0,' ',0,0)
 511           RETURN
 512 C
 513 10100     IF(VBFLAG) CALL RSPEAK(622)             ! huh?
 514           GO TO 800                               ! go clean up state.
 515 C
 516 C 11000-- Orphan preposition.  Conditions are
 517 C                   OBJ1.NE.0, OBJ2=0, PREP=0, ACT=OACT
 518 C
 519 11000     IF(OOBJ1.NE.0) GO TO 11500              ! orphan object?
 520           PREP1=OPREP                                       ! no, just use prep.
 521           GO TO 1200
 522 C
 523 11500     OBJ2=OBJ1                               ! yes, use as direct obj.
 524           PREP2=OPREP
 525           OBJ1=OOBJ1
 526           PREP1=OPREP1
 527           GO TO 1200
 528 C
 529 C 12000-- True hanging preposition, no objects yet.
 530 C
 531 12000     CALL ORPHAN(-1,ACT,0,0,PREP,' ',0,0)    ! orphan prep.
 532           GO TO 1200
 533 C
 534 C 13000-- EXCEPT/BUT errors.
 535 C
 536 13000     LCWORD=LCIFY(WORD,1)
 537           IF(VBFLAG) WRITE(OUTCH,13010) LCWORD(1:NBLEN(LCWORD))       ! wrong place.
 538 13010     FORMAT(' Misplaced "',A,'".')
 539           GO TO 800                               ! go clean up state.
 540 C
 541 13100     LCWORD=LCIFY(WORD,2)                                        ! wrong case.
 542           IF(VBFLAG) WRITE(OUTCH,13110) LCWORD(1:NBLEN(LCWORD))       ! not coll.
 543 13110     FORMAT(' "',A,'" can only be used with "everything",',
 544           & ' "valuables", or "possessions".')
 545           GO TO 800                               ! go clean up state.
 546 C
 547 13200     IF(VBFLAG) CALL RSPEAK(619)             ! no objects.
 548           GO TO 800                               ! go clean up state.
 549 C
 550           END
 551 C page
 552           BLOCK DATA BAR
 553           IMPLICIT INTEGER(A-Z)
 554           %include dparam
 555 C SPARSE, PAGE 2
 556 C
 557 C Vocabularies
 558 C
 559 C Buzz words--      ignored in syntactic processing
 560 C
 561           DATA BWORD/'BY','IS','A','AN','THE','AM','ARE',
 562           &         'TODAY','MY','YOUR','OUR','HIS'/
 563 C
 564 C Prepositions--    maps prepositions to indices
 565 C
 566           DATA PWORD/'OVER','WITH','USING','AT','TO',
 567           &         'IN','INSIDE','INTO','DOWN','UP',
 568           &         'UNDER','OF','ON','OFF','FOR',
 569           &         'FROM','OUT','THROUGH',' ',' '/
 570 C
 571           DATA PVOC/1,2,2,3,4,
 572           &         5,5,5,6,7,
 573           &         8,9,10,11,12,
 574           &         13,13,14,0,0/
 575 C
 576 C Directions--      maps directions to indices
 577 C
 578           DATA DWORD/'N','NORTH','S','SOUTH',
 579           & 'E','EAST','W','WEST',
 580           & 'SE','SW','NE','NW',
 581           & 'U','UP','D','DOWN',
 582           & 'LAUNCH','LAND','EXIT','OUT',
 583           & 'TRAVEL','IN','CROSS',' ',' '/
 584 C
 585           DATA DVOC/XNORTH,XNORTH,XSOUTH,XSOUTH,
 586           & XEAST,XEAST,XWEST,XWEST,
 587           & XSE,XSW,XNE,XNW,
 588           & XUP,XUP,XDOWN,XDOWN,
 589           & XLAUN,XLAND,XEXIT,XEXIT,
 590           & XCROSS,XENTER,XCROSS,0,0/
 591 C page
 592 C SPARSE, PAGE 3
 593 C
 594 C Adjectives--      maps adjectives to object numbers
 595 C
 596 C Each string entry in aword corresponds to a list of one or more
 597 C object numbers in AVOC.  Object entries are delimited by the first
 598 C object being positive, and all subsequent objects in the same entry
 599 C being negative.
 600 C
 601           DATA (AWORD(I),I=1,40) /
 602           & 'BROWN','ELONGATE','HOT','PEPPER',
 603           & 'VITREOUS','JADE','HUGE','ENORMOUS',
 604           & 'TROPHY','CLEAR','LARGE','NASTY',
 605           & 'ELVISH','BRASS','BROKEN','ORIENTAL',
 606           & 'BLOODY','RUSTY','BURNED-O','DEAD',
 607           & 'OLD','LEATHER','PLATINUM','PEARL',
 608           & 'MOBY','CRYSTAL','GOLD','IVORY',
 609           & 'SAPPHIRE','WOODEN','WOOD','STEEL',
 610           & 'DENTED','FANCY','ANCIENT','SMALL',
 611           & 'BLACK','TOUR','VISCOUS','VICIOUS'/
 612 C
 613           DATA (AVOC(I),I=1,112) /
 614           & 1,-81,-133,1,3,-190,3,
 615           & 4,6,8,8,-122,
 616           & 9,10,12,-26,-47,-95,-96,-123,-133,-135,-144,-145,
 617           &         -150,-176,-191,13,-19,
 618           & 14,15,-16,-46,-156,-190,16,-22,-38,-92,-113,-155,-158,17,
 619           & 20,24,-205,22,22,
 620           & 25,-41,-44,-45,-208,25,26,27,
 621           & 31,32,-126,-206,-209,33,-85,-104,-157,-158,-188,34,
 622           & 37,38,-67,-75,-93,-136,-137,-165,-173,-174,-175,-197,-204,
 623           &         38,-67,-136,-137,-165,-173,-174,-175,
 624           &         39,-105,-124,-125,-189,
 625           & 39,40,41,-44,5,-46,-52,-53,-89,-102,-103,-153,-187,
 626           & 47,-162,49,55,62/
 627 C
 628           DATA (AWORD(I),I=41,80) /
 629           & 'GLASS','TRAP','FRONT','STONE',
 630           & 'MANGLED','RED','YELLOW','BLUE',
 631           & 'VAMPIRE','MAGIC','SEAWORTH','TAN',
 632           & 'SHARP','WICKER','CLOTH','BRAIDED',
 633           & 'GAUDY','SQUARE','CLAY','SHINY',
 634           & 'THIN','GREEN','PURPLE','WHITE',
 635           & 'MARBLE','COKE','EMPTY','ROUND',
 636           & 'TRIANGUL','RARE','OBLONG','EAT-ME',
 637           & 'EATME','ORANGE','ECCH','ROCKY',
 638           & 'SHEER','200','NEAT','SHIMMERI'/
 639 C
 640           DATA (AVOC(I),I=113,179) /
 641           & 10,-126,-132,-206,-209,66,68,69,-150,-278,
 642           &         72,-124,79,-94,-140,-161,-170,-171,-190,-209,
 643           &         80,-159,82,-112,-114,-141,-206,
 644           & 83,90,-281,90,91,
 645           & 92,98,100,101,
 646           & 108,109,-127,109,110,
 647           & 110,77,-115,-143,116,117,-126,-147,-160,-266,
 648           & 119,121,121,128,
 649           & 129,134,135,138,
 650           & 138,139,141,146,
 651           & 146,148,148,151/
 652 C
 653           DATA (AWORD(I),I=81,120) /
 654           & 'ZURICH','BIRDS','ENCRUSTE','BEAUTIFU',
 655           & 'CLOCKWOR','MECHANIC','MAHOGANY','PINE',
 656           & 'LONG','CENTER','SHORT','T',
 657           & 'COMPASS','BRONZE','CELL','LOCKED',
 658           & 'SUN','BARE','SONG','NORTH',
 659           & 'NORTHERN','SOUTH','SOUTHERN','EAST',
 660           & 'EASTERN','WEST','WESTERN','DUNGEON',
 661           & 'FREE','GRANITE','LOWERED','VOLCANO',
 662           & 'MAN-SIZE','METAL','PLASTIC','SILVER',
 663           & 'USED','USELESS','SEEING','ONE-EYED'/
 664 C
 665           DATA (AVOC(I),I=180,238) /
 666           & 152,153,-154,-155,154,-155,86,-156,
 667           & 157,-158,157,-158,163,164,
 668           & 166,166,167,168,
 669           & 169,-275,172,174,-175,174,
 670           & 177,259,267,269,
 671           & 269,270,270,271,
 672           & 271,67,-272,67,-272,279,
 673           & 195,-262,265,36,111,
 674           & 93,64,-99,-200,-201,77,-87,-88,-90,59,
 675           & 22,22,126,-206,-209,58/
 676 C
 677           DATA (AWORD(I),I=121,160) /
 678           & 'HOLY','HAND-HEL','UNRUSTY','PLAIN',
 679           & 'PRICELES','SANDY','GIGANTIC','LINE-PRI',
 680           & 'FLATHEAD','FINE','SHADY','SUSPICIO',
 681           & 'CROSS','TOOL','CONTROL','DON',
 682           & 'WOODS','GOLDEN','OAK','BARRED',
 683           & 'DUSTY','NARROW','IRON','WELCOME',
 684           & 'RUBBER','SKELETON','ALL','ZORKMID',
 685           & 12*' '/
 686 C
 687           DATA (AVOC(I),I=239,282) /
 688           & 43,89,13,13,
 689           & 104,192,122,122,
 690           & 118,91,61,61,
 691           & 165,193,194,196,
 692           & 196,157,-158,197,198,-210,
 693           & 204,199,205,207,
 694           & 207,23,253,-254,104,-148,
 695           & 12*0/
 696 C page
 697 C SPARSE, PAGE 4
 698 C
 699 C OBJECTS--         Maps objects to object indices,
 700 C                   same format as AVOC.
 701 C
 702           DATA (OWORD(I),I=1,40) /
 703           & 'BAG','SACK','GARLIC','CLOVE',
 704           & 'FOOD','SANDWICH','LUNCH','DINNER',
 705           & 'GUNK','PIECE','SLAG','COAL',
 706           & 'PILE','HEAP','FIGURINE','MACHINE',
 707           & 'PDP10','VAX','DRYER','LID',
 708           & 'DIAMOND','CASE','BOTTLE','CONTAINE',
 709           & 'WATER','QUANTITY','LIQUID','H2O',
 710           & 'ROPE','HEMP','COIL','KNIFE',
 711           & 'BLADE','SWORD','ORCHRIST','GLAMDRIN',
 712           & 'LAMP','LANTERN','RUG','CARPET'/
 713 C
 714           DATA (OVOC(I),I=1,71) /
 715           & 1,-25,-100,1,2,2,
 716           & 3,3,3,3,
 717           & 4,-55,4,-143,-186,-282,4,5,
 718           & 5,-18,-38,-72,-73,-87,-88,-122,-148,5,6,7,
 719           & 7,7,7,7,-200,-201,
 720           & 8,9,-123,10,-121,10,
 721           & 11,-273,11,-273,11,-273,11,-273,
 722           & 12,-101,-282,12,12,-110,13,-24,
 723           & 13,-14,14,14,14,
 724           & 15,-16,-22,15,-16,-22,17,17/
 725 C
 726           DATA (OWORD(I),I=41,80) /
 727           & 'LEAVES','LEAF','TROLL','AXE',
 728           & 'PRAYER','KEYS','KEY','SET',
 729           & 'BONES','SKELETON','BODY','COINS',
 730           & 'BAR','NECKLACE','PEARLS','MIRROR',
 731           & 'ICE','MASS','GLACIER','RUBY',
 732           & 'TRIDENT','FORK','COFFIN','CASKET',
 733           & 'TORCH','CAGE','DUMBWAIT','BASKET',
 734           & 'BRACELET','JEWEL','TIMBER','BOX',
 735           & 'STRADIVA','VIOLIN','ENGRAVIN','INSCRIPT',
 736           & 'GHOST','SPIRIT','FIEND','GRAIL'/
 737 C
 738           DATA (OVOC(I),I=72,130) /
 739           & 18,18,19,-111,20,
 740           & 44,-47,23,23,-205,23,
 741           & 21,21,21,-72,-73,25,
 742           & 26,-165,-168,27,27,28,-29,-276,
 743           & 30,30,30,31,
 744           & 32,32,33,33,
 745           & 34,35,-36,-124,-125,35,-36,35,-36,-98,-113,
 746           & 37,37,38,39,-53,-105,
 747           & 40,40,41,41,-44,
 748           & 42,42,42,43/
 749 C
 750           DATA (OWORD(I),I=81,120) /
 751           & 'TRUNK','CHEST','BELL','BOOK',
 752           & 'BIBLE','GOODBOOK','CANDLES','PAIR',
 753           & 'GUIDEBOO','GUIDE','PAPER','NEWSPAPE',
 754           & 'ISSUE','REPORT','MAGAZINE','NEWS',
 755           & 'MATCHBOO','MATCH','MATCHES','ADVERTIS',
 756           & 'PAMPHLET','LEAFLET','BOOKLET','MAILBOX',
 757           & 'TUBE','TOOTHPAS','PUTTY','MATERIAL',
 758           & 'GLUE','WRENCH','SCREWDRI','CYCLOPS',
 759           & 'MONSTER','CHALICE','CUP','GOBLET',
 760           & 'PAINTING','ART','CANVAS','PICTURE'/
 761 C
 762           DATA (OVOC(I),I=131,182) /
 763           & 45,45,-193,46,-190,47,-49,-114,-115,-116,-117,
 764           & 47,47,48,48,
 765           & 49,49,50,-122,-143,-186,50,
 766           & 50,50,50,50,
 767           & 51,51,51,52,
 768           & 52,52,52,53,
 769           & 54,54,55,55,
 770           & 55,56,57,58,
 771           & 58,59,59,59,
 772           & 60,-149,60,-149,60,60/
 773 C
 774           DATA (OWORD(I),I=121,160) /
 775           & 'WORK','MASTERPI','THIEF','ROBBER',
 776           & 'CRIMINAL','BANDIT','CROOK','GENT',
 777           & 'GENTLEMA','MAN','INDIVIDU','BAGMAN',
 778           & 'STILETTO','WINDOW','BOLT','NUT',
 779           & 'GRATE','GRATING','DOOR','TRAP-DOO',
 780           & 'SWITCH','HEAD','CORPSE','BODIES',
 781           & 'DAM','GATES','GATE','FCD',
 782           & 'RAIL','RAILING','BUTTON','BUBBLE',
 783           & 'LEAK','DRIP','HOLE','BAT',
 784           & 'RAINBOW','POT','STATUE','SCULPTUR'/
 785 C
 786           DATA (OVOC(I),I=183,258) /
 787           & 60,60,61,61,
 788           & 61,61,61,61,
 789           & 61,61,61,61,
 790           & 62,63,-198,-210,64,64,
 791           & 65,65,66,-67,-68,-69,-119,-164,
 792           &         -172,-173,-174,-175,-189,-197,66,
 793           & 70,-79,-80,-81,-82,-170,71,-120,72,-73,72,-73,
 794           & 74,74,-76,74,-76,74,
 795           & 75,75,76,-79,-80,-81,-82,-127,-128,-129,-170,-176,77,
 796           & 78,-191,78,78,-107,-202,-203,83,
 797           & 84,85,86,86/
 798 C
 799           DATA (OWORD(I),I=161,200) /
 800           & 'ROCK','BOAT','PLASTIC','PUMP',
 801           & 'AIRPUMP','AIR-PUMP','LABEL','FINEPRIN',
 802           & 'STICK','BARREL','BUOY','EMERALD',
 803           & 'SHOVEL','GUANO','CRAP','SHIT',
 804           & 'HUNK','BALLOON','RECEPTAC','WIRE',
 805           & 'HOOK','ZORKMID','COIN','SAFE',
 806           & 'CARD','NOTE','SLOT','CROWN',
 807           & 'BRICK','FUSE','GNOME','STAMP',
 808           & 'TOMB','CRYPT','GRAVE','HEADS',
 809           & 'POLES','IMPLEMEN','LOSERS','COKES'/
 810 C
 811           DATA (OVOC(I),I=259,312) /
 812           & 86,87,-88,-90,87,-88,-90,89,
 813           & 89,89,91,-112,91,
 814           & 92,93,94,95,
 815           & 96,97,97,97,
 816           & 97,98,-113,99,101,-110,
 817           & 102,-103,104,-148,104,105,
 818           & 106,-188,106,-186,107,-187,108,
 819           & 109,110,111,-152,118,-196,
 820           & 119,119,119,120,
 821           & 120,120,120,121/
 822 C
 823           DATA (OWORD(I),I=201,240) /
 824           & 'LISTINGS','OUTPUT','PRINTOUT','SPHERE',
 825           & 'BALL','ETCHING','WALLS','WALL',
 826           & 'FLASK','POOL','SEWAGE','TIN',
 827           & 'SAFFRON','SPICES','TABLE','POST',
 828           & 'POSTS','BUCKET','CAKE','ICING',
 829           & 'ROBOT','ROBBY','C3PO','R2D2',
 830           & 'PANEL','POLE','TBAR','T-BAR',
 831           & 'ARROW','POINT','BEAM','DIAL',
 832           & 'SUNDIAL','1','ONE','2',
 833           & 'TWO','3','THREE','4'/
 834 C
 835           DATA (OVOC(I),I=313,387) /
 836           & 122,122,122,126,-206,-209,
 837           & 126,130,-131,130,-131,-257,130,-131,-159,
 838           &         -160,-161,-162,-163,-164,-257,-265,-269,-270,-271,-272,
 839           & 132,133,133,134,
 840           & 134,134,135,-204,136,-166,-167,
 841           & 136,137,138,-139,-140,-141,139,-140,-141,
 842           & 142,142,142,142,
 843           & 159,-160,-161,-162,-163,-164,-194,-277,120,-166,-167,168,168,
 844           & 169,169,171,177,
 845           & 177,178,178,179,
 846           & 179,180,180,181/
 847 C
 848           DATA (OWORD(I),I=241,280) /
 849           & 'FOUR','5','FIVE','6',
 850           & 'SIX','7','SEVEN','8',
 851           & 'EIGHT','WARNING','SLIT','IT',
 852           & 'THAT','THIS','ME','MYSELF',
 853           & 'CRETIN','ALL','EVERYTHI','TREASURE',
 854           & 'VALUABLE','SAILOR','TEETH','GRUE',
 855           & 'HAND','HANDS','LUNGS','AIR',
 856           & 'AVIATOR','FLYER','TREE','CLIFF',
 857           & 'LEDGE','PORTRAIT','STACK','BILLS',
 858           & 'VAULT','CUBE','LETTERIN','CURTAIN'/
 859 C
 860           DATA (OVOC(I),I=388,432) /
 861           & 181,182,182,183,
 862           & 183,184,184,185,
 863           & 185,186,187,250,
 864           & 250,250,251,251,
 865           & 251,252,252,253,
 866           & 253,255,256,258,
 867           & 259,259,260,260,
 868           & 261,261,144,-145,-268,146,-147,
 869           & 146,149,122,-148,148,
 870           & 150,150,67,-150,151/
 871 C
 872           DATA (OWORD(I),I=281,320) /
 873           & 'LIGHT','NEST','EGG','BAUBLE',
 874           & 'CANARY','BIRD','SONGBIRD','GUARD',
 875           & 'GUARDIAN','ROSE','STRUCTUR','CHANNEL',
 876           & 'KEEPER','LADDER','BROCHURE','WISH',
 877           & 'GROUND','EARTH','SAND','WELL',
 878           & 'SLIDE','CHUTE','HOUSE','BOTTLES',
 879           & 'BUNCH','PALANTIR','STONE','FLINT',
 880           & 'POSSESSI','GOOP','BEACH','GRIP',
 881           & 'HANDGRIP','PRINT','ETCHINGS','CRACK',
 882           & 'KEYHOLE','MAT','STOVE','PLATINUM'/
 883 C
 884           DATA (OVOC(I),I=433,485) /
 885           & 15,-151,-171,153,154,-155,156,
 886           & 157,-158,267,267,274,
 887           & 274,275,276,278,
 888           & 279,280,195,-262,263,
 889           & 264,264,192,-264,281,
 890           & 283,283,266,121,
 891           & 121,126,-206,-209,126,-206,-209,51,
 892           & 254,133,192,167,
 893           & 167,91,-122,130,-131,199,
 894           & 202,-203,207,208,26/
 895 C
 896           DATA (OWORD(I),I=321,360) /
 897           & 'HIM','SELF','GOLD','SAPPHIRE',
 898           & 'IVORY','MASTER','CANDLE','JADE',
 899           & 'SCREEN','BLESSING','GHOSTS','SPIRITS',
 900           & 'CORPSES','JEWELS','CLIFFS','CHIMNEY',
 901           & 24*' '/
 902 C
 903           DATA (OVOC(I),I=486,529) /
 904           & 250,251,85,-104,37,
 905           & 34,279,48,6,
 906           & 151,263,42,42,
 907           & 72,-73,37,-45,146,-147,211,
 908           & 24*0/
 909 C page
 910 C SPARSE, PAGE 5
 911 C
 912 C VERBS-- Maps verbs to syntax slots
 913 C
 914 C Vocabulary entries are variable length and consist of one
 915 C or more words.  If an entry contains more than one word,
 916 C all but the last are prefaced with an '*'.  The preferred
 917 C string for error messages should be first.
 918 C
 919 C Syntax entries consist of a flag word followed by 0, 1, or 2
 920 C Object descriptions.  The flag word has the following format--
 921 C
 922 C bit <14>          if 1, syntax includes direct object
 923 C bit <13>          if 1, syntax includes indirect object
 924 C bit <12>          if 1, direct object is implicit (standard form)
 925 C bit <11>          if 1, direct and indirect object must be swapped
 926 C                             after syntax processing
 927 C bit <10>          if 1, this is default syntax for orphanery
 928 C bits <8:0>        verb number for VAPPLI
 929 C
 930 C Object descriptions consist of a flag word and two FWIM words.
 931 C The flag word has the following format--
 932 C
 933 C bit <14>          if 1, search adventurer for object
 934 C bit <13>          if 1, search room for object
 935 C bit <12>          if 1, parser will try to take object
 936 C bit <11>          if 1, adventurer must have object
 937 C bit <10>          if 1, qualifying bits (normally -1,-1) are same
 938 C                             as FWIM bits
 939 C bit <9> if 1, object must be reachable
 940 C bits <8:0>        preposition number for SYNMCH
 941 C
 942 C The FWIM words have the same format as the two object flag words.
 943 C
 944 C Note that bits 12 and 11 of object descriptions actually have
 945 C four distinct states--
 946 C
 947 C         bit 12    bit 11    mdldesc             interpretation
 948 C         ------    ------    -------             ---------------
 949 C
 950 C           0         0        --                 no parser action
 951 C           0         1        HAVE               adventurer must have object
 952 C           1         0        TRY                try to take, dont care if fail
 953 C           1         1        TAKE               try to take, care if fail
 954 C
 955 C page
 956 C SPARSE, PAGE 6
 957 C
 958           DATA (VWORD(I),I=1,43) /
 959           & 'BRIEF','VERBOSE','SUPERBRI','STAY',
 960           & 'VERSION','*SWIM','*BATHE','WADE',
 961           & 'GERONIMO','*ULYSSES','ODYSSEUS','*PLUGH','XYZZY',
 962           & 'PRAY','TREASURE','TEMPLE','BLAST',
 963           & 'SCORE','*QUIT','*GOODBYE','*Q','BYE','HELP',
 964           & 'INFO','*HISTORY','UPDATE','BACK',
 965           & '*MUMBLE','SIGH','*CHOMP','*LOSE',
 966           & 'BARF','DUNGEON','FROBOZZ','*FOO',
 967           & '*BLETCH','BAR','REPENT','*HOURS',
 968           & 'SCHEDULE','WIN','*YELL','*SCREAM'/
 969 C
 970           DATA (VVOC(I),I=1,54) /
 971           & 1,70,1,71,1,72,1,73,
 972           & 1,74,1,75,
 973           & 1,76,1,77,1,56,
 974           & 1,79,1,80,1,81,1,82,
 975           & 1,83,1,84,1,40,
 976           & 1,41,1,42,1,43,
 977           & 1,44,
 978           & 1,45,1,46,1,47,
 979           & 1,48,1,49,
 980           & 1,50,1,51/
 981 C
 982           DATA (VWORD(I),I=44,86) /
 983           & 'SHOUT','*HOP','SKIP','*CURSE',
 984           & '*SHIT','*DAMN','FUCK','ZORK',
 985           & 'WISH','SAVE','RESTORE','TIME',
 986           & 'DIAGNOSE','EXORCISE','*LIST','*I','INVENTOR',
 987           & 'WAIT','INCANT','*ANSWER','RESPOND','AGAIN',
 988           & 'NOOBJ','*BUG','*GRIPE','COMPLAIN',
 989           & '*FEATURE','*COMMENT','*IDEA','SUGGESTI',
 990           & 'ROOM','*OBJECTS','OBJ','RNAME','DEFLATE',
 991           & '*EXAMINE','*WHAT','DESCRIBE','FILL',
 992           & '*FIND','*SEEK','*WHERE','SEE'/
 993 C
 994           DATA (VVOC(I),I=55,120) /
 995           & 1,52,1,53,
 996           & 1,54,1,55,
 997           & 1,169,1,149,1,150,1,90,
 998           & 1,94,1,105,1,133,
 999           & 1,128,1,95,1,96,1,57,
1000           & 1,58,1,59,
1001           & 1,60,
1002           & 1,65,1,66,1,67,1,o50147,
1003           & 4,o40170,o60000,-1,-1,
1004           & 11,o60206,o61000,o200,0,o61002,-1,-1,
1005           &         o40206,o61000,o200,0,
1006           & 4,o40177,o60000,-1,-1/
1007 C
1008           DATA (VWORD(I),I=87,131) /
1009           & 'FOLLOW','*KICK','*BITE','TAUNT',
1010           & 'LOWER','*PUSH','PRESS','*RING',
1011           & 'PEAL','*RUB','*FEEL','*CARESS','*TOUCH',
1012           & 'FONDLE','SHAKE','SPIN','*UNTIE',
1013           & 'FREE','*WALK','*RUN','*PROCEED','GO','*ATTACK','*FIGHT',
1014           & '*INJURE','*HIT','HURT','BOARD',
1015           & '*BRUSH','CLEAN','*BURN','*IGNITE',
1016           & 'INCINERA','CLIMB','CLOSE','DIG',
1017           & 'DISEMBAR','*DRINK','*IMBIBE','SWALLOW',
1018           & '*DROP','RELEASE','*EAT','*GOBBLE','*CONSUME'/
1019 C
1020           DATA (VVOC(I),I=121,278) /
1021           & 2,o125,o50125,1,o50153,
1022           & 1,o50156,9,o50160,o40160,o61012,-1,-1,
1023           &         o40241,o61010,-1,-1,
1024           & 5,o52127,o70127,o61002,-1,-1,
1025           & 1,o50157,1,o50171,1,o50201,
1026           & 11,o42161,o61000,0,o10000,
1027           &         o60242,o61000,0,o10000,o61015,-1,-1,
1028           & 9,o50216,o40126,o61016,-1,-1,o40126,o61005,-1,-1,
1029           & 7,o60215,o21000,0,o200,o44002,0,o1000,
1030           & 4,o40202,o21000,0,2,
1031           & 5,o52130,o70130,o61002,-1,-1,
1032           & 7,o60211,o61000,o20,0,o64002,o10,0,
1033           & 12,o40235,o20007,0,o4000,o40236,o20006,0,o4000,
1034           &         o40234,o20000,0,o4000,
1035           & 4,o40176,o61000,o10200,0,
1036           & 21,o60131,o20005,0,o40000,o44002,4,0,
1037           &         o60131,o20016,0,o40000,o44002,4,0,
1038           &         o60131,o20000,0,o40000,o44002,4,0,
1039           & 8,o40203,o20000,0,2,o40203,o20015,0,2,
1040           & 4,o40210,o61000,o400,0,
1041           & 25,o42221,o41000,-1,-1,
1042           &         o60220,o41000,-1,-1,o61005,-1,-1,
1043           &         o60220,o41000,-1,-1,o61006,-1,-1,
1044           &         o60220,o41000,-1,-1,o61016,-1,-1/
1045 C
1046           DATA (VWORD(I),I=132,172) /
1047           & '*MUNCH','TASTE','*DOUSE','EXTINGUI',
1048           & '*GIVE','*HAND','DONATE','*HELLO',
1049           & 'HI','BLOW','INFLATE','*JUMP',
1050           & 'LEAP','*KILL','*MURDER','*SLAY',
1051           & '*STAB','DISPATCH','*KNOCK','RAP',
1052           & 'LIGHT','LOCK','*LOOK','*L','*STARE',
1053           & 'GAZE','*MELT','LIQUIFY','MOVE',
1054           & '*PULL','TUG','*DESTROY','*MUNG',
1055           & '*BREAK','DAMAGE','OPEN','PICK',
1056           & '*PLUG','*GLUE','PATCH','*POKE'/
1057 C
1058           DATA (VVOC(I),I=279,450) /
1059           & 4,o40207,o75000,o2000,0,
1060           & 4,o40174,o75000,o100,0,
1061           & 11,o72222,o21004,o40,0,o64222,o21000,o40,0,
1062           &         o61000,-1,-1,
1063           & 2,o2227,o50227,
1064           & 15,o62146,o61007,-1,-1,o61002,4,0,
1065           &         o40122,o61007,-1,-1,o40165,o61005,-1,-1,
1066           & 4,o70146,o61002,4,0,
1067           & 5,o133,o40133,o61001,-1,-1,
1068           & 7,o60213,o21000,0,o200,o44002,0,o1000,
1069           & 12,o42166,o61003,-1,-1,o40166,o61012,-1,-1,
1070           &         o40215,o23006,o40,0,
1071           & 11,o42173,o75000,o100,0,o60211,o61000,o100,0,
1072           &         o54002,o10,0,
1073           & 7,o60134,o20000,-1,-1,o74002,4,0,
1074           & 31,o167,o40170,o60003,-1,-1,o40231,o61010,-1,-1,
1075           &         o40230,o60005,-1,-1,o40230,o60016,-1,-1,
1076           &         o60144,o60003,-1,-1,o61002,-1,-1,
1077           &         o60144,o60003,-1,-1,o61016,-1,-1,
1078           & 4,o70145,o61002,o10,0,
1079           & 4,o40172,o20000,-1,-1,
1080           & 8,o42172,o21000,-1,-1,o40172,o21012,-1,-1,
1081           & 5,o52212,o70212,o44002,-1,-1,
1082           & 11,o42175,o61000,o10200,0,o60175,o61000,o10200,0,
1083           &         o54002,4,o1000,
1084           & 4,o40204,o61007,o20000,o40,
1085           & 4,o70152,o61002,-1,-1/
1086 C
1087           DATA (VWORD(I),I=173,212) /
1088           & '*BLIND','JAB','*POUR','SPILL',
1089           & 'PUMP','*PUT','*INSERT','*STUFF',
1090           & 'PLACE','*RAISE','LIFT','*READ',
1091           & '*PERUSE','SKIM','STRIKE','*SWING',
1092           & 'THRUST','*TAKE','*HOLD','*CARRY',
1093           & 'REMOVE','*TELL','*COMMAND','REQUEST',
1094           & '*THROW','*HURL','CHUCK','*TIE',
1095           & 'FASTEN','*TURN','SET','UNLOCK',
1096           & '*WAKE','*ALARM','*STARTLE','SURPRISE',
1097           & '*WAVE','*FLAUNT','BRANDISH','WIND'/
1098 C
1099           DATA (VVOC(I),I=451,654) /
1100           & 7,o60212,o21000,0,o200,o44002,0,o1000,
1101           & 25,o42223,o41000,o400,0,
1102           &         o60223,o41000,o400,0,o61005,-1,-1,
1103           &         o60223,o41000,o400,0,o61016,-1,-1,
1104           &         o60240,o41000,o400,0,o61012,-1,-1,
1105           & 4,o40232,o60007,-1,-1,
1106           & 16,o72220,o61005,-1,-1,o70220,o61016,-1,-1,
1107           &         o40221,o61006,-1,-1,o70241,o61010,-1,-1,
1108           & 5,o52155,o40155,o61007,-1,-1,
1109           & 18,o42144,o71000,o40000,0,
1110           &         o60144,o71000,o40000,0,o61002,-1,-1,
1111           &         o60144,o71000,o40000,0,o61016,-1,-1,
1112           & 12,o60215,o23000,o40,0,o44002,0,o1000,
1113           &         o42215,o23000,o40,0,o50173,
1114           & 7,o60214,o44000,0,o1000,o21003,0,o200,
1115           & 11,o42204,o61000,o20000,o40,
1116           &         o60204,o61000,o20000,0,o61015,-1,-1,
1117           & 4,o40217,o20000,0,o2000,
1118           & 21,o62224,o44000,-1,-1,o21003,o40,0,
1119           &         o60224,o44000,-1,-1,o21016,o40,0,
1120           &         o60220,o44000,-1,-1,o61005,-1,-1,
1121           & 11,o70162,o61004,-1,-1,o60163,o21007,o40,0,
1122           &         o65002,4,0,
1123           & 22,o62164,o61000,2,0,o64002,4,0,
1124           &         o40173,o75012,o100,0,o40174,o75013,o100,0,
1125           &         o60237,o61000,2,0,o20004,-1,-1,
1126           & 7,o60135,o21000,-1,-1,o74002,4,0,
1127           & 8,o42150,o20000,o40,0,o40150,o20007,o40,0,
1128           & 4,o40154,o40000,-1,-1,
1129           & 5,o50233,o40233,o61007,-1,-1/
1130 C
1131           DATA (VWORD(I),I=213,240)/
1132           & 'ENTER','LEAVE','*MAKE','BUILD',
1133           & '*OIL','*GREASE','LUBRICAT','PLAY',
1134           & 'SEND','SLIDE','*SMELL','SNIFF',
1135           & 'SQUEEZE','GET','COUNT',13*' '/
1136 C
1137           DATA (VVOC(I),I=655,722) /
1138           & 2,167,o50126,2,168,o50220,1,o50243,
1139           & 4,o70244,o41002,-1,-1,
1140           & 5,o50245,o70245,o75002,4,0,
1141           & 4,o40246,o61014,-1,-1,
1142           & 4,o70241,o61010,-1,-1,1,o50105,
1143           & 1,o50104,19,o42204,o61000,o20000,o40,
1144           &         o40202,o21005,0,2,o40203,o21015,0,2,
1145           &         o60204,o61000,o20000,o40,o61015,-1,-1,
1146           & 1,o50141,13*0/
1147           END