Source Code
2 REM Solar/ Lunar Eclipses
4 REM \* 1985 I. Auersbacher
5 DEF FN d(x)=INT (1000*x+0.5)/1000
8 BORDER 5: GO TO 1000
10 IF yr>y THEN GO TO 9000
11 RETURN
12 PRINT #4;"________________________________": PRINT #4: RETURN
15 LET f=24*f: LET h=INT f
20 LET n=INT (60*(f-h))
25 LET t$=n$(2*h+1 TO 2*h+2)+":"+n$(2*n+1 TO 2*n+2): LET d=z+1.0: LET d=d-(7*INT (d/7))+1
30 PRINT #4;"Date: ";d$(2*d-1 TO 2*d);" ";m$(4*m-3 TO 4*m);n$(2*dy+1 TO 2*dy+2);",";yr;" ";t$
35 RETURN
40 LET f=24*f: LET h=INT f
42 LET n=INT (60*(f-h))
44 LET t$=n$(2*h+1 TO 2*h+2)+":"+n$(2*n+1 TO 2*n+2)
46 PRINT #4;t$;" GMT"
48 RETURN
50 BEEP 0.05,22: LET j=(y-1900)*12.3685: LET j=INT j: LET mn=1
52 PRINT #4;" Solar/Lunar Eclipses ";y: PRINT #4;"\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''":
54 LET k=j: GO SUB 100
55 IF ABS (SIN f)>0.359 THEN GO TO 72
56 GO SUB 200: IF ABS g>(1.5432+u) THEN GO TO 72
57 GO SUB 150: GO SUB 300: GO SUB 10: IF yr<y THEN GO TO 72
58 PRINT #4;" *** SOLAR ECLIPSE ***": IF ABS g>=0.9972 THEN GO TO 68
59 PRINT #4;"Central Eclipse - ";
60 IF u<0 THEN PRINT #4;" Total ":: GO SUB 15:: GO SUB 500: GO SUB 12: GO TO 72
62 IF u>0.0047 THEN PRINT #4;"Annular":: GO SUB 15: GO SUB 500: GO SUB 12: GO TO 72
64 LET w=0.00464*COS (ASN g)
65 IF u<w THEN PRINT #4;"Annular/Total":: GO SUB 15: GO SUB 500: GO SUB 12: GO TO 72
66 PRINT #4;" Annular ":: GO SUB 15: GO SUB 500: GO SUB 12: GO TO 72
68 PRINT #4;"Partial Eclipse of the SUN":: GO SUB 15
70 LET m1=(1.5432+u-ABS g)/(0.5460+2*u): LET m1=INT (1000*m1+0.5)/1000
71 PRINT #4;"Maximum Magnitude= ";m1: GO SUB 500: GO SUB 12
72 LET k=j+0.5: GO SUB 100
73 IF ABS (SIN f)>0.359 THEN GO TO 94
74 GO SUB 200: LET m1=(1.0129-u-ABS g)/0.5450: LET m2=(1.5572+u-ABS g)/0.5450: IF (m1<0)*(m2<0) THEN GO TO 94
75 LET m1=FN d(m1): LET m2=FN d(m2): GO SUB 150: GO SUB 300: GO SUB 10: IF yr<y THEN GO TO 94
76 PRINT #4;"LUNAR ECLIPSE - ";: IF m1<0 THEN GO TO 88
78 PRINT #4;" (Umbral) "
79 IF m1<=1.00 THEN LET m2=m1: GO TO 90
80 PRINT #4;"Total Eclipse of the MOON": LET w=n: GO SUB 15
82 PRINT #4;"Maximum Magnitude= ";m1: GO SUB 600
86 GO SUB 12: GO TO 94
88 PRINT #4;"(Penumbral)"
90 PRINT #4;"Partial Eclipse of the Moon": GO SUB 15
92 PRINT #4;"Maximum Magnitude= ";m2
93 GO SUB 12
94 LET j=j+1: GO TO 54
100 LET t=k/1236.85
110 LET t2=t*t: LET t3=t*t*t
120 LET jd=2415020.75933+29.53058868*k+(0.0001178*t*t-1.55e-7*t*t*t+0.00033*SIN (2.90702+2.31902*t-1.601e-4*t*t))
130 LET m=6.269645+5.079842936e-1*k-5.81195e-7*t2-6.05629e-8*t3
135 LET n=5.341149+6.733775529*k+1.872843e-4*t2+2.157227e-7*t3
140 LET f=0.3716923+6.818486627*k-2.88468e-5*t2-4.1713e-8*t3
145 RETURN
150 LET c=(.1734-.000393*t)*SIN m+0.0021*SIN (2*m)-0.4068*SIN n+0.0161*SIN (2*n)-0.0104*SIN (2*f)-0.0051*SIN (m+n)-0.0074*SIN (m-n)
160 LET jd=jd+c+0.5: RETURN
200 LET s=5.19595-0.0048*COS m+0.0020*COS (2*m)-0.3283*COS n-0.0060*COS (m+n)+0.0041*COS (m-n)
210 LET c=0.2070*SIN m+0.0024*SIN (2*m)-0.0390*SIN n+0.0115*SIN (2*n)-0.0073*SIN (m+n)-0.0067*SIN (m-n)+0.0117*SIN (2*f)
220 LET g=s*SIN f+c*COS f
230 LET u=0.0059+0.0046*COS m-0.0182*COS n+0.0004*COS (2*n)-0.0005*COS (m+n)
240 RETURN
300 LET z=INT jd: LET f=jd-z
310 IF z<2299161 THEN LET a=z
320 IF z>=2299161 THEN LET a=INT ((z-1867216.25)/36524.25): LET a=z+1+a-INT (a/4)
330 LET b=a+1524: LET c=INT ((b-122.1)/365.25): LET d=INT (365.25*c): LET e=INT ((b-d)/30.6001)
340 LET dy=b-d-INT (30.6001*e)
350 LET m=e-1-12*(e>=13.5)
360 LET yr=c-4716+1*(m<2.5)
370 RETURN
500 PRINT #4;"Visible ";
510 IF g>0.25 THEN PRINT #4;"northern hemisphere": RETURN
520 IF g<-0.25 THEN PRINT #4;"southern hemisphere": RETURN
530 PRINT #4;"equatorial regions"
540 RETURN
600 LET p=1.0129-u: LET t=0.4679-u: LET n=0.5458+0.04*COS w
605 IF t*t-g*g<=0 THEN RETURN
608 IF p*p-g*g<=0 THEN RETURN
610 LET pp=SQR (p*p-g*g)/24/n
620 LET tp=SQR (t*t-g*g)/24/n
630 PRINT #4: LET t=jd: LET jd=t-pp: GO SUB 300: PRINT #4;" Start partial: ";: GO SUB 40
640 LET jd=t-tp: GO SUB 300: PRINT #4;" Start - total: ";: GO SUB 40: LET jd=t: GO SUB 300
650 PRINT #4;" Max. eclipse : ";: GO SUB 40: LET jd=t+tp: GO SUB 300: PRINT #4;" End of total : ";: GO SUB 40: LET jd=t+pp
660 GO SUB 300: PRINT #4;" End - partial: ";: GO SUB 40
670 RETURN
1000 LET d$="SuMoTuWeThFrSa"
1010 LET m$="Jan.Feb.Mar.Apr.May Jun.Jul.Aug.Sep.Oct.Nov.Dec."
1020 LET n$="00010203040506070809101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960"
1030 BEEP 0.05,22: BEEP 0.06,20: POKE 23609,10: RESTORE 2000
1040 FOR m=0 TO 7: READ n,f: POKE USR "a"+m,n: POKE USR "b"+m,f: NEXT m
1100 BORDER 5: PAPER 3: CLS
1150 PRINT PAPER 6;AT 2,3;"\:'\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\':";AT 3,3;"\: Solar & Lunar Eclipses \ :";AT 4,3;"\: \ :";AT 5,3;"\: \* 1985 I. Auersbacher \ :";AT 6,3;"\:.\..\..\..\..\..\..\..\..\..\..\..\..\..\..\..\..\..\..\..\..\..\..\..\..\.:"
1155 PLOT 0,0: DRAW 0,175: DRAW 255,0: DRAW 0,-175: DRAW -255,0
1160 PRINT PAPER 7;AT 8,4;"Enter Year:";
1165 INPUT y: IF y<1000 OR y>4000 THEN BEEP 1.5,-22: GO TO 1165
1170 PRINT PAPER 6;" ";y;" "
1180 PAUSE 30: PRINT PAPER 6;AT 10,4;"Output to which device? "
1190 PRINT PAPER 7;AT 12,9;"1-TV Screen ";AT 13,9;"2-TS Printer"
1195 PAUSE 30: PRINT PAPER 6;AT 15,4;"Please pick option (1-2)"
1200 LET q$=INKEY$: IF q$="" THEN GO TO 1200
1210 LET t=CODE q$-48: IF (t<1)+(t>2) THEN BEEP 0.5,-15: BEEP 0.6,-20: GO TO 1200
1220 BEEP .05,22: PRINT INK 0;AT 11+t,6;CHR$ 144; INK 6;CHR$ 145
1230 PAUSE 75: IF t=1 THEN OPEN #4,"s": PAPER 7: CLS : GO TO 50
1300 OPEN #4,"p": PRINT FLASH 1; PAPER 7;AT 18,4;" See printer for output ": GO TO 50
2000 DATA 0,24,0,48,127,96,127,255,127,255,115,248,115,248,127,240
3000 SAVE "eclipse" LINE 8:
3100 STOP : STOP
9000 LPRINT : LPRINT : LPRINT : CLOSE #4: BEEP .2,22: BEEP .2,20
