home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1994 March / Source_Code_CD-ROM_Walnut_Creek_March_1994.iso / compsrcs / games / vmsnet / dungeon / part30 < prev    next >
Encoding:
Internet Message Format  |  1992-02-23  |  19.2 KB
  1. Path: uunet!haven.umd.edu!darwin.sura.net!gatech!nntp.msstate.edu!emory!dragon.com!cts
  2. From: cts@dragon.com
  3. Newsgroups: vmsnet.sources.games
  4. Subject: Dungeon Part 30/30
  5. Message-ID: <1992Feb24.014226.823@dragon.com>
  6. Date: 24 Feb 92 06:42:26 GMT
  7. Organization: Computer Projects Unlimited
  8. Lines: 613
  9.  
  10. -+-+-+-+-+-+-+-+ START OF PART 30 -+-+-+-+-+-+-+-+
  11. XC V158--        CLIMB DOWN
  12. XC
  13. X85000 CONTINUE
  14. X86000 CONTINUE
  15. X87000 I=XUP
  16. XC                                               !ASSUME UP.
  17. X      IF(PRSA.EQ.CLMBDW) I=XDOWN
  18. XC                                               !UNLESS CLIMB DN.
  19. X      F=(and(OFLAG2(PRSO),CLMBBT)).NE.0
  20. X      IF(F.AND.FINDXT(I,HERE)) GO TO 87500
  21. XC                                               !ANYTHING TO CLIMB?
  22. X      IF(OBJACT(X)) RETURN
  23. XC                                               !OBJ HANDLE?
  24. X      I=657
  25. X      IF(F) I=524
  26. XC                                               !VARIETY OF JOKES.
  27. X      IF(.NOT.F .AND.((PRSO.EQ.WALL).OR.
  28. X     &   ((PRSO.GE.WNORT).AND.(PRSO.LE.WNORT+3))))
  29. X     &  I=656
  30. X      CALL RSPEAK(I)
  31. XC                                               !JOKE.
  32. X      RETURN
  33. XC
  34. X87500 PRSA=WALKW
  35. XC                                               !WALK
  36. X      PRSO=I
  37. XC                                               !IN SPECIFIED DIR.
  38. X      VAPPLI=WALK(X)
  39. X      RETURN
  40. XC
  41. X      END
  42. X`0C
  43. XC CLOCKD- CLOCK DEMON FOR INTERMOVE CLOCK EVENTS
  44. XC
  45. XC DECLARATIONS
  46. XC
  47. X      LOGICAL FUNCTION CLOCKD(X)
  48. X      IMPLICIT INTEGER (A-Z)
  49. XC
  50. XC CLOCK INTERRUPTS
  51. XC
  52. X      INCLUDE 'CLOCK.LIB'
  53. XC
  54. X      CLOCKD=.FALSE.
  55. XC                                               !ASSUME NO ACTION.
  56. X      DO 100 I=1,CLNT
  57. X        IF(.NOT.CFLAG(I) .OR.(CTICK(I).EQ.0)) GO TO 100
  58. X        IF(CTICK(I).LT.0) GO TO 50
  59. XC                                               !PERMANENT ENTRY?
  60. X        CTICK(I)=CTICK(I)-1
  61. X        IF(CTICK(I).NE.0) GO TO 100
  62. XC                                               !TIMER EXPIRED?
  63. X50      CLOCKD=.TRUE.
  64. X        CALL CEVAPP(CACTIO(I))
  65. XC                                               !DO ACTION.
  66. X100   CONTINUE
  67. X      RETURN
  68. XC
  69. X      END
  70. $ CALL UNPACK [.SRC]VERBS.FOR;1 587413486
  71. $ create 'f'
  72. XC
  73. XC VERBS
  74. XC
  75. X      COMMON /VINDEX/ CINTW,DEADXW,FRSTQW,INXW,OUTXW
  76. X      COMMON /VINDEX/ WALKIW,FIGHTW,FOOW
  77. X      COMMON /VINDEX/ MELTW,READW,INFLAW,DEFLAW,ALARMW,EXORCW
  78. X      COMMON /VINDEX/ PLUGW,KICKW,WAVEW,RAISEW,LOWERW,RUBW
  79. X      COMMON /VINDEX/ PUSHW,UNTIEW,TIEW,TIEUPW,TURNW,BREATW
  80. X      COMMON /VINDEX/ KNOCKW,LOOKW,EXAMIW,SHAKEW,MOVEW,TRNONW,TRNOFW
  81. X      COMMON /VINDEX/ OPENW,CLOSEW,FINDW,WAITW,SPINW,BOARDW,UNBOAW,TAKEW
  82. X      COMMON /VINDEX/ INVENW,FILLW,EATW,DRINKW,BURNW
  83. X      COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW
  84. X      COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW
  85. X      COMMON /VINDEX/ DIGW,LEAPW,STAYW,FOLLOW
  86. X      COMMON /VINDEX/ HELLOW,LOOKIW,LOOKUW,PUMPW,WINDW
  87. X      COMMON /VINDEX/ CLMBW,CLMBUW,CLMBDW,TRNTOW
  88. $ CALL UNPACK [.SRC]VERBS.LIB;1 1531792341
  89. $ create 'f'
  90. XC
  91. XC VILLAINS AND DEMONS
  92. XC
  93. X      LOGICAL THFFLG,SWDACT,THFACT
  94. X      COMMON /HACK/ THFPOS,THFFLG,THFACT,SWDACT,SWDSTA
  95. XC
  96. X      COMMON /VILL/ VLNT,VILLNS(4),VPROB(4),VOPPS(4),VBEST(4),VMELEE(4)
  97. XC
  98. X      INTEGER EQV(4,5)
  99. X      EQUIVALENCE (VILLNS, EQV)
  100. $ CALL UNPACK [.SRC]VILLIANS.LIB;1 1412245821
  101. $ create 'f'
  102. XC TROLLP-       TROLL FUNCTION
  103. XC
  104. XC COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
  105. XC ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
  106. XC WRITTEN BY R. M. SUPNIK
  107. XC
  108. XC DECLARATIONS
  109. XC
  110. X      LOGICAL FUNCTION TROLLP(ARG)
  111. X      IMPLICIT INTEGER (A-Z)
  112. X      LOGICAL QHERE,PROB
  113. X
  114. X      INCLUDE 'PARSER.LIB'
  115. X      INCLUDE 'GAMESTATE.LIB'
  116. X      INCLUDE 'OBJECTS.LIB'
  117. X      INCLUDE 'OFLAGS.LIB'
  118. X      INCLUDE 'OINDEX.LIB'
  119. X      INCLUDE 'VERBS.LIB'
  120. X      INCLUDE 'FLAGS.LIB'
  121. X`0C
  122. XC TROLLP, PAGE 2
  123. XC
  124. X      TROLLP=.TRUE.
  125. XC                                               !ASSUME WINS.
  126. X      IF(PRSA.NE.FIGHTW) GO TO 1100
  127. XC                                               !FIGHT?
  128. X      IF(OCAN(AXE).EQ.TROLL) GO TO 10
  129. XC                                               !GOT AXE?  NOTHING.
  130. X      I=433
  131. XC                                               !ASSUME CANT GET.
  132. X      IF(.NOT.QHERE(AXE,HERE)) GO TO 1050
  133. XC                                               !HERE?
  134. X      I=434
  135. XC                                               !YES, RECOVER.
  136. X      CALL NEWSTA(AXE,0,0,TROLL,0)
  137. X1050  IF(QHERE(TROLL,HERE)) CALL RSPEAK(I)
  138. XC                                               !IF PLAYER HERE.
  139. X      RETURN
  140. XC
  141. X1100  IF(PRSA.NE.DEADXW) GO TO 1200
  142. XC                                               !DEAD?
  143. X      TROLLF=.TRUE.
  144. XC                                               !PERMIT EXITS.
  145. X      RETURN
  146. XC
  147. X1200  IF(PRSA.NE.OUTXW) GO TO 1300
  148. XC                                               !OUT?
  149. X      TROLLF=.TRUE.
  150. XC                                               !PERMIT EXITS.
  151. X      OFLAG1(AXE)=and(OFLAG1(AXE), not(VISIBT))
  152. X      ODESC1(TROLL)=435
  153. XC                                               !TROLL OUT.
  154. X      RETURN
  155. XC
  156. X1300  IF(PRSA.NE.INXW) GO TO 1400
  157. XC                                               !WAKE UP?
  158. X      TROLLF=.FALSE.
  159. XC                                               !FORBID EXITS.
  160. X      OFLAG1(AXE)=or(OFLAG1(AXE),VISIBT)
  161. X      ODESC1(TROLL)=436
  162. XC                                               !TROLL IN.
  163. X      IF(QHERE(TROLL,HERE)) CALL RSPEAK(437)
  164. X      RETURN
  165. XC
  166. X1400  IF(PRSA.NE.FRSTQW) GO TO 1500
  167. XC                                               !FIRST ENCOUNTER?
  168. X      TROLLP=PROB(33,66)
  169. XC                                               !33% TRUE UNLESS BADLK.
  170. X      RETURN
  171. XC
  172. X1500  IF((PRSA.NE.MOVEW).AND.(PRSA.NE.TAKEW).AND.(PRSA.NE.MUNGW)
  173. X     &   .AND.(PRSA.NE.THROWW).AND.(PRSA.NE.GIVEW)) GO TO 2000
  174. X      IF(OCAPAC(TROLL).GE.0) GO TO 1550
  175. XC                                               !TROLL OUT?
  176. X      OCAPAC(TROLL)=-OCAPAC(TROLL)
  177. XC                                               !YES, WAKE HIM.
  178. X      OFLAG1(AXE)=or(OFLAG1(AXE),VISIBT)
  179. X      TROLLF=.FALSE.
  180. X      ODESC1(TROLL)=436
  181. X      CALL RSPEAK(437)
  182. XC
  183. X1550  IF((PRSA.NE.TAKEW).AND.(PRSA.NE.MOVEW)) GO TO 1600
  184. X      CALL RSPEAK(438)
  185. XC                                               !JOKE.
  186. X      RETURN
  187. XC
  188. X1600  IF(PRSA.NE.MUNGW) GO TO 1700
  189. XC                                               !MUNG?
  190. X      CALL RSPEAK(439)
  191. XC                                               !JOKE.
  192. X      RETURN
  193. XC
  194. X1700  IF(PRSO.EQ.0) GO TO 10
  195. XC                                               !NO OBJECT?
  196. X      I=440
  197. XC                                               !ASSUME THROW.
  198. X      IF(PRSA.EQ.GIVEW) I=441
  199. XC                                               !GIVE?
  200. X      CALL RSPSUB(I,ODESC2(PRSO))
  201. XC                                               !TROLL TAKES.
  202. X      IF(PRSO.EQ.KNIFE) GO TO 1900
  203. XC                                               !OBJ KNIFE?
  204. X      CALL NEWSTA(PRSO,442,0,0,0)
  205. XC                                               !NO, EATS IT.
  206. X      RETURN
  207. XC
  208. X1900  CALL RSPEAK(443)
  209. XC                                               !KNIFE, THROWS IT BACK
  210. X      OFLAG2(TROLL)=or(OFLAG2(TROLL),FITEBT)
  211. X      RETURN
  212. XC
  213. X2000  IF(.NOT.TROLLF.OR.(PRSA.NE.HELLOW)) GO TO 10
  214. X      CALL RSPEAK(366)
  215. XC                                               !TROLL OUT.
  216. X      RETURN
  217. XC
  218. X10    TROLLP=.FALSE.
  219. XC                                               !COULDNT HANDLE IT.
  220. X      RETURN
  221. X      END
  222. X`0C
  223. XC CYCLOP-       CYCLOPS FUNCTION
  224. XC
  225. XC DECLARATIONS
  226. XC
  227. X      LOGICAL FUNCTION CYCLOP(ARG)
  228. X      IMPLICIT INTEGER (A-Z)
  229. X
  230. X      INCLUDE 'PARSER.LIB'
  231. X      INCLUDE 'GAMESTATE.LIB'
  232. X      INCLUDE 'OBJECTS.LIB'
  233. X      INCLUDE 'OFLAGS.LIB'
  234. X      INCLUDE 'OINDEX.LIB'
  235. X      INCLUDE 'VERBS.LIB'
  236. X      INCLUDE 'FLAGS.LIB'
  237. X`0C
  238. XC CYCLOP, PAGE 2
  239. XC
  240. X      CYCLOP=.TRUE.
  241. XC                                               !ASSUME WINS.
  242. X      IF(.NOT.CYCLOF) GO TO 100
  243. XC                                               !ASLEEP?
  244. X      IF((PRSA.NE.ALARMW).AND.(PRSA.NE.MUNGW).AND.(PRSA.NE.HELLOW).AND.
  245. X     &   (PRSA.NE.BURNW).AND.(PRSA.NE.KILLW).AND.(PRSA.NE.ATTACW))
  246. X     &  GO TO 10
  247. X      CYCLOF=.FALSE.
  248. XC                                               !WAKE CYCLOPS.
  249. X      CALL RSPEAK(187)
  250. XC                                               !DESCRIBE.
  251. X      RVCYC=IABS(RVCYC)
  252. X      OFLAG2(CYCLO)=and(or(OFLAG2(CYCLO),FITEBT),not(SLEPBT))
  253. X      RETURN
  254. XC
  255. X100   IF((PRSA.EQ.FIGHTW).OR.(PRSA.EQ.FRSTQW)) GO TO 10
  256. X      IF(IABS(RVCYC).LE.5) GO TO 200
  257. XC                                               !ANNOYED TOO MUCH?
  258. X      RVCYC=0
  259. XC                                               !RESTART COUNT.
  260. X      CALL JIGSUP(188)
  261. XC                                               !YES, EATS PLAYER.
  262. X      RETURN
  263. XC
  264. X200   IF(PRSA.NE.GIVEW) GO TO 500
  265. XC                                               !GIVE?
  266. X      IF((PRSO.NE.FOOD).OR.(RVCYC.LT.0)) GO TO 300
  267. XC                                               !FOOD WHEN HUNGRY?
  268. X      CALL NEWSTA(FOOD,189,0,0,0)
  269. XC                                               !EATS PEPPERS.
  270. X      RVCYC=MIN0(-1,-RVCYC)
  271. XC                                               !GETS THIRSTY.
  272. X      RETURN
  273. XC
  274. X300   IF(PRSO.NE.WATER) GO TO 400
  275. XC                                               !DRINK WHEN THIRSTY?
  276. X      IF(RVCYC.GE.0) GO TO 350
  277. X      CALL NEWSTA(PRSO,190,0,0,0)
  278. XC                                               !DRINKS AND
  279. X      CYCLOF=.TRUE.
  280. XC                                               !FALLS ASLEEP.
  281. X      OFLAG2(CYCLO)=and(or(OFLAG2(CYCLO),SLEPBT),not(FITEBT))
  282. X      RETURN
  283. XC
  284. X350   CALL RSPEAK(191)
  285. XC                                               !NOT THIRSTY.
  286. X10    CYCLOP=.FALSE.
  287. XC                                               !FAILS.
  288. X      RETURN
  289. XC
  290. X400   I=192
  291. XC                                               !ASSUME INEDIBLE.
  292. X      IF(PRSO.EQ.GARLI) I=193
  293. XC                                               !GARLIC IS JOKE.
  294. X450   CALL RSPEAK(I)
  295. XC                                               !DISDAIN IT.
  296. X      IF(RVCYC.LT.0) RVCYC=RVCYC-1
  297. X      IF(RVCYC.GE.0) RVCYC=RVCYC+1
  298. X      IF(.NOT.CYCLOF) CALL RSPEAK(193+IABS(RVCYC))
  299. X      RETURN
  300. XC
  301. X500   I=0
  302. XC                                               !ASSUME NOT HANDLED.
  303. X      IF(PRSA.EQ.HELLOW) GO TO 450
  304. XC                                               !HELLO IS NO GO.
  305. X      IF((PRSA.EQ.THROWW).OR.(PRSA.EQ.MUNGW)) I=200+RND(2)
  306. X      IF(PRSA.EQ.TAKEW) I=202
  307. X      IF(PRSA.EQ.TIEW) I=203
  308. X      IF(I) 10,10,450
  309. XC                                               !SEE IF HANDLED.
  310. XC
  311. X      END
  312. X`0C
  313. XC THIEFP-       THIEF FUNCTION
  314. XC
  315. XC DECLARATIONS
  316. XC
  317. X      LOGICAL FUNCTION THIEFP(ARG)
  318. X      IMPLICIT INTEGER (A-Z)
  319. X      LOGICAL QHERE,PROB
  320. X
  321. X      INCLUDE 'PARSER.LIB'
  322. X      INCLUDE 'GAMESTATE.LIB'
  323. XC
  324. XC ROOMS
  325. X      INCLUDE 'RINDEX.LIB'
  326. X      INCLUDE 'OBJECTS.LIB'
  327. X      INCLUDE 'OFLAGS.LIB'
  328. X      INCLUDE 'OINDEX.LIB'
  329. X      INCLUDE 'CLOCK.LIB'
  330. X
  331. X      INCLUDE 'VILLIANS.LIB'
  332. X      INCLUDE 'VERBS.LIB'
  333. X      INCLUDE 'FLAGS.LIB'
  334. X`0C
  335. XC THIEFP, PAGE 2
  336. XC
  337. X      THIEFP=.TRUE.
  338. XC                                               !ASSUME WINS.
  339. X      IF(PRSA.NE.FIGHTW) GO TO 100
  340. XC                                               !FIGHT?
  341. X      IF(OCAN(STILL).EQ.THIEF) GO TO 10
  342. XC                                               !GOT STILLETTO?  F.
  343. X      IF(QHERE(STILL,THFPOS)) GO TO 50
  344. XC                                               !CAN HE RECOVER IT?
  345. X      CALL NEWSTA(THIEF,0,0,0,0)
  346. XC                                               !NO, VANISH.
  347. X      IF(QHERE(THIEF,HERE)) CALL RSPEAK(498)
  348. XC                                               !IF HERO, TELL.
  349. X      RETURN
  350. XC
  351. X50    CALL NEWSTA(STILL,0,0,THIEF,0)
  352. XC                                               !YES, RECOVER.
  353. X      IF(QHERE(THIEF,HERE)) CALL RSPEAK(499)
  354. XC                                               !IF HERO, TELL.
  355. X      RETURN
  356. XC
  357. X100   IF(PRSA.NE.DEADXW) GO TO 200
  358. XC                                               !DEAD?
  359. X      THFACT=.FALSE.
  360. XC                                               !DISABLE DEMON.
  361. X      OFLAG1(CHALI)=or(OFLAG1(CHALI),TAKEBT)
  362. X      J=0
  363. X      DO 125 I=1,OLNT
  364. XC                                               !CARRYING ANYTHING?
  365. X125     IF(OADV(I).EQ.-THIEF) J=500
  366. X      CALL RSPEAK(J)
  367. XC                                               !TELL IF BOOTY REAPPEARS.
  368. XC
  369. X      J=501
  370. X      DO 150 I=1,OLNT
  371. XC                                               !LOOP.
  372. X        IF((I.EQ.CHALI).OR.(I.EQ.THIEF).OR.(HERE.NE.TREAS)
  373. X     &      .OR. .NOT.QHERE(I,HERE)) GO TO 135
  374. X        OFLAG1(I)=or(OFLAG1(I),VISIBT)
  375. X        CALL RSPSUB(J,ODESC2(I))
  376. XC                                               !DESCRIBE.
  377. X        J=502
  378. X        GO TO 150
  379. XC
  380. X135     IF(OADV(I).EQ.-THIEF) CALL NEWSTA(I,0,HERE,0,0)
  381. X150   CONTINUE
  382. X      RETURN
  383. XC
  384. X200   IF(PRSA.NE.FRSTQW) GO TO 250
  385. XC                                               !FIRST ENCOUNTER?
  386. X      THIEFP=PROB(20,75)
  387. X      RETURN
  388. XC
  389. X250   IF((PRSA.NE.HELLOW).OR.(ODESC1(THIEF).NE.504))
  390. X     &  GO TO 300
  391. X      CALL RSPEAK(626)
  392. X      RETURN
  393. XC
  394. X300   IF(PRSA.NE.OUTXW) GO TO 400
  395. XC                                               !OUT?
  396. X      THFACT=.FALSE.
  397. XC                                               !DISABLE DEMON.
  398. X      ODESC1(THIEF)=504
  399. XC                                               !CHANGE DESCRIPTION.
  400. X      OFLAG1(STILL)=and(OFLAG1(STILL),not(VISIBT))
  401. X      OFLAG1(CHALI)=or(OFLAG1(CHALI),TAKEBT)
  402. X      RETURN
  403. XC
  404. X400   IF(PRSA.NE.INXW) GO TO 500
  405. XC                                               !IN?
  406. X      IF(QHERE(THIEF,HERE)) CALL RSPEAK(505)
  407. XC                                               !CAN HERO SEE?
  408. X      THFACT=.TRUE.
  409. XC                                               !ENABLE DEMON.
  410. X      ODESC1(THIEF)=503
  411. XC                                               !CHANGE DESCRIPTION.
  412. X      OFLAG1(STILL)=or(OFLAG1(STILL),VISIBT)
  413. X      IF((HERE.EQ.TREAS).AND.QHERE(CHALI,HERE))
  414. X     &  OFLAG1(CHALI)=and(OFLAG1(CHALI),not(TAKEBT))
  415. X      RETURN
  416. XC
  417. X500   IF(PRSA.NE.TAKEW) GO TO 600
  418. XC                                               !TAKE?
  419. X      CALL RSPEAK(506)
  420. XC                                               !JOKE.
  421. X      RETURN
  422. XC
  423. X600   IF((PRSA.NE.THROWW).OR.(PRSO.NE.KNIFE).OR.
  424. X     &   (and(OFLAG2(THIEF),FITEBT).NE.0)) GO TO 700
  425. X      IF(PROB(10)) GO TO 650
  426. XC                                               !THREW KNIFE, 10%?
  427. X      CALL RSPEAK(507)
  428. XC                                               !NO, JUST MAKES
  429. X      OFLAG2(THIEF)=or(OFLAG2(THIEF),FITEBT)
  430. X      RETURN
  431. XC
  432. X650   J=508
  433. XC                                               !THIEF DROPS STUFF.
  434. X      DO 675 I=1,OLNT
  435. X        IF(OADV(I).NE.-THIEF) GO TO 675
  436. XC                                               !THIEF CARRYING?
  437. X        J=509
  438. X        CALL NEWSTA(I,0,HERE,0,0)
  439. X675   CONTINUE
  440. X      CALL NEWSTA(THIEF,J,0,0,0)
  441. XC                                               !THIEF VANISHES.
  442. X      RETURN
  443. XC
  444. X700   IF(((PRSA.NE.THROWW).AND.(PRSA.NE.GIVEW)).OR.(PRSO.EQ.0).OR.
  445. X     &   (PRSO.EQ.THIEF)) GO TO 10
  446. X      IF(OCAPAC(THIEF).GE.0) GO TO 750
  447. XC                                               !WAKE HIM UP.
  448. X      OCAPAC(THIEF)=-OCAPAC(THIEF)
  449. X      THFACT=.TRUE.
  450. X      OFLAG1(STILL)=or(OFLAG1(STILL),VISIBT)
  451. X      ODESC1(THIEF)=503
  452. X      CALL RSPEAK(510)
  453. XC
  454. X750   IF((PRSO.NE.BRICK).OR.(OCAN(FUSE).NE.BRICK).OR.
  455. X     &   (CTICK(CEVFUS).EQ.0)) GO TO 800
  456. X      CALL RSPEAK(511)
  457. XC                                               !THIEF REFUSES BOMB.
  458. X      RETURN
  459. XC
  460. X800   CALL NEWSTA(PRSO,0,0,0,-THIEF)
  461. XC                                               !THIEF TAKES GIFT.
  462. X      IF(OTVAL(PRSO).GT.0) GO TO 900
  463. XC                                               !A TREASURE?
  464. X      CALL RSPSUB(512,ODESC2(PRSO))
  465. X      RETURN
  466. XC
  467. X900   CALL RSPSUB(627,ODESC2(PRSO))
  468. XC                                               !THIEF ENGROSSED.
  469. X      THFENF=.TRUE.
  470. X      RETURN
  471. XC
  472. X10    THIEFP=.FALSE.
  473. X      RETURN
  474. X      END
  475. $ CALL UNPACK [.SRC]VILLNS.FOR;1 53218733
  476. $ create 'f'
  477. X      INTEGER FUNCTION AND (I1, I2)
  478. X      IMPLICIT INTEGER (A-Z)
  479. X      AND = IAND (I1, I2)
  480. X      RETURN
  481. X      END
  482. X`0C
  483. X      SUBROUTINE INIRND (VAL)
  484. X      IMPLICIT INTEGER (A-Z)
  485. X      INCLUDE 'RANDOM.LIB'
  486. X      SEED = VAL
  487. X      RETURN
  488. X      END
  489. X`0C
  490. X      SUBROUTINE ITIME (IH, IM, IS)
  491. X      INTEGER IH, IM, IS
  492. X      CHARACTER*8 T
  493. X
  494. X      CALL TIME (T)
  495. X
  496. X      IH = (ICHAR(T(1:1)) - ICHAR('0')) * 10
  497. X      IH = IH + (ICHAR(T(2:2)) - ICHAR('0'))
  498. X
  499. X      IM = (ICHAR(T(4:4)) - ICHAR('0')) * 10
  500. X      IM = IM + (ICHAR(T(5:5)) - ICHAR('0'))
  501. X
  502. X      IS = (ICHAR(T(7:7)) - ICHAR('0')) * 10
  503. X      IS = IS + (ICHAR(T(8:8)) - ICHAR('0'))
  504. X
  505. X      RETURN
  506. X      END
  507. X`0C
  508. X      SUBROUTINE GETUSER (USERID)`20
  509. X
  510. X      INTEGER*4 ITMLST(4)
  511. X      INTEGER*4 USERID_LEN
  512. X      EXTERNAL JPI$_USERNAME
  513. X      CHARACTER*12 USERID
  514. X
  515. X      ITMLST(1)=JISHFT(%LOC(JPI$_USERNAME),16)+12
  516. X      ITMLST(2)=%LOC(USERID)
  517. X      ITMLST(3)=%LOC(USERID_LEN)
  518. X      ITMLST(4)=0
  519. X      CALL SYS$GETJPI(,,,ITMLST,,,)
  520. X      RETURN
  521. X      END
  522. X`0C
  523. X      INTEGER FUNCTION RND (RANGE)
  524. X      IMPLICIT INTEGER (A-Z)
  525. X      INCLUDE 'RANDOM.LIB'
  526. X      RND = (RAN(SEED) * RANGE)
  527. X      RETURN
  528. X      END
  529. X`0C
  530. X      INTEGER FUNCTION OR (I1, I2)
  531. X      IMPLICIT INTEGER (A-Z)
  532. X      OR = IOR (I1, I2)
  533. X      RETURN
  534. X      END
  535. X`0C
  536. X      SUBROUTINE SYSTEM (S)
  537. X      CHARACTER*(*) S
  538. X      IF (S .EQ. ' ')  THEN
  539. X        CALL LIB$SPAWN
  540. X      ELSE
  541. X        CALL LIB$SPAWN(%DESCR(S))
  542. X      ENDIF
  543. X      RETURN
  544. X      END
  545. $ CALL UNPACK [.SRC]VMSSUBS.FOR;1 1734811703
  546. $ create 'f'
  547. XC
  548. XC VOCABULARIES
  549. XC
  550. X      COMMON /BUZVOC/ BVOC(20)
  551. X      COMMON /PRPVOC/ PVOC(45)
  552. X      COMMON /DIRVOC/ DVOC(75)
  553. X      INTEGER AVOC(450)
  554. X      COMMON /ADJVOC/ AVOC1(184),AVOC2(114),AVOC3(106),AVOCND
  555. X      INTEGER VVOC(950)
  556. X      COMMON /VRBVOC/ VVOC1(92),VVOC1A(108),VVOC1B(38),VVOC2(104),
  557. X     &`09`09VVOC3(136),
  558. X     &`09`09VVOC4(116),VVOC5(134),VVOC6(117),VVOC7(89),VVOCND
  559. X      INTEGER OVOC(1050)
  560. X      COMMON /OBJVOC/ OVOC1(160),OVOC2(144),OVOC3(150),OVOC4(128),
  561. X     &`09`09OVOC5(111),OVOC6(104),OVOC6A(97),OVOC7(127),OVOCND
  562. XC
  563. X      EQUIVALENCE (VVOC(1),VVOC1(1))
  564. X      EQUIVALENCE (AVOC(1),AVOC1(1))
  565. X      EQUIVALENCE (OVOC(1),OVOC1(1))
  566. $ CALL UNPACK [.SRC]VOCAB.LIB;1 877398334
  567. $ create 'f'
  568. X      LOGICAL FUNCTION WIZARD ()
  569. X      IMPLICIT INTEGER (A-Z)
  570. X      INCLUDE 'WIZARD.LIB'
  571. X      WIZARD = .FALSE.
  572. X      CALL GETUSER (USERID)
  573. X      DO 10, I = 1,WIZCNT
  574. X        IF (USERID .EQ. WIZARDS(I)) WIZARD = .TRUE.
  575. X   10 CONTINUE
  576. X      IF (WIZARD) PRINT 1000
  577. X      RETURN
  578. X 1000 FORMAT (' Welcome, Wizard...')
  579. X      END
  580. $ CALL UNPACK [.SRC]WIZARD.FOR;1 387794534
  581. $ create 'f'
  582. X      PARAMETER WIZCNT=12
  583. X      CHARACTER*12 WIZARDS (12)
  584. X      CHARACTER*12 USERID
  585. X      DATA WIZARDS /
  586. X     &             'CTS',`20
  587. X     &             'CMS',`20
  588. X     &             'CSMITH',
  589. X     &             ' ',
  590. X     &             ' ',
  591. X     &             ' ',
  592. X     &             ' ',
  593. X     &             ' ',
  594. X     &             ' ',
  595. X     &             ' ',
  596. X     &             ' ',
  597. X     &             ' ' /
  598. X`20
  599. $ CALL UNPACK [.SRC]WIZARD.LIB;1 1179923881
  600. $ create 'f'
  601. X`09.TITLE`09XOR`20
  602. X`09.IDENT`09/01/
  603. X`09.ENTRY`09XOR,`5EM<R2,R3>
  604. X
  605. X`09MOVL`09@4(AP),R2
  606. X`09MOVL`09@8(AP),R3
  607. X`09XORL3`09R2,R3,R0
  608. X`09RET
  609. X`09.END
  610. $ CALL UNPACK [.SRC]XOR.MAR;1 760941579
  611. $ create 'f'
  612. XC
  613. X      COMMON /XPARS/ XRMASK,XDMASK,XFMASK,XFSHFT,XASHFT,
  614. X     &`09`09XELNT(4),XNORM,XNO,XCOND,XDOOR,XLFLAG
  615. $ CALL UNPACK [.SRC]XPARS.LIB;1 190853558
  616. $ create 'f'
  617. XC
  618. X      COMMON /XSRCH/ XMIN,XMAX,XDOWN,XUP,
  619. X     &`09`09XNORTH,XSOUTH,XENTER,XEXIT,XEAST,XWEST
  620. $ CALL UNPACK [.SRC]XSRCH.LIB;1 1852324057
  621. $ v=f$verify(v)
  622. $ EXIT
  623.