home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1994 March / Source_Code_CD-ROM_Walnut_Creek_March_1994.iso / compsrcs / games / vmsnet / startrek / part09 < prev    next >
Encoding:
Internet Message Format  |  1993-04-06  |  14.4 KB
  1. Path: uunet!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 [09/18]
  5. Date: 7 Apr 93 10:55:12 EDT
  6. Organization: Pembroke State University
  7. Lines: 443
  8. Message-ID: <1993Apr7.105512.1@pembvax1.pembroke.edu>
  9. NNTP-Posting-Host: papa.pembroke.edu
  10. Xref: uunet vmsnet.sources.games:651
  11.  
  12. -+-+-+-+-+-+-+-+ START OF PART 9 -+-+-+-+-+-+-+-+
  13. X 1401 CALL PROUT('YOU AND YOUR LANDING PARTY ARE STRANDED ON A',44)
  14. X      CALL CRAM('CLASS ')
  15. X      CALL CRAMEN(ICLASS)
  16. X      CALL CRAMDMP(' PLANET, WHICH IS INCAPABLE OF SUPPORTING')
  17. X      CALL PROUT('HUMAN LIFE.  AFTER YOUR SUIT LIFE SUPPORT SYSTEMS',49)
  18. X      CALL PROUT('ARE EXHAUSTED, YOU DIE.',23)
  19. X 1410 CALL SKIP(1)
  20. X      CALL CRAM(29HWITHOUT YOUR LEADERSHIP, THE  )
  21. X      CALL CRAMSHP
  22. X      CALL CRAMDMP(14H IS DESTROYED.)`20
  23. X      GO TO 5000
  24. XC--------CASE 15:  ENTERPRISE DESTROYS PLANET WITH MINING PARTY ON IT.
  25. X 1500 CALL PROUT(33HYOU AND YOUR MINING PARTY PERISH.       ,33)`20
  26. X      GO TO 705`20
  27. XC--------CASE 16.  KIRK FRIED BY NOVA WHILE ON PLANET.
  28. X 1600 CALL PROUT(41HYOU AND YOUR MINING PARTY ARE ATOMIZED.       ,41)`20
  29. X      CALL SKIP(1)
  30. X      CALL CRAM(31HMR. SPOCK TAKES COMMAND OF THE  )
  31. X      CALL CRAMSHP
  32. X      CALL CRAMDMP(4H AND)
  33. X      CALL PROUT(54HJOINS THE ROMULANS, REIGNING TERROR ON THE FEDERATIO
  34. X     CN.     ,54)
  35. X      GO TO 5000
  36. XC--------CASE 17.  KIRK FRIED BY SUPERNOVA IN SHUTTLE CRAFT.
  37. X 1700 CALL PROUT(51HGALILEO IS INSTANTLY ANNIHILATED BY THE SUPERNOVA.
  38. X     C     ,51)   `20
  39. X      GO TO 1600
  40. XC--------CASE 18.  SHUTTLE CRAFT CAUGHT IN TRACTOR BEAM.
  41. X 1800 CALL PROUT(37HSHUTTLE CRAFT GALILEO IS ALSO CAUGHT,     ,37)`20
  42. X      CALL PROUT(31HAND BREAKS UP UNDER THE STRAIN.      ,31)
  43. X      CALL SKIP(1)
  44. X      CALL PROUT(47HYOUR DEBRIS IS SCATTERED FOR MILLIONS OF MILES. `20
  45. X`091 ,47)
  46. X      GO TO 1410
  47. XC--------CASE 19.  DEATH RAY CONVERTS CREW INTO MUTANTS.
  48. XC--------CASE 21.  BLACK HOLE SWALLOWS SHIP.
  49. X 2100 CALL PROUT(51HYOUR SHIP IS DRAWN TO THE CENTER OF THE BLACK HOLE.`20
  50. X     +  ,51)`20
  51. X      CALL PROUT(44HYOU ARE CRUSHED INTO EXTREMELY DENSE MATTER.,44)`20
  52. X      GO TO 5000
  53. XC--------CASE 22.  SHIP DESTROYED BY A TORPEDO BOOMERANG
  54. X 2200 CALL PROUT(31HYOU ARE POSTHUMOUSLY AWARDED A     ,31)
  55. X      CALL PROUT(31HSTARFLEET MARKSMANSHIP AWARD.       ,31)`20
  56. X      GO TO 705`20
  57. XC--------DECIDE FINAL OUTCOME OF GAME AFTER YOUR DEATH
  58. X 5000 CALL SKIP(1)
  59. X      IF(ISHIP .EQ. IHF) ISHIP=0
  60. X      IF(ISHIP .EQ. IHE) ISHIP=IHF
  61. X      ALIVE=0`20
  62. X      IF(REMKL .EQ. 0) GO TO 5050`20
  63. X      GOODIES=REMRES/INRESOR
  64. X      BADDIES=(REMKL+2.0*REMCOM)/(INKLING+2.0*INCOM)
  65. X      ADVANTG=GOODIES/BADDIES`20
  66. X      IF(ADVANTG .LT. (1.0+0.5*RANF(0))) GO TO 5020`20
  67. X      CALL PROUT(`20
  68. X     +   54HAS A RESULT OF YOUR ACTIONS, A TREATY WITH THE KLINGON,54)`20
  69. X      CALL PROUT(`20
  70. X     +   52HEMPIRE HAS BEEN SIGNED.  THE TERMS OF THE TREATY ARE,52)`20
  71. X      IF(ADVANTG .LT. (3.0+RANF(0))) GO TO 5010`20
  72. X      CALL PROUT(`20
  73. X     +   28HFAVORABLE TO THE FEDERATION.,28)`20
  74. X      CALL SKIP(1)
  75. X      CALL PROUT(16HCONGRATULATIONS.,16)`20
  76. X      GO TO 5030
  77. X 5010 CALL PROUT(37HHIGHLY UNFAVORABLE TO THE FEDERATION.,37)
  78. X      GO TO 5030
  79. X 5020 CALL PROUT(33HTHE FEDERATION WILL BE DESTROYED.,33)
  80. X 5030 CALL SCORE
  81. X      RETURN
  82. XC--------STILL ANOTHER CASE--SUCCESSFUL KAZIKAME TACTICS
  83. X 5050 CALL PROUT(`20
  84. X     +   51HSINCE YOU TOOK THE LAST KLINGON WITH YOU, YOU ARE A,51)
  85. X      CALL PROUT(`20
  86. X     +   51HMARTYR AND A HERO.  SOMEDAY MAYBE THEY'LL ERECT A   ,51)`20
  87. X      CALL PROUT(`20
  88. X     +   51HSTATUE IN YOUR MEMORY.  REST IN PEACE, AND TRY NOT  ,51)`20
  89. X      CALL PROUT(`20
  90. X     +   23HTO THINK ABOUT PIGEONS.,23)
  91. X      GAMEWON=1`20
  92. X      ALIVE=0`20
  93. X      CALL SCORE
  94. X      RETURN
  95. X      END`20
  96. $ CALL UNPACK TRFINISH.FOR;1 1225412609
  97. $ create 'f'
  98. X$ COPY TRABANDON.OBJ PART1.OBJ
  99. X$ APPEND -
  100. X`09TRATTACK.OBJ+`09TRAUTOVER.OBJ+`09TRCANTA.OBJ+-
  101. X`09TRCHART.OBJ+`09TRCHOOSE.OBJ+`09TRCRAM.OBJ+`09TRCRAMEN.OBJ+-
  102. X`09TRCRAMLOC.OBJ+`09TRCRAMSHP.OBJ+`09TRCRAMSP.OBJ+`09TRCRMSENA.OBJ+-
  103. X`09TRCROP.OBJ+`09TRDEADKL.OBJ+`09TRDESTRCT.OBJ+`09TRDOCK.OBJ+-
  104. X`09TRDREPORT.OBJ+`09TRDROPIN.OBJ+`09TREMEXIT.OBJ+`09TREVENTS.OBJ -
  105. X`09PART1.OBJ
  106. X$ LINK/EXEC=TREK -
  107. X`09PART1+ -
  108. X`09TREXPRAN+`09TRFINISH+`09TRFREEZE+`09TRGETCD+-
  109. X`09TRGETFN+`09TRGETOUT+`09TRHELP+`09`09TRHITEM+-
  110. X`09TRIMPULSE+`09TRIRAN8+`09TRJA+`09`09TRLRSCAN+-
  111. X`09TRMOVE+`09`09TRMOVECOM+`09TRMOVETHO+`09TRNEWCOND+-
  112. X`09TRNEWQUAD+`09TRNOVA+`09`09TRPHASERS+`09TRPHOTONS+-
  113. X`09TRPLANET+`09TRPLAQUE+`09TRPRELIM+`09TRPROUT+-
  114. X`09TRRAM+`09`09TRRANF+`09`09TRSCAN+`09`09TRSCOM+-
  115. X`09TRSCORE+`09TRSETUP+`09TRSETWARP+`09TRSHIELDS+-
  116. X`09TRSKIP+`09`09TRSNOVA+`09TRSORTKL+`09TRSRSCAN+-
  117. X`09TRTREK+`09`09TRTHAW+`09`09TRTIMEWRP+`09TRWAIT+-
  118. X`09TRWARP+`09`09TRZAP
  119. $ CALL UNPACK TRFIX.COM;1 1464082335
  120. $ create 'f'
  121. X`09SUBROUTINE FREEZE
  122. XC
  123. XC`093-APR-79
  124. XC`09MAKE THE 'GAME FROZEN' MESSAGE COME OUT PROPERLY.
  125. XC
  126. X`09INCLUDE 'TREKCOM/NOLIST'
  127. X`09LOGICAL*1 NAME(30)
  128. X`09CALL GETFN(NAME)
  129. X`09IDIDIT=0
  130. X`09IF(NAME(1).EQ.0) GOTO 920
  131. X`09CALL CLOSE(2)
  132. X`09OPEN(UNIT=2,NAME=NAME,TYPE='UNKNOWN',FORM='UNFORMATTED',ERR=920)
  133. X`09WRITE(2,ERR=920) COMSIZE,ICOM
  134. X`09CALL CLOSE(2)
  135. X`09IDIDIT=1
  136. X`09CALL PROUT(13H GAME FROZEN.   ,13)
  137. X`09RETURN
  138. X920`09CALL PROUT(17H GAME NOT FROZEN.  ,17)
  139. X`09RETURN
  140. X`09END`20
  141. $ CALL UNPACK TRFREEZE.FOR;1 628895905
  142. $ create 'f'
  143. X      SUBROUTINE GETCD
  144. X`09INCLUDE 'TREKCOM/NOLIST'
  145. X`09LOGICAL*2 CROP
  146. X`09REAL*8 AITEM
  147. X`09COMMON/SCANBF/KEY,AITEM
  148. X`09EQUIVALENCE (FNUM,AITEM)
  149. XC        GET COURSE <DIREC> AND DISTANCE <DIST>.  IF USER TYPES`20
  150. XC        BAD VALUES, RETURN WITH <DIREC>=-1.0 .`20
  151. XC--------CHECK TO MAKE SURE NO ONE IS LEFT ON A PLANET.`20
  152. X      IF(LANDED .NE. 1) GO TO 1`20
  153. X      CALL PROUT(41H YOU CAN'T LEAVE STANDARD ORBIT UNTIL YOU ,41)`20
  154. X      CALL CRAM(20HARE BACK ABOARD THE )
  155. X`09CALL CRAMSHP
  156. X`09CALL CRAMDMP(1H.)
  157. X`09GO TO 71
  158. X1`09IROWQ=QUADX
  159. X`09ICOLQ=QUADY
  160. X`09DELTX=0.
  161. X`09DELTY=0.
  162. X`09ITEMP=0
  163. X      IPROMPT=0`20
  164. XC--------CHECK FOR MANUAL OR AUTOMATIC.`20
  165. X10    CALL SCAN`20
  166. X`09IF(KEY.EQ.IHREAL) GOTO 24`09!DEFAULT MANUAL MODE
  167. X      IF(KEY .EQ. IHALPHA) GO TO 13`20
  168. X      IF(DAMAGE(11) .NE. 0) GO TO 1301
  169. X 11   CALL MANORA`20
  170. X      IPROMPT=1`20
  171. X      GO TO 10
  172. X 13   IF (CROP(AITEM,6HMANUAL)) GO TO 20`20
  173. X      IF (.NOT.CROP(AITEM,7HAUTOMAT)) GO TO 11`20
  174. XC--------AUTOMATIC MOVEMENT REQUESTED.  CHECK FOR COMPUTER DAMAGE.
  175. X      IF(DAMAGE(11).EQ.0) GO TO 14
  176. X 1301 CALL PROUT(41HCOMPUTER DAMAGED; MANUAL MOVEMENT ONLY.      ,41)
  177. X      GO TO 2001
  178. XC--------GET QUADRANT AND SECTOR.`20
  179. X 14   CALL SCAN`20
  180. X`09XI=FNUM
  181. X      IF(KEY.NE.IHEOL) GO TO 15`20
  182. X 1410 CALL PROMPT(40HDESTINATION QUADRANT AND/OR SECTOR:     ,40)
  183. X      IPROMPT=1`20
  184. X      GO TO 14
  185. X 15   IF (KEY .NE. IHREAL) GO TO 1410`20
  186. X`09IF(FNUM.EQ.-1.) GO TO 71
  187. X      CALL SCAN`20
  188. X`09XJ=FNUM
  189. X      IF(KEY.NE.IHREAL) GO TO 1410
  190. X      CALL SCAN
  191. X`09XK=FNUM
  192. X      IF (KEY .NE. IHREAL) GO TO 16`20
  193. X      CALL SCAN
  194. X`09XL=FNUM
  195. X      IF (KEY .NE. IHREAL) GO TO 1410`20
  196. XC--------QUADRANT AND SECTOR SPECIFIED.`20
  197. X`09IROWQ=XI+.5
  198. X`09ICOLQ=XJ+.5
  199. X`09IROWS=XK+.5
  200. X`09ICOLS=XL+.5
  201. X`09GO TO 30
  202. XC--------ONLY SECTOR SPECIFIED.`20
  203. X16`09IROWS=XI+.5
  204. X`09ICOLS=XJ+.5
  205. X`09ITEMP=1
  206. X`09GO TO 30
  207. XC--------MANUAL (DELTX, DELTY) MOVEMENT.
  208. X 20   CALL SCAN
  209. X      IF(KEY .EQ. IHREAL) GO TO 24
  210. X 2001 CALL PROMPT(30HX AND Y DISPLACEMENTS:        ,30)`20
  211. X      IPROMPT=1`20
  212. X      GO TO 20
  213. X24`09DELTX=FNUM
  214. X`09CALL SCAN
  215. X`09IF(DELTX.EQ.-1..AND.KEY.EQ.IHEOL) GO TO 71
  216. X`09IF(KEY .NE. IHREAL) GO TO 70
  217. X`09DELTY=FNUM
  218. X`09GO TO 40
  219. XC--------CHECK FOR INVALID INPUT FOR AUTOMATIC CASE.
  220. X 30   IF((IROWQ.LT.1) .OR. (IROWQ.GT.8) .OR. (ICOLQ.LT.1) .OR.
  221. X     C(ICOLQ.GT.8) .OR. (IROWS.LT.1) .OR. (IROWS.GT.10) .OR.
  222. X     C(ICOLS.LT.1) .OR. (ICOLS.GT.10) ) GO TO 70
  223. XC--------PRINT MESSAGE FROM APPROPRIATE OFFICER.
  224. X      IF(ITEMP .EQ. 1) GO TO 31`20
  225. X      CALL PROUT(42HENSIGN CHEKOV:  "COURSE LAID IN, CAPTAIN."   ,42)
  226. X      GO TO 32
  227. X 31   IF(IPROMPT .NE. 1) GO TO 32`20
  228. X      CALL CRAM(37HHELMSMAN SULU:  "COURSE LOCKED IN FOR)`20
  229. X      CALL CRAMLOC(2,IROWS,ICOLS)`20
  230. X      CALL CRAMDMP(2H.")
  231. XC--------CONVERT TO DELTX, DELTY FORM.
  232. X 32   DELTX = ICOLQ -QUADY +0.1*(ICOLS-SECTY)`20
  233. X      DELTY = QUADX -IROWQ + 0.1*(SECTX -IROWS)`20
  234. XC--------CHECK FOR A ZERO MOVEMENT.`20
  235. X 40   IF((DELTX .NE. 0.) .OR. (DELTY .NE. 0.)) GO TO 42`20
  236. X      GO TO 71
  237. X 42   IF(IPROMPT .EQ. 0) GO TO 43`20
  238. X      CALL PROUT(27HHELMSMAN SULU:  "AYE, SIR."  ,27)
  239. XC--------CONVERT INTO COURSE AND DISTANCE.
  240. X 43   DIST = SQRT(DELTX*DELTX+DELTY*DELTY)
  241. X      DIREC = ATAN2(DELTX,DELTY)*1.90985932`20
  242. X      IF(DIREC .LT. 0.) DIREC=12.+DIREC`20
  243. X      RETURN
  244. XC--------GARBAGE IN, GARBAGE OUT
  245. X 70   CALL SKIP(1)
  246. X      CALL BEGPARD
  247. X 71   DIREC=-1.0
  248. X      RETURN
  249. X      END`20
  250. $ CALL UNPACK TRGETCD.FOR;1 1511326570
  251. $ create 'f'
  252. X      SUBROUTINE GETFN(NAME)
  253. XC
  254. XC`093-APR-79
  255. XC`09MODIFIED TO MAKE FROZEN GAMES WORK ON THE VAX.
  256. XC
  257. X`09INCLUDE 'TREKCOM/NOLIST'
  258. X`09LOGICAL*1 NAME(30),AIT(8)
  259. X`09REAL*8 AITEM
  260. X`09COMMON/SCANBF/KEY,AITEM
  261. X`09EQUIVALENCE (AIT,AITEM)
  262. XC*  READ IN A LEGAL FILE NAME (FOR FREEZE AND THAW)
  263. XC*  A NON-ALPHA ENTRY ABORTS THE ATTEMPT`20
  264. X40`09CALL SCAN
  265. X      IF (KEY .EQ. IHEOL) GO TO 75
  266. X      IF (KEY .NE. IHALPHA) GO TO 100`20
  267. X`09NAME(1)='S'
  268. X`09NAME(2)='Y'
  269. X`09NAME(3)='S'
  270. X`09NAME(4)='$'
  271. X`09NAME(5)='D'
  272. X`09NAME(6)='I'
  273. X`09NAME(7)='S'
  274. X`09NAME(8)='K'
  275. X`09NAME(9)=':'
  276. X`09DO 50 I=1,8
  277. X`09IF(AIT(I).EQ.0) GOTO 60
  278. X50`09NAME(I+9)=AIT(I)
  279. X`09I=9
  280. X60`09NAME(I+ 9)='.'
  281. X`09NAME(I+10)='T'
  282. X`09NAME(I+11)='R'
  283. X`09NAME(I+12)='K'
  284. X`09NAME(I+13)=0
  285. X      RETURN     `20
  286. XC*--PROMPT FOR A VALID FILE NAME`20
  287. X 75   CALL PROMPT(18HENTER FILE NAME:      ,18)`20
  288. X      GO TO 40
  289. XC*--NON-ALPHA ITEM ABORTS REQUEST...`20
  290. X100`09NAME(1)=0
  291. X      RETURN
  292. X      END`20
  293. $ CALL UNPACK TRGETFN.FOR;1 1912811171
  294. $ create 'f'
  295. X`09SUBROUTINE GETOUT
  296. XC
  297. XC`094-APR-79 (NEW ROUTINE)
  298. XC`09ERASES THE SCREEN ON A VT52 AND EXITS.
  299. XC
  300. X`09LOGICAL*1 ERASE(5)
  301. X`09DATA ERASE/'$',27,'H',27,'J'/
  302. XC
  303. X`09WRITE(1,1)ERASE
  304. X1`09FORMAT(5A1)
  305. X`09CALL EXIT
  306. X`09END
  307. $ CALL UNPACK TRGETOUT.FOR;1 625347793
  308. $ create 'f'
  309. X      SUBROUTINE HELP`20
  310. XC
  311. XC`094-DEC-79
  312. XC`09SET DISTANCES CORRECTLY WHEN SHIP MATERIALIZES
  313. XC
  314. X`09INCLUDE 'TREKCOM/NOLIST'
  315. X`09LOGICAL*1 ISHIP
  316. X      EQUIVALENCE (CRACKS(2),SHUTUP),(SHIP,ISHIP)
  317. XC--------TEST FOR CONDITIONS WHICH PREVENT CALLING FOR HELP`20
  318. X      IF(CONDIT .NE. IHDOCKD ) GO TO 10`20
  319. X      CALL PROUT(`20
  320. X     +   48HLT. UHURA:  "BUT CAPTAIN, WE'RE ALREADY DOCKED.",48)    `20
  321. X      RETURN
  322. X 10   IF(DAMAGE(9) .EQ. 0) GO TO 20`20
  323. X      CALL PROUT(23HSUBSPACE RADIO DAMAGED.,23)
  324. X      RETURN
  325. X 20   IF(REMBASE .NE. 0) GO TO 30`20
  326. X      CALL PROUT(66HLT. UHURA:  "CAPTAIN, I'M NOT GETTING ANY RESPONSE F
  327. V     `20
  328. X     +ROM STARBASE.",66)`20
  329. X      RETURN
  330. X 30   IF(LANDED .NE. 1) GO TO 31
  331. X      CALL CRAM(23HYOU MUST BE ABOARD THE )`20
  332. X`09CALL CRAMSHP
  333. X`09CALL CRAMDMP(1H.)
  334. X`09RETURN
  335. X 31   IF(ISCRAFT .NE. 0) GO TO 32`20
  336. X      CALL PROUT(42HYOU MAY NOT LEAVE SHUTTLE CRAFT ON PLANET.`20
  337. X`091 ,42)
  338. X      RETURN
  339. XC--------DETERMINE APPROXIMATE DISTANCE TO NEAREST STARBASE`20
  340. X 32   NHELP=NHELP+1`20
  341. X      IF(BASEX .EQ. 0) GO TO 40`20
  342. X      DIST=SQRT(FLOAT((BASEX-SECTX)**2 + (BASEY-SECTY)**2))`20
  343. X      GO TO 60
  344. X 40   DIST=1E38
  345. X      DO 50 L=1,REMBASE`20
  346. X      XDIST=10.0*SQRT(FLOAT((BASEQX(L)-QUADX)**2+(BASEQY(L)-QUADY)**2))`20
  347. X      IF(XDIST .GT. DIST) GO TO 50
  348. X      DIST=XDIST
  349. X      LINE=L
  350. X 50   CONTINUE
  351. XC--------IF STARBASE IS NOT IN THIS QUADRANT, SET UP NEW QUADRANT`20
  352. X      QUADX=BASEQX(LINE)
  353. X      QUADY=BASEQY(LINE)
  354. X      SHUTUP=1.0
  355. X      CALL NEWQUAD
  356. X      SHUTUP=0.0
  357. XC--------DEMATERIALIZE STARSHIP`20
  358. X 60   QUAD(SECTX,SECTY)=IHDOT`20
  359. X      CALL CRAM(11HSTARBASE IN)`20
  360. X      CALL CRAMLOC(1,QUADX,QUADY)`20
  361. X      CALL CRAM(11H RESPONDS--)`20
  362. X      CALL CRAMSHP
  363. X      CALL CRAMDMP(16H DEMATERIALIZES.)`20
  364. XC--------GIVE STARBASE THREE CHANCES TO REMATERIALIZE STARSHIP
  365. X      PROBF=(1.0 - 0.98**DIST)**0.3333333333
  366. X      DO 80 L=1,3`20
  367. X      IF(L .EQ. 1) CALL CRAM(4H1ST )
  368. X      IF(L .EQ. 2) CALL CRAM(4H2ND )
  369. X      IF(L .EQ. 3) CALL CRAM(4H3RD )
  370. X      CALL CRAM(26HATTEMPT TO RE-MATERIALIZE )
  371. X      CALL CRAMSHP
  372. X      CALL CRAM(11H . . . . . )`20
  373. X      IF(RANF(0) .GT. PROBF) GO TO 90`20
  374. X 70   CALL CRAMDMP(6HFAILS.)
  375. X 80   CONTINUE
  376. XC--------ONE, TWO, THREE STRIKES YOU'RE OUT    `20
  377. X      CALL FINISH(11)`20
  378. X      RETURN
  379. XC--------REMATERIALIZATION ATTEMPT SHOULD SUCCEED, IF CAN GET ADJ TO BASE`20
  380. X 90   DO 100 LL=1,5`20
  381. X      IX=BASEX+IFIX(3.0*RANF(0))-1
  382. X      IF(IX.EQ.0 .OR. IX.EQ.11) GO TO 100`20
  383. X      IY=BASEY+IFIX(3.0*RANF(0))-1
  384. X      IF(IY.EQ.0 .OR. IY.EQ.11) GO TO 100`20
  385. X      IF(QUAD(IX,IY) .EQ. IHDOT) GO TO 110
  386. X 100  CONTINUE
  387. X      GO TO 70
  388. XC--------ATTEMPT HAS SUCCEEDED--FINISH UP`20
  389. X 110  CALL CRAMDMP(9HSUCCEEDS.)`20
  390. X      SECTX=IX
  391. X      SECTY=IY
  392. X      QUAD(IX,IY)=ISHIP
  393. X`09CALL RESETD
  394. X`09CALL SORTKL
  395. X      CALL DOCK`20
  396. X      CALL SKIP(1)
  397. X      CALL PROUT(34HLT. UHURA:  "CAPTAIN, WE MADE IT!",34)`20
  398. X      RETURN
  399. X      END`20
  400. $ CALL UNPACK TRHELP.FOR;1 994253116
  401. $ create 'f'
  402. X      SUBROUTINE HITEM(HITS)
  403. X`09INCLUDE 'TREKCOM/NOLIST'
  404. X`09LOGICAL*1 IENM
  405. X`09DIMENSION HITS(20)
  406. X`09REAL KP
  407. X      DATA PHASFAC/2.0/`20
  408. X      CALL SKIP(1)
  409. X      NENHER2=NENHERE`20
  410. X      KK=1
  411. X      DO 40 K=1,NENHER2`20
  412. X      WHAM=HITS(K)
  413. X      IF(WHAM .EQ. 0) GO TO 30
  414. X      DUSTFAC=0.90+0.01*RANF(0)`20
  415. X      HIT=WHAM*DUSTFAC**KDIST(KK)`20
  416. X      KP=KPOWER(KK)`20
  417. X      KPOWER(KK)=KP-SIGN(AMIN1(ABS(KP),PHASFAC*HIT),KP)`20
  418. X      KPOW=KPOWER(KK)`20
  419. X      II=KX(KK)`20
  420. X      JJ=KY(KK)`20
  421. X      IF(HIT .GT. .005)GO TO 10`20
  422. X      CALL CRAM(18HVERY SMALL HIT ON )
  423. X      GO TO 20
  424. X10    CALL CRAMF(HIT,0,2)`20
  425. X      CALL CRAM(13H UNIT HIT ON )`20
  426. X20    IENM=QUAD(II,JJ)
  427. X      CALL CRAMENA(IENM,2,II,JJ)
  428. X      CALL CREND
  429. X      IF(KPOW .NE. 0) GO TO 25
  430. X      CALL DEADKL(II,JJ,IENM,II,JJ)`20
  431. X      IF(REMKL .EQ. 0)CALL FINISH(1)
  432. X      IF(ALLDONE.NE.0) RETURN`20
  433. X      GO TO 40
  434. XC--------- DECIDE WHETHER OR NOT TO EMASCULATE KLINGON.`20
  435. X 25   IF(KPOW .LT. 0) GO TO 30
  436. X      IF(RANF(0.) .LT. .90)GO TO 30`20
  437. X      IF(KPOW       .GT. ((.40 + .4*RANF(0.))*KP))GO TO 30
  438. X      CALL CRAM(38H***MR. SPOCK:  "CAPTAIN, THE VESSEL AT)
  439. X      CALL CRAMLOC(2,II,JJ)`20
  440. X      CALL CREND
  441. X      CALL PROUT(32H   HAS JUST LOST ITS FIREPOWER.",32)`20
  442. X      KPOWER(KK)=-KPOW
  443. X30    KK=KK+1`20
  444. X40    CONTINUE
  445. X      RETURN
  446. X      END`20
  447. $ CALL UNPACK TRHITEM.FOR;1 1180327649
  448. $ create 'f'
  449. X      SUBROUTINE IMPULSE
  450. X`09INCLUDE 'TREKCOM/NOLIST'
  451. X      IDIDIT=0
  452. X      IF(DAMAGE(7).NE.0) GO TO 40`20
  453. XC--------READ IN COURSE AND DISTANCE
  454. +-+-+-+-+-+-+-+-  END  OF PART 9 +-+-+-+-+-+-+-+-
  455.