home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / gwbasic / spiele / startrek.bas < prev    next >
Encoding:
BASIC Source File  |  1987-06-26  |  37.0 KB  |  1,043 lines
  1. 5 SCREEN 0,0:WIDTH 80:COLOR 3,0,0:CLS
  2. 10 REM
  3. 20 REM ****       **** STAR TREK ****       ****
  4. 30 REM ****  Simulation of a mission of the starship ENTERPRISE
  5. 40 REM ****  as seen on the Star Trek tv show.
  6. 50 REM ****  Original program in Creative Computing
  7. 60 REM ****  Basic Computer Games by Dave Ahl.
  8. 70 REM ****  Modifications by Bob Fritz and Sharon Fritz
  9. 80 REM **** for the IBM Personal Computer, October-November 1981
  10. 90 REM **** Bob Fritz, 9915 Caninito Cuadro, San Diego, Ca., 92129
  11. 100 REM ****  (714) 484-2955
  12. 110 REM ****
  13. 120 '****
  14. 130 '**** Modifications to modifications by Mike Stafford
  15. 140 '**** Ditto by D. V. Taylor
  16. 150 DIM G(8,8),C%(9,2),K%(3,3),N(3),Z(8,8),D(8),Q%(8,8), MOVES%(10,2)
  17. 160 STAR$=" "+CHR$(15)+" "
  18. 170 STARBASE$=CHR$(93)+CHR$(176)+CHR$(91)
  19. 180 ENTERPRISE$=CHR$(222)+CHR$(234)+CHR$(221)
  20. 190 KLINGON$=CHR$(169)+CHR$(157)+CHR$(170)
  21. 200 TORPEDO$=CHR$(248)
  22. 205 C$="GREEN "
  23. 207 WD=8
  24. 210 UPPERLINE$=CHR$(205)+CHR$(209)+CHR$(205)
  25. 220 UPPERLINE$=UPPERLINE$+UPPERLINE$
  26. 230 UPPERLINE$=CHR$(201)+UPPERLINE$+UPPERLINE$+UPPERLINE$+UPPERLINE$+CHR$(187)
  27. 240 LOWERLINE$=CHR$(205)+CHR$(207)+CHR$(205)
  28. 250 LOWERLINE$=LOWERLINE$+LOWERLINE$
  29. 260 LOWERLINE$=CHR$(200)+LOWERLINE$+LOWERLINE$+LOWERLINE$+LOWERLINE$+CHR$(188)
  30. 270 A1$="NAVSRSLRSPHATORSHIDAMCOMRESCLE"
  31. 280 '**********************************************************
  32. 290 '*  Theme to Startrek
  33. 300 '*  Music in variables Z1$, Z2$, Z3$, Z4$, and Z5$
  34. 310 '**********************************************************
  35. 320 Z1$="T200MLO2L2GO3FL4FEL6DCO2BL4B-L8B-L32B-B-B-P32B-L1B-" 'Beyond the rim of the starlight
  36. 330 Z2$="L2GO3GL4GFL6EDCO2L4BL8BL32BBBP32L1BL4B" ' My love is wandring in star flight
  37. 340 Z3$="L4B-AAABO3C#DL6EF#GL2AB-B-B-O2B-L4B-O3CDE-L6FGA-L2B-BBB"' I know he'll find in star clustered reaches love, strange love a star woman teaches.
  38. 350 Z4$="O2GO3FL4FEL6DCO2BL4B-L8B-L32B-B-B-P32L1B-L4B-A-L2GO3GL4GFL6EDCO2L4BL8BL32BBBP32L1BL4B"
  39. 360 Z5$="O2B-AAABO3CDL6EFEL2GL4GL32GGGP32L4GB-B-B-AL2GL1CL2DL1CC"
  40. 370 E6LINE$=STRING$(6,CHR$(196))
  41. 380 FOR I=1 TO 10
  42. 390   MOVES%(I,1)=0
  43. 400 NEXT I
  44. 410 '****************************************************************
  45. 420 '*  CREATE MATRIX C(9,2) FOR CALCULATION OF MOVEMENTS
  46. 430 '****************************************************************
  47. 440 FOR I=1 TO 9
  48. 450   C%(I,1)=0
  49. 460   C%(I,2)=0
  50. 470 NEXT I
  51. 480 C%(3,1)=-1
  52. 490 C%(2,1)=-1
  53. 500 C%(4,1)=-1
  54. 510 C%(4,2)=-1
  55. 520 C%(5,2)=-1
  56. 530 C%(6,2)=-1
  57. 540 C%(1,2)=1
  58. 550 C%(2,2)=1
  59. 560 C%(6,1)=1
  60. 570 C%(7,1)=1
  61. 580 C%(8,1)=1
  62. 590 C%(8,2)=1
  63. 600 C%(9,2)=1
  64. 610 CLS
  65. 620 KEY OFF
  66. 630 LOCATE 13,1
  67. 640 PRINT "                                    ,"+E6LINE$;
  68. 650 COLOR 31,0
  69. 660 PRINT CHR$(236);
  70. 670 COLOR 3,0
  71. 680 PRINT E6LINE$+","
  72. 690 PRINT "                    ,"+STRING$(13,CHR$(196))+",  '"+STRING$(3,CHR$(196))+"  "+E6LINE$+"'"
  73. 700 PRINT "                     '"+STRING$(7,CHR$(196))+"  "+STRING$(2,CHR$(196))+"'      / /"
  74. 710 PRINT "                        ,"+STRING$(3,CHR$(196))+"' '"+STRING$(7,CHR$(196))+"/ /"+STRING$(2,CHR$(196))+","
  75. 720 PRINT "                          '"+STRING$(16,CHR$(196))+"'"
  76. 730 PRINT
  77. 740 PRINT "                   THE USS ENTERPRISE --- NCC-1701"
  78. 750 RANDOMIZE(VAL(MID$(TIME$,4,2)+RIGHT$(TIME$,2)))
  79. 760 Z$="                         "
  80. 765 LOCATE 23,28:INPUT "SOUND (Y/N) ";DH$:IF DH$="n"OR DH$ = "N" THEN 800
  81. 770 PLAY "MB"+Z1$+Z2$+Z3$
  82. 771 FOR J=1 TO 9:LOCATE 22,27:COLOR 15,0:PRINT"PHOTON TORPEDO";
  83. 772 FOR I=45 TO 79:LOCATE 17,I:PRINT TORPEDO$;:LOCATE 17,I-1:PRINT" ";
  84. 773 NEXT I:LOCATE 17,79:PRINT " ";
  85. 774 LOCATE 22,27:COLOR 14,0:PRINT"  PHASERS     ";
  86. 775 FOR I=44 TO 79:LOCATE 15,I:PRINT CHR$(223);:NEXT I
  87. 776 FOR I=44 TO 79:LOCATE 15,I:PRINT " ";:NEXT I:NEXT J
  88. 777 LOCATE 22,27:PRINT "              ";
  89. 780 PLAY "MB"+Z4$+Z5$
  90. 781 LOCATE 1,62:COLOR  9,0:  PRINT"╔═══DIRECTORY════╗"
  91. 782 FOR I=2 TO 6:LOCATE I,62:PRINT"║                ║":NEXT I
  92. 783              LOCATE 7,62:PRINT"╚════════════════╝
  93. 784 LOCATE 2,63:COLOR 14,0:PRINT"STAR:       "+STAR$
  94. 785 LOCATE 3,63:COLOR 15,0:PRINT"STARBASE:   "+STARBASE$
  95. 786 LOCATE 4,63:COLOR 10,0:PRINT"ENTERPRISE: "+ENTERPRISE$
  96. 787 LOCATE 5,63:COLOR 12,0:PRINT"KLINGON:    "+KLINGON$
  97. 788 LOCATE 6,63:COLOR 15,0:PRINT"TORPEDO:    "+TORPEDO$
  98. 789 COLOR 6,0:LOCATE 9,64:PRINT"COURSE SETTINGS"
  99. 790 LOCATE 10,67:PRINT"   3   "
  100. 791 LOCATE 11,67:PRINT" 4   2 "
  101. 792 LOCATE 12,67:PRINT"5 ";:COLOR 10,0:PRINT ENTERPRISE$;:COLOR 6,0:PRINT" 1"
  102. 793 LOCATE 13,67:PRINT" 6   8 "
  103. 794 LOCATE 14,67:PRINT"   7   "
  104. 795 '**********************************************************
  105. 800 '* Initialize variables
  106. 810 '* T - CURRENT DATE
  107. 820 '* T0 - INITIAL DATE
  108. 830 '* T9 - COMPLETION DATE
  109. 840 '* B9 - TOTAL NUMBER OF BASES
  110. 850 '* K9 - TOTAL NUMBER OF KLINGONS
  111. 860 '* K3 - NUMBER OF KLINGONS IN CURRENT QUADRANT
  112. 870 '* P - NUMBER OF PHOTON TORPEDOES
  113. 880 '**********************************************************
  114. 890 START=1
  115. 900 SRS.CLEARED=1
  116. 910 GALRECSET=0
  117. 920 CLEARFLAG=0
  118. 930 MOVERANDOM%=0
  119. 940 T=INT(RND(1)*20+20)*100
  120. 950 T0=T
  121. 960 T9=25+INT(RND(1)*10)
  122. 970 D0=0
  123. 980 E=3000
  124. 990 E0=E
  125. 1000 P=10
  126. 1010 P0=P
  127. 1020 S9=200
  128. 1030 S=0
  129. 1040 B9=0
  130. 1050 K9=0
  131. 1060 X$=""
  132. 1070 X0$=" is "
  133. 1080 DEF FND(D)=SQR((K%(I,1)-S1)^2+(K%(I,2)-S2)^2)
  134. 1090 DEF FNR(R)=INT(RND(R)*7.98+1.01)
  135. 1100 REM initialize enterprise's position
  136. 1110 Q1=FNR(1)
  137. 1120 Q2=FNR(1)
  138. 1130 S1=FNR(1)
  139. 1140 S2=FNR(1)
  140. 1150 FOR I=1 TO 8
  141. 1160   D(I)=0
  142. 1170 NEXT I
  143. 1180 '****************************************************************
  144. 1190 '*  set up what exists in galaxy
  145. 1200 '****************************************************************
  146. 1210 REM k3=#klingons  b3=#starbases  s3=#stars
  147. 1220 FOR I=1 TO 8
  148. 1230   FOR J=1 TO 8
  149. 1240     Z(I,J)=0
  150. 1250     R1=RND(1)
  151. 1260     IF R1<.8 THEN K3=0: GOTO 1290
  152. 1270     IF R1<.95 THEN K3=1: GOTO 1290
  153. 1280     IF R1<.9799999 THEN K3=2: ELSE K3=3
  154. 1290     K9=K9+K3
  155. 1300     IF RND(1)>.96 THEN B3=1: B9=B9+1 ELSE B3=0
  156. 1310     G(I,J)=K3*100+B3*10+FNR(1)
  157. 1320   NEXT J
  158. 1330 NEXT I
  159. 1340 IF K9>T9 THEN T9=K9+1
  160. 1350 IF B9<>0 THEN 1410
  161. 1360 IF G(Q1,Q2)<200 THEN G(Q1,Q2)=G(Q1,Q2)+100: K9=K9+1
  162. 1370 B9=1
  163. 1380 G(Q1,Q2)=G(Q1,Q2)+10
  164. 1390 Q1=FNR(1)
  165. 1400 Q2=FNR(1)
  166. 1410 K7=K9
  167. 1420 IF B9<>1 THEN X$="s":X0$=" are "
  168. 1425 COLOR 2,0
  169. 1430 LOCATE 1,1:PRINT"      Your orders are as follows: ":PRINT " "
  170. 1440 PRINT"      Destroy the";K9;"Klingon warships which have invaded"
  171. 1450 PRINT"    the galaxy before they can attack Federation headquarters"
  172. 1460 PRINT"    on stardate";T0+T9;". This gives you";T9;"days.  There";X0$
  173. 1470 PRINT"   ";B9;"starbase";X$;" in the galaxy for resupplying your ship."
  174. 1475 COLOR 3,0
  175. 1480 REM FOR ITEMP=1 TO 2500: NEXT ITEMP
  176. 1490 REM here any time new quadrant entered
  177. 1500 Z4=Q1
  178. 1510 Z5=Q2
  179. 1520 K3=0
  180. 1530 B3=0
  181. 1540 S3=0
  182. 1550 G5=0
  183. 1560 D4=.5*RND(1)
  184. 1570 Z(Q1,Q2)=G(Q1,Q2)
  185. 1580 IF Q1<1 OR Q1>8 OR Q2<1 OR Q2>8 THEN 1840
  186. 1590 GOSUB 7770
  187. 1600 PRINT " "
  188. 1610 IF T0 <>T THEN 1710
  189. 1620 PRINT " "
  190. 1625 COLOR 14,0
  191. 1630 PRINT "Hit enter key when ready to accept command."
  192. 1640 ATEMP$=INKEY$+"0"
  193. 1650 IF ASC(LEFT$(ATEMP$,1))<>13 THEN 1640
  194. 1655 COLOR 3,0
  195. 1660 PRINT"Your mission begins with your starship located"
  196. 1670 PRINT"in the galactic quadrant, '";G2$;"'."
  197. 1680 FOR I=1 TO 1500
  198. 1690 NEXT I
  199. 1700 GOTO 1730
  200. 1710 COLOR 9,0:PRINT"Now entering ";G2$;" quadrant."
  201. 1730 K3=INT(G(Q1,Q2)*.01)
  202. 1740 B3=INT(G(Q1,Q2)*.1)-10*K3
  203. 1750 S3=G(Q1,Q2)-100*K3-10*B3
  204. 1760 FOR I=1 TO 8
  205. 1770   FOR J=1 TO 8
  206. 1780     Q%(I,J)=0
  207. 1790   NEXT J
  208. 1800 NEXT I
  209. 1810 FOR I=1 TO 3
  210. 1820   K%(I,3)=0
  211. 1830 NEXT I
  212. 1840 SRS.CLEARED=1
  213. 1850 '***************************************************************
  214. 1860 '*  position enterprise in quadrant, then place "k3" klingons,&
  215. 1870 '*  "b3" starbases &"s3" stars elsewhere.
  216. 1880 '***************************************************************
  217. 1890 Q%(S1,S2)=30000
  218. 1900 IF K3<1 THEN 1980
  219. 1910 FOR I=1 TO K3
  220. 1920   GOSUB 7570
  221. 1930   K%(I,1)=R1
  222. 1940   K%(I,2)=R2
  223. 1950   K%(I,3)=INT(S9*(.5+RND(1)))
  224. 1960   Q%(R1,R2)=-1
  225. 1970 NEXT I
  226. 1980 IF B3<1 THEN 2010
  227. 1990 GOSUB 7570
  228. 2000 Q%(R1,R2)=1 'STARBASE
  229. 2010 FOR I=1 TO S3
  230. 2020   GOSUB 7570
  231. 2030   Q%(R1,R2)=2 'STARS
  232. 2040 NEXT I
  233. 2050 GOSUB 6030
  234. 2060 IF S+E>10 THEN IF E>10 OR D(7)=0 THEN 2120
  235. 2070 COLOR 20,15: PRINT"*** FATAL ERROR ***";:COLOR 3,0:GOSUB 9790
  236. 2075 COLOR 1,0
  237. 2080 CLS:PRINT"You've just stranded your ship in "
  238. 2090 PRINT"space":PRINT"You have insufficient maneuvering energy,";
  239. 2100 PRINT" and shield control":PRINT"is presently incapable of cross";
  240. 2110 PRINT"-circuiting to engine room!!":GOTO 5750
  241. 2120 GOSUB 6360
  242. 2130 LOCATE 13,1
  243. 2140 PRINT STRING$(26," ");
  244. 2150 LOCATE 13,1
  245. 2160 INPUT "COMMAND";A$
  246. 2170 GOSUB 8230
  247. 2180 IF GALRECSET=1 THEN GOSUB 9680: GOTO 2250
  248. 2190 FOR ITEMP=14 TO 24
  249. 2200   LOCATE ITEMP,1
  250. 2210   PRINT STRING$(54," ");
  251. 2220 NEXT ITEMP
  252. 2230 LOCATE 14,1
  253. 2240 IF GALRECSET=1 THEN GOSUB 9680: GOTO 2250
  254. 2250 FOR I=1 TO 10: IF LEFT$(A$,3)<> MID$(A1$,3*I-2,3) THEN 2270
  255. 2260 ON I GOTO 2430,2050,3630,3910,4540,5080,5250,6520,5810,9510
  256. 2270 NEXT I:GOSUB 9680: COLOR 14,0
  257. 2275 LOCATE 1,34: PRINT"Enter one of the following:";
  258. 2280 LOCATE 3,36: PRINT "NAV   (to set course)";
  259. 2290 LOCATE 4,36: PRINT "SRS   (for short range sensor scan)";
  260. 2300 LOCATE 5,36: PRINT "LRS   (for long range sensor scan)";
  261. 2310 LOCATE 6,36: PRINT "PHA   (to fire phasers)";
  262. 2320 LOCATE 7,36: PRINT "TOR   (to fire photon torpedoes)";
  263. 2330 LOCATE 8,36: PRINT "SHE   (to raise or lower shields)";
  264. 2340 LOCATE 9,36: PRINT "DAM   (for damage control reports)";
  265. 2350 LOCATE 10,36: PRINT "COM   (to call on library-computer)";
  266. 2360 LOCATE 11,36: PRINT "RES   (to resign your command)";0
  267. 2370 LOCATE 12,36: PRINT "CLE   (to clear and redraw screen)";
  268. 2375 COLOR 3,0
  269. 2380 GALRECSET=1
  270. 2390 GOTO 2060
  271. 2400 '*****************************************************************
  272. 2410 '*  course control begins here
  273. 2420 '*****************************************************************
  274. 2430 INPUT"Course (1-8)";C1
  275. 2450 IF C1>=1 AND C1<9 THEN 2490
  276. 2460 PRINT "Lt. Sulu reports"
  277. 2470 PRINT "  'Incorrect course data, sir!'"
  278. 2480 GOTO 2060
  279. 2490 X$="8"
  280. 2500 IF D(1)<0 THEN X$=STR$(WD)
  281. 2510 PRINT"Warp factor(0-";X$;")";:INPUT W1:IF D(1)<0 AND W1>WD THEN 2570
  282. 2520 IF W1>0 AND W1<8 THEN 2590
  283. 2530 IF W1=0 THEN 2060
  284. 2540 PRINT "Chief Engineer Scott reports"
  285. 2550 PRINT "  'The engines won't take";
  286. 2560 PRINT " warp ";W1;"!'.":GOTO 2060
  287. 2570 PRINT "Warp engines are damaged."
  288. 2580 PRINT "Maximum speed = warp ";:PRINT WD;:GOTO 2060
  289. 2590 N=INT(W1*8+.5) ' N=ENERGY USED BY NAVIGATION
  290. 2600 IF E-N>=0 THEN 2710
  291. 2610 PRINT "Engineering reports"
  292. 2620 PRINT "   'Insufficient energy available"
  293. 2630 PRINT "    for maneuvering at warp";W1;"!'"
  294. 2640 IF S<N-E OR D(7)<0 THEN 2060
  295. 2650 PRINT "Deflector control room acknowledges"
  296. 2660 PRINT S;"UNITS OF ENERGY DEPLOYED TO SHIELDS."
  297. 2670 GOTO 2060
  298. 2680 '*****************************************************************
  299. 2690 '*  klingons move/fire on moving starship . . .
  300. 2700 '*****************************************************************
  301. 2710 D1=0
  302. 2720 D6=W1
  303. 2730 IF W1>=1 THEN D6=1
  304. 2740 FOR I=1 TO 8
  305. 2750   IF D(I)>=0 THEN D(I)=0: GOTO 2840
  306. 2760   D(I)=D(I)+D6
  307. 2770   IF D(I)>-.1  AND D(I)<0 THEN D(I)=-.1:GOTO  2840
  308. 2780   IF D(I)<0 THEN 2840
  309. 2790   IF D1<>1 THEN D1=1:PRINT"DAMAGE CONTROL REPORT:"
  310. 2800   PRINT TAB(8);
  311. 2810   R1=I
  312. 2820   GOSUB 7620
  313. 2830   PRINT G2$;" Repair completed."
  314. 2835   IF I = 1 THEN WD = 8
  315. 2840 NEXT I
  316. 2850 IF RND(1)>.2 THEN 2980
  317. 2860 R1=FNR(1)
  318. 2870 IF RND(1)>=.6 THEN 2910
  319. 2880 D(R1)=D(R1)-(RND(1)*5+1)
  320. 2885 IF R1=1 THEN WD=RND*8
  321. 2890 PRINT"DAMAGE CONTROL REPORT:"
  322. 2900 GOSUB 7620:PRINT G2$;" damaged":PRINT:GOTO 2980
  323. 2910 D(R1)=D(R1)+RND(1)*3+1
  324. 2920 PRINT"DAMAGE CONTROL REPORT:"
  325. 2930 GOSUB 7620
  326. 2940 PRINT G2$;" State of repair improved"
  327. 2950 '*****************************************************************
  328. 2960 '*  begin moving starship
  329. 2970 '*****************************************************************
  330. 2980 MOVES%(1,1)=INT(S1)
  331. 2990 MOVES%(1,2)=INT(S2)
  332. 3000 CR1=INT(C1)
  333. 3010 X1=C%(CR1,1)+(C%(CR1+1,1)-C%(CR1,1))*(C1-CR1)
  334. 3020 X=S1
  335. 3030 Y=S2
  336. 3040 X2=C%(CR1,2)+(C%(CR1+1,2)-C%(CR1,2))*(C1-CR1)
  337. 3050 Q4=Q1
  338. 3060 Q5=Q2
  339. 3070 FOR I=1 TO N
  340. 3080   S1=S1+X1
  341. 3090   S2=S2+X2
  342. 3100   SR1=INT(.5+S1)
  343. 3110   SR2=INT(.5+S2)
  344. 3120   IF SR1<1 OR SR1>=9 OR SR2<1 OR SR2>=9 THEN 3350
  345. 3130   IF Q%(SR1,SR2)=0 THEN 3190
  346. 3140   S1=INT(S1+.5-X1)
  347. 3150   S2=INT(.5+S2-X2)
  348. 3160   PRINT"Warp engines shut down at "
  349. 3170   PRINT "sector";S1;",";S2;"due to bad navigation."
  350. 3180   GOTO 3250
  351. 3190   MOVES%(I+1,1)=SR1
  352. 3200   MOVES%(I+1,2)=SR2
  353. 3210 NEXT I
  354. 3220 S1=SR1
  355. 3230 S2=SR2
  356. 3240 GOSUB 5510
  357. 3250 GOSUB 8050
  358. 3260 MOVERANDOM%=4
  359. 3270 GOSUB 8230
  360. 3280 GOSUB 3570
  361. 3290 T8=1
  362. 3300 IF W1<1 THEN T8=.1*INT(10*W1)
  363. 3310 T=T+T8:IF T>T0+T9 THEN 5750
  364. 3320 REM see if docked then get command
  365. 3330 GOTO 2050
  366. 3340 REM exceeded quadrant limits
  367. 3350 GOSUB 8050
  368. 3360 LOCATE 3+INT(.5+S1-X1),48+3*INT(.5+S2-X2)
  369. 3370 PRINT "   ";
  370. 3380 LOCATE 15,1
  371. 3390 X=8*Q1+X+N*X1:Y=8*Q2+Y+N*X2:Q1=INT(X/8):Q2=INT(Y/8):S1=INT(X-Q1*8)
  372. 3400 S2=INT(Y-Q2*8):IF S1=0 THEN Q1=Q1-1:S1=8
  373. 3410 IF S2=0 THEN Q2=Q2-1:S2=8
  374. 3420 X5=0:IF Q1<1 THEN X5=1:Q1=1:S1=1
  375. 3430 IF Q1>8 THEN X5=1:Q1=8:S1=8
  376. 3440 IF Q2<1 THEN X5=1:Q2=1:S2=1
  377. 3450 IF Q2>8 THEN X5=1:Q2=8:S2=8
  378. 3460 IF X5=0 THEN 3540
  379. 3470 PRINT"Lt. Uhura reports message from Starfleet Command:"
  380. 3480 PRINT"  'Permission to attempt crossing of galactic perimeter"
  381. 3490 PRINT"  is hereby *DENIED*.  Shut down your engines.'"
  382. 3500 PRINT "Chief Engineer Scott reports"
  383. 3510 PRINT "  'Warp engines shut down"
  384. 3520 PRINT "  at sector";S1;",";S2;"of quadrant";Q1;",";Q2".'"
  385. 3530 IF T>T0 THEN 5750
  386. 3540 IF 8*Q1+Q2=8*Q4+Q5 THEN 3250
  387. 3550 T=T+1:GOSUB 3570:GOTO 1500
  388. 3560 REM maneuver energy s/r **
  389. 3570 E=E-N-10:IF E>0 THEN RETURN
  390. 3580 PRINT "Shield control supplies energy"
  391. 3590 PRINT "to complete the maneuver."
  392. 3600 S=S+E:E=0:IF S<=0 THEN S=0
  393. 3610 RETURN
  394. 3620 '** Long range sensor scan code
  395. 3630 IF D(3)<0 THEN PRINT"Long Range Sensors are inoperable":GOTO 2060
  396. 3640 IF GALRECSET=1 THEN GOSUB 9680 ELSE GOSUB 9600
  397. 3650 COLOR 6,0:LOCATE 14,58
  398. 3660 PRINT"LONG RANGE SCAN";
  399. 3670 LOCATE 15,58
  400. 3680 PRINT"QUADRANT";Q1;",";Q2;
  401. 3690 O1$="-------------------":FOR I=16 TO 22 STEP 2: LOCATE I,55: PRINT O1$;: NEXT I
  402. 3700 ITEMP=0
  403. 3710 FOR I=Q1-1 TO Q1+1
  404. 3720   N(1)=-1
  405. 3730   N(2)=-2
  406. 3740   N(3)=-3
  407. 3750   FOR J=Q2-1 TO Q2+1
  408. 3760     IF I>0 AND I<9 AND J>0 AND J<9 THEN N(J-Q2+2)=G(I,J):Z(I,J)=G(I,J)
  409. 3770   NEXT J
  410. 3780   ITEMP=ITEMP+1
  411. 3790   LOCATE 15+ITEMP*2,55
  412. 3800   FOR L=1 TO 3
  413. 3810     PRINT": ";
  414. 3820     IF N(L)<0 THEN PRINT"*** ";: GOTO 3840
  415. 3830     PRINT RIGHT$(STR$(N(L)+1000),3);" ";
  416. 3840   NEXT L
  417. 3850   PRINT":";
  418. 3860 NEXT I:COLOR 3,0
  419. 3870 GOTO 2060
  420. 3880 '*****************************************************************
  421. 3890 '*  phaser control code begins here
  422. 3900 '*****************************************************************
  423. 3910 IF D(4)<0 THEN PRINT"Phasers Inoperative":GOTO 2060
  424. 3920 IF K3>0 THEN 3970
  425. 3930 PRINT "Science Officer Spock reports"
  426. 3940 PRINT "  'Sensors show no enemy ships"
  427. 3950 PRINT "   in this quadrant'"
  428. 3960 GOTO 2060
  429. 3970 IF D(8)<0 THEN PRINT"Computer failure hampers accuracy"
  430. 3980 IF K3>1 THEN A$="s" ELSE A$=" "
  431. 3990 PRINT "Phasers locked on target"+A$
  432. 4000 PRINT"Energy available = ";E;"units"
  433. 4010 INPUT "Numbers of units to fire";X
  434. 4020 IF X<=0 THEN 2060
  435. 4030 IF E-X<0 THEN 4000
  436. 4040 E=E-X
  437. 4050 GOSUB 5500
  438. 4060 GOSUB 9920
  439. 4070 IF D(7)<0 THEN X=X*RND(1)
  440. 4080 H1=INT(X/K3)
  441. 4090 FOR I=1 TO 3
  442. 4100   IF K%(I,3)<=0 THEN 4370
  443. 4110   H=INT((H1/FND(0))*(RND(1)+2))
  444. 4120   IF H>.15*K%(I,3) THEN 4150
  445. 4130   PRINT"Sensors show no damage to enemy at ";K%(I,1);",";K%(I,2)
  446. 4140   GOTO 4370
  447. 4150   K%(I,3)=K%(I,3)-H:IF K%(I,3)>0 THEN 4160
  448. 4154   COLOR 16,7
  449. 4155   PRINT"***KLINGON at";K%(I,1);","K%(I,2);"DESTROYED***":GOTO 4170
  450. 4160   PRINT H;"Units hit Klingon at";K%(I,1);",";K%(I,2);K%(I,3);"units left"
  451. 4170   GOSUB 9290
  452. 4180   LOCATE 3+K%(I,1),48+3*K%(I,2)
  453. 4190   IF K%(I,3)<=0 THEN GOTO 4260
  454. 4200   COLOR 12,0
  455. 4210   IF SRS.CLEARED=0 AND D(2)>=0 THEN PRINT KLINGON$;
  456. 4230   LOCATE CURSY%,CURSX%
  457. 4250   GOTO 4370
  458. 4260   COLOR 31,0
  459. 4270   IF SRS.CLEARED=0 AND D(2)>=0 THEN PRINT KLINGON$;
  460. 4280   LOCATE CURSY%,CURSX%
  461. 4310   COLOR 3,0
  462. 4320   K3=K3-1
  463. 4330   K9=K9-1
  464. 4340   K%(I,3)=0
  465. 4350   G(Q1,Q2)=G(Q1,Q2)-100
  466. 4360   Z(Q1,Q2)=G(Q1,Q2)
  467. 4370 NEXT I
  468. 4380 GOSUB 9290
  469. 4390 FOR I=1 TO 600
  470. 4400 NEXT I
  471. 4410 FOR I=1 TO 3
  472. 4420   LOCATE 3+K%(I,1),48+3*K%(I,2)
  473. 4430   IF Q%(K%(I,1),K%(I,2))>=0 THEN GOTO 4470
  474. 4440   IF K%(I,3)>0 THEN COLOR 12,0:PRINT KLINGON$;: GOTO 4470
  475. 4450   PRINT "   ";
  476. 4460   Q%(K%(I,1),K%(I,2))=0
  477. 4470 NEXT I
  478. 4480 LOCATE CURSY%,CURSX%
  479. 4490 IF K9<=0 THEN 5970
  480. 4500 GOTO 2060
  481. 4510 '*****************************************************************
  482. 4520 '*  photon torpedo code begins here
  483. 4530 '*****************************************************************
  484. 4540 IF P<=0 THEN PRINT "All photon torpedoes expended": GOTO 2060
  485. 4550 IF D(5)<0 THEN PRINT "Photon tubes are not operational": GOTO 2060
  486. 4560 INPUT"Photon torpedo course (1-9)";C1:IF C1=9 THEN C1=1
  487. 4570 IF C1>=1 AND C1<9 THEN 4610
  488. 4580 PRINT "Ensign Chekov reports:"
  489. 4590 PRINT "  'Incorrect course data, sir!'"
  490. 4600 GOTO 2060
  491. 4610 CR1=INT(C1)
  492. 4620 MOVERANDOM%=1
  493. 4630 GOSUB 8230
  494. 4640 GOSUB 5500
  495. 4650 ITEMP=1
  496. 4660 X1=C%(CR1,1)+(C%(CR1+1,1)-C%(CR1,1))*(C1-CR1)
  497. 4670 E=E-2
  498. 4680 P=P-1
  499. 4690 X2=C%(CR1,2)+(C%(CR1+1,2)-C%(CR1,2))*(C1-CR1):X=S1:Y=S2
  500. 4700 X=X+X1:Y=Y+X2:X3=INT(X+.5):Y3=INT(Y+.5)
  501. 4710 MOVES%(ITEMP,1)=X3
  502. 4720 MOVES%(ITEMP,2)=Y3
  503. 4730 IF X3<1 OR X3>8 OR Y3<1 OR Y3>8 THEN GOSUB 8450: GOTO 5030
  504. 4740 ITEMP=ITEMP+1
  505. 4750 IF Q%(X3,Y3)=0 THEN 4700 ELSE GOSUB 8450
  506. 4760 IF Q%(X3,Y3)>0 THEN 4870
  507. 4770 COLOR 30,15:PRINT"**** KLINGON DESTROYED ****":COLOR 3,0
  508. 4780 Q%(X3,Y3)=0
  509. 4790 K3=K3-1
  510. 4800 K9=K9-1
  511. 4810 I=1
  512. 4820 WHILE K%(I,1)<>X3 OR K%(I,2)<>Y3
  513. 4830   I=I+1
  514. 4840 WEND
  515. 4850 K%(I,3)=0
  516. 4860 IF K9<=0 THEN 5970 ELSE GOTO 5020
  517. 4870 IF Q%(X3,Y3)<>2 THEN 4900
  518. 4880 PRINT"Star at";X3;",";Y3;"absorbed torpedo energy."
  519. 4890 GOTO 2060
  520. 4900 IF Q%(X3,Y3)<>1 THEN 4560
  521. 4910 COLOR 20,15:PRINT"*** STARBASE DESTROYED ***";:COLOR 3,0:PRINT SPC(54)
  522. 4920 Q%(X3,Y3)=0
  523. 4930 B3=B3-1
  524. 4940 B9=B9-1
  525. 4950 IF B9>0 OR K9>T-T0-T9 THEN 4990
  526. 4960 PRINT"THAT DOES IT, CAPTAIN!!  You are hereby relieved of command"SPC(21)
  527. 4970 PRINT"and sentenced to 99 stardates of hard labor on CYGNUS 12!!"
  528. 4980 GOTO 5810
  529. 4990 PRINT"Starfleet reviewing your record to consider"
  530. 5000 PRINT"court martial!":D0=0
  531. 5010 Q%(X3,Y3)=0
  532. 5020 G(Q1,Q2)=K3*100+B3*10+S3:Z(Q1,Q2)=G(Q1,Q2):GOSUB 5500:GOTO 2060
  533. 5030 PRINT "Torpedo missed"
  534. 5040 GOTO 2060
  535. 5050 '*****************************************************************
  536. 5060 '*  shield control
  537. 5070 '*****************************************************************
  538. 5080 IF D(7)<0 THEN PRINT"Shield control inoperable":GOTO 2060
  539. 5090 PRINT "Energy available = ";E+S
  540. 5100 INPUT "Number of units to shields";X
  541. 5110 IF X<0 OR S=X THEN PRINT"<shields unchanged>":GOTO 2060
  542. 5120 IF X<E+S THEN 5160
  543. 5130 PRINT "Shield Control reports"
  544. 5140 PRINT "  'This is not the federation treasury.'"
  545. 5150 PRINT"<shields unchanged>:goto 1990
  546. 5160 E=E+S-X
  547. 5170 S=X
  548. 5180 PRINT "Deflector Control Room report:"
  549. 5190 PRINT "  'Shields now at";INT(S);"units"
  550. 5200 PRINT "  per your command.'"
  551. 5210 GOTO 2060
  552. 5220 '*****************************************************************
  553. 5230 '*  damage control
  554. 5240 '*****************************************************************
  555. 5250 IF D(6)>=0 THEN 5400
  556. 5260 PRINT "Damage control report not available"
  557. 5270 IF D0=0 THEN 2060
  558. 5280 D3=0:FOR I=1 TO 8:IF D(I)<0 THEN D3=D3+1
  559. 5290 NEXT I:IF D3=0 THEN 2060
  560. 5300 PRINT:D3=D3+D4:IF D3>=1 THEN D3=.9000001
  561. 5310 PRINT "Technicians standing by to effect                       "
  562. 5320 PRINT "repairs to your ship estimated time"
  563. 5330 PRINT "to repair:";.01*INT(100*D3);"stardates"
  564. 5340 INPUT "Will you authorize the repair order (Y/N)";A$
  565. 5350 A$=LEFT$(A$,1):IF A$<>"y" AND A$<>"Y" THEN 2060
  566. 5360 FOR I=1 TO 8
  567. 5370   IF D(I)<0 THEN D(I)=0
  568. 5380 NEXT I
  569. 5390 T=T+D3+.1
  570. 5400 IF CLEARFLAG<2 THEN GOSUB 9680
  571. 5410 GALRECSET=1
  572. 5420 LOCATE 8,30:PRINT"Device            state of repair":FOR R1=1 TO 8
  573. 5430 GOSUB 7620:LOCATE 9+R1,30: PRINT G2$;:GG2$=LEFT$(Z$,25-LEN(G2$)): PRINT GG2$;
  574. 5440 GG2=INT(D(R1)*100)*.01:LOCATE 9+R1,55:PRINT GG2;:PRINT "  "
  575. 5450 NEXT R1: PRINT:IF D0<>0 THEN LOCATE 16,1: GOTO 5280
  576. 5460 GOTO 2060
  577. 5470 '*****************************************************************
  578. 5480 '*  klingons shooting
  579. 5490 '*****************************************************************
  580. 5500 IF K3<=0 THEN RETURN
  581. 5510 IF D0<>0 THEN PRINT"Starbase shields protect the ENTERPRISE":RETURN
  582. 5520 TOTHIT=0
  583. 5530 FOR I=1 TO 3:IF K%(I,3)<=0 THEN 5570
  584. 5540   TOTHIT=TOTHIT+INT((K%(I,3)/FND(1))*(1+RND(1)))
  585. 5550   S=S-TOTHIT
  586. 5560   E=E-TOTHIT
  587. 5570 NEXT I
  588. 5580 IF TOTHIT=0 THEN 5710
  589. 5590 COLOR 20,15
  590. 5600 PRINT TOTHIT;"unit hit on ENTERPRISE!"
  591. 5610 COLOR 3,0
  592. 5620 GOSUB 9980
  593. 5640 IF S<=0 THEN 5790
  594. 5650 PRINT "      <shields down to";S;"units>"
  595. 5660 IF TOTHIT<20 THEN 5710
  596. 5670 IF RND(1)>.6 OR TOTHIT/S<=.02 THEN 5710
  597. 5680 R1=FNR(1):D(R1)=D(R1)-TOTHIT/S-.5*RND(1):GOSUB 7620
  598. 5690 COLOR 14,0:PRINT "Damage control reports ";G2$;" damaged":COLOR 3,0
  599. 5710 RETURN
  600. 5720 '*****************************************************************
  601. 5730 '*  end of game
  602. 5740 '*****************************************************************
  603. 5750 FOR I=1 TO 2000:NEXT I:CLS
  604. 5760 LOCATE 5,1
  605. 5770 PRINT "It is stardate";T
  606. 5780 GOTO 5810
  607. 5790 CLS:PRINT "The ENTERPRISE has been destroyed.  The Federation";
  608. 5800 PRINT" will be conquered.":GOTO 5750
  609. 5810 PRINT"There were";K9;"Klingon battle cruisers left on your mission."
  610. 5820 PRINT:PRINT:IF B9=0 THEN 5960
  611. 5830 PRINT "The Federation is in need of a new starship commander for a similar"
  612. 5840 PRINT "mission -- if there is a volunteer, let him or her step forward and"
  613. 5850 INPUT"enter 'aye'";A$:IF A$="aye" OR A$="AYE" THEN 610
  614. 5860 KEY 1,"LIST "
  615. 5870 KEY 2,"RUN"+CHR$(13)
  616. 5880 KEY 3,"LOAD"+CHR$(34)
  617. 5890 KEY 4, "SAVE"+CHR$(34)
  618. 5900 KEY 5, "CONT"+CHR$(13)
  619. 5910 KEY 6,","+CHR$(34)+"LPT1:"+CHR$(34)+CHR$(13)
  620. 5920 KEY 7, "TRON"+CHR$(13)
  621. 5930 KEY 8, "TROFF"+CHR$(13)
  622. 5940 KEY 9, "KEY "
  623. 5950 KEY 10,"SCREEN 0,0,0"+CHR$(13)
  624. 5960 END
  625. 5970 CLS:PRINT"Congratulations, Captain! The last Klingon battle cruiser"
  626. 5980 PRINT"menacing the Federation has been destroyed.":PRINT
  627. 5990 PRINT"Your efficiency rating is";1000*(K7/(T-T0))^2:GOTO 5820
  628. 6000 '*****************************************************************
  629. 6010 '*  short range sensor scan & startup subroutine
  630. 6020 '*****************************************************************
  631. 6030 IF START=1 THEN CLS: GOSUB 9330: GOSUB 6240: GOSUB 6360: START=0
  632. 6040 LOCATE 1,1: START=0
  633. 6050 FOR I=S1-1 TO S1+1
  634. 6060   FOR J=S2-1 TO S2+1
  635. 6070     IF INT(I+.5)<1 OR INT(I+.5)>8 OR INT(J+.5)<1 OR INT(J+.5)>8 THEN 6090
  636. 6080     IF Q%(I,J)=1 THEN 6130
  637. 6090   NEXT J
  638. 6100 NEXT I
  639. 6110 D0=0
  640. 6120 GOTO 6200
  641. 6130 D0=1
  642. 6140 CC$="docked"
  643. 6150 E=E0
  644. 6160 P=P0
  645. 6170 PRINT"Shields down for docking"
  646. 6180 S=0
  647. 6190 GOTO 6210
  648. 6200 IF E<E0*.2 THEN C$="YELLOW" ELSE C$="GREEN "
  649. 6210 GOSUB 8890
  650. 6220 RETURN
  651. 6230 '*****************************************************************
  652. 6240 '*  LIST INFORMATION HEADINGS
  653. 6250 '*****************************************************************
  654. 6260 COLOR 1,0:LOCATE 4,1: PRINT "Stardate";
  655. 6270 LOCATE 5,1: PRINT "Condition";
  656. 6280 LOCATE 6,1: PRINT "Quadrant";
  657. 6290 LOCATE 7,1: PRINT "Sector";
  658. 6300 LOCATE 8,1: PRINT "Photon torpedoes";
  659. 6310 LOCATE 9,1: PRINT "Total energy";
  660. 6320 LOCATE 10,1: PRINT "Shields";
  661. 6330 LOCATE 11,1: PRINT "Klingons remaining";
  662. 6340 RETURN
  663. 6350 '*****************************************************************
  664. 6360 '*  LIST INFORMATION
  665. 6370 '*****************************************************************
  666. 6380 COLOR 3,0:LOCATE 4,19: TT=INT(10*T)*.1: PRINT TT;
  667. 6390 LOCATE 5,20: PRINT "      ";
  668. 6400 LOCATE 5,20:IF C$="YELLOW" THEN COLOR 14,0:PRINT C$;
  669. 6405 LOCATE 5,20:IF C$="GREEN " THEN COLOR 2,0:PRINT C$;
  670. 6410 LOCATE 5,20:IF K3>0  THEN COLOR 20,14: PRINT " RED  ";
  671. 6415 COLOR 3,0
  672. 6420 LOCATE 6,19: PRINT Q1;",";Q2;
  673. 6430 LOCATE 7,19: PRINT S1;",";S2;
  674. 6440 LOCATE 8,19: PRINT INT(P);
  675. 6450 LOCATE 9,19: PRINT INT(E+S);
  676. 6460 LOCATE 10,1
  677. 6470 IF S<200 AND K3>0 THEN COLOR 30,1: PRINT "SHIELDS LOW";: COLOR 1,0: ELSE PRINT "Shields    ";
  678. 6480 LOCATE 10,19: PRINT INT(S);:PRINT "  ";
  679. 6490 LOCATE 11,19: PRINT INT(K9);
  680. 6500 IF K3>0 THEN GOSUB 9790
  681. 6510 RETURN
  682. 6520 REM library computer code
  683. 6530 CM1$="GALSTATORBASDIRREG"
  684. 6535 COLOR 1,0
  685. 6540 IF D(8)<0 THEN PRINT"Computer Disabled":GOTO 2060
  686. 6550 KEY 1, "GAL RCD"+CHR$(13)
  687. 6560 KEY 2, "STATUS"+CHR$(13)
  688. 6570 KEY 3, "DIR/DIST"+CHR$(13)
  689. 6580 KEY 4, "BASE NAV"+CHR$(13)
  690. 6590 KEY 5, "TOR DATA"+CHR$(13)
  691. 6600 KEY 6, "REG MAP"+CHR$(13)
  692. 6610 KEY 7,CHR$(13):KEY 8,CHR$(13):KEY 9,CHR$(13):KEY 10,CHR$(13)
  693. 6620 INPUT"Computer awaiting your command";CM$
  694. 6630 H8=1
  695. 6640 FOR K= 1 TO 6
  696. 6650   IF LEFT$(CM$,3)<>MID$(CM1$,3*K-2,3) THEN 6670
  697. 6660   ON K GOTO 6890,7100,7220,7480,7280,6810
  698. 6670 NEXT K
  699. 6680 GOSUB 9680
  700. 6690 LOCATE 3,36: PRINT "Functions available from library-computer:";
  701. 6700 LOCATE 4,36: PRINT "   KEY 1= Cumulative galactic record";
  702. 6710 LOCATE 5,36: PRINT "   KEY 2 = Status report";
  703. 6720 LOCATE 6,36: PRINT "   KEY 3 = Direction/distance calculator";
  704. 6730 LOCATE 7,36: PRINT "   KEY 4 = Starbase nav data";
  705. 6740 LOCATE 8,36: PRINT "   KEY 5 = Photon torpedo data";
  706. 6750 LOCATE 9,36: PRINT "   KEY 6 = Galaxy 'region name' map";
  707. 6760 GALRECSET=1
  708. 6770 GOTO 6620
  709. 6780 '*****************************************************************
  710. 6790 '*  setup to change cum gal record to galaxy map
  711. 6800 '*****************************************************************
  712. 6810 GOSUB 9330
  713. 6820 H8=0
  714. 6830 G5=1
  715. 6840 GOSUB 9680
  716. 6850 LOCATE 2,55
  717. 6860 PRINT"THE GALAXY";
  718. 6870 GOTO 6940
  719. 6880 '*****************************************************************
  720. 6890 '*  cum galactic record
  721. 6900 '*****************************************************************
  722. 6910 GOSUB 9330
  723. 6920 GOSUB 9680
  724. 6930 LOCATE 2,33: PRINT "Computer record of galaxy for quadrant";Q1;",";Q2;
  725. 6940 LOCATE 4,28
  726. 6950 PRINT"     1     2     3     4     5     6     7     8"
  727. 6960 O1$= "----- ----- ----- ----- ----- ----- ----- -----"
  728. 6970 GALRECSET=1:COLOR 11,0
  729. 6980 FOR I=5 TO 21 STEP 2
  730. 6990 LOCATE I,31: PRINT O1$;
  731. 7000 NEXT I
  732. 7010 FOR I=1 TO 8:LOCATE 4+I*2,28: PRINT I;" ";: IF H8=0 THEN 7050
  733. 7020 FOR J=1 TO 8: IF Z(I,J)=0 THEN PRINT"***   ";:GOTO 7040
  734. 7030 PRINT RIGHT$(STR$(Z(I,J)+1000),3);"   ";
  735. 7040 NEXT J:GOTO 7070
  736. 7050 Z4=I:Z5=1:GOSUB 7770:J0=INT(43-.5*LEN(G2$)): PRINT TAB(J0);G2$;
  737. 7060 Z5=5:GOSUB 7770:J0=INT(67-.5*LEN(G2$)):PRINT TAB(J0);G2$;
  738. 7070 NEXT I
  739. 7080 GOTO 2060
  740. 7090 REM status report
  741. 7100 GOSUB 9330:GOSUB 9660: LOCATE 2,33: PRINT"Status Report":X$="":IF K9>1 THEN X$="s"
  742. 7110 LOCATE 3,30: PRINT"Klingon";X$;" left: ";K9
  743. 7120 LOCATE 4,30: PRINT"Mission must be completed in";.1*INT((T0+T9-T)*10);"stardates."
  744. 7130 X$="s":IF B9<2 THEN X$="":IF B9<1 THEN 7190
  745. 7140 LOCATE 5,30: PRINT "The federation is maintaining";B9;"starbase";X$;
  746. 7150 LOCATE 6,30: PRINT "in the galaxy.";
  747. 7160 CLEARFLAG=5
  748. 7170 GOTO 5250
  749. 7180 LOCATE 18,1
  750. 7190 LOCATE 5,30: PRINT "Your stupidity has left you on your own in"
  751. 7200 LOCATE 6,30: PRINT "the galaxy -- you have no starbases left!":GOTO 5250
  752. 7210 REM torpedo, base nav, d/d calculator
  753. 7220 GOSUB 9330:IF K3<=0 THEN 3930
  754. 7230 X$="":IF K3>1 THEN X$="s"
  755. 7240 PRINT"From ENTERPRISE to Klingon battle cruiser";X$
  756. 7250 H8=0:FOR I=1 TO 3:IF K%(I,3)<=0 THEN 7470
  757. 7260 W1=K%(I,1):X=K%(I,2)
  758. 7270 C1=S1:A=S2:GOTO 7320
  759. 7280 GOSUB 9330:PRINT"Direction/Distance Calculator:"
  760. 7290 PRINT"You are at quadrant ";Q1;",";Q2;" sector ";S1;",";S2
  761. 7300 INPUT " Initial coordinates (x,y)";C1,A
  762. 7310 INPUT " Final coordinates (x,y)";W1,X
  763. 7320 X=X-A: A=C1-W1:IF X<0 THEN 7400
  764. 7330 IF A<0 THEN 7420
  765. 7340 IF X>0 THEN 7360
  766. 7350 IF A=0 THEN C1=5:GOTO 7370
  767. 7360 C1=1
  768. 7370 IF ABS(A)<=ABS(X) THEN 7390
  769. 7380 PRINT"Direction =";C1+(((ABS(A)-ABS(X))+ABS(A))/ABS(A)):GOTO 7460
  770. 7390 PRINT"Direction =";C1+(ABS(A)/ABS(X)):GOTO 7460
  771. 7400 IF A>0 THEN C1=3:GOTO 7430
  772. 7410 IF X<>0 THEN C1=5:GOTO 7370
  773. 7420 C1=7
  774. 7430 IF ABS(A)>=ABS(X) THEN 7450
  775. 7440 PRINT"Direction =";C1+(((ABS(X)-ABS(A))+ABS(X))/ABS(X)):GOTO 7460
  776. 7450 PRINT"Direction =";:CC1=C1+(ABS(X)/ABS(A)):PRINT CC1
  777. 7460 PRINT"Distance =";SQR(X^2+A^2):IF H8=1 THEN 2060
  778. 7470 NEXT I:GOTO 2060
  779. 7480 GOSUB 9330:IF B3<>0 THEN PRINT"From ENTERPRISE to Starbase:":W1=B4:X=B5
  780. 7490 GOTO 7270
  781. 7500 PRINT "Mr. Spock reports:"
  782. 7510 PRINT "  'Sensors show no starbases"
  783. 7520 PRINT "   in this quadrant.'"
  784. 7530 GOTO 2060
  785. 7540 '***************************************************************
  786. 7550 '* FINDS RANDOM EMPTY SPOT IN QUADRANT
  787. 7560 '***************************************************************
  788. 7570 R1=FNR(1)
  789. 7580 R2=FNR(1)
  790. 7590 IF Q%(R1,R2)=0 THEN RETURN ELSE 7570
  791. 7600 RETURN
  792. 7610 REM prints device name
  793. 7620 ON R1 GOTO 7630,7640,7650,7660,7670,7680,7690,7700
  794. 7630 G2$="Warp Engines":RETURN
  795. 7640 G2$="Short Range Sensors":RETURN
  796. 7650 G2$="Long Range Sensors":RETURN
  797. 7660 G2$="Phaser Control":RETURN
  798. 7670 G2$="Photon Tubes":RETURN
  799. 7680 G2$="Damage Control":RETURN
  800. 7690 G2$="Shield Control":RETURN
  801. 7700 G2$="Library-Computer":RETURN
  802. 7710 REM string comparison in quadrant array
  803. 7720 Z1=INT(Z1+.5):Z2=INT(Z2+.5):S8=(Z2-1)*3+(Z1-1)*24+1:Z3=0
  804. 7730 IF MID$(Q$,S8,3)<>A$ THEN RETURN
  805. 7740 Z3=1:RETURN
  806. 7750 REM quadrant name in g2$ from z4,z5 (=q1,q2)
  807. 7760 REM call with g5=1 to get region name only
  808. 7770 IF Z5<+4 THEN ON Z4 GOTO 7790,7800,7810,7820,7830,7840,7850,7860
  809. 7780 GOTO 7870
  810. 7790 G2$="Antares":GOTO 7960
  811. 7800 G2$="Rigel":GOTO 7960
  812. 7810 G2$="Procyon":GOTO 7960
  813. 7820 G2$="Vega":GOTO 7960
  814. 7830 G2$="Canopus":GOTO 7960
  815. 7840 G2$="Altair":GOTO 7960
  816. 7850 G2$="Sagittarius":GOTO 7960
  817. 7860 G2$="Pollux":GOTO 7960
  818. 7870 ON Z4 GOTO 7880,7890,7900,7910,7920,7930,7940,7950
  819. 7880 G2$="Sirius":GOTO 7960
  820. 7890 G2$="Deneb":GOTO 7960
  821. 7900 G2$="Capella":GOTO 7960
  822. 7910 G2$="Betelgeuse":GOTO 7960
  823. 7920 G2$="Aldebaran":GOTO 7960
  824. 7930 G2$="Regulus":GOTO 7960
  825. 7940 G2$="Arcturus":GOTO 7960
  826. 7950 G2$="Spica"
  827. 7960 IF G5<>1 THEN ON Z5 GOTO 7980,7990,8000,8010,7980,7990,8000,8010
  828. 7970 RETURN
  829. 7980 G2$=G2$+" i":RETURN
  830. 7990 G2$=G2$+" ii":RETURN
  831. 8000 G2$=G2$+" iii":RETURN
  832. 8010 G2$=G2$+" iv":RETURN
  833. 8020 '*********************************************************
  834. 8030 '* MOVE ENTERPRISE ALONG COURSE IN MOVE%
  835. 8040 '*********************************************************
  836. 8050 Q%(MOVES%(1,1),MOVES%(1,2))=0
  837. 8060 GOSUB 9290
  838. 8070 I=2
  839. 8080 WHILE MOVES%(I,1)<>0
  840. 8090   LOCATE 3+MOVES%(I-1,1),48+3*MOVES%(I-1,2)
  841. 8100   IF SRS.CLEARED=0 THEN PRINT "   ";
  842. 8110   LOCATE 3+MOVES%(I,1),48+3*MOVES%(I,2)
  843. 8120   IF SRS.CLEARED=0 THEN COLOR 10,0:PRINT ENTERPRISE$;
  844. 8130   MOVES%(I-1,1)=0
  845. 8140   I=I+1
  846. 8150 WEND
  847. 8160 Q%(MOVES%(I-1,1),MOVES%(I-1,2))=30000
  848. 8170 MOVES%(I-1,1)=0
  849. 8180 LOCATE CURSY%,CURSX%
  850. 8190 RETURN
  851. 8200 '*****************************************************************
  852. 8210 '*  MOVE KLINGONS
  853. 8220 '*****************************************************************
  854. 8230 FOR I=1 TO K3
  855. 8240   IF K%(I,3)=0 THEN 8380
  856. 8250   FOR ITEMP=1 TO MOVERANDOM%+1
  857. 8260     GOSUB 7570
  858. 8270     IF ABS(R1-K%(I,1))>1 OR ABS(R2-K%(I,2))>1 THEN 8370
  859. 8280     IF SRS.CLEARED=1 THEN 8330
  860. 8290     LOCATE 3+K%(I,1),48+3*K%(I,2)
  861. 8300     PRINT "   ";
  862. 8310     LOCATE 3+R1,48+3*R2
  863. 8320     COLOR 12,0:IF D(2)>=0 THEN PRINT KLINGON$;
  864. 8330     Q%(K%(I,1),K%(I,2))=0
  865. 8340     Q%(R1,R2)=-1
  866. 8350     K%(I,1)=R1
  867. 8360     K%(I,2)=R2
  868. 8370   NEXT ITEMP
  869. 8380 NEXT I
  870. 8390 LOCATE 15,1
  871. 8400 MOVERANDOM%=0
  872. 8410 RETURN
  873. 8420 '*****************************************************************
  874. 8430 '*  MOVE TORPEDO ALONG COURSE MOVES%
  875. 8440 '*****************************************************************
  876. 8450 GOSUB 8890
  877. 8460 GOSUB 9290   'SAVE CURSOR POSITION
  878. 8470 GOSUB 9860
  879. 8480 IF MOVES%(2,1)<>0 THEN LOCATE 3+MOVES%(1,1),49+3*MOVES%(1,2) ELSE ITEMP=1: GOTO 8630
  880. 8490 ITEMP=3
  881. 8500 IF SRS.CLEARED=0 THEN PRINT TORPEDO$;
  882. 8510 WHILE MOVES%(ITEMP,1)<>0
  883. 8520   LOCATE 3+MOVES%(ITEMP-2,1),49+3*MOVES%(ITEMP-2,2)
  884. 8530   IF SRS.CLEARED=0 THEN PRINT " ";
  885. 8540   LOCATE 3+MOVES%(ITEMP-1,1),49+3*MOVES%(ITEMP-1,2)
  886. 8550   IF SRS.CLEARED=0 THEN PRINT TORPEDO$;
  887. 8560   MOVES%(ITEMP-2,1)=0
  888. 8570   MOVES%(ITEMP-2,2)=0
  889. 8580   ITEMP=ITEMP+1
  890. 8590 WEND
  891. 8600 LOCATE 3+MOVES%(ITEMP-2,1),49+3*MOVES%(ITEMP-2,2)
  892. 8610 IF SRS.CLEARED=0 THEN PRINT " "; ELSE GOTO 8750
  893. 8620 ITEMP=ITEMP-1
  894. 8630 IF MOVES%(ITEMP,1)<1 OR MOVES%(ITEMP,2)<1 OR MOVES%(ITEMP,1)>8 OR MOVES%(ITEMP,2)>8 THEN 8750
  895. 8640 IF Q%(MOVES%(ITEMP,1),MOVES%(ITEMP,2))=0 THEN 8750
  896. 8650 LOCATE 3+MOVES%(ITEMP,1),48+3*MOVES%(ITEMP,2)
  897. 8660 IF Q%(MOVES%(ITEMP,1),MOVES%(ITEMP,2))<0 THEN A$=KLINGON$: GOTO 8680
  898. 8670 IF Q%(MOVES%(ITEMP,1),MOVES%(ITEMP,2))=1 THEN A$=STARBASE$ ELSE A$=STAR$
  899. 8675 IF D(2)>=0 THEN 8750
  900. 8680 COLOR 31,0
  901. 8690 PRINT A$;
  902. 8700 COLOR 3,0
  903. 8710 FOR JTEMP=1 TO 500
  904. 8720 NEXT JTEMP
  905. 8730 LOCATE 3+MOVES%(ITEMP,1),48+3*MOVES%(ITEMP,2)
  906. 8740 IF A$=STAR$ THEN COLOR 14,0:PRINT A$ ELSE PRINT "   ";
  907. 8750 MOVES%(ITEMP,1)=0
  908. 8760 LOCATE CURSY%,CURSX%
  909. 8770 RETURN
  910. 8780 '*****************************************************************
  911. 8790 '*  CLEAR SHORT RANGE SCAN AREA
  912. 8800 '*****************************************************************
  913. 8810 FOR I=1 TO 13
  914. 8820   LOCATE I,30
  915. 8830   PRINT STRING$(49," ");
  916. 8840 NEXT I
  917. 8850 RETURN
  918. 8860 '*********************************************************
  919. 8870 '* DRAW QUADRANT FOR SRS
  920. 8880 '*********************************************************
  921. 8890 GOSUB 9290
  922. 8900 IF SRS.CLEARED=0 THEN SRS.CLEARED=2: GOTO 8920
  923. 8910 IF GALRECSET THEN GOSUB 9680 ELSE  GOSUB 8810
  924. 8920 IF D(2)>=0 THEN 9000
  925. 8930 GOSUB 8800
  926. 8940 LOCATE 6,50
  927. 8950 PRINT "SHORT RANGE SENSORS";
  928. 8960 LOCATE 7,53
  929. 8970 PRINT "ARE DISABLED";
  930. 8980 SRS.CLEARED=1
  931. 8990 GOTO 9240
  932. 9000 IF SRS.CLEARED=2 THEN 9230
  933. 9005 COLOR 1,0
  934. 9010 LOCATE 1,55
  935. 9020 PRINT "SHORT RANGE SCAN";
  936. 9030 LOCATE 2,52
  937. 9040 PRINT "1  2  3  4  5  6  7  8";
  938. 9050 LOCATE 3,50
  939. 9060 PRINT UPPERLINE$;
  940. 9070 FOR I=1 TO 8
  941. 9080   LOCATE I+3,49
  942. 9090   PRINT CHR$(48+I)+CHR$(199);
  943. 9100   FOR J=1 TO 8
  944. 9110     IF Q%(I,J)=0 THEN 9170
  945. 9115     COLOR 14,0
  946. 9120     IF Q%(I,J)=2 THEN LOCATE I+3,49+3*J:PRINT CHR$(15);:GOTO 9170
  947. 9130     LOCATE I+3,48+3*J
  948. 9140     IF Q%(I,J)=30000 THEN COLOR 10,0:PRINT ENTERPRISE$;: GOTO 9170
  949. 9150     IF Q%(I,J)<0 THEN COLOR 12,0:PRINT KLINGON$;: GOTO 9170
  950. 9160     PRINT STARBASE$;
  951. 9170   COLOR 1,0:NEXT J
  952. 9180   LOCATE I+3,75
  953. 9190   PRINT CHR$(182);
  954. 9200 NEXT I
  955. 9210 LOCATE 12,50
  956. 9220 PRINT LOWERLINE$;
  957. 9225 COLOR 3,0
  958. 9230 SRS.CLEARED=0
  959. 9240 LOCATE CURSY%,CURSX%
  960. 9250 RETURN
  961. 9260 '***************************************************************
  962. 9270 '*  SAVE CURSOR POSITION IN CURSX% AND CURSY%
  963. 9280 '***************************************************************
  964. 9290 CURSX%=POS(N)
  965. 9300 CURSY%=CSRLIN
  966. 9310 RETURN
  967. 9320 '***************************************************************
  968. 9330 '*   ------- set function keys  for game -------
  969. 9340 '***************************************************************
  970. 9350 KEY OFF
  971. 9360 KEY 1,"NAV"+CHR$(13)
  972. 9370 KEY 2,"SRS"+CHR$(13)
  973. 9380 KEY 3,"LRS"+CHR$(13)
  974. 9390 KEY 4,"PHASERS"+CHR$(13)
  975. 9400 KEY 5,"TORPEDO"+CHR$(13)
  976. 9410 KEY 6,"SHIELDS"+CHR$(13)
  977. 9420 KEY 7,"DAMAGE REPORT"+CHR$(13)
  978. 9430 KEY 8,"COMPUTER"+CHR$(13)
  979. 9440 KEY 9,"RESIGN"+CHR$(13)
  980. 9450 KEY 10,"CLEAR"+CHR$(13)
  981. 9460 KEY ON
  982. 9470 RETURN
  983. 9480 '*****************************************************************
  984. 9490 '*  CLEAR AND REDRAW SCREEN
  985. 9500 '*****************************************************************
  986. 9510 CLS
  987. 9520 GALRECSET=0
  988. 9530 SRS.CLEARED=1
  989. 9540 GOSUB 6260
  990. 9550 GOSUB 8890
  991. 9560 GOTO 2060
  992. 9570 '***************************************************************
  993. 9580 '*  CLEAR LOWER SCREEN FOR LRS SCAN
  994. 9590 '***************************************************************
  995. 9600 FOR ITEMP=13 TO 24
  996. 9610   LOCATE ITEMP,1: PRINT STRING$(79," ");
  997. 9620 NEXT ITEMP
  998. 9630 LOCATE 14,1
  999. 9640 RETURN
  1000. 9650 '***************************************************************
  1001. 9660 '*  CLEAR MOST OF SCREEN
  1002. 9670 '***************************************************************
  1003. 9680 FOR ITEMP=1 TO 11
  1004. 9690   LOCATE ITEMP,26: PRINT STRING$(53," ");
  1005. 9700 NEXT ITEMP
  1006. 9710 FOR ITEMP=12 TO 24
  1007. 9720   LOCATE ITEMP,1: PRINT STRING$(79," ");
  1008. 9730 NEXT ITEMP
  1009. 9740 SRS.CLEARED=1
  1010. 9750 GALRECSET=0
  1011. 9760 CLEARFLAG=0
  1012. 9770 LOCATE 14,1
  1013. 9780 RETURN
  1014. 9790 '    red alert sound
  1015. 9800 IF DH$="NO" OR DH$="N" THEN RETURN ELSE FOR J= 1 TO 5
  1016. 9810   FOR K=1000 TO 2000 STEP 20
  1017. 9820     SOUND K,.01*18.2
  1018. 9830   NEXT K
  1019. 9840 NEXT J
  1020. 9850 RETURN
  1021. 9860 '   torpedo sound
  1022. 9870 IF DH$="NO" OR DH$="N" THEN RETURN ELSE FOR J = 1500 TO 100 STEP -20
  1023. 9880   SOUND J,.01*18.2
  1024. 9890   SOUND 3600-J,.01*18.2
  1025. 9900 NEXT J
  1026. 9910 RETURN
  1027. 9920 '    phaser sound
  1028. 9930 IF DH$="NO"OR DH$="N" THEN RETURN ELSE FOR J= 1 TO 60
  1029. 9940   SOUND 800,.01*18.2
  1030. 9950   SOUND 2500,8.000001E-03*18.2
  1031. 9960 NEXT J
  1032. 9970 RETURN
  1033. 9980 '           alarm sound
  1034. 9990 IF DH$="NO" OR DH$="N" THEN RETURN ELSE FOR SI = 1 TO 4
  1035. 10000  FOR J=  800 TO 1500 STEP 20
  1036. 10010    SOUND J,.01 *18.2
  1037. 10020  NEXT J
  1038. 10030  FOR K = 1500 TO 800 STEP -20
  1039. 10040    SOUND K, .01 *18.2
  1040. 10050  NEXT K
  1041. 10060 NEXT SI
  1042. 10070 RETURN
  1043.