home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1994 March / Source_Code_CD-ROM_Walnut_Creek_March_1994.iso / compsrcs / games / vmsnet / funadv / part07 < prev    next >
Internet Message Format  |  1992-03-07  |  48KB
  1. Path: uunet!zaphod.mps.ohio-state.edu!think.com!yale.edu!heifetz!emory!dragon.com!cts
  2. From: cts@dragon.com
  3. Newsgroups: vmsnet.sources.games
  4. Subject: funadv Part 07/08
  5. Message-ID: <1992Mar7.222320.830@dragon.com>
  6. Date: 8 Mar 92 03:23:20 GMT
  7. Organization: Computer Projects Unlimited
  8. Lines: 1588
  9.  
  10. -+-+-+-+-+-+-+-+ START OF PART 7 -+-+-+-+-+-+-+-+
  11. X***LOCK, UNLOCK, NO OBJECT GIVEN.  ASSUME VARIOUS THINGS IF PRESENT.
  12. X `20
  13. X 8040 SPK=28
  14. X      IF(HERE(SACK)) OBJ=SACK`20
  15. X      IF(HERE(CLAM))OBJ=CLAM
  16. X      IF(HERE(OYSTER))OBJ=OYSTER
  17. X      IF(AT(DOOR))OBJ=DOOR
  18. X      IF(AT(GRATE))OBJ=GRATE
  19. X      IF(OBJ.NE.0.AND.HERE(CHAIN))GOTO 8000`20
  20. X      IF(HERE(CHAIN))OBJ=CHAIN
  21. X      IF(OBJ.EQ.0)GOTO 2011`20
  22. X `20
  23. X***LOCK, UNLOCK OBJECT.  SPECIAL STUFF FOR OPENING CLAM/OYSTER AND FOR C
  24. X `20
  25. X 9040 IF(OBJ.EQ.CLAM.OR.OBJ.EQ.OYSTER)GOTO 9046`20
  26. X      IF(OBJ.EQ.SACK) GOTO 9041`20
  27. X      IF(OBJ.EQ.DOOR)SPK=111
  28. X      IF(OBJ.EQ.DOOR.AND.PROP(DOOR).EQ.1)SPK=54`20
  29. X      IF(OBJ.EQ.SACK)SPK=32`20
  30. X      IF(OBJ.EQ.KEYS)SPK=55`20
  31. X      IF(OBJ.EQ.GRATE.OR.OBJ.EQ.CHAIN)SPK=31
  32. X      IF(SPK.NE.31.OR..NOT.HERE(KEYS))GOTO 2011`20
  33. X      IF(OBJ.EQ.CHAIN)GOTO 9048`20
  34. X      IF(.NOT.CLOSNG)GOTO 9043
  35. X      K=130`20
  36. X      IF(.NOT.PANIC)CLOCK2=15`20
  37. X      PANIC=.TRUE.
  38. X      GOTO 2010`20
  39. X `20
  40. X***SACK.
  41. X `20
  42. X 9041 IF(VERB.EQ.LOCK) GOTO 9042
  43. X      OBJ=MONGOOS`20
  44. X      GOTO 9020`20
  45. X 9042 SPK=225`20
  46. X      GOTO 2011`20
  47. X `20
  48. X***GRATE.`20
  49. X `20
  50. X 9043 K=34+PROP(GRATE)
  51. X      PROP(GRATE)=1`20
  52. X      IF(VERB.EQ.LOCK)PROP(GRATE)=0`20
  53. X      K=K+2*PROP(GRATE)`20
  54. X      GOTO 2010`20
  55. X `20
  56. X***CLAM/OYSTER.`20
  57. X `20
  58. X 9046 K=0`20
  59. X      IF(OBJ.EQ.OYSTER)K=1
  60. X      SPK=124+K`20
  61. X      IF(TOTING(OBJ))SPK=120+K
  62. X      IF(.NOT.TOTING(TRIDNT))SPK=122+K
  63. X      IF(VERB.EQ.LOCK)SPK=61
  64. X      IF(SPK.NE.124)GOTO 2011`20
  65. X      CALL MOVE(CLAM,0)`20
  66. X      CALL DROP(OYSTER,LOC)`20
  67. X      CALL DROP(PEARL,PLAC(CLAM)+2)`20
  68. X      GOTO 2011`20
  69. X `20
  70. X***CHAIN.`20
  71. X `20
  72. X 9048 IF(VERB.EQ.LOCK)GOTO 9049`20
  73. X      SPK=171`20
  74. X      IF(PROP(BEAR).EQ.0)SPK=41`20
  75. X      IF(PROP(CHAIN).EQ.0)SPK=37
  76. X      IF(SPK.NE.171)GOTO 2011`20
  77. X      PROP(CHAIN)=0`20
  78. X      FIXED(CHAIN)=0
  79. X      IF(PROP(BEAR).NE.3)PROP(BEAR)=2`20
  80. X      FIXED(BEAR)=2-PROP(BEAR)
  81. X      GOTO 2011`20
  82. X `20
  83. X 9049 SPK=172`20
  84. X      IF(PROP(CHAIN).NE.0)SPK=34
  85. X      IF(LOC.NE.PLAC(CHAIN))SPK=173`20
  86. X      IF(SPK.NE.172)GOTO 2011`20
  87. X      PROP(CHAIN)=2`20
  88. X      IF(TOTING(CHAIN))CALL DROP(CHAIN,LOC)`20
  89. X      FIXED(CHAIN)=-1`20
  90. X      GOTO 2011`20
  91. X `20
  92. X***LIGHT LAMP`20
  93. X `20
  94. X 9070 IF(.NOT.HERE(LAMP))GOTO 2011
  95. X      SPK=184`20
  96. X      IF(LIMIT.LT.0)GOTO 2011`20
  97. X      PROP(LAMP)=1
  98. X      CALL RSPEAK(39)`20
  99. X      IF(WZDARK)GOTO 2000`20
  100. X      GOTO 2012`20
  101. X `20
  102. X***LAMP OFF`20
  103. X `20
  104. X 9080 IF(.NOT.HERE(LAMP))GOTO 2011
  105. X      PROP(LAMP)=0
  106. X      CALL RSPEAK(40)`20
  107. X      IF(DARK(0))CALL RSPEAK(16)
  108. X      GOTO 2012`20
  109. X `20
  110. X***WAVE.  NO EFFECT UNLESS WAVING ROD AT FISSURE.`20
  111. X `20
  112. X 9090 IF((.NOT.TOTING(OBJ)).AND.(OBJ.NE.ROD.OR..NOT.TOTING(ROD2)))
  113. X     $SPK=29
  114. X      IF(OBJ.NE.ROD.OR..NOT.AT(FISSUR).OR..NOT.TOTING(OBJ)) GOTO 9091`20
  115. X      SPK=205`20
  116. X      CALL MOVE(ROD,125)
  117. X      GOTO 2011`20
  118. X 9091 IF(OBJ.NE.ROD.OR..NOT.AT(ROPE).OR..NOT.`20
  119. X     $TOTING(OBJ).OR.CLOSNG) GOTO 2011
  120. X      IF(PROP(ROPE).GT.0) GOTO 9092`20
  121. X      PROP(ROPE)=1
  122. X      CALL PSPEAK(ROPE,PROP(ROPE))
  123. X      GOTO 2011`20
  124. X 9092 PROP(ROPE)=1-PROP(ROPE)`20
  125. X      CALL PSPEAK(ROPE,PROP(ROPE))
  126. X      GOTO 2012`20
  127. X `20
  128. X***ATTACK.  ASSUME TARGET IF UNAMBIGUOUS.  'THROW' ALSO LINKS HERE.  ATT
  129. X*`20
  130. X*  OBJECTS FALL INTO TWO CATEGORIES: ENEMIES (SNAKE, DWARF, ETC.)  AND O
  131. X*  (MONGOOS, CLAM).  AMBIGUOUS IF TWO ENEMIES, OR IF NO ENEMIES BUT TWO OTH`
  132. V20
  133. X `20
  134. X 9120 DO 9121 LOOP=1,7
  135. X      I=LOOP
  136. X      IF(DLOC(LOOP).EQ.LOC.AND.DFLAG.GE.2)GOTO 9122`20
  137. X 9121 CONTINUE
  138. X      I=0`20
  139. X 9122 IF(OBJ.NE.0)GOTO 9124`20
  140. X      IF(I.NE.0)OBJ=DWARF`20
  141. X      IF(HERE(SNAKE))OBJ=OBJ*100+SNAKE
  142. X      IF(AT(DRAGON).AND.PROP(DRAGON).EQ.0)OBJ=OBJ*100+DRAGON
  143. X      IF(AT(TROLL))OBJ=OBJ*100+TROLL
  144. X      IF(HERE(BEAR).AND.PROP(BEAR).EQ.0)OBJ=OBJ*100+BEAR
  145. X      IF(OBJ.GT.100)GOTO 8000`20
  146. X      IF(OBJ.NE.0)GOTO 9124`20
  147. X `20
  148. X***CAN'T ATTACK MONGOOS BY THROWING AXE.
  149. X `20
  150. X      IF(HERE(MONGOOS).AND.VERB.NE.THROW)OBJ=MONGOOS
  151. X `20
  152. X***CLAM AND OYSTER BOTH TREATED AS CLAM FOR INTRANSITIVE CASE; NO HARM D
  153. X `20
  154. X      IF(HERE(CLAM).OR.HERE(OYSTER))OBJ=100*OBJ+CLAM
  155. X      IF(OBJ.GT.100)GOTO 8000`20
  156. X 9124 IF(OBJ.NE.MONGOOS)GOTO 9125`20
  157. X      SPK=137`20
  158. X      IF(CLOSED)GOTO 2011`20
  159. X      CALL MOVE(MONGOOS,0)
  160. X      PROP(MONGOOS)=0`20
  161. X      IF(PLACE(SNAKE).EQ.PLAC(SNAKE))TALLY2=TALLY2+1
  162. X      SPK=45
  163. X 9125 IF(OBJ.EQ.0)SPK=44
  164. X      IF(OBJ.EQ.CLAM.OR.OBJ.EQ.OYSTER)SPK=150`20
  165. X      IF(OBJ.EQ.SNAKE)SPK=46
  166. X      IF(OBJ.EQ.DWARF)SPK=48
  167. X      IF(OBJ.EQ.DWARF.AND.CLOSED)GOTO 19000`20
  168. X      IF(OBJ.EQ.DRAGON)SPK=167
  169. X      IF(OBJ.EQ.TROLL)SPK=157`20
  170. X      IF(OBJ.EQ.BEAR)SPK=165+(PROP(BEAR)+1)/2`20
  171. X      IF(OBJ.NE.DRAGON.OR.PROP(DRAGON).NE.0)GOTO 2011`20
  172. X `20
  173. X***FUN STUFF FOR DRAGON.  IF HE INSISTS ON ATTACKING IT, WIN!  SET PROP`20
  174. X*  MOVE DRAGON TO CENTRAL LOC (STILL FIXED), MOVE RUG THERE (NOT FIXED),
  175. X*  MOVE HIM THERE, TOO.  THEN DO A NULL MOTION TO GET NEW DESCRIPTION.
  176. X `20
  177. X      CALL RSPEAK(49)`20
  178. X      VERB=0
  179. X      OBJ=0`20
  180. X      READ(5,9127) WD1
  181. X 9127 FORMAT(1A5)`20
  182. X      call str$upcase (wd1,wd1)
  183. X      IF(WD1.NE.'Y' .AND.WD1.NE.'YES')GOTO 2608
  184. X      CALL PSPEAK(DRAGON,1)`20
  185. X      PROP(DRAGON)=2
  186. X      PROP(RUG)=0`20
  187. X      K=(PLAC(DRAGON)+FIXD(DRAGON))/2`20
  188. X      CALL MOVE(DRAGON+100,-1)
  189. X      CALL MOVE(RUG+100,0)
  190. X      CALL MOVE(DRAGON,K)`20
  191. X      CALL MOVE(RUG,K)
  192. X*  MOVE OBJECTS TO THE 'NEW' ROOM.
  193. X      DO 9126 LOOP=1,100
  194. X      IF(PLACE(LOOP).EQ.PLAC(DRAGON).OR.PLACE(LOOP).EQ.FIXD(DRAGON))
  195. X     $CALL MOVE(LOOP,K)`20
  196. X 9126 CONTINUE
  197. X      LOC=K`20
  198. X      K=NULL
  199. X      GOTO 3000`20
  200. X `20
  201. X***POUR.  IF NO OBJECT, OR OBJECT IS BOTTLE, ASSUME CONTENTS OF BOTTLE.`20
  202. X*  SPECIAL TESTS FOR POURING WATER OR OIL ON PLANT OR RUSTY DOOR.`20
  203. X `20
  204. X 9130 IF(OBJ.EQ.BOTTLE.OR.OBJ.EQ.0)OBJ=LIQ(0)`20
  205. X      IF(OBJ.EQ.0)GOTO 8000`20
  206. X      IF(.NOT.TOTING(OBJ))GOTO 2011`20
  207. X      SPK=78
  208. X      IF(OBJ.NE.OIL.AND.OBJ.NE.WATER)GOTO 2011
  209. X      PROP(BOTTLE)=1
  210. X      PLACE(OBJ)=0
  211. X      SPK=77
  212. X      IF(.NOT.(AT(PLANT).OR.AT(DOOR)))GOTO 2011`20
  213. X `20
  214. X      IF(AT(DOOR))GOTO 9132`20
  215. X      SPK=112`20
  216. X      IF(OBJ.NE.WATER)GOTO 2011`20
  217. X 9131 CALL PSPEAK(PLANT,PROP(PLANT)+1)
  218. X      PROP(PLANT)=MOD(PROP(PLANT)+2,6)
  219. X      PROP(PLANT2)=PROP(PLANT)/2
  220. X      K=NULL
  221. X      GOTO 3000`20
  222. X `20
  223. X 9132 PROP(DOOR)=0
  224. X      IF(OBJ.EQ.OIL)PROP(DOOR)=1
  225. X      SPK=113+PROP(DOOR)
  226. X      GOTO 2011`20
  227. X `20
  228. X***EAT.  INTRANSITIVE: ASSUME FOOD IF PRESENT, ELSE ASK WHAT.  TRANSITIV
  229. X*  OK, SOME THINGS LOSE APPETITE, REST ARE RIDICULOUS.
  230. X `20
  231. X 8140 IF(.NOT.HERE(FOOD))GOTO 8000
  232. X 8142 CALL MOVE(FOOD,0)`20
  233. X      SPK=72
  234. X      GOTO 2011`20
  235. X `20
  236. X 9140 IF(OBJ.EQ.FOOD)GOTO 8142
  237. X      IF(OBJ.EQ.SHIT) GOTO 9145`20
  238. X      IF(OBJ.EQ.COAL) GOTO 9148`20
  239. X      IF(OBJ.EQ.MONGOOS.OR.OBJ.EQ.SNAKE.OR.OBJ.EQ.CLAM.OR.OBJ.EQ.OYSTER`20
  240. X     $.OR.OBJ.EQ.DWARF.OR.OBJ.EQ.DRAGON.OR.OBJ.EQ.TROLL`20
  241. X     $.OR.OBJ.EQ.BEAR)SPK=71
  242. X      GOTO 2011`20
  243. X `20
  244. X 9145 IF(PROP(SHIT).EQ.0) GOTO 9146`20
  245. X      PROP(SHIT)=0
  246. X      SPK=225`20
  247. X      GOTO 2011`20
  248. X 9146 PROP(SHIT)=1
  249. X      SPK=226`20
  250. X      GOTO 2011`20
  251. X `20
  252. X 9148 CALL MOVE(COAL,0)`20
  253. X      SPK=227`20
  254. X      GOTO 2011`20
  255. X `20
  256. X***DRINK.  IF NO OBJECT, ASSUME WATER AND LOOK FOR IT HERE.  IF WATER IS
  257. X*  THE BOTTLE, DRINK THAT, ELSE MUST BE AT A WATER LOC, SO DRINK STREAM.
  258. X `20
  259. X 9150 IF(OBJ.EQ.0.AND.LIQLOC(LOC).NE.WATER.AND.(LIQ(0).NE.WATER`20
  260. X     $.OR..NOT.HERE(BOTTLE)))GOTO 8000
  261. X      IF(OBJ.EQ.OIL) GOTO 9155
  262. X      IF(BFULL) SPK=209`20
  263. X      IF(BFULL) GOTO 2011`20
  264. X      IF(.NOT.HERE(FOUNTN)) GOTO 9155`20
  265. X      IF(OBJ.EQ.POTION) GOTO 9151`20
  266. X      BFULL=.TRUE.
  267. X      HLDMAX=7
  268. X      SPK=206`20
  269. X      IF(PCT(50)) GOTO 2011`20
  270. X 9151 HLDMAX=14`20
  271. X      SPK=207`20
  272. X      IF(PCT(40).OR.WIZKID) GOTO 2011`20
  273. X      DO 9152 LOOP=1,100
  274. X 9152 IF(TOTING(LOOP)) CALL DROP(LOOP,LOC)
  275. X      HLDMAX=4
  276. X      SPK=208`20
  277. X      IF(PCT(95)) GOTO 2011`20
  278. X      GOTO 2011`20
  279. X `20
  280. X***OOPS... HE DRANK THE POTION OF INSTANT DEATH.
  281. X
  282. X!  WARNING  - Following is dead code.
  283. X `20
  284. X 9154 CALL RSPEAK(215)
  285. X      GOTO 99`20
  286. X 9155 IF(OBJ.EQ.OIL)SPK=110`20
  287. X      IF(OBJ.EQ.OIL) GOTO 2011
  288. X      IF(.NOT.(HERE(BOTTLE)).OR.PROP(BOTTLE).NE.0) GOTO 9157
  289. X      PROP(BOTTLE)=1
  290. X      SPK=74
  291. X 9157 BFULL=.TRUE.
  292. X      WAITNG=TURNS+25`20
  293. X      OOPS=WAITNG+3`20
  294. X      PLACE(WATER)=0
  295. X      GOTO 2011`20
  296. X `20
  297. X***RUB.  YIELDS VARIOUS SNIDE REMARKS.
  298. X `20
  299. X 9160 IF(OBJ.NE.LAMP)SPK=76`20
  300. X      GOTO 2011`20
  301. X `20
  302. X***THROW.  SAME AS DISCARD UNLESS AXE.  THEN SAME AS ATTACK EXCEPT IGNOR
  303. X*  AND IF DWARF IS PRESENT THEN ONE MIGHT BE KILLED.  (ONLY WAY TO DO SO
  304. X*  AXE ALSO SPECIAL FOR DRAGON, BEAR, AND TROLL.  TREASURES SPECIAL FOR`20
  305. X `20
  306. X 9170 IF(TOTING(ROD2).AND.OBJ.EQ.ROD.AND..NOT.TOTING(ROD))OBJ=ROD2
  307. X      IF(.NOT.TOTING(OBJ))GOTO 2011`20
  308. X      IF(OBJ.GE.TRSURE.AND.OBJ.LE.MAXTRS.AND.AT(TROLL))GOTO 9178
  309. X      IF(OBJ.EQ.FOOD.AND.HERE(BEAR))GOTO 9177`20
  310. X      IF(OBJ.NE.AXE)GOTO 9020`20
  311. X      DO 9171 LOOP=1,7
  312. X `20
  313. X*  NEEDN'T CHECK DFLAG IF AXE IS HERE.
  314. X `20
  315. X      IF(DLOC(LOOP).EQ.LOC)GOTO 9172
  316. X 9171 CONTINUE
  317. X      SPK=152`20
  318. X      IF(AT(DRAGON).AND.PROP(DRAGON).EQ.0)GOTO 9175`20
  319. X      SPK=158`20
  320. X      IF(AT(TROLL))GOTO 9175
  321. X      IF(HERE(BEAR).AND.PROP(BEAR).EQ.0)GOTO 9176`20
  322. X      OBJ=0`20
  323. X      GOTO 9120`20
  324. X `20
  325. X 9172 SPK=48
  326. X `20
  327. X*  IF SAVED NOT = -1, HE BYPASSED THE 'START' CALL.`20
  328. X `20
  329. X      IF(random(2).EQ.0.OR.SAVED.NE.-1)GOTO 9175`20
  330. X      DSEEN(I)=.FALSE.
  331. X      DLOC(I)=0`20
  332. X      SPK=47
  333. X      DKILL=DKILL+1`20
  334. X      IF(DKILL.EQ.1)SPK=149`20
  335. X 9175 CALL RSPEAK(SPK)
  336. X      CALL DROP(AXE,LOC)
  337. X      K=NULL
  338. X      GOTO 3000`20
  339. X `20
  340. X*  THIS'LL TEACH HIM TO THROW THE AXE AT THE BEAR!
  341. X `20
  342. X 9176 SPK=164`20
  343. X      CALL DROP(AXE,LOC)
  344. X      FIXED(AXE)=-1`20
  345. X      PROP(AXE)=1`20
  346. X      CALL JUGGLE(BEAR)`20
  347. X      GOTO 2011`20
  348. X `20
  349. X*  BUT THROWING FOOD IS ANOTHER STORY.
  350. X `20
  351. X 9177 OBJ=BEAR
  352. X      GOTO 9210`20
  353. X `20
  354. X 9178 SPK=159`20
  355. X `20
  356. X*  SNARF A TREASURE FOR THE TROLL.
  357. X `20
  358. X      CALL DROP(OBJ,0)
  359. X      CALL MOVE(TROLL,0)
  360. X      CALL MOVE(TROLL+100,0)
  361. X      CALL DROP(TROLL2,PLAC(TROLL))`20
  362. X      CALL DROP(TROLL2+100,FIXD(TROLL))`20
  363. X      CALL JUGGLE(CHASM)
  364. X      GOTO 2011`20
  365. X `20
  366. X***QUIT.  INTRANSITIVE ONLY.  VERIFY INTENT AND EXIT IF THAT'S WHAT HE W
  367. X `20
  368. X 8180 GAVEUP=YES(22,54,54,WCOUNT)`20
  369. X 8185 IF(GAVEUP)GOTO 20000
  370. X      GOTO 2012`20
  371. X `20
  372. X***FIND.  MIGHT BE CARRYING IT, OR IT MIGHT BE HERE.  ELSE GIVE CAVEAT.`20
  373. X `20
  374. X 9190 IF(AT(OBJ).OR.(LIQ(0).EQ.OBJ.AND.AT(BOTTLE))
  375. X     $.OR.K.EQ.LIQLOC(LOC))SPK=94`20
  376. X      IF(WIZKID.AND.OBJ.EQ.DWARF) GOTO 9195`20
  377. X      DO 9192 LOOP=1,7
  378. X 9192 IF(DLOC(LOOP).EQ.LOC.AND.DFLAG.GE.2.AND.OBJ.EQ.DWARF)SPK=94`20
  379. X      IF(CLOSED)SPK=138`20
  380. X      IF(TOTING(OBJ))SPK=24`20
  381. X      GOTO 2011`20
  382. X `20
  383. X 9195 WRITE(6,9197) (DLOC(LOOP), LOOP=1,8)
  384. X 9197 FORMAT(' DWARF   1   2   3   4   5   6   7   PIRATE',/,`20
  385. X     $' ROOM ',7I4,I7)
  386. X      GOTO 2012`20
  387. X `20
  388. X***INVENTORY.  IF OBJECT, TREAT SAME AS FIND.  ELSE REPORT ON CURRENT BU
  389. X `20
  390. X 8200 SPK=98
  391. X      DO 8201 LOOP=1,100
  392. X      IF(LOOP.EQ.BEAR.OR..NOT.TOTING(LOOP))GOTO 8201
  393. X      IF(SPK.EQ.98)CALL RSPEAK(99)
  394. X      TEM=-1
  395. X      IF((LOOP.EQ.RING.AND.WEARING(1)).OR.(LOOP.EQ.MAIL.AND.WEARING(2)))
  396. X     $TEM=1`20
  397. X      CALL PSPEAK(LOOP,TEM)`20
  398. X      SPK=0`20
  399. X 8201 CONTINUE
  400. X      IF(TOTING(BEAR))SPK=141`20
  401. X      GOTO 2011`20
  402. X `20
  403. X***FEED.  IF MONGOOS, NOT HUNGRY.  SNAKE, DRAGON, TROLL: QUIP.  IF DWARF, MA
  404. VKE
  405. X*  MAD.  BEAR, SPECIAL.`20
  406. X `20
  407. X 9210 IF(OBJ.NE.MONGOOS)GOTO 9212`20
  408. X      SPK=100`20
  409. X      GOTO 2011`20
  410. X `20
  411. X 9212 IF(OBJ.NE.SNAKE.AND.OBJ.NE.DRAGON.AND.OBJ.NE.TROLL)GOTO 9213
  412. X      SPK=102`20
  413. X      IF(OBJ.EQ.DRAGON.AND.PROP(DRAGON).NE.0)SPK=110
  414. X      IF(OBJ.EQ.TROLL)SPK=182`20
  415. X      IF(OBJ.NE.SNAKE.OR.CLOSED.OR..NOT.HERE(MONGOOS))GOTO 2011`20
  416. X      SPK=101`20
  417. X      CALL MOVE(MONGOOS,0)
  418. X      PROP(MONGOOS)=0`20
  419. X      TALLY2=TALLY2+1`20
  420. X      GOTO 2011`20
  421. X `20
  422. X 9213 IF(OBJ.NE.DWARF)GOTO 9214`20
  423. X      IF(.NOT.HERE(COAL)) GOTO 8213`20
  424. X      ONCE=.FALSE.
  425. X      DO 8212 LOOP=1,7
  426. X      IF(DLOC(LOOP).NE.LOC.OR.ONCE) GOTO 8212`20
  427. X      ONCE=.TRUE.`20
  428. X      CALL MOVE(COAL,0)`20
  429. X      DLOC(LOOP)=0
  430. X 8212 CONTINUE
  431. X      SPK=117`20
  432. X      IF(ONCE) SPK=116
  433. X      GOTO 2011`20
  434. X 8213 IF(.NOT.HERE(FOOD))GOTO 2011
  435. X      SPK=103`20
  436. X      DFLAG=DFLAG+1`20
  437. X      GOTO 2011`20
  438. X `20
  439. X 9214 IF(OBJ.NE.BEAR)GOTO 9215
  440. X      IF(PROP(BEAR).EQ.0)SPK=102
  441. X      IF(PROP(BEAR).EQ.3)SPK=110
  442. X      IF(.NOT.HERE(FOOD))GOTO 2011
  443. X      CALL MOVE(FOOD,0)`20
  444. X      PROP(BEAR)=1
  445. X      FIXED(AXE)=0
  446. X      PROP(AXE)=0`20
  447. X      SPK=168`20
  448. X      GOTO 2011`20
  449. X `20
  450. X 9215 SPK=14
  451. X      GOTO 2011`20
  452. X `20
  453. X***FILL.  BOTTLE MUST BE EMPTY, AND SOME LIQUID AVAILABLE.  (VASE IS NAS
  454. X `20
  455. X 9220 IF(OBJ.EQ.VASE)GOTO 9222
  456. X      IF(OBJ.NE.0.AND.OBJ.NE.BOTTLE)GOTO 2011`20
  457. X      IF(OBJ.EQ.0.AND..NOT.HERE(BOTTLE))GOTO 8000`20
  458. X      SPK=107`20
  459. X      IF(LIQLOC(LOC).EQ.0)SPK=106`20
  460. X      IF(LIQ(0).NE.0)SPK=105
  461. X      IF(SPK.NE.107)GOTO 2011`20
  462. X      PROP(BOTTLE)=MOD(COND(LOC),4)/2*2`20
  463. X      K=LIQ(0)
  464. X      IF(TOTING(BOTTLE))PLACE(K)=-1`20
  465. X      IF(K.EQ.OIL)SPK=108`20
  466. X      GOTO 2011`20
  467. X `20
  468. X 9222 SPK=29
  469. X      IF(LIQLOC(LOC).EQ.0)SPK=144`20
  470. X      IF(LIQLOC(LOC).EQ.0.OR..NOT.TOTING(VASE))GOTO 2011
  471. X      CALL RSPEAK(145)
  472. X      PROP(VASE)=2
  473. X      FIXED(VASE)=-1
  474. X      GOTO 9024`20
  475. X `20
  476. X***BLAST.  NO EFFECT UNLESS YOU'VE GOT DYNAMITE, WHICH IS A NEAT TRICK!`20
  477. X `20
  478. X 9230 IF(PROP(ROD2).LT.0.OR..NOT.CLOSED)GOTO 2011`20
  479. X      BONUS=133`20
  480. X      IF(LOC.EQ.115)BONUS=134`20
  481. X      IF(HERE(ROD2))BONUS=135`20
  482. X      CALL RSPEAK(BONUS)
  483. X      GOTO 20000
  484. X `20
  485. X***SCORE.  GO TO SCORING SECTION, WHICH WILL RETURN TO 8241 IF SCORNG IS
  486. X `20
  487. X 8240 SCORNG=.TRUE.`20
  488. X      GOTO 20000
  489. X `20
  490. X 8241 SCORNG=.FALSE.
  491. X      WRITE(6,8243)SCORE,MXSCOR`20
  492. X 8243 FORMAT(/,' If you were to quit now, you would score',I4`20
  493. X     $,' out of a possible',I4,'.')`20
  494. X*     GAVEUP=YES(143,54,54,WCOUNT)
  495. X      GOTO 8185`20
  496. X `20
  497. X***FEE FIE FOE FOO (AND FUM).  ADVANCE TO NEXT STATE IF GIVEN IN PROPER`20
  498. X*  LOOK UP WD1 IN SECTION 3 OF VOCAB TO DETERMINE WHICH WORD WE'VE GOT.`20
  499. X*  WORD ZIPS THE EGGS BACK TO THE GIANT ROOM (UNLESS ALREADY THERE).
  500. X `20
  501. X 8250 K=VOCAB(WD1,3)
  502. X      SPK=42
  503. X      IF(FOOBAR.EQ.1-K)GOTO 8252
  504. X      IF(FOOBAR.NE.0)SPK=151
  505. X      GOTO 2011`20
  506. X `20
  507. X 8252 FOOBAR=K
  508. X      IF(K.NE.4)GOTO 2009`20
  509. X      FOOBAR=0
  510. X      IF(PLACE(EGGS).EQ.PLAC(EGGS)
  511. X     $.OR.(TOTING(EGGS).AND.LOC.EQ.PLAC(EGGS)))GOTO 2011
  512. X `20
  513. X***BRING BACK TROLL IF WE STEAL THE EGGS BACK FROM HIM BEFORE CROSSING.`20
  514. X `20
  515. X      IF(PLACE(EGGS).EQ.0.AND.PLACE(TROLL).EQ.0.AND.PROP(TROLL).EQ.0)`20
  516. X     $PROP(TROLL)=1`20
  517. X      K=2`20
  518. X      IF(HERE(EGGS))K=1`20
  519. X      IF(LOC.EQ.PLAC(EGGS))K=0
  520. X      CALL MOVE(EGGS,PLAC(EGGS))
  521. X      CALL PSPEAK(EGGS,K)`20
  522. X      GOTO 2012`20
  523. X `20
  524. X***BRIEF.  INTRANSITIVE ONLY.  SUPPRESS LONG DESCRIPTIONS AFTER FIRST TI
  525. X `20
  526. X 8260 SPK=156`20
  527. X      ABBNUM=10000
  528. X      DETAIL=3
  529. X      GOTO 2011`20
  530. X `20
  531. X***READ.  MAGAZINES IN DWARVISH, MESSAGE WE'VE SEEN, AND . . . OYSTER?
  532. X `20
  533. X 8270 IF(HERE(MAGZIN)) OBJ=MAGZIN`20
  534. X      IF(HERE(TABLET)) OBJ=OBJ*100+TABLET`20
  535. X      IF(HERE(MESSAG)) OBJ=OBJ*100+MESSAG`20
  536. X      IF(HERE(RUNES)) OBJ=RUNES`20
  537. X      IF(HERE(BOOK)) OBJ=BOOK`20
  538. X      IF(HERE(LISTING)) OBJ=LISTING`20
  539. X      IF(CLOSED.AND.TOTING(OYSTER)) OBJ=OYSTER
  540. X      IF(OBJ.GT.100.OR.OBJ.EQ.0.OR.DARK(0))GOTO 8000
  541. X `20
  542. X 9270 IF(DARK(0))GOTO 5190
  543. X      IF(OBJ.EQ.BOOK) SPK=231`20
  544. X      IF(OBJ.EQ.LISTING) SPK=230
  545. X      IF(OBJ.EQ.MAGZIN) SPK=190`20
  546. X      IF(OBJ.EQ.TABLET) SPK=196`20
  547. X      IF(OBJ.EQ.MESSAG) SPK=191`20
  548. X      IF(OBJ.EQ.RUNES) SPK=43`20
  549. X      IF(OBJ.EQ.OYSTER.AND.HINTED(2).AND.TOTING(OYSTER)) SPK=194
  550. X      IF(OBJ.NE.OYSTER.OR.HINTED(2).OR..NOT.TOTING(OYSTER)
  551. X     $.OR..NOT.CLOSED)GOTO 2011`20
  552. X      HINTED(2)=YES(192,193,54,WCOUNT)
  553. X      GOTO 2012`20
  554. X `20
  555. X***BREAK.  ONLY WORKS FOR MIRROR IN REPOSITORY AND, OF COURSE, THE VASE.
  556. X `20
  557. X 9280 IF(OBJ.EQ.MIRROR)SPK=148
  558. X      IF(OBJ.EQ.VASE.AND.PROP(VASE).EQ.0)GOTO 9282
  559. X      IF(OBJ.NE.MIRROR.OR..NOT.CLOSED)GOTO 2011`20
  560. X      CALL RSPEAK(197)
  561. X      GOTO 19000
  562. X `20
  563. X 9282 SPK=198`20
  564. X      IF(TOTING(VASE))CALL DROP(VASE,LOC)`20
  565. X      PROP(VASE)=2
  566. X      FIXED(VASE)=-1
  567. X      GOTO 2011`20
  568. X `20
  569. X***WAKE.  ONLY USE IS TO DISTURB THE DWARVES.`20
  570. X `20
  571. X 9290 IF(OBJ.NE.DWARF.OR..NOT.CLOSED)GOTO 2011
  572. X      CALL RSPEAK(199)
  573. X      GOTO 19000
  574. X `20
  575. X***SUSPEND.`20
  576. X `20
  577. X8300  WRITE (6,8302)
  578. X8302  FORMAT(//,' Saving game...',//)
  579. X      call svcomn (.FALSE.,' ')
  580. X!!!!! STOP
  581. X      call sys$exit(%val(1))
  582. X
  583. X***WEAR. ONLY WORKS FOR RING AND MAIL...   AND FOOD!
  584. X `20
  585. X 9310 IF(OBJ.NE.RING.AND.OBJ.NE.MAIL) GOTO 9315`20
  586. X      IF(OBJ.EQ.RING) GOTO 9314`20
  587. X      IF(OBJ.EQ.MAIL.AND.WEARING(2)) GOTO 9312
  588. X      WEARING(2)=.TRUE.`20
  589. X      CALL CARRY(OBJ,LOC)`20
  590. X      PROP(MAIL)=1
  591. X      CALL PSPEAK(MAIL,PROP(MAIL))
  592. X      GOTO 2012`20
  593. X 9312 WRITE(6,9313)`20
  594. X 9313 FORMAT(' You are already wearing it!')
  595. X      GOTO 2012`20
  596. X 9314 IF(WEARING(1)) GOTO 9312
  597. X      WEARING(1)=.TRUE.`20
  598. X      CALL CARRY(OBJ,LOC)`20
  599. X      PROP(RING)=1
  600. X      CALL PSPEAK(RING,PROP(RING))
  601. X      GOTO 2012`20
  602. X 9315 IF(OBJ.EQ.FOOD) GOTO 9318`20
  603. X      WRITE(6,9316)`20
  604. X 9316 FORMAT(' You can''t wear that!')`20
  605. X      GOTO 2012`20
  606. X 9318 WRITE(6,9319)`20
  607. X 9319 FORMAT(' Ugh-- What a mess!')`20
  608. X      CALL MOVE(FOOD,0)`20
  609. X      GOTO 2012`20
  610. X 8310 WRITE(6,8318)`20
  611. X 8318 FORMAT(/' What are you trying to wear?')
  612. X      GOTO 2600`20
  613. X `20
  614. X***PISS.  AHHHH.... ... .. . . RELIEF.
  615. X `20
  616. X***HE CANNOT PISS AN OBJECT, OR HAVE AN OBJECT PISS.
  617. X `20
  618. X 9320 SPK=223`20
  619. X      GOTO 2011`20
  620. X `20
  621. X 8320 IF(BFULL) GOTO 8325`20
  622. X      SPK=222`20
  623. X      GOTO 2011`20
  624. X `20
  625. X 8325 BFULL=.FALSE.`20
  626. X      WAITNG=9999999
  627. X      OOPS=  9999999
  628. X      CALL RSPEAK(210)
  629. X      IF(HERE(PLANT).OR.HERE(PLANT2)) GOTO 9131`20
  630. X      GOTO 2012`20
  631. X `20
  632. X***SWIM.  HE CAN ONLY SWIM IN THE RIVER, IF HE CAN FIND IT!`20
  633. X `20
  634. X 9330 IF(OBJ.EQ.FOUNTN.OR.OBJ.EQ.WATER) GOTO 8330`20
  635. X      GOTO 2011`20
  636. X 8330 IF(LIQLOC(LOC).NE.WATER) GOTO 2011
  637. X      IF ( .NOT. TOTING(NUGGET) ) GOTO 9331`20
  638. X      CALL RSPEAK (228)`20
  639. X      GOTO 99`20
  640. X 9331 CONTINUE
  641. X      TEM=LOC-PLAC(BOAT)+2
  642. X      IF(TEM.LT.1.OR.TEM.GT.3) GOTO 8332
  643. X      NEWLOC=LOC+1
  644. X 8331 OLDLOC=LOC
  645. X      OLDLC2=OLDLOC`20
  646. X      CALL RSPEAK(227)
  647. X      GOTO 2
  648. X 8332 IF(TEM.NE.5) GOTO 8334
  649. X      NEWLOC=PLAC(RUNES)
  650. X      GOTO 8331`20
  651. X 8334 IF(LOC.NE.PLAC(RUNES)) GOTO 8336
  652. X      NEWLOC=RINGLOC
  653. X      GOTO 8331`20
  654. X 8336 IF(LOC.NE.RINGLOC) GOTO 8338
  655. X***   SPK=YOU ARE NOW WET...
  656. X      SPK=70
  657. X      IF(PLACE(RING).NE.0) GOTO 2011
  658. X***   SPK=YOU HAVE JUMPED INTO...   (AND FOUND THE RING!)`20
  659. X      CALL MOVE(RING,RINGLOC)`20
  660. X      SPK=219`20
  661. X      GOTO 2011`20
  662. X 8338 CONTINUE
  663. X***   SPK=YOU NOW ARE WET...
  664. X      SPK=70
  665. X      GOTO 2011`20
  666. X
  667. X*     Restore.
  668. X
  669. X 8400 WRITE (6,8402)
  670. X 8402 FORMAT(//,' Restoring game...',//)
  671. X      call ldcomn (.FALSE.,FLNAME)
  672. X      goto 2606 `20
  673. X
  674. X
  675. X***                      *******************
  676. X*                        ***** OBJECTS *****
  677. X*                        *******************
  678. X*  ANALYSE AN OBJECT WORD.  SEE IF THE THING IS HERE, WHETHER WE'VE GOT`20
  679. X*  YET, AND SO ON.  OBJECT MUST BE HERE UNLESS VERB IS 'FIND' OR 'INVENT
  680. X*  (AND NO NEW VERB YET TO BE ANALYSED).  WATER AND OIL ARE ALSO FUNNY,`20
  681. X*  THEY ARE NEVER ACTUALLY DROPPED AT ANY LOCATION, BUT MIGHT BE HERE IN
  682. X*  THE BOTTLE OR AS A FEATURE OF THE LOCATION.
  683. X `20
  684. X 5000 OBJ=K`20
  685. X      IF(WIZKID) GOTO 5010
  686. X      IF(FIXED(OBJ).NE.LOC.AND..NOT.HERE(OBJ))GOTO 5100`20
  687. X      IF(DARK(0)) GOTO 5100`20
  688. X 5010 IF(WD2.NE.' ')GOTO 2800`20
  689. X      IF(OBJ.EQ.SWITCH) GOTO 5150`20
  690. X      IF(VERB.NE.0)GOTO 4090
  691. X      WRITE(6,5015) WD1
  692. X 5015 FORMAT(/,' What do you want to do with the ',A10,'?')
  693. X      GOTO 2600`20
  694. X `20
  695. X 5100 IF(OBJ.NE.GRATE)GOTO 5110`20
  696. X      IF(LOC.EQ.1.OR.LOC.EQ.4.OR.LOC.EQ.7)OBJ=DPRSSN
  697. X      IF(LOC.GT.9.AND.LOC.LT.15)K=ENTRNC
  698. X      IF(OBJ.NE.GRATE)GOTO 3000`20
  699. X 5110 IF(OBJ.NE.DWARF)GOTO 5120`20
  700. X      DO 5112 LOOP=1,7
  701. X      IF(DLOC(LOOP).EQ.LOC.AND.DFLAG.GE.2)GOTO 5010`20
  702. X 5112 CONTINUE
  703. X 5120 IF((LIQ(0).EQ.OBJ.AND.HERE(BOTTLE)).OR.OBJ.EQ.LIQLOC(LOC))
  704. X     $GOTO 5010`20
  705. X      IF(OBJ.NE.PLANT.OR..NOT.AT(PLANT2).OR.PROP(PLANT2).EQ.0)GOTO 5130`20
  706. X      OBJ=PLANT2
  707. X      GOTO 5010`20
  708. X 5130 IF(OBJ.NE.KNIFE.OR.KNFLOC.NE.LOC)GOTO 5140
  709. X      KNFLOC=-1`20
  710. X      SPK=116`20
  711. X      GOTO 2011`20
  712. X 5140 IF(OBJ.NE.ROD.OR..NOT.HERE(ROD2))GOTO 5190
  713. X      OBJ=ROD2
  714. X      GOTO 5010`20
  715. X `20
  716. X***FLIP SWITCH. THIS WILL LIGHT UP THE WHOLE CAVE AND UP THE MOVE LIMIT`20
  717. X*  TO 600..... OR IT WILL KILL YOU.`20
  718. X `20
  719. X 5150 IF(LIT.AND.VERB.NE.ON) GOTO 5152
  720. X      IF(VERB.EQ.OFF) GOTO 5152`20
  721. X      IF(WIZKID) GOTO 5151
  722. X      IF(HERE(SWITCH).AND.WEARING(1)) GOTO 5151`20
  723. X      CALL RSPEAK(211)
  724. X `20
  725. X***OH-OH! HE DIED.
  726. X `20
  727. X      GOTO 99`20
  728. X 5151 LIT=.TRUE.
  729. X      LIMIT=600`20
  730. X      CALL RSPEAK(212)
  731. X      GOTO 2
  732. X 5152 LIT=.FALSE.`20
  733. X      SPK=213`20
  734. X      GOTO 2011`20
  735. X `20
  736. X 5190 IF((VERB.EQ.FIND.OR.VERB.EQ.INVENT).AND.WD2.EQ.' ')GOTO 5010
  737. X      IF(WIZKID.AND.PLAC(OBJ).NE.0.AND.PLACE(OBJ).EQ.0) GOTO 5010`20
  738. X      WRITE(6,5199) WD1`20
  739. X 5199 FORMAT(/,' I see no ',A10,' here.')`20
  740. X      GOTO 2012`20
  741. X `20
  742. X***                      *******************
  743. X*                        ****** HINTS ******
  744. X*                        *******************
  745. X*`20
  746. X*  COME HERE IF HE'S BEEN LONG ENOUGH AT REQUIRED LOC(S) FOR SOME UNUSED
  747. X*  HINT NUMBER IS IN VARIABLE 'HINT'.  BRANCH TO QUICK TEST FOR ADDITION
  748. X*  CONDITIONS, THEN COME BACK TO DO NEAT STUFF.  GOTO 40010 IF CONDITION
  749. X*  MET AND WE WANT TO OFFER THE HINT.  GOTO 40020 TO CLEAR HINTLC BACK T
  750. X*  40030 TO TAKE NO ACTION YET.`20
  751. X `20
  752. X40000 HINTM3=HINT-3`20
  753. X      GOTO (40400,40500,40600,40700,40800,40900),HINTM3`20
  754. X*           CAVE  MONGOOS  SNAKE MAZE  DARK  WITT`20
  755. X      CALL BUG(27)
  756. X `20
  757. X40010 HINTLC(HINT)=0
  758. X      IF(.NOT.YES(HINTS(HINT,3),0,54,WCOUNT))GOTO 2602
  759. X      WRITE(6,40012)HINTS(HINT,2)`20
  760. X40012 FORMAT(/,' I am prepared to give you a hint, but it will cost you'
  761. X     $,I2,' points.')`20
  762. X      HINTED(HINT)=YES(175,HINTS(HINT,4),54,WCOUNT)`20
  763. X      IF(HINTED(HINT).AND.LIMIT.GT.30)LIMIT=LIMIT+30*HINTS(HINT,2)
  764. X40020 HINTLC(HINT)=0
  765. X40030 GOTO 2602`20
  766. X `20
  767. X***NOW FOR THE QUICK TESTS.  SEE DATABASE DESCRIPTION FOR ONE-LINE NOTES
  768. X `20
  769. X40400 IF(PROP(GRATE).EQ.0.AND..NOT.HERE(KEYS))GOTO 40010
  770. X      GOTO 40020
  771. X `20
  772. X40500 IF(LOOSE.AND.OBJ.EQ.MONGOOS)GOTO 40010
  773. X      GOTO 40030
  774. X `20
  775. X40600 IF(HERE(SNAKE).AND..NOT.HERE(MONGOOS))GOTO 40010
  776. X      GOTO 40020
  777. X `20
  778. X40700 IF(ATLOC(LOC).EQ.0.AND.ATLOC(OLDLOC).EQ.0`20
  779. X     $.AND.ATLOC(OLDLC2).EQ.0.AND.HOLDNG.GT.1)GOTO 40010
  780. X      GOTO 40020
  781. X `20
  782. X40800 IF(PROP(EMRALD).NE.-1.AND.PROP(PYRAM).EQ.-1)GOTO 40010
  783. X      GOTO 40020
  784. X `20
  785. X40900 GOTO 40010
  786. X***`20
  787. X*  CAVE CLOSING AND SCORING`20
  788. X `20
  789. X `20
  790. X***THESE SECTIONS HANDLE THE CLOSING OF THE CAVE.  THE CAVE CLOSES 'CLOC
  791. X*  TURNS AFTER THE LAST TREASURE HAS BEEN LOCATED (INCLUDING THE PIRATE'
  792. X*  CHEST, WHICH MAY OF COURSE NEVER SHOW UP).  NOTE THAT THE TREASURES N
  793. X*  HAVE BEEN TAKEN YET, JUST LOCATED.  HENCE CLOCK1 MUST BE LARGE ENOUGH
  794. X*  OUT OF THE CAVE (IT ONLY TICKS WHILE INSIDE THE CAVE).  WHEN IT HITS`20
  795. X*  WE BRANCH TO 10000 TO START CLOSING THE CAVE, AND THEN SIT BACK AND W
  796. X*  HIM TO TRY TO GET OUT.  IF HE DOESN'T WITHIN CLOCK2 TURNS, WE CLOSE T
  797. X*  CAVE; IF HE DOES TRY, WE ASSUME HE PANICS, AND GIVE HIM A FEW ADDITIO
  798. X*  TURNS TO GET FRANTIC BEFORE WE CLOSE.  WHEN CLOCK2 HITS ZERO, WE BRAN
  799. X*  11000 TO TRANSPORT HIM INTO THE FINAL PUZZLE.  NOTE THAT THE PUZZLE D
  800. X*  UPON ALL SORTS OF RANDOM THINGS.  FOR INSTANCE, THERE MUST BE NO WATE
  801. X*  OIL, SINCE THERE ARE BEANSTALKS WHICH WE DON'T WANT TO BE ABLE TO WAT
  802. X*  SINCE THE CODE CAN'T HANDLE IT.  ALSO, WE CAN HAVE NO KEYS, SINCE THE
  803. X*  GRATE (HAVING MOVED THE FIXED OBJECT!) THERE SEPARATING HIM FROM ALL`20
  804. X*  TREASURES.  MOST OF THESE PROBLEMS ARISE FROM THE USE OF NEGATIVE PRO
  805. X*  NUMBERS TO SUPPRESS THE OBJECT DESCRIPTIONS UNTIL HE'S ACTUALLY MOVED
  806. X*  OBJECTS.`20
  807. X `20
  808. X*  WHEN THE FIRST WARNING COMES, WE LOCK THE GRATE, DESTROY THE BRIDGE,`20
  809. X*  ALL THE DWARVES (AND THE PIRATE), REMOVE THE TROLL AND BEAR (UNLESS D
  810. X*  AND SET 'CLOSNG' TO TRUE.  LEAVE THE DRAGON; TOO MUCH TROUBLE TO MOVE
  811. X*  FROM NOW UNTIL CLOCK2 RUNS OUT, HE CANNOT UNLOCK THE GRATE, MOVE TO A
  812. X*  LOCATION OUTSIDE THE CAVE (LOC<9), OR CREATE THE BRIDGE.  NOR CAN HE`20
  813. X*  RESURRECTED IF HE DIES.  NOTE THAT THE SNAKE IS ALREADY GONE, SINCE H
  814. X*  TO THE TREASURE ACCESSIBLE ONLY VIA THE HALL OF THE MT. KING.  ALSO,`20
  815. X*  BEEN IN GIANT ROOM (TO GET EGGS), SO WE CAN REFER TO IT.  ALSO ALSO,`20
  816. X*  GOTTEN THE PEARL, SO WE KNOW THE BIVALVE IS AN OYSTER.  *AND*, THE DW
  817. X*  MUST HAVE BEEN ACTIVATED, SINCE WE'VE FOUND CHEST.`20
  818. X `20
  819. X10000 PROP(GRATE)=0`20
  820. X      PROP(FISSUR)=0
  821. X      DO 10010 LOOP=1,8`20
  822. X      DSEEN(LOOP)=.FALSE.`20
  823. X10010 DLOC(LOOP)=0
  824. X      CALL MOVE(TROLL,0)
  825. X      CALL MOVE(TROLL+100,0)
  826. X      CALL MOVE(TROLL2,PLAC(TROLL))`20
  827. X      CALL MOVE(TROLL2+100,FIXD(TROLL))`20
  828. X      CALL JUGGLE(CHASM)
  829. X      CALL MOVE(BEAR,0)`20
  830. X      PROP(CHAIN)=0`20
  831. X      FIXED(CHAIN)=0
  832. X      PROP(AXE)=0`20
  833. X      FIXED(AXE)=0
  834. X      CALL RSPEAK(129)
  835. X      CLOCK1=-1`20
  836. X      CLOSNG=.TRUE.`20
  837. X      GOTO 19999
  838. X `20
  839. X***ONCE HE'S PANICKED, AND CLOCK2 HAS RUN OUT, WE COME HERE TO SET UP TH
  840. X*  STORAGE ROOM.  THE ROOM HAS TWO LOCS, HARDWIRED AS 115 (NE) AND 116 (
  841. X*  AT THE NE END, WE PLACE EMPTY BOTTLES, A NURSERY OF PLANTS, A BED OF`20
  842. X*  OYSTERS, A PILE OF LAMPS, RODS WITH STARS, SLEEPING DWARVES, AND HIM.
  843. X*  THE SW END WE PLACE GRATE OVER TREASURES, SNAKE PIT, COVEY OF SACKED B`20
  844. X*  MORE RODS, AND PILLOWS.  A MIRROR STRETCHES ACROSS ONE WALL.  MANY OF
  845. X*  OBJECTS COME FROM KNOWN LOCATIONS AND/OR STATES (E.G. THE SNAKE IS KN
  846. X*  HAVE BEEN DESTROYED AND NEEDN'T BE CARRIED AWAY FROM ITS OLD 'PLACE')
  847. X*  MAKING THE VARIOUS OBJECTS BE HANDLED DIFFERENTLY.  WE ALSO DROP ALL`20
  848. X*  OBJECTS HE MIGHT BE CARRYING (LEST HE HAVE SOME WHICH COULD CAUSE TRO
  849. X*  SUCH AS THE KEYS).  WE DESCRIBE THE FLASH OF LIGHT AND TRUNDLE BACK.`20
  850. X `20
  851. X11000 PROP(BOTTLE)=PUT(BOTTLE,115,1)
  852. X      PROP(PLANT)=PUT(PLANT,115,0)
  853. X      PROP(OYSTER)=PUT(OYSTER,115,0)
  854. X      PROP(LAMP)=PUT(LAMP,115,0)
  855. X      PROP(ROD)=PUT(ROD,115,0)
  856. X      PROP(DWARF)=PUT(DWARF,115,0)
  857. X      LOC=115`20
  858. X      OLDLOC=115
  859. X      NEWLOC=115
  860. X `20
  861. X*  LEAVE THE GRATE WITH NORMAL (NON-NEGATIVE PROPERTY).`20
  862. X `20
  863. X      PROP(GRATE)=PUT(GRATE,116,-1)`20
  864. X      PROP(SNAKE)=PUT(SNAKE,116,1)
  865. X      PROP(MONGOOS)=PUT(MONGOOS,116,1)
  866. X      PROP(SACK)=PUT(SACK,116,0)
  867. X      PROP(ROD2)=PUT(ROD2,116,0)
  868. X      PROP(PILLOW)=PUT(PILLOW,116,0)
  869. X      PROP(MIRROR)=PUT(MIRROR,115,0)
  870. X      FIXED(MIRROR)=116`20
  871. X `20
  872. X*  DISTROY THE OBJECTS THAT HE IS TOTING.`20
  873. X `20
  874. X      DO 11010 LOOP=1,100`20
  875. X11010 IF(TOTING(LOOP))CALL MOVE(LOOP,0)`20
  876. X `20
  877. X      CALL RSPEAK(132)
  878. X      CLOSED=.TRUE.`20
  879. X      GOTO 2
  880. X `20
  881. X***ANOTHER WAY WE CAN FORCE AN END TO THINGS IS BY HAVING THE LAMP GIVE`20
  882. X*  WHEN IT GETS CLOSE, WE COME HERE TO WARN HIM.  WE GO TO 12000 IF THE`20
  883. X*  AND FRESH BATTERIES ARE HERE, IN WHICH CASE WE REPLACE THE BATTERIES`20
  884. X*  CONTINUE.  12200 IS FOR OTHER CASES OF LAMP DYING.  12400 IS WHEN IT`20
  885. X*  OUT, AND 12600 IS IF HE'S WANDERED OUTSIDE AND THE LAMP IS USED UP, I
  886. X*  CASE WE FORCE HIM TO GIVE UP.
  887. X `20
  888. X12000 CALL RSPEAK(188)
  889. X      PROP(BATTER)=1
  890. X      IF(TOTING(BATTER))CALL DROP(BATTER,LOC)`20
  891. X      LIMIT=LIMIT+2500
  892. X      LMWARN=.FALSE.
  893. X      GOTO 19999
  894. X `20
  895. X12200 IF(LMWARN.OR..NOT.HERE(LAMP))GOTO 19999`20
  896. X      LMWARN=.TRUE.`20
  897. X      SPK=187`20
  898. X      IF(PLACE(BATTER).EQ.0)SPK=183`20
  899. X      IF(PROP(BATTER).EQ.1)SPK=189
  900. X      CALL RSPEAK(SPK)
  901. X      GOTO 19999
  902. X `20
  903. X12400 LIMIT=-1
  904. X      PROP(LAMP)=0
  905. X      IF(HERE(LAMP))CALL RSPEAK(184)
  906. X      GOTO 19999
  907. X `20
  908. X12600 CALL RSPEAK(185)
  909. X      GAVEUP=.TRUE.`20
  910. X      GOTO 20000
  911. X `20
  912. X***OH DEAR, HE'S DISTURBED THE DWARVES.`20
  913. X `20
  914. X19000 CALL RSPEAK(136)
  915. X `20
  916. X***EXIT CODE.  WILL EVENTUALLY INCLUDE SCORING.  FOR NOW, HOWEVER, ...
  917. X `20
  918. X*  THE PRESENT SCORING ALGORITHM IS AS FOLLOWS:`20
  919. X*     OBJECTIVE:          POINTS:        PRESENT TOTAL POSSIBLE: `20
  920. X*  EACH TREASURE < CHEST    12                    60
  921. X*  TREASURE CHEST ITSELF    14                    14
  922. X*  EACH TREASURE > CHEST    16                   192
  923. X*  DYING                   -10                     0
  924. X*  GETTING WELL INTO CAVE   25                    25
  925. X*  NOT QUITTING              4                     4
  926. X*  REACHING 'CLOSNG'        25                    25
  927. X*  'CLOSED': QUIT/KILLED    10                    10
  928. X*            KLUTZED        25                    25
  929. X*            WRONG WAY      30                    30
  930. X*            SUCCESS        45                    45
  931. X*  CAME TO WITT'S END        2                     2
  932. X*  ROUND OUT THE TOTAL       3                     3
  933. X*                                       TOTAL:   360
  934. X*  (POINTS CAN ALSO BE DEDUCTED FOR USING HINTS.)`20
  935. X `20
  936. X20000 SCORE=0`20
  937. X      MXSCOR=0
  938. X `20
  939. X***FIRST TALLY UP THE TREASURES.  MUST BE IN BUILDING AND NOT BROKEN.`20
  940. X*  GIVE THE POOR GUY 2 POINTS JUST FOR FINDING EACH TREASURE.`20
  941. X `20
  942. X      DO 20010 LOOP=TRSURE,MAXTRS`20
  943. X      IF(PTEXT(LOOP).EQ.0)GOTO 20010
  944. X      K=12
  945. X      IF(LOOP.EQ.CHEST)K=14`20
  946. X      IF(LOOP.GT.CHEST)K=16`20
  947. X      IF(PROP(LOOP).GE.0)SCORE=SCORE+2
  948. X      IF(PLACE(LOOP).EQ.3.AND.PROP(LOOP).EQ.0)SCORE=SCORE+K-2`20
  949. X      MXSCOR=MXSCOR+K`20
  950. X20010 CONTINUE
  951. X `20
  952. X***NOW LOOK AT HOW HE FINISHED AND HOW FAR HE GOT.  MAXDIE AND NUMDIE TE
  953. X*  HOW WELL HE SURVIVED.  GAVEUP SAYS WHETHER HE EXITED VIA QUIT.  DFLAG
  954. X*  TELL US IF HE EVER GOT SUITABLY DEEP INTO THE CAVE.  CLOSNG STILL IND
  955. X*  WHETHER HE REACHED THE ENDGAME.  AND IF HE GOT AS FAR AS 'CAVE CLOSED
  956. X*  (INDICATED BY 'CLOSED'), THEN BONUS IS ZERO FOR MUNDANE EXITS OR 133,
  957. X*  135 IF HE BLEW IT (SO TO SPEAK).`20
  958. X `20
  959. X      SCORE=SCORE-NUMDIE*10`20
  960. X      IF(DFLAG.NE.0)SCORE=SCORE+25
  961. X      MXSCOR=MXSCOR+25
  962. X      IF(.NOT.(SCORNG.OR.GAVEUP))SCORE=SCORE+4
  963. X      MXSCOR=MXSCOR+4`20
  964. X      IF(CLOSNG)SCORE=SCORE+25
  965. X      MXSCOR=MXSCOR+25
  966. X      IF(.NOT.CLOSED)GOTO 20020`20
  967. X      IF(BONUS.EQ.0)SCORE=SCORE+10
  968. X      IF(BONUS.EQ.135)SCORE=SCORE+25
  969. X      IF(BONUS.EQ.134)SCORE=SCORE+30
  970. X      IF(BONUS.EQ.133)SCORE=SCORE+45
  971. X20020 MXSCOR=MXSCOR+45
  972. X `20
  973. X***DID HE COME TO WITT'S END AS HE SHOULD?
  974. X `20
  975. X      IF(PLACE(MAGZIN).EQ.108)SCORE=SCORE+2`20
  976. X      MXSCOR=MXSCOR+2`20
  977. X `20
  978. X***ROUND IT OFF.
  979. X `20
  980. X      SCORE=SCORE+3`20
  981. X      MXSCOR=MXSCOR+3`20
  982. X `20
  983. X***DEDUCT POINTS FOR HINTS.  HINTS < 4 ARE SPECIAL; SEE DATABASE DESCRIP
  984. X `20
  985. X      DO 20030 LOOP=1,HNTMAX
  986. X20030 IF(HINTED(LOOP))SCORE=SCORE-HINTS(LOOP,2)`20
  987. X `20
  988. X***RETURN TO SCORE COMMAND IF THAT'S WHERE WE CAME FROM.
  989. X `20
  990. X      IF(SCORNG)GOTO 8241`20
  991. X `20
  992. X*`20
  993. X***THAT SHOULD BE GOOD ENOUGH.  LET'S TELL HIM ALL ABOUT IT.
  994. X `20
  995. X      WRITE(6,20100)SCORE,MXSCOR,TURNS
  996. X20100 FORMAT(///,' You scored',I4,' out of a possible',I4,
  997. X     $', using',I5,' turns.')`20
  998. X `20
  999. X      IF(WIZKID) GOTO 25000`20
  1000. X      DO 20200 LOOP=1,CLSSES
  1001. X      I=LOOP
  1002. X      IF(CVAL(LOOP).GE.SCORE)GOTO 20210`20
  1003. X20200 CONTINUE
  1004. X      WRITE(6,20202)
  1005. X20202 FORMAT(/,' You just went off my scale!!',/)`20
  1006. X      GOTO 25000
  1007. X `20
  1008. X20210 CALL SPEAK(CTEXT(I))
  1009. X      IF(I.EQ.CLSSES-1)GOTO 20220`20
  1010. X      K=CVAL(I)+1-SCORE`20
  1011. X      KK='s.'`20
  1012. X      IF(K.EQ.1)KK='. '`20
  1013. X      WRITE(6,20212)K,KK
  1014. X20212 FORMAT(/,' To achieve the next higher rating, you need',I3,`20
  1015. X     $' more point',A2/)
  1016. X      GOTO 25000
  1017. X `20
  1018. X20220 WRITE(6,20222)
  1019. X20222 FORMAT(/,' To achieve the next higher rating ',`20
  1020. X     $'would be a neat trick!',//,' Congratulations!!',/)`20
  1021. X `20
  1022. X25000 CONTINUE
  1023. X!!!!! STOP
  1024. X      call sys$exit(%val(1))
  1025. X      END`20
  1026. $ CALL UNPACK [.SRC]FUNADV.FOR;7 1025282667
  1027. $ create 'f'
  1028. X      SUBROUTINE GETIN(W1,W2,WCOUNT)
  1029. X*`20
  1030. X*  GET A COMMAND FROM THE ADVENTURER.`20
  1031. X*`20
  1032. X*  W1 IS SET TO THE FIRST WORD OF HIS COMMAND.  W2 IS SET TO THE
  1033. X*  SECOND WORD.  WCOUNT HOLDS THE POINTER POSITION FOR THE LINE.
  1034. X*`20
  1035. X      IMPLICIT INTEGER(A-Z)`20
  1036. X      LOGICAL BLKLIN,YESCALL
  1037. X      Character*10 Blank, W1, W2, WORD
  1038. X      Character*80 Line
  1039. X      COMMON /IOSCOM/ BLKLIN,YESCALL
  1040. X      DIMENSION T(22)
  1041. X      DATA BLANK/' '/`20
  1042. X
  1043. X      W1=' '
  1044. X      W2=' '
  1045. X      IF(BLKLIN)WRITE(6,1)
  1046. X    1 FORMAT(1X)
  1047. X      WRITES=WCOUNT`20
  1048. X      IF(YESCALL) WRITES=0
  1049. X      IF(WCOUNT.NE.0) GOTO 20`20
  1050. X    5 READ(5,10,end=5) LINE
  1051. X   10 FORMAT(80A)
  1052. X      CALL STR$UPCASE(LINE,LINE)
  1053. X   20 WCOUNT=WCOUNT+1`20
  1054. X      IF(WCOUNT.GT.80) GOTO 90
  1055. X      IF(LINE(WCOUNT:WCOUNT).EQ.BLANK) GOTO 20`20
  1056. X      WORD=' '
  1057. X      WSTART=WCOUNT`20
  1058. X   30 IF(LINE(WCOUNT:WCOUNT).EQ.' ') GOTO 100
  1059. X      IF(WCOUNT.GT.80) GOTO 100`20
  1060. X      ptr = wcount-wstart+1
  1061. X      IF(WCOUNT-WSTART.LE.10) WORD(ptr:ptr)=LINE(WCOUNT:WCOUNT)`20
  1062. X      WCOUNT=WCOUNT+1`20
  1063. X      GOTO 30`20
  1064. X   90 WCOUNT=0
  1065. X      IF(W1.NE.' ') GOTO 200
  1066. X      WRITES=0
  1067. X      GOTO 5
  1068. X `20
  1069. X  100 IF(WORD.EQ.' '.AND.W1.EQ.' ') GOTO 20`20
  1070. X      IF(WORD.EQ.' ') GOTO 200
  1071. X      IF(WCOUNT-WSTART.GE.10) GOTO 120
  1072. X      TEMP=WCOUNT-WSTART+1
  1073. X      DO 110 LOOP=TEMP,10`20
  1074. X  110 WORD(loop:loop) = BLANK
  1075. X  120 IF(W1.NE.' ') W2=WORD`20
  1076. X      IF(W2.EQ.' ') W1=WORD`20
  1077. X      IF(LINE(WCOUNT:WCOUNT).NE.BLANK) GOTO 200
  1078. X      IF(W2.EQ.' ') GOTO 20`20
  1079. X      WCOUNT=WCOUNT+1`20
  1080. X  130 IF(WCOUNT.GT.80) GOTO 200`20
  1081. X      IF(LINE(WCOUNT:WCOUNT).EQ.BLANK) GOTO 140
  1082. X  140 WCOUNT=WCOUNT+1`20
  1083. X      GOTO 130
  1084. X `20
  1085. X  200 IF(WRITES.EQ.0) RETURN
  1086. X      IF(BLKLIN) WRITE(6,1)`20
  1087. X      WRITE(6,220) WD1,WD2
  1088. X  220 FORMAT(A10,x,A10)`20
  1089. X      RETURN
  1090. X      END`20
  1091. $ CALL UNPACK [.SRC]GETIN.FOR;1 1581651471
  1092. $ create 'f'
  1093. X      subroutine image_dir (dir)
  1094. X
  1095. X      implicit none
  1096. X
  1097. X      external jpi$_imagname
  1098. X      integer*4 sys$getjpi
  1099. X      integer*2 len
  1100. X      integer*4 status
  1101. X      integer*4 i
  1102. X      structure /itmlist/`20
  1103. X         union
  1104. X            map
  1105. X               integer*2 buflen
  1106. X               integer*2 code
  1107. X               integer*4 bufadr
  1108. X               integer*4 retlenadr
  1109. X            end map
  1110. X            map
  1111. X               integer*4 end_list
  1112. X            end map
  1113. X         end union
  1114. X      end structure
  1115. X
  1116. X      record /itmlist/ itmlst
  1117. X      character*128 imagname
  1118. X      character*128 dir
  1119. X      itmlst.buflen=80
  1120. X      itmlst.code       = %loc(jpi$_imagname)
  1121. X      itmlst.bufadr     = %loc(imagname)
  1122. X      itmlst.retlenadr  = %loc(len)
  1123. X
  1124. X      status = sys$getjpi (%val(1),,,itmlst,,,)`09! Get myself
  1125. X
  1126. X      do 10,i=len,1,-1
  1127. X        if (imagname (i:i) .eq. '`5D') goto 20
  1128. X   10 continue
  1129. X
  1130. X   20 dir = imagname(1:i)
  1131. X
  1132. X      return`20
  1133. X      end
  1134. $ CALL UNPACK [.SRC]IMAGE_DIR.FOR;1 1916815225
  1135. $ create 'f'
  1136. X      SUBROUTINE JUGGLE(OBJECT)`20
  1137. X `20
  1138. X*  JUGGLE AN OBJECT BY PICKING IT UP AND PUTTING IT DOWN AGAIN, THE PURP
  1139. X*  BEING TO GET THE OBJECT TO THE FRONT OF THE CHAIN OF THINGS AT ITS LO
  1140. X `20
  1141. X      IMPLICIT INTEGER(A-Z)`20
  1142. X      COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,COND,PROP,LOC,LAMP,HOLDNG
  1143. X      DIMENSION PROP(100), LINK(200), PLACE(100), FIXED(100)
  1144. X      DIMENSION ATLOC(220), COND(220)`20
  1145. X `20
  1146. X      I=PLACE(OBJECT)`20
  1147. X      J=FIXED(OBJECT)`20
  1148. X      CALL MOVE(OBJECT,I)`20
  1149. X      CALL MOVE(OBJECT+100,J)`20
  1150. X      RETURN
  1151. X      END`20
  1152. $ CALL UNPACK [.SRC]JUGGLE.FOR;1 319691190
  1153. $ create 'f'
  1154. X      SUBROUTINE LDCOMN(QNAME,NAME)`20
  1155. X*`20
  1156. X*   ADVENTURE SUBROUTINE TO LOAD ALL COMMON BLOCKS FROM EITHER
  1157. X*     THE SYSTEM FILE (QNAME=.TRUE.) OR A PREVIOUSLY SAVED FILE`20
  1158. X*     (QNAME=.FALSE.)`20
  1159. X*`20
  1160. X*   IF THE SYSTEM FILE IS NOT FOUND, ZERO ARRAYS.`20
  1161. X*`20
  1162. X*   IF THE NAMED FILE IS NOT FOUND, DIE`20
  1163. X `20
  1164. X      IMPLICIT INTEGER (A-Z)
  1165. X      CHARACTER*148 FILENAME
  1166. X      Character*128 filedir
  1167. X      COMMON /AAAAAA/ CORE(1)
  1168. X      COMMON /ZZZZZZ/ THEEND
  1169. X
  1170. X      LOGICAL QNAME`20
  1171. X     `20
  1172. X      call image_dir (filedir)
  1173. X
  1174. X      if (qname) then
  1175. X         filename = filedir//'funadv.common'
  1176. X      else
  1177. X         filename = 'sys$login:funadv.adv'
  1178. X      endif      `20
  1179. X
  1180. X      open (unit=2,file=filename,status='old',err=1000,
  1181. X     1form='unformatted',carriagecontrol='none')
  1182. X      BEGIN=1`20
  1183. X      END=((%LOC(THEEND)-%LOC(CORE(1))+1)/4)+1
  1184. X      READ(2,err=9999) (CORE(I1),I1=BEGIN,END)`20
  1185. X     `20
  1186. X      CLOSE(2)
  1187. X      RETURN
  1188. X
  1189. X 1000 if (qname) RETURN
  1190. X      type*,'Saved game can not be opened...'
  1191. X      RETURN
  1192. X
  1193. X 9999 type*,' '
  1194. X      type*,'Fatal error loading saved game - ABORT.'
  1195. X      STOP
  1196. X      END`20
  1197. $ CALL UNPACK [.SRC]LDCOMN.FOR;2 53837312
  1198. $ create 'f'
  1199. X      Integer Function MINPMID (sub)
  1200. X
  1201. X      real secnds
  1202. X
  1203. X      minpmid = (ifix(secnds(0.0)) / 60) - sub
  1204. X      return
  1205. X      end
  1206. $ CALL UNPACK [.SRC]MINPMID.FOR;1 990196778
  1207. $ create 'f'
  1208. X      SUBROUTINE MOVE(OBJECT,WHERE)`20
  1209. X `20
  1210. X*  PLACE ANY OBJECT ANYWHERE BY PICKING IT UP AND DROPPING IT.  MAY ALREADY`
  1211. V20
  1212. X*  TOTING, IN WHICH CASE THE CARRY IS A NO-OP.  MUSTN'T PICK UP OBJECTS THAT
  1213. X*  ARE NOT AT ANY LOC, SINCE CARRY WANTS TO REMOVE OBJECTS FROM ATLOC CH
  1214. X `20
  1215. X      IMPLICIT INTEGER(A-Z)`20
  1216. X      COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,COND,PROP,LOC,LAMP,HOLDNG
  1217. X      DIMENSION PROP(100), LINK(200), PLACE(100), FIXED(100)
  1218. X      DIMENSION ATLOC(220), COND(220)`20
  1219. X `20
  1220. X      IF(OBJECT.GT.100)GOTO 1`20
  1221. X      FROM=PLACE(OBJECT)
  1222. X      GOTO 2
  1223. X    1 FROM=FIXED(OBJECT-100)
  1224. X    2 IF(FROM.GT.0.AND.FROM.LE.300)CALL CARRY(OBJECT,FROM)
  1225. X      CALL DROP(OBJECT,WHERE)`20
  1226. X      RETURN
  1227. X      END`20
  1228. $ CALL UNPACK [.SRC]MOVE.FOR;1 404384361
  1229. $ create 'f'
  1230. X      SUBROUTINE PSPEAK(MSG,SKIP)`20
  1231. X `20
  1232. X*  FIND THE SKIP+1ST MESSAGE FROM MSG AND PRINT IT.  MSG SHOULD BE THE I
  1233. X*  THE INVENTORY MESSAGE FOR OBJECT.  (INVEN+N+1 MESSAGE IS PROP=N MESSA
  1234. X
  1235. X      IMPLICIT INTEGER(A-Z)`20
  1236. X
  1237. X      STRUCTURE /TEXTYPE/
  1238. X        Integer*4 count
  1239. X        Character*80 string
  1240. X      end structure
  1241. X
  1242. X      record /textype/ lines`20
  1243. X
  1244. X      COMMON /TXTCOM/ RTEXT,LINES,LINUSE
  1245. X      COMMON /PTXCOM/ PTEXT`20
  1246. X
  1247. X      DIMENSION RTEXT(250), LINES(2000), PTEXT(100)
  1248. X `20
  1249. X      M=PTEXT(MSG)
  1250. X      IF(SKIP.LT.0)GOTO 9`20
  1251. X      SKIP1=SKIP+1
  1252. X      DO 3 I=1,SKIP1
  1253. X    1 M=IABS(LINES(M).COUNT)
  1254. X      IF(LINES(M).COUNT.GE.0) GOTO 1
  1255. X    3 CONTINUE
  1256. X    9 CALL SPEAK(M)`20
  1257. X      RETURN
  1258. X      END`20
  1259. $ CALL UNPACK [.SRC]PSPEAK.FOR;1 492851518
  1260. $ create 'f'
  1261. X      INTEGER FUNCTION PUT(OBJECT,WHERE,PVAL)`20
  1262. X `20
  1263. X*  PUT IS THE SAME AS MOVE, EXCEPT IT RETURNS A VALUE USED TO SET UP THE
  1264. X*  NEGATED PROP VALUES FOR THE REPOSITORY OBJECTS.
  1265. X `20
  1266. X      IMPLICIT INTEGER(A-Z)`20
  1267. X `20
  1268. X      CALL MOVE(OBJECT,WHERE)`20
  1269. X      PUT=(-1)-PVAL`20
  1270. X      RETURN
  1271. X      END`20
  1272. $ CALL UNPACK [.SRC]PUT.FOR;1 1330259878
  1273. $ create 'f'
  1274. X      INTEGER FUNCTION RANDOM(RANGE)`20
  1275. X `20
  1276. X*  RETURN RANDOM UNIFORMLY DISTRIBUTED VALUE IN CLOSED INTERVAL(0,RANGE).`20
  1277. X*`20
  1278. X*  COURTESY MICHAEL GRUBIN@PRIME COMPUTER INC., FRAMINGHAM MASS.
  1279. X
  1280. X `20
  1281. X      IMPLICIT INTEGER (A-Z)
  1282. X      COMMON /SEED/ SEED
  1283. X
  1284. X      RANDOM = (RANGE-1.)*RAN(SEED)
  1285. X      RETURN
  1286. X      END`20
  1287. $ CALL UNPACK [.SRC]RANDOM.FOR;1 908817846
  1288. $ create 'f'
  1289. X      SUBROUTINE RSPEAK(N)
  1290. X `20
  1291. X*  PRINT THE N-TH 'RANDOM' MESSAGE (SECTION 6 OF DATABASE).`20
  1292. X `20
  1293. X      IMPLICIT INTEGER(A-Z)`20
  1294. X      COMMON /TXTCOM/ RTEXT,LINES,LINUSE
  1295. X      DIMENSION RTEXT(250), LINES(2000)
  1296. X      IF(N.NE.0)CALL SPEAK(RTEXT(N))
  1297. X      RETURN
  1298. X      END`20
  1299. $ CALL UNPACK [.SRC]RSPEAK.FOR;1 539841814
  1300. $ create 'f'
  1301. X      INTEGER FUNCTION SCRMBL(IVAL)`20
  1302. X `20
  1303. X*  RETURN 'SCRAMBLED' VAL.  SCRAMBLING IS DONE BY 'NOT'ING IVAL`20
  1304. X*  (INITIAL ATTEMPT, ALGORITHM MAY BE MODIFIED LATER)`20
  1305. X `20
  1306. X      SCRMBL=.NOT. IVAL`20
  1307. X      RETURN
  1308. X      END`20
  1309. $ CALL UNPACK [.SRC]SCRMBL.OLD;1 876562136
  1310. $ create 'f'
  1311. Xmodule shift$main (input,output);
  1312. X
  1313. X(***************************************************************************
  1314. V***)
  1315. X(*
  1316. V                                                                         `20
  1317. V  *)
  1318. X(*  Shift - emulate CDC FORTRAN shift function.
  1319. V                               *)
  1320. X(*
  1321. V                                                                         `20
  1322. V  *)
  1323. X(*  Restrictions:  Cannot shift greater than 32, the VAX longword length.
  1324. V     *)
  1325. X(*
  1326. V                                                                         `20
  1327. V  *)
  1328. X(***************************************************************************
  1329. V***)
  1330. X
  1331. Xtype bit32 = packed array `5B1..32`5D of 0..1;
  1332. X
  1333. X`5Bglobal`5D function shift ( val : bit32; cnt : integer ): bit32;
  1334. X
  1335. Xvar loop : integer;
  1336. X    temp : bit32;
  1337. X
  1338. Xbegin
  1339. X  if cnt > 32 then
  1340. X    begin
  1341. X      writeln ('Error in shift argument - shift count greater than word leng
  1342. Vth');
  1343. X      halt;
  1344. X    end;
  1345. X  if cnt > 0 then
  1346. X    begin
  1347. X      for loop := 1 to 32 - cnt do
  1348. X        begin
  1349. X          temp `5Bloop + cnt`5D := val `5Bloop`5D;
  1350. X        end;
  1351. X      for loop := 1 to cnt do
  1352. X        begin
  1353. X          temp `5Bloop`5D := val `5B32 - cnt + loop`5D;
  1354. X        end;
  1355. X     end
  1356. X   else if cnt = 0 then
  1357. X     begin
  1358. X       temp := val;
  1359. X     end
  1360. X   else
  1361. X     begin
  1362. X       for loop := -cnt + 1 to 31 do
  1363. X         begin
  1364. X           temp `5Bloop + cnt`5D := val `5Bloop`5D;
  1365. X         end;
  1366. X       for loop := 31 downto 32 + cnt do
  1367. X          begin
  1368. X            temp `5Bloop`5D := 0;
  1369. X          end;
  1370. X     end;
  1371. X  shift := temp;
  1372. Xend;
  1373. X
  1374. Xend.
  1375. $ CALL UNPACK [.SRC]SHIFT.PAS;21 1298335372
  1376. $ create 'f'
  1377. X      SUBROUTINE SPEAK(N)`20
  1378. X `20
  1379. X*  PRINT THE MESSAGE WHICH STARTS AT LINES(N).  PRECEDE IT WITH A BLANK`20
  1380. X*  UNLESS BLKLIN IS FALSE.
  1381. X `20
  1382. X      IMPLICIT INTEGER(A-Z)`20
  1383. X
  1384. X      STRUCTURE /TEXTYPE/
  1385. X        Integer*4 count
  1386. X        Character*80 string
  1387. X      end structure
  1388. X
  1389. X      LOGICAL BLKLIN
  1390. X
  1391. X      record /textype/ lines`20
  1392. X
  1393. X      Character*80 text
  1394. X
  1395. X      COMMON /TXTCOM/ RTEXT,LINES,LINUSE
  1396. X      COMMON /STXCOM/ TEXT
  1397. X      COMMON /IOSCOM/ BLKLIN
  1398. X      DIMENSION RTEXT(250), LINES(2000), TEXT(80)
  1399. X
  1400. X      IF(N.EQ.0)RETURN
  1401. X      IF (LINES(N).string .EQ. '>$<') RETURN
  1402. X      IF(BLKLIN)WRITE(6,1)
  1403. X    1 FORMAT(1X)
  1404. X      I = N
  1405. X   10 CONTINUE`20
  1406. X      WRITE(6,20)lines(I).string
  1407. X   20 FORMAT(1x,80A)
  1408. X   30 I = I + 1
  1409. X      IF (LINES(I).COUNT .GE. 0) GO TO 10`20
  1410. X      RETURN
  1411. X `20
  1412. X      END`20
  1413. $ CALL UNPACK [.SRC]SPEAK.FOR;1 440817370
  1414. $ create 'f'
  1415. X      SUBROUTINE SVCOMN(QNAME,NAME)`20
  1416. X*`20
  1417. X*  ADVENTURE SUBROUTINE TO SAVE ALL COMMON BLOCKS.  (SEE LDCOMN)
  1418. X `20
  1419. X      IMPLICIT INTEGER (A-Z)
  1420. X      CHARACTER*148 FILENAME
  1421. X      Character*128 filedir
  1422. X      COMMON /AAAAAA/ CORE(1)
  1423. X      COMMON /ZZZZZZ/  THEEND`20
  1424. X
  1425. X      LOGICAL QNAME`20
  1426. X
  1427. X      if (qname) then
  1428. X         filename = filedir//'funadv.common'
  1429. X      else
  1430. X         filename = 'sys$login:funadv.adv'
  1431. X      endif      `20
  1432. X `20
  1433. X      open (unit=2,file=filename,status='new',err=9999,
  1434. X     1form='unformatted',carriagecontrol='none')
  1435. X      BEGIN=1`20
  1436. X      END=(%LOC(THEEND)-%LOC(CORE(1))+4)/4     ! Account for wordsize
  1437. X      WRITE(2,err=9998) (CORE(I1),I1=BEGIN,END)
  1438. X      close(2)
  1439. X      RETURN
  1440. X 9998 close (2)
  1441. X 9999 write (6,10)
  1442. X  10  Format (' Error creating save file.')
  1443. X      return
  1444. X      END`20
  1445. $ CALL UNPACK [.SRC]SVCOMN.FOR;2 538577936
  1446. $ create 'f'
  1447. X`5Binherit('sys$library:starlet')`5D
  1448. Xmodule getuser;
  1449. X
  1450. Xtype
  1451. X   word_integer = `5Bword`5D 0..65535;
  1452. X   long_integer = `5Blong`5D integer;
  1453. X   char12 = packed array `5B1..12`5D of char;
  1454. X    jpi_rec = packed record
  1455. X       len : word_integer;
  1456. X       oper : word_integer;
  1457. X       adr : long_integer;
  1458. X       adrl : long_integer;
  1459. X       zero : long_integer;
  1460. X    end;
  1461. X
  1462. Xvar rts,i : integer;
  1463. X    jrec : jpi_rec;
  1464. X
  1465. X`5Bglobal`5D procedure user( var name: char12);
  1466. X
  1467. Xbegin
  1468. X  jrec.len := 12;
  1469. X  jrec.zero := 0;
  1470. X  jrec.adr := iaddress(name);
  1471. X  jrec.adrl := iaddress(i);
  1472. X  jrec.oper := jpi$_username;
  1473. X  rts := $getjpi(itmlst := jrec);
  1474. Xend;
  1475. X
  1476. Xend.
  1477. $ CALL UNPACK [.SRC]USER.PAS;3 1985376514
  1478. $ create 'f'
  1479. X      INTEGER FUNCTION VOCAB(ID,INIT)`20
  1480. X `20
  1481. X*  LOOK UP ID IN THE VOCABULARY (ATAB) AND RETURN ITS 'DEFINITION' (KTAB
  1482. X*  -1 IF NOT FOUND.  IF INIT IS POSITIVE, THIS IS AN INITIALIZATION CALL
  1483. X*  UP A KEYWORD VARIABLE, AND NOT FINDING IT CONSTITUTES A BUG.  IT ALSO
  1484. X*  THAT ONLY KTAB VALUES WHICH TAKEN OVER 1000 EQUAL INIT MAY BE CONSIDE
  1485. X*  (THUS 'STEPS', WHICH IS A MOTION VERB AS WELL AS AN OBJECT, MAY BE LO
  1486. X*  AS AN OBJECT.)  AND IT ALSO MEANS THE KTAB VALUE IS TAKEN MOD 1000.
  1487. X `20
  1488. X      IMPLICIT INTEGER(A-Z)`20
  1489. X      COMMON /VOCCOM/ TABSIZ,KTAB,ATAB
  1490. X      Character*10 ID, HASH, ATAB
  1491. X      DIMENSION KTAB(400), ATAB(400)
  1492. X `20
  1493. X!!!!! HASH=SCRMBL(ID)`20
  1494. X      HASH = ID
  1495. X      DO 1 I=1,TABSIZ`20
  1496. X      IF(KTAB(I).EQ.-1)GOTO 2`20
  1497. X      IF(INIT.GE.0.AND.KTAB(I)/1000.NE.INIT)GOTO 1
  1498. X      IF(ATAB(I).EQ.HASH)GOTO 3`20
  1499. X    1 CONTINUE
  1500. X      CALL BUG(21)
  1501. X `20
  1502. X    2 VOCAB=-1
  1503. X      IF(INIT.LT.0)RETURN`20
  1504. X      PRINT*,HASH`20
  1505. X      CALL BUG(5)`20
  1506. X `20
  1507. X    3 VOCAB=KTAB(I)`20
  1508. X      IF(INIT.GE.0)VOCAB=MOD(VOCAB,1000)
  1509. X      RETURN
  1510. X      END`20
  1511. $ CALL UNPACK [.SRC]VOCAB.FOR;2 724852254
  1512. $ create 'f'
  1513. X      LOGICAL FUNCTION WIZARD(DUMMY)
  1514. X      IMPLICIT INTEGER (A-Z)
  1515. X      LOGICAL BIGWIZ
  1516. X      CHARACTER*12 BIGWIZS (4)
  1517. X      Character*12 Usernum
  1518. X      Character*10 Junk,Junk2
  1519. X      COMMON /USER/ USERNUM`20
  1520. X      DATA BIGWIZS / 'CTS' , ' ', ' ', ' ' /
  1521. X `20
  1522. X      WIZARD=.FALSE.
  1523. X      WRITE(6,10)`20
  1524. X 10   FORMAT(' Are you The Wizard ? ',$)
  1525. X      READ(5,20,end=25)JUNK
  1526. X 20   FORMAT(2A10)
  1527. X      call str$upcase(JUNK,JUNK)
  1528. X      IF(JUNK.EQ.'Y'.OR.JUNK.EQ.'YES') GOTO 40
  1529. X      if(junk.eq.'MAYBE') goto 47
  1530. X      IF(JUNK.EQ.'SAVE') GOTO 35
  1531. X   25 WRITE(6,30)`20
  1532. X 30   FORMAT(' Very well.')`20
  1533. X      RETURN
  1534. X 35   CALL SVCOMN(.TRUE.,0)`20
  1535. X 40   BIGWIZ=.FALSE.
  1536. X      CALL USER(%ref(USERNUM))
  1537. X      DO 45 LOOP = 1,4`20
  1538. X         IF ( USERNUM .NE. BIGWIZS(LOOP) ) GOTO 45
  1539. X         BIGWIZ = .TRUE.
  1540. X         GOTO 100`20
  1541. X   45 CONTINUE
  1542. X 47   WRITE(6,50)`20
  1543. X 50   FORMAT(' Prove it! Say the magic word!')
  1544. X      READ(5,20,end=200)JUNK,JUNK2
  1545. X      call str$upcase(junk,junk)
  1546. X      call str$upcase(junk2,junk2)
  1547. X      IF(JUNK.EQ.'ORCS ARE S'.AND.JUNK2.EQ.'CUM       ') GOTO 60
  1548. X      IF(JUNK.NE.'DWARF'.AND.JUNK.NE.'DWARVES') GOTO 200
  1549. X      IF(JUNK.EQ.'DWARF') MSG=1`20
  1550. X      IF(JUNK.EQ.'DWARVES') MSG=2`20
  1551. X 60   WRITE(6,70)`20
  1552. X 70   FORMAT(' That is not what I thought it was.  Do you know what',`20
  1553. X     $' I thought it was?')`20
  1554. X      READ(5,20,end=200)JUNK
  1555. X      call str$upcase(junk,junk)
  1556. X      IF(JUNK.NE.'NO'.AND.JUNK.NE.'N') GOTO 200`20
  1557. X      WRITE(6,80)`20
  1558. X 80   FORMAT(/,' Wazu')`20
  1559. X      READ(5,20,end=200)JUNK
  1560. X      call str$upcase(junk,junk)
  1561. X      IF(JUNK.NE.'WAZU') GOTO 200`20
  1562. X      IF(MSG.NE.0) GOTO 190`20
  1563. X      WRITE(6,90)`20
  1564. X 90   FORMAT(' Oh dear, you really *are* a Wizard! Sorry to have ',`20
  1565. X     $'bothered you. . .')
  1566. X      WIZARD=.TRUE.`20
  1567. X      RETURN
  1568. X 100  WRITE(6,110)
  1569. X 110  FORMAT(/,' Oh my!!! I''ve been detaining a *true* wizard! ! !'
  1570. X     $,//)`20
  1571. X      WIZARD=.TRUE.`20
  1572. X      RETURN
  1573. X 190  IF(MSG.EQ.1) WRITE(6,191)`20
  1574. X 191  FORMAT(' There are now several threatening little Dwarves'
  1575. X     $,' in the room with you!',/,' Most of them throw knives'
  1576. X     $,' at you!',/,' All of them get you!')
  1577. X      IF(MSG.EQ.2) WRITE(6,195)`20
  1578. X 195  FORMAT(' There is a threatening  little dwarf in the room with'`20
  1579. X     $,' you!',/,' One sharp nasty knife is thrown at you!'`20
  1580. X     $,/,' It gets you!')`20
  1581. X      WRITE(6,199)
  1582. X 199  FORMAT(/,/,/,' Just kidding....  You are not a Wizard, though.'`20
  1583. X     $,/,' ....in this game, anyway.')
  1584. X      RETURN
  1585. X 200  WRITE(6,210)
  1586. X 210  FORMAT(' Foo, you are nothing but a charlatan!')
  1587. X      RETURN
  1588. X      END`20
  1589. $ CALL UNPACK [.SRC]WIZARD.FOR;4 1968196168
  1590. $ create 'f'
  1591. X      LOGICAL FUNCTION YES(X,Y,Z,WCOUNT)
  1592. X `20
  1593. X*  PRINT MESSAGE X, WAIT FOR YES/NO ANSWER.  IF YES, PRINT Y AND LEAVE Y
  1594. X*  TRUE; IF NO, PRINT Z AND LEAVE YEA FALSE.  SPK IS RSPEAK.
  1595. X `20
  1596. X      IMPLICIT INTEGER(A-Z)`20
  1597. +-+-+-+-+-+-+-+-  END  OF PART 7 +-+-+-+-+-+-+-+-
  1598.