1 REM SETUP... THE FOLLOWING CAN BE CHANGED IN GAME AND SAVED 2 PROGEXIT=0:REM 0=QUIT 1=END, 2=TOUCHIDE (ANDROID ONLY) 3 ERTRAP=0:REM ON ERROR TARGET 0=END W/REPORT, 1=PROGEXIT 4 MONOCOL=0:REM 0=COLOR DISPLAY, >0=MONOCHROME TEXT COLOR CODE 5 MONOBKG=0:REM MONOCHROME BACKGROUND COLOR CODE 6 DISPLOOK=1:REM 0=STOCK, 1=GRID/NEW SYMBOLS 2=DOTS 3=DIVISIONS 7 REM THE FOLLOWING ARE NOT SAVED... 8 SFNAME$="SST3SAVE.DAT":PFNAME$="SST3PREF.DAT":REM SAVE/PREF FILENAMES 9 SDIR=1:REM 0=CURRENT OR FOR SDL/BBC4W 1=@usr$ 2=@dir$ 3=@tmp$ 10 REM 11 REM SST3 - SUPER STAR TREK FOR BBC BASIC - ENHANCED VERSION 12 REM 8/12/20 - CONVERSIONS FOR BBC BASIC. NEEDS A BIT MORE MEMORY NOW. 13 REM 10/19/20 - INPUT FORMATTING MODS, COMPUTER MODS, CODE FORMATTING 14 REM 12/15/20 - FIXED LINE SEQ BUGS (IGNORED BY SDL VERSION) 15 REM 2/9/21 - FIXED INCORRECT # BASES (LINE 440) 16 REM 2/9/21-2/22/21 - ADDED COLOUR! SAVE/RESTORE,LEVEL,PREFS,OTHER TWEAKS 17 REM 100 REM [ORIGINAL COMMENTS] 101 REM SUPER STARTREK - MAY 16,1978 - REQUIRES 24K MEMORY 102 REM **** **** STAR TREK **** **** 103 REM **** SIMULATION OF A MISSION OF THE STARSHIP ENTERPRISE, 104 REM **** AS SEEN ON THE STAR TREK TV SHOW. 105 REM **** ORIGIONAL PROGRAM BY MIKE MAYFIELD, MODIFIED VERSION 106 REM **** PUBLISHED IN DEC'S "101 BASIC GAMES", BY DAVE AHL. 107 REM **** MODIFICATIONS TO THE LATTER (PLUS DEBUGGING) BY BOB 108 REM *** LEEDOM - APRIL & DECEMBER 1974, 109 REM *** WITH A LITTLE HELP FROM HIS FRIENDS . . . 110 REM *** COMMENTS, EPITHETS, AND SUGGESTIONS SOLICITED -- 111 REM *** SEND TO: R. C. LEEDOM 112 REM *** WESTINGHOUSE DEFENSE & ELECTRONICS SYSTEMS CNTR. 113 REM *** BOX 746, M.S. 338 114 REM *** BALTIMORE, MD 21203 115 REM *** 116 REM *** CONVERTED TO MICROSOFT 8 K BASIC 3/16/78 BY JOHN GORDERS 117 REM *** LINE NUMBERS FROM VERSION STREK7 OF 1/12/75 PRESERVED AS 118 REM *** MUCH AS POSSIBLE WHILE USING MULTIPLE STATEMENTS PER LINE 119 REM *** SOME LINES ARE LONGER THAN 72 CHARACTERS; THIS WAS DONE 120 REM *** BY USING "?" INSTEAD OF "PRINT" WHEN ENTERING LINES 121 REM *** 130 REM [NEW COMMENTS] 131 REM CHANGES BY TERRY NEWTON (WTN) 132 REM AUG 2020 - MODS TO WORK WITH BBC BASIC - ADDED SPACES BETWEEN 133 REM KEYWORDS, FIXED CODE THAT JUMPED OUT OF FOR NEXT LOOPS, FIXED 134 REM NUMBER PRINTS, FIXED OUT OF RANGE ON GOTO, DID OTHER STUFF 135 REM OCT 2020 - CHANGED INPUT FORMAT - INPUT "COMMAND? "A$ ETC SO 136 REM THAT IT'LL LOOK THE SAME IN DIFFERENT BBC BASIC VERSIONS 137 REM REMOVED CONFUSING X,Y REFERENCES FROM COM CALCULATOR INPUTS 138 REM ADDED ERROR CHECKING TO DIR/DIST CALCULATOR (AVOID DIV BY 0) 139 REM NOW DISPLAYS BOTH GAME UNIT DISTANCE AND ACTUAL DISTANCE 140 REM CHANGED COM INPUT SO 0/ENTER SHOWS LIST OF COMPUTER COMMANDS 141 REM ADDED >LOCATION< INDICATOR TO CUMULATIVE RECORD 142 REM REFORMATTED A FEW LONG CODE LINES 143 REM FEB 2021 - ADDED COLOUR COMMANDS, FIXED #BASES (LINE 440), 144 REM ADDED SAE TO SAVE AND EXIT, PROMPTS TO RESTORE ON STARTUP 145 REM ADDED STO TO STOP, ADDED DIFFICULTY LEVEL, CHANGED PROMPTS 147 REM AND OTHER TEXT TWEAKS, FIXED # STARBASES (LINE 1150) 148 REM DEV PERIOD.. LOTS OF CHANGES AND SOME VERSIONS WERE BUGGY 199 REM LINE 200 IS NOW THE GOTO TARGET WHEN RERUNNING 200 SAVDIR$="":BBC=INKEY(-256) 201 REM BBC=BBCBASIC TYPE, 115=SDL 87=BBC4W 77=MATRIX BRANDY 202 REM MATRIX BRANDY FORMAT IS DIFFERENT SO USE DIFFERENT FILENAMES.. 203 IF BBC=77 THEN SFNAME$="SST3BRSAVE.DAT":PFNAME$="SST3BRPREF.DAT" 204 IF (BBC<>115 AND BBC<>87) OR SDIR=0 THEN 210 205 IF SDIR=1 THEN SAVDIR$=@usr$ 206 IF SDIR=2 THEN SAVDIR$=@dir$ 207 IF SDIR=3 THEN SAVDIR$=@tmp$ 209 REM LOAD PREFS, SET PREFS/VARS, SET ERROR TRAP.. 210 GOSUB 15000:GOSUB 14300:ON ERROR GOTO 14200 220 PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT 221 PRINT " ,------*------," 222 PRINT " ,------------- '--- ------'" 223 PRINT " '-------- --' / /" 224 PRINT " ,---' '-------/ /--," 225 PRINT " '----------------'":PRINT 226 PRINT " THE USS ENTERPRISE --- NCC-1701" 230 OFF:FOR I=1 TO 25:WAIT 15:PRINT:NEXT I:ON:REM SLOW SCROLL CURS.OFF 260 REM CLEAR 600 270 Z$=" " 330 DIM G(8,8),C(9,2),K(3,3),N(3),Z(8,8),D(8) 370 T=INT(RND(1)*20+20)*100:T0=T:T9=25+INT(RND(1)*10):D0=0:E=3000:E0=E 440 P=10:P0=P:S9=200:S=0:B9=0:K9=0:X$="":X0$=" IS " 470 DEF FND(D)=SQR((K(I,1)-S1)^2+(K(I,2)-S2)^2) 475 DEF FNR(R)=INT(RND(R)*7.98+1.01) 480 REM INITIALIZE ENTERPRISE'S POSITION 490 Q1=FNR(1):Q2=FNR(1):S1=FNR(1):S2=FNR(1) 530 FOR I=1 TO 9:C(I,1)=0:C(I,2)=0:NEXT I 540 C(3,1)=-1:C(2,1)=-1:C(4,1)=-1:C(4,2)=-1:C(5,2)=-1:C(6,2)=-1 600 C(1,2)=1:C(2,2)=1:C(6,1)=1:C(7,1)=1:C(8,1)=1:C(8,2)=1:C(9,2)=1 670 FOR I=1 TO 8:D(I)=0:NEXT I 710 A1$="NAVSRSLRSPHATORSHEDAMCOMXXXSAESTOSET" 810 REM SETUP WHAT EXISTS IN GALAXY . . . 815 REM K3= # KLINGONS B3= # STARBASES S3 = # STARS 820 FOR I=1 TO 8:FOR J=1 TO 8:K3=0:Z(I,J)=0:R1=RND(1) 850 IF R1>.98 THEN K3=3:K9=K9+3:GOTO 980 860 IF R1>.95 THEN K3=2:K9=K9+2:GOTO 980 870 IF R1>.80 THEN K3=1:K9=K9+1 980 B3=0:IF RND(1)>.96 THEN B3=1:B9=B9+1 1040 G(I,J)=K3*100+B3*10+FNR(1):NEXT J:NEXT I:IF K9>T9 THEN T9=K9+1 1100 IF B9<>0 THEN 1200 1150 IF G(Q1,Q2)<200 THEN G(Q1,Q2)=G(Q1,Q2)+100:K9=K9+1 1160 B9=1:G(Q1,Q2)=G(Q1,Q2)+10:Q1=FNR(1):Q2=FNR(1) 1200 K7=K9:IF B9<>1 THEN X$="S":X0$=" ARE " 1210 SF=0:GOSUB 11000:REM CHECK FOR SAVE FILE 1211 IF SF=0 THEN 1220:REM NO SAVE FILE, PROMPT FOR DIFFICULTY 1212 CLS:PRINT: REM SAVE FILE WAS LOADED, UPDATE ON CURRENT CONDITIONS 1213 COLOUR CYAN:PRINT "INTELLIGENCE REPORTS THE AVERAGE KLINGON ENERGY IS ";S9;" UNITS" 1214 IF R8>0 THEN PRINT "AND THEY HAVE A ";INT(R8*100);"% CHANCE OF FIRING ON YOU FIRST" 1215 PRINT "YOU HAVE ";INT((T0+T9)-T);" DAYS LEFT TO COMPLETE YOUR MISSION." 1216 IF K3>0 THEN PRINT:COLOUR RED+BOLD:PRINT "COMBAT AREA CONDITION RED" 1217 IF S<=200 THEN COLOUR YELLOW+BOLD:PRINT " SHIELDS DANGEROUSLY LOW" 1218 Z8=0:GOTO 1980:REM SKIP TO SRS AND COMMAND, Z8 IS FLAG FOR SHOOT 1ST 1220 Z8=0::R8=0:REM E=ENERGY S9=KLINGON STRENGTH, R8=CHANCE THEY SHOOT 1ST 1221 INPUT "DIFFICULTY LEVEL (0-3): "A$:L=INT(VAL(A$)):CLS:PRINT 1222 IF L=1 THEN E=3000:S9=250:R8=0.25 1223 IF L=2 THEN E=4000:S9=300:R8=0.5 1224 IF L=3 THEN E=5000:S9=350:R8=1 1225 IF L>0 THEN E0=E:S9=INT(S9+S9*0.2*(RND(1)-0.5)):R8=R8+R8*(RND(1)-0.5) 1226 IF R8>1 THEN R8=1 1230 COLOUR WHITE:PRINT "YOUR ORDERS ARE AS FOLLOWS:":PRINT 1240 PRINT " DESTROY THE ";K9;" KLINGON WARSHIPS WHICH HAVE INVADED THE" 1252 PRINT " GALAXY BEFORE THEY CAN ATTACK FEDERATION HEADQUARTERS" 1260 PRINT " ON STARDATE ";T0+T9;", THIS GIVES YOU ";T9;" DAYS. THERE";X0$ 1272 PRINT " ";B9;" STARBASE";X$;" IN THE GALAXY FOR RESUPPLYING YOUR SHIP." 1273 PRINT " THE KLINGONS HAVE AN AVERAGE STRENGTH OF ";S9;" UNITS"; 1274 IF R8=0 THEN PRINT ".":GOTO 1300 ELSE PRINT 1275 IF R8<1 THEN PRINT " AND HAVE AN ESTIMATED ";INT(R8*100);"% CHANCE OF FIRING FIRST." 1276 IF R8=1 THEN PRINT " AND ALWAYS SHOOT FIRST." 1280 REM PRINT:PRINT"HIT ANY KEY EXCEPT RETURN WHEN READY TO ACCEPT COMMAND" 1300 I=RND(1):REM IF INP(1)=13 THEN 1300 1310 REM HERE ANY TIME NEW QUADRANT ENTERED 1320 Z4=Q1:Z5=Q2:K3=0:B3=0:S3=0:G5=0:D4=.5*RND(1):Z(Q1,Q2)=G(Q1,Q2) 1390 IF Q1<1 OR Q1>8 OR Q2<1 OR Q2>8 THEN 1600 1430 GOSUB 9030:PRINT:IF T0<>T THEN 1490 1460 PRINT "YOUR MISSION BEGINS WITH YOUR STARSHIP LOCATED" 1470 PRINT "IN THE GALACTIC QUADRANT, '";G2$;"'.":GOTO 1500 1490 COLOUR WHITE:PRINT "NOW ENTERING ";G2$;" QUADRANT . . ." 1500 PRINT:K3=INT(G(Q1,Q2)*.01):B3=INT(G(Q1,Q2)*.1)-10*K3 1540 S3=G(Q1,Q2)-100*K3-10*B3:IF K3=0 THEN 1590 1560 COLOUR RED+BOLD:PRINT "COMBAT AREA CONDITION RED":IF S>200 THEN 1590 1580 COLOUR YELLOW+BOLD:PRINT " SHIELDS DANGEROUSLY LOW" 1590 FOR I=1 TO 3:K(I,1)=0:K(I,2)=0:NEXT I 1600 FOR I=1 TO 3:K(I,3)=0:NEXT I:Q$=Z$+Z$+Z$+Z$+Z$+Z$+Z$+LEFT$(Z$,17) 1660 REM POSITION ENTERPRISE IN QUADRANT, THEN PLACE "K3" KLINGONS, & 1670 REM "B3" STARBASES, & "S3" STARS ELSEWHERE. 1680 A$="<*>":Z1=S1:Z2=S2:GOSUB 8670:IF K3<1 THEN 1820 1720 FOR I=1 TO K3:GOSUB 8590:A$="+K+":Z1=R1:Z2=R2 1780 GOSUB 8670:K(I,1)=R1:K(I,2)=R2:K(I,3)=S9*(0.5+RND(1)):NEXT I 1820 IF B3<1 THEN 1910 1880 GOSUB 8590:A$=">!<":Z1=R1:B4=R1:Z2=R2:B5=R2:GOSUB 8670 1910 FOR I=1 TO S3:GOSUB 8590:A$=" * ":Z1=R1:Z2=R2:GOSUB 8670:NEXT I 1920 Z8=0:IF T>T0 THEN Z8=1 1980 GOSUB 6430 1985 REM DETERMINE IF KLINGONS SHOOT FIRST 1986 IF Z8 THEN IF RND(1)10 THEN IF E>10 OR D(7)=0 THEN 2060 2020 COLOUR CYAN+BOLD:PRINT:PRINT "** FATAL ERROR ** YOU'VE JUST STRANDED YOUR SHIP IN " 2030 PRINT "SPACE":PRINT "YOU HAVE INSUFFICIENT MANEUVERING ENERGY,"; 2040 PRINT " AND SHIELD CONTROL":PRINT "IS PRESENTLY INCAPABLE OF CROSS"; 2050 PRINT "-CIRCUITING TO ENGINE ROOM!!":GOTO 6220 2060 COLOUR WHITE+BOLD:INPUT "COMMAND: "A$:GOSUB 9900:REM TO UPPERCASE 2075 REM CAN'T JUMP OUT OF A FOR NEXT LOOP, REWRITING 2080 I=1:REM FORI=1TO8 2090 IF LEFT$(A$,3)<>MID$(A1$,3*I-2,3) THEN 2160 2140 ON I GOTO 2300,1980,4000,4260,4700,5530,5690,7290,6270,10000,2280,2285 2160 I=I+1:IF I<=12 THEN 2090:REM NEXTI 2170 COLOUR CYAN+BOLD:PRINT "ENTER ONE OF THE FOLLOWING:" 2180 PRINT " NAV (TO SET COURSE)" 2190 PRINT " SRS (FOR SHORT RANGE SENSOR SCAN)" 2200 PRINT " LRS (FOR LONG RANGE SENSOR SCAN)" 2210 PRINT " PHA (TO FIRE PHASERS)" 2220 PRINT " TOR (TO FIRE PHOTON TORPEDOES)" 2230 PRINT " SHE (TO RAISE OR LOWER SHIELDS)" 2240 PRINT " DAM (FOR DAMAGE CONTROL REPORTS)" 2250 PRINT " COM (TO CALL ON LIBRARY-COMPUTER)" 2260 PRINT " XXX (TO RESIGN YOUR COMMAND)" 2265 PRINT " SAE (TO SAVE AND EXIT)" 2266 PRINT " STO (TO STOP THE PROGRAM)" 2267 PRINT " SET (TO SET PREFERENCES)" 2270 GOTO 1990 2280 PRINT:PRINT "GOTO 1980 TO RESUME PROGRAM":END 2285 GOSUB 16000:PRINT 2286 IF K3>0 THEN PRINT:COLOUR RED+BOLD:PRINT "COMBAT AREA CONDITION RED" 2287 IF S<=200 THEN COLOUR YELLOW+BOLD:PRINT " SHIELDS DANGEROUSLY LOW" 2288 GOTO 1980 2290 REM COURSE CONTROL BEGINS HERE 2300 COLOUR WHITE+BOLD:INPUT "COURSE (1-9): "C1:IF C1=9 THEN C1=1 2310 IF C1>=1 AND C1<9 THEN 2350 2330 COLOUR CYAN:PRINT " LT. SULU REPORTS, 'INCORRECT COURSE DATA, SIR!'" 2331 REM ADDED INSTRUCTIONS 2332 PRINT " FROM THE MANUAL..." 2333 PRINT 2334 PRINT " COURSE IS IN A CIRCULAR NUMERICAL 4 3 2" 2335 PRINT " VECTOR ARRANGEMENT AS SHOWN . . ." 2336 PRINT " INTEGER AND REAL VALUES MAY BE ..." 2337 PRINT " USED. (THUS COURSE 1.5 IS HALF- 5 ---*--- 1" 2338 PRINT " WAY BETWEEN 1 AND 2 ..." 2339 PRINT " . . ." 2340 PRINT " VALUES MAY APPROACH 9.0, WHICH 6 7 8" 2341 PRINT " ITSELF IS EQUIVALENT TO 1.0" 2342 PRINT " COURSE" 2343 PRINT " ONE WARP FACTOR IS THE SIZE OF " 2344 PRINT " ONE QUADTANT. THEREFORE, TO GET" 2345 PRINT " FROM QUADRANT 6,5 TO 5,5, YOU WOULD" 2346 PRINT " USE COURSE 3, WARP FACTOR 1." 2347 PRINT 2349 GOTO 1990 2350 X$="8":IF D(1)<0 THEN X$="0.2" 2360 COLOUR WHITE+BOLD:PRINT "WARP FACTOR (0-";X$;")";:INPUT ": "W1 2370 IF D(1)<0 AND W1>.2 THEN 2470 2380 IF W1>0 AND W1<=8 THEN 2490 2390 IF W1=0 THEN 1990 2420 COLOUR CYAN:PRINT " CHIEF ENGINEER SCOTT REPORTS 'THE ENGINES WON'T TAKE"; 2430 PRINT " WARP ";W1;"!'":GOTO 1990 2470 PRINT "WARP ENGINES ARE DAMAGED. MAXIMUM SPEED = WARP 0.2":GOTO 1990 2490 N=INT(W1*8+.5):IF E-N>=0 THEN 2590 2500 COLOUR CYAN:PRINT "ENGINEERING REPORTS 'INSUFFICIENT ENERGY AVAILABLE" 2510 PRINT " FOR MANEUVERING AT WARP";W1;"!'" 2530 IF S=1 THEN D6=1 2770 FOR I=1 TO 8:IF D(I)>=0 THEN 2880 2790 D(I)=D(I)+D6:IF D(I)>-.1 AND D(I)<0 THEN D(I)=-.1:GOTO 2880 2800 IF D(I)<0 THEN 2880 2810 IF D1<>1 THEN D1=1:COLOUR CYAN:PRINT "DAMAGE CONTROL REPORT: "; 2840 R1=I:GOSUB 8790:COLOUR GREEN:PRINT G2$;" REPAIR COMPLETED." 2880 NEXT I:IF RND(1)>.2 THEN 3070 2910 R1=FNR(1):IF RND(1)>=.6 THEN 3000 2930 D(R1)=D(R1)-(RND(1)*5+1):COLOUR CYAN:PRINT "DAMAGE CONTROL REPORT: "; 2960 GOSUB 8790:COLOUR MAGENTA+BOLD:PRINT G2$;" DAMAGED":PRINT:GOTO 3070 3000 D(R1)=D(R1)+RND(1)*3+1:COLOUR CYAN:PRINT "DAMAGE CONTROL REPORT: "; 3030 GOSUB 8790:COLOUR GREEN:PRINT G2$;" STATE OF REPAIR IMPROVED":PRINT 3060 REM BEGIN MOVING STARSHIP 3070 A$=" ":Z1=INT(S1):Z2=INT(S2):GOSUB 8670 3110 X1=C(C1,1)+(C(C1+1,1)-C(C1,1))*(C1-INT(C1)):X=S1:Y=S2 3140 X2=C(C1,2)+(C(C1+1,2)-C(C1,2))*(C1-INT(C1)):Q4=Q1:Q5=Q2 3165 REM CAN'T JUMP OUT OF FOR LOOP 3170 I=1:REM FOR I=1 TO N 3180 S1=S1+X1:S2=S2+X2:IF S1<1 OR S1>=9 OR S2<1 OR S2>=9 THEN 3500 3240 S8=INT(S1)*24+INT(S2)*3-26:IF MID$(Q$,S8,2)=" " THEN 3360 3320 S1=INT(S1-X1):S2=INT(S2-X2):COLOUR CYAN+BOLD:PRINT "WARP ENGINES SHUT DOWN AT "; 3350 PRINT "SECTOR ";S1;",";S2;" DUE TO BAD NAVAGATION":GOTO 3370 3360 I=I+1:IF I<=N THEN 3180:REM NEXT I 3365 S1=INT(S1):S2=INT(S2) 3370 A$="<*>":Z1=INT(S1):Z2=INT(S2):GOSUB 8670:GOSUB 3910:T8=1 3430 IF W1<1 THEN T8=.1*INT(10*W1) 3450 T=T+T8:IF T>T0+T9 THEN 6220 3470 REM SEE IF DOCKED, THEN GET COMMAND 3480 GOTO 1980 3490 REM EXCEEDED QUADRANT LIMITS 3500 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) 3550 S2=INT(Y-Q2*8):IF S1=0 THEN Q1=Q1-1:S1=8 3590 IF S2=0 THEN Q2=Q2-1:S2=8 3620 X5=0:IF Q1<1 THEN X5=1:Q1=1:S1=1 3670 IF Q1>8 THEN X5=1:Q1=8:S1=8 3710 IF Q2<1 THEN X5=1:Q2=1:S2=1 3750 IF Q2>8 THEN X5=1:Q2=8:S2=8 3790 IF X5=0 THEN 3860 3800 COLOUR CYAN:PRINT "LT. UHURA REPORTS MESSAGE FROM STARFLEET COMMAND:" 3810 PRINT " 'PERMISSION TO ATTEMPT CROSSING OF GALACTIC PERIMETER" 3820 PRINT " IS HEREBY *DENIED*. SHUT DOWN YOUR ENGINES.'" 3830 PRINT "CHIEF ENGINEER SCOTT REPORTS 'WARP ENGINES SHUT DOWN" 3840 PRINT " AT SECTOR ";S1;",";S2;" OF QUADRANT ";Q1;",";Q2;".'" 3850 IF T>T0+T9 THEN 6220 3860 IF 8*Q1+Q2=8*Q4+Q5 THEN 3370 3870 T=T+1:GOSUB 3910:GOTO 1320 3900 REM MANEUVER ENERGY S/R ** 3910 E=E-N-10:IF E>=0 THEN RETURN 3930 COLOUR CYAN:PRINT "SHIELD CONTROL SUPPLIES ENERGY TO COMPLETE THE MANEUVER." 3940 S=S+E:E=0:IF S<=0 THEN S=0 3980 RETURN 3990 REM LONG RANGE SENSOR SCAN CODE 4000 IF D(3)<0 THEN COLOUR MAGENTA:PRINT "LONG RANGE SENSORS ARE INOPERABLE":GOTO 1990 4030 COLOUR GREEN:PRINT "LONG RANGE SCAN FOR QUADRANT ";Q1;",";Q2 4040 O1$="-------------------":COLOUR WHITE:PRINT O1$ 4060 FOR I=Q1-1 TO Q1+1:N(1)=-1:N(2)=-2:N(3)=-3:FOR J=Q2-1 TO Q2+1 4120 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) 4180 NEXT J:FOR L=1 TO 3:COLOUR WHITE:PRINT ": ";:COLOUR CYAN+BOLD 4185 IF N(L)<0 THEN PRINT "*** ";:GOTO 4230 4210 PRINT RIGHT$(STR$(N(L)+1000),3);" "; 4230 NEXT L:COLOUR WHITE:PRINT ":":PRINT O1$:NEXT I:GOTO 1990 4250 REM PHASER CONTROL CODE BEGINS HERE 4260 IF D(4)<0 THEN COLOUR CYAN:PRINT "PHASERS INOPERATIVE":GOTO 1990 4265 IF K3>0 THEN 4330 4270 COLOUR CYAN:PRINT "SCIENCE OFFICER SPOCK REPORTS 'SENSORS SHOW NO ENEMY SHIPS" 4280 PRINT " IN THIS QUADRANT'":GOTO 1990 4330 IF D(8)<0 THEN COLOUR MAGENTA+BOLD:PRINT"COMPUTER FAILURE HAMPERS ACCURACY" 4350 COLOUR CYAN+BOLD:PRINT "PHASERS LOCKED ON TARGET; "; 4360 PRINT "ENERGY AVAILABLE = ";E;" UNITS" 4370 COLOUR WHITE+BOLD:INPUT "NUMBER OF UNITS TO FIRE: "X:IF X<=0 THEN 1990 4400 IF E-X<0 THEN 4360 4410 E=E-X:IF D(7)<0 THEN X=X*RND(1) 4450 H1=INT(X/K3):REM FORI=1TO3 CAN'T JUMP OUT OF FOR NEXT 4460 I=1 4470 IF K(I,3)<=0 THEN 4670 4480 H=INT((H1/FND(0))*(RND(1)+2)):IF H>.15*K(I,3) THEN 4530 4500 COLOUR CYAN+BOLD:PRINT "SENSORS SHOW NO DAMAGE TO ENEMY AT ";K(I,1);",";K(I,2):GOTO 4670 4530 K(I,3)=K(I,3)-H 4540 COLOUR CYAN+BOLD:PRINT H;" UNIT HIT ON KLINGON AT SECTOR ";K(I,1);",";K(I,2) 4550 IF K(I,3)<=0 THEN COLOUR GREEN+BOLD:PRINT "*** KLINGON DESTROYED ***":GOTO 4580 4560 COLOUR MAGENTA+BOLD:PRINT " (SENSORS SHOW ";INT(K(I,3));" UNITS REMAINING)":GOTO 4670 4580 K3=K3-1:K9=K9-1:Z1=K(I,1):Z2=K(I,2):A$=" ":GOSUB 8670 4650 K(I,3)=0:G(Q1,Q2)=G(Q1,Q2)-100:Z(Q1,Q2)=G(Q1,Q2):IF K9<=0 THEN 6370 4670 I=I+1:IF I<=3 THEN 4470:REM NEXTI 4680 GOSUB 6000:GOTO 1990 4690 REM PHOTON TORPEDO CODE BEGINS HERE 4700 COLOUR CYAN+BOLD:IF P<=0 THEN PRINT "ALL PHOTON TORPEDOES EXPENDED":GOTO 1990 4730 IF D(5)<0 THEN PRINT "PHOTON TUBES ARE NOT OPERATIONAL":GOTO 1990 4760 COLOUR WHITE+BOLD:INPUT "PHOTON TORPEDO COURSE (1-9): "C1:IF C1=9 THEN C1=1 4780 IF C1>=1 AND C1<9 THEN 4850 4790 COLOUR CYAN:PRINT "ENSIGN CHEKOV REPORTS, 'INCORRECT COURSE DATA, SIR!'" 4800 GOTO 1990 4850 X1=C(C1,1)+(C(C1+1,1)-C(C1,1))*(C1-INT(C1)):E=E-2:P=P-1 4860 X2=C(C1,2)+(C(C1+1,2)-C(C1,2))*(C1-INT(C1)):X=S1:Y=S2 4910 COLOUR CYAN+BOLD:PRINT "TORPEDO TRACK:":COLOUR CYAN 4920 X=X+X1:Y=Y+X2:X3=INT(X+.5):Y3=INT(Y+.5) 4960 IF X3<1 OR X3>8 OR Y3<1 OR Y3>8 THEN 5490 5000 PRINT " ";X3;",";Y3:A$=" ":Z1=X:Z2=Y:GOSUB 8830 5050 IF Z3<>0 THEN 4920 5060 A$="+K+":Z1=X:Z2=Y:GOSUB 8830:IF Z3=0 THEN 5210 5110 COLOUR GREEN+BOLD:PRINT "*** KLINGON DESTROYED ***":K3=K3-1:K9=K9-1:IF K9<=0 THEN 6370 5150 REM CAN'T JUMP FROM FOR I=1 TO 3 5160 I=1 5170 IF X3=K(I,1) AND Y3=K(I,2) THEN 5190 5180 REM NEXT I:I=3 5181 I=I+1:IF I<=3 THEN 5170 5182 I=3 5190 K(I,3)=0:GOTO 5430 5210 A$=" * ":Z1=X:Z2=Y:GOSUB 8830:IF Z3=0 THEN 5280 5260 COLOUR MAGENTA+BOLD:PRINT "STAR AT ";X3;",";Y3;" ABSORBED TORPEDO ENERGY." 5270 GOSUB 6000:GOTO 1990 5280 A$=">!<":Z1=X:Z2=Y:GOSUB 8830:IF Z3=0 THEN 4760 5330 COLOUR RED+BOLD:PRINT "*** STARBASE DESTROYED ***":B3=B3-1:B9=B9-1 5360 IF B9>0 OR K9>T-T0-T9 THEN 5400 5370 COLOUR WHITE:PRINT "THAT DOES IT, CAPTAIN!! YOU ARE HEREBY RELIEVED OF COMMAND" 5380 PRINT "AND SENTENCED TO 99 STARDATES AT HARD LABOR ON CYGNUS 12!!" 5390 GOTO 6270 5400 PRINT "STARFLEET COMMAND REVIEWING YOUR RECORD TO CONSIDER" 5410 PRINT "COURT MARTIAL!":D0=0 5430 Z1=X:Z2=Y:A$=" ":GOSUB 8670 5470 G(Q1,Q2)=K3*100+B3*10+S3:Z(Q1,Q2)=G(Q1,Q2):GOSUB 6000:GOTO 1990 5490 COLOUR CYAN:PRINT "TORPEDO MISSED":GOSUB 6000:GOTO 1990 5520 REM SHIELD CONTROL 5530 IF D(7)<0 THEN COLOUR CYAN+BOLD:PRINT "SHIELD CONTROL INOPERABLE":GOTO 1990 5560 COLOUR CYAN+BOLD:PRINT "ENERGY AVAILABLE = ";E+S; 5565 COLOUR WHITE+BOLD:INPUT " NUMBER OF UNITS TO SHIELDS: "X 5580 COLOUR CYAN+BOLD:IF X<0 OR S=X THEN PRINT "":GOTO 1990 5590 IF X<=E+S THEN 5630 5600 PRINT "SHIELD CONTROL REPORTS 'THIS IS NOT THE FEDERATION TREASURY.'" 5610 PRINT "":GOTO 1990 5630 E=E+S-X:S=X:PRINT "DEFLECTOR CONTROL ROOM REPORT:" 5660 PRINT " 'SHIELDS NOW AT ";INT(S);" UNITS PER YOUR COMMAND.'":GOTO 1990 5680 REM DAMAGE CONTROL 5690 IF D(6)>=0 THEN 5910 5700 COLOUR MAGENTA+BOLD:PRINT "DAMAGE CONTROL REPORT NOT AVAILABLE":IF D0=0 THEN 1990 5720 D3=0:FOR I=1 TO 8:IF D(I)<0 THEN D3=D3+.1 5760 NEXT I:IF D3=0 THEN 1990 5780 PRINT:D3=D3+D4:IF D3>=1 THEN D3=.9 5810 COLOUR CYAN+BOLD:PRINT "TECHNICIANS STANDING BY TO EFFECT REPAIRS TO YOUR SHIP;" 5820 PRINT "ESTIMATED TIME TO REPAIR: ";.01*INT(100*D3);" STARDATES" 5840 COLOUR WHITE+BOLD:INPUT "WILL YOU AUTHORIZE THE REPAIR ORDER? (Y/N) "A$:GOSUB 9900 5860 IF A$<>"Y" THEN 1990 5870 FOR I=1 TO 8:IF D(I)<0 THEN D(I)=0 5890 NEXT I:T=T+D3+.1 5910 COLOUR WHITE:PRINT:PRINT "DEVICE STATE OF REPAIR" 5915 FOR R1=1 TO 8 5920 GOSUB 8790:COLOUR CYAN:PRINT G2$;LEFT$(Z$,25-LEN(G2$)); 5930 ZZ=INT(D(R1)*100)*.01:ZZC=GREEN:IF ZZ<0 THEN ZZC=RED 5940 COLOUR ZZC:PRINT ZZ 5950 NEXT R1:PRINT:IF D0<>0 THEN 5720 5980 GOTO 1990 5990 REM KLINGONS SHOOTING 6000 IF K3<=0 THEN RETURN 6010 IF D0<>0 THEN COLOUR GREEN+BOLD:PRINT "STARBASE SHIELDS PROTECT THE ENTERPRISE":RETURN 6040 FOR I=1 TO 3:IF K(I,3)<=0 THEN 6200 6060 H=INT((K(I,3)/FND(1))*(2+RND(1))):S=S-H:K(I,3)=K(I,3)/(3+RND(0)) 6080 COLOUR RED+BOLD:PRINT H;" UNIT HIT ON ENTERPRISE FROM SECTOR ";K(I,1);",";K(I,2) 6090 IF S<=0 THEN 6240 6100 COLOUR CYAN+BOLD:PRINT " ":IF H<20 THEN 6200 6120 IF RND(1)>.6 OR H/S<=.02 THEN 6200 6140 R1=FNR(1):D(R1)=D(R1)-H/S-.5*RND(1):GOSUB 8790 6170 COLOUR MAGENTA+BOLD:PRINT "DAMAGE CONTROL REPORTS ";G2$;" DAMAGED BY THE HIT" 6200 NEXT I:RETURN 6210 REM END OF GAME 6220 COLOUR WHITE:PRINT "IT IS STARDATE ";T:GOTO 6270 6240 COLOUR MAGENTA:PRINT "THE ENTERPRISE HAS BEEN DESTROYED. THEN FEDERATION "; 6250 PRINT "WILL BE CONQUERED":GOTO 6220 6270 PRINT "THERE WERE ";K9;" KLINGON BATTLE CRUISERS LEFT AT" 6280 PRINT "THE END OF YOUR MISSION." 6290 PRINT:PRINT:IF B9=0 THEN 6360 6310 PRINT "THE FEDERATION IS IN NEED OF A NEW STARSHIP COMMANDER" 6320 PRINT "FOR A SIMILAR MISSION -- IF THERE IS A VOLUNTEER," 6330 INPUT "LET HIM STEP FORWARD AND ENTER 'AYE' ";A$ 6340 GOSUB 9900:IF A$="AYE" THEN 12000:REM REMOVE SAVE FILE AND RERUN 6360 PRINT "OK, GOODBYE...":WAIT 100:GOTO 13000:REM REMOVE SAVE FILE AND EXIT 6370 PRINT "CONGRULATION, CAPTAIN! THEN LAST KLINGON BATTLE CRUISER" 6380 PRINT "MENACING THE FEDERATION HAS BEEN DESTROYED.":PRINT 6400 PRINT "YOUR EFFICIENCY RATING IS ";1000*(K7/(T-T0))^2:GOTO 6290 6420 REM SHORT RANGE SENSOR SCAN & STARTUP SUBROUTINE 6430 REM CAN'T JUMP OUT OF FOR NEXT FORI=S1-1TOS1+1:FORJ=S2-1TOS2+1 6431 I=S1-1 6432 J=S2-1 6450 IF INT(I+.5)<1 OR INT(I+.5)>8 OR INT(J+.5)<1 OR INT(J+.5)>8 THEN 6540 6490 A$=">!<":Z1=I:Z2=J:GOSUB 8830:IF Z3=1 THEN 6580 6540 REM NEXTJ:NEXTI 6541 J=J+1:IF J<=S2+1 THEN 6450 6542 I=I+1:IF I<=S1+1 THEN 6432 6550 D0=0:GOTO 6650 6580 D0=1:C$="DOCKED":E=E0:P=P0:CCC=GREEN+BOLD 6620 COLOUR CYAN+BOLD:PRINT "SHIELDS DROPPED FOR DOCKING PURPOSES":S=0:GOTO 6670 6650 IF K3>0 THEN C$="*RED*":CCC=RED+BOLD:GOTO 6670 6660 C$="GREEN":CCC=GREEN+BOLD:IF E((T0+T9)-7) THEN SDC=MAGENTA 6700 PTC=CYAN:IF P<4 THEN PTC=MAGENTA 6720 IF D(2)>=0 THEN 6770 6730 COLOUR CYAN+BOLD:PRINT:PRINT "*** SHORT RANGE SENSORS ARE OUT ***":PRINT:RETURN 6760 REM MODIFIED TO ALLOW DIVISIONS AND DIFFERENT SYMBOLS 6770 O1$="---------------------------------" 6771 IF DISPLOOK=3 THEN O1$="---- --- --- --- --- --- --- ----" 6772 IF DISPLOOK=4 THEN O1$="--=---=---=---=---=---=---=---=--" 6773 IF A9$="_" THEN O1$=" ___ ___ ___ ___ ___ ___ ___ ___" 6780 COLOUR WHITE:PRINT O1$:IF A9$="_" THEN O1$="" 6790 FOR I=1 TO 8 6820 FOR J=(I-1)*24+1 TO (I-1)*24+22 STEP 3:COLOUR WHITE:PRINT A8$;:A7$=MID$(Q$,J,3) 6821 IF A7$=" * " THEN A7$=E6$:COLOUR GREEN 6822 IF A7$="+K+" THEN A7$=E7$:COLOUR RED+BOLD 6823 IF A7$="<*>" THEN A7$=E8$:COLOUR CYAN+BOLD 6824 IF A7$=">!<" THEN A7$=E9$:COLOUR MAGENTA+BOLD 6825 IF A7$=" " THEN A7$=E5$:COLOUR WHITE 6826 IF I=8 THEN IF A9$<>"_" THEN 6829 6827 FOR A6=1 TO 3:IF MID$(A7$,A6,1)=" " THEN MID$(A7$,A6,1)=A9$ 6828 NEXT A6 6829 PRINT A7$;:NEXT J:COLOUR WHITE:PRINT A8$; 6830 ON I GOTO 6850,6900,6960,7020,7070,7120,7180,7240 6850 PRINT " STARDATE ";:COLOUR SDC:PRINT "";INT(T*10)*.1:GOTO 7260 6900 PRINT " CONDITION ";:COLOUR CCC:PRINT C$:GOTO 7260 6960 PRINT " QUADRANT ";:COLOUR GREEN:PRINT "";Q1;",";Q2:GOTO 7260 7020 PRINT " SECTOR ";:COLOUR GREEN:PRINT "";S1;",";S2:GOTO 7260 7070 PRINT " PHOTON TORPEDOES ";:COLOUR PTC:PRINT "";INT(P):GOTO 7260 7120 PRINT " TOTAL ENERGY ";:COLOUR EC:PRINT "";INT(E+S):GOTO 7260 7180 PRINT " SHIELDS ";:COLOUR SC:PRINT "";INT(S):GOTO 7260 7240 PRINT " KLINGONS REMAINING ";:COLOUR YELLOW+BOLD:PRINT "";INT(K9) 7260 NEXT I:COLOR WHITE:PRINT O1$:RETURN 7280 REM LIBRARY COMPUTER CODE 7290 IF D(8)<0 THEN COLOUR CYAN+BOLD:PRINT "COMPUTER DISABLED":GOTO 1990 7320 COLOUR WHITE+BOLD:INPUT "COMPUTER ACTIVE AND AWAITING COMMAND (1-6): "A:A=INT(A) 7330 IF A<0 OR A>6 THEN 1990 7350 H8=1:IF A<1 THEN 7360:REM 0 OR ENTER FOR LIST 7352 ON A GOTO 7900,8070,8500,8150,7400,7540 7360 COLOUR CYAN+BOLD:PRINT "FUNCTIONS AVAILABLE FROM LIBRARY-COMPUTER:" 7372 PRINT " 1 = STATUS REPORT" 7374 PRINT " 2 = PHOTON TORPEDO DATA" 7376 PRINT " 3 = STARBASE NAV DATA" 7378 PRINT " 4 = DIRECTION/DISTANCE CALCULATOR" 7380 PRINT " 5 = GALAXY 'REGION NAME' MAP" 7382 PRINT " 6 = CUMULATIVE GALACTIC RECORD" 7384 GOTO 7320 7390 REM SETUP TO CHANGE CUM GAL RECORD TO GALAXY MAP 7400 H8=0:G5=1:COLOUR GREEN+BOLD 7405 PRINT:PRINT " THE GALAXY":GOTO 7550 7530 REM CUM GALACTIC RECORD 7540 REM INPUT"DO YOU WANT A HARDCOPY? IS THE TTY ON (Y/N)";A$ 7542 REM IFA$="Y"THENPOKE1229,2:POKE1237,3:NULL1 7543 PRINT:PRINT " "; 7544 COLOUR GREEN+BOLD:PRINT "COMPUTER RECORD OF GALAXY FOR QUADRANT ";Q1;",";Q2 7546 PRINT 7550 PRINT " 1 2 3 4 5 6 7 8" 7560 O1$=" ----- ----- ----- ----- ----- ----- ----- -----" 7570 PRINT O1$:FOR I=1 TO 8:PRINT " ";I;" ";:IF H8=0 THEN 7740 7610 FOR J=1 TO 8:PRINT " "; 7620 IF I=Q1 AND J=Q2 THEN PRINT ">"; ELSE PRINT " "; 7630 IF Z(I,J)=0 THEN PRINT "***";:GOTO 7710 7700 PRINT RIGHT$(STR$(Z(I,J)+1000),3); 7710 IF I=Q1 AND J=Q2 THEN PRINT "<"; ELSE PRINT " "; 7720 NEXT J:GOTO 7850 7740 Z4=I:Z5=1:GOSUB 9030:J0=INT(15-.5*LEN(G2$)):PRINT TAB(J0);G2$; 7800 Z5=5:GOSUB 9030:J0=INT(39-.5*LEN(G2$)):PRINT TAB(J0);G2$; 7850 PRINT:PRINT O1$:NEXT I:PRINT:GOTO 1990 7890 REM STATUS REPORT 7900 COLOUR CYAN+BOLD:PRINT " STATUS REPORT:":X$="":IF K9>1 THEN X$="S" 7940 PRINT "KLINGON";X$;" LEFT: ";K9 7960 PRINT "MISSION MUST BE COMPLETED IN ";.1*INT((T0+T9-T)*10);" STARDATES" 7970 X$="S":IF B9<2 THEN X$="":IF B9<1 THEN 8010 7980 PRINT "THE FEDERATION IS MAINTAINING ";B9;" STARBASE";X$;" IN THE GALAXY" 7990 GOTO 5690 8010 COLOUR WHITE:PRINT "YOUR STUPIDITY HAS LEFT YOU ON YOUR OWN IN" 8020 PRINT " THE GALAXY -- YOU HAVE NO STARBASES LEFT!":GOTO 5690 8060 REM TORPEDO, BASE NAV, D/D CALCULATOR 8070 IF K3<=0 THEN 4270 8080 X$="":IF K3>1 THEN X$="S" 8090 COLOUR CYAN+BOLD:PRINT "FROM ENTERPRISE TO KLINGON BATTLE CRUSER";X$ 8100 H8=0:REM CAN'T JUMP FROM FOR NEXT FOR I=1 TO 3 8101 I=1 8105 IF K(I,3)<=0 THEN 8480 8110 W1=K(I,1):X=K(I,2) 8120 C1=S1:A=S2:GOTO 8220 8150 COLOUR WHITE+BOLD:PRINT "DIRECTION/DISTANCE CALCULATOR:" 8160 PRINT "YOU ARE AT QUADRANT ";Q1;",";Q2;" SECTOR ";S1;",";S2 8170 PRINT "PLEASE ENTER" 8180 INPUT " INITIAL COORDINATES: "C1,A:C1=INT(C1):A=INT(A) 8200 INPUT " FINAL COORDINATES: "W1,X:W1=INT(W1):X=INT(X) 8220 IF C1<1 OR C1>8 OR A<1 OR A>8 OR W1<1 OR W1>8 OR X<1 OR X>8 THEN 8230 8221 X=X-A:A=C1-W1:IF X<>0 OR A<>0 THEN 8240 8230 COLOUR CYAN+BOLD:PRINT "INVALID ENTRY":GOTO 1990 8240 IF X<0 THEN 8350 8250 IF A<0 THEN 8410 8260 IF X>0 THEN 8280 8270 IF A=0 THEN C1=5:GOTO 8290 8280 C1=1 8290 IF ABS(A)<=ABS(X) THEN 8330 8310 COLOUR CYAN+BOLD:PRINT "DIRECTION = ";C1+(((ABS(A)-ABS(X))+ABS(A))/ABS(A)):GOTO 8460 8330 COLOUR CYAN+BOLD:PRINT "DIRECTION = ";C1+(ABS(A)/ABS(X)):GOTO 8460 8350 IF A>0 THEN C1=3:GOTO 8420 8360 IF X<>0 THEN C1=5:GOTO 8290 8410 C1=7 8420 IF ABS(A)>=ABS(X) THEN 8450 8430 COLOUR CYAN+BOLD:PRINT "DIRECTION = ";C1+(((ABS(X)-ABS(A))+ABS(X))/ABS(X)):GOTO 8460 8450 COLOUR CYAN+BOLD:PRINT "DIRECTION = ";C1+(ABS(X)/ABS(A)) 8460 PRINT "DISTANCE = "; 8462 IF ABS(X)>ABS(A) THEN PRINT "";ABS(X); ELSE PRINT "";ABS(A); 8470 PRINT " UNITS (ACTUAL = ";SQR(X^2+A^2);")":IF H8=1 THEN 1990 8480 I=I+1:IF I<=3 THEN 8105:REM NEXTI 8490 GOTO 1990 8500 IF B3<>0 THEN COLOUR CYAN+BOLD:PRINT "FROM ENTERPRISE TO STARBASE: ":W1=B4:X=B5:GOTO 8120 8510 COLOUR CYAN:PRINT "MR. SPOCK REPORTS, 'SENSORS SHOW NO STARBASES IN THIS"; 8520 PRINT " QUADRANT.'":GOTO 1990 8580 REM FIND EMPTY PLACE IN QUADRANT (FOR THINGS) 8590 R1=FNR(1):R2=FNR(1):A$=" ":Z1=R1:Z2=R2:GOSUB 8830:IF Z3=0 THEN 8590 8600 RETURN 8660 REM INSERT IN STRING ARRAY FOR QUADRANT 8670 S8=INT(Z2-.5)*3+INT(Z1-.5)*24+1 8675 IF LEN(A$)<>3 THEN COLOUR RED+BOLD:PRINT "ERROR":COLOUR WHITE:STOP 8680 IF S8=1 THEN Q$=A$+RIGHT$(Q$,189):RETURN 8690 IF S8=190 THEN Q$=LEFT$(Q$,189)+A$:RETURN 8700 Q$=LEFT$(Q$,S8-1)+A$+RIGHT$(Q$,190-S8):RETURN 8780 REM PRINTS DEVICE NAME 8790 ON R1 GOTO 8792,8794,8796,8798,8800,8802,8804,8806 8792 G2$="WARP ENGINES":RETURN 8794 G2$="SHORT RANGE SENSORS":RETURN 8796 G2$="LONG RANGE SENSORS":RETURN 8798 G2$="PHASER CONTROL":RETURN 8800 G2$="PHOTON TUBES":RETURN 8802 G2$="DAMAGE CONTROL":RETURN 8804 G2$="SHIELD CONTROL":RETURN 8806 G2$="LIBRARY-COMPUTER":RETURN 8820 REM STRING COMPARISON IN QUADRANT ARRAY 8830 Z1=INT(Z1+.5):Z2=INT(Z2+.5):S8=(Z2-1)*3+(Z1-1)*24+1:Z3=0 8890 IF MID$(Q$,S8,3)<>A$ THEN RETURN 8900 Z3=1:RETURN 9010 REM QUADRANT NAME IN G2$ FROM Z4,Z5 (=Q1,Q2) 9020 REM CALL WITH G5=1 TO GET REGION NAME ONLY 9030 IF Z5<=4 THEN ON Z4 GOTO 9040,9050,9060,9070,9080,9090,9100,9110 9035 GOTO 9120 9040 G2$="ANTARES":GOTO 9210 9050 G2$="RIGEL":GOTO 9210 9060 G2$="PROCYON":GOTO 9210 9070 G2$="VEGA":GOTO 9210 9080 G2$="CANOPUS":GOTO 9210 9090 G2$="ALTAIR":GOTO 9210 9100 G2$="SAGITTARIUS":GOTO 9210 9110 G2$="POLLUX":GOTO 9210 9120 ON Z4 GOTO 9130,9140,9150,9160,9170,9180,9190,9200 9130 G2$="SIRIUS":GOTO 9210 9140 G2$="DENEB":GOTO 9210 9150 G2$="CAPELLA":GOTO 9210 9160 G2$="BETELGEUSE":GOTO 9210 9170 G2$="ALDEBARAN":GOTO 9210 9180 G2$="REGULUS":GOTO 9210 9190 G2$="ARCTURUS":GOTO 9210 9200 G2$="SPICA" 9210 IF G5<>1 THEN ON Z5 GOTO 9230,9240,9250,9260,9230,9240,9250,9260 9220 RETURN 9230 G2$=G2$+" I":RETURN 9240 G2$=G2$+" II":RETURN 9250 G2$=G2$+" III":RETURN 9260 G2$=G2$+" IV":RETURN 9899 REM MAKE A$ UPPERCASE 9900 FOR Z9=1 TO LEN(A$) 9902 Z5=ASC(MID$(A$,Z9,1)) 9904 IF Z5>=97 AND Z5<=122 THEN Z5=Z5-32 9906 MID$(A$,Z9,1)=CHR$(Z5) 9908 NEXT Z9 9910 RETURN 9995 REM SAVE/LOAD/EXIT CODE 10000 REM SAVE VARIABLES TO SAVE FILE AND EXIT 10010 SF=OPENOUT(SAVDIR$+SFNAME$) 10020 IF SF=0 THEN PRINT "COULD NOT CREATE FILE":GOTO 10130 10030 PRINT "SAVING DATA...":PRINT#SF,"SST3V2 SAVE FILE" 10040 FOR I=1 TO 8:FOR J=1 TO 8:PRINT#SF,G(I,J):NEXT J:NEXT I 10050 FOR I=1 TO 9:FOR J=1 TO 2:PRINT#SF,C(I,J):NEXT J:NEXT I 10060 FOR I=1 TO 3:FOR J=1 TO 3:PRINT#SF,K(I,J):NEXT J:NEXT I 10070 FOR I=1 TO 3:PRINT#SF,N(I):NEXT I 10080 FOR I=1 TO 8:FOR J=1 TO 8:PRINT#SF,Z(I,J):NEXT J:NEXT I 10090 FOR I=1 TO 8:PRINT#SF,D(I):NEXT I 10100 PRINT#SF,D0,E,E0,P,P0,S9,S,B9,K9,K7,G2$,S8,A8$,Q$,T,T0,T9 10110 PRINT#SF,S1,S2,Z4,Q1,Z5,Q2,K3,B3,S3,G5,D4,R1,R2,R8 10120 CLOSE#SF 10130 WAIT 200:GOTO 14000 11000 REM SUBROUTINE - IF SAVE FILE PRESENT PROMPT TO LOAD 11010 SF=OPENIN(SAVDIR$+SFNAME$):IF SF=0 THEN RETURN 11020 INPUT "RESTORE PREVIOUS? (Y/N) "A$:GOSUB 9900 11030 IF A$<>"Y" THEN CLOSE#SF:SF=0:RETURN 11040 INPUT#SF,A$:IF A$="SST3V2 SAVE FILE" THEN 11060 11050 CLOSE#SF:SF=0:PRINT "SAVE FILE CORRUPT":RETURN 11060 FOR I=1 TO 8:FOR J=1 TO 8:INPUT#SF,G(I,J):NEXT J:NEXT I 11070 FOR I=1 TO 9:FOR J=1 TO 2:INPUT#SF,C(I,J):NEXT J:NEXT I 11080 FOR I=1 TO 3:FOR J=1 TO 3:INPUT#SF,K(I,J):NEXT J:NEXT I 11090 FOR I=1 TO 3:INPUT#SF,N(I):NEXT I 11100 FOR I=1 TO 8:FOR J=1 TO 8:INPUT#SF,Z(I,J):NEXT J:NEXT I 11110 FOR I=1 TO 8:INPUT#SF,D(I):NEXT I 11120 INPUT#SF,D0,E,E0,P,P0,S9,S,B9,K9,K7,G2$,S8,A8$,Q$,T,T0,T9 11130 INPUT#SF,S1,S2,Z4,Q1,Z5,Q2,K3,B3,S3,G5,D4,R1,R2,R8 11140 CLOSE#SF 11500 RETURN 12000 REM REMOVE SAVE FILE AND RERUN 12010 A$=SAVDIR$+SFNAME$:GOSUB 12500:GOTO 200 12500 REM SUBROUTINE TO DELETE A FILE, NAME IN A$ 12510 SF=OPENIN(A$):CLOSE#SF:IF SF=0 THEN RETURN 12520 IF BBC=77 THEN 12540 12530 OSCLI "DEL """+A$+"""":RETURN:REM DEFAULT FOR SDL/WINDOWS 12540 OSCLI "rm """+A$+"""":RETURN:REM FOR MATRIX BRANDY UNDER LINUX 13000 REM REMOVE SAVE FILE AND EXIT 13010 A$=SAVDIR$+SFNAME$:GOSUB 12500 14000 REM EXIT PROGRAM 14010 IF PROGEXIT=1 THEN END 14020 IF PROGEXIT=2 THEN 14100 14030 QUIT 14100 REM CHAIN TO TOUCHIDE SHELL 14110 ON ERROR GOTO 14130 14120 CHAIN @lib$+"../examples/tools/touchide" 14130 PRINT "TOUCHIDE SHELL NOT FOUND":ON ERROR OFF:END 14200 REM ERROR TRAP 14210 ON ERROR OFF:IF ERTRAP=2 THEN 14000 14220 PRINT:PRINT "ERROR CODE ";ERR;:IF ERL>0 THEN PRINT " AT LINE ";ERL 14230 REPORT:PRINT:END 14300 REM SUBROUTINE - DEFINE/CHANGE COLORS 14310 BK=0:RED=1:GREEN=2:YELLOW=3:BLUE=4:MAGENTA=5:CYAN=6:WHITE=7:BOLD=8 14320 X=MONOCOL:IF X=0 THEN 14350 14330 RED=X:GREEN=X:YELLOW=X:BLUE=X:MAGENTA=X:CYAN=X:WHITE=X 14340 BOLD=0:BK=MONOBKG 14350 COLOUR BK+128:COLOUR WHITE+BOLD:CLS 14360 REM DIVISIONS ON SRS DISPLAY, A8$=" ":A9$=" " FOR STOCK LOOK 14370 REM IF A9$="_" ALSO SUPPRESSES STOCK ----- ON TOP AND BOTTOM 14380 A8$=" ":A9$=" ":IF DISPLOOK=1 THEN A8$="|":A9$="_" 14390 REM SYMBOLS FOR SPACE STAR KLINGON ENTERPRISE STARBASE 14400 E5$=" ":E6$=" * ":E7$="+K+":E8$="<*>":E9$=">!<":REM STOCK SYMBOLS 14410 IF DISPLOOK=1 THEN E6$=" * ":E7$=" K ":E8$=" E ":E9$=" B " 14420 IF DISPLOOK=2 THEN E5$=" . ":REM DISPLOOK 3-4 HANDLED IN SRS CODE 14430 RETURN 15000 REM SUBROUTINE - LOAD PREFERENCE FILE IF PRESENT 15010 PF=OPENIN(SAVDIR$+PFNAME$) 15020 IF PF=0 THEN RETURN 15030 INPUT#PF,A$:IF A$="SST3V2 PREF FILE" THEN 15050 15040 CLOSE#PF:PRINT "PREF FILE CORRUPT":WAIT 200:RETURN 15050 INPUT#PF,PROGEXIT,ERTRAP,MONOCOL,MONOBKG,DISPLOOK 15070 CLOSE#PF:RETURN 16000 REM CHANGE PREFERENCES AND OPTIONALLY SAVE TO PREFERENCE FILE 16010 COLOR CYAN:PRINT "MONOCHROME OR COLOR DISPLAY (M/C)";:INPUT ": "A$ 16020 GOSUB 9900:IF A$="C" THEN X=0:Y=0:GOTO 16100 ELSE IF A$<>"M" THEN 16110 16030 PRINT "TEXT COLOR (0-15)";:INPUT ": "A$ 16040 IF A$="" THEN PRINT "USING CODE 10, BOLD GREEN":X=10:GOTO 16060 16050 X=INT(VAL(A$)):IF X<0 OR X>15 THEN PRINT "OUT OF RANGE":GOTO 16030 16060 PRINT "BACKGROUND COLOR (0-15)";:INPUT ": "A$ 16070 IF A$="" THEN PRINT "USING CODE 0, BLACK":Y=0:GOTO 16100 16080 Y=INT(VAL(A$)):IF Y<0 OR Y>15 THEN PRINT "OUT OF RANGE":GOTO 16060 16090 IF X=Y THEN PRINT "FG AND BG CAN'T BE THE SAME, TRY AGAIN":GOTO 16010 16100 MONOCOL=X:MONOBKG=Y 16110 INPUT "SRS DISPLAY 0=STOCK 1=GRID 2=DOTS 3=DIV1 4=DIV2: "A$ 16115 IF A$="" THEN 16140 16120 DISPLOOK=INT(VAL(A$)):IF DISPLOOK>=0 AND DISPLOOK<=4 THEN 16140 16130 PRINT "OUT OF RANGE":GOTO 16110 16140 PLATFORM%=0:IF BBC=115 THEN PLATFORM%=@platform%:REM GET PLATFORM 16142 XMAX=2:POPT$="":IF PLATFORM%=33556995 THEN XMAX=3:POPT$="2=TOUCHIDE " 16143 REM TOUCHIDE ONLY SHOWS UP FOR ANDROID, NOT USEFUL FOR PC 16148 PRINT "ON EXIT 0=QUIT 1=END ";POPT$;"(CURRENTLY ";PROGEXIT;")"; 16150 INPUT ": "A$:IF A$="" THEN 16180 16160 X=INT(VAL(A$)):IF X<0 OR X>2 THEN PRINT "OUT OF RANGE":GOTO 16140 16170 PROGEXIT=X 16180 PRINT "ON ERROR/ESC 0=END 1=EXIT (CURRENTLY ";ERTRAP;")"; 16190 INPUT ": "A$:IF A$="" THEN 16300 16200 X=INT(VAL(A$)):IF X<0 OR X>1 THEN PRINT "OUT OF RANGE":GOTO 16180 16210 ERTRAP=X 16300 INPUT "SAVE PREFERENCES? (Y/N) "A$:GOSUB 9900:IF A$<>"Y" THEN 16350 16310 PF=OPENOUT(SAVDIR$+PFNAME$) 16320 IF PF=0 THEN PRINT "COULD NOT CREATE FILE":RETURN 16330 PRINT "SAVING PREFERENCES...":PRINT#PF,"SST3V2 PREF FILE" 16340 PRINT#PF,PROGEXIT,ERTRAP,MONOCOL,MONOBKG,DISPLOOK:CLOSE#PF:GOTO 16380 16350 PF=OPENIN(SAVDIR$+PFNAME$):CLOSE#PF:IF PF=0 THEN 16380 16360 INPUT "REMOVE PREFERENCES FILE? (Y/N) "A$ 16370 GOSUB 9900:IF A$="Y" THEN A$=SAVDIR$+PFNAME$:GOSUB 12500 16380 GOSUB 14300:RETURN 19999 REM END OF SST3 PROGRAM