home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1994 March / Source_Code_CD-ROM_Walnut_Creek_March_1994.iso / compsrcs / games / vmsnet / startrek / part11 < prev    next >
Encoding:
Internet Message Format  |  1993-04-06  |  14.5 KB
  1. Path: uunet!cs.utexas.edu!swrinde!zaphod.mps.ohio-state.edu!usc!elroy.jpl.nasa.gov!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 [11/18]
  5. Date: 7 Apr 93 10:57:47 EDT
  6. Organization: Pembroke State University
  7. Lines: 445
  8. Message-ID: <1993Apr7.105747.1@pembvax1.pembroke.edu>
  9. NNTP-Posting-Host: papa.pembroke.edu
  10. Xref: uunet vmsnet.sources.games:653
  11.  
  12. -+-+-+-+-+-+-+-+ START OF PART 11 -+-+-+-+-+-+-+-+
  13. X`09IF(I.LE.NENHERE) GOTO 1
  14. X`09CALL SORTKL
  15. X`09RETURN
  16. X      END`20
  17. $ CALL UNPACK TRMOVECOM.FOR;1 1446162428
  18. $ create 'f'
  19. X      SUBROUTINE MOVETHO
  20. X`09INCLUDE 'TREKCOM/NOLIST'
  21. X      EQUIVALENCE (KSTUF(1),ITHERE),(KSTUF(2),ITHX),(KSTUF(3),ITHY)`20
  22. X `20
  23. X      IF(ITHERE.EQ.0) RETURN
  24. X      IF(JUSTIN.EQ.1) RETURN
  25. X `20
  26. X      IF((ITHX.EQ.1).AND.(ITHY.EQ.1)) GO TO 10   `20
  27. X      IF((ITHX.EQ.1).AND.(ITHY.EQ.10))GO TO 20   `20
  28. X      IF((ITHX.EQ.10).AND.(ITHY.EQ.10))GOTO 30   `20
  29. X      IF((ITHX.EQ.10).AND.(ITHY.EQ.1))GO TO 40   `20
  30. XC---------SOMETHING IS VERY WRONG....GET RID OF THOLIAN. `20
  31. X      ITHERE=0   `20
  32. X      RETURN     `20
  33. X       `20
  34. XC--------SET DESTINATION SECTOR.     `20
  35. X10`09IDX=1
  36. X`09IDY=10
  37. X`09GO TO 50
  38. X20`09IDX=10
  39. X`09IDY=10
  40. X`09GO TO 50
  41. X30`09IDX=10
  42. X`09IDY=1
  43. X`09GO TO 50
  44. X40`09IDX=1
  45. X`09IDY=1
  46. X       `20
  47. XC----------MAKE SURE DESTINATION IS EMPTY. IF NOT, FORGET IT.      `20
  48. X50    IF((QUAD(IDX,IDY).NE.IHDOT).AND.(QUAD(IDX,IDY).NE.IHNUM))      `20
  49. X     2  RETURN   `20
  50. X      QUAD(ITHX,ITHY)=IHNUM`20
  51. X      IF(ITHX.EQ.IDX) GO TO 120      `20
  52. XC----------MOVE THOLIAN ON X-AXIS    `20
  53. X      IM=ABS(FLOAT(IDX-ITHX))/FLOAT(IDX-ITHX)  `20
  54. X70    IF(ITHX.EQ.IDX) GO TO 200      `20
  55. X      ITHX=ITHX+IM
  56. X      IF(QUAD(ITHX,ITHY).EQ.IHDOT) QUAD(ITHX,ITHY)=IHNUM `20
  57. X      GO TO 70   `20
  58. X120   IF(ITHY.EQ.IDY) GO TO 200      `20
  59. XC------------MOVE THOLIAN ON Y-AXIS. `20
  60. X      IM=ABS(FLOAT(IDY-ITHY))/FLOAT(IDY-ITHY)  `20
  61. X130   IF(ITHY.EQ.IDY) GO TO 200      `20
  62. X      ITHY=ITHY+IM
  63. X      IF(QUAD(ITHX,ITHY).EQ.IHDOT) QUAD(ITHX,ITHY)=IHNUM `20
  64. X      GO TO 130  `20
  65. X200   QUAD(ITHX,ITHY)=IHT  `20
  66. XC-------CHECK TO SEE IF ALL HOLES ARE PLUGED   `20
  67. X      DO 220 I=1,10`20
  68. X      IF(QUAD(1,I).EQ.IHNUM) GO TO 205
  69. X      IF(QUAD(1,I).NE.IHT) RETURN    `20
  70. X205   IF(QUAD(10,I).EQ.IHNUM) GO TO 210`20
  71. X      IF(QUAD(10,I).NE.IHT) RETURN   `20
  72. X210   IF(QUAD(I,1).EQ.IHNUM) GO TO 215
  73. X      IF(QUAD(I,1).NE.IHT) RETURN    `20
  74. X215   IF(QUAD(I,10).EQ.IHNUM) GO TO 220`20
  75. X      IF(QUAD(I,10).NE.IHT) RETURN   `20
  76. X220   CONTINUE   `20
  77. XC-------ALL PLUGED UP, THOLIAN SPLITS.
  78. X      QUAD(ITHX,ITHY)=IHNUM`20
  79. X      CALL DROPIN('@',ID1,ID2)   `20
  80. X      ITHERE=0   `20
  81. X      CALL CRMSENA(IHT,2,ITHX,ITHY)  `20
  82. X      CALL CRAMDMP(15H COMPLETES WEB.    )     `20
  83. X      RETURN     `20
  84. X      END`20
  85. $ CALL UNPACK TRMOVETHO.FOR;1 1718768731
  86. $ create 'f'
  87. X      SUBROUTINE NEWCOND
  88. X`09INCLUDE 'TREKCOM/NOLIST'
  89. X      CONDIT=IHGREEN
  90. X      IF(ENERGY .LT. 1000.0) CONDIT=IHYELLO
  91. X      IF((GALAXY(QUADX,QUADY) .GT. 99) .OR. (NEWSTUF(QUADX,QUADY) .GT.
  92. X     C 9))CONDIT=IHRED
  93. X      RETURN
  94. X      END`20
  95. $ CALL UNPACK TRNEWCOND.FOR;1 192507788
  96. $ create 'f'
  97. X      SUBROUTINE NEWQUAD
  98. X`09INCLUDE 'TREKCOM/NOLIST'
  99. X`09LOGICAL*1 ISHIP
  100. X      INTEGER QUADNUM`20
  101. X`09REAL*8 THOLIANX
  102. X      EQUIVALENCE (CRACKS(2),SHUTUP),(SHIP,ISHIP)
  103. X      EQUIVALENCE (KSTUF(1),ITHERE),(KSTUF(2),ITHX),(KSTUF(3),ITHY)`20
  104. X`09DATA THOLIANX/8HTHOLIANX/
  105. X      JUSTIN=1
  106. X`09BASEX=0
  107. X`09BASEY=0
  108. X`09KLHERE=0
  109. X`09COMHERE=0
  110. X`09PLNETX=0
  111. X`09PLNETY=0
  112. X`09ISHERE=0
  113. X`09IRHERE=0
  114. X`09IPLANET=0
  115. X`09NENHERE=0
  116. X`09NEUTZ=0
  117. X`09INORBIT=0
  118. X`09LANDED=-1
  119. X`09IENTESC=0
  120. X      ITHERE=0   `20
  121. X      IF(ISCATE .EQ. 0) GO TO 5`20
  122. XC--------ENTERPRISE TRIED TO ESCAPE FROM A SUPER-COMMANDER.`20
  123. X`09ISCATE=0
  124. X`09IENTESC=1
  125. X5     QUADNUM=GALAXY(QUADX,QUADY)`20
  126. X      IF(QUADNUM .GT. 999) GO TO 70`20
  127. X      KLHERE=QUADNUM/100
  128. X`09NEWNUM=NEWSTUF(QUADX,QUADY)
  129. X`09IRHERE=NEWNUM/10
  130. X`09NPLAN=NEWNUM-IRHERE*10
  131. X`09NENHERE=KLHERE+IRHERE
  132. XC--------EMPTY QUADRANT AND POSITION STARSHIP`20
  133. X      DO 15 I=1,10
  134. X      DO 15 J=1,10
  135. X15    QUAD(I,J)=IHDOT`20
  136. X      QUAD(SECTX,SECTY)=ISHIP
  137. XC-----------DECIDE IF THIS QUADRENT NEEDS A THOLIAN..... `20
  138. X      IF((RANF(0).GT.0.08).AND.(PASSWD.NE.8HTHOLIANX)) GO TO 23      `20
  139. XC--------DECIDE POSITION FOR THOLIAN......     `20
  140. X17    ITHX=INT(RANF(0)+0.5)*9+1      `20
  141. X      ITHY=INT(RANF(0)+0.5)*9+1      `20
  142. X      IF(QUAD(ITHX,ITHY).NE.IHDOT) GO TO 17    `20
  143. X      QUAD(ITHX,ITHY)=IHT  `20
  144. X      ITHERE=1   `20
  145. XC---------PUT AN X IN EACH UNOCCUPIED CORNER. (TO RESERVE IT)      `20
  146. X      IF(QUAD(1,1).EQ.IHDOT) QUAD(1,1)=1HX     `20
  147. X      IF(QUAD(1,10).EQ.IHDOT)QUAD(1,10)=1HX    `20
  148. X      IF(QUAD(10,10).EQ.IHDOT)QUAD(10,10)=1HX  `20
  149. X      IF(QUAD(10,1).EQ.IHDOT)QUAD(10,1)=1HX    `20
  150. X23    CONTINUE   `20
  151. XC--------POSITION ORDINARY KLINGON VESSELS
  152. X      IF(QUADNUM .LT.100)GO TO 34`20
  153. X      QUADNUM=QUADNUM-100*KLHERE
  154. X      DO 25 I=1,KLHERE
  155. X      CALL DROPIN(IHK,IX,IY)
  156. X`09KX(I)=IX
  157. X`09KY(I)=IY
  158. X 25   KPOWER(I)=RANF(0)*150.0+300.+25.*SKILL
  159. XC--------IF THIS QUADRANT NEEDS A COMMANDER, PROMOTE ONE KLINGON
  160. X      IF(REMCOM .EQ. 0) GO TO 32
  161. X      DO 30 I=1,REMCOM
  162. X      IF(CX(I) .EQ. QUADX .AND. CY(I) .EQ. QUADY)GO TO 31`20
  163. X 30   CONTINUE
  164. X      GO TO 32
  165. X 31   QUAD(IX,IY)=IHC`20
  166. X      KPOWER(KLHERE)=950.0+400.0*RANF(0)+50.*SKILL
  167. X      COMHERE=1`20
  168. X      COMX=IX`20
  169. X      COMY=IY`20
  170. XC--------IF THIS QUADRANT NEEDS A SUPER-COMMANDER, PROMOTE ONE KLINGON.`20
  171. X 32   I=KLHERE
  172. X      IF((QUADX .NE. ISX) .OR. (QUADY .NE. ISY)) GO TO 34`20
  173. X      IF(COMHERE .EQ. 0) GO TO 33`20
  174. X`09I=KLHERE-1
  175. X`09IX=KX(I)
  176. X`09IY=KY(I)
  177. X 33   QUAD(IX,IY) = IHS`20
  178. X      KPOWER(I)=1175.0+400.0*RANF(0)+125.0*SKILL
  179. X`09ISCATE=1
  180. X`09ISHERE=1
  181. XC--------PUT IN ROMULANS IF NEEDED.`20
  182. X34`09IF(IRHERE .EQ. 0) GO TO 37
  183. X      ITEMP1=KLHERE+1`20
  184. X      DO 36 I=ITEMP1, NENHERE`20
  185. X      CALL DROPIN(IHR,IX,IY)
  186. X`09KX(I)=IX
  187. X`09KY(I)=IY
  188. X 36   KPOWER(I)=450.+400.*RANF(0)+50.*SKILL`20
  189. X37`09CALL RESETD
  190. X`09CALL SORTKL
  191. XC--------IF QUADRANT CONTAINS A STARBASE, CHOOSE ITS POSITION`20
  192. X      IF(QUADNUM .LT. 10)GO TO 50    `20
  193. X      QUADNUM =QUADNUM - 10`20
  194. X      CALL DROPIN(IHB,BASEX,BASEY)
  195. XC--------IF QUADRANT NEEDS A PLANET, PUT ONE IN.
  196. X 50   IF(NPLAN .EQ. 0) GO TO 54`20
  197. X      DO 51 I=1,INPLAN
  198. X      IPLANET=I`20
  199. X      IF(PLNETS(I,1) .EQ. QUADX .AND. PLNETS(I,2) .EQ. QUADY) GO TO 52
  200. X 51   CONTINUE
  201. X`09IPLANET=0
  202. X`09GO TO 54
  203. X 52   CALL DROPIN(IHP,PLNETX,PLNETY)
  204. XC--------AND FINALLY, THE STARS`20
  205. X54    CALL NEWCOND
  206. X      IF(QUADNUM .LT. 1)GO TO 62
  207. X      DO 60I=1,QUADNUM
  208. X 60   CALL DROPIN(IHSTAR,IX,IY)`20
  209. XC--------IF ROMULANS PRESENT WITHOUT KLINGONS OR BASE, PRINT SPECIAL MESSAGE
  210. V.`20
  211. X 62   IF((IRHERE .EQ. 0) .OR. (KLHERE .NE. 0) .OR. (BASEX .NE. 0))GOTO66
  212. X      IF(DAMAGE(9) .GT. 0.) GO TO 64
  213. X      CALL SKIP(1)
  214. X      CALL PROUT(41HLT. UHURA:  "CAPTAIN, AN URGENT MESSAGE.       ,41)
  215. X      CALL PROUT(31H  I'LL PUT IT ON AUDIO." CLICK    ,31)`20
  216. X      CALL SKIP(1)
  217. X      CALL PROUT(58H  "INTRUDER!  YOU HAVE VIOLATED THE ROMULAN NEUTRAL
  218. V      `20
  219. X     CZONE."    ,58)`20
  220. X      CALL PROUT(44H  "LEAVE AT ONCE, OR YOU WILL BE DESTROYED!"    ,44)
  221. V      `20
  222. X 64   NEUTZ=1`20
  223. XC--------PUT IN "THING" IF NEEDED`20
  224. X 66   IF(SHUTUP.NE.0.) GO TO 67      `20
  225. X      IF(THINGX.NE.QUADX .OR. THINGY.NE.QUADY) GO TO 67`20
  226. X      CALL DROPIN(IHQUEST,IX,IY)
  227. X`09THINGX=0
  228. X`09THINGY=0
  229. X      IF(DAMAGE(1) .GT. 0) GO TO 67
  230. X      CALL SKIP(1)
  231. X      CALL PROUT(`20
  232. X     +   43HMR. SPOCK:  "CAPTAIN, THIS IS MOST UNUSUAL.,43)
  233. X      CALL PROUT(`20
  234. X     +   43H     PLEASE EXAMINE YOUR SHORT-RANGE SCAN.",43)
  235. XC--------DROP IN A FEW BLACK HOLES
  236. X 67   DO 68 I=1,3`20
  237. X 68   IF(RANF(0) .GT. 0.89) CALL DROPIN('@',IX,IY)   `20
  238. XC----------IF THOLIAN HERE, TAKE THE X OUT OF EACH CORNER.
  239. X      IF(ITHERE.EQ.0) RETURN
  240. X      IF(QUAD(1,1).EQ.1HX) QUAD(1,1)=IHDOT     `20
  241. X      IF(QUAD(1,10).EQ.1HX)QUAD(1,10)=IHDOT    `20
  242. X      IF(QUAD(10,10).EQ.1HX)QUAD(10,10)=IHDOT  `20
  243. X      IF(QUAD(10,1).EQ.1HX) QUAD(10,1)=IHDOT   `20
  244. X      RETURN     `20
  245. XC--------COPE IF QUADRANT CONTAINS ONLY A SUPERNOVA`20
  246. X70    DO 75 I=1,10
  247. X      DO 75 J=1,10
  248. X75    QUAD(I,J)=IHDOT`20
  249. X      RETURN
  250. X      END`20
  251. $ CALL UNPACK TRNEWQUAD.FOR;1 1363100824
  252. $ create 'f'
  253. X      SUBROUTINE NOVA(IX,IY)
  254. XC
  255. XC`095-DEC-79
  256. XC`09DON'T CHARGE PLAYER FOR A PLANET NOVAED BY AN ENEMY
  257. XC
  258. X`09INCLUDE 'TREKCOM/NOLIST'
  259. X`09LOGICAL*1 IQUAD,IQUAD1,ISHIP
  260. X      INTEGER BURST,HITS(10,2),BOT,TOP,TOP2`20
  261. X      DIMENSION COURSE(9)`20
  262. X      EQUIVALENCE (CRACKS(1),HIT),(CRACKS(4),KSHOT),(SHIP,ISHIP)
  263. X      DATA COURSE/ 10.5, 12.0, 1.5, 9.0, 0.0, 3.0, 7.5, 6.0, 4.5 /
  264. XC--------CHECK FOR SUPERNOVA POSSIBILITY
  265. X      IF(RANF(0) .GE. 0.05) GO TO 76 `20
  266. X      CALL SNOVA(IX,IY)`20
  267. X      RETURN
  268. XC--------PRINT NOVA MESSAGE FOR INITIAL STAR AT LOCATION (IX,IY)
  269. X 76   QUAD(IX,IY)=IHDOT`20
  270. X      CALL CRMSENA(IHSTAR,2,IX,IY)
  271. X      CALL CRAMDMP(7H NOVAS.)`20
  272. X      GALAXY(QUADX,QUADY)=GALAXY(QUADX,QUADY)-1`20
  273. XC-------IF ENTERPRISE DESTROYS STAR, TAKE OFF POINTS     `20
  274. X      IF(IPHWHO.NE.1) STARKL=STARKL+1`20
  275. XC--------SET UP STACK TO RECURSIVELY TRIGGER ADJACENT STARS`20
  276. X`09BOT=1
  277. X`09TOP=1
  278. X`09TOP2=1
  279. X`09KOUNT=0
  280. X`09ICX=0
  281. X`09ICY=0
  282. X      HITS(BOT,1)=IX
  283. X      HITS(BOT,2)=IY
  284. X 78   DO 90 MM=BOT,TOP
  285. X      DO 90 NN=1,3
  286. X      DO 90 J=1,3`20
  287. X      IF((J*NN) .EQ. 4)GO TO 90`20
  288. X      II=HITS(MM,1)+NN-2
  289. X      JJ=HITS(MM,2)+J-2`20
  290. X      IF(II .LT. 1 .OR. II .GT. 10)GO TO 90`20
  291. X      IF(JJ .LT. 1 .OR. JJ .GT. 10)GO TO 90`20
  292. X      IQUAD=QUAD(II,JJ)`20
  293. X      IF(IQUAD.EQ.IHDOT .OR. IQUAD.EQ.IHQUEST .OR. IQUAD.EQ.'@')
  294. X     +  GO TO 90
  295. X      IF(IQUAD.EQ.IHNUM) GO TO 90    `20
  296. X      IF(IQUAD.EQ.IHT) GO TO 90      `20
  297. X      IF(IQUAD .NE. IHSTAR) GO TO 80
  298. XC--------ANOTHER STAR AFFECTED BY A NOVA
  299. X      IF(RANF(0.) .GE. .05)GO TO 79`20
  300. X      CALL SNOVA(II,JJ)`20
  301. X      RETURN
  302. X 79   TOP2=TOP2+1`20
  303. X      HITS(TOP2,1)=II`20
  304. X      HITS(TOP2,2)=JJ`20
  305. X      GALAXY(QUADX,QUADY)=GALAXY(QUADX,QUADY)-1`20
  306. X      IF(IPHWHO.NE.1) STARKL=STARKL+1`20
  307. X      CALL CRMSENA(IHSTAR,2,II,JJ)
  308. X      CALL CRAM(7H NOVAS.)
  309. X      GO TO 8905
  310. X 80   IF(IQUAD .NE. IHP) GO TO 8002`20
  311. XC--------PLANET DESTROYED BY NOVA.
  312. X      NEWSTUF(QUADX,QUADY)=NEWSTUF(QUADX,QUADY) -1
  313. X`09IF(IPHWHO.NE.1)NPLANKL=NPLANKL+1
  314. X      CALL CRMSENA(IHP,2,II,JJ)`20
  315. X      CALL CRAM(11H DESTROYED.)`20
  316. X      DO 8001 I=1,5`20
  317. X 8001 PLNETS(IPLANET,I)=0
  318. X`09IPLANET=0
  319. X`09PLNETX=0
  320. X`09PLNETY=0
  321. X`09IF(LANDED .NE. 1) GO TO 8905
  322. X`09CALL FINISH
  323. X`09GO TO 95
  324. X 8002 IF(IQUAD .NE. IHB) GO TO 82`20
  325. XC----------NOVA DESTROYS STARBASE`20
  326. X      GALAXY(QUADX,QUADY)=GALAXY(QUADX,QUADY)-10
  327. X      DO 81 LLL=1,REMBASE`20
  328. X      IF(BASEQX(LLL).NE.QUADX .OR. BASEQY(LLL).NE.QUADY) GO TO 81`20
  329. X      BASEQX(LLL)=BASEQX(REMBASE)`20
  330. X      BASEQY(LLL)=BASEQY(REMBASE)`20
  331. X 81   CONTINUE
  332. X      REMBASE=REMBASE-1`20
  333. X`09BASEX=0
  334. X`09BASEY=0
  335. X      IF(IPHWHO.NE.1) BASEKL=BASEKL+1`20
  336. X      CALL NEWCOND
  337. X      CALL CRMSENA(IHB,2,II,JJ)`20
  338. X      CALL CRAM(12H DESTROYED. )
  339. X      GO TO 8905
  340. X 82   HIT=800.0 + 800.0*RANF(0)`20
  341. X      IF(IQUAD .NE.ISHIP) GO TO 87
  342. XC----------STARSHIP IN A NOVA`20
  343. X      CALL PROUT(29H***STARSHIP BUFFETED BY NOVA.,29)
  344. X      KSHOT=0`20
  345. X      CALL ZAP
  346. XC-------CHECK IF STARSHIP SURVIVED NOVA`20
  347. X      IF(ENERGY .GT. 0)GO TO 86`20
  348. X      CALL FINISH(7)
  349. X      RETURN
  350. XC--------ADD IN COURSE NOVA CONTRIBUTES TO KICKING STARSHIP`20
  351. X 86   ICX=ICX+SECTX-HITS(MM,1)
  352. X      ICY=ICY+SECTY-HITS(MM,2)
  353. X      KOUNT=KOUNT+1`20
  354. X      GO TO 90
  355. XC--------ENEMY DESTROYED OR DAMAGED ; BUFFETED BY NOVA.`20
  356. X 87   IF(IQUAD .EQ. IHK) GO TO 88`20
  357. X      DO 8701 LL=1,NENHERE
  358. X      IF(KX(LL).EQ.II .AND. KY(LL).EQ.JJ) GO TO 8702
  359. X 8701 CONTINUE
  360. X 8702 KPOWER(LL)=KPOWER(LL)-HIT`20
  361. X      IF(KPOWER(LL) .LE. 0) GO TO 88
  362. X      NEWCX=II+II-HITS(MM,1)
  363. X      NEWCY=JJ+JJ-HITS(MM,2)
  364. X      CALL CRMSENA(IQUAD,2,II,JJ)`20
  365. X      CALL CRAM(8H DAMAGED)`20
  366. X      IF(NEWCX.LT.1 .OR. NEWCX.GT.10 .OR.`20
  367. X     +   NEWCY.LT.1 .OR. NEWCY.GT.10) GO TO 8703
  368. X      IQUAD1=QUAD(NEWCX,NEWCY)
  369. X      IF(IQUAD1 .NE. '@') GO TO 87025`20
  370. XC--------ENEMY DISPLACED INTO BLACK HOLE
  371. X      CALL CRAMDMP(26H, BLASTED INTO BLACK HOLE.)`20
  372. X      CALL DEADKL(II,JJ,IQUAD,NEWCX,NEWCY)`20
  373. X`09GO TO 90
  374. X87025 IF(IQUAD1 .NE. IHDOT) GO TO 8703
  375. X      CALL CRAM(13H, BUFFETED TO)`20
  376. X      CALL CRAMLOC(2,NEWCX,NEWCY)`20
  377. X      QUAD(II,JJ)=IHDOT`20
  378. X      QUAD(NEWCX,NEWCY)=IQUAD`20
  379. X      KX(LL)=NEWCX
  380. X      KY(LL)=NEWCY
  381. X      KDIST(LL)=          SQRT(FLOAT((SECTX-NEWCX)**2+(SECTY-NEWCY)**2))
  382. X 8703 CALL CREND
  383. X      GO TO 90
  384. XC--------ENEMY DESTROYED BY NOVA.`20
  385. X 88   CALL DEADKL(II,JJ,IQUAD,II,JJ)
  386. X      GO TO 90
  387. X 8905 CALL CREND
  388. X      QUAD(II,JJ)=IHDOT`20
  389. X 90   CONTINUE
  390. XC--------IF MORE STARS AFFECTED BY NOVA GO FIND WHAT THEY GOT`20
  391. X      IF(TOP .EQ. TOP2)GO TO 93`20
  392. X      BOT=TOP+1`20
  393. X      TOP=TOP2
  394. X      GO TO 78
  395. X 93   IF(KOUNT .EQ. 0)RETURN
  396. XC--------STARSHIP AFFECTED BY NOVA - KICK IT AWAY.
  397. X      DIST=KOUNT*.1`20
  398. X      IF(ICX .NE. 0) ICX=ISIGN(1,ICX)`20
  399. X      IF(ICY .NE. 0) ICY=ISIGN(1,ICY)`20
  400. X      INDEX=3*(ICX+1)+ICY+2`20
  401. X      DIREC=COURSE(INDEX)`20
  402. X      IF(DIREC .EQ. 0) DIST=0`20
  403. X      IF(DIST .EQ. 0)RETURN`20
  404. X      TIME=12.0*DIST
  405. X      CALL SKIP(1)
  406. X      CALL PROUT(34HFORCE OF NOVA DISPLACES STARSHIP. ,34)`20
  407. X      CALL MOVE`20
  408. X 95   RETURN
  409. X      END`20
  410. $ CALL UNPACK TRNOVA.FOR;1 1734993791
  411. $ create 'f'
  412. X      SUBROUTINE PHASERS
  413. XC
  414. XC`094-APR-79
  415. XC`09THIS MODULE HAS BEEN WORKED OVER TO MAKE IT HARDER TO FIRE THE
  416. XC`09PHASERS ACCIDENTALLY WHEN YOU REALLY WANTED TO DO SOMETHING
  417. XC`09ELSE.  ALSO, THE BATTLE COMPUTER DAMAGE LOOPHOLE HAS BEEN
  418. XC`09CLOSED.
  419. XC`093-DEC-79
  420. XC`09ALLOW PLAYER TO OBTAIN BATTLE COMPUTER DATA EVEN IF THE PHASERS
  421. XC`09ARE BROKEN (OR OTHERWISE UNUSABLE).
  422. XC
  423. X`09INCLUDE 'TREKCOM/NOLIST'
  424. X`09LOGICAL*1 IENM
  425. X`09LOGICAL CROP
  426. X`09REAL*8 AITEM
  427. X`09BYTE ITM
  428. X`09COMMON/SCANBF/KEY,AITEM
  429. X`09EQUIVALENCE (FNUM,AITEM)
  430. X`09EQUIVALENCE (ITM,AITEM)
  431. X      REAL HITS(20)`20
  432. X`09DATA PHASFAC/2.0/
  433. X      IFAST=0
  434. X`09NO=0
  435. X      IDIDIT=1
  436. X`09IPOOP=1
  437. X      IF(DAMAGE(1)+DAMAGE(11) .GT. 0.0) IPOOP=0`20
  438. X`09IDOIT=1
  439. XC--------ENSURE PHASERS CAN BE FIRED
  440. X      IF(CONDIT .NE.IHDOCKD  )GO TO 5`20
  441. X      CALL PROUT(`20
  442. X     +  44HPHASERS CAN'T BE FIRED THROUGH BASE SHIELDS.,44)
  443. X      GO TO 19
  444. X5     IF(DAMAGE(3) .EQ. 0)GO TO 10
  445. X      CALL PROUT(23HPHASER CONTROL DAMAGED.,23)
  446. X      GO TO 19
  447. XC--------DO CHECKS FOR HI-SPEED SHIELD CONTROL
  448. X 10   IF(SHLDUP .EQ. 0)GO TO 20`20
  449. X      IF(DAMAGE(13) .EQ. 0.) GO TO 13`20
  450. X      CALL PROUT(34HHIGH-SPEED SHIELD CONTROL DAMAGED.,34)`20
  451. X      GO TO 19
  452. X 13   IF(ENERGY .GT. 200.) GO TO 16`20
  453. X      CALL PROUT(58HINSUFFICIENT ENERGY TO ACTIVATE HIGH-SPEED SHIELD CO
  454. X     CNTROL.   ,58)
  455. X19`09IDOIT=0
  456. +-+-+-+-+-+-+-+-  END  OF PART 11 +-+-+-+-+-+-+-+-
  457.