home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1994 March / Source_Code_CD-ROM_Walnut_Creek_March_1994.iso / compsrcs / games / vmsnet / dungeon / part23 < prev    next >
Encoding:
Internet Message Format  |  1992-02-23  |  47.3 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 23/30
  5. Message-ID: <1992Feb24.013437.816@dragon.com>
  6. Date: 24 Feb 92 06:34:37 GMT
  7. Organization: Computer Projects Unlimited
  8. Lines: 1508
  9.  
  10. -+-+-+-+-+-+-+-+ START OF PART 23 -+-+-+-+-+-+-+-+
  11. X      DATA RVECTR/0,0,0,0,5,5,1,1,2,2,2,2,
  12. X     &          0,0,0,0,0,5,5,3,3,1,
  13. X     &          0,0,0,5,5,3,3,3,1,2,2,2,
  14. X     &          0,0,0,0,0,5,5,3,3,4,4,
  15. X     &          0,0,0,5,5,3,3,3,4,4,4,
  16. X     &          0,5,5,3,3,3,3,4,4,4/
  17. X      DATA RSTATE/5000,3005,3008,4011,3015,3018,1021,0,0,
  18. X     &          5022,3027,3030,4033,3037,3040,1043,0,0,
  19. X     &          4044,2048,4050,4054,5058,4063,4067,3071,1074,
  20. X     &          4075,1079,4080,4084,4088,4092,4096,4100,1104,
  21. X     &          4105,2109,4111,4115,4119,4123,4127,3131,3134/
  22. X`0C
  23. XC BLOW, PAGE 3
  24. XC
  25. X      RA=OACTIO(V)
  26. XC                                               !GET VILLAIN ACTION,
  27. X      DV=ODESC2(V)
  28. XC                                               !DESCRIPTION.
  29. X      BLOW=RMISS
  30. XC                                               !ASSUME NO RESULT.
  31. X      IF(DFLAG) PRINT 10,H,V,RMK,HFLG,OUT
  32. X10    FORMAT(' BLOW 10-- ',3I7,L7,I7)
  33. X      IF(.NOT.HFLG) GO TO 1000
  34. XC                                               !HERO STRIKING BLOW?
  35. XC
  36. XC HERO IS ATTACKER, VILLAIN IS DEFENDER.
  37. XC
  38. X      PBLOSE=10
  39. XC                                               !BAD LK PROB.
  40. X      OFLAG2(V)=or(OFLAG2(V),FITEBT)
  41. X      IF(and(AFLAG(H),ASTAG).EQ.0) GO TO 100
  42. X      CALL RSPEAK(591)
  43. XC                                               !YES, CANT FIGHT.
  44. X      AFLAG(H)=and(AFLAG(H), not(ASTAG))
  45. X      RETURN
  46. XC
  47. X100   ATT=FIGHTS(H,.TRUE.)
  48. XC                                               !GET HIS STRENGTH.
  49. X      OA=ATT
  50. X      DEF=VILSTR(V)
  51. XC                                               !GET VILL STRENGTH.
  52. X      OD=DEF
  53. X      DWEAP=0
  54. XC                                               !ASSUME NO WEAPON.
  55. X      DO 200 I=1,OLNT
  56. XC                                               !SEARCH VILLAIN.
  57. X        IF((OCAN(I).EQ.V).AND.(and(OFLAG2(I),WEAPBT).NE.0))
  58. X     &          DWEAP=I
  59. X200   CONTINUE
  60. X      IF(V.EQ.AOBJ(PLAYER)) GO TO 300
  61. XC                                               !KILLING SELF?
  62. X      IF(DEF.NE.0) GO TO 2000
  63. XC                                               !DEFENDER ALIVE?
  64. X      CALL RSPSUB(592,DV)
  65. XC                                               !VILLAIN DEAD.
  66. X      RETURN
  67. XC
  68. X300   CALL JIGSUP(593)
  69. XC                                               !KILLING SELF.
  70. X      RETURN
  71. XC
  72. XC VILLAIN IS ATTACKER, HERO IS DEFENDER.
  73. XC
  74. X1000  PBLOSE=50
  75. XC                                               !BAD LK PROB.
  76. X      AFLAG(H)=and(AFLAG(H),not(ASTAG))
  77. X      IF(and(OFLAG2(V),STAGBT).EQ.0) GO TO 1200
  78. X      OFLAG2(V)=and(OFLAG2(V), not(STAGBT))
  79. X      CALL RSPSUB(594,DV)
  80. XC                                               !DESCRIBE.
  81. X      RETURN
  82. XC
  83. X1200  ATT=VILSTR(V)
  84. XC                                               !SET UP ATT, DEF.
  85. X      OA=ATT
  86. X      DEF=FIGHTS(H,.TRUE.)
  87. X      IF(DEF.LE.0) RETURN
  88. XC                                               !DONT ALLOW DEAD DEF.
  89. X      OD=FIGHTS(H,.FALSE.)
  90. X      DWEAP=IABS(FWIM(0,WEAPBT,0,0,H,.TRUE.))
  91. XC                                               !FIND A WEAPON.
  92. X`0C
  93. XC BLOW, PAGE 4
  94. XC
  95. XC PARTIES ARE NOW EQUIPPED.  DEF CANNOT BE ZERO.
  96. XC ATT MUST BE > 0.
  97. XC
  98. X2000  CONTINUE
  99. X      IF(DFLAG) PRINT 2050,ATT,OA,DEF,OD,DWEAP
  100. X2050  FORMAT(' BLOW 2050-- ',5I7)
  101. X      IF(DEF.GT.0) GO TO 2100
  102. XC                                               !DEF ALIVE?
  103. X      RES=RKILL
  104. X      IF(HFLG) CALL RSPSUB(595,DV)
  105. XC                                               !DEADER.
  106. X      GO TO 3000
  107. XC
  108. X2100  IF(DEF-2) 2200,2300,2400
  109. XC                                               !DEF <2,=2,>2
  110. X2200  ATT=MIN0(ATT,3)
  111. XC                                               !SCALE ATT.
  112. X      TBL=DEF1R(ATT)
  113. XC                                               !CHOOSE TABLE.
  114. X      GO TO 2500
  115. XC
  116. X2300  ATT=MIN0(ATT,4)
  117. XC                                               !SCALE ATT.
  118. X      TBL=DEF2R(ATT)
  119. XC                                               !CHOOSE TABLE.
  120. X      GO TO 2500
  121. XC
  122. X2400  ATT=ATT-DEF
  123. XC                                               !SCALE ATT.
  124. X      ATT=MIN0(2,MAX0(-2,ATT))+3
  125. X      TBL=DEF3R(ATT)
  126. XC
  127. X2500  RES=RVECTR(TBL+RND(10))
  128. XC                                               !GET RESULT.
  129. X      IF(OUT.EQ.0) GO TO 2600
  130. XC                                               !WAS HE OUT?
  131. X      IF(RES.EQ.RSTAG) GO TO 2550
  132. XC                                               !YES, STAG--> HES.
  133. X      RES=RSIT
  134. XC                                               !OTHERWISE, SITTING.
  135. X      GO TO 2600
  136. X2550  RES=RHES
  137. X2600  IF((RES.EQ.RSTAG).AND.(DWEAP.NE.0).AND.PROB(25,PBLOSE))
  138. X     &  RES=RLOSE
  139. XC
  140. X      MI=RSTATE(((RMK-1)*9)+RES+1)
  141. XC                                               !CHOOSE TABLE ENTRY.
  142. X      IF(MI.EQ.0) GO TO 3000
  143. X      I=(MOD(MI,1000)+RND(MI/1000))+MBASE+1
  144. X      J=DV
  145. X      IF(.NOT.HFLG .AND.(DWEAP.NE.0)) J=ODESC2(DWEAP)
  146. X      IF(DFLAG) PRINT 2650,RES,MI,I,J,MBASE
  147. X2650  FORMAT(' BLOW 2650-- ',5I7)
  148. X      CALL RSPSUB(I,J)
  149. XC                                               !PRESENT RESULT.
  150. X`0C
  151. XC BLOW, PAGE 5
  152. XC
  153. XC NOW APPLY RESULT
  154. XC
  155. X3000  GO TO (4000,3100,3200,3300,3400,3500,3600,4000,3200),RES+1
  156. XC
  157. X3100  IF(HFLG) DEF=-DEF
  158. XC                                               !UNCONSCIOUS.
  159. X      GO TO 4000
  160. XC
  161. X3200  DEF=0
  162. XC                                               !KILLED OR SITTING DUCK.
  163. X      GO TO 4000
  164. XC
  165. X3300  DEF=MAX0(0,DEF-1)
  166. XC                                               !LIGHT WOUND.
  167. X      GO TO 4000
  168. XC
  169. X3400  DEF=MAX0(0,DEF-2)
  170. XC                                               !SERIOUS WOUND.
  171. X      GO TO 4000
  172. XC
  173. X3500  IF(HFLG) GO TO 3550
  174. XC                                               !STAGGERED.
  175. X      AFLAG(H)=or(AFLAG(H),ASTAG)
  176. X      GO TO 4000
  177. XC
  178. X3550  OFLAG2(V)=or(OFLAG2(V),STAGBT)
  179. X      GO TO 4000
  180. XC
  181. X3600  CALL NEWSTA(DWEAP,0,HERE,0,0)
  182. XC                                               !LOSE WEAPON.
  183. X      DWEAP=0
  184. X      IF(HFLG) GO TO 4000
  185. XC                                               !IF HERO, DONE.
  186. X      DWEAP=IABS(FWIM(0,WEAPBT,0,0,H,.TRUE.))
  187. XC                                               !GET NEW.
  188. X      IF(DWEAP.NE.0) CALL RSPSUB(605,ODESC2(DWEAP))
  189. X`0C
  190. XC BLOW, PAGE 6
  191. XC
  192. X4000  BLOW=RES
  193. XC                                               !RETURN RESULT.
  194. X      IF(.NOT.HFLG) GO TO 4500
  195. XC                                               !HERO?
  196. X      OCAPAC(V)=DEF
  197. XC                                               !STORE NEW CAPACITY.
  198. X      IF(DEF.NE.0) GO TO 4100
  199. XC                                               !DEAD?
  200. X      OFLAG2(V)=and(OFLAG2(V), not(FITEBT))
  201. X      CALL RSPSUB(572,DV)
  202. XC                                               !HE DIES.
  203. X      CALL NEWSTA(V,0,0,0,0)
  204. XC                                               !MAKE HIM DISAPPEAR.
  205. X      IF(RA.EQ.0) RETURN
  206. XC                                               !IF NX TO DO, EXIT.
  207. X      PRSA=DEADXW
  208. XC                                               !LET HIM KNOW.
  209. X      F=OAPPLI(RA,0)
  210. X      RETURN
  211. XC
  212. X4100  IF((RES.NE.ROUT).OR.(RA.EQ.0)) RETURN
  213. X      PRSA=OUTXW
  214. XC                                               !LET HIM BE OUT.
  215. X      F=OAPPLI(RA,0)
  216. X      RETURN
  217. XC
  218. X4500  ASTREN(H)=-10000
  219. XC                                               !ASSUME DEAD.
  220. X      IF(DEF.NE.0) ASTREN(H)=DEF-OD
  221. X      IF(DEF.GE.OD) GO TO 4600
  222. X      CTICK(CEVCUR)=30
  223. X      CFLAG(CEVCUR)=.TRUE.
  224. X4600  IF(FIGHTS(H,.TRUE.).GT.0) RETURN
  225. X      ASTREN(H)=1-FIGHTS(H,.FALSE.)
  226. XC                                               !HE'S DEAD.
  227. X      CALL JIGSUP(596)
  228. X      BLOW=-1
  229. X      RETURN
  230. XC
  231. X      END
  232. X`0C
  233. XC SWORDD- SWORD INTERMOVE DEMON
  234. XC
  235. XC DECLARATIONS
  236. XC
  237. X      SUBROUTINE SWORDD
  238. X      IMPLICIT INTEGER(A-Z)
  239. X      LOGICAL INFEST,FINDXT
  240. X
  241. X      INCLUDE 'GAMESTATE.LIB'
  242. X      INCLUDE 'CURXT.LIB'
  243. X      INCLUDE 'XSRCH.LIB'
  244. X      INCLUDE 'OBJECTS.LIB'
  245. X      INCLUDE 'OINDEX.LIB'
  246. X      INCLUDE 'VILLIANS.LIB'
  247. X      INCLUDE 'ADVERS.LIB'
  248. X`0C
  249. XC SWORDD, PAGE 2
  250. XC
  251. X      IF(OADV(SWORD).NE.PLAYER) GO TO 500
  252. XC                                               !HOLDING SWORD?
  253. X      NG=2
  254. XC                                               !ASSUME VILL CLOSE.
  255. X      IF(INFEST(HERE)) GO TO 300
  256. XC                                               !VILL HERE?
  257. X      NG=1
  258. X      DO 200 I=XMIN,XMAX,XMIN
  259. XC                                               !NO, SEARCH ROOMS.
  260. X        IF(.NOT.FINDXT(I,HERE)) GO TO 200
  261. XC                                               !ROOM THAT WAY?
  262. X        GO TO (50,200,50,50),XTYPE
  263. XC                                               !SEE IF ROOM AT ALL.
  264. X50      IF(INFEST(XROOM1)) GO TO 300
  265. XC                                               !CHECK ROOM.
  266. X200   CONTINUE
  267. X      NG=0
  268. XC                                               !NO GLOW.
  269. XC
  270. X300   IF(NG.EQ.SWDSTA) RETURN
  271. XC                                               !ANY STATE CHANGE?
  272. X      CALL RSPEAK(NG+495)
  273. XC                                               !YES, TELL NEW STATE.
  274. X      SWDSTA=NG
  275. X      RETURN
  276. XC
  277. X500   SWDACT=.FALSE.
  278. XC                                               !DROPPED SWORD,
  279. X      RETURN
  280. XC                                               !DISABLE DEMON.
  281. X      END
  282. X`0C
  283. XC INFEST-       SUBROUTINE TO TEST FOR INFESTED ROOM
  284. XC
  285. XC DECLARATIONS
  286. XC
  287. X      LOGICAL FUNCTION INFEST(R)
  288. X      IMPLICIT INTEGER(A-Z)
  289. XC
  290. XC ROOMS
  291. X
  292. X      INCLUDE 'RINDEX.LIB'
  293. X      INCLUDE 'OBJECTS.LIB'
  294. X      INCLUDE 'OINDEX.LIB'
  295. X      INCLUDE 'VILLIANS.LIB'
  296. X      INCLUDE 'FLAGS.LIB'
  297. XC
  298. X      IF (.NOT.ENDGMF) INFEST=(OROOM(CYCLO).EQ.R).OR.
  299. X     &                        (OROOM(TROLL).EQ.R).OR.
  300. X     &                        ((OROOM(THIEF).EQ.R).AND.THFACT)
  301. X      IF (ENDGMF) INFEST=(R.EQ.MRG).OR.(R.EQ.MRGE).OR.
  302. X     &                   (R.EQ.MRGW).OR.
  303. X     &                   ((R.EQ.INMIR).AND.(MLOC.EQ.MRG))
  304. X      RETURN
  305. X      END
  306. $ CALL UNPACK [.SRC]DEMONS.FOR;1 1414959697
  307. $ create 'f'
  308. XC GAME- MAIN COMMAND LOOP FOR DUNGEON
  309. XC
  310. XC COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
  311. XC ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
  312. XC WRITTEN BY R. M. SUPNIK
  313. XC
  314. XC DECLARATIONS
  315. XC
  316. X      SUBROUTINE GAME
  317. X      IMPLICIT INTEGER (A-Z)
  318. X      LOGICAL RMDESC,VAPPLI,RAPPLI,AAPPLI
  319. X      LOGICAL F,PARSE,FINDXT,XVEHIC,LIT
  320. X      CHARACTER SECHO(4)
  321. X      CHARACTER GDTSTR(3)
  322. X
  323. X      INCLUDE 'PARSER.LIB'
  324. X      INCLUDE 'GAMESTATE.LIB'
  325. X      INCLUDE 'STATE.LIB'
  326. X      INCLUDE 'IO.LIB'
  327. X      INCLUDE 'ROOMS.LIB'
  328. X      INCLUDE 'RINDEX.LIB'
  329. X      INCLUDE 'OBJECTS.LIB'
  330. X      INCLUDE 'OFLAGS.LIB'
  331. X      INCLUDE 'OINDEX.LIB'
  332. X      INCLUDE 'ADVERS.LIB'
  333. X      INCLUDE 'VERBS.LIB'
  334. X      INCLUDE 'FLAGS.LIB'
  335. XC
  336. XC FUNCTIONS AND DATA
  337. XC
  338. X      DATA SECHO/'E','C','H','O'/
  339. X      DATA GDTSTR/'G','D','T'/
  340. X`0C
  341. XC GAME, PAGE 2
  342. XC
  343. XC START UP, DESCRIBE CURRENT LOCATION.
  344. XC
  345. X      CALL RSPEAK(1)
  346. XC                                               !WELCOME ABOARD.
  347. X      F=RMDESC(3)
  348. XC                                               !START GAME.
  349. XC
  350. XC NOW LOOP, READING AND EXECUTING COMMANDS.
  351. XC
  352. X100   WINNER=PLAYER
  353. XC                                               !PLAYER MOVING.
  354. X      TELFLG=.FALSE.
  355. XC                                               !ASSUME NOTHING TOLD.
  356. X      IF(PRSCON.LE.1) CALL RDLINE(INBUF,INLNT,1)
  357. XC
  358. X      DO 150 I=1,3
  359. XC                                               !CALL ON GDT?
  360. X        IF(INBUF(I+PRSCON-1).NE.GDTSTR(I)) GO TO 200
  361. X150   CONTINUE
  362. X      CALL GDT
  363. XC                                               !YES, INVOKE.
  364. X      GO TO 100
  365. XC                                               !ONWARD.
  366. XC
  367. X200   MOVES=MOVES+1
  368. X      PRSWON=PARSE(INBUF,INLNT,.TRUE.)
  369. X      IF(.NOT.PRSWON) GO TO 400
  370. XC                                               !PARSE LOSES?
  371. X      IF(XVEHIC(1)) GO TO 400
  372. XC                                               !VEHICLE HANDLE?
  373. XC
  374. X      IF(PRSA.EQ.TELLW) GO TO 2000
  375. XC                                               !TELL?
  376. X300   IF((PRSO.EQ.VALUA).OR.(PRSO.EQ.EVERY)) GO TO 900
  377. X      IF(.NOT.VAPPLI(PRSA)) GO TO 400
  378. XC                                               !VERB OK?
  379. X350   IF(.NOT.ECHOF.AND.(HERE.EQ.ECHOR)) GO TO 1000
  380. X      F=RAPPLI(RACTIO(HERE))
  381. XC
  382. X400   CALL XENDMV(TELFLG)
  383. XC                                               !DO END OF MOVE.
  384. X      IF(.NOT.LIT(HERE)) PRSCON=1
  385. X      GO TO 100
  386. XC
  387. X900   CALL VALUAC(VALUA)
  388. X      GO TO 350
  389. X`0C
  390. XC GAME, PAGE 3
  391. XC
  392. XC SPECIAL CASE-- ECHO ROOM.
  393. XC IF INPUT IS NOT 'ECHO' OR A DIRECTION, JUST ECHO.
  394. XC
  395. X1000  CALL RDLINE(INBUF,INLNT,0)
  396. X      MOVES=MOVES+1
  397. XC                                               !CHARGE FOR MOVES.
  398. X      DO 1100 I=1,4
  399. XC                                               !INPUT = ECHO?
  400. X        IF(INBUF(I).NE.SECHO(I)) GO TO 1300
  401. X1100  CONTINUE
  402. XC
  403. XC   Note: the following DO loop was changed from DO 1200 I=5,78
  404. XC     The change was necessary because the RDLINE function was changed,
  405. XC      and no longer provides a 78 character buffer padded with blanks.
  406. XC
  407. X      DO 1200 I=5,INLNT
  408. X        IF(INBUF(I).NE.' ') GO TO 1300
  409. X1200  CONTINUE
  410. XC
  411. X      CALL RSPEAK(571)
  412. XC                                               !KILL THE ECHO.
  413. X      ECHOF=.TRUE.
  414. X      OFLAG2(BAR)=and(OFLAG2(BAR), not(SCRDBT))
  415. X      PRSWON=.TRUE.
  416. XC                                               !FAKE OUT PARSER.
  417. X      PRSCON=1
  418. XC                                               !FORCE NEW INPUT.
  419. X      GO TO 400
  420. XC
  421. X1300  PRSWON=PARSE(INBUF,INLNT,.FALSE.)
  422. X      IF(.NOT.PRSWON .OR. (PRSA.NE.WALKW))
  423. X     &  GO TO 1400
  424. X      IF(FINDXT(PRSO,HERE)) GO TO 300
  425. XC                                               !VALID EXIT?
  426. XC
  427. X1400  WRITE(OUTCH,1410) (INBUF(J),J=1,INLNT)
  428. X1410  FORMAT(1X,78A1)
  429. X      TELFLG=.TRUE.
  430. XC                                               !INDICATE OUTPUT.
  431. X      GO TO 1000
  432. X`0C
  433. XC                                               !MORE ECHO ROOM.
  434. XC GAME, PAGE 4
  435. XC
  436. XC SPECIAL CASE-- TELL <ACTOR>, NEW COMMAND
  437. XC NOTE THAT WE CANNOT BE IN THE ECHO ROOM.
  438. XC
  439. X2000  IF(and(OFLAG2(PRSO),ACTRBT).NE.0) GO TO 2100
  440. X      CALL RSPEAK(602)
  441. XC                                               !CANT DO IT.
  442. X      GO TO 350
  443. XC                                               !VAPPLI SUCCEEDS.
  444. XC
  445. X2100  WINNER=OACTOR(PRSO)
  446. XC                                               !NEW PLAYER.
  447. X      HERE=AROOM(WINNER)
  448. XC                                               !NEW LOCATION.
  449. X      IF(PRSCON.LE.1) GO TO 2700
  450. XC                                               !ANY INPUT?
  451. X      IF(PARSE(INBUF,INLNT,.TRUE.)) GO TO 2150
  452. X2700  I=341
  453. XC                                               !FAILS.
  454. X      IF(TELFLG) I=604
  455. XC                                               !GIVE RESPONSE.
  456. X      CALL RSPEAK(I)
  457. X2600  WINNER=PLAYER
  458. XC                                               !RESTORE STATE.
  459. X      HERE=AROOM(WINNER)
  460. X      GO TO 350
  461. XC
  462. X2150  IF(AAPPLI(AACTIO(WINNER))) GO TO 2400
  463. XC                                               !ACTOR HANDLE?
  464. X      IF(XVEHIC(1)) GO TO 2400
  465. XC                                               !VEHICLE HANDLE?
  466. X      IF((PRSO.EQ.VALUA).OR.(PRSO.EQ.EVERY)) GO TO 2900
  467. X      IF(.NOT.VAPPLI(PRSA)) GO TO 2400
  468. XC                                               !VERB HANDLE?
  469. X2350  F=RAPPLI(RACTIO(HERE))
  470. XC
  471. X2400  CALL XENDMV(TELFLG)
  472. XC                                               !DO END OF MOVE.
  473. X      GO TO 2600
  474. XC                                               !DONE.
  475. XC
  476. X2900  CALL VALUAC(VALUA)
  477. XC                                               !ALL OR VALUABLES.
  478. X      GO TO 350
  479. XC
  480. X      END
  481. X`0C
  482. XC XENDMV-       EXECUTE END OF MOVE FUNCTIONS.
  483. XC
  484. XC DECLARATIONS
  485. XC
  486. X      SUBROUTINE XENDMV(FLAG)
  487. X      IMPLICIT INTEGER(A-Z)
  488. X      LOGICAL F,CLOCKD,FLAG,XVEHIC
  489. X
  490. X      INCLUDE 'PARSER.LIB'
  491. X      INCLUDE 'VILLIANS.LIB'
  492. XC
  493. X      IF(.NOT.FLAG) CALL RSPEAK(341)
  494. XC                                               !DEFAULT REMARK.
  495. X      IF(THFACT) CALL THIEFD
  496. XC                                               !THIEF DEMON.
  497. X      IF(PRSWON) CALL FIGHTD
  498. XC                                               !FIGHT DEMON.
  499. X      IF(SWDACT) CALL SWORDD
  500. XC                                               !SWORD DEMON.
  501. X      IF(PRSWON) F=CLOCKD(X)
  502. XC                                               !CLOCK DEMON.
  503. X      IF(PRSWON) F=XVEHIC(2)
  504. XC                                               !VEHICLE READOUT.
  505. X      RETURN
  506. X      END
  507. X`0C
  508. XC XVEHIC- EXECUTE VEHICLE FUNCTION
  509. XC
  510. XC DECLARATIONS
  511. XC
  512. X      LOGICAL FUNCTION XVEHIC(N)
  513. X      IMPLICIT INTEGER(A-Z)
  514. X      LOGICAL OAPPLI
  515. X
  516. X      INCLUDE 'GAMESTATE.LIB'
  517. X      INCLUDE 'OBJECTS.LIB'
  518. X      INCLUDE 'ADVERS.LIB'
  519. XC
  520. X      XVEHIC=.FALSE.
  521. XC                                               !ASSUME LOSES.
  522. X      AV=AVEHIC(WINNER)
  523. XC                                               !GET VEHICLE.
  524. X      IF(AV.NE.0) XVEHIC=OAPPLI(OACTIO(AV),N)
  525. X      RETURN
  526. X      END
  527. $ CALL UNPACK [.SRC]DGAME.FOR;1 1347247650
  528. $ create 'f'
  529. XC INIT-- DUNGEON INITIALIZATION SUBROUTINE
  530. XC
  531. XC COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
  532. XC ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
  533. XC WRITTEN BY R. M. SUPNIK
  534. XC
  535. XC DECLARATIONS
  536. XC
  537. X      LOGICAL FUNCTION INIT(X)
  538. X      IMPLICIT INTEGER (A-Z)
  539. X      LOGICAL PROTCT
  540. X      LOGICAL WIZMODE
  541. X      INTEGER DATARR(3)
  542. X
  543. X      INCLUDE 'FILES.LIB/LIST'
  544. X      INCLUDE 'PARSER.LIB/LIST'
  545. X      INCLUDE 'GAMESTATE.LIB/LIST'
  546. X      INCLUDE 'STATE.LIB/LIST'
  547. X      INCLUDE 'SCREEN.LIB/LIST'
  548. X      INCLUDE 'MINDEX.LIB/LIST'
  549. Xc
  550. XC MISCELLANEOUS VARIABLES
  551. XC
  552. X      COMMON /STAR/ MBASE,STRBIT
  553. X      COMMON /VERS/ VMAJ,VMIN,VEDIT
  554. X      COMMON /TIME/ PLTIME,SHOUR,SMIN,SSEC
  555. X      INCLUDE 'IO.LIB/LIST'
  556. X      INCLUDE 'DEBUG.LIB/LIST'
  557. X      COMMON /HYPER/ HFACTR
  558. X      INCLUDE 'ROOMS.LIB/LIST'
  559. X      INCLUDE 'RFLAG.LIB/LIST'
  560. X      INCLUDE 'RINDEX.LIB/LIST'
  561. X      INCLUDE 'EXITS.LIB/LIST'
  562. X      INCLUDE 'CURXT.LIB/LIST'
  563. X      INCLUDE 'XPARS.LIB/LIST'
  564. X      INCLUDE 'OBJECTS.LIB/LIST'
  565. X      INCLUDE 'OINDEX.LIB/LIST'
  566. X      INCLUDE 'CLOCK.LIB/LIST'
  567. X      INCLUDE 'VILLIANS.LIB/LIST'
  568. X      INCLUDE 'ADVERS.LIB/LIST'
  569. X      INCLUDE 'FLAGS.LIB/LIST'
  570. X`0C
  571. XC INIT, PAGE 2
  572. XC
  573. XC
  574. XC FIRST CHECK FOR PROTECTION VIOLATION
  575. XC
  576. X      IF(PROTCT(X)) GO TO 10000
  577. XC                                               !PROTECTION VIOLATION?
  578. X      PRINT 10100
  579. X10100 FORMAT(' There appears before you a threatening figure clad '
  580. X     &'all over'/' in heavy black armor.  His legs seem like the '
  581. X     &'massive trunk'/' of the oak tree.  His broad shoulders and '
  582. X     &'helmeted head loom'/' high over your own puny frame, and '
  583. X     &'you realize that his powerful'/' arms could easily crush the '
  584. X     &'very life from your body.  There'/' hangs from his belt a '
  585. X     &'veritable arsenal of deadly weapons:'/' sword, mace, ball '
  586. X     &'and chain, dagger, lance, and trident.'/' He speaks with a '
  587. X     &'commanding voice:'//20X,'"You shall not pass."'//' As '
  588. X     &'he grabs you by the neck all grows dim about you.')
  589. X      CALL EXIT
  590. XC
  591. XC NOW START INITIALIZATION PROPER
  592. XC
  593. X10000 INIT=.FALSE.
  594. XC                                               !ASSUME INIT FAILS.
  595. X      MMAX=1050
  596. XC                                               !SET UP ARRAY LIMITS.
  597. X      OMAX=220
  598. X      RMAX=200
  599. X      VMAX=4
  600. X      AMAX=4
  601. X      CMAX=25
  602. X      FMAX=46
  603. X      SMAX=22
  604. X      XMAX=900
  605. X      R2MAX=20
  606. X      DIRMAX=15
  607. XC
  608. X      MLNT=0
  609. XC                                               !INIT ARRAY COUNTERS.
  610. X      OLNT=0
  611. X      RLNT=0
  612. X      VLNT=0
  613. X      ALNT=0
  614. X      CLNT=0
  615. X      XLNT=1
  616. X      R2LNT=0
  617. XC
  618. X      LTSHFT=10
  619. XC                                               !SET UP STATE VARIABLES.
  620. X      MXSCOR=LTSHFT
  621. X      EGSCOR=0
  622. X      EGMXSC=0
  623. X      MXLOAD=100
  624. X      RWSCOR=0
  625. X      DEATHS=0
  626. X      MOVES=0
  627. X      PLTIME=0
  628. X      MUNGRM=0
  629. X      HS=0
  630. X      PRSA=0
  631. XC                                               !CLEAR PARSE VECTOR.
  632. X      PRSI=0
  633. X      PRSO=0
  634. X      PRSCON=1
  635. X      OFLAG=0
  636. XC                                               !CLEAR ORPHANS.
  637. X      OACT=0
  638. X      OSLOT=0
  639. X      OPREP=0
  640. X      ONAME=0
  641. X      THFFLG=.FALSE.
  642. XC                                               !THIEF NOT INTRODUCED BUT
  643. X      THFACT=.TRUE.
  644. XC                                               !IS ACTIVE.
  645. X      SWDACT=.FALSE.
  646. XC                                               !SWORD IS INACTIVE.
  647. X      SWDSTA=0
  648. XC                                               !SWORD IS OFF.
  649. XC
  650. X      RECNO=1
  651. XC                                               !INIT DB FILE POINTER.
  652. X      MBASE=0
  653. XC                                               !INIT MELEE BASE.
  654. XC   LOGICAL UNIT NRS: 5=STDIN, 6=STDOUT
  655. X      INPCH=5
  656. XC                                               !TTY INPUT
  657. X      OUTCH=6
  658. X      DBCH=2
  659. X`0C
  660. XC                                               !DATA BASE.
  661. XC INIT, PAGE 3
  662. XC
  663. XC INIT ALL ARRAYS.
  664. XC
  665. X      DO 5 I=1,CMAX
  666. XC                                               !CLEAR CLOCK EVENTS
  667. X        CFLAG(I)=.FALSE.
  668. X        CTICK(I)=0
  669. X        CACTIO(I)=0
  670. X5     CONTINUE
  671. XC
  672. X      DO 10 I=1,FMAX
  673. XC                                               !CLEAR FLAGS.
  674. X        FLAGS(I)=.FALSE.
  675. X10    CONTINUE
  676. X      BUOYF=.TRUE.
  677. XC                                               !SOME START AS TRUE.
  678. X      EGYPTF=.TRUE.
  679. X      CAGETF=.TRUE.
  680. X      MR1F=.TRUE.
  681. X      MR2F=.TRUE.
  682. X      FOLLWF=.TRUE.
  683. X      DO 12 I=1,SMAX
  684. XC                                               !CLEAR SWITCHES.
  685. X        SWITCH(I)=0
  686. X12    CONTINUE
  687. X      ORMTCH=4
  688. XC                                               !NUMBER OF MATCHES.
  689. X      LCELL=1
  690. X      PNUMB=1
  691. X      MDIR=270
  692. X      MLOC=MRB
  693. X      CPHERE=10
  694. XC
  695. X      DO 15 I=1,R2MAX
  696. XC                                               !CLEAR ROOM 2 ARRAY.
  697. X        RROOM2(I)=0
  698. X        OROOM2(I)=0
  699. X15    CONTINUE
  700. XC
  701. X      DO 20 I=1,XMAX
  702. XC                                               !CLEAR TRAVEL ARRAY.
  703. X        TRAVEL(I)=0
  704. X20    CONTINUE
  705. XC
  706. X      DO 30 I=1,VMAX
  707. XC                                               !CLEAR VILLAINS ARRAYS.
  708. X        VOPPS(I)=0
  709. X        VPROB(I)=0
  710. X        VILLNS(I)=0
  711. X        VBEST(I)=0
  712. X        VMELEE(I)=0
  713. X30    CONTINUE
  714. XC
  715. X      DO 40 I=1,OMAX
  716. XC                                               !CLEAR OBJECT ARRAYS.
  717. X        ODESC1(I)=0
  718. X        ODESC2(I)=0
  719. X        ODESCO(I)=0
  720. X        OREAD(I)=0
  721. X        OACTIO(I)=0
  722. X        OFLAG1(I)=0
  723. X        OFLAG2(I)=0
  724. X        OFVAL(I)=0
  725. X        OTVAL(I)=0
  726. X        OSIZE(I)=0
  727. X        OCAPAC(I)=0
  728. X        OCAN(I)=0
  729. X        OADV(I)=0
  730. X        OROOM(I)=0
  731. X40    CONTINUE
  732. XC
  733. X      RDESC2=0
  734. XC                                               !CLEAR DESC BASE PTR.
  735. X      DO 50 I=1,RMAX
  736. XC                                               !CLEAR ROOM ARRAYS.
  737. X        RDESC1(I)=0
  738. X        RACTIO(I)=0
  739. X        RFLAG(I)=0
  740. X        RVAL(I)=0
  741. X        REXIT(I)=0
  742. X50    CONTINUE
  743. XC
  744. X      DO 60 I=1,MMAX
  745. XC                                               !CLEAR MESSAGE DIRECTORY.
  746. X        RTEXT(I)=0
  747. X60    CONTINUE
  748. XC
  749. X      DO 70 I=1,AMAX
  750. XC                                               !CLEAR ADVENTURER'S ARRAYS.
  751. X        AROOM(I)=0
  752. X        ASCORE(I)=0
  753. X        AVEHIC(I)=0
  754. X        AOBJ(I)=0
  755. X        AACTIO(I)=0
  756. X        ASTREN(I)=0
  757. X        AFLAG(I)=0
  758. X70    CONTINUE
  759. XC
  760. X      DBGFLG=0
  761. X      PRSFLG=0
  762. X      GDTFLG=0
  763. XC
  764. XC allow setting gdtflg true if wizard function returns true
  765. XC this way, the wizard doesn't have to recompile to use gdt
  766. XC
  767. X      WIZMODE = WIZARD()
  768. X      IF (WIZMODE) GDTFLG = 1
  769. XC
  770. X      FROMDR=0
  771. XC                                               !INIT SCOL GOODIES.
  772. X      SCOLRM=0
  773. X      SCOLAC=0
  774. X`0C
  775. XC INIT, PAGE 4
  776. XC
  777. XC NOW RESTORE FROM EXISTING INDEX FILE.
  778. XC
  779. X      call image_dir (filedir)
  780. X      OPEN(UNIT=1,file=filedir//INDXFILE,status='OLD',
  781. X     &          FORM='FORMATTED',ACCESS='SEQUENTIAL',ERR=1900)
  782. X      READ(1,130) I,J,K
  783. XC                                               !GET VERSION.
  784. X      IF((I.NE.VMAJ).OR.(J.NE.VMIN))
  785. X     &          GO TO 1925
  786. X
  787. X      OPEN(UNIT=DBCH,file=filedir//TEXTFILE,status='OLD',
  788. X     &          FORM='UNFORMATTED',ACCESS='DIRECT',
  789. X     &          ERR=1950)
  790. X
  791. X      IF (WIZMODE) PRINT 150`20
  792. X150   FORMAT(' RESTORING FROM "dindx.dat"')
  793. X      READ(1,130) MXSCOR,STRBIT,EGMXSC
  794. X      READ(1,130) RLNT,RDESC2,RDESC1,REXIT,RACTIO,RVAL,RFLAG
  795. X      READ(1,130) XLNT,TRAVEL
  796. X      READ(1,130) OLNT,ODESC1,ODESC2,ODESCO,OACTIO,OFLAG1,OFLAG2,
  797. X     &          OFVAL,OTVAL,OSIZE,OCAPAC,OROOM,OADV,OCAN,
  798. X     &          OREAD
  799. X      READ(1,130) R2LNT,OROOM2,RROOM2
  800. X      READ(1,130) CLNT,CTICK,CACTIO
  801. X      READ(1,135) CFLAG
  802. X      READ(1,130) VLNT,VILLNS,VPROB,VOPPS,VBEST,VMELEE
  803. X      READ(1,130) ALNT,AROOM,ASCORE,AVEHIC,AOBJ,AACTIO,ASTREN,AFLAG
  804. X      READ(1,130) MBASE,MLNT,RTEXT
  805. XC
  806. X      CLOSE(1)
  807. X      GO TO 1025
  808. XC                                               !INIT DONE.
  809. XC
  810. XC 130   FORMAT(I8)
  811. X130     FORMAT(I6)
  812. X135     FORMAT(L4)
  813. XC INIT, PAGE 5
  814. XC
  815. XC THE INTERNAL DATA BASE IS NOW ESTABLISHED.
  816. XC SET UP TO PLAY THE GAME.
  817. XC
  818. X1025  CALL ITIME(SHOUR,SMIN,SSEC)
  819. XC                                               !GET TIME AND DATE.
  820. X      CALL IDATE(I,J,K)
  821. X      CALL INIRND(or(I,or(J,K)),or(SHOUR,or(SMIN,SSEC)))
  822. XC
  823. X      WINNER=PLAYER
  824. X      LASTIT=AOBJ(PLAYER)
  825. X      HERE=AROOM(WINNER)
  826. X      THFPOS=OROOM(THIEF)
  827. X      BLOC=OROOM(BALLO)
  828. X      INIT=.TRUE.
  829. XC
  830. X      IF (WIZMODE) PRINT 1050,RLNT,RMAX,XLNT,XMAX,OLNT,OMAX,MLNT,MMAX,
  831. X     &    VLNT,VMAX,ALNT,AMAX,CLNT,CMAX,R2LNT,R2MAX
  832. X1050  FORMAT(' USED:'/1X,I5,' OF',I5,' ROOMS'/
  833. X     &       1X,I5,' OF',I5,' EXITS'/
  834. X     &       1X,I5,' OF',I5,' OBJECTS'/
  835. X     &       1X,I5,' OF',I5,' MESSAGES'/
  836. X     &       1X,I5,' OF',I5,' VILLAINS'/
  837. X     &       1X,I5,' OF',I5,' ADVENTURERS'/
  838. X     &       1X,I5,' OF',I5,' CLOCK EVENTS'/
  839. X     &       1X,I5,' OF',I5,' ROOM2 SLOTS')
  840. X      IF (WIZMODE) PRINT 1150,MXSCOR,EGMXSC,RECNO,RDESC2,MBASE,STRBIT
  841. X1150  FORMAT(' MAX SCORE=',I5/' EG SCORE=',I5/
  842. X     &       ' MAX RECNO=',I5/' RDESC2 BASE=',I5/
  843. X     &       ' MELEE START=',I5/' STAR MASK=',I7)
  844. X**      IF (WIZMODE) PAUSE 1
  845. XC
  846. X      RETURN
  847. XC INIT, PAGE 6
  848. XC
  849. XC ERRORS-- INIT FAILS.
  850. XC
  851. X1900  PRINT 910
  852. X      PRINT 980
  853. X      RETURN
  854. X1925  PRINT 920,I,J,K,VMAJ,VMIN,VEDIT
  855. X      PRINT 980
  856. X      RETURN
  857. X1950  PRINT 960
  858. X      PRINT 980
  859. X      RETURN
  860. X910   FORMAT(' I can''t open INDXFILE.')
  861. X920   FORMAT(' "dindx.dat" is version ',I1,'.',I1,A1,'.'/
  862. X     &       ' I require version ',I1,'.',I1,A1,'.')
  863. X960   FORMAT(' I can''t open TEXTFILE.')
  864. X980   FORMAT(' Suddenly a sinister, wraithlike figure appears before '
  865. X     &'you,'/' seeming to float in the air.  In a low, sorrowful voice'
  866. X     &' he says,'/' "Alas, the very nature of the world has changed, '
  867. X     &'and the dungeon'/' cannot be found.  All must now pass away."'
  868. X     &'  Raising his oaken staff'/' in farewell, he fades into the '
  869. X     &'spreading darkness.  In his place'/' appears a tastefully '
  870. X     &'lettered sign reading:'//23X,'INITIALIZATION FAILURE'//
  871. X     &' The darkness becomes all encompassing, and your vision fails.')
  872. XC
  873. X      END
  874. XC PROTCT-- CHECK FOR USER VIOLATION
  875. XC
  876. XC THIS ROUTINE SHOULD BE MODIFIED IF YOU WISH TO ADD SYSTEM
  877. XC DEPENDANT PROTECTION AGAINST ABUSE.
  878. XC
  879. XC AT THE MOMENT, PLAY IS PERMITTED UNDER ALL CIRCUMSTANCES.
  880. XC
  881. X      LOGICAL FUNCTION PROTCT(X)
  882. X      IMPLICIT INTEGER(A-Z)
  883. XC
  884. X      PROTCT=.TRUE.
  885. X      RETURN
  886. X      END
  887. $ CALL UNPACK [.SRC]DINIT.FOR;4 392504658
  888. $ create 'f'
  889. XC DUNGEON-- MAIN PROGRAM
  890. XC
  891. XC COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
  892. XC ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
  893. XC WRITTEN BY R. M. SUPNIK
  894. XC
  895. X      PROGRAM DUNGEON
  896. XC
  897. XC DECLARATIONS
  898. XC
  899. X      IMPLICIT INTEGER (A-Z)
  900. X      LOGICAL INIT
  901. X
  902. X      INCLUDE 'PARSER.LIB/LIST'
  903. X      INCLUDE 'GAMESTATE.LIB/LIST'
  904. X      INCLUDE 'STATE.LIB/LIST'
  905. X      INCLUDE 'SCREEN.LIB/LIST'
  906. X      INCLUDE 'PUZZLE.LIB/LIST'
  907. XC
  908. XC MISCELLANEOUS VARIABLES
  909. XC
  910. X      CHARACTER VEDIT
  911. X      COMMON /STAR/ MBASE,STRBIT
  912. X      COMMON /VERS/ VMAJ,VMIN,VEDIT
  913. X      COMMON /BATS/ BATDRP(9)
  914. X      INCLUDE 'IO.LIB/LIST'
  915. X      INCLUDE 'DEBUG.LIB/LIST'
  916. X      COMMON /HYPER/ HFACTR
  917. X      INCLUDE 'ROOMS.LIB/LIST'
  918. X      INCLUDE 'RFLAG.LIB/LIST'
  919. X      INCLUDE 'RINDEX.LIB/LIST'
  920. X      INCLUDE 'EXITS.LIB/LIST'
  921. X      INCLUDE 'CURXT.LIB/LIST'
  922. X      INCLUDE 'XPARS.LIB/LIST'
  923. X      INCLUDE 'XSRCH.LIB/LIST'
  924. X      INCLUDE 'OBJECTS.LIB/LIST'
  925. X      INCLUDE 'OFLAGS.LIB/LIST'
  926. X      INCLUDE 'OINDEX.LIB/LIST'
  927. X      INCLUDE 'CLOCK.LIB/LIST'
  928. X
  929. X      INCLUDE 'VILLIANS.LIB/LIST'
  930. X      INCLUDE 'ADVERS.LIB/LIST'
  931. X      INCLUDE 'VERBS.LIB/LIST'
  932. X      INCLUDE 'FLAGS.LIB/LIST'
  933. X
  934. X      INCLUDE 'FILES.LIB/LIST'
  935. X      INCLUDE 'MINDEX.LIB/LIST'
  936. X      INCLUDE 'RANDOM.LIB/LIST'
  937. X      INCLUDE 'VOCAB.LIB/LIST'
  938. X      INCLUDE 'WIZARD.LIB/LIST'
  939. X`0C
  940. XC DUNGEON, PAGE 2
  941. XC
  942. XC DATA STATEMENTS FOR CONSTANT ARRAYS
  943. XC
  944. X      DATA VMAJ/2/,VMIN/6/,VEDIT/'C'/
  945. XC
  946. X      DATA SDIR/'40000'O/,SIND/'20000'O/,SSTD/'10000'O/,
  947. X     &     SFLIP/'4000'O/,SDRIV/'2000'O/,SVMASK/'777'O/
  948. X      DATA VABIT/'40000'O/,VRBIT/'20000'O/,VTBIT/'10000'O/,
  949. X     &     VCBIT/'4000'O/,VEBIT/'2000'O/,VFBIT/'1000'O/,
  950. X     &     VPMASK/'777'O/
  951. XC
  952. X      DATA BATDRP/66,67,68,69,70,71,72,65,73/
  953. XC
  954. X      DATA SCOLDR/'2000'O,153,'12000'O,154,'6000'O,152,'16000'O,151/
  955. X      DATA SCOLWL/151,207,'6000'O,152,208,'16000'O,
  956. X     &            153,206,'12000'O,154,205,'2000'O/
  957. XC
  958. X      DATA HFACTR/500/
  959. XC
  960. X      DATA CPDR/'2000'O,-8,'4000'O,-7,'6000'O,1,'10000'O,9,
  961. X     &          '12000'O,8,'14000'O,7,'16000'O,-1,'20000'O,-9/
  962. X      DATA CPWL/205,-8,206,8,207,1,208,-1/
  963. X      DATA CPVEC/ 1, 1, 1, 1, 1, 1, 1, 1,
  964. X     &            1, 0,-1, 0, 0,-1, 0, 1,
  965. X     &            1,-1, 0, 1, 0,-2, 0, 1,
  966. X     &            1, 0, 0, 0, 0, 1, 0, 1,
  967. X     &            1,-3, 0, 0,-1,-1, 0, 1,
  968. X     &            1, 0, 0,-1, 0, 0, 0, 1,
  969. X     &            1, 1, 1, 0, 0, 0, 1, 1,
  970. X     &            1, 1, 1, 1, 1, 1, 1, 1/
  971. XC
  972. X      DATA CEVCUR/1/,CEVMNT/2/,CEVLNT/3/,CEVMAT/4/,
  973. X     &     CEVCND/5/,CEVBAL/6/,CEVBRN/7/,CEVFUS/8/,
  974. X     &     CEVLED/9/,CEVSAF/10/,CEVVLG/11/,CEVGNO/12/,
  975. X     &     CEVBUC/13/,CEVSPH/14/,CEVEGH/15/,
  976. X     &     CEVFOR/16/,CEVSCL/17/,CEVZGI/18/,CEVZGO/19/,
  977. X     &     CEVSTE/20/,CEVMRS/21/,CEVPIN/22/,CEVINQ/23/,
  978. X     &     CEVFOL/24/
  979. XC
  980. X      DATA XRMASK/'377'O/,XDMASK/'76000'O/,XFMASK/3/
  981. X      DATA XFSHFT/256/,XASHFT/256/
  982. X      DATA XNORM/1/,XNO/2/,XCOND/3/,XDOOR/4/
  983. X      DATA XELNT/1,2,3,3/,XLFLAG/'100000'O/
  984. X      DATA XMIN/'2000'O/,XMAX/'40000'O/,XUP/'22000'O/,XDOWN/'24000'O/
  985. X      DATA XNORTH/'2000'O/,XSOUTH/'12000'O/,XENTER/'32000'O/,
  986. X     &     XEXIT/'34000'O/
  987. X      DATA XEAST/'6000'O/,XWEST/'16000'O/
  988. XC
  989. X      DATA PLAYER/1/,AROBOT/2/,AMASTR/3/
  990. X      DATA ASTAG/'100000'O/
  991. XC
  992. X      DATA RSEEN/'100000'O/,RLIGHT/'40000'O/,RLAND/'20000'O/
  993. X      DATA RWATER/'10000'O/,RAIR/'4000'O/,RSACRD/'2000'O/,
  994. X     &     RFILL/'1000'O/
  995. X      DATA RMUNG/'400'O/,RBUCK/'200'O/,RHOUSE/'100'O/,
  996. X     &     RNWALL/'40'O/,REND/'20'O/
  997. XC
  998. X      DATA WHOUS/2/,LROOM/8/,CELLA/9/
  999. X      DATA MTROL/10/,MAZE1/11/
  1000. X      DATA MGRAT/25/,MAZ15/30/
  1001. X      DATA FORE1/31/,FORE3/33/,CLEAR/36/,RESER/40/
  1002. X      DATA STREA/42/,EGYPT/44/,ECHOR/49/
  1003. X      DATA TSHAF/61/
  1004. X      DATA BSHAF/76/,MMACH/77/,DOME/79/,MTORC/80/
  1005. X      DATA CAROU/83/
  1006. X      DATA RIDDL/91/,LLD2/94/,TEMP1/96/,TEMP2/97/,MAINT/100/
  1007. X      DATA MCYCL/101/,BLROO/102/,TREAS/103/,RIVR1/107/,RIVR2/108/
  1008. X      DATA RIVR3/109/
  1009. X      DATA RIVR4/112/,RIVR5/113/,FCHMP/114/,MBARR/119/,FALLS/120/
  1010. X      DATA MRAIN/121/,POG/122/,VLBOT/126/,VAIR1/127/,VAIR2/128/
  1011. X      DATA VAIR3/129/,VAIR4/130/
  1012. X      DATA LEDG2/131/,LEDG3/132/,LEDG4/133/,MSAFE/135/,CAGER/140/
  1013. X      DATA CAGED/141/,TWELL/142/,BWELL/143/,ALICE/144/,ALISM/145/
  1014. X      DATA ALITR/146/,MTREE/147/,BKENT/148/
  1015. X      DATA BKVW/151/,BKTWI/153/,BKVAU/154/,BKBOX/155/
  1016. X      DATA CRYPT/157/,TSTRS/158/,MRANT/159/
  1017. X      DATA MREYE/160/,MRA/161/,MRB/162/,MRC/163/,MRG/164/
  1018. X      DATA MRD/165/,FDOOR/166/,MRAE/167/
  1019. X      DATA MRCE/171/,MRCW/172/,MRGE/173/,MRGW/174/,MRDW/176/
  1020. X      DATA INMIR/177/,SCORR/179/
  1021. X      DATA NCORR/182/,PARAP/183/,CELL/184/,PCELL/185/,NCELL/186/
  1022. X      DATA CPANT/188/,CPOUT/189/
  1023. X      DATA CPUZZ/190/
  1024. XC
  1025. X      DATA CINTW/1/,DEADXW/2/,FRSTQW/3/,INXW/4/
  1026. X      DATA OUTXW/5/,WALKIW/6/,FIGHTW/7/,FOOW/8/
  1027. XC
  1028. X      DATA READW/100/,MELTW/101/
  1029. X      DATA INFLAW/102/,DEFLAW/103/,ALARMW/104/,EXORCW/105/
  1030. X      DATA PLUGW/106/,KICKW/107/,WAVEW/108/,RAISEW/109/,LOWERW/110/
  1031. X      DATA RUBW/111/,PUSHW/112/,UNTIEW/113/,TIEW/114/,TIEUPW/115/
  1032. X      DATA TURNW/116/,BREATW/117/,KNOCKW/118/,LOOKW/119/
  1033. X      DATA EXAMIW/120/,SHAKEW/121/,MOVEW/122/,TRNONW/123/,TRNOFW/124/
  1034. X      DATA OPENW/125/,CLOSEW/126/,FINDW/127/,WAITW/128/,SPINW/129/
  1035. X      DATA BOARDW/130/,UNBOAW/131/,TAKEW/132/,INVENW/133/
  1036. X      DATA FILLW/134/,EATW/135/,DRINKW/136/,BURNW/137/
  1037. X      DATA MUNGW/138/,KILLW/139/,ATTACW/141/
  1038. X      DATA SWINGW/140/,WALKW/142/,TELLW/143/,PUTW/144/
  1039. X      DATA DROPW/145/,GIVEW/146/,POURW/147/,THROWW/148/
  1040. XC
  1041. X      DATA DIGW/89/,LEAPW/91/,STAYW/73/,FOLLOW/85/
  1042. X      DATA HELLOW/151/,LOOKIW/152/,LOOKUW/153/,PUMPW/154/
  1043. X      DATA WINDW/155/,CLMBW/156/,CLMBUW/157/,CLMBDW/158/,TRNTOW/159/
  1044. XC
  1045. X      DATA VISIBT/'100000'O/,READBT/'40000'O/,TAKEBT/'20000'O/,
  1046. X     &     DOORBT/'10000'O/,TRANBT/'4000'O/,FOODBT/'2000'O/,
  1047. X     &     NDSCBT/'1000'O/,DRNKBT/'400'O/, CONTBT/'200'O/,
  1048. X     &     LITEBT/'100'O/,VICTBT/'40'O/,BURNBT/'20'O/,
  1049. X     &     FLAMBT/'10'O/,TOOLBT/'4'O/,TURNBT/'2'O/,ONBT/'1'O/
  1050. XC
  1051. X      DATA FINDBT/'100000'O/,SLEPBT/'40000'O/,SCRDBT/'20000'O/,
  1052. X     &     TIEBT/'10000'O/, CLMBBT/'4000'O/,ACTRBT/'2000'O/,
  1053. X     &     WEAPBT/'1000'O/,FITEBT/'400'O/, VILLBT/'200'O/,
  1054. X     &     STAGBT/'100'O/,TRYBT/'40'O/,NOCHBT/'20'O/,
  1055. X     &     OPENBT/'10'O/,TCHBT/'4'O/,VEHBT/'2'O/,SCHBT/'1'O/
  1056. XC
  1057. X      DATA GARLI/2/,FOOD/3/,GUNK/4/,COAL/5/,MACHI/7/,DIAMO/8/
  1058. X      DATA TCASE/9/,BOTTL/10/
  1059. X      DATA WATER/11/,ROPE/12/,KNIFE/13/,SWORD/14/,LAMP/15/,BLAMP/16/
  1060. X      DATA RUG/17/,LEAVE/18/,TROLL/19/,AXE/20/
  1061. X      DATA RKNIF/21/,KEYS/23/,BAR/26/,ICE/30/
  1062. X      DATA COFFI/33/,TORCH/34/,TBASK/35/,FBASK/36/,IRBOX/39/
  1063. X      DATA GHOST/42/,TRUNK/45/,BELL/46/,BOOK/47/,CANDL/48/
  1064. X      DATA MATCH/51/,TUBE/54/,PUTTY/55/,WRENC/56/,SCREW/57/
  1065. X      DATA CYCLO/58/,CHALI/59/
  1066. X      DATA THIEF/61/,STILL/62/,WINDO/63/,GRATE/65/,DOOR/66/
  1067. X      DATA HPOLE/71/,RBUTT/79/,LEAK/78/,RAILI/75/
  1068. X      DATA POT/85/,STATU/86/,IBOAT/87/,DBOAT/88/,PUMP/89/,RBOAT/90/
  1069. X      DATA STICK/92/,BUOY/94/,SHOVE/96/,GUANO/97/,BALLO/98/,RECEP/99/
  1070. X      DATA BROPE/101/,HOOK1/102/,HOOK2/103/,SAFE/105/,SSLOT/107/
  1071. X      DATA BRICK/109/,FUSE/110/
  1072. X      DATA GNOME/111/,BLABE/112/,DBALL/113/,TOMB/119/
  1073. X      DATA LCASE/123/,CAGE/124/,RCAGE/125/,SPHER/126/,SQBUT/127/
  1074. X      DATA FLASK/132/,POOL/133/,SAFFR/134/,BUCKE/137/,ORICE/139/
  1075. X      DATA ECAKE/138/,RDICE/140/
  1076. X      DATA BLICE/141/,ROBOT/142/,FTREE/145/,BILLS/148/,PORTR/149/
  1077. X      DATA SCOL/151/,ZGNOM/152/,EGG/154/,BEGG/155/,BAUBL/156/
  1078. X      DATA CANAR/157/,BCANA/158/,YLWAL/159/
  1079. X      DATA RDWAL/161/,PINDR/164/
  1080. X      DATA RBEAM/171/,ODOOR/172/,QDOOR/173/,CDOOR/175/
  1081. X      DATA NUM1/178/
  1082. X      DATA NUM8/185/,WARNI/186/,CSLIT/187/,GCARD/188/,STLDR/189/
  1083. X      DATA ITOBJ/192/,OPLAY/193/,EVERY/194/
  1084. X      DATA VALUA/195/,SAILO/196/,TEETH/197/,WALL/198/
  1085. X      DATA HANDS/200/,LUNGS/201/,AVIAT/202/
  1086. X      DATA WNORT/205/,GWATE/209/,MASTER/215/
  1087. X`0C
  1088. XC DUNGEON, PAGE 3
  1089. XC
  1090. XC 1) INITIALIZE DATA STRUCTURES
  1091. XC 2) PLAY GAME
  1092. XC
  1093. X      IF(INIT(X)) CALL GAME
  1094. XC                                               !IF INIT, PLAY GAME.
  1095. X      CALL EXIT
  1096. XC                                               !DONE
  1097. X      END
  1098. $ CALL UNPACK [.SRC]DMAIN.FOR;1 1753057966
  1099. $ create 'f'
  1100. XC PRINCR- PRINT CONTENTS OF ROOM
  1101. XC
  1102. XC COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
  1103. XC ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
  1104. XC WRITTEN BY R. M. SUPNIK
  1105. XC
  1106. XC DECLARATIONS
  1107. XC
  1108. X      SUBROUTINE PRINCR(FULL,RM)
  1109. X      IMPLICIT INTEGER (A-Z)
  1110. X      LOGICAL QEMPTY,QHERE,FULL
  1111. X
  1112. X      INCLUDE 'GAMESTATE.LIB/LIST'
  1113. X      INCLUDE 'ROOMS.LIB/LIST'
  1114. X      INCLUDE 'RFLAG.LIB/LIST'
  1115. XC
  1116. X      INCLUDE 'OBJECTS.LIB/LIST'
  1117. X      INCLUDE 'OFLAGS.LIB/LIST'
  1118. X      INCLUDE 'OINDEX.LIB/LIST'
  1119. X      INCLUDE 'ADVERS.LIB/LIST'
  1120. X      INCLUDE 'FLAGS.LIB/LIST'
  1121. X`0C
  1122. XC PRINCR, PAGE 2
  1123. XC
  1124. X      J=329
  1125. XC                                               !ASSUME SUPERBRIEF FORMAT.
  1126. X      DO 500 I=1,OLNT
  1127. XC                                               !LOOP ON OBJECTS
  1128. X        IF(.NOT.QHERE(I,RM).OR.(and(OFLAG1(I),(VISIBT+NDSCBT)).NE.
  1129. X     &          VISIBT).OR.(I.EQ.AVEHIC(WINNER))) GO TO 500
  1130. X        IF(.NOT.FULL.AND.(SUPERF.OR.(BRIEFF.AND.
  1131. X     &          (and(RFLAG(HERE),RSEEN).NE.0)))) GO TO 200
  1132. XC
  1133. XC DO LONG DESCRIPTION OF OBJECT.
  1134. XC
  1135. X        K=ODESCO(I)
  1136. XC                                               !GET UNTOUCHED.
  1137. X        IF((K.EQ.0).OR.(and(OFLAG2(I),TCHBT).NE.0)) K=ODESC1(I)
  1138. X        CALL RSPEAK(K)
  1139. XC                                               !DESCRIBE.
  1140. X        GO TO 500
  1141. XC DO SHORT DESCRIPTION OF OBJECT.
  1142. XC
  1143. X200     CALL RSPSUB(J,ODESC2(I))
  1144. XC                                               !YOU CAN SEE IT.
  1145. X        J=502
  1146. XC
  1147. X500   CONTINUE
  1148. XC
  1149. XC NOW LOOP TO PRINT CONTENTS OF OBJECTS IN ROOM.
  1150. XC
  1151. X      DO 1000 I=1,OLNT
  1152. XC                                               !LOOP ON OBJECTS.
  1153. X        IF(.NOT.QHERE(I,RM).OR.(and(OFLAG1(I),(VISIBT+NDSCBT)).NE.
  1154. X     &          VISIBT)) GO TO 1000
  1155. X        IF(and(OFLAG2(I),ACTRBT).NE.0) CALL INVENT(OACTOR(I))
  1156. X        IF(((and(OFLAG1(I),TRANBT).EQ.0)
  1157. X     &          .AND.(and(OFLAG2(I),OPENBT).EQ.0))
  1158. X     &          .OR.QEMPTY(I)) GO TO 1000
  1159. XC
  1160. XC OBJECT IS NOT EMPTY AND IS OPEN OR TRANSPARENT.
  1161. XC
  1162. X        J=573
  1163. X        IF(I.NE.TCASE) GO TO 600
  1164. XC                                               !TROPHY CASE?
  1165. X        J=574
  1166. X        IF((BRIEFF.OR.SUPERF).AND. .NOT.FULL) GO TO 1000
  1167. X600     CALL PRINCO(I,J)
  1168. XC                                               !PRINT CONTENTS.
  1169. XC
  1170. X1000  CONTINUE
  1171. X      RETURN
  1172. XC
  1173. X      END
  1174. X`0C
  1175. XC INVENT- PRINT CONTENTS OF ADVENTURER
  1176. XC
  1177. XC DECLARATIONS
  1178. XC
  1179. X      SUBROUTINE INVENT(ADV)
  1180. X      IMPLICIT INTEGER (A-Z)
  1181. X      LOGICAL QEMPTY
  1182. X
  1183. X      INCLUDE 'GAMESTATE.LIB/LIST'
  1184. X      INCLUDE 'OBJECTS.LIB/LIST'
  1185. X      INCLUDE 'OFLAGS.LIB/LIST'
  1186. XC
  1187. X      INCLUDE 'ADVERS.LIB/LIST'
  1188. X`0C
  1189. XC INVENT, PAGE 2
  1190. XC
  1191. X      I=575
  1192. XC                                               !FIRST LINE.
  1193. X      IF(ADV.NE.PLAYER) I=576
  1194. XC                                               !IF NOT ME.
  1195. X      DO 10 J=1,OLNT
  1196. XC                                               !LOOP
  1197. X        IF((OADV(J).NE.ADV).OR.(and(OFLAG1(J),VISIBT).EQ.0))
  1198. X     &          GO TO 10
  1199. X        CALL RSPSUB(I,ODESC2(AOBJ(ADV)))
  1200. X        I=0
  1201. X        CALL RSPSUB(502,ODESC2(J))
  1202. X10    CONTINUE
  1203. XC
  1204. X      IF(I.EQ.0) GO TO 25
  1205. XC                                               !ANY OBJECTS?
  1206. X      IF(ADV.EQ.PLAYER) CALL RSPEAK(578)
  1207. XC                                               !NO, TELL HIM.
  1208. X      RETURN
  1209. XC
  1210. X25    DO 100 J=1,OLNT
  1211. XC                                               !LOOP.
  1212. X        IF((OADV(J).NE.ADV).OR.(and(OFLAG1(J),VISIBT).EQ.0).OR.
  1213. X     &          ((and(OFLAG1(J),TRANBT).EQ.0).AND.
  1214. X     &          (and(OFLAG2(J),OPENBT).EQ.0))) GO TO 100
  1215. X        IF(.NOT.QEMPTY(J)) CALL PRINCO(J,573)
  1216. XC                                               !IF NOT EMPTY, LIST.
  1217. X100   CONTINUE
  1218. X      RETURN
  1219. XC
  1220. X      END
  1221. X`0C
  1222. XC PRINCO-       PRINT CONTENTS OF OBJECT
  1223. XC
  1224. XC DECLARATIONS
  1225. XC
  1226. X      SUBROUTINE PRINCO(OBJ,DESC)
  1227. X      IMPLICIT INTEGER(A-Z)
  1228. X      INCLUDE 'OBJECTS.LIB/LIST'
  1229. XC
  1230. X      CALL RSPSUB(DESC,ODESC2(OBJ))
  1231. XC                                               !PRINT HEADER.
  1232. X      DO 100 I=1,OLNT
  1233. XC                                               !LOOP THRU.
  1234. X        IF(OCAN(I).EQ.OBJ) CALL RSPSUB(502,ODESC2(I))
  1235. X100   CONTINUE
  1236. X      RETURN
  1237. XC
  1238. X      END
  1239. $ CALL UNPACK [.SRC]DSO1.FOR;1 1296852279
  1240. $ create 'f'
  1241. XC MOVETO- MOVE PLAYER TO NEW ROOM
  1242. XC
  1243. XC COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
  1244. XC ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
  1245. XC WRITTEN BY R. M. SUPNIK
  1246. XC
  1247. XC DECLARATIONS
  1248. XC
  1249. X      LOGICAL FUNCTION MOVETO(NR,WHO)
  1250. X      IMPLICIT INTEGER (A-Z)
  1251. X      LOGICAL NLV,LHR,LNR
  1252. X
  1253. X      INCLUDE 'GAMESTATE.LIB'
  1254. X      INCLUDE 'ROOMS.LIB'
  1255. X      INCLUDE 'RFLAG.LIB'
  1256. X      INCLUDE 'OBJECTS.LIB'
  1257. X      INCLUDE 'OINDEX.LIB'
  1258. X      INCLUDE 'ADVERS.LIB'
  1259. X`0C
  1260. XC MOVETO, PAGE 2
  1261. XC
  1262. X      MOVETO=.FALSE.
  1263. XC                                               !ASSUME FAILS.
  1264. X      LHR=and(RFLAG(HERE),RLAND).NE.0
  1265. X      LNR=and(RFLAG(NR),RLAND).NE.0
  1266. X      J=AVEHIC(WHO)
  1267. XC                                               !HIS VEHICLE
  1268. XC
  1269. X      IF(J.NE.0) GO TO 100
  1270. XC                                               !IN VEHICLE?
  1271. X      IF(LNR) GO TO 500
  1272. XC                                               !NO, GOING TO LAND?
  1273. X      CALL RSPEAK(427)
  1274. XC                                               !CAN'T GO WITHOUT VEHICLE.
  1275. X      RETURN
  1276. XC
  1277. X100   BITS=0
  1278. XC                                               !ASSUME NOWHERE.
  1279. X      IF(J.EQ.RBOAT) BITS=RWATER
  1280. XC                                               !IN BOAT?
  1281. X      IF(J.EQ.BALLO) BITS=RAIR
  1282. XC                                               !IN BALLOON?
  1283. X      IF(J.EQ.BUCKE) BITS=RBUCK
  1284. XC                                               !IN BUCKET?
  1285. X      NLV=and(RFLAG(NR),BITS).EQ.0
  1286. X      IF((.NOT.LNR .AND.NLV) .OR.
  1287. X     &   (LNR.AND.LHR.AND.NLV.AND.(BITS.NE.RLAND)))
  1288. X     &GO TO 800
  1289. XC
  1290. X500   MOVETO=.TRUE.
  1291. XC                                               !MOVE SHOULD SUCCEED.
  1292. X      IF(and(RFLAG(NR),RMUNG).EQ.0) GO TO 600
  1293. X      CALL RSPEAK(RRAND(NR))
  1294. XC                                               !YES, TELL HOW.
  1295. X      RETURN
  1296. XC
  1297. X600   IF(WHO.NE.PLAYER) CALL NEWSTA(AOBJ(WHO),0,NR,0,0)
  1298. X      IF(J.NE.0) CALL NEWSTA(J,0,NR,0,0)
  1299. X      HERE=NR
  1300. X      AROOM(WHO)=HERE
  1301. X      CALL SCRUPD(RVAL(NR))
  1302. XC                                               !SCORE ROOM
  1303. X      RVAL(NR)=0
  1304. X      RETURN
  1305. XC
  1306. X800   CALL RSPSUB(428,ODESC2(J))
  1307. XC                                               !WRONG VEHICLE.
  1308. X      RETURN
  1309. X      END
  1310. X`0C
  1311. XC SCORE-- PRINT OUT CURRENT SCORE
  1312. XC
  1313. XC DECLARATIONS
  1314. XC
  1315. X      SUBROUTINE SCORE(FLG)
  1316. X      IMPLICIT INTEGER (A-Z)
  1317. X      LOGICAL FLG
  1318. X      INTEGER RANK(10),ERANK(5)
  1319. X      include 'gamestate.LIB'
  1320. X      include 'state.LIB'
  1321. XC
  1322. X      COMMON /CHAN/ INPCH,OUTCH,DBCH
  1323. X
  1324. X      INCLUDE 'ADVERS.LIB'
  1325. X      INCLUDE 'FLAGS.LIB'
  1326. XC
  1327. XC FUNCTIONS AND DATA
  1328. XC
  1329. X      DATA RANK/20,19,18,16,12,8,4,2,1,0/
  1330. X      DATA ERANK/20,15,10,5,0/
  1331. X`0C
  1332. XC SCORE, PAGE 2
  1333. XC
  1334. X      AS=ASCORE(WINNER)
  1335. XC
  1336. X      IF(ENDGMF) GO TO 60
  1337. XC                                               !ENDGAME?
  1338. X      IF(FLG) WRITE(OUTCH,100)
  1339. X      IF(.NOT.FLG) WRITE(OUTCH,110)
  1340. X      IF(MOVES.NE.1) WRITE(OUTCH,120) AS,MXSCOR,MOVES
  1341. X      IF(MOVES.EQ.1) WRITE(OUTCH,130) AS,MXSCOR,MOVES
  1342. XC
  1343. X      DO 10 I=1,10
  1344. X        IF((AS*20/MXSCOR).GE.RANK(I)) GO TO 50
  1345. X10    CONTINUE
  1346. X50    CALL RSPEAK(484+I)
  1347. X      RETURN
  1348. XC
  1349. X60    IF(FLG) WRITE(OUTCH,140)
  1350. X      IF(.NOT.FLG) WRITE(OUTCH,150)
  1351. X      WRITE(OUTCH,120) EGSCOR,EGMXSC,MOVES
  1352. X      DO 70 I=1,5
  1353. X        IF((EGSCOR*20/EGMXSC).GE.ERANK(I)) GO TO 80
  1354. X70    CONTINUE
  1355. X80    CALL RSPEAK(786+I)
  1356. X      RETURN
  1357. X
  1358. X100   FORMAT(' Your score would be',$)
  1359. X110   FORMAT(' Your score is',$)
  1360. X120   FORMAT('+',I4,' `5Btotal of',I4,' points`5D, in',I5,' moves.')
  1361. X130   FORMAT('+',I4,' `5Btotal of',I4,' points`5D, in',I5,' move.')
  1362. X140   FORMAT(' Your score in the endgame would be',$)
  1363. X150   FORMAT(' Your score in the endgame is',$)
  1364. XC
  1365. X      END
  1366. X`0C
  1367. XC SCRUPD- UPDATE WINNER'S SCORE
  1368. XC
  1369. XC DECLARATIONS
  1370. XC
  1371. X      SUBROUTINE SCRUPD(N)
  1372. X      IMPLICIT INTEGER (A-Z)
  1373. X
  1374. X      INCLUDE 'GAMESTATE.LIB'
  1375. X      INCLUDE 'STATE.LIB'
  1376. X      INCLUDE 'CLOCK.LIB'
  1377. X      INCLUDE 'ADVERS.LIB'
  1378. X      INCLUDE 'FLAGS.LIB'
  1379. XC
  1380. X      IF(ENDGMF) GO TO 100
  1381. XC                                               !ENDGAME?
  1382. X      ASCORE(WINNER)=ASCORE(WINNER)+N
  1383. XC                                               !UPDATE SCORE
  1384. X      RWSCOR=RWSCOR+N
  1385. XC                                               !UPDATE RAW SCORE
  1386. X      IF(ASCORE(WINNER).LT.(MXSCOR-(10*DEATHS))) RETURN
  1387. X      CFLAG(CEVEGH)=.TRUE.
  1388. XC                                               !TURN ON END GAME
  1389. X      CTICK(CEVEGH)=15
  1390. X      RETURN
  1391. XC
  1392. X100   EGSCOR=EGSCOR+N
  1393. XC                                               !UPDATE EG SCORE.
  1394. X      RETURN
  1395. X      END
  1396. $ CALL UNPACK [.SRC]DSO2.FOR;1 812531101
  1397. $ create 'f'
  1398. XC FINDXT- FIND EXIT FROM ROOM
  1399. XC
  1400. XC COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
  1401. XC ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
  1402. XC WRITTEN BY R. M. SUPNIK
  1403. XC
  1404. XC DECLARATIONS
  1405. XC
  1406. X      LOGICAL FUNCTION FINDXT(DIR,RM)
  1407. X      IMPLICIT INTEGER (A-Z)
  1408. X
  1409. X      INCLUDE 'ROOMS.LIB'
  1410. X      INCLUDE 'EXITS.LIB'
  1411. X      INCLUDE 'CURXT.LIB'
  1412. X      INCLUDE 'XPARS.LIB'
  1413. XC
  1414. X      FINDXT=.TRUE.
  1415. XC                                               !ASSUME WINS.
  1416. X      XI=REXIT(RM)
  1417. XC                                               !FIND FIRST ENTRY.
  1418. X      IF(XI.EQ.0) GO TO 1000
  1419. XC                                               !NO EXITS?
  1420. XC
  1421. X100   I=TRAVEL(XI)
  1422. XC                                               !GET ENTRY.
  1423. X      XROOM1=and(I,XRMASK)
  1424. XC
  1425. XC mask to 16-bits to get rid of sign extension problems with 32-bit ints
  1426. XC
  1427. X      XXXFLG = and(not(XLFLAG), 65535)
  1428. X      XTYPE=and((and(I,XXXFLG)/XFSHFT),XFMASK)+1
  1429. X      GO TO (110,120,130,130),XTYPE
  1430. XC                                               !BRANCH ON ENTRY.
  1431. X      CALL BUG(10,XTYPE)
  1432. XC
  1433. X130   XOBJ=and(TRAVEL(XI+2),XRMASK)
  1434. X      XACTIO=TRAVEL(XI+2)/XASHFT
  1435. X120   XSTRNG=TRAVEL(XI+1)
  1436. XC                                               !DOOR/CEXIT/NEXIT - STRING.
  1437. X110   XI=XI+XELNT(XTYPE)
  1438. XC                                               !ADVANCE TO NEXT ENTRY.
  1439. X      IF(and(I,XDMASK).EQ.DIR) RETURN
  1440. X      IF(and(I,XLFLAG).EQ.0) GO TO 100
  1441. X1000  FINDXT=.FALSE.
  1442. XC                                               !YES, LOSE.
  1443. X      RETURN
  1444. X      END
  1445. X`0C
  1446. XC FWIM- FIND WHAT I MEAN
  1447. XC
  1448. XC DECLARATIONS
  1449. XC
  1450. X      INTEGER FUNCTION FWIM(F1,F2,RM,CON,ADV,NOCARE)
  1451. X      IMPLICIT INTEGER (A-Z)
  1452. X      LOGICAL NOCARE
  1453. X
  1454. X      INCLUDE 'OBJECTS.LIB'
  1455. X      INCLUDE 'OFLAGS.LIB'
  1456. XC
  1457. X      FWIM=0
  1458. XC                                               !ASSUME NOTHING.
  1459. X      DO 1000 I=1,OLNT
  1460. XC                                               !LOOP
  1461. X        IF(((RM.EQ.0).OR.(OROOM(I).NE.RM)) .AND.
  1462. X     &     ((ADV.EQ.0).OR.(OADV(I).NE.ADV)) .AND.
  1463. X     &     ((CON.EQ.0).OR.(OCAN(I).NE.CON)))
  1464. X     &  GO TO 1000
  1465. XC
  1466. XC OBJECT IS ON LIST... IS IT A MATCH?
  1467. XC
  1468. X        IF(and(OFLAG1(I),VISIBT).EQ.0) GO TO 1000
  1469. X        IF(and(not(NOCARE),(and(OFLAG1(I),TAKEBT).EQ.0)) .OR.
  1470. X     &    ((and(OFLAG1(I),F1).EQ.0).AND.
  1471. X     &     (and(OFLAG2(I),F2).EQ.0))) GO TO 500
  1472. X        IF(FWIM.EQ.0) GO TO 400
  1473. XC                                               !ALREADY GOT SOMETHING?
  1474. X        FWIM=-FWIM
  1475. XC                                               !YES, AMBIGUOUS.
  1476. X        RETURN
  1477. XC
  1478. X400     FWIM=I
  1479. XC                                               !NOTE MATCH.
  1480. XC
  1481. XC DOES OBJECT CONTAIN A MATCH?
  1482. XC
  1483. X500     IF(and(OFLAG2(I),OPENBT).EQ.0) GO TO 1000
  1484. X        DO 700 J=1,OLNT
  1485. XC                                               !NO, SEARCH CONTENTS.
  1486. X          IF((OCAN(J).NE.I).OR.(and(OFLAG1(J),VISIBT).EQ.0) .OR.
  1487. X     &       ((and(OFLAG1(J),F1).EQ.0).AND.
  1488. X     &        (and(OFLAG2(J),F2).EQ.0))) GO TO 700
  1489. X          IF(FWIM.EQ.0) GO TO 600
  1490. X          FWIM=-FWIM
  1491. X          RETURN
  1492. XC
  1493. X600       FWIM=J
  1494. X700     CONTINUE
  1495. X1000  CONTINUE
  1496. X      RETURN
  1497. X      END
  1498. X`0C
  1499. XC YESNO- OBTAIN YES/NO ANSWER
  1500. XC
  1501. XC CALLED BY-
  1502. XC
  1503. XC       YES-IS-TRUE=YESNO(QUESTION,YES-STRING,NO-STRING)
  1504. XC
  1505. X      LOGICAL FUNCTION YESNO(Q,Y,N)
  1506. X      IMPLICIT INTEGER(A-Z)
  1507. X      COMMON /CHAN/ INPCH,OUTCH,DBCH
  1508. X      CHARACTER ANS
  1509. XC
  1510. X100   CALL RSPEAK(Q)
  1511. XC                                               !ASK
  1512. X      READ(INPCH,110) ANS
  1513. XC                                               !GET ANSWER
  1514. X110   FORMAT(A1)
  1515. X      IF((ANS.EQ.'Y').OR.(ANS.EQ.'y')) GO TO 200
  1516. X      IF((ANS.EQ.'N').OR.(ANS.EQ.'n')) GO TO 300
  1517. +-+-+-+-+-+-+-+-  END  OF PART 23 +-+-+-+-+-+-+-+-
  1518.