04_Planetarium.bc3

1000 A=250:GOTO20:REM PLANETARIUM
1010 P1=3.1415927:TP=2*P1:RD=180/P1:VR=VE:HR=HO
1020 HS=1/HG:VS=1/VG
1030 DIMM$(12),RA(110),DE(110),B(12),HO(7),VE(7)
1040 DIML(5,1),A(5),E(5),I(5),KK(5,1),M(5,1),PL$(7)
1050 GOSUB100:SR$="BASICODE PLANETARIUM"
1060 GOSUB150:PRINT:PRINT
1070 PRINT"Wilt u uitleg? (J/N) ";:GOSUB210:PRINTIN$
1080 IFIN=74 THENGOSUB6010:GOTO1510
1090 IFIN<>78 THEN1070
1100 READA$:IFA$<>"" THEN1100
1500 REM ** INITIALISATIE ARRAYS **
1510 GOSUB100:PRINT"Even geduld..."
1520 FORI=1 TO12:READM$(I):NEXTI
1530 FORI=1 TO110:READRA(I):NEXTI
1540 FORI=1 TO110:READDE(I):NEXTI
1550 FORI=1 TO12:READB(I):NEXTI
1560 FORI=1 TO5
1570 READL0,L1,A(I),E(I),I0,K0,K1,M0,M1
1580 L(I,0)=L0/RD:L(I,1)=L1/RD:I(I)=I0/RD
1590 KK(I,0)=K0/RD:KK(I,1)=K1/RD:M(I,0)=M0/RD:M(I,1)=M1/RD
1600 NEXTI
1610 FORI=1 TO7:READPL$(I):NEXTI
2000 GOSUB100:PRINT"Geef de dag van de maand: ";
2010 INPUTDA:IF(DA<1) OR(DA>31) THEN2000
2020 PRINT:PRINT"Geef de maand (1-12): ";
2030 INPUTMA:IF(MA<1) OR(MA>12) THEN2020
2040 PRINT:PRINT"Geef het jaar: ";:INPUTJR
2050 PRINT:PRINT"Geef de tijd (0.00-23.59): ";
2060 INPUTTY:IF(TY<0) OR(TY>24) THEN2050
2070 UR=INT(TY):MI=INT((TY-INT(TY))*100+.5)
2080 IFMI>59 THEN2050
2090 REM
2100 REM **TEKEN  STERRENKAART**
2110 REM
2120 GOSUB600
2130 CN=0:HM=1-HS:RR=.2025
2140 FORY=.2/VG TO.45 STEP1/VG
2150 X=SQR(RR-Y*Y)*.75
2160 HO=0:VE=Y+.5:GOSUB620:HO=.5-X:GOSUB630
2170 HO=.5+X:GOSUB620:HO=HM:GOSUB630
2180 HO=0:VE=.5-Y:GOSUB620:HO=.5-X:GOSUB630
2190 HO=.5+X:GOSUB620:HO=HM:GOSUB630
2200 NEXTY
2210 SR$="NOORD":HO=.4375:VE=0:GOSUB650
2220 SR$="ZUID":HO=.45:VE=.959:GOSUB650
2230 SR$="OOST":HO=.025:VE=.5:CN=1:GOSUB650
2240 SR$="WEST":HO=.875:GOSUB650
2250 REM
2260 REM ***********************
2270 REM *   COORDINATEN VAN   *
2280 REM *  WAARNEMINGSPLAATS  *
2290 REM * EVENTUEEL AANPASSEN *
2300 REM * AAN EIGEN OMGEVING  *
2310 REM ***********************
2320 REM
2330 REM GEOGRAFISCHE BREEDTE VOOR HILVERSUM:
2340 B=52.2
2350 REM
2360 REM GEOGRAFISCHE LENGTE VOOR HILVERSUM:
2370 L=5.16666667
2380 REM
2390 SP=SIN(B/RD):CP=COS(B/RD)
2400 ZO=1:REM  TIJDZONE
2410 IF(MA>3) AND(MA<10) THENZO=2:REM  ZOMERTIJD 1/4-1/10
2420 H=UR+MI/60-ZO
2430 REM ** BEREKEN T IN EEUWEN VANAF 1900 **
2440 M1=MA:Y1=JR:IFM1<3 THENM1=M1+12:Y1=Y1-1
2450 B=0:IFJR<1582 THEN2500
2460 IFJR>1582 THEN2490
2470 IFMA<10 THEN2500
2480 IF(MA=10) AND(DA<15) THEN2500
2490 A=INT(Y1/100):B=2-A+INT(A/4)
2500 T=INT(365.25*Y1)+INT(30.6001*(M1+1))+B+DA-694025.5+H/24
2510 T=T/36525
2520 REM LOKALE STERRENTIJD BEPAALT
2530 REM STAND VAN DE STERRENHEMEL
2540 REM
2550 GS=6.6460656+2400.051262*T+H+L/15
2560 GS=GS-24*INT(GS/24):GS=GS*P1/12
2570 REM ** BEREKEN POSITIE ZON **
2580 LS=279.69668+36000.76892*T:MS=358.47583+35999.04975*T
2590 LS=(LS-360*INT(LS/360))/RD:MS=(MS-360*INT(MS/360))/RD
2600 E=.01675104
2610 A=1:M=MS:GOSUB4120:LS=LS+V-MS:RS=R
2620 LA=LS:BE=0:GOSUB4220:GOSUB4310
2630 HO(1)=HO:VE(1)=VE:CN=0:GOSUB4410
2640 REM ** BEREKEN POSITIE MAAN **
2650 LA=270.434164+481267.8831*T:M=296.104608+477198.8491*T
2660 D=350.737486+445267.1142*T:F=11.250889+483202.0251*T
2670 LA=LA-360*INT(LA/360):M=(M-360*INT(M/360))/RD
2680 D=(D-360*INT(D/360))/RD:F=(F-360*INT(F/360))/RD
2690 LA=LA+6.28875*SIN(M)+1.274018*SIN(2*D-M)
2700 LA=LA+.658309*SIN(2*D)+.213616*SIN(2*M)
2710 LA=LA-.185596*SIN(MS)-.114336*SIN(2*F)
2720 BE=5.128189*SIN(F)+.280606*SIN(M+F)
2730 BE=BE+.277693*SIN(M-F)+.173238*SIN(2*D-F)
2740 LA=LA/RD:BE=BE/RD:GOSUB4220:GOSUB4310
2750 HO(2)=HO:VE(2)=VE:GOSUB4410
2760 REM ** BEREKEN POSITIE PLANETEN **
2770 FORI=1 TO5
2780 L=L(I,0)+T*L(I,1):L=L-TP*INT(L/TP)
2790 A=A(I):E=E(I):IN=I(I):KK=KK(I,0)+T*KK(I,1)
2800 M=M(I,0)+T*M(I,1):M=M-TP*INT(M/TP)
2810 GOSUB4120:U=L+V-M-KK:SU=SIN(U)
2820 N=COS(IN)*SU:D=COS(U):GOSUB4010:L=KK+AR
2830 SB=SU*SIN(IN):B=ATN(SB/SQR(1-SB*SB))
2840 RC=R*COS(B)
2850 N=RC*SIN(L-LS):D=RC*COS(L-LS)+RS:GOSUB4010
2860 LA=LS+AR:DL=SQR(N*N+D*D+(R*SB)^2)
2870 SB=SB*R/DL:BE=ATN(SB/SQR(1-SB*SB)):GOSUB4220
2880 GOSUB4310:HO(I+2)=HO:VE(I+2)=VE:GOSUB4410
2890 NEXTI
2900 REM ** PLOT DE STERREN **
2910 BT=1:FORI=1 TO110
2920 BR=0:IFI=B(BT) THENBR=1:BT=BT+1
2930 RA=RA(I):DE=DE(I):GOSUB4310:IFHO<0 THEN2950
2940 GOSUB620:IFBR=1 THENHO=HO+HS:GOSUB620
2950 NEXTI
2960 SR=DA:GOSUB300:DA$=SR$:SR=JR:GOSUB300
2970 SR$=DA$+" "+M$(MA)+" "+SR$
2980 HO=0:VE=.9:CN=1:GOSUB650
2990 SR=UR:GOSUB300:UR$=SR$+"h"
3000 SR=MI:GOSUB300:IFMI<10 THENSR$="0"+SR$
3010 SR$=UR$+SR$+"m":HO=.825:VE=.9:GOSUB650
3020 HO=.45:VE=.959:CN=1:SR$="ZUID":GOSUB650
3030 HO=0:VE=.959:CN=0:SR$="1 t/m 7 of S: ":GOSUB650
3040 GOSUB210:IFIN=83 THEN3220
3050 PL=IN-48:IF(PL<1) OR(PL>7) THEN3040
3060 CN=1:GOSUB650
3070 IFHO(PL)<0 THEN3190
3080 SR$=PL$(PL):CN=0:GOSUB650
3090 FORI=1 TO5
3100 HO=HO(PL):VE=VE(PL):CN=1:GOSUB4410
3110 SD=5
3120 GOSUB450:IFSD>0 THEN3120
3130 HO=HO(PL):VE=VE(PL):CN=0:GOSUB4410
3140 SD=5
3150 GOSUB450:IFSD>0 THEN3150
3160 NEXTI
3170 HO=0:VE=.959:CN=1:SR$=PL$(PL):GOSUB650
3180 GOTO3030
3190 SR$=PL$(PL)+" IS ONDER DE HORIZON":CN=0:GOSUB650
3200 SD=20:GOSUB450
3210 CN=1:GOSUB650:GOTO3030
3220 CN=1:GOSUB650
3230 CN=0:SR$="Nog een keer? (J/N):":GOSUB650
3240 GOSUB210:IFIN=74 THEN2000
3250 IFIN<>78 THEN3240
3260 GOTO950
4000 REM ** ARCTAN (N/D) IN JUISTE KWADRANT **
4010 AR=ATN(N/D):IFD<0 THENAR=AR+P1
4020 IFAR<0 THENAR=AR+TP
4030 RETURN
4100 REM ** MIDDELBARE NAAR WARE ANOMALIE **
4110 REM    (CENTRUMVERGELIJKING)
4120 E2=E*E:E3=E2*E
4130 V=M+(2*E+E3/4)*SIN(M)+1.25*E2*SIN(2*M)
4140 V=V+13/12*E3*SIN(3*M)
4150 R=A*(1-E2)/(1+E*COS(V))
4160 RETURN
4200 REM ASTR. LENGTE EN BREEDTE
4210 REM NAAR RECHTE KLIMMING EN DECLINATIE
4220 SE=.3979486:CE=.9174077
4230 SL=SIN(LA):SB=SIN(BE):CB=COS(BE)
4240 N=SL*CE-SB/CB*SE:D=COS(LA):GOSUB4010:RA=AR
4250 SD=SB*CE+CB*SE*SL:DE=ATN(SD/SQR(1-SD*SD))
4260 RETURN
4300 REM ** BEREKEN HO EN VE VOOR STERRENKAART **
4310 HA=GS-RA:SD=SIN(DE):CD=COS(DE)
4320 CZ=SP*SD+CP*CD*COS(HA)
4330 IFCZ<=0 THENHO=-1:VE=-1:RETURN
4340 Z1=P1/2-ATN(CZ/SQR(1-CZ*CZ)):Z=Z1*.9/P1
4350 X=Z*CD*SIN(HA)/SIN(Z1)
4360 Y=SQR(ABS(Z*Z-X*X))
4370 IFSD>SP*CZ THENY=-Y
4380 HO=X*.75+.5:VE=Y+.5
4390 RETURN
4400 REM ** PLOT ZON/MAAN/PLANEET **
4410 IFHO<0 THENRETURN
4420 GOSUB620:HO=HO+HS:GOSUB620
4430 VE=VE-VS:GOSUB620:HO=HO-HS:GOSUB620
4440 RETURN
4500 REM ** WACHT OP TOETS **
4510 HO=0:VE=VR:GOSUB110:PRINT"Toets voor vervolg >";
4520 GOSUB210:GOSUB100:RETURN
6000 REM ** UITLEG OP SCHERM **
6010 GOSUB100
6020 SR$="BASICODE PLANETARIUM"
6030 GOSUB150:PRINT:PRINT
6040 RT=2:P$=""
6050 IFLEN(P$)>HR THEN6110
6060 READR$:IFR$="" THENGOSUB4510:RETURN
6070 IFLEFT$(R$,1)<>"." THEN6090
6080 GOSUB6160:P$=RIGHT$(R$,LEN(R$)-1):GOTO6050
6090 IFP$="" THENP$=R$:GOTO6050
6100 P$=P$+" "+R$:GOTO6050
6110 L=HR+1
6120 IFMID$(P$,L,1)<>" " THENL=L-1:GOTO6120
6130 R$=RIGHT$(P$,LEN(P$)-L):P$=LEFT$(P$,L-1)
6140 GOSUB6160:P$=R$:GOTO6050
6150 REM ** PRINT P$ OP SCHERM **
6160 PRINTP$:RT=RT+1:IFRT<VR-1 THENRETURN
6170 GOSUB4510:RT=0:RETURN
25000 DATA"Een grafisch programma in BASICODE-3.",". "
25010 DATA".Dit programma tekent voor een door u te bepalen"
25020 DATA"datum en tijd een ronde sterrenkaart op het"
25030 DATA"scherm. Op deze kaart bevinden zich niet alleen"
25040 DATA"sterren, maar ook de Zon, de Maan en de planeten"
25050 DATA"Mercurius t/m Saturnus!",". "
25060 DATA".U kunt opvragen waar de Zon, de Maan of een"
25070 DATA"planeet staat, door na het tekenen van de kaart"
25080 DATA"een cijfer 1 t/m 7 in te toetsen. Daarbij staat"
25090 DATA"het cijfer 1 voor de Zon, 2 voor de Maan, 3 voor"
25100 DATA"Mercurius, 4 voor Venus, enzovoort t/m 7 voor"
25110 DATA"Saturnus. (Alleen de met het blote oog zichtbare"
25120 DATA"planeten worden getoond)."
25130 DATA".De opgegeven planeet zal dan gaan knipperen,"
25140 DATA"als hij tenminste boven de horizon is!"
25150 DATA"Indien u hier de letter S toetst, verlaat u de"
25160 DATA"sterrenkaart en kunt u een nieuwe datum"
25170 DATA"invoeren."
25180 DATA". ",".Langs de randen van de kaart is de horizon"
25190 DATA"aangegeven. Het midden van de kaart komt overeen"
25200 DATA"met het zenit, dat is het punt dat recht boven u"
25210 DATA"ligt."
25220 DATA".Hoe dichter een hemellichaam dus bij de rand"
25230 DATA"van de kaart staat, hoe lager dit in"
25240 DATA"werkelijkheid aan de hemel staat."
25250 DATA".Bedenk wel dat u de kaart in een keer kunt"
25260 DATA"overzien maar de komplete sterrenhemel niet!"
25270 DATA". ",".De kaart toont de sterren tot aan"
25280 DATA"magnitude 3, dat zijn de sterren die normaal in"
25290 DATA"de stad zichtbaar zijn."
25300 DATA".De heldere sterren zijn afgebeeld als twee"
25310 DATA"puntjes naast elkaar op de kaart, de Zon, Maan"
25320 DATA"en planeten als vier puntjes naast elkaar."
25330 DATA". ",".Veel plezier!"
25340 DATA". ",""
25350 REM **MAANDNAMEN**
25360 DATA"jan","feb","mrt","apr","mei","jun"
25370 DATA"jul","aug","sep","okt","nov","dec"
25380 REM
25390 REM COORDINATEN VAN STERREN
25400 REM 110 X RECHTE KLIMMING IN RADIALEN
25410 REM
25420 DATA.03,.04,.17,.19,.3,.58,.54,.55,.6,.79
25430 DATA.82,.89,1.20,1.37,1.38,1.41,1.42,1.44,1.46,1.48
25440 DATA1.51,1.55,1.56,1.67,1.73,1.76,1.98,2,2.03,2.47
25450 DATA2.65,2.88,2.89,2.94,3.09,3.11,3.37,3.5,3.51,3.61
25460 DATA3.73,3.89,4.08,4.19,4.3,4.35,4.49,4.6,4.7,4.87
25470 DATA5.19,5.33,5.41,5.43,5.58,5.69,6.03,6.04
25480 DATA.05,.24,.37,.50,.56,.80,.97,.99,1.02,1.03
25490 DATA1.03,1.29,1.31,1.34,1.43,1.45,1.46,1.47,1.56,1.67
25500 DATA1.95,2.12,2.55,2.70,3.21,3.27,3.29,3.32,3.38,3.41
25510 DATA3.64,3.80,3.86,3.88,4.00,4.12,4.21,4.25,4.29,4.32
25520 DATA4.37,4.58,4.64,4.99,5.01,5.17,5.17,5.63,5.70,5.78
25530 DATA5.94,3.21
25540 REM
25550 REM 110 X DECLINATIE IN RADIALEN
25560 REM
25570 DATA.51,1.03,.99,-.32,.62,1.56,.74,.41,-0.05,.07
25580 DATA.71,.87,.29,-.14,.8,.11,.5,-.01,-.02,-.03
25590 DATA-.17,.13,.78,-.31,.29,-.29,.56,.09,.49,-.15
25600 DATA.21,.99,1.08,.36,.26,.94,.98,.96,-.19,.86
25610 DATA.34,1.3,.47,-.39,-.46,-.18,-.27,.22,.9,.68
25620 DATA.15,.7,.79,0.59,1.09,0.17,0.49,0.26
25630 DATA.26,1.06,1.05,.36,.61,.93,.83,.42,.56,.70
25640 DATA-.24,.58,.76,-.09,-.36,-.31,-.10,.37,.65,.39
25650 DATA.15,-.42,.42,.35,-.30,-.29,-.41,-.02,.67,.19
25660 DATA.32,.67,.47,-.28,-.16,.11,-.34,-.06,1.07,.38
25670 DATA.55,.91,.08,.24,-.37,.79,.18,-.10,-.28,-.01
25680 DATA.53,1.00
25690 REM
25700 REM NUMMERS VAN DE 11 HELDERSTE STERREN
25710 REM
25720 DATA13,14,15,22,26,28,39,41,45,50,51,200
25730 REM
25740 REM ** PLANEETBAAN-ELEMENTEN **
25750 REM 2X MIDDELBARE LENGTE, HALVE LANGE AS
25760 REM EXCENTRICITEIT, INCLINATIE
25770 REM 2X LENGTE KLIMMENDE KNOOP
25780 REM 2X MIDDELBARE ANOMALIE
25790 REM
25800 REM MERCURIUS
25810 DATA178.179078,149474.07078,.3870986
25820 DATA.20561421,7.002881,47.145944,1.1852083
25830 DATA102.27938,149472.51529
25840 REM VENUS
25850 DATA342.767053,58519.21191,.7233316
25860 DATA.00682069,3.393631,75.779647,.8998500
25870 DATA212.60322,58517.80387
25880 REM MARS
25890 DATA293.737334,19141.69551
25900 DATA1.5236883,.09331290,1.850333
25910 DATA48.786442,.7709917
25920 DATA319.51913,19139.85475
25930 REM JUPITER
25940 DATA238.049257,3036.301986
25950 DATA5.202561,.04833475,1.308736
25960 DATA99.443414,1.0105300
25970 DATA225.32833,3034.69202
25980 REM SATURNUS
25990 DATA266.564377,1223.509884
26000 DATA9.554747,.05589232,2.492519
26010 DATA112.790414,.8731951
26020 DATA175.46622,1221.55147
26030 REM ** PLANEETNAMEN **
26040 DATA"ZON","MAAN","MERCURIUS","VENUS"
26050 DATA"MARS","JUPITER","SATURNUS"
26060 REM
30000 REM *********************
30010 REM *                   *
30020 REM *     BASICODE      *
30030 REM *    PLANETARIUM    *
30040 REM *                   *
30050 REM *********************
30060 REM
30070 REM De meeste formule zijn afkomstig uit
30080 REM "ASTRONOMICAL FORMULAE FOR CALCULATORS"
30090 REM van JEAN MEEUS (WILLMANN-BELL,1982)
30100 REM
30110 REM Voor optimale snelheid zijn de meeste
30120 REM berekeningen vereenvoudigd, zodat de
30130 REM nauwkeurigheid veelal niet beter is
30140 REM dan 1 graad. Dit is echter ruim
30150 REM voldoende voor deze sterrenkaart.
30160 REM
32000 REM ************************
32010 REM *                      *
32020 REM *    JAN BREDENBEEK    *
32030 REM * DIEPENDAALSELAAN 255 *
32040 REM *  1214 KD  HILVERSUM  *
32050 REM *                      *
32060 REM *      VERSIE 3.0      *
32070 REM *   27 DECEMBER 1987   *
32080 REM *                      *
32090 REM * SINCLAIR ZX SPECTRUM *
32100 REM *                      *
32110 REM ************************