home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1994 March / Source_Code_CD-ROM_Walnut_Creek_March_1994.iso / compsrcs / games / vmsnet / dungeon / part26 < prev    next >
Encoding:
Internet Message Format  |  1992-02-23  |  47.4 KB
  1. Path: uunet!paladin.american.edu!gatech!nntp.msstate.edu!emory!dragon.com!cts
  2. From: cts@dragon.com
  3. Newsgroups: vmsnet.sources.games
  4. Subject: Dungeon Part 26/30
  5. Message-ID: <1992Feb24.013734.819@dragon.com>
  6. Date: 24 Feb 92 06:37:34 GMT
  7. Organization: Computer Projects Unlimited
  8. Lines: 1429
  9.  
  10. -+-+-+-+-+-+-+-+ START OF PART 26 -+-+-+-+-+-+-+-+
  11. XC                                               !ASK QUESTION.
  12. X      RETURN
  13. XC
  14. X14200 CALL RSPEAK(798)
  15. XC                                               !NO REPLY.
  16. X      RETURN
  17. XC
  18. XC O46-- LOCKED DOOR
  19. XC
  20. X15000 IF(PRSA.NE.OPENW) GO TO 10
  21. XC                                               !OPEN?
  22. X      CALL RSPEAK(778)
  23. XC                                               !CANT.
  24. X      RETURN
  25. XC
  26. XC O47-- CELL DOOR
  27. XC
  28. X16000 NOBJS=OPNCLS(CDOOR,779,780)
  29. XC                                               !OPEN/CLOSE?
  30. X      RETURN
  31. X`0C
  32. XC NOBJS, PAGE 9
  33. XC
  34. XC O48-- DIALBUTTON
  35. XC
  36. X17000 IF(PRSA.NE.PUSHW) GO TO 10
  37. XC                                               !PUSH?
  38. X      CALL RSPEAK(809)
  39. XC                                               !CLICK.
  40. X      IF(QOPEN(CDOOR)) CALL RSPEAK(810)
  41. XC                                               !CLOSE CELL DOOR.
  42. XC
  43. X      DO 17100 I=1,OLNT
  44. XC                                               !RELOCATE OLD TO HYPER.
  45. X        IF((OROOM(I).EQ.CELL).AND.(and(OFLAG1(I),DOORBT).EQ.0))
  46. X     &    CALL NEWSTA(I,0,LCELL*HFACTR,0,0)
  47. X        IF(OROOM(I).EQ.(PNUMB*HFACTR))
  48. X     &    CALL NEWSTA(I,0,CELL,0,0)
  49. X17100 CONTINUE
  50. XC
  51. X      OFLAG2(ODOOR)=and(OFLAG2(ODOOR), not(OPENBT))
  52. X      OFLAG2(CDOOR)=and(OFLAG2(CDOOR), not(OPENBT))
  53. X      OFLAG1(ODOOR)=and(OFLAG1(ODOOR), not(VISIBT))
  54. X      IF(PNUMB.EQ.4) OFLAG1(ODOOR)=or(OFLAG1(ODOOR),VISIBT)
  55. XC
  56. X      IF(AROOM(PLAYER).NE.CELL) GO TO 17400
  57. XC                                               !PLAYER IN CELL?
  58. X      IF(LCELL.NE.4) GO TO 17200
  59. XC                                               !IN RIGHT CELL?
  60. X      OFLAG1(ODOOR)=or(OFLAG1(ODOOR), VISIBT)
  61. X      F=MOVETO(NCELL,PLAYER)
  62. XC                                               !YES, MOVETO NCELL.
  63. X      GO TO 17400
  64. X17200 F=MOVETO(PCELL,PLAYER)
  65. XC                                               !NO, MOVETO PCELL.
  66. XC
  67. X17400 LCELL=PNUMB
  68. X      RETURN
  69. X`0C
  70. XC NOBJS, PAGE 10
  71. XC
  72. XC O49-- DIAL INDICATOR
  73. XC
  74. X18000 IF(PRSA.NE.SPINW) GO TO 18100
  75. XC                                               !SPIN?
  76. X      PNUMB=RND(8)+1
  77. XC                                               !WHEE
  78. XC                                               !
  79. X      CALL RSPSUB(797,712+PNUMB)
  80. X      RETURN
  81. XC
  82. X18100 IF((PRSA.NE.MOVEW).AND.(PRSA.NE.PUTW).AND.
  83. X     &   (PRSA.NE.TRNTOW)) GO TO 10
  84. X      IF(PRSI.NE.0) GO TO 18200
  85. XC                                               !TURN DIAL TO X?
  86. X      CALL RSPEAK(806)
  87. XC                                               !MUST SPECIFY.
  88. X      RETURN
  89. XC
  90. X18200 IF((PRSI.GE.NUM1).AND.(PRSI.LE.NUM8)) GO TO 18300
  91. X      CALL RSPEAK(807)
  92. XC                                               !MUST BE DIGIT.
  93. X      RETURN
  94. XC
  95. X18300 PNUMB=PRSI-NUM1+1
  96. XC                                               !SET UP NEW.
  97. X      CALL RSPSUB(808,712+PNUMB)
  98. X      RETURN
  99. XC
  100. XC O50-- GLOBAL MIRROR
  101. XC
  102. X19000 NOBJS=MIRPAN(832,.FALSE.)
  103. X      RETURN
  104. XC
  105. XC O51-- GLOBAL PANEL
  106. XC
  107. X20000 IF(HERE.NE.FDOOR) GO TO 20100
  108. XC                                               !AT FRONT DOOR?
  109. X      IF((PRSA.NE.OPENW).AND.(PRSA.NE.CLOSEW)) GO TO 10
  110. X      CALL RSPEAK(843)
  111. XC                                               !PANEL IN DOOR, NOGO.
  112. X      RETURN
  113. XC
  114. X20100 NOBJS=MIRPAN(838,.TRUE.)
  115. X      RETURN
  116. XC
  117. XC O52-- PUZZLE ROOM SLIT
  118. XC
  119. X21000 IF((PRSA.NE.PUTW).OR.(PRSI.NE.CSLIT)) GO TO 10
  120. X      IF(PRSO.NE.GCARD) GO TO 21100
  121. XC                                               !PUT CARD IN SLIT?
  122. X      CALL NEWSTA(PRSO,863,0,0,0)
  123. XC                                               !KILL CARD.
  124. X      CPOUTF=.TRUE.
  125. XC                                               !OPEN DOOR.
  126. X      OFLAG1(STLDR)=and(OFLAG1(STLDR),not(VISIBT))
  127. X      RETURN
  128. XC
  129. X21100 IF((and(OFLAG1(PRSO),VICTBT).EQ.0).AND.
  130. X     &   (and(OFLAG2(PRSO),VILLBT).EQ.0)) GO TO 21200
  131. X      CALL RSPEAK(RND(5)+552)
  132. XC                                               !JOKE FOR VILL, VICT.
  133. X      RETURN
  134. XC
  135. X21200 CALL NEWSTA(PRSO,0,0,0,0)
  136. XC                                               !KILL OBJECT.
  137. X      CALL RSPSUB(864,ODO2)
  138. XC                                               !DESCRIBE.
  139. X      RETURN
  140. XC
  141. X      END
  142. X`0C
  143. XC MIRPAN--      PROCESSOR FOR GLOBAL MIRROR/PANEL
  144. XC
  145. XC DECLARATIONS
  146. XC
  147. X      LOGICAL FUNCTION MIRPAN(ST,PNF)
  148. X      IMPLICIT INTEGER(A-Z)
  149. X      LOGICAL PNF
  150. X
  151. X      INCLUDE 'GAMESTATE.LIB'
  152. X      INCLUDE 'PARSER.LIB'
  153. X      INCLUDE 'VERBS.LIB'
  154. X      INCLUDE 'FLAGS.LIB'
  155. X`0C
  156. XC MIRPAN, PAGE 2
  157. XC
  158. X      MIRPAN=.TRUE.
  159. X      NUM=MRHERE(HERE)
  160. XC                                               !GET MIRROR NUM.
  161. X      IF(NUM.NE.0) GO TO 100
  162. XC                                               !ANY HERE?
  163. X      CALL RSPEAK(ST)
  164. XC                                               !NO, LOSE.
  165. X      RETURN
  166. XC
  167. X100   MRBF=0
  168. XC                                               !ASSUME MIRROR OK.
  169. X      IF(((NUM.EQ.1).AND..NOT.MR1F).OR.
  170. X     &   ((NUM.EQ.2).AND..NOT.MR2F)) MRBF=1
  171. X      IF((PRSA.NE.MOVEW).AND.(PRSA.NE.OPENW)) GO TO 200
  172. X      CALL RSPEAK(ST+1)
  173. XC                                               !CANT OPEN OR MOVE.
  174. X      RETURN
  175. XC
  176. X200   IF(PNF.OR.((PRSA.NE.LOOKIW).AND.(PRSA.NE.EXAMIW).AND.
  177. X     &           (PRSA.NE.LOOKW))) GO TO 300
  178. X      CALL RSPEAK(844+MRBF)
  179. XC                                               !LOOK IN MIRROR.
  180. X      RETURN
  181. XC
  182. X300   IF(PRSA.NE.MUNGW) GO TO 400
  183. XC                                               !BREAK?
  184. X      CALL RSPEAK(ST+2+MRBF)
  185. XC                                               !DO IT.
  186. X      IF((NUM.EQ.1).AND..NOT.PNF) MR1F=.FALSE.
  187. X      IF((NUM.EQ.2).AND..NOT.PNF) MR2F=.FALSE.
  188. X      RETURN
  189. XC
  190. X400   IF(PNF.OR.(MRBF.EQ.0)) GO TO 500
  191. XC                                               !BROKEN MIRROR?
  192. X      CALL RSPEAK(846)
  193. X      RETURN
  194. XC
  195. X500   IF(PRSA.NE.PUSHW) GO TO 600
  196. XC                                               !PUSH?
  197. X      CALL RSPEAK(ST+3+NUM)
  198. X      RETURN
  199. XC
  200. X600   MIRPAN=.FALSE.
  201. XC                                               !CANT HANDLE IT.
  202. X      RETURN
  203. XC
  204. X      END
  205. $ CALL UNPACK [.SRC]NOBJS.FOR;1 1400445320
  206. $ create 'f'
  207. XC RDLINE-       READ INPUT LINE
  208. XC
  209. XC COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
  210. XC ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
  211. XC WRITTEN BY R. M. SUPNIK
  212. XC
  213. XC DECLARATIONS
  214. XC
  215. X      SUBROUTINE RDLINE(BUFFER,LENGTH,WHO)
  216. X      IMPLICIT INTEGER(A-Z)
  217. X      CHARACTER BUFFER(78)
  218. X      character*78 sysbuf
  219. X
  220. X      INCLUDE 'PARSER.LIB'
  221. X      INCLUDE 'IO.LIB'
  222. X
  223. X5     GO TO (90,10),WHO+1
  224. XC                                               !SEE WHO TO PROMPT FOR.
  225. X10    WRITE(OUTCH,50)
  226. XC                                               !PROMPT FOR GAME.
  227. X50    FORMAT(' >',$)
  228. X
  229. X90    READ(INPCH,100, END=210) BUFFER
  230. X100   FORMAT(78A1)
  231. X
  232. X      DO 200 LENGTH=78,1,-1
  233. X        IF(BUFFER(LENGTH).NE.' ') GO TO 250
  234. X200   CONTINUE
  235. X      GO TO 5
  236. XC                                               !END OF FILE
  237. X210   STOP
  238. XC                                               !TRY AGAIN.
  239. X
  240. XC
  241. XC       check for shell escape here before things are
  242. XC       converted to upper case
  243. XC
  244. X250   if (buffer(1) .ne. '!') go to 300
  245. X      sysbuf = ' '
  246. X      do 275 j=2,length
  247. X        sysbuf(j-1:j-1) = buffer(j)
  248. X275     continue
  249. X      call system(sysbuf)
  250. X      go to 5
  251. X
  252. XC CONVERT TO UPPER CASE
  253. X
  254. X300   DO 400 I=1,LENGTH
  255. X        IF(and((BUFFER(I).GE.'a'),(BUFFER(I).LE.'z')))
  256. X     &    BUFFER(I)=char(ichar(BUFFER(I))-32)
  257. X400   CONTINUE
  258. X
  259. X      IF(LENGTH.EQ.0) GO TO 5
  260. X      PRSCON=1
  261. XC                                               !RESTART LEX SCAN.
  262. X      RETURN
  263. X      END
  264. X`0C
  265. XC PARSE-        TOP LEVEL PARSE ROUTINE
  266. XC
  267. XC DECLARATIONS
  268. XC
  269. XC THIS ROUTINE DETAILS ON BIT 0 OF PRSFLG
  270. XC
  271. X      LOGICAL FUNCTION PARSE(INBUF,INLNT,VBFLAG)
  272. X      IMPLICIT INTEGER(A-Z)
  273. X      CHARACTER INBUF(78)
  274. X      LOGICAL LEX,SYNMCH,VBFLAG
  275. X      INTEGER OUTBUF(40)
  276. X
  277. X      INCLUDE 'DEBUG.LIB'
  278. X      INCLUDE 'PARSER.LIB'
  279. X      INCLUDE 'XSRCH.LIB'
  280. XC
  281. X      DFLAG=and(PRSFLG,1).NE.0
  282. X      PARSE=.FALSE.
  283. XC                                               !ASSUME FAILS.
  284. X      PRSA=0
  285. XC                                               !ZERO OUTPUTS.
  286. X      PRSI=0
  287. X      PRSO=0
  288. XC
  289. X      IF(.NOT.LEX(INBUF,INLNT,OUTBUF,OUTLNT,VBFLAG)) GO TO 100
  290. X      IF(SPARSE(OUTBUF,OUTLNT,VBFLAG)) 100,200,300
  291. XC                                               !DO SYN SCAN.
  292. XC
  293. XC PARSE REQUIRES VALIDATION
  294. XC
  295. X200   IF(.NOT.VBFLAG) GO TO 350
  296. XC                                               !ECHO MODE, FORCE FAIL.
  297. X      IF(.NOT.SYNMCH(X)) GO TO 100
  298. XC                                               !DO SYN MATCH.
  299. X      IF(and((PRSO.GT.0),(PRSO.LT.XMIN))) LASTIT=PRSO
  300. XC
  301. XC SUCCESSFUL PARSE OR SUCCESSFUL VALIDATION
  302. XC
  303. X300   PARSE=.TRUE.
  304. X350   CALL ORPHAN(0,0,0,0,0)
  305. XC                                               !CLEAR ORPHANS.
  306. X      IF(DFLAG) WRITE(0,*) 'PARSE GOOD'
  307. X      IF(DFLAG) PRINT 10,PARSE,PRSA,PRSO,PRSI
  308. X10    FORMAT(' PARSE RESULTS- ',L7,3I7)
  309. X      RETURN
  310. XC
  311. XC PARSE FAILS, DISALLOW CONTINUATION
  312. XC
  313. X100   PRSCON=1
  314. X      IF(DFLAG) WRITE(0,*) 'PARSE FAILED'
  315. X      IF(DFLAG) PRINT 10,PARSE,PRSA,PRSO,PRSI
  316. X      RETURN
  317. XC
  318. X      END
  319. X`0C
  320. XC ORPHAN- SET UP NEW ORPHANS
  321. XC
  322. XC DECLARATIONS
  323. XC
  324. X      SUBROUTINE ORPHAN(O1,O2,O3,O4,O5)
  325. X      IMPLICIT INTEGER(A-Z)
  326. X      COMMON /ORPHS/ A,B,C,D,E
  327. XC
  328. X      A=O1
  329. XC                                               !SET UP NEW ORPHANS.
  330. X      B=O2
  331. X      C=O3
  332. X      D=O4
  333. X      E=O5
  334. X      RETURN
  335. X      END
  336. X`0C
  337. XC LEX-  LEXICAL ANALYZER
  338. XC
  339. XC
  340. XC THIS ROUTINE DETAILS ON BIT 1 OF PRSFLAG
  341. XC
  342. X      LOGICAL FUNCTION LEX(INBUF,INLNT,OUTBUF,OP,VBFLAG)
  343. X      IMPLICIT INTEGER(A-Z)
  344. X      CHARACTER INBUF(78),J,DLIMIT(9)
  345. X      INTEGER OUTBUF(40)
  346. X      LOGICAL VBFLAG
  347. XC
  348. X      INCLUDE 'PARSER.LIB'
  349. X      INCLUDE 'DEBUG.LIB'
  350. XC
  351. X      DATA DLIMIT/'A','Z','100'O,'1','9','22'O,'-','-','22'O/
  352. XC
  353. X      DO 100 I=1,40
  354. XC                                               !CLEAR OUTPUT BUF.
  355. X        OUTBUF(I)=0
  356. X100   CONTINUE
  357. XC
  358. X      DFLAG=and(PRSFLG,2).NE.0
  359. X      LEX=.FALSE.
  360. XC                                               !ASSUME LEX FAILS.
  361. X      OP=-1
  362. XC                                               !OUTPUT PTR.
  363. X50    OP=OP+2
  364. XC                                               !ADV OUTPUT PTR.
  365. X      CP=0
  366. XC                                               !CHAR PTR=0.
  367. XC
  368. X200   IF(PRSCON.GT.INLNT) GO TO 1000
  369. XC                                               !END OF INPUT?
  370. X      J=INBUF(PRSCON)
  371. XC                                               !NO, GET CHARACTER,
  372. X      PRSCON=PRSCON+1
  373. XC                                               !ADVANCE PTR.
  374. X      IF(J.EQ.'.') GO TO 1000
  375. XC                                               !END OF COMMAND?
  376. X      IF(J.EQ.',') GO TO 1000
  377. XC                                               !END OF COMMAND?
  378. X      IF(J.EQ.' ') GO TO 6000
  379. XC                                               !SPACE?
  380. X      DO 500 I=1,9,3
  381. XC                                               !SCH FOR CHAR.
  382. X        IF(and((J.GE.DLIMIT(I)),(J.LE.DLIMIT(I+1))))
  383. X     &    GO TO 4000
  384. X500   CONTINUE
  385. XC
  386. X      IF(VBFLAG) CALL RSPEAK(601)
  387. XC                                               !GREEK TO ME, FAIL.
  388. X      RETURN
  389. XC
  390. XC END OF INPUT, SEE IF PARTIAL WORD AVAILABLE.
  391. XC
  392. X1000  IF(PRSCON.GT.INLNT) PRSCON=1
  393. XC                                               !FORCE PARSE RESTART.
  394. X      IF(and((CP.EQ.0),(OP.EQ.1))) RETURN
  395. X      IF(CP.EQ.0) OP=OP-2
  396. XC                                               !ANY LAST WORD?
  397. X      LEX=.TRUE.
  398. X      IF(DFLAG) PRINT 10,CP,OP,PRSCON,(OUTBUF(I),I=1,OP+1)
  399. X10    FORMAT(' LEX RESULTS- ',3I7/1X,10O7)
  400. X      RETURN
  401. XC
  402. XC LEGITIMATE CHARACTERS: LETTER, DIGIT, OR HYPHEN.
  403. XC
  404. X4000  J1=ichar(J)-ichar(DLIMIT(I+2))
  405. X      IF(DFLAG) PRINT 20,J,J1,CP
  406. X20    FORMAT(' LEX- CHAR= ',3I7)
  407. X      IF(CP.GE.6) GO TO 200
  408. XC                                               !IGNORE IF TOO MANY CHAR.
  409. X      K=OP+(CP/3)
  410. XC                                               !COMPUTE WORD INDEX.
  411. X      GO TO (4100,4200,4300),(MOD(CP,3)+1)
  412. XC                                               !BRANCH ON CHAR.
  413. X4100  J2=J1*780
  414. XC                                               !CHAR 1... *780
  415. X      OUTBUF(K)=OUTBUF(K)+J2+J2
  416. XC                                               !*1560 (40 ADDED BELOW).
  417. X4200  OUTBUF(K)=OUTBUF(K)+(J1*39)
  418. XC                                               !*39 (1 ADDED BELOW).
  419. X4300  OUTBUF(K)=OUTBUF(K)+J1
  420. XC                                               !*1.
  421. X      CP=CP+1
  422. X      GO TO 200
  423. XC                                               !GET NEXT CHAR.
  424. XC
  425. XC SPACE
  426. XC
  427. X6000  IF(CP.EQ.0) GO TO 200
  428. XC                                               !ANY WORD YET?
  429. X      GO TO 50
  430. XC                                               !YES, ADV OP.
  431. XC
  432. X      END
  433. $ CALL UNPACK [.SRC]NP.FOR;1 544010258
  434. $ create 'f'
  435. XC SPARSE-       START OF PARSE
  436. XC
  437. XC COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
  438. XC ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
  439. XC WRITTEN BY R. M. SUPNIK
  440. XC
  441. XC DECLARATIONS
  442. XC
  443. XC THIS ROUTINE DETAILS ON BIT 2 OF PRSFLG
  444. XC
  445. X      INTEGER  FUNCTION  SPARSE(LBUF,LLNT,VBFLAG)
  446. X      IMPLICIT INTEGER(A-Z)
  447. X      INTEGER  LBUF(40)
  448. X      LOGICAL  LIT,OTEST,VBFLAG
  449. X
  450. X      INCLUDE 'PARSER.LIB'
  451. X      INCLUDE 'GAMESTATE.LIB'
  452. X      INCLUDE 'DEBUG.LIB'
  453. X      INCLUDE 'OBJECTS.LIB'
  454. X      INCLUDE 'OINDEX.LIB'
  455. X      INCLUDE 'ADVERS.LIB'
  456. X      INCLUDE 'VERBS.LIB'
  457. X      INCLUDE 'VOCAB.LIB'
  458. X`0C
  459. XC SPARSE, PAGE 2
  460. XC
  461. XC FUNCTIONS AND DATA
  462. XC
  463. X      OTEST(R)=(R.GT.0).AND.(R.LT.R50MIN)
  464. XC
  465. X      DATA R50MIN/1RA/,R50WAL/3RWAL/
  466. XC
  467. XC BUZZ WORDS--  IGNORED IN SYNTACTIC PROCESSING
  468. XC
  469. XC
  470. X      DATA BVOC/3RAND,0,2RBY,0,2RIS,0,1RA,0,
  471. X     &          2RAN,0,3RTHE,0,3RRUN,0,2RGO,0,3RPRO,3RCEE,0,0/
  472. XC
  473. XC
  474. XC
  475. XC PREPOSITIONS--        MAPS PREPOSITIONS TO INDICES
  476. XC
  477. X      DATA PVOC/3ROVE,1RR,1,3RWIT,1RH,2,3RUSI,2RNG,2,3RTHR,3ROUG,2,
  478. X     &          2RAT,0,3,2RTO,0,4,2RIN,0,5,3RINS,3RIDE,5,3RINT,1RO,5,
  479. X     &          3RDOW,1RN,6,2RUP,0,7,3RUND,2RER,8,2ROF,0,9,2RON,0,10,
  480. X     &          3ROFF,0,11/
  481. XC
  482. XC
  483. XC DIRECTIONS--  MAPS DIRECTIONS TO INDICES
  484. XC
  485. X      DATA DVOC/1RN,0,'2000'o,3RNOR,2RTH,'2000'o,1RS,0,'12000'o,
  486. X     &1RE,0,'6000'o,3REAS,1RT,'6000'o,1RW,0,'16000'o,3RWES,1RT,'16000'o,
  487. X     &2RSE,0,'10000'o,2RSW,0,'14000'o,
  488. X     &2RNE,0,'4000'o,2RNW,0,'20000'o,
  489. X     &1RU,0,'22000'o,2RUP,0,'22000'o,1RD,0,'24000'o,3RDOW,1RN,'24000'o,
  490. X     &3RLAU,3RNCH,'26000'o,3RLAN,1RD,'30000'o,3RENT,2RER,'32000'o,
  491. X     &3REXI,1RT,'34000'o,3ROUT,0,'34000'o,3RLEA,2RVE,'34000'o,
  492. X     &3RTRA,3RVEL,'36000'o,3RSOU,2RTH,'12000'o,
  493. X     &2RIN,0,'32000'o,
  494. X     &3RCRO,2RSS,'36000'o/
  495. X`0C
  496. XC
  497. XC
  498. XC SPARSE, PAGE 3
  499. XC
  500. XC ADJECTIVES--  MAPS ADJECTIVES TO OBJECT NUMBERS
  501. XC
  502. XC EACH ENTRY IS VARIABLE LENGTH AND CONSISTS OF A TWO WORD
  503. XC ADJECTIVE IN RADIX-50 FOLLOWED BY ONE OR MORE OBJECT NUMBERS.
  504. XC NOTE THAT ADJECTIVES CAN BE DISTINGUISHED FROM OBJECTS AS
  505. XC FOLLOWS-- ALL ADJECTIVES ARE .GE. 1RA (1600), WHILE ALL OBJECTS
  506. XC ARE .LE. OLNT (255 MAX).
  507. XC
  508. XC
  509. X
  510. X      DATA AVOC1/3RBRO,2RWN,1,81,3RELO,3RNGA,1,3RHOT,0,3,3RPEP,3RPER,3,
  511. X     &   3RVIT,3RREO,4,3RJAD,1RE,6,3RHUG,1RE,8,3RENO,3RRMO,8,122,
  512. X     &   3RTRO,3RPHY,9,3RCLE,2RAR,10,3RLAR,2RGE,12,26,47,95,96,123,
  513. X     &   133,135,146,147,150,176,3RNAS,2RTY,13,3RELV,3RISH,14,
  514. X     &   3RBRA,2RSS,15,16,46,156,
  515. X     &   3RBRO,3RKEN,16,22,92,113,155,158,3RORI,3RENT,17,
  516. X     &   3RBLO,3RODY,20,3RRUS,2RTY,21,3RBUR,3RNED,22,
  517. X     &   3RDEA,1RD,22,3ROLD,0,25,41,44,45,3RLEA,3RTHE,25,
  518. X     &   3RPLA,3RTIN,26,3RPEA,2RRL,27,
  519. X     &   3RMOB,1RY,31,3RCRY,3RSTA,32,126,
  520. X     &   3RGOL,1RD,33,85,104,157,158,188,
  521. X     &   3RIVO,2RRY,34,3RSAP,3RPHI,37,3RWOO,3RDEN,38,67,136,137,
  522. X     &   165,173,174,175,3RWOO,1RD,38,67,136,137,165,173,174,175,
  523. X     &   3RSTE,2REL,39,125,189,
  524. X     &   3RDEN,3RTED,39,3RFAN,2RCY,40,3RANC,3RIEN,41,44,
  525. X     &   3RSMA,2RLL,5,46,52,53,89,102,103,153,187,
  526. X     &   3RBLA,2RCK,47,162,3RTOU,1RR,49,
  527. X     &   3RVIS,3RCOU,55,3RVIC,3RIOU,62,
  528. X     &   3RGLA,2RSS,10,126,132,3RTRA,1RP,66/
  529. XC
  530. XC
  531. X      DATA AVOC2/3RFRO,2RNT,68,3RSTO,2RNE,69,150,214,3RMAN,3RGLE,72,
  532. X     &   3RRED,0,79,94,140,161,170,171,3RYEL,3RLOW,80,159,
  533. X     &   3RBLU,1RE,82,112,114,141,
  534. X     &   3RVAM,3RPIR,83,3RMAG,2RIC,90,
  535. X     &   3RSEA,3RWOR,90,3RTAN,0,91,3RSHA,2RRP,92,
  536. X     &   3RWIC,3RKER,98,3RCLO,2RTH,100,
  537. X     &   3RBRA,3RIDE,101,
  538. X     &   3RGAU,2RDY,108,3RSQU,3RARE,109,127,3RCLA,1RY,109,
  539. X     &   3RSHI,2RNY,110,3RTHI,1RN,110,
  540. X     &   3RGRE,2REN,115,143,3RPUR,3RPLE,116,3RWHI,2RTE,117,147,160,
  541. X     &   3RMAR,3RBLE,119,3RCOK,1RE,121,3REMP,2RTY,121,
  542. X     &   3RROU,2RND,128,3RTRI,3RANG,129,
  543. X     &   3RRAR,1RE,134,3ROBL,3RONG,135,3REAT,3R$ME,138,
  544. X     &   3REAT,2RME,138,3RORA,3RNGE,139,3RECC,1RH,141/
  545. XC
  546. XC
  547. XC
  548. X      DATA AVOC3/3RROC,2RKY,147,3RSHE,2RER,147,
  549. X     &   3R200,0,148,3RNEA,1RT,148,3RSHI,3RMME,151,
  550. X     &   3RZUR,3RICH,152,3RBIR,2RDS,153,154,155,
  551. X     &   3RENC,3RRUS,154,155,3RBEA,3RUTI,156,3RCLO,3RCKW,157,158,
  552. X     &   3RMEC,3RHAN,157,158,
  553. X     &   3RMAH,3ROGA,163,3RPIN,1RE,164,3RLON,1RG,166,
  554. X     &   3RCEN,3RTER,166,3RSHO,2RRT,167,1RT,0,168,
  555. X     &   3RCOM,3RPAS,169,211,3RBRO,3RNZE,172,3RCEL,1RL,174,175,
  556. X     &   3RLOC,3RKED,174,3RSUN,0,177,
  557. X     &   3RBAR,1RE,200,3RSON,1RG,203,
  558. X     &   3RNOR,2RTH,205,3RNOR,3RTHE,205,3RSOU,2RTH,206,
  559. X     &   3RSOU,3RTHE,206,3REAS,1RT,207,3REAS,3RTER,207,
  560. X     &   3RWES,1RT,208,3RWES,3RTER,208,3RDUN,3RGEO,215/
  561. XC
  562. XC
  563. XC
  564. X      DATA AVOCND/-1/
  565. X`0C
  566. XC SPARSE, PAGE 4
  567. XC
  568. XC VERBS--       MAPS VERBS TO SYNTAX SLOTS
  569. XC
  570. XC EACH ENTRY IS VARIABLE LENGTH AND CONSISTS OF ONE OR MORE
  571. XC TWO WORD VERBS IN RADIX-50 FOLLOWED BY A SYNTAX WORD COUNT
  572. XC FOLLOWED BY ONE OR MORE SYNTAXES.  NOTE THAT VERBS CAN BE
  573. XC DISTINGUISHED FROM WORD COUNTS AS FOLLOWS--
  574. XC ALL VERBS ARE .GE. 1RA (1600), WHILE ALL SYNTAX WORD COUNTS
  575. XC ARE .LE. 255.
  576. XC
  577. XC SYNTAX ENTRIES CONSIST OF A FLAG WORD FOLLOWED BY 0, 1, OR 2
  578. XC OBJECT DESCRIPTIONS.  THE FLAG WORD HAS THE FOLLOWING FORMAT--
  579. XC
  580. XC BIT <14>      IF 1, SYNTAX INCLUDES DIRECT OBJECT
  581. XC BIT <13>      IF 1, SYNTAX INCLUDES INDIRECT OBJECT
  582. XC BIT <12>      IF 1, DIRECT OBJECT IS IMPLICIT (STANDARD FORM)
  583. XC BIT <11>      IF 1, DIRECT AND INDIRECT OBJECT MUST BE SWAPPED
  584. XC                       AFTER SYNTAX PROCESSING
  585. XC BIT <10>      IF 1, THIS IS DEFAULT SYNTAX FOR ORPHANERY
  586. XC BITS <8:0>    VERB NUMBER FOR VAPPLI
  587. XC
  588. XC OBJECT DESCRIPTIONS CONSIST OF A FLAG WORD AND TWO FWIM WORDS.
  589. XC THE FLAG WORD HAS THE FOLLOWING FORMAT--
  590. XC
  591. XC BIT <14>      IF 1, SEARCH ADVENTURER FOR OBJECT
  592. XC BIT <13>      IF 1, SEARCH ROOM FOR OBJECT
  593. XC BIT <12>      IF 1, PARSER WILL TRY TO TAKE OBJECT
  594. XC BIT <11>      IF 1, ADVENTURER MUST HAVE OBJECT
  595. XC BIT <10>      IF 1, QUALIFYING BITS (NORMALLY -1,-1) ARE SAME
  596. XC                       AS FWIM BITS
  597. XC BIT <9>       IF 1, OBJECT MUST BE REACHABLE
  598. XC BITS <8:0>    PREPOSITION NUMBER FOR SYNMCH
  599. XC
  600. XC THE FWIM WORDS HAVE THE SAME FORMAT AS THE TWO OBJECT FLAG WORDS.
  601. XC
  602. XC NOTE THAT BITS 12 AND 11 OF OBJECT DESCRIPTIONS ACTUALLY HAVE
  603. XC FOUR DISTINCT STATES--
  604. XC
  605. XC       BIT 12  BIT 11  MDLDESC         INTERPRETATION
  606. XC       ------  ------  -------         ---------------
  607. XC
  608. XC         0       0      --             NO PARSER ACTION
  609. XC         0       1      HAVE           ADVENTURER MUST HAVE OBJECT
  610. XC         1       0      TRY            TRY TO TAKE, DONT CARE IF FAIL
  611. XC         1       1      TAKE           TRY TO TAKE, CARE IF FAIL
  612. XC
  613. X`0C
  614. XC SPARSE, PAGE 5
  615. XC
  616. XC   THE FOLLOWING DATA STATEMENT WAS ORIGINALLY:
  617. XC
  618. X      DATA VVOC1/3RBRI,2REF,1,70,3RVER,3RBOS,1,71,
  619. X     &   3RSUP,3RERB,1,72,3RSTA,1RY,1,73,3RVER,3RSIO,1,74,
  620. X     &   3RSWI,1RM,3RBAT,2RHE,3RWAD,1RE,1,75,3RGER,3RONI,1,76,
  621. X     &   3RULY,3RSSE,3RODY,3RSSE,1,77,
  622. X     &   3RWEL,1RL,1,78,3RPRA,1RY,1,79,3RTRE,3RASU,1,80,
  623. X     &   3RTEM,3RPLE,1,81,3RBLA,2RST,1,82,3RSCO,2RRE,1,83,
  624. X     &   1RQ,0,3RQUI,1RT,1,84,3RHEL,1RP,1,40,3RINF,1RO,1,41,
  625. X     &   3RHIS,3RTOR,3RUPD,3RATE,1,42,3RBAC,1RK,1,43,
  626. X     &   3RSIG,1RH,3RMUM,3RBLE,1,44/
  627. XC
  628. XC
  629. X      DATA VVOC1A/3RCHO,2RMP,3RLOS,1RE,3RBAR,1RF,1,45,
  630. X     &   3RDUN,3RGEO,1,46,3RFRO,3RBOZ,1,47,3RFOO,0,3RBLE,3RTCH,
  631. X     &   3RBAR,0,1,48,3RREP,3RENT,1,49,3RHOU,2RRS,3RSCH,3REDU,1,50,
  632. X     &   3RWIN,0,1,51,3RYEL,1RL,3RSCR,3REAM,3RSHO,2RUT,1,52,
  633. X     &   3RHOP,0,3RSKI,1RP,1,53,3RFUC,1RK,3RSHI,1RT,3RDAM,1RN,
  634. X     &   3RCUR,2RSE,1,54,3RZOR,1RK,1,55,3RGRA,3RNIT,1,'50070'o,
  635. X     &   3RSAV,1RE,1,149,3RRES,3RTOR,1,150,3RTIM,1RE,1,90,
  636. X     &   3RDIA,3RGNO,1,94,3REXO,3RRCI,1,105,3RINV,3RENT,
  637. X     &   1RI,0,1,133,3RWAI,1RT,1,128,
  638. X     &   3RINC,3RANT,1,95,3RANS,3RWER,1,96/
  639. XC
  640. XC
  641. XC
  642. XC
  643. X      DATA VVOC1B/3RAGA,2RIN,1,57,3RNOO,2RBJ,1,58,
  644. X     &   3RBUG,0,3RGRI,2RPE,3RCOM,3RPLA,1,59,
  645. X     &   3RFEA,3RTUR,3RCOM,3RMEN,3RSUG,3RGES,3RIDE,1RA,1,60,
  646. X     &   3RROO,1RM,1,65,3ROBJ,3RECT,1,66,3RRNA,2RME,1,67/
  647. XC
  648. XC
  649. XC
  650. XC
  651. X      DATA VVOC2/3RDEF,3RLAT,1,'50147'o,
  652. X     &3RDES,3RCRI,3RWHA,1RT,3REXA,3RMIN,1,'50170'o,
  653. X     &3RFIL,1RL,11,'60206'o,'61000'o,'200'o,0,'61002'o,'400'o,0,
  654. X     &     '40206'o,'61000'o,'200'o,0,
  655. X     &3RFIN,1RD,3RSEE,1RK,3RWHE,2RRE,3RSEE,0,4,'40177'o,'60000'o,-1,-1,
  656. X     &3RFOL,3RLOW,2,'125'o,'50125'o,
  657. X     &3RKIC,1RK,3RBIT,1RE,3RTAU,2RNT,1,'50153'o,3RLOW,2RER,1,'50156'o,
  658. X     &3RPUS,1RH,3RPRE,2RSS,1,'50160'o,3RRIN,1RG,3RPEA,1RL,1,'50127'o,
  659. X     &3RRUB,0,3RCAR,3RESS,3RTOU,2RCH,3RFON,3RDLE,1,'50157'o,
  660. X     &3RSHA,2RKE,1,'50171'o,3RSPI,1RN,1,'50201'o,
  661. X     &3RUNT,2RIE,3RFRE,1RE,1,'50161'o,3RWAL,1RK,9,'50216'o,
  662. X     &     '40126'o,'61002'o,-1,-1,'40126'o,'61005'o,-1,-1/
  663. XC
  664. XC
  665. XC
  666. XC
  667. XC
  668. XC
  669. X      DATA VVOC3/3RATT,3RACK,3RFIG,2RHT,3RINJ,3RURE,3RHIT,0,3RHUR,1RT,
  670. X     &          7,'60215'o,'21000'o,0,'200'o,'44002'o,0,'1000'o,
  671. X     &3RBOA,2RRD,4,'40202'o,'21000'o,0,'2'o,
  672. X     &3RBRU,2RSH,3RCLE,2RAN,5,'52130'o,'70130'o,'61002'o,-1,-1,
  673. X     &3RBUR,1RN,3RIGN,3RITE,3RINC,3RINE,7,'60211'o,'61000'o,'20'o,0,
  674. X     &          '64002'o,'10'o,0,
  675. X     &3RCLI,2RMB,12,'40235'o,'20007'o,0,'4000'o,
  676. X     &          '40236'o,'20006'o,0,'4000'o,'40234'o,'20000'o,0,'4000'o,
  677. X     &3RCLO,2RSE,4,'40176'o,'61000'o,'10200'o,0,
  678. X     &3RDIG,0,4,'40131'o,'44002'o,'4'o,0,
  679. X     &3RDIS,3REMB,4,'40203'o,'20000'o,0,'2'o,
  680. X     &3RDRI,2RNK,3RIMB,3RIBE,3RSWA,3RLLO,4,'40210'o,'61000'o,'400'o,0,
  681. X     &3RDRO,1RP,3RREL,3REAS,11,'42221'o,'41000'o,-1,-1,
  682. X     &          '60221'o,'41000'o,-1,-1,'61005'o,-1,-1,
  683. X     &3REAT,0,3RCON,3RSUM,3RGOB,3RBLE,3RMUN,2RCH,3RTAS,2RTE,
  684. X     &          4,'40207'o,'75000'o,'2000'o,0,
  685. X     &3REXT,3RING,3RDOU,2RSE,4,'40174'o,'75000'o,'100'o,0/
  686. XC
  687. XC
  688. XC
  689. X      DATA VVOC4/3RGIV,1RE,3RHAN,1RD,3RDON,3RATE,11,'72222'o,'21004'o,
  690. X     &          '40'o,0,'64222'o,'21000'o,'40'o,0,'61000'o,-1,-1,
  691. X     &   3RHEL,2RLO,2RHI,0,2,'2227'o,'50227'o,
  692. X     &   3RBLO,1RW,15,'62146'o,'61007'o,-1,-1,'61002'o,'4'o,0,
  693. X     &          '40160'o,'61007'o,-1,-1,'40165'o,'61005'o,-1,-1,
  694. X     &   3RINF,3RLAT,4,'70146'o,'61002'o,'4'o,0,
  695. X     &   3RJUM,1RP,3RLEA,1RP,5,'133'o,'40133'o,'61001'o,-1,-1,
  696. X     &   3RKIL,1RL,3RMUR,3RDER,3RSLA,1RY,3RSTA,1RB,3RDIS,3RPAT,
  697. X     &          7,'60213'o,'21000'o,0,'200'o,
  698. X     &          '44002'o,0,'1000'o,
  699. X     &   3RKNO,2RCK,3RRAP,0,12,'42166'o,'61003'o,-1,-1,
  700. X     &          '40166'o,'61012'o,-1,-1,'40215'o,'23006'o,'40'o,0,
  701. X     &   3RLIG,2RHT,11,'42173'o,'75000'o,'100'o,0,
  702. X     &          '60211'o,'61000'o,'100'o,0,'54002'o,'10'o,0,
  703. X     &   3RLOC,1RK,4,'40134'o,'20000'o,-1,-1/
  704. XC
  705. XC
  706. XC
  707. XC
  708. X      DATA VVOC5/3RLOO,1RK,1RL,0,3RSTA,2RRE,3RGAZ,1RE,
  709. X     &          13,'167'o,'40167'o,'60003'o,-1,-1,
  710. X     &          '40231'o,'61010'o,-1,-1,'40230'o,'60005'o,-1,-1,
  711. X     &   3RMEL,1RT,3RLIQ,3RUIF,4,'70145'o,'61002'o,'10'o,0,
  712. X     &   3RMOV,1RE,4,'40172'o,'20000'o,-1,-1,
  713. X     &   3RPUL,1RL,3RTUG,0,8,'42172'o,'21000'o,-1,-1,
  714. X     &          '40172'o,'21012'o,-1,-1,
  715. X     &   3RMUN,1RG,3RHAC,1RK,3RFRO,1RB,3RDAM,3RAGE,
  716. X     &          5,'52212'o,'70212'o,'44002'o,-1,-1,
  717. X     &   3ROPE,1RN,11,'42175'o,'61000'o,'10200'o,0,
  718. X     &          '60175'o,'61000'o,'10200'o,0,'54002'o,'4'o,'1000'o,
  719. X     &   3RPIC,1RK,4,'40204'o,'61007'o,'20000'o,'40'o,
  720. X     &   3RPLU,1RG,3RGLU,1RE,3RPAT,2RCH,4,'70152'o,'61002'o,-1,-1,
  721. X     &   3RPOK,1RE,3RBRE,2RAK,3RJAB,0,7,'60212'o,'21000'o,0,'200'o,
  722. X     &          '44002'o,0,'1000'o,
  723. X     &   3RPOU,1RR,3RSPI,2RLL,11,'42223'o,'42000'o,'400'o,0,
  724. X     &          '60223'o,'42000'o,'400'o,0,'60005'o,-1,-1,
  725. X     &          3RPUM,1RP,4,'60232'o,'60007'o,-1,-1/
  726. XC
  727. XC
  728. XC
  729. XC
  730. X      DATA VVOC6/3RPUT,0,3RINS,3RERT,3RSTU,2RFF,3RPLA,2RCE,
  731. X     &          8,'72220'o,'61005'o,-1,-1,
  732. X     &          '40221'o,'61006'o,-1,-1,
  733. X     &   3RRAI,2RSE,3RLIF,1RT,5,'52155'o,'40155'o,'61007'o,-1,-1,
  734. X     &   3RREA,1RD,3RSKI,1RM,11,'42144'o,'71000'o,'40000'o,0,
  735. X     &          '60144'o,'71000'o,'40000'o,0,'61002'o,-1,-1,
  736. X     &   3RSTR,3RIKE,12,'60215'o,'23000'o,'40'o,0,
  737. X     &          '44002'o,0,'1000'o,'42215'o,'23000'o,'40'o,0,'50173'o,
  738. X     &   3RSWI,2RNG,3RTHR,3RUST,7,'60214'o,'44000'o,0,'1000'o,
  739. X     &          '21003'o,0,'200'o,
  740. X     &   3RTAK,1RE,3RGET,0,3RHOL,1RD,3RCAR,2RRY,3RREM,3ROVE,
  741. X     &          4,'40204'o,'61000'o,'20000'o,'40'o,
  742. X     &3RTEL,1RL,3RCOM,3RMAN,3RREQ,3RUES,4,'40217'o,'20000'o,0,'2000'o,
  743. X     &3RTHR,2ROW,3RHUR,1RL,3RCHU,2RCK,14,'60224'o,'44000'o,-1,-1,
  744. X     & '21003'o,'40'o,0,'60224'o,'44000'o,-1,-1,'21002'o,'40'o,0/
  745. XC
  746. XC
  747. XC
  748. XC
  749. X      DATA VVOC7/3RTIE,0,3RFAS,3RTEN,11,'70162'o,'61004'o,-1,-1,
  750. X     &          '60163'o,'21000'o,'40'o,0,'65002'o,'4'o,0,
  751. X     &   3RTUR,1RN,3RSET,0,22,'62164'o,'61000'o,'2'o,0,
  752. X     &          '64002'o,'4'o,0,
  753. X     &          '40173'o,'75012'o,'100'o,0,'40174'o,'75013'o,'100'o,0,
  754. X     &          '60237'o,'61000'o,'2'o,0,'20004'o,-1,-1,
  755. X     &   3RUNL,3ROCK,7,'60135'o,'21000'o,-1,-1,
  756. X     &          '74002'o,'4'o,0,
  757. X     &   3RWAK,1RE,3RSUR,3RPRI,3RALA,2RRM,3RSTA,3RRTL,
  758. X     &          8,'42150'o,'20000'o,'40'o,0,
  759. X     &          '40150'o,'20007'o,'40'o,0,
  760. X     &   3RWAV,1RE,3RFLA,3RUNT,3RBRA,3RNDI,4,'40154'o,'40000'o,-1,-1,
  761. X     &   3RWIN,1RD,5,'50233'o,'40233'o,'61007'o,-1,-1/
  762. XC
  763. XC
  764. XC
  765. XC
  766. X      DATA VVOCND/-1/
  767. X`0C
  768. XC SPARSE, PAGE 6
  769. XC
  770. XC OBJECTS--     MAPS OBJECTS TO OBJECT INDICES
  771. XC
  772. XC SAME FORMAT AS AVOC.
  773. XC
  774. XC
  775. X      DATA OVOC1/3RBAG,0,1,25,100,3RSAC,1RK,1,3RGAR,3RLIC,2,
  776. X     &   3RCLO,2RVE,2,3RFOO,1RD,3,3RSAN,3RDWI,3,3RLUN,2RCH,3,
  777. X     &   3RDIN,3RNER,3,
  778. X     &   3RGUN,1RK,4,55,3RPIE,2RCE,4,143,186,3RSLA,1RG,4,3RCOA,1RL,5,
  779. X     &   3RPIL,1RE,5,18,38,78,87,88,122,3RHEA,1RP,5,
  780. X     &   3RFIG,3RURI,6,
  781. X     &   3RMAC,3RHIN,7,3RPDP,2R10,7,3RPDP,2R11,7,3RDRY,2RER,7,
  782. X     &   3RLID,0,7,3RDIA,3RMON,8,3RCAS,1RE,9,123,3RBOT,3RTLE,10,121,
  783. X     &   3RCON,3RTAI,10,3RWAT,2RER,11,209,3RQUA,3RNTI,11,209,
  784. X     &   3RLIQ,3RUID,11,209,3RH2O,0,11,209,
  785. X     &   3RROP,1RE,12,101,3RHEM,1RP,12,3RCOI,1RL,12,110,
  786. X     &   3RKNI,2RFE,13,21,3RBLA,2RDE,13,14,3RSWO,2RRD,14,3RORC,3RHRI,14,
  787. X     &   3RGLA,3RMDR,14,3RLAM,1RP,15,16,22,3RLAN,3RTER,15,16,22,
  788. X     &   3RRUG,0,17,3RCAR,3RPET,17,
  789. X     &   3RLEA,3RVES,18,3RLEA,1RF,18,3RTRO,2RLL,19,
  790. X     &   3RAXE,0,20,3RDIN,3RNER,3/
  791. XC
  792. XC
  793. XC
  794. X      DATA OVOC2/3RKEY,1RS,23,3RKEY,0,23,
  795. X     &   3RSET,0,23,3RBON,2RES,24,3RSKE,3RLET,24,3RBOD,1RY,24,73,
  796. X     &   3RCOI,2RNS,25,3RBAR,0,26,165,168,
  797. X     &   3RNEC,3RKLA,27,3RPEA,3RRLS,27,3RMIR,3RROR,28,29,212,
  798. X     &   3RICE,0,30,3RMAS,1RS,30,3RGLA,3RCIE,30,3RRUB,1RY,31,
  799. X     &   3RTRI,3RDEN,32,3RFOR,1RK,32,3RCOF,3RFIN,33,3RCAS,3RKET,33,
  800. X     &   3RTOR,2RCH,34,3RCAG,1RE,35,36,124,125,3RDUM,3RBWA,35,36,
  801. X     &   3RBAS,3RKET,35,36,98,113,3RBRA,3RCEL,37,
  802. X     &   3RJEW,2REL,37,3RTIM,3RBER,38,3RBOX,0,39,53,105,3RSTR,3RADI,40,
  803. X     &   3RVIO,3RLIN,40,3RENG,3RRAV,41,3RINS,3RCRI,41,44,3RGHO,2RST,42,
  804. X     &   3RSPI,3RRIT,42,3RFIE,2RND,42,3RGRA,2RIL,43,3RPRA,3RYER,44,47,
  805. X     &   3RTRU,2RNK,45,3RCHE,2RST,45,3RBEL,1RL,46,
  806. X     &   3RBOO,1RK,47,49,114,115,116,117,3RBIB,2RLE,47/
  807. XC
  808. XC
  809. XC
  810. X      DATA OVOC3/3RGOO,3RDBO,47,3RCAN,3RDLE,48,3RPAI,1RR,48,
  811. X     &   3RGUI,3RDEB,49,
  812. X     &   3RGUI,2RDE,49,3RPAP,2RER,50,122,143,186,3RNEW,3RSPA,50,
  813. X     &   3RISS,2RUE,50,3RREP,3RORT,50,3RMAG,3RAZI,50,3RNEW,1RS,50,
  814. X     &   3RMAT,3RCHB,51,
  815. X     &   3RMAT,2RCH,51,3RMAT,3RCHE,51,3RADV,3RERT,52,3RPAM,3RPHL,52,
  816. X     &   3RLEA,3RFLE,52,3RBOO,3RKLE,52,3RMAI,3RLBO,53,
  817. X     &   3RTUB,1RE,54,3RTOO,3RTHP,54,3RPUT,2RTY,55,3RMAT,3RERI,55,
  818. X     &   3RGLU,1RE,55,3RWRE,3RNCH,56,3RSCR,3REWD,57,
  819. X     &   3RCYC,3RLOP,58,3RMON,3RSTE,58,3RCHA,3RLIC,59,3RCUP,0,59,
  820. X     &   3RGOB,3RLET,59,3RPAI,3RNTI,60,149,3RART,0,60,149,
  821. X     &   3RCAN,3RVAS,60,3RPIC,3RTUR,60,3RWOR,1RK,60,
  822. X     &   3RMAS,3RTER,60,215,3RTHI,2REF,61,3RROB,3RBER,61,
  823. X     &   3RCRI,3RMIN,61,3RBAN,3RDIT,61,3RCRO,2ROK,61,3RGEN,1RT,61,
  824. X     &   3RGEN,3RTLE,61,3RMAN,0,61,3RTHU,1RG,61,
  825. X     &   3RBAG,3RMAN,61,3RSTI,3RLLE,62/
  826. XC
  827. XC
  828. X      DATA OVOC4/3RWIN,3RDOW,63,3RBOL,1RT,64,3RNUT,0,64,
  829. X     &   3RGRA,2RTE,65,3RGRA,3RTIN,65,3RDOO,1RR,66,67,68,69,
  830. X     &   164,172,173,174,175,189,3RTRA,3RPDO,66,
  831. X     &   3RTRA,3RP$D,66,3RSWI,3RTCH,70,76,79,80,81,82,170,
  832. X     &   3RHEA,1RD,71,120,3RCOR,3RPSE,72,73,3RBOD,3RIES,73,
  833. X     &   3RDAM,0,74,3RGAT,2RES,74,76,3RGAT,1RE,74,76,
  834. X     &   3RFCD,0,74,3RRAI,1RL,75,3RRAI,3RLIN,75,
  835. X     &   3RBUT,3RTON,76,79,80,81,82,127,128,129,170,176,
  836. X     &   3RBUB,3RBLE,77,3RLEA,1RK,78,3RDRI,1RP,78,
  837. X     &   3RHOL,1RE,78,107,
  838. X     &   3RBAT,0,83,3RRAI,3RNBO,84,
  839. X     &   3RPOT,0,85,3RSTA,3RTUE,86,3RSCU,3RLPT,86,3RROC,1RK,86,
  840. X     &   3RBOA,1RT,87,88,90,3RPLA,3RSTI,87,88,
  841. X     &   3RPUM,1RP,89/
  842. XC
  843. XC
  844. XC
  845. X      DATA OVOC5/3RAIR,3RPUM,89,3RAIR,3R$PU,89,3RLAB,2REL,91,112,
  846. X     &   3RFIN,3REPR,91,3RSTI,2RCK,92,3RBAR,3RREL,93,3RBUO,1RY,94,
  847. X     &   3REME,3RRAL,95,3RSHO,3RVEL,96,3RGUA,2RNO,97,3RCRA,1RP,97,
  848. X     &   3RSHI,1RT,97,3RHUN,1RK,97,3RBAL,3RLOO,98,113,
  849. X     &   3RREC,3REPT,99,3RWIR,1RE,101,110,
  850. X     &   3RHOO,1RK,102,103,3RZOR,3RKMI,104,148,3RCOI,1RN,104,
  851. X     &   3RSAF,1RE,105,3RCAR,1RD,106,188,3RNOT,1RE,106,186,
  852. X     &   3RSLO,1RT,107,187,3RCRO,2RWN,108,3RBRI,2RCK,109,
  853. X     &   3RFUS,1RE,110,3RGNO,2RME,111,152,
  854. X     &   3RSTA,2RMP,118,
  855. X     &   3RTOM,1RB,119,3RCRY,2RPT,119,3RGRA,2RVE,119,3RHEA,2RDS,120,
  856. X     &   3RPOL,2RES,120,3RIMP,3RLEM,120/
  857. XC
  858. XC
  859. XC
  860. X      DATA OVOC6/3RLOS,3RERS,120,3RCOK,2RES,121,
  861. X     &   3RLIS,3RTIN,122,3RSTA,2RCK,122,
  862. X     &   3RPRI,3RNTO,122,
  863. X     &   3RSPH,3RERE,126,3RBAL,1RL,126,
  864. X     &   3RETC,3RHIN,130,131,
  865. X     &   3RWAL,2RLS,130,131,198,205,206,207,208,3RWAL,1RL,
  866. X     &   130,131,159,160,161,162,163,164,198,205,206,207,208,
  867. X     &   3RFLA,2RSK,132,3RPOO,1RL,133,3RSEW,3RAGE,133,
  868. X     &   3RTIN,0,134,3RSAF,3RFRO,134,3RSPI,3RCES,134,3RTAB,2RLE,135,
  869. X     &   3RPOS,1RT,136,166,167,3RPOS,2RTS,136,3RBUC,3RKET,137,
  870. X     &   3RCAK,1RE,138,139,140,141,3RICI,2RNG,139,140,141,
  871. X     &   3RROB,2ROT,142,3RROB,2RBY,142,
  872. X     &   3RC3P,1RO,142,3RR2D,1R2,142/
  873. XC
  874. XC
  875. XC
  876. X      DATA OVOC6A/3RPAN,2REL,159,160,161,162,163,164,213,
  877. X     &   3RPOL,1RE,166,167,3RTBA,1RR,168,3RT$B,2RAR,168,
  878. X     &   3RARR,2ROW,169,3RPOI,2RNT,169,3RBEA,1RM,171,
  879. X     &   3RDIA,1RL,177,3RSUN,3RDIA,177,1R1,0,178,
  880. X     &   3RONE,0,178,1R2,0,179,3RTWO,0,179,1R3,0,180,
  881. X     &   3RTHR,2REE,180,1R4,0,181,3RFOU,1RR,181,1R5,0,182,
  882. X     &   3RFIV,1RE,182,1R6,0,183,3RSIX,0,183,1R7,0,184,
  883. X     &   3RSEV,2REN,184,1R8,0,185,3REIG,2RHT,185,
  884. X     &   3RWAR,3RNIN,186,3RSLI,1RT,187,
  885. X     &   2RIT,0,192,3RTHA,1RT,192,3RTHI,1RS,192/
  886. XC
  887. XC
  888. X      DATA OVOC7/2RME,0,193,3RMYS,3RELF,193,3RCRE,3RTIN,193,
  889. X     &   3RALL,0,194,3REVE,3RRYT,194,
  890. X     &   3RTRE,3RASU,195,3RVAL,3RUAB,195,3RSAI,3RLOR,196,3RTEE,2RTH,197,
  891. X     &   3RGRU,1RE,199,3RHAN,1RD,200,3RHAN,2RDS,200,
  892. X     &   3RLUN,2RGS,201,3RAIR,0,201,3RAVI,3RATO,202,
  893. X     &   3RFLY,2RER,202,3RTRE,1RE,144,145,204,
  894. X     &   3RCLI,2RFF,146,147,3RLED,2RGE,146,147,3RPOR,3RTRA,149,
  895. X     &   3RSTA,2RCK,148,3RBIL,2RLS,148,
  896. X     &   3RVAU,2RLT,150,3RCUB,1RE,150,3RLET,3RTER,67,150,
  897. X     &   3RCUR,3RTAI,151,3RLIG,2RHT,151,3RNES,1RT,153,
  898. X     &   3REGG,0,154,155,3RBAU,3RBLE,156,3RCAN,3RARY,157,158,
  899. X     &   3RBIR,1RD,203,3RSON,3RGBI,203,
  900. X     &   3RGUA,2RRD,210,3RGUA,3RRDI,210,3RROS,1RE,211,
  901. X     &   3RSTR,3RUCT,212,3RCHA,3RNNE,214,
  902. X     &   3RKEE,3RPER,215,3RLAD,3RDER,216/
  903. XC
  904. XC
  905. XC
  906. X      DATA OVOCND/-1/
  907. X
  908. X`0C
  909. XC SPARSE, PAGE 7
  910. XC
  911. XC SET UP FOR PARSING
  912. XC
  913. X      SPARSE=-1
  914. XC                                               !ASSUME PARSE FAILS.
  915. X      ADJ=0
  916. XC                                               !CLEAR PARTS HOLDERS.
  917. X      ACT=0
  918. X      PREP=0
  919. X      PPTR=0
  920. X      O1=0
  921. X      O2=0
  922. X      P1=0
  923. X      P2=0
  924. X      DFLAG=and(PRSFLG,4).NE.0
  925. XC
  926. X      BUZLNT=20
  927. X      PRPLNT=48
  928. X      DIRLNT=75
  929. X`0C
  930. XC SPARSE, PAGE 8
  931. XC
  932. XC NOW LOOP OVER INPUT BUFFER OF LEXICAL TOKENS.
  933. XC
  934. X      DO 1000 I=1,LLNT,2
  935. XC                                               !TWO WORDS/TOKEN.
  936. X        LBUF1=LBUF(I)
  937. XC                                               !GET CURRENT TOKEN.
  938. X        LBUF2=LBUF(I+1)
  939. X        if (dflag) write(0,*) 'lbuf1=',lbuf1,' lbuf2=',lbuf2
  940. X        IF(LBUF1.EQ.0) GO TO 1500
  941. XC                                               !END OF BUFFER?
  942. XC
  943. XC CHECK FOR BUZZ WORD
  944. XC
  945. X        DO 50 J=1,BUZLNT,2
  946. X          IF((LBUF1.EQ.BVOC(J)).AND.(LBUF2.EQ.BVOC(J+1)))
  947. X     &          GO TO 1000
  948. X50      CONTINUE
  949. XC
  950. XC CHECK FOR ACTION OR DIRECTION
  951. XC
  952. X        IF(ACT.NE.0) GO TO 75
  953. XC                                               !GOT ACTION ALREADY?
  954. X        J=1
  955. XC                                               !CHECK FOR ACTION.
  956. X125     IF((LBUF1.EQ.VVOC(J)).AND.(LBUF2.EQ.VVOC(J+1)))
  957. X     &    GO TO 3000
  958. X150     J=J+2
  959. XC                                               !ADV TO NEXT SYNONYM.
  960. X        IF(.NOT.OTEST(VVOC(J))) GO TO 125
  961. XC                                               !ANOTHER VERB?
  962. X        J=J+VVOC(J)+1
  963. XC                                               !NO, ADVANCE OVER SYNTAX.
  964. X        IF(VVOC(J).NE.-1) GO TO 125
  965. XC                                               !TABLE DONE?
  966. XC
  967. X75      IF((ACT.NE.0).AND.((VVOC(ACT).NE.R50WAL).OR.
  968. X     &     (PREP.NE.0))) GO TO 200
  969. X        DO 100 J=1,DIRLNT,3
  970. XC                                               !THEN CHK FOR DIR.
  971. X          IF((LBUF1.EQ.DVOC(J)).AND.(LBUF2.EQ.DVOC(J+1)))
  972. X     &      GO TO 2000
  973. X100     CONTINUE
  974. XC
  975. XC NOT AN ACTION, CHECK FOR PREPOSITION, ADJECTIVE, OR OBJECT.
  976. XC
  977. X200     DO 250 J=1,PRPLNT,3
  978. XC                                               !LOOK FOR PREPOSITION.
  979. X          IF((LBUF1.EQ.PVOC(J)).AND.(LBUF2.EQ.PVOC(J+1)))
  980. X     &      GO TO 4000
  981. X250     CONTINUE
  982. XC
  983. X        J=1
  984. XC                                               !LOOK FOR ADJECTIVE.
  985. X300     IF((LBUF1.EQ.AVOC(J)).AND.(LBUF2.EQ.AVOC(J+1)))
  986. X     &    GO TO 5000
  987. X        J=J+1
  988. X325     J=J+1
  989. XC                                               !ADVANCE TO NEXT ENTRY.
  990. X        IF(OTEST(AVOC(J))) GO TO 325
  991. XC                                               !A RADIX 50 CONSTANT?
  992. X        IF(AVOC(J).NE.-1) GO TO 300
  993. XC                                               !POSSIBLY, END TABLE?
  994. XC
  995. X        J=1
  996. XC                                               !LOOK FOR OBJECT.
  997. X450     IF((LBUF1.EQ.OVOC(J)).AND.(LBUF2.EQ.OVOC(J+1)))
  998. X     &    GO TO 600
  999. X        J=J+1
  1000. X500     J=J+1
  1001. X        IF(OTEST(OVOC(J))) GO TO 500
  1002. X        IF(OVOC(J).NE.-1) GO TO 450
  1003. XC
  1004. XC NOT RECOGNIZABLE
  1005. XC
  1006. X        IF(VBFLAG) CALL RSPEAK(601)
  1007. X        RETURN
  1008. X`0C
  1009. XC SPARSE, PAGE 9
  1010. XC
  1011. XC OBJECT PROCESSING (CONTINUATION OF DO LOOP ON PREV PAGE)
  1012. XC
  1013. X600     OBJ=GETOBJ(J,ADJ,0)
  1014. XC                                               !IDENTIFY OBJECT.
  1015. X        IF(DFLAG) PRINT 60,J,OBJ
  1016. X60      FORMAT(' SPARSE- OBJ AT ',I6,'  OBJ= ',I6)
  1017. X        IF(OBJ.LE.0) GO TO 6000
  1018. XC                                               !IF LE, COULDNT.
  1019. X        IF(OBJ.NE.ITOBJ) GO TO 650
  1020. XC                                               !'IT'?
  1021. X        OBJ=GETOBJ(0,0,LASTIT)
  1022. XC                                               !FIND LAST.
  1023. X        IF(OBJ.LE.0) GO TO 6000
  1024. XC                                               !IF LE, COULDNT.
  1025. XC
  1026. X650     IF(PREP.EQ.9) GO TO 8000
  1027. XC                                               !'OF' OBJ?
  1028. X        IF(PPTR.EQ.2) GO TO 7000
  1029. XC                                               !TOO MANY OBJS?
  1030. X        PPTR=PPTR+1
  1031. X        OBJVEC(PPTR)=OBJ
  1032. XC                                               !STUFF INTO VECTOR.
  1033. X        PRPVEC(PPTR)=PREP
  1034. X700     PREP=0
  1035. X        ADJ=0
  1036. X
  1037. XC Go to end of do loop (moved '1000 CONTINUE' to end of module, to avoid
  1038. XC complaints about people jumping back into the doloop.)
  1039. X
  1040. X        GOTO 1000
  1041. X`0C
  1042. XC SPARSE, PAGE 10
  1043. XC
  1044. XC SPECIAL PARSE PROCESSORS
  1045. XC
  1046. XC 2000--        DIRECTION
  1047. XC
  1048. X2000  PRSA=WALKW
  1049. X      PRSO=DVOC(J+2)
  1050. X      SPARSE=1
  1051. X      IF(DFLAG) PRINT 10,J
  1052. X10    FORMAT(' SPARSE- DIR AT ',I6)
  1053. X      RETURN
  1054. XC
  1055. XC 3000--        ACTION
  1056. XC
  1057. X3000  ACT=J
  1058. X      OACT=0
  1059. X      IF(DFLAG) PRINT 20,J
  1060. X20    FORMAT(' SPARSE- ACT AT ',I6)
  1061. X      if(dflag) write(0,*) 'count=',vvoc(j+2),' vnr=',vvoc(j+3)
  1062. X      GO TO 1000
  1063. XC
  1064. XC 4000--        PREPOSITION
  1065. XC
  1066. X4000  IF(PREP.NE.0) GO TO 4500
  1067. X      PREP=PVOC(J+2)
  1068. X      ADJ=0
  1069. X      IF(DFLAG) PRINT 30,J
  1070. X30    FORMAT(' SPARSE- PREP AT ',I6)
  1071. X      GO TO 1000
  1072. XC
  1073. X4500  IF(VBFLAG) CALL RSPEAK(616)
  1074. X      RETURN
  1075. XC
  1076. XC 5000--        ADJECTIVE
  1077. XC
  1078. X5000  ADJ=J
  1079. X      J=(and(ONAME,OFLAG))
  1080. X      IF(DFLAG) PRINT 40,ADJ,J
  1081. X40    FORMAT(' SPARSE- ADJ AT ',I6,' ORPHAN= ',I6)
  1082. X      IF((J.NE.0).AND.(I.GE.LLNT)) GO TO 600
  1083. X      GO TO 1000
  1084. XC
  1085. XC 6000--        UNIDENTIFIABLE OBJECT (INDEX INTO OVOC IS J)
  1086. XC
  1087. X6000  IF(OBJ.LT.0) GO TO 6100
  1088. X      J=579
  1089. X      IF(LIT(HERE)) J=618
  1090. X      IF(VBFLAG) CALL RSPEAK(J)
  1091. X      RETURN
  1092. XC
  1093. X6100  IF(OBJ.NE.-10000) GO TO 6200
  1094. X      IF(VBFLAG) CALL RSPSUB(620,ODESC2(AVEHIC(WINNER)))
  1095. X      RETURN
  1096. XC
  1097. X6200  IF(VBFLAG) CALL RSPEAK(619)
  1098. X      IF(ACT.EQ.0) ACT=(and(OFLAG,OACT))
  1099. X      CALL ORPHAN(-1,ACT,O1,PREP,J)
  1100. X      RETURN
  1101. XC
  1102. XC 7000--        TOO MANY OBJECTS.
  1103. XC
  1104. X7000  IF(VBFLAG) CALL RSPEAK(617)
  1105. X      RETURN
  1106. XC
  1107. XC 8000--        RANDOMNESS FOR 'OF' WORDS
  1108. XC
  1109. X8000  IF(OBJVEC(PPTR).EQ.OBJ) GO TO 700
  1110. X      IF(VBFLAG) CALL RSPEAK(601)
  1111. X      RETURN
  1112. XC
  1113. XC End of do-loop.
  1114. XC
  1115. X1000  CONTINUE
  1116. XC                                               !AT LAST.
  1117. XC
  1118. XC NOW SOME MISC CLEANUP -- We fell out of the do-loop
  1119. XC
  1120. X1500  IF(ACT.EQ.0) ACT=(and(OFLAG,OACT))
  1121. X      IF(ACT.EQ.0) GO TO 9000
  1122. XC                                               !IF STILL NONE, PUNT.
  1123. X      IF(ADJ.NE.0) GO TO 10000
  1124. XC                                               !IF DANGLING ADJ, PUNT.
  1125. XC
  1126. X      IF((OFLAG.NE.0).AND.(OPREP.NE.0).AND.(PREP.EQ.0).AND.
  1127. X     &   (O1.NE.0).AND.(O2.EQ.0).AND.(ACT.EQ.OACT))
  1128. X     &  GO TO 11000
  1129. XC
  1130. X      SPARSE=0
  1131. XC                                               !PARSE SUCCEEDS.
  1132. X      IF(PREP.EQ.0) GO TO 1750
  1133. XC                                               !IF DANGLING PREP,
  1134. X      IF((PPTR.EQ.0).OR.(PRPVEC(PPTR).NE.0))
  1135. X     &  GO TO 12000
  1136. X      PRPVEC(PPTR)=PREP
  1137. XC                                               !CVT TO 'PICK UP FROB'.
  1138. XC
  1139. XC 1750--        RETURN A RESULT
  1140. XC
  1141. X1750  CONTINUE
  1142. XC                                               !WIN.
  1143. X      IF(DFLAG) PRINT 70,ACT,O1,O2,P1,P2
  1144. X70    FORMAT(' SPARSE RESULTS- ',5I7)
  1145. X      if(dflag) write(0,*) 'sparse=',sparse
  1146. X      RETURN
  1147. XC                                               !LOSE.
  1148. XC
  1149. XC 9000--        NO ACTION, PUNT
  1150. XC
  1151. X9000  IF(O1.EQ.0) GO TO 10000
  1152. XC                                               !ANY DIRECT OBJECT?
  1153. X      IF(VBFLAG) CALL RSPSUB(621,ODESC2(O1))
  1154. XC                                               !WHAT TO DO?
  1155. X      CALL ORPHAN(-1,0,O1,0,0)
  1156. X      RETURN
  1157. XC
  1158. XC 10000--       TOTAL CHOMP
  1159. XC
  1160. X10000 IF(VBFLAG) CALL RSPEAK(622)
  1161. XC                                               !HUH?
  1162. X      RETURN
  1163. XC
  1164. XC 11000--       ORPHAN PREPOSITION.  CONDITIONS ARE
  1165. XC               O1.NE.0, O2=0, PREP=0, ACT=OACT
  1166. XC
  1167. X11000 IF(OSLOT.NE.0) GO TO 11500
  1168. XC                                               !ORPHAN OBJECT?
  1169. X      P1=OPREP
  1170. XC                                               !NO, JUST USE PREP.
  1171. X      GO TO 1750
  1172. XC
  1173. X11500 O2=O1
  1174. XC                                               !YES, USE AS DIRECT OBJ.
  1175. X      P2=OPREP
  1176. X      O1=OSLOT
  1177. X      P1=0
  1178. X      GO TO 1750
  1179. XC
  1180. XC 12000--       TRUE HANGING PREPOSITION.
  1181. XC               ORPHAN FOR LATER.
  1182. XC
  1183. X12000 CALL ORPHAN(-1,ACT,0,PREP,0)
  1184. XC                                               !ORPHAN PREP.
  1185. X      GO TO 1750
  1186. XC
  1187. X      END
  1188. $ CALL UNPACK [.SRC]NP1.FOR;1 776142616
  1189. $ create 'f'
  1190. XC GETOBJ--      FIND OBJ DESCRIBED BY ADJ, NAME PAIR
  1191. XC
  1192. XC COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
  1193. XC ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
  1194. XC WRITTEN BY R. M. SUPNIK
  1195. XC
  1196. XC DECLARATIONS
  1197. XC
  1198. XC THIS ROUTINE DETAILS ON BIT 3 OF PRSFLG
  1199. XC
  1200. X      INTEGER FUNCTION GETOBJ(OIDX,AIDX,SPCOBJ)
  1201. X      IMPLICIT INTEGER(A-Z)
  1202. X      LOGICAL THISIT,GHERE,LIT,CHOMP
  1203. X
  1204. X      INCLUDE 'PARSER.LIB'
  1205. X      INCLUDE 'GAMESTATE.LIB'
  1206. XC
  1207. XC MISCELLANEOUS VARIABLES
  1208. XC
  1209. X      COMMON /STAR/ MBASE,STRBIT
  1210. X
  1211. X      INCLUDE 'DEBUG.LIB'
  1212. X      INCLUDE 'OBJECTS.LIB'
  1213. X      INCLUDE 'OFLAGS.LIB'
  1214. X      INCLUDE 'ADVERS.LIB'
  1215. X      INCLUDE 'VOCAB.LIB'
  1216. X`0C
  1217. XC GETOBJ, PAGE 2
  1218. XC
  1219. X      DFLAG=and(PRSFLG, 8).NE.0
  1220. X      CHOMP=.FALSE.
  1221. X      AV=AVEHIC(WINNER)
  1222. X      OBJ=0
  1223. XC                                               !ASSUME DARK.
  1224. X      IF(.NOT.LIT(HERE)) GO TO 200
  1225. XC                                               !LIT?
  1226. XC
  1227. X      OBJ=SCHLST(OIDX,AIDX,HERE,0,0,SPCOBJ)
  1228. XC                                               !SEARCH ROOM.
  1229. X      IF(DFLAG) PRINT 10,OBJ
  1230. X10    FORMAT(' SCHLST- ROOM SCH ',I6)
  1231. X      IF(OBJ) 1000,200,100
  1232. XC                                               !TEST RESULT.
  1233. X100   IF((AV.EQ.0).OR.(AV.EQ.OBJ).OR.
  1234. X     &   (and(OFLAG2(OBJ),FINDBT).NE.0)) GO TO 200
  1235. X      IF(OCAN(OBJ).EQ.AV) GO TO 200
  1236. XC                                               !TEST IF REACHABLE.
  1237. X      CHOMP=.TRUE.
  1238. XC                                               !PROBABLY NOT.
  1239. XC
  1240. X200   IF(AV.EQ.0) GO TO 400
  1241. XC                                               !IN VEHICLE?
  1242. X      NOBJ=SCHLST(OIDX,AIDX,0,AV,0,SPCOBJ)
  1243. XC                                               !SEARCH VEHICLE.
  1244. X      IF(DFLAG) PRINT 20,NOBJ
  1245. X20    FORMAT(' SCHLST- VEH SCH  ',I6)
  1246. X      IF(NOBJ) 1100,400,300
  1247. XC                                               !TEST RESULT.
  1248. X300   CHOMP=.FALSE.
  1249. XC                                               !REACHABLE.
  1250. X      IF(OBJ.EQ.NOBJ) GO TO 400
  1251. XC                                               !SAME AS BEFORE?
  1252. X      IF(OBJ.NE.0) NOBJ=-NOBJ
  1253. XC                                               !AMB RESULT?
  1254. X      OBJ=NOBJ
  1255. XC
  1256. X400   NOBJ=SCHLST(OIDX,AIDX,0,0,WINNER,SPCOBJ)
  1257. XC                                               !SEARCH ADVENTURER.
  1258. X      IF(DFLAG) PRINT 30,NOBJ
  1259. X30    FORMAT(' SCHLST- ADV SCH  ',I6)
  1260. X      IF(NOBJ) 1100,600,500
  1261. XC                                               !TEST RESULT
  1262. X500   IF(OBJ.NE.0) NOBJ=-NOBJ
  1263. XC                                               !AMB RESULT?
  1264. X1100  OBJ=NOBJ
  1265. XC                                               !RETURN NEW OBJECT.
  1266. X600   IF(CHOMP) OBJ=-10000
  1267. XC                                               !UNREACHABLE.
  1268. X1000  GETOBJ=OBJ
  1269. XC
  1270. X      IF(GETOBJ.NE.0) GO TO 1500
  1271. XC                                               !GOT SOMETHING?
  1272. X      DO 1200 I=STRBIT+1,OLNT
  1273. XC                                               !NO, SEARCH GLOBALS.
  1274. X        IF(.NOT.THISIT(OIDX,AIDX,I,SPCOBJ)) GO TO 1200
  1275. X        IF(.NOT.GHERE(I,HERE)) GO TO 1200
  1276. XC                                               !CAN IT BE HERE?
  1277. X        IF(GETOBJ.NE.0) GETOBJ=-I
  1278. XC                                               !AMB MATCH?
  1279. X        IF(GETOBJ.EQ.0) GETOBJ=I
  1280. X1200  CONTINUE
  1281. XC
  1282. X1500  CONTINUE
  1283. XC                                               !END OF SEARCH.
  1284. X      IF(DFLAG) PRINT 40,GETOBJ
  1285. X40    FORMAT(' SCHLST- RESULT   ',I6)
  1286. X      RETURN
  1287. X      END
  1288. X`0C
  1289. XC SCHLST--      SEARCH FOR OBJECT
  1290. XC
  1291. XC DECLARATIONS
  1292. XC
  1293. X      INTEGER FUNCTION SCHLST(OIDX,AIDX,RM,CN,AD,SPCOBJ)
  1294. X      IMPLICIT INTEGER(A-Z)
  1295. X      LOGICAL THISIT,QHERE,NOTRAN,NOVIS
  1296. XC
  1297. X      COMMON /STAR/ MBASE,STRBIT
  1298. X
  1299. X      INCLUDE 'OBJECTS.LIB'
  1300. X      INCLUDE 'OFLAGS.LIB'
  1301. XC
  1302. XC FUNCTIONS AND DATA
  1303. XC
  1304. X      NOTRAN(O)=(and(OFLAG1(O),TRANBT).EQ.0).AND.
  1305. X     &          (and(OFLAG2(O),OPENBT).EQ.0)
  1306. X      NOVIS(O)=(and(OFLAG1(O),VISIBT).EQ.0)
  1307. XC
  1308. X      SCHLST=0
  1309. XC                                               !NO RESULT.
  1310. X      DO 1000 I=1,OLNT
  1311. XC                                               !SEARCH OBJECTS.
  1312. X        IF(NOVIS(I).OR.
  1313. X     &          (((RM.EQ.0).OR.(.NOT.QHERE(I,RM))).AND.
  1314. X     &           ((CN.EQ.0).OR.(OCAN(I).NE.CN)).AND.
  1315. X     &           ((AD.EQ.0).OR.(OADV(I).NE.AD)))) GO TO 1000
  1316. X        IF(.NOT.THISIT(OIDX,AIDX,I,SPCOBJ)) GO TO 200
  1317. X        IF(SCHLST.NE.0) GO TO 2000
  1318. XC                                               !GOT ONE ALREADY?
  1319. X        SCHLST=I
  1320. XC                                               !NO.
  1321. XC
  1322. XC IF OPEN OR TRANSPARENT, SEARCH THE OBJECT ITSELF.
  1323. XC
  1324. X200     IF(NOTRAN(I)) GO TO 1000
  1325. XC
  1326. XC SEARCH IS CONDUCTED IN REVERSE.  ALL OBJECTS ARE CHECKED TO
  1327. XC SEE IF THEY ARE AT SOME LEVEL OF CONTAINMENT INSIDE OBJECT 'I'.
  1328. XC IF THEY ARE AT LEVEL 1, OR IF ALL LINKS IN THE CONTAINMENT
  1329. XC CHAIN ARE OPEN, VISIBLE, AND HAVE SEARCHME SET, THEY CAN QUALIFY
  1330. XC AS A POTENTIAL MATCH.
  1331. XC
  1332. X        DO 500 J=1,OLNT
  1333. XC                                               !SEARCH OBJECTS.
  1334. X          IF(NOVIS(J).OR. (.NOT.THISIT(OIDX,AIDX,J,SPCOBJ)))
  1335. X     &      GO TO 500
  1336. X          X=OCAN(J)
  1337. XC                                               !GET CONTAINER.
  1338. X300       IF(X.EQ.I) GO TO 400
  1339. XC                                               !INSIDE TARGET?
  1340. X          IF(X.EQ.0) GO TO 500
  1341. XC                                               !INSIDE ANYTHING?
  1342. X          IF(NOVIS(X).OR.NOTRAN(X).OR.
  1343. X     &       (and(OFLAG2(X),SCHBT).EQ.0)) GO TO 500
  1344. X          X=OCAN(X)
  1345. XC                                               !GO ANOTHER LEVEL.
  1346. X          GO TO 300
  1347. XC
  1348. X400       IF(SCHLST.NE.0) GO TO 2000
  1349. XC                                               !ALREADY GOT ONE?
  1350. X          SCHLST=J
  1351. XC                                               !NO.
  1352. X500     CONTINUE
  1353. XC
  1354. X1000  CONTINUE
  1355. X      RETURN
  1356. XC
  1357. X2000  SCHLST=-SCHLST
  1358. XC                                               !AMB RETURN.
  1359. X      RETURN
  1360. XC
  1361. X      END
  1362. X`0C
  1363. XC
  1364. XC THISIT--      VALIDATE OBJECT VS DESCRIPTION
  1365. XC
  1366. XC DECLARATIONS
  1367. XC
  1368. X      LOGICAL  FUNCTION  THISIT(OIDX,AIDX,OBJ,SPCOBJ)
  1369. X      IMPLICIT INTEGER(A-Z)
  1370. X      LOGICAL  NOTEST
  1371. X
  1372. X      INCLUDE 'VOCAB.LIB'
  1373. XC
  1374. XC FUNCTIONS AND DATA
  1375. XC
  1376. X      NOTEST(O)=(O.LE.0).OR.(O.GE.R50MIN)
  1377. XC
  1378. XC    THE FOLLOWING DATA STATEMENT USED RADIX-50 NOTATION (R50MIN/1RA/)
  1379. XC       IN RADIX-50 NOTATION, AN 'A' IN THE FIRST POSITION IS
  1380. XC       ENCODED AS 1*40*40 = 1600.
  1381. XC
  1382. X      DATA R50MIN/1600/
  1383. XC
  1384. X      THISIT=.FALSE.
  1385. XC                                               !ASSUME NO MATCH.
  1386. X      IF((SPCOBJ.NE.0).AND.(OBJ.EQ.SPCOBJ)) GO TO 500
  1387. XC
  1388. XC CHECK FOR OBJECT NAMES
  1389. XC
  1390. X      I=OIDX+1
  1391. X100   I=I+1
  1392. X      IF(NOTEST(OVOC(I))) RETURN
  1393. XC                                               !IF DONE, LOSE.
  1394. X      IF(OVOC(I).NE.OBJ) GO TO 100
  1395. XC                                               !IF FAIL, CONT.
  1396. XC
  1397. X      IF(AIDX.EQ.0) GO TO 500
  1398. XC                                               !ANY ADJ?
  1399. X      I=AIDX+1
  1400. X200   I=I+1
  1401. X      IF(NOTEST(AVOC(I))) RETURN
  1402. XC                                               !IF DONE, LOSE.
  1403. X      IF(AVOC(I).NE.OBJ) GO TO 200
  1404. XC                                               !IF FAIL, CONT.
  1405. XC
  1406. X500   THISIT=.TRUE.
  1407. X      RETURN
  1408. X      END
  1409. $ CALL UNPACK [.SRC]NP2.FOR;1 723588376
  1410. $ create 'f'
  1411. XC SYNMCH--      SYNTAX MATCHER
  1412. XC
  1413. XC COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
  1414. XC ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
  1415. XC WRITTEN BY R. M. SUPNIK
  1416. XC
  1417. XC DECLARATIONS
  1418. XC
  1419. XC THIS ROUTINE DETAILS ON BIT 4 OF PRSFLG
  1420. XC
  1421. X      LOGICAL FUNCTION SYNMCH()
  1422. X      IMPLICIT INTEGER(A-Z)
  1423. X      LOGICAL SYNEQL,TAKEIT
  1424. X
  1425. X      INCLUDE 'PARSER.LIB'
  1426. X      INCLUDE 'VOCAB.LIB'
  1427. X      INCLUDE 'DEBUG.LIB'
  1428. XC
  1429. X      DATA R50MIN/1RA/
  1430. XC
  1431. XC
  1432. X      SYNMCH=.FALSE.
  1433. X      DFLAG=and(PRSFLG, 16).NE.0
  1434. X      if(dflag) write(0,*) 'synflags=',sdir,sind,sstd,sflip,sdriv,svmask
  1435. X      J=ACT
  1436. XC                                               !SET UP PTR TO SYNTAX.
  1437. X      DRIVE=0
  1438. +-+-+-+-+-+-+-+-  END  OF PART 26 +-+-+-+-+-+-+-+-
  1439.