home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1994 March / Source_Code_CD-ROM_Walnut_Creek_March_1994.iso / compsrcs / games / vmsnet / startrek / part16 < prev    next >
Encoding:
Internet Message Format  |  1993-04-06  |  14.4 KB
  1. Path: uunet!decwrl!concert!lester.appstate.edu!pembvax1.pembroke.edu!rennie
  2. From: rennie@pembvax1.pembroke.edu
  3. Newsgroups: vmsnet.sources.games
  4. Subject: Star Trek - Part [16/18]
  5. Date: 7 Apr 93 11:08:32 EDT
  6. Organization: Pembroke State University
  7. Lines: 467
  8. Message-ID: <1993Apr7.110833.1@pembvax1.pembroke.edu>
  9. NNTP-Posting-Host: papa.pembroke.edu
  10. Xref: uunet vmsnet.sources.games:658
  11.  
  12. -+-+-+-+-+-+-+-+ START OF PART 16 -+-+-+-+-+-+-+-+
  13. X      IF(DAMAGE(8).NE.0.0) GO TO 60  `20
  14. X      IF(SHLDUP.NE.0) GO TO 20
  15. XC*`20
  16. X      ENTRY SHLDSUP`20
  17. XC*`20
  18. X      CALL PROMPT(40HSHIELDS ARE DOWN.  DO YOU WANT THEM UP? ,40)`20
  19. X      IF(JA(DUMMY)) GO TO 40`20
  20. X`09GO TO 90
  21. X 20   CALL PROMPT(40HSHIELDS ARE UP.  DO YOU WANT THEM DOWN? ,40)`20
  22. X      IF(JA(DUMMY)) GO TO 50`20
  23. X`09GO TO 90
  24. X 30   IF(ITEM.EQ.1HT) GO TO 80
  25. X      IF(DAMAGE(8).NE.0.0) GO TO 60  `20
  26. X      IF(ITEM.EQ. 1HU) GO TO 40
  27. X      IF(ITEM.EQ. 1HD) GO TO 50`20
  28. X`09GO TO 15
  29. XC--------RAISE SHIELDS
  30. X 40   IF(SHLDUP.NE.0) GO TO 45
  31. X      SHLDUP=1
  32. X      SHLDCHG=1`20
  33. X      IF(CONDIT .NE. IHDOCKD ) ENERGY=ENERGY-50.0`20
  34. X      CALL PROUT(15HSHIELDS RAISED.,15)
  35. X      IF(ENERGY .LE. 0) GO TO 70
  36. X      IDIDIT=1
  37. X      RETURN
  38. X 45   CALL PROUT(21HSHIELDS ALREADY UP.   ,21)  `20
  39. X      RETURN
  40. XC--------LOWER SHIELDS
  41. X 50   IF(SHLDUP .EQ. 0) GO TO 55
  42. X      SHLDUP=0
  43. X      SHLDCHG=1`20
  44. X      CALL PROUT(16HSHIELDS LOWERED.,16)`20
  45. X      IDIDIT=1
  46. X      RETURN
  47. X 55   CALL PROUT(21HSHIELDS ALREADY DOWN.,21)
  48. X      RETURN
  49. XC--------SHIELD DAMAGE
  50. X 60   CALL PROUT(25HSHIELDS DAMAGED AND DOWN.,25)
  51. X      RETURN
  52. XC--------ENERGY TOTALLY DEPLETED
  53. X 70   CALL SKIP(1)
  54. X      CALL PROUT(31HSHIELDS USE UP LAST OF ENERGY. ,31)   `20
  55. X`09CALL FINISH(4)
  56. X`09RETURN
  57. XC--------CHANGE SHIELD ENERGY.
  58. X 80   CALL SCAN`20
  59. X`09ETRANS=FNUM
  60. X      IF(KEY .EQ. IHREAL) GO TO 81
  61. X 8010 CALL PROMPT(38HENERGY TO TRANSFER TO SHIELDS?        ,38)`20
  62. X      GO TO 80
  63. X 81   IF(ETRANS .EQ. 0.) GO TO 90`20
  64. X      IF(ETRANS .LT. ENERGY) GO TO 82`20
  65. X      CALL PROUT(25HINSUFFICIENT SHIP ENERGY.,25)`20
  66. X`09GO TO 90
  67. X 82   IDIDIT=1
  68. X      IF(SHLD+ETRANS .LE. INSHLD) GO TO 83
  69. X      CALL PROUT(24HSHIELD ENERGY MAXIMIZED.,24)`20
  70. X      CALL PROUT(48HEXCESS ENERGY REQUESTED RETURNED TO SHIP ENERGY.,48)`20
  71. X      ENERGY=ENERGY+SHLD-INSHLD`20
  72. X`09SHLD=INSHLD
  73. X`09GO TO 90
  74. XC--------PREVENT SHIELD-DRAIN LOOPHOLE.`20
  75. X 83   IF(ETRANS .GT. 0.) GO TO 8310`20
  76. X      IF(ENERGY-ETRANS .LE. INENRG) GO TO 8310
  77. X      IF(ENERGY + SHLD .LE. INENRG) GO TO 8310
  78. X      CALL SKIP(1)
  79. X      CALL PROUT(24H"ENGINEERING TO BRIDGE--,24)`20
  80. X      CALL PROUT(46H  SCOTT HERE.  POWER CIRCUIT PROBLEM, CAPTAIN.,46)`20
  81. X      CALL PROUT(31H  I CAN'T DRAIN THE SHIELDS."  ,31)   `20
  82. X`09IDIDIT=0
  83. X`09GO TO 90
  84. X 8310 IF(SHLD+ETRANS .GE. 0.) GO TO 84
  85. X      CALL PROUT(38HALL SHIELD ENERGY TRANSFERRED TO SHIP.,38)`20
  86. X`09ENERGY=ENERGY+SHLD
  87. X`09SHLD=0
  88. X`09GO TO 90
  89. X 84   CALL CRAM(10HSCOTTY:  ")
  90. X      IF(ETRANS .GT. 0.) CALL CRAM(12HTRANSFERRING)`20
  91. X      IF(ETRANS .LT. 0.) CALL CRAM(8HDRAINING)
  92. X      CALL CRAM(8H ENERGY )`20
  93. X      IF(ETRANS .GT. 0.) CALL CRAM(2HTO)
  94. X      IF(ETRANS .LT. 0.) CALL CRAM(4HFROM)
  95. X      CALL CRAMDMP(10H SHIELDS.")`20
  96. X`09SHLD=SHLD+ETRANS
  97. X`09ENERGY=ENERGY-ETRANS
  98. X 90   IF(SHLD .LE. 0.0) SHLDUP=0
  99. X      RETURN     `20
  100. X      END`20
  101. $ CALL UNPACK TRSHIELDS.FOR;1 436473907
  102. $ create 'f'
  103. X      SUBROUTINE SKIP(N)
  104. X      DO 10 L=1,N`20
  105. X      CALL PROUT(0,1)`20
  106. X 10   CONTINUE
  107. X      RETURN
  108. X      END`20
  109. $ CALL UNPACK TRSKIP.FOR;1 1448562315
  110. $ create 'f'
  111. X      SUBROUTINE SNOVA(INSX,INSY)`20
  112. XC
  113. XC`095-DEC-79
  114. XC`09DON'T CHARGE PLAYER FOR BAD THINGS IF SUPERNOVA CAUSED BY
  115. XC`09ENEMY ACTION
  116. XC
  117. X`09INCLUDE 'TREKCOM/NOLIST'
  118. X      INTEGER COMDEAD`20
  119. X      NSX=INSX
  120. X      NSY=INSY
  121. XC--------IF SCHEDULED SUPERNOVA (INSX=INSY=0), SELECT STAR
  122. X      IF(INSX.NE.0) GO TO 50
  123. X      NUM=RANF(0)*INSTAR+1
  124. X      DO 10 NQX=1,8`20
  125. X      DO 10 NQY=1,8`20
  126. X      NUM=NUM-MOD(GALAXY(NQX,NQY),10)`20
  127. X      IF(NUM .LE. 0) GO TO 20`20
  128. X 10   CONTINUE
  129. XC--------IF STAR IS ALREADY GONE, RETURN EMPTY-HANDED`20
  130. X      RETURN
  131. XC--------IF STARSHIP IS IN THIS QUADRANT, CHOOSE STAR EXACTLY`20
  132. X 20   IF(NQX.NE.QUADX .OR. NQY.NE.QUADY) GO TO 70`20
  133. XC--------UNLESS STARSHIP JUST GOT HERE; THEN TREAT SUPERNOVA AS`20
  134. XC        OCCURING WHILE EN ROUTE.`20
  135. X      IF(JUSTIN.NE.0) GO TO 70
  136. X      NUM=RANF(0)*MOD(GALAXY(NQX,NQY),10)+1`20
  137. X      DO 30 NSX=1,10
  138. X      DO 30 NSY=1,10
  139. X      IF(QUAD(NSX,NSY) .NE. IHSTAR) GO TO 30
  140. X      NUM=NUM-1`20
  141. X      IF(NUM .EQ. 0) GO TO 50`20
  142. X 30   CONTINUE
  143. XC--------PRINT RED ALERT (INCIPIENT SUPERNOVA) MESSAGE
  144. X 50   CALL SKIP(1)
  145. X      CALL REDALRT
  146. X      CALL CRAM(34H***INCIPIENT SUPERNOVA DETECTED AT)
  147. X      CALL CRAMLOC(2,NSX,NSY)`20
  148. X      CALL CREND
  149. X      NQX=QUADX`20
  150. X      NQY=QUADY`20
  151. XC--------SUPERNOVA ADJACENT TO STARSHIP ENDS GAME`20
  152. X      DSQ=(NSX-SECTX)**2 + (NSY-SECTY)**2`20
  153. X      IF(DSQ .GT. 2.1) GO TO 80`20
  154. X      CALL PROUT(`20
  155. X     +   54HEMERGENCY AUTOMATIC OVERRIDE ATTEMPTS T***************,54)`20
  156. X      CALL STARS
  157. X      ALLDONE=1`20
  158. X      GO TO 80
  159. XC--------IF STARSHIP NOT IN SAME QUADRANT, JUST GET A MESSAGE`20
  160. X 70   IF(DAMAGE(9) .NE. 0) GO TO 80`20
  161. X      CALL SKIP(1)
  162. X      CALL CRAM(49HMESSAGE FROM STARFLEET COMMAND          STARDATE )`20
  163. X      CALL CRAMF(DATE,0,1)
  164. X      CALL CREND
  165. X      CALL CRAM(17H     SUPERNOVA IN)`20
  166. X      CALL CRAMLOC(1,NQX,NQY)`20
  167. X      CALL CRAMDMP(18H; CAUTION ADVISED.)`20
  168. XC--------DESTROY ANY KLINGONS IN SUPERNOVAED QUADRANT`20
  169. X 80   NUM=GALAXY(NQX,NQY)`20
  170. X      KLDEAD=NUM/100
  171. X`09COMDEAD=0
  172. X`09ISCDEAD=0
  173. X      IF((NQX .NE. ISX) .OR. (NQY .NE. ISY)) GO TO 85`20
  174. X`09NSCREM=0
  175. X`09ISX=0
  176. X`09ISY=0
  177. X`09ISATB=0
  178. X`09ISCATE=0
  179. X`09ISCDEAD=1
  180. X`09FUTURE(6)=1E38
  181. X`09FUTURE(7)=1E38
  182. X 85   IF(KLDEAD .EQ. 0) GO TO 100`20
  183. X      REMKL=REMKL-KLDEAD
  184. X      IF(REMCOM .EQ. 0) GO TO 100`20
  185. X      MAXLOOP=REMCOM
  186. X      DO 90 L=1,MAXLOOP`20
  187. X      IF(CX(L).NE.NQX .OR. CY(L).NE.NQY) GO TO 90`20
  188. X      CX(L)=CX(REMCOM)
  189. X      CY(L)=CY(REMCOM)
  190. X`09CX(REMCOM)=0
  191. X`09CX(REMCOM)=0
  192. X      REMCOM=REMCOM-1`20
  193. X      KLDEAD=KLDEAD-1`20
  194. X      COMDEAD=1`20
  195. X      IF(REMCOM .EQ. 0) FUTURE(2)=1E38`20
  196. X 90   CONTINUE
  197. XC--------DESTROY ROMULANS AND PLANETS IN SUPERNOVAED QUADRANT.
  198. X 100  NUM=NEWSTUF(NQX,NQY)
  199. X`09NEWSTUF(NQX,NQY)=0
  200. X`09NRMDEAD=NUM/10
  201. X      NROMREM=NROMREM-NRMDEAD`20
  202. X      NPDEAD=NUM-NRMDEAD*10`20
  203. X      IF(NPDEAD .EQ. 0) GO TO 109`20
  204. X      DO 106 L=1,INPLAN`20
  205. X      IF((PLNETS(L,1) .NE. NQX).OR. (PLNETS(L,2) .NE. NQY)) GO TO 106`20
  206. X      DO 105 I=1,5
  207. X 105  PLNETS(L,I)=0
  208. X 106  CONTINUE
  209. XC--------DESTROY ANY BASE IN SUPERNOVAED QUADRANT`20
  210. X 109  IF(REMBASE .EQ. 0) GO TO 120
  211. X      MAXLOOP=REMBASE`20
  212. X      DO 110 L=1,MAXLOOP
  213. X      IF(BASEQX(L).NE.NQX .OR. BASEQY(L).NE.NQY) GO TO 110
  214. X      BASEQX(L)=BASEQX(REMBASE)`20
  215. X      BASEQY(L)=BASEQY(REMBASE)`20
  216. X`09BASEQX(REMBASE)=0
  217. X`09BASEQY(REMBASE)=0
  218. X      REMBASE=REMBASE-1`20
  219. X 110  CONTINUE
  220. XC--------IF STARSHIP CAUSED SUPERNOVA, TALLY UP DESTRUCTION`20
  221. X 120  IF(INSX .EQ. 0) GO TO 130`20
  222. X      NUMBER=MOD(GALAXY(NQX,NQY),100)`20
  223. X`09KILLK=KILLK+KLDEAD
  224. X`09KILLC=KILLC+COMDEAD`20
  225. X`09NROMKL=NROMKL+NRMDEAD
  226. X`09NSCKILL=NSCKILL+ISCDEAD`20
  227. XC--------IF ENEMY ACTION CAUSED SUPERNOVA, DON'T ASSESS ANY PENALTIES
  228. X`09IF(IPHWHO.EQ.1)GO TO 130
  229. X`09STARKL=STARKL+MOD(NUMBER,10)
  230. X`09BASEKL=BASEKL+(NUMBER/10)`20
  231. X`09NPLANKL=NPLANKL+NPDEAD
  232. XC--------MARK SUPERNOVA IN GALAXY AND IN STAR CHART`20
  233. X 130  IF(STARCH(NQX,NQY).GT.0 .AND. DAMAGE(9).NE.0)`20
  234. X     +   STARCH(NQX,NQY)=1000+GALAXY(NQX,NQY)`20
  235. X      IF(DAMAGE(9).EQ.0 .OR. (QUADX.EQ.NQX .AND. QUADY.EQ.NQY))`20
  236. X     +   STARCH(NQX,NQY)=1
  237. X      GALAXY(NQX,NQY)=1000
  238. XC--------IF SUPERNOVA DESTROYS LAST KLINGONS, GIVE SPECIAL MESSAGE
  239. X      IF(REMKL.NE.0 .OR. (NQX.EQ.QUADX .AND. NQY.EQ.QUADY)) GO TO 140`20
  240. X      CALL SKIP(2)
  241. X      CALL PROUT(11HLUCKY YOU! ,11)   `20
  242. X      CALL CRAM(14HA SUPERNOVA IN)
  243. X      CALL CRAMLOC(1,NQX,NQY)`20
  244. X      CALL CRAMDMP(38H HAS JUST DESTROYED THE LAST KLINGONS.)`20
  245. X      CALL FINISH(1)
  246. X      RETURN
  247. XC--------IF SOME KLINGONS REMAIN, CONTINUE (OR DIE IN SUPERNOVA)
  248. X 140  IF(ALLDONE.NE.0) CALL FINISH(8)`20
  249. X      RETURN
  250. X      END`20
  251. $ CALL UNPACK TRSNOVA.FOR;1 1919253965
  252. $ create 'f'
  253. X      SUBROUTINE SORTKL`20
  254. X`09INCLUDE 'TREKCOM/NOLIST'
  255. X      INTEGER SWITCH
  256. X      IF(NENHERE.LE.1)RETURN
  257. X      MINUS1=NENHERE-1
  258. X 10   SWITCH=0
  259. X      DO 20 J=1,MINUS1
  260. X      IF(KDIST(J) .LE. KDIST(J+1)) GO TO 20`20
  261. X`09T=KDIST(J)
  262. X`09KDIST(J)=KDIST(J+1)
  263. X`09KDIST(J+1)=T
  264. X`09K=KX(J)
  265. X`09KX(J)=KX(J+1)
  266. X`09KX(J+1)=K
  267. X`09K=KY(J)
  268. X`09KY(J)=KY(J+1)
  269. X`09KY(J+1)=K
  270. X`09T=KPOWER(J)
  271. X`09KPOWER(J)=KPOWER(J+1)
  272. X`09KPOWER(J+1)=T
  273. X      SWITCH=1
  274. X 20   CONTINUE
  275. X      IF(SWITCH.NE.0) GO TO 10
  276. X      RETURN
  277. X      END`20
  278. $ CALL UNPACK TRSORTKL.FOR;1 1462117107
  279. $ create 'f'
  280. X      SUBROUTINE SRSCAN`20
  281. X`09INCLUDE 'TREKCOM/NOLIST'
  282. X`09BYTE BITEM
  283. X      LOGICAL LEFTSID,RITESID ,CROP
  284. X      REAL*8 REQUST(10),AITEM,DAMAGD,UP,DOWN,TJ
  285. X`09EQUIVALENCE (AITEM,BITEM)
  286. X`09COMMON/SCANBF/KEY,AITEM
  287. X      DATA REQUST /4HDATE,8HCONDITIO,8HPOSITION,8HLSUPPORT,8HWARPFACT
  288. X     +,6HENERGY,8HTORPEDOE,7HSHIELDS,8HKLINGONS,4HTIME/`20
  289. X`09DATA DAMAGD,UP,DOWN/7HDAMAGED,2HUP,4HDOWN/
  290. X      IF(DAMAGE(1) .NE. 0 .AND. CONDIT .NE. IHDOCKD) GOTO 160      `20
  291. X      LEFTSID=.TRUE.
  292. X      RITESID=.TRUE.
  293. X      CALL SCAN`20
  294. X      IF(KEY .EQ. IHEOL) GO TO 3
  295. X      IF(BITEM .EQ. 1HN) RITESID = .FALSE.`20
  296. X 3    STARCH(QUADX,QUADY)=1`20
  297. X      K=0`20
  298. X      CALL PROUT(23H   1 2 3 4 5 6 7 8 9 10,23)
  299. X      GO TO 4`20
  300. XC*`20
  301. X      ENTRY REQUEST`20
  302. XC*`20
  303. X301`09CALL SCAN
  304. X      IF(KEY .EQ. IHALPHA) GO TO 303
  305. X 302  CALL PROMPT(24HINFORMATION DESIRED?    ,24)`20
  306. X`09GO TO 301
  307. X 303  DO 304 I=1,10`20
  308. X304`09IF(CROP(AITEM,REQUST(I))) K=I
  309. X      IF(K.NE.0) GO TO 305 `20
  310. X      CALL PROUT(42HUNRECOGNIZED REQUEST.  LEGAL REQUESTS ARE:,42)`20
  311. X      CALL PROUT(`20
  312. X     +51H  DATE, CONDITION, POSITION, LSUPPORT, WARPFACTOR,   ,51)  `20
  313. X      CALL PROUT(45H  ENERGY, TORPEDOES, SHIELDS, KLINGONS, TIME.,45)
  314. X`09CALL SKIP(1)
  315. X`09GO TO 302
  316. XC*`20
  317. X      ENTRY STATUS
  318. XC*`20
  319. X 305  LEFTSID=.FALSE.`20
  320. X 4    DO 150 I=1,10`20
  321. X`09JJ=I
  322. X`09IF(K.NE.0) JJ=K
  323. X      IF(.NOT. LEFTSID) GO TO 8`20
  324. X      CALL CRAMI(I,2)`20
  325. X      CALL CRAM(1H )
  326. X      DO 5 J=1,10`20
  327. X`09CALL CRAMS(QUAD(I,J),1)
  328. X`09CALL CRAM(1H )
  329. X 5    CONTINUE
  330. X      IF(RITESID)GO TO 8
  331. X      CALL CREND
  332. X      GO TO 150`20
  333. X 8    GO TO (10,20,30,40,50,60,70,80,90,100), JJ
  334. X 10   CALL CRAM(15H STARDATE      )`20
  335. X      CALL CRAMF(DATE,0,1)
  336. X      CALL CREND
  337. X      GO TO 140`20
  338. X 20   IF(CONDIT .NE. IHDOCKD ) CALL NEWCOND`20
  339. X      CALL CRAM(15H CONDITION     )`20
  340. X`09IF(CONDIT.EQ.IHGREEN) CALL CRMDPS('GREEN',5)
  341. X`09IF(CONDIT.EQ.IHRED) CALL CRMDPS('RED',3)
  342. X`09IF(CONDIT.EQ.IHYELLO) CALL CRMDPS('YELLOW',6)
  343. X`09IF(CONDIT.EQ.IHDOCKD) CALL CRMDPS('DOCKED',6)
  344. X      GO TO 140`20
  345. X 30   CALL CRAM(14H POSITION      )`20
  346. X      CALL CRAMLOC(0,QUADX,QUADY)`20
  347. X      CALL CRAM(1H,)
  348. X      CALL CRAMLOC(0,SECTX,SECTY)`20
  349. X      CALL CREND
  350. X      GO TO 140`20
  351. X 40   CALL CRAM(15H LIFE SUPPORT  )`20
  352. X      IF(DAMAGE(5).NE.0.) GO TO 44   `20
  353. X      CALL CRAM(6HACTIVE)`20
  354. X      GO TO 46
  355. X 44   IF(CONDIT .NE. IHDOC ) GO TO 45`20
  356. X      CALL CRAM(30HDAMAGED, SUPPORTED BY STARBASE)
  357. X      GO TO 46
  358. X 45   CALL CRAM(18HDAMAGED, RESERVES=)
  359. X      CALL CRAMF(LSUPRES,4,2)`20
  360. X 46   CALL CREND
  361. X      GO TO 140`20
  362. X 50   CALL CRAM(15H WARP FACTOR   )`20
  363. X      CALL CRAMF(WARPFAC,0,1)`20
  364. X      CALL CREND
  365. X      GO TO 140`20
  366. X 60   CALL CRAM(15H ENERGY        )`20
  367. X      CALL CRAMF(ENERGY,0,2)`20
  368. X      CALL CREND
  369. X      GO TO 140`20
  370. X 70   CALL CRAM(15H TORPEDOES     )`20
  371. X      CALL CRAMI(TORPS,0)`20
  372. X      CALL CREND
  373. X      GO TO 140`20
  374. X 80   CALL CRAM(15H SHIELDS       )`20
  375. X      TJ=DOWN
  376. X      IF(SHLDUP.NE.0) TJ=UP`20
  377. X      IF(DAMAGE(8) .GT. 0) TJ=DAMAGD
  378. X      CALL CRAMS(TJ,8)
  379. X      J=100.0*SHLD/INSHLD+0.5`20
  380. X      CALL CRAMI(J,0)`20
  381. X`09CALL CRAM(5H% -   )
  382. X`09J=SHLD
  383. X`09CALL CRAMI(J,0)
  384. X      CALL CRAMDMP(6H UNITS)
  385. X      GO TO 140`20
  386. X 90   CALL CRAM(15H KLINGONS LEFT )`20
  387. X      CALL CRAMI(REMKL,0)`20
  388. X      CALL CREND
  389. X      GO TO 140`20
  390. X 100  CALL CRAM(15H TIME LEFT     )`20
  391. X      CALL CRAMF(REMTIME,0,2)`20
  392. X      CALL CREND
  393. X`09IF(LEFTSID) CALL PROUT(23H   1 2 3 4 5 6 7 8 9 10,23)
  394. X 140  IF(K .EQ. 0) GO TO 150
  395. X`09K=0
  396. X`09RETURN
  397. X 150  CONTINUE
  398. X      RETURN
  399. X 160  CALL PROUT(22HS. R. SENSORS DAMAGED.,22)`20
  400. X      RETURN
  401. X      END`20
  402. $ CALL UNPACK TRSRSCAN.FOR;1 242226551
  403. $ create 'f'
  404. X`09SUBROUTINE THAW
  405. XC
  406. XC`095-APR-79
  407. XC`09FIX BUG IN TYPEOUT ON STATE OF GAME.
  408. XC`0925-APR-79
  409. XC`09CLEAN UP MESSAGE ON BASES.
  410. XC`09GET RID OF SPURIOUS COMMANDER ATTACK.
  411. XC`091-MAY-78
  412. XC`09DON'T PRINT PASSWORD FOR 'GAME' ENTRY
  413. XC`093-MAY-78
  414. XC`09USE CRAMSP TO TAKE CARE OF ALL SINGULAR/PLURAL TYPEOUTS.
  415. XC
  416. X`09INCLUDE 'TREKCOM/NOLIST'
  417. X`09LOGICAL*1 NAME(30)
  418. X`09INTEGER DESTBAS
  419. XC
  420. X`09CALL GETFN(NAME)
  421. X`09IDIDIT=0
  422. X`09IF(NAME(1).EQ.0) GOTO 800
  423. X`09CALL CLOSE(2)
  424. X`09OPEN(UNIT=2,NAME=NAME,TYPE='OLD',FORM='UNFORMATTED',
  425. X`091 ERR=800)
  426. X`09READ(2,ERR=800) N,(ICOM(K),K=1,N)
  427. X`09CALL CLOSE(2)
  428. X`09IDIDIT=1
  429. X`09GO TO 100
  430. XC*--TELL HIM WHAT KIND OF GAME HE GOT HIMSELF INTO...
  431. X`09ENTRY GAME
  432. X`09IDIDIT=0
  433. X100`09CALL SKIP(1)
  434. X`09CALL CRAM(22HYOU ARE NOW PLAYING A  )
  435. X`09IF(LENGTH.EQ.1) CALL CRAM(5HSHORT)
  436. X`09IF(LENGTH.EQ.2) CALL CRAM(6HMEDIUM)
  437. X`09IF(LENGTH.EQ.4) CALL CRAM(4HLONG)
  438. X`09IF(SKILL.EQ.1) CALL CRAM(7H NOVICE)
  439. X`09IF(SKILL.EQ.2) CALL CRAM(5H FAIR)
  440. X`09IF(SKILL.EQ.3) CALL CRAM(5H GOOD)
  441. X`09IF(SKILL.EQ.4) CALL CRAM(7H EXPERT)
  442. X`09IF(SKILL.EQ.5) CALL CRAM(9H EMERITUS)
  443. X`09CALL CRAMDMP(6H GAME.)
  444. X`09IF(IDIDIT.EQ.0)GO TO 110
  445. X`09CALL CRAM(25HYOUR SECRET PASSWORD IS ')
  446. X`09CALL CRAMS(PASSWD,8)
  447. X`09CALL CRAMDMP(2H'.)
  448. X110`09KILLTOT=KILLK+KILLC+NSCKILL
  449. X`09CALL CRAMI(KILLTOT,0)
  450. X`09CALL CRAM(4H OF )
  451. X`09CALL CRAMSP(INKLING,'KLINGON')
  452. X`09IF(KILLTOT.EQ.1)CALL CRAM(' HAS')
  453. X`09IF(KILLTOT.NE.1)CALL CRAM(' HAVE')
  454. X`09CALL CRAM(' BEEN KILLED, INCLUDING ')
  455. X`09CALL CRAMSP(KILLC,'COMMANDER')
  456. X`09CALL CRAMDMP('.')
  457. X`09IF(SKILL.LE.2) GOTO 200
  458. X`09CALL CRAM(24HTHE SUPER-COMMANDER HAS )
  459. X`09IF(NSCREM.EQ.1) CALL CRAM(4HNOT )
  460. X`09CALL CRAMDMP(15HBEEN DESTROYED.)
  461. XC*--GIVE HIM THE POOP ON THE BASES.
  462. X200`09DESTBAS=INBASE-REMBASE
  463. X`09IF(DESTBAS.EQ.0)GO TO 210
  464. X`09CALL CRAMSP(DESTBAS,'BASE')
  465. X`09CALL CRAM(' DESTROYED, ')
  466. X210`09CALL CRAMSP(REMBASE,'BASE')
  467. X`09IF(DESTBAS.NE.0)CALL CRAM(' REMAINING')
  468. X`09CALL CRAMDMP('.')
  469. XC*--IS A COMMANDER CHOMPING ON A BASE?
  470. X`09IF(ICSOS.EQ.0)GO TO 240
  471. X`09IF(FUTURE(5).GE. 1.E38) GOTO 240
  472. X`09IF(REMCOM.EQ.0 .OR. REMBASE.EQ.0)GO TO 240
  473. X`09IF(MOD(GALAXY(BATX,BATY),100).LT.10)GO TO 240
  474. X`09DO 220 I=1,REMCOM
  475. X`09IF(CX(I).EQ.BATX .AND. CY(I).EQ.BATY)GO TO 221
  476. X220`09CONTINUE
  477. X`09GO TO 240
  478. +-+-+-+-+-+-+-+-  END  OF PART 16 +-+-+-+-+-+-+-+-
  479.