SOLAR.BAS  ·  BAS  ·  9.6 KB  ·  1988-08-05  ·  from Compute-PC-Magazine-Disk_November-1988_Volume-2_No.6_Issue-8
10 KEY OFF:SCREEN 1,0:DEFINT A-Z
20 DEF FNCAP$(K$)=CHR$(ASC(LEFT$(K$+" ",1))-(K$>="a")*(K$<="z")*32)
40 DIM MX(2,12),S!(255),C!(255),M$(9,17),MASK0(124),MASK1(124),CYAN(6),MAGENTA(6),MAGENTA2(7),WHITE(6),WHITE2(7),CYAN3(14)
45 DIM MOON0(108),MOON1(108),MOON2(108),MOON3(108),MOON4(108),MOON5(108),MOON6(108),MOON7(108),MOON8(108),MOON9(108),MOON10(108),MOON11(108)
50 EY!=1984.82
60 PI!=3.14159:PP!=2*PI!:P$(0)="Ac":P$(1)="De":SA!=1.1
70 CLS:PRINT"Please wait..."
80 SP$=CHR$(32):X$=SP$+"ESC"+CHR$(26)+"Exit":Z$=CHR$(27)
100 T$(1)="Sun & Planets"
110 T$(2)="Sun, Earth & Moon"
120 T$(3)="Comets"
130 T$(4)="Facts"
135 CIRCLE(162,102),2,1:PAINT(162,102),1,1:GET(160,100)-(164,104),CYAN3
140 LINE(160,100)-(162,102),3,BF
150 GET(160,100)-(162,102),WHITE2:GET(160,100)-(161,101),WHITE
160 LINE(160,100)-(216,107),2,BF:GET(160,100)-(216,107),MASK1
170 GET(160,100)-(161,101),MAGENTA:GET(160,100)-(162,102),MAGENTA2
180 LINE(160,100)-(216,107),1,BF:GET(160,100)-(216,107),MASK0
190 GET(160,100)-(161,101),CYAN:LINE(160,100)-(216,107),0,BF
191 FOR J=0 TO 2:FOR I=0 TO 12:READ MX(J,I):NEXT I,J:DATA 11,8,6,5,4,3,2,1,1,0,0,0,0,12,10,8,7,6,5,4,3,3,2,2,2,2,13,12,11,11,10,10,9,9,9,8,8,8,8
192 K=3:GOSUB 1771
196 GET(0,100)-(15,125),MOON5:GET(16+40,100)-(31+40,125),MOON6:GET(16+80,100)-(31+80,125),MOON7:GET(120+16,100)-(31+120,125),MOON8:GET(160,100)-(15+160,125),MOON9:GET(200,100)-(15+200,125),MOON10
197 GET(0,140)-(15,165),MOON11:GET(16+40,140)-(31+40,165),MOON0:GET(16+80,140)-(31+80,165),MOON1:GET(16+120,140)-(31+120,165),MOON2:GET(160,140)-(15+160,165),MOON3:GET(200,140)-(15+200,165),MOON4
200 K=0:GOSUB 1771:FOR J=0 TO 10:READ F$(J),U$(J)
210 L=0:H=10:IF J>4 THEN L=1:H=9
220 FOR K=L TO H:READ Z$(K,J):NEXT K,J
230 FOR J=1 TO 9:D!(J)=VAL(Z$(J,5))
240 P!(J)=VAL(Z$(J,6)):NEXT
250 FOR J=0 TO 10:READ N$(J)
260 IF J<4 OR J=10 THEN 280
270 FOR K=1 TO VAL(Z$(J,10)):READ M$(J,K):NEXT
280 NEXT:FOR J=1 TO 9:READ R!:R!(J)=R!/360:NEXT
290 FOR N=0 TO 255:M!=N*2*PI!/256
300 S!(N)=SIN(M!):C!(N)=COS(M!):NEXT
310 FOR J=32 TO 36:K=74-J:NEXT
380 CLS:LOCATE 5,15
390 PRINT"SOLARPIX":PRINT:PRINT
400 FOR J=1 TO 4:PRINT TAB(9)J;T$(J):PRINT
410 NEXT:PRINT TAB(10)"Q Quit"
420 GOSUB 480:ON K GOTO 640,1020,1280,1470
430 IF K$<>"Q" THEN 420
460 CLS:CLEAR:END
480 K$=FNCAP$(INKEY$):IF K$=" " THEN 480
490 K=VAL(K$):RETURN
500 LOCATE 19,32:PRINT"G=Go"
510 PRINT TAB(32)"S=Stop"
520 PRINT TAB(32)"+=Faster"
530 PRINT TAB(32)"-=Slower"
540 PRINT TAB(31)X$:RETURN
570 LOCATE 24,31:PRINT X$;
580 LOCATE 3,1:RETURN
590 K$=FNCAP$(INKEY$):IF K$="S" THEN FL=1
600 IF K$="G" THEN FL=0
610 IF K$="-" THEN M!=M!/2
620 RETURN
640 CLS:PRINT T$(1):GOSUB 570
650 PRINT"Please Select Planets (Max. 5)"
660 PRINT:FOR J=1 TO 9:PRINT J;N$(J):NEXT
670 PRINT:PRINT"Inner planet? ";
680 GOSUB 480:IF K$=Z$ THEN 380
690 L=K:IF L<1 THEN 680
700 PRINT N$(L):PRINT"Outer planet? ";
710 GOSUB 480:IF K$=Z$ THEN 380
720 H=K:IF H<L OR H>9 OR H-L>4 THEN 710
730 PRINT N$(H):PRINT:X=1
740 FOR J=1 TO H-L+1:X=X+2^J:NEXT
750 FOR J=L TO H:F!(J)=D!(J)*90/D!(H):PX(J)=0:PY(J)=198
760 E!(J)=F!(J)*SA!:NEXT:M!=P!(L)/50:ML!=M!*9
770 INPUT"Starting year (1-2000)";K$
775 IF K$="" THEN K$="1"
780 SY=VAL(K$):IF SY<1 OR SY>2000 THEN 640
790 CLS:PRINT T$(1):K=1
800 COL=0:FOR J=L TO H:PRINT TAB(32)N$(J):IF COL=0 THEN PUT(248,K*8),MASK0,AND ELSE IF COL=1 THEN PUT(248,K*8),MASK1,AND
810 COL=K MOD 3:K=K+1:NEXT
820 GOSUB 500:LOCATE 8,32
830 PRINT"Earth":PRINT TAB(32)"Year"
840 E!=.25:T!=SY-EY!:FL=1
850 PUT(106,98),WHITE2
860 FOR J=L TO H:A!=T!/P!(J)+R!(J)
870 A!=INT((A!-INT(A!))*256):IF J=9 THEN 890
880 X!(J)=C!(A!):Y!(J)=-S!(A!):GOTO 910
890 Z!=1+E!*C!(A!):X!(J)=E!+(E!+C!(A!))/Z!
900 Y!(J)=(E!*E!-1)*S!(A!)/Z!
910 X!(J)=INT(107+X!(J)*E!(J))
920 Y!(J)=INT(99+Y!(J)*F!(J)):NEXT
930 K=1:COL=0:FOR J=L TO H:IF PX(J)<>INT(X!(J)) OR PY(J)<>INT(Y!(J)) THEN PUT(PX(J),PY(J)),WHITE,PRESET:PX(J)=INT(X!(J)):PY(J)=INT(Y!(J)):IF COL=0 THEN PUT(PX(J),PY(J)),CYAN ELSE IF COL=1 THEN PUT(PX(J),PY(J)),MAGENTA ELSE PUT(PX(J),PY(J)),WHITE
940 COL=K MOD 3:K=K+1:NEXT
950 T$=STR$(INT(INT((T!+EY!)*10)/10))+"."+RIGHT$(STR$(INT(T!+EY!*10)),1)
960 LOCATE 10,31:PRINT T$SP$SP$
970 GOSUB 590:IF K$=Z$ THEN 640
980 IF FL THEN 970
990 IF K$="+" AND M!<ML! THEN M!=M!+M!
1000 T!=T!+M!:GOTO 860
1020 CLS:PRINT T$(2):PRINT TAB(32)"Moon"
1030 PRINT TAB(32)"Phase":GOSUB 500
1040 LOCATE 25,2:PRINT"(Earth-Moon distance magnified by 30.)";
1050 LOCATE 8,32:PRINT"Earth"
1060 PRINT TAB(32)"Day"
1070 E!=84:D!=E!*SA!:F!=D!*30/390:G!=F!/SA!
1080 M!=.3/365.25:T!=0
1090 PX=100:PY=50:PW=100:PZ=50
1100 PUT(117,97),CYAN3
1120 FL=1:PUT(266,25),MOON2,PSET
1130 A!=T!-INT(T!):B!=T!*13.3685:B!=B!-INT(B!)
1140 C=INT(12*(B!-A!)+.5)-7
1150 IF C<0 THEN C=C+12:GOTO 1150
1160 A!=A!*PP!:B!=B!*PP!
1170 X=INT(118.5+COS(A!)*D!)
1180 Y=INT(98.5-SIN(A!)*E!)
1190 W=INT(X+1+COS(B!)*F!)
1200 Z=INT(Y+1-SIN(B!)*G!)
1210 IF PX<>X OR PY<>Y THEN PUT(PX,PY),WHITE2,PRESET:PUT(X,Y),MAGENTA2,PSET:PX=X:PY=Y
1211 IF PW<>W OR PZ<>Z THEN PUT(PW,PZ),WHITE,PRESET:PUT(W,Z),WHITE,PSET:PW=W:PZ=Z
1212 ON C GOTO 1214,1215,1216,1217,1218,1219,1220,1221,1222,1223,1224
1213 PUT(266,25),MOON0,PSET:GOTO 1230
1214 PUT(266,25),MOON1,PSET:GOTO 1230
1215 PUT(266,25),MOON2,PSET:GOTO 1230
1216 PUT(250,25),MOON3,PSET:GOTO 1230
1217 PUT(250,25),MOON4,PSET:GOTO 1230
1218 PUT(252,25),MOON5,PSET:GOTO 1230
1219 PUT(268,25),MOON6,PSET:GOTO 1230
1220 PUT(268,25),MOON7,PSET:GOTO 1230
1221 PUT(266,25),MOON8,PSET:GOTO 1230
1222 PUT(252,25),MOON9,PSET:GOTO 1230
1223 PUT(252,25),MOON10,PSET:GOTO 1230
1224 PUT(252,25),MOON11,PSET:GOTO 1230
1230 LOCATE 10,31:PRINT INT(T!*365.25)
1240 GOSUB 590:IF K$=Z$ THEN 380
1250 IF FL THEN 1240
1260 IF K$="+" AND M!<.006 THEN M!=M!+M!
1270 T!=T!+M!:GOTO 1130
1280 GOSUB 570:PX=0:PY=0
1290 CLS:PRINT T$(3):GOSUB 570
1300 PRINT"Eccentricity(0-0.96)? ";:LINE(176,16)-(183,23),3,BF:GOSUB 480:IF FNCAP$(K$)=Z$ THEN 380
1310 PRINT K$;:IF K$=CHR$(13) THEN K$="0":E$="" ELSE INPUT "",E$
1320 E!=VAL(K$+E$):IF E!<0 OR E!>.96 OR LEN(K$)=0 THEN 1280
1330 FL=1:IF FNCAP$(RIGHT$(K$+E$,1))="R" THEN FL=-1
1340 CLS:PRINT T$(3):GOSUB 570
1350 PRINT"Eccentricity = ";:IF E!=0 THEN PRINT"0" ELSE PRINT K$+E$
1360 LOCATE 3,28:IF E!>0 THEN PRINT"Accelerating"
1370 M!=.01:T!=0:F!=65*SA!:G!=65*FL
1380 PUT(82,98),WHITE2:PUT(O,0),WHITE
1390 A!=(T!-INT(T!))*PP!:Z!=1+E!*COS(A!)
1410 X=INT(83+(E!+(E!+COS(A!))/Z!)*F!):Y=INT(99+(E!*E!-1)*SIN(A!)/Z!*G!)
1420 J=INT(A!/PI!):IF PX<>X OR PY<>Y THEN PUT(PX,PY),WHITE:PUT(X,Y),WHITE:PX=X:PY=Y
1430 IF E!>.1 THEN LOCATE 3,28:PRINT P$(J)
1440 K$=FNCAP$(INKEY$):IF K$=Z$ THEN 1280
1450 T!=T!+M!:GOTO 1390
1470 CLS:PRINT T$(4)" Menu":LOCATE 5,1
1480 GOSUB 570:LOCATE 5,1
1490 PRINT" S Sun":PRINT" M Moon"
1500 FOR J=1 TO 9:PRINT J;N$(J):NEXT
1510 LOCATE 5,1:FOR J=0 TO 10
1520 LOCATE ,20:PRINT CHR$(J+65)" "F$(J):NEXT
1530 GOSUB 480:IF K$=Z$ THEN 380
1540 IF K$="S" THEN K=0:GOTO 1600
1550 IF K$="M" THEN K=10:GOTO 1600
1560 IF K>0 AND K<10 THEN 1600
1570 K=ASC(K$)-65:IF K<0 OR K>10 THEN 1530
1580 GOTO 1730
1600 CLS:PRINT N$(K);
1610 H=4:IF K=0 OR K=10 THEN PRINT:GOTO 1630
1620 H=10:PRINT" Planet #"K"from sun"
1630 PRINT:FOR J=0 TO H
1640 PRINT F$(J)TAB(19)Z$(K,J)TAB(29)U$(J)
1650 NEXT:IF K<10 THEN 1680
1660 PRINT"Dist. from earth"TAB(20)"243000 Miles"
1670 PRINT F$(9)TAB(20)"6 Months"
1680 PRINT:IF K<4 OR K=10 THEN 1770
1690 FOR J=1 TO Z!(K,10):C=INT((J-1)/7)+1
1700 L=14+J-C*7:LOCATE L,C*13
1710 PRINT M$(K,J):NEXT:GOTO 1770
1730 CLS:PRINT F$(K)TAB(20)U$(K)
1740 L=0:H=10:IF K>4 THEN L=1:H=9
1750 LOCATE 6,1:FOR J=L TO H
1760 PRINT N$(J)TAB(19)Z$(J,K):NEXT
1770 LOCATE 24,1:PRINT"Press any key to continue.";:WHILE INKEY$="":WEND:GOTO 1470
1771 FOR I=0 TO 12:FOR J=0 TO 1:Y1=113-((J=0)*2+1)*(12-I):Y2=Y1+40:LINE(MX(0,I),Y1)-(31-MX(0,I),Y1),K:LINE(MX(0,I)+40,Y1)-(12-MX(1,I)+55,Y1),K
1772 LINE(MX(0,I)+80,Y1)-(13-MX(2,I)+95,Y1),K:LINE(MX(0,I)+120,Y1)-(135,Y1),K:LINE(MX(0,I)+160,Y1)-(160+MX(2,I),Y1),K
1773 LINE(MX(0,I)+200,Y1)-(200+MX(1,I),Y1),K:LINE(31-MX(1,I)+40,Y2)-(31-MX(0,I)+40,Y2),K:LINE(31-MX(2,I)+80,Y2)-(31-MX(0,I)+80,Y2),K:LINE(16+120,Y2)-(31-MX(0,I)+120,Y2),K
1774 LINE(MX(2,I)+163,Y2)-(31-MX(0,I)+160,Y2),K:LINE(MX(1,I)+203,Y2)-(31-MX(0,I)+200,Y2),K
1775 NEXT J,I:RETURN
2380 DATA Diameter,Miles
2390 DATA 864000,3100,7700,7926
2400 DATA 4200,88000,71000,32000
2410 DATA 31000,1500,2160
2420 DATA Mass,(Earth=1)
2430 DATA 332830,0.055,0.815,1
2440 DATA 0.107,318,95.2,14.5
2450 DATA 17.2,0.01,0.012
2460 DATA Density,(Water=1)
2470 DATA 1.4,5.4,5.2,5.5,3.9,1.3
2480 DATA 0.7,1.2,1.7,1.4,3.4
2490 DATA Rotation Period,Earthdays
2500 DATA 25,58.9,243,1,1.03,0.404
2510 DATA 0.444,0.67,0.77,6.39,27.3
2520 DATA Temperature,Fahrenheit
2530 DATA 10000,620,900,72,-10,-240
2540 DATA -300,-340,-370,-400,-10
2550 DATA Distance from Sun,Mill. Miles
2560 DATA 36,67.2,92.9,142,483
2570 DATA 887,1783,2795,3670
2580 DATA Length of Year,Earthyears
2590 DATA 0.241,0.615,1,1.88,11.86
2600 DATA 29.46,84,164,248
2610 DATA Orbit Speed,MPH
2620 DATA 107000,78000,66000,54000
2630 DATA 29000,22000,15000,12000,10000
2640 DATA Axis Tilt,Degrees
2650 DATA 0,179,23.5,25,3.1
2660 DATA 26.7,97.9,28.8,0
2670 DATA Drivetime(55 MPH),Years
2680 DATA 75,139,193,295,1002
2690 DATA 1840,3698,5797,7612
2700 DATA Moons,-
2710 DATA 0,0,1,2,16,17,5,3,1
2720 DATA Sun,Mercury,Venus,Earth,Mars,Phobos,Deimos
2730 DATA Jupiter,Metis,Adrastrea,Amalthea,Thebe,Io,Europa,Ganymede,Callisto
2740 DATA Leda,Himalia,Lysithea,Elara,Ananke,Carme,Pasiphae,Sinope
2750 DATA Saturn,Atlas,X,X,Janus,Epimetheus,Mimas,Enceladus,Tethys,Telesto
2760 DATA Calypso,Dione,X,Rhea,Titan,Hyperion,Iapetus,Phoebe
2770 DATA Uranus,Miranda,Ariel,Umbriel,Titania,Oberon
2780 DATA Neptune,Triton,Nereid,X,Pluto,Charon,Moon
2790 DATA 198,255,351,285,249,180,204,227,173