REM **** THIS FILE CONTAINS EMBEDDED GRAPHICS, **** REM **** NOT ALL OF WHICH ARE VISIBLE ON AN **** REM **** ASCII/ANSI/ISO-8859 SCREEN **** REM REM 10REM STAR-TREK...Adapted by L.R.H.Nicholson and P.N.Turnbull 20GOSUB 4890 30?" " 40?" " 50?" " 60?" " 70?" " 80?" " 90?" " 100?:?:? 110?" " 120?" " 130?" " 140?" " 150?" " 160?" " 170?" ":?:? 180?SPC(20);" " 190?SPC(20);" " 200?SPC(20);" " 210?SPC(20);" " 220?SPC(20);" " 230?SPC(20);" " 240?SPC(20);" " 250CLEAR1000 260Z$=" " 270DIMG(8,8),C(9,2),K(3,3),N(3),Z(8,8),D(8) 280T=INT(RND(1)*20+20)*100:T0=T:T9=25+INT(RND(1)*10):D0=0 290E=3000:E0=E 300P=10:P0=P:S9=200:S=0:B9=0:K9=0:X$="":X0$=" IS " 310DEF FND(D)=SQR((K(I,1)-S1)^2+(K(I,2)-S2)^2) 320DEF FNR(R)=INT(RND(R)*7.98+1.01) 330REM **** INITIALISE ENTERPRISE'S POSITION 340Q1=FNR(1):Q2=FNR(1):S1=FNR(1):S2=FNR(1) 350FORI=1TO9:C(I,1)=0:C(I,2)=0:NEXT I 360C(3,1)=-1:C(2,1)=-1:C(4,1)=-1:C(4,2)=-1:C(5,2)=-1:C(6,2)=-1 370C(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 380FORI=1TO8:D(I)=0:NEXTI 390A1$="NAVSRSLRSPHATORSHEDAMCOMXXX" 400REM **** SET UP WHAT EXISTS IN GALAXY 410REM **** K3=#KLINGONS B3=#STARBASES S3=#STARS 420FORI=1TO8:FORJ=1TO8:K3=0:Z(I,J)=0:R1=RND(1) 430IFR1>.98THENK3=3:K9=K9+3:GOTO460 440IFR1>.95THENK3=2:K9=K9+2:GOTO460 450IFR1>.80THENK3=1:K9=K9+1 460B3=0:IFRND(1)>.96THENB3=1:B9=B9+1 470G(I,J)=K3*100+B3*10+FNR(1):NEXTJ:NEXTI:IFK9>T9THENT9=K9+1 480IFB9<>0THEN510 490IFG(Q1,Q2)<200THENG(Q1,Q2)=G(Q1,Q2)+100:K9=K9+1 500B9=1:G(Q1,Q2)=G(Q1,Q2)+10:Q1=FNR(1):Q2=FNR(1) 510K7=K9:IFB9<>1THENX$="s":X0$=" are " 520GOSUB4900 530?" WELCOME TO THE COMPUTER ":?:?:?:? 540?"PLEASE TELL ME YOUR NAME SO THAT I CAN ADMINISTER"; 550?" SYMPATHY" 560?"WHEN NEEDED (and it will be!)." 570?:?"Type in your name after the QUESTION MARK and hit the" 580?"'RETURN' key.";:INPUT NA$ 590?"PLEASED TO MEET YOU ";NA$:? 600?"HERE'S WHAT YOU HAVE TO DO............................." 610?" Destroy the ";K9;" Klingon warship which" 620?"have invaded the galaxy before they can attack Federation" 630?"H.Q. on Stardate ";T0+T9;". This gives you ";T9;" days." 640?"There";X0$;B9;" Starbase";X$;" in the galaxy for " 650?"resupplying your ship." 660?:?" PRESS 'RETURN' TO CONTINUE" 670INPUTCO$:CO$="" 680GOSUB4900 690REM **** HERE ANY TIME NEW QUADRANT ENTERED 700Z4=Q1:Z5=Q2:K3=0:B3=0:S3=0:G5=0:D4=.5*RND(1):Z(Q1,Q2)=G(Q1,Q2) 710IFQ1<1ORQ1>8ORQ2<1ORQ2>8THEN840 720GOSUB4590 730?:IF T0<>T THEN 770 740?" WELL ";NA$;" HERE WE GO....":? 750?" Your mission begins with your Starship located" 760?" in the Galactic Quadrant,'";G2$;"'.":GOTO 780 770?" NOW ENTERING ";G2$;" QUADRANT..." 780?:K3=INT(G(Q1,Q2)*.01):B3=INT(G(Q1,Q2)*.1)-10*K3 790S3=G(Q1,Q2)-100*K3-10*B3:IFK3=0THEN830 800?" COMBAT AREA---CONDITION RED ":IFS>200THEN830 810OUT 255,1:?" SHIELD STRENGTH CRITICAL " 820?" Oh dear ";NA$;",watch out!" 830FORI=1TO3:K(I,1)=0:K(I,2)=0:NEXT I:OUT255,0 840FORI=1TO3:K(I,3)=0:NEXTI:Q$=Z$+Z$+Z$+Z$+Z$+Z$+Z$+LEFT$(Z$,17) 850REM **** POSITION ENTERPRISE IN QUADRANT THEN KLINGONS etc 860A$="":Z1=S1:Z2=S2:GOSUB4380:IFK3<1THEN890 870FORI=1TOK3:GOSUB4340:A$="":Z1=R1:Z2=R2 880GOSUB4380:K(I,1)=R1:K(I,2)=R2:K(I,3)=S9*(0.5+RND(1)):NEXTI 890IFB3<1THEN910 900GOSUB4340:A$="><":Z1=R1:B4=R1:Z2=R2:B5=R2:GOSUB4380 910FORI=1TOS3:GOSUB4340:A$=" * ":Z1=R1:Z2=R2:GOSUB4380:NEXTI 920GOSUB3330 930IFS+E>10THENIFE>10ORD(7)=0THEN1000 940?:OUT255,1:OUT255,0 950?SPC(15);"YOU BLEW IT,";NA$;". I'M AWFULLY SORRY." 960?SPC(15);" FATAL ERROR " 970?SPC(15);" You have insufficient energy " 980?SPC(15);" for manoevring and therefore " 985OUT255,1:OUT255,0 990?SPC(15);" are STRANDED in space....... ":GOTO3080 1000?:INPUT" COMMAND (TYPE 'HELP' IF YOU'RE NOT SURE)";A$ 1010FORI=1TO9:IFLEFT$(A$,3)<>MID$(A1$,3*I-2,3)THEN1050 1020IFI=5THEN1040 1030GOSUB 4900 1040ONIGOTO1170,920,1970,2060,2290,2670,2770,3570,3130 1050NEXTI:?"ENTER 1 OF THE FOLLOWING: " 1060? " NAV (SET COURSE)" 1070? " SRS (SHORT RANGE SENSOR SCAN)" 1080? " LRS (LONG RANGE SENSOR SCAN)" 1090? " PHA (FIRE PHASERS)" 1100? " TOR (FIRE PHOTON TORPEDO)" 1110? " SHE (RAISE/LOWER SHIELDS)" 1120? " DAM (DAMAGE CONTROL REPORT)" 1130? " COM (CALL LIBRARY COMPUTER)" 1140? " XXX (RESIGN COMMAND)" 1150? " ":?:GOTO930 1160REM **** COURSE CONTROL BEGINS HERE 1170INPUT" COURSE (0-9) ";C1:IFC1=9THENC1=1 1180IFC1>=1ANDC1<9THEN1200 1190?" INCORRECT COURSE DATA":OUT255,1:OUT255,0:GOTO930 1200X$="8":IFD(1)<0THENX$="0.2" 1210?" WARP FACTOR (0-";X$;")";:INPUT W1 1220IFD(1)<0ANDW1>.2THEN1260 1230IFW1>0ANDW1<=8THEN1280 1240IFW1=0THEN930 1245OUT255,1:OUT255,0 1250?" ENGINES WON'T TAKE WARP FACTOR";W1:GOTO930 1260?"";SPC(17);"WARP ENGINES DAMAGED":OUT255,1 1270OUT255,0:?"";SPC(17);"MAXIMUM SPEED = WARP 0.2":GOTO930 1280N=INT(W1*8+0.5):IFE-N>=0THEN1370 1290?"";SPC(17);"INSUFFICIENT ENERGY AVAILABLE":OUT255,1 1300OUT255,0:?"";SPC(17);"FOR MANOEVRING AT WARP";W1 1310IFS=1THEND6=1 1410FORI=1TO8:IFD(I)>=0THEN1460 1420D(I)=D(I)+D6:IFD(I)>-.1ANDD(I)<0THEND(I)=-.1:GOTO1460 1430IFD(I)<0THEN1460 1440IFD1<>1THEND1=1:?" DAMAGE CONTROL REPORT:" 1450?TAB(8);:R1=I:GOSUB4440:?G2$;" REPAIR COMPLETED " 1460NEXTI:IFRND(1)>.2THEN1550 1470R1=FNR(1):IFRND(1)>=.6THEN1520 1475OUT255,1:OUT255,0 1480?" METEORITE DAMAGE " 1490?:?"SORRY ABOUT THAT ";NA$;".KLINGONS ARE BAD ENOUGH" 1500D(R1)=D(R1)-(RND(1)*5+1):?" DAMAGE CONTROL REPORT:" 1510GOSUB4440:?TAB(8);G2$;" DAMAGED":?:GOTO1550 1520D(R1)=D(R1)+RND(1)*3+1:?" DAMAGE CONTROL REPORT:" 1530GOSUB4440:?TAB(8);G2$;" IMPROVEMENT IN STATE OF REPAIR":? 1540REM **** BEGIN MOVING STARSHIP 1550A$=" ":Z1=INT(S1):Z2=INT(S2):GOSUB4380 1560X1=C(C1,1)+(C(C1+1,1)-C(C1,1))*(C1-INT(C1)):X=S1:Y=S2 1570X2=C(C1,2)+(C(C1+1,2)-C(C1,2))*(C1-INT(C1)):Q4=Q1:Q5=Q2 1580FORI=1TON:S1=S1+X1:S2=S2+X2:IFS1<1ORS1>=9ORS2<1ORS2>=9THEN1720 1590S8=INT(S1)*24+INT(S2)*3-26:IFMID$(Q$,S8,2)=" "THEN1650 1600S1=INT(S1-X1):S2=INT(S2-X2) 1610?SPC(15);" WARP ENGINES SHUT DOWN":OUT255,1:OUT255,0 1620?SPC(15);" AT SECTOR";S1;",";S2;" DUE TO BAD NAVIGATION" 1630?" WELL,";NA$;",I THINK YOU SHOULD TRY A SHORT RANGE SCAN" 1640GOTO1660 1650NEXTI:S1=INT(S1):S2=INT(S2) 1660A$="":Z1=INT(S1):Z2=INT(S2):GOSUB4380:GOSUB1910:T8=1 1670IFW1<1THENT8=.1*INT(10*W1) 1680T=T+T8:IFT>T0+T9THEN3080 1690REM **** SEE IF DOCKED THEN GET COMMAND 1700GOTO920 1710REM **** EXCEEDED QUADRANT LIMITS 1720X=8*Q1+X+N*X1:Y=8*Q2+Y+N*X2:Q1=INT(X/8):Q2=INT(Y/8) 1730S1=INT(X-Q1*8) 1740S2=INT(Y-Q2*8):IFS1=0THENQ1=Q1-1:S1=8 1750IFS2=0THENQ2=Q2-1:S2=8 1760X5=0:IFQ1<1THENX5=1:Q1=1:S1=1 1770IFQ1>8THENX5=1:Q1=8:S1=8 1780IFQ2<1THENX5=1:Q2=1:S2=1 1790IFQ2>8THENX5=1:Q2=8:S2=8 1800IFX5=0THEN1880 1810OUT255,1:?" MESSAGE FROM STARFLEET COMMAND:" 1820?" Permission to attempt crossing of GALACTIC PERIMETER" 1830?" is DENIED.Shut down engines.":?"" 1840?" WARP ENGINES SHUT DOWN AT SECTOR";S1;",";S2 1850?" OF QUADRANT";Q1;",";Q2:?:OUT255,0 1860?" DON'T PANIC,";NA$;",THERE'S NO HARM DONE" 1870IFT>T0+T9THEN3080 1880IF8*Q1+Q2=8*Q4+Q5THEN1660 1890T=T+1:GOSUB1910:GOTO700 1900REM **** MANOEVRE ENERGY S/R **** 1910E=E-N-10:IFE>=0THENRETURN 1920?" SHIELD CONTROL SUPPLIES ENERGY" 1930?" TO COMPLETE THIS MANOEVRE" 1940S=S+E:E=0:IFS<=0THENS=0 1950RETURN 1960REM **** LONG RANGE SENSOR SCAN CODE 1970IFD(3)<0THEN?" LONG RANGE SENSORS INOPERATIVE":GOTO930 1980?" LONG RANGE SCAN FOR QUADRANT";Q1;",";Q2 1990O1$="-------------------":?O1$ 2000FORI=Q1-1TOQ1+1:N(1)=-1:N(2)=-2:N(3)=-3:FORJ=Q2-1TOQ2+1 2010IFI>0ANDI<9ANDJ>0ANDJ<9THENN(J-Q2+2)=G(I,J):Z(I,J)=G(I,J) 2020NEXTJ:FORL=1TO3:?": ";:IFN(L)<0THEN?"*** ";:GOTO2040 2030?RIGHT$(STR$(N(L)+1000),3);" "; 2040NEXTL:?":":?O1$:NEXTI:GOTO930 2050REM **** PHASER CONTROL CODE 2060IFD(4)<0THEN?" PHASERS INOPERATIVE":GOTO930 2070IFK3>0THEN2100 2080?" SENSORS SHOW NO HOSTILES IN THIS QUADRANT" 2090GOTO930 2100IFD(8)<0THEN?" COMPUTER FAILURE AFFECTS ACCURACY" 2110?" PHASERS LOCKED ON TARGET" 2120?" Energy available =";E;" units." 2130INPUT" NUMBER OF UNITS TO FIRE";X:IFX<=0THEN930 2140IFE-X<0THEN2120 2150E=E-X:IFD(7)<0THENX=X*RND(1) 2160H1=INT(X/K3):FORI=1TO3:IFK(I,3)<=0THEN2270 2170H=INT((H1/FND(0))*(RND(1)+2)):IFH>.15*K(I,3)THEN2200 2180?" SENSORS SHOW NO DAMAGE TO ENEMY" 2190?" AT";K(I,1);",";K(I,2):GOTO2270 2200K(I,3)=K(I,3)-H:?"";H;" UNIT HIT ON KLINGON AT SECTOR"; 2210?"";K(I,1);",";K(I,2) 2220IFK(I,3)<=0THEN?" KLINGON DESTROYED " 2225IFK(I,3)<=0THENOUT255,1:OUT255,0:GOTO2240 2230?" SENSORS SHOW";K(I,3);" UNITS REMAINING":GOTO2270 2240K3=K3-1:K9=K9-1:Z1=K(I,1):Z2=K(I,2):A$=" ":GOSUB4380 2250K(I,3)=0:G(Q1,Q2)=G(Q1,Q2)-100:Z(Q1,Q2)=G(Q1,Q2) 2260IFK9<=0THEN3290 2270NEXTI:GOSUB2930:GOTO930 2280REM **** PHOTON TORPEDO CODE 2290IFP<=0THEN?" ALL PHOTON TORPEDOES EXPENDED":GOTO930 2300IFD(5)<0THEN?" PHOTON TUBES NON-OPERATIONAL":GOTO930 2310INPUT" PHOTON TORPEDO COURSE (1-9)";C1:IFC1=9THENC1=1 2320IFC1>=1ANDC1<9THEN2340 2330?" INCORRECT COURSE DATA":GOTO930 2340X1=C(C1,1)+(C(C1+1,1)-C(C1,1))*(C1-INT(C1)):E=E-2:P=P-1 2350X2=C(C1,2)+(C(C1+1,2)-C(C1,2))*(C1-INT(C1)):X=S1:Y=S2 2360?" TORPEDO TRACK---" 2370X=X+X1:Y=Y+X2:X3=INT(X+.5):Y3=INT(Y+.5) 2380IFX3<1ORX3>8ORY3<1ORY3>8THEN2640 2390?" ";X3;",";Y3:A$=" ":Z1=X:Z2=Y 2400GOSUB 4540 2410IFZ3<>0THEN2370 2420A$="":Z1=X:Z2=Y:GOSUB4540:IFZ3=0THEN2490 2430OUT255,1:OUT255,0 2435?" KLINGON DESTROYED ":K3=K3-1:K9=K9-1 2440IFK9<=0THEN3290 2450FORVV=1TO500:NEXTVV:GOSUB4900 2460FORI=1TO3:IFX3=K(I,1)ANDY3=K(I,2)THEN2480 2470NEXTI:I=3 2480K(I,3)=0:GOTO2620 2490A$=" * ":Z1=X:Z2=Y:GOSUB4540:IFZ3=0THEN2530 2500FORVV=1TO500:NEXTVV:GOSUB4900 2510?" STAR AT";X3;",";Y3;" ABSORBED TORPEDO ENERGY":GOSUB2930 2520GOTO930 2530A$="><":Z1=X:Z2=Y:GOSUB4540:IFZ3=0THEN2310 2540FORVV=1TO500:NEXTVV:GOSUB4900 2550OUT255,1:OUT255,0 2555?" STARBASE DESTROYED":B3=B3-1:B9=B9-1 2560IFB9>0ORK9>T-T0-T9THEN2600 2570?" YOU ARE RELIEVED OF COMMAND AND SENTENCED" 2580?" TO 10 YEARS WATCHING 'CROSSROADS'" 2590GOTO3130 2600?" STARFLEET COMMAND REVIEWING RECORD TO" 2610?" CONSIDER COURT MARTIAL":D0=0 2620Z1=X:Z2=Y:A$=" ":GOSUB4380 2630G(Q1,Q2)=K3*100+B3*10+S3:Z(Q1,Q2)=G(Q1,Q2):GOSUB2930:GOTO930 2640FORVV=1TO500:NEXTVV:GOSUB4900 2650?" TORPEDO MISSED HOSTILE":GOSUB 2930:GOTO930 2660REM **** SHIELD CONTROL 2670IFD(7)<0THEN?" SHIELD CONTROL OUT OF COMMISSION":GOTO930 2680?" ENERGY AVAILABLE =";E+S 2690INPUT" NUMBER OF UNITS TO SHIELDS";X 2700IFX<0ORS=XTHEN?" SHIELDS UNCHANGED ":GOTO930 2710IFX<=E+STHEN2740 2720?" REQUESTED NO. OF UNITS NOT AVAILABLE" 2730?" SHIELDS UNCHANGED":GOTO930 2740E=E+S-X:S=X:?" DEFLECTOR CONTROL ROOM REPORT:" 2750?" SHIELDS NOW AT";INT(S);" UNITS AS ORDERED":GOTO930 2760REM **** DAMAGE CONTROL 2770IFD(6)>=0THEN2880 2780?" DAMAGE CONTROL REPORT UNAVAILABLE":IFD0=0THEN930 2790D3=0:FORI=1TO8:IFD(I)<0THEND3=D3+.1 2800NEXTI:IFD3=0THEN930 2810?:D3=D3+D4:IFD3>=1THEND3=.9 2820?" TECHNICIANS STANDING BY TO EFFECT REPAIRS TO YOUR SHIP" 2830?" REPAIR TIME ESTIMATED AT";.01*INT(100*D3);" STARDATES" 2840INPUT" CONFIRM AUTHORISATION OF REPAIR ORDER (Y/N)";A$ 2850IFA$<>"Y"THEN930 2860FORI=1TO8:IFD(I)<0THEND(I)=0 2870NEXTI:T=T+D3+.1 2880?:?"DEVICE STATE OF REPAIR":FORR1=1TO8 2890GOSUB4440:?G2$;LEFT$(Z$,25-LEN(G2$));INT(D(R1)*100)*.01 2900NEXTR1:IFD0<>0THEN2790 2910GOTO930 2920REM **** KLINGONS SHOOTING 2930IFK3<=0THENRETURN 2940IF D0<>0THENGOTO4840 2950REM 2960FORI=1TO3:IFK(I,3)<=0THEN3050 2970H=INT((K(I,3)/FND(1))*(2+RND(1))):S=S-H 2980K(I,3)=K(I,3)/(3+RND(0)) 2990?H;" UNIT HIT ON ENTERPRISE FROM SECTOR";K(I,1);",";K(I,2) 3000IFS<=0THEN3110 3010?" SHIELDS DOWN TO";S;" UNITS ":IFH<20THEN3050 3020IFRND(1)>.6ORH/S<=.02THEN3050 3030R1=FNR(1):D(R1)=D(R1)-H/S-.5*RND(1):GOSUB4440 3040?" DAMAGE CONTROL REPORTS ";G2$;" DAMAGED BY HIT" 3050NEXTI:RETURN 3060OUT255,1:OUT255,0:REM **** END OF GAME **** 3070GOSUB4900 3080?" IT IS STARDATE";T; 3090?"" 3100GOTO3130 3110?:?" THE ENTERPRISE HAS BEEN DESTROYED" 3120?" THE FEDERATION WILL BE CONQUERED" 3125?:OUT255,1:OUT255,0:GOTO3080 3130?"" 3140?"" 3150?"" 3160?"" 3170?"" 3180?"" 3190FORVV=1TO4:?CHR$(23);:NEXTVV 3200FORVV=1TO10:?CHR$(19);:NEXTVV 3210?"THERE WERE";K9;" KLINGON BATTLE CRUISERS" 3220FORVV=1TO10:?CHR$(19);:NEXTVV 3230?"LEFT AT THE END OF YOUR MISSION" 3240?:?:IFB9=0THEN3280 3250?" THE FEDERATION IS IN NEED OF A NEW STARSHIP COMMANDER" 3260?" FOR A SIMILAR MISSION-----ENTER 'OK' IF YOU WISH TO" 3270INPUT" ACCEPT THE ASSIGNMENT";A$:IFA$="OK"THEN10 3280END 3290?" CONGRATULATIONS,CAPTAIN! THE LAST KLINGON BATTLE" 3300?" CRUISER MENACING THE FEDERATION HAS BEEN DESTROYED":? 3310?" YOUR EFFICIENCY RATING IS";1000*(K7/(T-T0))^2:GOTO3240 3320REM **** SHORT RANGE SENSOR SCAN & STARTUP 3330FORI=S1-1TOS1+1:FORJ=S2-1TOS2+1 3340IFINT(I+.5)<1ORINT(I+.5)>8ORINT(J+.5)<1ORINT(J+.5)>8THEN3360 3350A$="><":Z1=I:Z2=J:GOSUB4540:IFZ3=1THEN3370 3360NEXTJ:NEXTI:D0=0:GOTO3390 3370D0=1:C$=" DOCKED ":E=E0:P=P0 3380?" SHIELDS DROPPED FOR DOCKING PURPOSES ":S=0:GOTO3410 3390IFK3>0THENC$=" RED ":GOTO3410 3400C$=" GREEN ":IFE=0THEN3430 3420?:?" SHORT RANGE SENSORS ARE OUT ":?:RETURN 3430O1$="----------------------------------":?O1$:FORI=1TO8 3440FORJ=((I-1)*24)+1TO((I-1)*24)+22STEP3:?" ";MID$(Q$,J,3);:NEXTJ 3450ONIGOTO3460,3470,3480,3490,3500,3510,3520,3530 3460?" STARDATE ";INT(T*10)*.1:GOTO3540 3470?" CONDITION ";C$:GOTO 3540 3480?" QUADRANT ";Q1;",";Q2:GOTO3540 3490?" SECTOR ";S1;",";S2:GOTO3540 3500?" PHOTON TORPEDOES ";INT(P):GOTO3540 3510?" TOTAL ENERGY ";INT(E+S):GOTO3540 3520?" SHIELDS ";INT(S):GOTO3540 3530?" KLINGONS ACTIVE ";INT(K9) 3540NEXTI 3550?O1$:RETURN 3560REM **** LIBRARY COMPUTER CODE 3570IFD(8)<0THEN?" COMPUTER DISABLED ":GOTO930 3580REM 3590REM 3600REM 3610? 3620?" LIBRARY COMPUTER OPTIONS:" 3630?" 0=CUMULATIVE GALACTIC RECORD" 3640?" 1=STATUS REPORT" 3650?" 2=PHOTON TORPEDO DATA" 3660?" 3=STARBASE NAV DATA" 3670?" 4=DIRECTION/DISTANCE CALCULATOR" 3680?" 5=GALAXY 'REGION NAME' MAP":? 3690INPUT" COMPUTER ACTIVE-----AWAITING COMMAND";A 3700IFA<0THEN930 3710A=INT(A):IFA>5THEN3610 3720?:H8=1:ONA+1GOTO3760,3900,4020,4300,4080,3740 3730REM **** SETUP TO CHANGE CUM GAL RECORD TO GALAXY MAP 3740H8=0:G5=1:?" THE GALAXY":GOTO3800 3750REM **** CUM GALACTIC RECORD 3760GOSUB4900 3770?:?" "; 3780?"COMPUTER RECORD OF GALAXY FOR QUADRANT";Q1;",";Q2 3790? 3800?" 1 2 3 4 5 6 7 8" 3810O1$=" ----- ----- ----- ----- ----- ----- ----- -----" 3820?O1$:FORI=1TO8:?I;:IFH8=0THEN3860 3830FORJ=1TO8:?" ";:IFZ(I,J)=0THEN?"***";:GOTO3850 3840?RIGHT$(STR$(Z(I,J)+1000),3); 3850NEXTJ:GOTO3880 3860Z4=I:Z5=1:GOSUB4590:J0=INT(15-.5*LEN(G2$)):?TAB(J0);G2$; 3870Z5=5:GOSUB4590:J0=INT(39-.5*LEN(G2$)):?TAB(J0);G2$; 3880?:?O1$:NEXTI:?:GOTO930 3890REM ***** STATUS REPORT 3900?" STATUS REPORT:";:X$=" " 3910?"":IFK9>1THENX$="S" 3920?" KLINGON";X$;" ACTIVE: ";K9 3930?" MISSION MUST BE COMPLETED IN";.1*INT((T0+T9-T)*10); 3940?" STARDATES" 3950X$="S":IFB9<2THENX$=" ":IFB9<1THEN3990 3960?" THE FEDERATION IS MAINTAINING";B9;" STARBASE";X$; 3970?" IN THE GALAXY." 3980GOTO2770 3990?" YOUR INEFFICIENCY HAS LEFT YOU ALONE IN THE GALAXY" 4000?" YOU HAVE NO STARBASES LEFT--START WORRYING":GOTO2770 4010REM **** TORPEDO,BASE NAV,D/D CALCULATOR 4020IFK3<=0THEN2080 4030X$=" ":IFK3>1THENX$="S" 4040?" FROM ENTERPRISE TO KLINGON BATTLE CRUISER";X$ 4050H8=0:FORI=1TO3:IFK(I,3)<=0THEN4290 4060W1=K(I,1):X=K(I,2) 4070C1=S1:A=S2:GOTO4120 4080?" DIRECTION/DISTANCE CALCULATOR:" 4090?" YOU ARE AT QUADRANT";Q1;",";Q2;" SECTOR";S1;",";S2 4100INPUT" PLEASE ENTER INITIAL COORDINATES (X,Y)";C1,A 4110INPUT" FINAL COORDINATES (X,Y)";W1,X 4120X=X-A:A=C1-W1:IFX<0THEN4210 4130IFA<0THEN4230 4140IFX>0THEN4160 4150IFA=0THENC1=5:GOTO4170 4160C1=1 4170IFABS(A)<=ABS(X)THEN4200 4180?" DIRECTION=";C1+(((ABS(A)-ABS(X))+ABS(A))/ABS(A)) 4190GOTO4280 4200?" DIRECTION=";C1+(ABS(A)/ABS(X)):GOTO4280 4210IFA>0THENC1=3:GOTO4240 4220IFX<>0THENC1=5:GOTO4170 4230C1=7 4240IFABS(A)>=ABS(X)THEN4270 4250?" DIRECTION=";C1+(((ABS(X)-ABS(A))+ABS(X))/ABS(X)) 4260GOTO4280 4270?" DIRECTION=";C1+(ABS(X)/ABS(A)) 4280?" DISTANCE =";SQR(X^2+A^2):IFH8=1THEN930 4290NEXTI:GOTO930 4300IFB3<>0THEN?" FROM ENTERPRISE TO STARBASE:":W1=B4:X=B5 4310GOTO4070 4320?" SENSORS SHOW NO STARBASES IN THIS QUADRANT":GOTO930 4330REM **** FIND EMPTY PLACE IN QUADRANT (FOR THINGS) 4340R1=FNR(1):R2=FNR(1):A$=" ":Z1=R1:Z2=R2:GOSUB4540 4350IFZ3=0THEN4340 4360RETURN 4370REM **** INSERT IN STRING ARRAY FOR QUADRANT 4380S8=INT(Z2-.5)*3+INT(Z1-.5)*24+1 4390IFLEN(A$)<>3THEN?"##################ERROR###############":STOP 4400IFS8=1THENQ$=A$+RIGHT$(Q$,189):RETURN 4410IFS8=190THENQ$=LEFT$(Q$,189)+A$:RETURN 4420Q$=LEFT$(Q$,S8-1)+A$+RIGHT$(Q$,190-S8):RETURN 4430REM **** PRINTS DEVICE NAME 4440ONR1GOTO4450,4460,4470,4480,4490,4500,4510,4520 4450G2$="WARP ENGINES":RETURN 4460G2$="SHORT RANGE SENSORS":RETURN 4470G2$="LONG RANGE SENSORS":RETURN 4480G2$="PHASER CONTROL":RETURN 4490G2$="PHOTON TUBES":RETURN 4500G2$="DAMAGE CONTROL":RETURN 4510G2$="SHIELD CONTROL":RETURN 4520G2$="LIBRARY COMPUTER":RETURN 4530REM **** STRING COMPARISON IN QUADRANT ARRAY 4540Z1=INT(Z1+.5):Z2=INT(Z2+.5):S8=(Z2-1)*3+(Z1-1)*24+1:Z3=0 4550IFMID$(Q$,S8,3)<>A$THEN RETURN 4560Z3=1:RETURN 4570REM **** QUADRANT NAME IN G2$ FROM Z4,Z5 (=Q1,Q2) 4580REM **** CALL WITH G5=1 TO GET REGION NAME ONLY 4590IFZ5<=4THENONZ4GOTO4610,4620,4630,4640,4650,4660,4670,4680 4600GOTO4690 4610G2$="ANTARES":GOTO4780 4620G2$="RIGEL":GOTO4780 4630G2$="PROCYON":GOTO4780 4640G2$="VEGA":GOTO4780 4650G2$="CANOPUS":GOTO4780 4660G2$="ALTAIR":GOTO4780 4670G2$="SAGITTARIUS":GOTO4780 4680G2$="POLLUX":GOTO4780 4690ONZ4GOTO4700,4710,4720,4730,4740,4750,4760,4770 4700G2$="SIRIUS":GOTO4780 4710G2$="DENEB":GOTO4780 4720G2$="CAPELLA":GOTO4780 4730G2$="BETELGEUSE":GOTO4780 4740G2$="ALDEBARAN":GOTO4780 4750G2$="REGULUS":GOTO4780 4760G2$="ARCTURUS":GOTO4780 4770G2$="SPICA" 4780IFG5<>1THENONZ5GOTO4800,4810,4820,4830,4800,4810,4820,4830 4790RETURN 4800G2$=G2$+" I":RETURN 4810G2$=G2$+" II":RETURN 4820G2$=G2$+" III":RETURN 4830G2$=G2$+" IV":RETURN 4840REM*** SUB FOR INVULNERABILITY UNDER STARBASE PROTECTION 4850? 4860?" STARBASE SHIELDS PROTECT THE ENTERPRISE " 4870? 4880RETURN 4890FOR C=-512 TO -505:POKE C,255:NEXT 4895FOR C=-504 TO -481:READ X:POKE C,X:NEXT 4900REM *** CLEAR SCREEN & CURSOR DOWN 2 4910?CHR$(12);:?:? 4920RETURN 4930DATA 0,0,255,127,3,31,15,0,0,7,195,192 4940DATA 3,255,255,0,0,255,254,224,128,240,224,0