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