home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Loadstar 163
/
163.d81
/
sunup-down
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-08-26
|
5KB
|
201 lines
5 poke55,.:poke56,56:clr
6 dv=peek(186):ifdv<8thendv=8
7 poke53280,.:poke53281,.:print"[147]"
14 poke53272,31:poke53371,0
16 ad=49152
17 sysad:sysad+12
19 gosub235
20 print"[147]":sysad+9,0
52 bs$="[159][164][157][164][157][164][157][164][157][164][157][164][157][164][157][164][157][164][157][164][157][164][157][164][157][164][157][164][157][164][157][164][157][164][157][164][157][164][157][164][157][164][157][164]"
55 bd=53280:bg=53281
56 rm$(1)="[206].[197]ast":rm$(2)="[196]ue [197]ast":rm$(3)="[211].[197]ast"
57 rm$(4)="[211].[215]est":rm$(5)="[196]ue [215]est":rm$(6)="[206].[215]est"
58 su$="[158][167][168]"
59 print"[147]":sysad+9,1
60 print"[159][220][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][221]"
61 printbs$"";tab(38)bs$
62 print"[159][255][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][161]"
64 print""tab(14)"[150][211][213][206][213][208]-[211][213][206][196][207][215][206]"
65 print:printtab(6)"[158][197]nter [204]atitude [219]: ";:l9%=7:gosub730:b5=q9
67 sysad+9,2
70 printtab(6)"[158][197]nter [204]ongitude [219]: ";:l9%=7:gosub730:l5=q9
72 sysad+9,2
75 printtab(6)"[158][212]ime [218]one (hrs): ";:l9%=2:gosub730:h=q9
77 sysad+9,2
80 l5=l5/360:z0=h/24
85 gosub650:poke214,10:print:printtab(8)"[159][201]s this [195]orrect? (y[159]/n[159])":poke198,.
86 gosub772
87 ifhc$="n"then52
88 sysad+9,2
89 t=(j-2451545)+f
90 tt=t/36525+1:rem tt=centuries
95 rem from 1900.0
100 gosub290:t=t+z0
110 rem get sun's postion
115 gosub530:a(1)=a5:d(1)=d5
120 t=t+1
125 gosub530:a(2)=a5:d(2)=d5
130 ifa(2)<a(1)then a(2)=a(2)+p2
135 z1=dr*90.833:rem zeith distance
140 s=sin(b5*dr):c=cos(b5*dr)
145 z=cos(z1):m8=0:w8=0:printtab(1)"[156][145][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162]"
147 sysad+9,3
150 a0=a(1):d0=d(1)
155 da=a(2)-a(1):dd=d(2)-d(1)
160 forc0=0to23
165 p=(c0+1)/24
170 a2=a(1)+p*da:d2=d(1)+p*dd
175 gosub330
180 a0=a2:d0=d2:v0=v2
185 next
190 gosub490:rem special mags?
191 ifqm=3andqd=20thengosub810
192 ifqm=6andqd=21thengosub820
193 ifqm=9andqd=22thengosub830
194 ifqm=12andqd=21thengosub840
195 gosub3000
200 goto52
235 rem constants
240 dim a(2),d(2)
245 p1=(NULL):p2=2*p1
250 dr=p1/180:k1=15*dr*1.0027379
255 s$="[153] [211]undown at (hrs:mins):"
260 r$="[153] [211]unup at (hrs:mins):"
265 m1$="[150] [206]o [211]unup this date! "
270 m2$="[150] [206]o [211]undown this date! "
275 m3$="[155] [211]un down all day! "
280 m4$="[158] [211]un up all day! "
285 return
290 rem lst at 0hr zone time
295 t0=t/36525
300 s=24110.5+8640184.813*t0
305 s=s+86636.6*z0+86400*l5
310 s=s/86400:s=s-int(s)
315 t0=s*360*dr
320 return
330 rem test an hour for an event
335 l0=t0+c0*k1:l2=l0+k1
340 h0=l0-a0:h2=l2-a2
345 h1=(h2+h0)/2:rem hour angle
350 d1=(d2+d0)/2:rem declination
355 rem at half hour
360 ifc0>0then370
365 v0=s*sin(d0)+c*cos(d0)*cos(h0)-z
370 v2=s*sin(d2)+c*cos(d2)*cos(h2)-z
375 ifsgn(v0)=sgn(v2)then485
380 v1=s*sin(d1)+c*cos(d1)*cos(h1)-z
385 a=2*v2-4*v1+2*v0:b=4*v1-3*v0-v2
390 d=b*b-4*a*v0:ifd<0then485
395 d=sqr(d)
400 ifv0<0andv2>0thenprinttab(3)r$
405 ifv0<0andv2>0thenm8=1
410 ifv0>0andv2<0thenprinttab(3)s$
415 ifv0>0andv2<0thenw8=1
420 e=(-b+d)/(2*a)
425 ife>1ore<0thene=(-b-d)/(2*a)
430 t3=c0+e+1/120:rem round off
435 h3=int(t3):m3=int((t3-h3)*60)
440 printtab(16)h3":";m3
445 h7=h0+e*(h2-h0)
450 n7=-cos(d1)*sin(h7)
455 d7=c*sin(d1)-s*cos(d1)*cos(h7)
460 az=atn(n7/d7)/dr
465 ifd7<0thenaz=az+180
470 ifaz<0thenaz=az+360
475 ifaz>360thenaz=az-360
480 printtab(3)"[153][193]zimuth :[158]";az"[219]":gosub775
481 printtab(26)"[145][153]"rm$(pv);" "su$:sysad+9,3
485 return
490 rem special message routine
495 ifm8=0andw8=0then515
500 ifm8=0thenprinttab(6)m1$
505 ifw8=0thenprinttab(6)m2$
510 goto525
515 ifv2<0thenprinttab(6)m3$
520 ifv2>0thenprinttab(6)m4$
525 return
530 rem fundamental arguments
535 rem van flandern &
540 rem pulkkinen, 1979
545 l=.779072+.00273790931*t
550 g=.993126+.0027377785*t
555 l=l-int(l):g=g-int(g)
560 l=l*p2:g=g*p2
565 v=.39785*sin(l)
570 v=v-.01000*sin(l-g)
575 v=v+.00333*sin(l+g)
580 v=v-.00021*tt*sin(l)
585 u=1-.03349*cos(g)
590 u=u-.00014*cos(2*l)
595 u=u+.00008*cos(l)
600 w=-.00010-.04129*sin(2*l)
605 w=w+.03211*sin(g)
610 w=w+.00104*sin(2*l-g)
615 w=w-.00035*sin(2*l+g)
620 w=w-.00008*tt*sin(g)
625 rem compute sun's ra & dec
630 s=w/sqr(u-v*v)
635 a5=l+atn(s/sqr(1-s*s))
640 s=v/sqr(u):d5=atn(s/sqr(1-s*s))
645 return
650 rem calendar-----jd
655 print:printtab(6)"[158][197]nter [217]ear: ";:l9%=4:gosub730:y=q9
657 sysad+9,2
660 printtab(6)"[158][197]nter [205]onth: ";:l9%=2:gosub730:m=q9:qm=q9
662 ifm<0orm>12thenprint"[145][145]":goto660
663 sysad+9,2
665 printtab(6)"[158][197]nter [196]ay: ";:l9=2:gosub730:d=q9:qd=q9
667 ifd<0ord>31thenprint"[145][145]":goto665
668 sysad+9,2
670 g=1:ify<1583theng=0
675 d1=int(d):f=d-d1-.5
680 j=-int(7*(int((m+9)/12)+y)/4)
685 ifg=0then705
690 s=sgn(m-9):a=abs(m-9)
695 j3=int(y+s*int(a/7))
700 j3=-int((int(j3/100)+1)*3/4)
705 j=j+int(275*m/9)+d1+g*j3
710 j=j+1721027+2*g+367*y
715 iff>0then725
720 f=f+1:j=j-1
725 return
730 q9$="":poke198,.
735 geta$
740 poke646,rnd(1)*15+1:print"*[157]";:ifa$=""then735
745 ifa$=chr$(13)thenprint" ":q9=val(q9$):return
750 if(a$=chr$(20)andlen(q9$))thenq9$=left$(q9$,len(q9$)-1):goto771
755 iflen(q9$)>=l9%thensysad+9,3:goto735
760 if(a$>="0"anda$<="9")ora$="."then765
762 goto735
765 q9$=q9$+a$
770 print""a$;:goto735
771 print" [157][157] [157]";:goto735
772 gethc$:ifhc$<>"y"andhc$<>"n"then772
773 return
775 ifaz<90thenpv=1
776 ifaz<90thenpv=1
780 ifaz>=90andaz<91thenpv=2
785 ifaz>91andaz<180thenpv=3
790 ifaz>180andaz<270thenpv=4
795 ifaz>=270andaz<271thenpv=5
800 ifaz>271andaz<300thenpv=6
805 return
810 printtab(6)"[214]ernal [197]quinox - [211]pringtime!"
815 return
820 printtab(6)"[211]ummer [211]olstice - [211]ummertime!"
825 return
830 printtab(6)"[193]utumnal [197]quinox - [201]t's [198]all!"
835 return
840 printtab(5)"[215]inter [211]olstice - [215]intertime!"
845 return
3000 poke214,19:print:printtab(8)"[150](1[150]) [195]alculate another
3010 [153][163]8)"def(2def) (NULL)o (NULL)(NULL)right$(NULL)val(NULL)(NULL)val (NULL)enu
3020 poke198,0
3030 geta$:ifa$<"1"ora$>"2"then3030
3040 ifa$="1"thenreturn
3050 sysad+15
3060 print"[147]load"chr$(34)"b.universe"chr$(34)","dv
3070 print"run28"
3080 poke631,13:poke632,13:poke198,2:end
10000 d=peek(186):n$="sunup-down":open15,d,15,"s0:"+n$:close15:saven$,d:end