Source Code
2 REM Moon Phase Calculator
4 REM \* 1985 I. Auersbacher
8 BORDER 5: GO TO 1000
10 IF yr>y THEN GO TO 9000
12 IF yr<y THEN RETURN
15 LET f=24*f: LET h=INT f
20 LET n=INT (60*(f-h)): IF m>mn THEN PRINT #4: LET mn=m
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;CHR$ (g+143);" ";p$(9*g-8 TO 9*g);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
50 BEEP 0.05,22: LET j=(y-1900)*12.3685: LET j=INT j: LET mn=1
52 PRINT #4;"Moon Phase ";TAB 11;" Date of Event ";TAB 26;" Time ": PRINT #4;"\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''":
55 LET k=j: LET g=1: GO SUB 100: GO SUB 150: GO SUB 300: GO SUB 10: LET k=j+0.25: LET g=2
60 GO SUB 100: GO SUB 200: GO SUB 300: GO SUB 10: LET k=j+0.5: LET g=3: GO SUB 100: GO SUB 150
65 GO SUB 300: GO SUB 10: LET k=j+0.75: LET g=4: GO SUB 100: GO SUB 200: GO SUB 300: GO SUB 10
70 LET j=j+1: GO TO 55
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.0004*SIN (3*n)+0.0104*SIN (2*f)-0.0051*SIN (m+n)-0.0074*SIN (m-n)+0.0004*SIN (2*f+m)-0.0004*SIN (2*f-m)-0.0006*SIN (2*f+n)+0.0010*SIN (2*f-n)+0.0005*SIN (m+2*n)
160 LET jd=jd+c+0.5: RETURN
200 LET c=(0.1721-0.0004*t)*SIN m+0.0021*SIN (2*m)-0.628*SIN n+0.0089*SIN (2*n)-0.0004*SIN (3*n)+0.0079*SIN (2*f)-0.0119*SIN (m+n)-0.0047*SIN (m-n)+0.0003*SIN (2*f+m)-0.0004*SIN (2*f-m)-0.0006*SIN (2*f+n)+0.0021*SIN (2*f-n)+0.0003*SIN (m+2*n)+0.0004*SIN (m-2*n)-0.0003*SIN (2*m+n)
210 IF g=2 THEN LET c=c+0.0028-0.0004*COS m+0.0003*COS n
220 IF g=4 THEN LET c=c-0.0028+0.0004*COS m-0.0003*COS n
230 LET jd=jd+c+0.5: 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
1000 LET d$="SuMoTuWeThFrSa"
1010 LET m$="Jan.Feb.Mar.Apr.May Jun.Jul.Aug.Sep.Oct.Nov.Dec."
1020 LET n$="00010203040506070809101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960"
1025 LET p$="New Moon 1st. Qtr Full Mn. Last Qtr "
1030 BEEP 0.05,22: BEEP 0.06,20: POKE 23609,10: RESTORE 2000
1040 FOR m=0 TO 7: READ n,f,t,c: POKE USR "a"+m,n: POKE USR "b"+m,f: POKE USR "c"+m,t: POKE USR "d"+m,c: NEXT m
1050 RESTORE 2100: FOR m=0 TO 7: READ n,f: POKE USR "e"+m,n: POKE USR "f"+m,f: NEXT m
1100 BORDER 5: PAPER 3: CLS
1150 PRINT PAPER 6;AT 2,3;"\:'\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\':";AT 3,3;"\: Moon Phase Calculator \ :";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,-20: 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$ 148; INK 6;CHR$ 149
1230 PAUSE 70: 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,60,0,60,60,98,60,70,126,241,66,143,126,241,66,143,126,241,66,143,126,241,66,143,60,98,60,70,0,60,0,60
2100 DATA 0,24,0,48,127,96,127,255,127,255,115,248,115,248,127,240
3000 SAVE "moon" LINE 8: STOP
9000 LPRINT : LPRINT : LPRINT : CLOSE #4: BEEP .2,25: BEEP .2,20
