home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1994 March / Source_Code_CD-ROM_Walnut_Creek_March_1994.iso / compsrcs / games / vmsnet / startrek / part13 < prev    next >
Encoding:
Internet Message Format  |  1993-04-06  |  14.5 KB
  1. Path: uunet!usc!sdd.hp.com!decwrl!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 [13/18]
  5. Date: 7 Apr 93 11:02:03 EDT
  6. Organization: Pembroke State University
  7. Lines: 422
  8. Message-ID: <1993Apr7.110203.1@pembvax1.pembroke.edu>
  9. NNTP-Posting-Host: papa.pembroke.edu
  10. Xref: uunet vmsnet.sources.games:655
  11.  
  12. -+-+-+-+-+-+-+-+ START OF PART 13 -+-+-+-+-+-+-+-+
  13. X      CALL CRAMDMP(26H BUFFETED INTO BLACK HOLE.)`20
  14. X      IF(IQUAD .NE.ISHIP) GO TO 6902
  15. X      CALL FINISH(21)`20
  16. X      RETURN
  17. X 6902 CALL DEADKL(IX,IY,IQUAD,JX,JY)
  18. X      GO TO 50
  19. X 6903 IF(QUAD(JX,JY) .NE. IHDOT) GO TO 6905`20
  20. X      QUAD(JX,JY)=IQUAD`20
  21. X      QUAD(IX,IY)=IHDOT`20
  22. X      CALL CRAMDMP(10H DAMAGED--)`20
  23. X      CALL CRAM(24H   DISPLACED BY BLAST TO)
  24. X      CALL CRAMLOC(2,JX,JY)`20
  25. X      CALL CREND
  26. X      IF(IQUAD .NE.ISHIP) GO TO 6904
  27. XC------STARSHIP DISPLACED BY TORPEDO.  MOVE IT AND RESET ENEMY DISTANCES
  28. X`09SECTX=JX
  29. X`09SECTY=JY
  30. X      CALL RESETD`20
  31. X      GO TO 50
  32. XC--------ENEMY DISPLACED BY PHOTON BLAST
  33. X6904`09KX(LL)=JX
  34. X`09KY(LL)=JY
  35. X      KDIST(LL)=          SQRT(FLOAT((SECTX-JX)**2 + (SECTY-JY)**2))
  36. X      GO TO 50
  37. X6905  CALL CRAMDMP(27H DAMAGED BUT NOT DESTROYED.)
  38. X      GO TO 50
  39. XC--------TEST FOR AND COPE WITH HIT ON A STARBASE`20
  40. X70    IF(IQUAD.NE.IHT) GO TO  7002   `20
  41. X      CALL CRMSENA(IHT,2,IX,IY)      `20
  42. X      IF(HIT.LT.600) GO TO 7001      `20
  43. X      CALL CRAMDMP(11H DESTROYED.   )   `20
  44. X      QUAD(IX,IY)=IHDOT    `20
  45. X`09ITHERE=0
  46. X`09ITHX=0
  47. X`09ITHY=0
  48. X      GO TO 50   `20
  49. X7001  X=RANF(0)  `20
  50. X      IF(X.GT.0.05) CALL CRAMDMP(23H SURVIVES PHOTON BLAST.     )  `20
  51. X      IF(X.GT.0.05) GO TO 50
  52. X      CALL CRAMDMP(12H DISAPPEARS.  )    `20
  53. X      QUAD(IX,IY)=IHNUM    `20
  54. X      CALL DROPIN('@',DUM,MY)    `20
  55. X      ITHERE=0   `20
  56. X      GO TO 50   `20
  57. X7002  IF(IQUAD.NE.IHNUM) GOTO 7005   `20
  58. X      CALL PROUT(35H***TORPEDO ABSORBED BY THOLIAN WEB. ,35)`20
  59. X      GOTO 50    `20
  60. X7005  IF(IQUAD.NE.IHB) GO TO 75      `20
  61. X      CALL CRMSENA(IHB,2,IX,IY)`20
  62. X      IF(HIT .LT. 600.0) GO TO 7510`20
  63. X      CALL CRAM(12H DESTROYED       )`20
  64. X      IF(IPHWHO.NE.1) CALL CRAM(21H.... CONGRATULATIONS        )   `20
  65. X      CALL CREND `20
  66. X      IF(STARCH(QUADX,QUADY) .LT. 0) STARCH(QUADX,QUADY)=0
  67. X      DO 71 LLL=1,REMBASE`20
  68. X      IF(BASEQX(LLL).NE.QUADX .OR. BASEQY(LLL).NE.QUADY) GO TO 71`20
  69. X      BASEQX(LLL)=BASEQX(REMBASE)`20
  70. X      BASEQY(LLL)=BASEQY(REMBASE)`20
  71. X71    CONTINUE
  72. X      QUAD(IX,IY)=IHDOT`20
  73. X      REMBASE=REMBASE-1`20
  74. X`09BASEX=0
  75. X`09BASEY=0
  76. X      GALAXY(QUADX,QUADY)=GALAXY(QUADX,QUADY)-10
  77. X      IF(IPHWHO.NE.1) BASEKL=BASEKL+1`20
  78. X      CALL NEWCOND
  79. X      GO TO 50
  80. XC--------TEST FOR AND COPE WITH A HIT ON A PLANET.
  81. X 75   IF(IQUAD .NE. IHP) GO TO 80`20
  82. X      CALL CRMSENA(IHP,2,IX,IY)`20
  83. X      IF(HIT .GT. 450.0) GO TO 7520`20
  84. X 7510 CALL CRAMDMP(23H SURVIVES PHOTON BLAST.)
  85. X      GO TO 50
  86. X 7520 CALL CRAMDMP(11H DESTROYED. )`20
  87. X`09IF(IPHWHO.NE.1)NPLANKL=NPLANKL+1
  88. X`09NEWSTUF(QUADX,QUADY)=NEWSTUF(QUADX,QUADY)-1
  89. X      DO 76 II=1,5
  90. X 76   PLNETS(IPLANET,II)=0`20
  91. X`09IPLANET=0
  92. X`09PLNETX=0
  93. X`09PLNETY=0
  94. X`09QUAD(IX,IY)=IHDOT
  95. X      IF(LANDED .NE. 1) GO TO 50
  96. XC--------CAPTAIN PERISHES ON PLANET.
  97. X`09CALL FINISH(15)
  98. X`09RETURN
  99. X 80   IF(IQUAD .NE. IHSTAR) GO TO 90
  100. XC--------STAR HIT - CHECK FOR NOVA RESULTS
  101. X      IF(HIT.GT.270.0) GO TO 85      `20
  102. X      CALL CRMSENA(IHSTAR,2,IX,IY)
  103. X      CALL CRAMDMP(28H UNAFFECTED BY PHOTON BLAST.)`20
  104. X      GO TO 50
  105. X85    CALL NOVA(IX,IY)
  106. X      IF(GALAXY(QUADX,QUADY) .EQ. 1000) RETURN
  107. X      IF(ALLDONE.NE.0) RETURN`20
  108. X      GO TO 50
  109. XC--------CHECK FOR A BOOMERANG TORPEDO
  110. X 90   IF(IQUAD .NE.ISHIP) GO TO 93
  111. X      IF(CONDIT.NE.IHDOC) GO TO 9010
  112. X      IF(RANF(0).GT.0.77) GO TO 9010 `20
  113. X      CALL CRAM(27H STAR BASE SHIELDS PROTECT          ) `20
  114. X      CALL CRAMSHP
  115. X      CALL CREND `20
  116. X      GO TO 50   `20
  117. X9010`09CALL CRAM3AS
  118. X`09CALL CRAMSHP
  119. X      CALL CRAMDMP(27H BLASTED BY PHOTON TORPEDO!  )     `20
  120. X      CALL NEWCOND
  121. X      CALL ZAP
  122. X      IF(ENERGY .GT. 0.0) GO TO 91
  123. X      IF(KSHOT.NE.0) GO TO 9020  `20
  124. X`09CALL FINISH(22)
  125. X`09RETURN
  126. X9020`09CALL FINISH(5)
  127. X`09RETURN
  128. X 91   CALL CASULTY
  129. XC--------CHECK TO SEE IF SHIP DISPLACED`20
  130. X      CALL CRAMSHP
  131. X      GO TO 6901
  132. XC--------CHECK FOR HIT ON THING.
  133. X 93   IF(IQUAD .NE. IHQUEST) GO TO 95`20
  134. X      CALL SKIP(1)
  135. X      CALL PROUT(`20
  136. X     +   55H"AAAAIIIIIEEEEEEEEEAAAAAAAAUUUUUGGGGGHHHHHHHHHHHHHHH!!!,55)
  137. X      CALL PROUT(`20
  138. X     +   48H    HACK!     HACK!     HACK!         *CHOKE!* ",48)    `20
  139. X      CALL SKIP(1)
  140. X      CALL PROUT(26HMR. SPOCK:  "FASCINATING!",26)`20
  141. X      QUAD(IX,IY)=IHDOT`20
  142. X      GO TO 50
  143. XC--------TORPEDO ENTERS VICINITY OF BLACK HOLE.  CHECK FOR DEFLECTION`20
  144. X 95   CALL CRMSENA('@',2,IX,IY)`20
  145. X      IF(DISTN .LT. 0.1) GO TO 97`20
  146. XC--------BOING.  COMPUTE DEFLECTION ANGLE, AND NEW STARTING POINT`20
  147. X      SPRANG=(0.5-DISTN) * 7.853981634
  148. X      BETA=1.57079633 + ANGLE - SPRANG
  149. X      STARTX = IX-DISTN*SIN(BETA)`20
  150. X      STARTY = IY+DISTN*COS(BETA)`20
  151. X      ANGLE = ANGLE - SIGN(SPRANG,SINANG)`20
  152. X      CALL CRAMDMP(18H DEFLECTS TORPEDO. )
  153. X`09CALL CRAM(9HNEW TRACK)
  154. X`09GO TO 5720
  155. X 97   CALL CRAMDMP(18H SWALLOWS TORPEDO.)`20
  156. X      GO TO 50
  157. XC--------END INNER LOOP FOR MOVING ONE TORPEDO
  158. X105   CALL CREND
  159. X106   CALL PROUT(15HTORPEDO MISSED.,15)
  160. X      GO TO 50
  161. X115   IF(REMKL .EQ. 0) CALL FINISH(1)`20
  162. X      IF(KSHOT .EQ. 0) CALL SORTKL
  163. X      RETURN
  164. X      END`20
  165. $ CALL UNPACK TRPHOTONS.FOR;1 343720900
  166. $ create 'f'
  167. X      SUBROUTINE PLANET`20
  168. XC
  169. XC`094-APR-79
  170. XC`09FIX MESSAGE ABOUT SHUTTLE CRAFT'S CULINARY MISSION.
  171. XC`0928-NOV-79
  172. XC`09ALLOW STARBASE SR SCANNERS TO BE USED FOR SENSOR SCAN.
  173. XC*      `20
  174. XC*  SUBROUTINE PLANETS CONTAINS ENTRY POINTS FOR :`20
  175. XC*      `20
  176. XC*  ORBIT,BEAM,MINE,CRYSTAL,SENSOR,GALILEO,DEATHRA`20
  177. XC*      `20
  178. X`09INCLUDE 'TREKCOM/NOLIST'
  179. X`09CALL SKIP(1)
  180. X`09IKNOW=0
  181. X`09DO 101 I=1,INPLAN
  182. X101`09IKNOW=IKNOW+PLNETS(I,5)
  183. X`09IF(IKNOW.NE.0)GO TO 102
  184. X`09CALL PROUT('SPOCK:  "WE HAVE NO INFORMATION ON ANY PLANET,
  185. X`091 CAPTAIN."',56)
  186. X`09RETURN
  187. X102`09CALL PROUT('SPOCK:  "PLANET REPORT FOLLOWS, CAPTAIN."',41)
  188. X`09CALL SKIP(1)
  189. X`09DO 1 I=1,INPLAN`20
  190. X`09IF(PLNETS(I,5) .EQ. 0) GO TO 1`20
  191. X`09IX=PLNETS(I,1)
  192. X`09IY=PLNETS(I,2)
  193. X`09ICLASS=PLNETS(I,3)
  194. X`09IDIL=PLNETS(I,4)
  195. X      CALL CRAMLOC(1,IX,IY)`20
  196. X      CALL CRAM(9H   CLASS )
  197. X      CALL CRAMEN(ICLASS)`20
  198. X      CALL CRAM(3H   )
  199. X      IF(IDIL .EQ. 0) CALL CRAM (3HNO )`20
  200. X      CALL CRAMDMP(28HDILITHIUM CRYSTALS PRESENT.  )
  201. X 1    CONTINUE
  202. X      RETURN
  203. XC*`20
  204. X      ENTRY ORBIT`20
  205. XC*`20
  206. X      CALL SKIP(1)
  207. X`09IDIDIT=0
  208. X`09IF(INORBIT .EQ. 0) GO TO 2
  209. X      CALL PROUT(26HALREADY IN STANDARD ORBIT.      ,26)`20
  210. X      RETURN
  211. XC--------CHECK FOR ENGINE DAMAGE.`20
  212. X 2    IF((DAMAGE(7) .EQ. 0.) .OR. (DAMAGE(6) .EQ. 0.)) GO TO 3
  213. X      CALL PROUT(38HBOTH WARP AND IMPULSE ENGINES DAMAGED.      ,38)`20
  214. X      RETURN
  215. XC--------CHECK TO SEE IF SHIP ADJACENT TO PLANET.`20
  216. X 3    IF(PLNETX .EQ. 0) GO TO 5
  217. X      IF(IABS(SECTX-PLNETX) .LE. 1 .AND.  IABS(SECTY-PLNETY) .LE. 1)
  218. X     C GO TO 10`20
  219. X 5    CALL CRAMSHP
  220. X      CALL CRAMDMP(24H NOT ADJACENT TO PLANET.  )`20
  221. X      RETURN
  222. X 10   TIME = .02+.03*RANF(0)
  223. X      IF(DAMAGE(6) .GT. 0.) TIME=TIME*10.`20
  224. XC--------GO AHEAD, SULU.
  225. X      CALL PROUT(46HHELMSMAN SULU:  "ENTERING STANDARD ORBIT, SIR.  `20
  226. X`091 ,46)
  227. X      CALL NEWCOND
  228. X      ASSIGN 17 TO IWHERE`20
  229. X 16   IDIDIT=1
  230. X      CALL EVENTS`20
  231. X      IF(ALLDONE.EQ.1 .OR. GALAXY(QUADX,QUADY).EQ.1000 .OR. JUSTIN.EQ.1)
  232. X     +  RETURN
  233. X      GO TO IWHERE
  234. X 17   CALL CRAM(11H  ALTITUDE   )`20
  235. X      HEIGHT=1400.+7200.*RANF(0)
  236. X      CALL CRAMF(HEIGHT,0,2)
  237. X      CALL CRAMDMP(13H KILOMETERS.")
  238. X`09INORBIT=1
  239. X`09RETURN
  240. XC*`20
  241. X      ENTRY BEAM
  242. XC*`20
  243. X      CALL SKIP(1)
  244. X      IF(DAMAGE(12) .EQ. 0) GO TO 19
  245. X      CALL PROUT(21HTRANSPORTER DAMAGED.    ,21)`20
  246. X`09IF(DAMAGE(10) .NE. 0) RETURN
  247. X`09CALL SKIP(1)
  248. X      CALL PROUT(47HSPOCK:  "MAY I SUGGEST THE SHUTTLE CRAFT, SIR." `20
  249. X`091 ,47)
  250. X      RETURN
  251. X 19   IF(INORBIT.NE.0) GO TO 1910`20
  252. X 1901 CALL CRAMSHP
  253. X      CALL CRAMDMP(23H NOT IN STANDARD ORBIT.   )`20
  254. X      RETURN
  255. X 1910 IF(SHLDUP .EQ. 0) GO TO 1920
  256. X      CALL PROUT(41HIMPOSSIBLE TO TRANSPORT THROUGH SHIELDS.  ,41)  `20
  257. X      RETURN
  258. X 1920 IF(PLNETS(IPLANET,5) .EQ. 1) GO TO 1940
  259. X 1930 CALL PROUT(56HSPOCK:  "CAPTAIN, WE HAVE NO INFORMATION ON THIS PLA
  260. X     CNET,      ,56)`20
  261. X      CALL PROUT(64H  AND STARFLEET REGULATIONS CLEARLY STATE THAT IN TH
  262. X     CIS SITUATION    ,64)`20
  263. X      CALL PROUT(23H  YOU MAY NOT GO DOWN."    ,23)
  264. X      RETURN
  265. X 1940 IF(LANDED .EQ. 1) GO TO 30
  266. X      IF(PLNETS(IPLANET,4) .EQ. 1) GO TO 20
  267. X      CALL PROUT(44HSPOCK:   CAPTAIN, I FAIL TO SEE THE LOGIC IN    ,44)`20
  268. X      CALL PROUT(`20
  269. X     +51H  EXPLORING A PLANET WITH NO DILITHIUM CRYSTALS.    ,51)   `20
  270. X      ASSIGN 20 TO IWHERE`20
  271. X 1950 CALL PROMPT(30H  ARE YOU SURE THIS IS WISE?        ,30)`20
  272. X`09IF(JA(DUMMY)) GO TO IWHERE
  273. X`09RETURN
  274. X 20   CALL PROUT(41HSCOTTY:  "TRANSPORTER ROOM READY, SIR."     ,41)`20
  275. X      CALL SKIP(1)
  276. X      CALL PROUT(63HKIRK, AND LANDING PARTY PREPARE TO BEAM DOWN TO PLAN
  277. X     CET SURFACE.       ,63)`20
  278. X      CALL SKIP(1)
  279. X      CALL PROUT(18HKIRK:  "ENERGIZE."   ,18)
  280. X 21   CALL SKIP(1)
  281. X      CALL PROUT(41HWWHOOOIIIIIRRRRREEEE.E.E. . . . .  .   .       ,41)
  282. X      IF(RANF(0) .GT. 0.98) GO TO 35
  283. X      CALL PROUT(41H.   .  . . . . .E.E.EEEERRRRRIIIIIOOOHWW      ,41)`20
  284. X      CALL SKIP(1)
  285. X      CALL PROUT(19HTRANSPORT COMPLETE.    ,19)
  286. X      LANDED = LANDED *(-1)`20
  287. X      IF((LANDED .NE. 1) .AND. (IMINE .EQ. 1)) ICRYSTL = 1
  288. X      IMINE=0`20
  289. X      RETURN
  290. XC--------READY TO BEAM UP TO SHIP.
  291. X 30   IF(ISCRAFT .EQ. 1) GO TO 32`20
  292. X      CALL PROUT(42HYOU MAY NOT LEAVE SHUTTLE CRAFT ON PLANET.    ,42)`20
  293. X      RETURN
  294. X 32   CALL PROUT(42HLANDING PARTY ASSEMBLED, READY TO BEAM UP.     ,42)
  295. X      CALL SKIP(1)
  296. X      CALL PROUT(31HKIRK WHIPS OUT COMMUNICATOR...   ,31) `20
  297. X      CALL PROUT(17HBEEP  BEEP  BEEP     ,17)
  298. X      CALL SKIP(1)
  299. X      CALL PROUT(54H"KIRK TO ENTERPRISE:  LOCK ON COORDINATES...ENERGIZE
  300. X     C."    ,54)`20
  301. X      GO TO 21
  302. XC--------CATASTROPHE!      `20
  303. X 35   CALL SKIP(1)
  304. X      CALL PROUT(31HBOOOIIIOOOIIOOOOIIIOIING . . .   ,31)     `20
  305. X`09CALL SKIP(1)
  306. X      CALL PROUT(38HSCOTTY:  "OH MY GOD!  I'VE LOST THEM."    ,38)  `20
  307. X`09CALL FINISH(13)
  308. X`09RETURN
  309. XC*`20
  310. X      ENTRY MINE
  311. XC*`20
  312. X`09IDIDIT=0
  313. X`09CALL SKIP(1)
  314. X      IF(LANDED .EQ. 1) GO TO 50
  315. X      CALL PROUT(27HMINING PARTY NOT ON PLANET.   ,27)`20
  316. X      RETURN
  317. X 50   IF(PLNETS(IPLANET,4) .EQ. 1) GO TO 51
  318. X      CALL PROUT(37HNO DILITHIUM CRYSTALS ON THIS PLANET.    ,37)
  319. X      RETURN
  320. X 51   TIME =(0.1+0.2*RANF(0)) * PLNETS(IPLANET,3)
  321. X`09ASSIGN 52 TO IWHERE
  322. X`09GO TO 16
  323. X 52   CALL PROUT(26HMINING OPERATION COMPLETE.   ,26)
  324. X`09IMINE=1
  325. X`09RETURN
  326. XC*`20
  327. X      ENTRY CRYSTAL`20
  328. XC*`20
  329. X      CALL SKIP(1)
  330. X      IF(ICRYSTL .EQ. 1) GO TO 55`20
  331. X      CALL PROUT(32HNO DILITHIUM CRYSTALS AVAILABLE.   ,32)
  332. X      RETURN
  333. X 55   IF(ENERGY .LT. 1000.) GO TO 5510
  334. X      CALL PROUT(66HSPOCK:  "CAPTAIN, STARFLEET REGULATIONS PROHIBIT SUC
  335. X     CH AN OPERATION    ,66)`20
  336. X      CALL PROUT(41H  EXCEPT WHEN CONDITION YELLOW EXISTS."      ,41)
  337. X      RETURN
  338. X 5510 CALL PROUT(46HSPOCK:  "CAPTAIN, I MUST WARN YOU THAT LOADING  `20
  339. X`091 ,46)
  340. X      CALL PROUT(46H  RAW DILITHIUM CRYSTALS INTO THE SHIP'S POWER        `2
  341. V0
  342. X`091 ,46)
  343. X      CALL PROUT(37H  SYSTEM MAY RISK A SEVERE EXPLOSION.    ,37)
  344. X`09ASSIGN 56 TO IWHERE
  345. X`09GO TO 1950
  346. X 56   CALL SKIP(1)
  347. X      CALL PROUT(45HENGINEERING OFFICER SCOTT:  "(GULP) AYE SIR."   ,45)`20
  348. X      CALL PROUT(32H  "MR. SPOCK AND I WILL TRY IT."   ,32)
  349. X      CRYPROB=CRYPROB*2.0`20
  350. X      CALL SKIP(1)
  351. X      CALL PROUT(32HSPOCK:  "CRYSTAL IN PLACE, SIR."          ,32)`20
  352. X      CALL PROUT(31H  "READY TO ACTIVATE CIRCUIT."   ,31) `20
  353. X      CALL SKIP(1)
  354. X      CALL PROUT(42HSCOTTY:  "KEEP YOUR FINGERS CROSSED, SIR!"   ,42)
  355. X      CALL SKIP(1)
  356. X      IF(RANF(0) .GT. CRYPROB) GO TO 57`20
  357. X      CALL PROUT(41H  "ACTIVATING NOW! - - NO GOOD!  IT'S***   ,41) `20
  358. X 5610 CALL PROUT(54H***RED ALERT!  RED A*L******************************
  359. V     `20
  360. X     +**,54)`20
  361. X      CALL STARS
  362. X      CALL PROUT(54H*****************    KA-BOOM!!!!    ****************
  363. V     `20
  364. X     C**    ,54)`20
  365. X`09CALL KABOOM
  366. X`09RETURN
  367. X 57   ENERGY = ENERGY +5000.*(1.+0.9*RANF(0))`20
  368. X      CALL PROUT(38H  "ACTIVATING NOW% - - THE INSTRUMENTS    ,38)  `20
  369. X      CALL PROUT(36H   ARE GOING CRAZY, BUT I THINK IT'S         ,36)
  370. X      CALL PROUT(41H   GOING TO WORK!  CONGRATULATIONS, SIR!"   ,41)`20
  371. X      RETURN
  372. XC*`20
  373. X      ENTRY SENSOR
  374. XC*`20
  375. X      CALL SKIP(1)
  376. X      IF(DAMAGE(1) .EQ. 0 .OR. CONDIT .EQ. IHDOCKD) GOTO 60      `20
  377. X      CALL PROUT(28HSHORT RANGE SENSORS DAMAGED.   ,28)
  378. X      RETURN
  379. X 60   IF(PLNETX .NE. 0) GO TO 65`20
  380. X      CALL PROUT(27HNO PLANET IN THIS QUADRANT.   ,27)`20
  381. X      RETURN
  382. X 65   CALL CRAM(24HSPOCK:  "SENSOR SCAN FOR  )
  383. X      CALL CRAMLOC(1,QUADX,QUADY)`20
  384. X      CALL CRAMDMP(1H:)`20
  385. X      CALL SKIP(1)
  386. X      CALL CRAM(18H         PLANET AT)
  387. X      CALL CRAMLOC(2,PLNETX,PLNETY)`20
  388. X      CALL CRAM(13H IS OF CLASS )`20
  389. X      ICLASS=PLNETS(IPLANET,3)`20
  390. X      IDIL=PLNETS(IPLANET,4)`20
  391. X      CALL CRAMEN(ICLASS)`20
  392. X      CALL CRAMDMP(1H.)`20
  393. X      CALL CRAM(27H         READINGS INDICATE )`20
  394. X      IF(IDIL .EQ. 0) CALL CRAM(3HNO )
  395. X      CALL CRAMDMP(28HDILITHIUM CRYSTALS PRESENT."  )`20
  396. X      PLNETS(IPLANET,5) = 1`20
  397. X`09RETURN
  398. XC*`20
  399. X      ENTRY GALILEO`20
  400. XC*`20
  401. X      CALL SKIP(1)
  402. X      IDIDIT = 0
  403. X      IF(DAMAGE(10) .EQ. 0) GO TO 72
  404. X      IF(DAMAGE(10) .GT. 0.) GO TO 71`20
  405. X      IF(DAMAGE(10) .EQ. -1.) GO TO 70
  406. X      CALL PROUT(36HSHUTTLE CRAFT NOW SERVING BIG MAC'S.,36)
  407. X`09RETURN
  408. X 70   CALL PROUT(38HYE FAERIE QUEENE HAS NO SHUTTLE CRAFT.  ,38)`20
  409. X      RETURN
  410. X 71   CALL PROUT(22HSHUTTLE CRAFT DAMAGED.  ,22)`20
  411. X      RETURN
  412. X 72   IF(INORBIT .EQ. 1) GO TO 75`20
  413. X      GO TO 1901
  414. X 75   IF(SHLDUP .EQ. 0 .AND. CONDIT .NE. IHDOCKD) GO TO 80
  415. X      CALL PROUT(42HSHUTTLE CRAFT CANNOT PASS THROUGH SHIELDS.,42)`20
  416. X      RETURN
  417. X 80   IF(PLNETS(IPLANET,5) .NE. 1) GO TO 1930
  418. X      TIME=3.0E-5*HEIGHT
  419. X      IF(LANDED .NE. 1) GO TO 100`20
  420. X      IF(ISCRAFT .NE. 1) GO TO 98`20
  421. XC--------SHUTTLE CRAFT TO THE RESCUE.`20
  422. X      IF(DAMAGE(12) .NE. 0) GO TO 95
  423. X`09CALL PROMPT(47HSPOCK:  WOULD YOU RATHER USE THE TRANSPORTER?  ,47)
  424. X      IF(JA(DUMMY)) RETURN
  425. X 95   IF(DAMAGE(12) .EQ. 0) CALL CRAM(13HSHUTTLE CREW )`20
  426. X      IF(DAMAGE(12) .NE. 0) CALL CRAM(13HRESCUE PARTY )`20
  427. X      CALL CRAMDMP(50HBOARDS "GALILEO" AND SWOOPS TOWARD PLANET SURFACE.
  428. X     C  )`20
  429. X      ISCRAFT=0`20
  430. X      ASSIGN 97 TO IWHERE`20
  431. X 96   CALL SKIP(1)
  432. X      GO TO 16
  433. +-+-+-+-+-+-+-+-  END  OF PART 13 +-+-+-+-+-+-+-+-
  434.