home *** CD-ROM | disk | FTP | other *** search
/ Commodore Disk User Volume 1 #5 / Commodore_Disk_User_Vol.1_5_1988_-.d64 / orrery (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  13KB  |  407 lines
  1. 1000 rem orrery 88
  2. 1010 rem 8/1/88 program- david cook
  3. 1020 rem -epoch 1988-
  4. 1030 rem most formulae based on- pract
  5. 1040 rem astronomy with your calculator
  6. 1050 rem by  p d-smith
  7. 1060 rem*******************************
  8. 1070 gosub3510:rem setup
  9. 1080 gosub4980:rem co-ordinates
  10. 1090 gosub1410:rem date
  11. 1100 gosub1540:rem time
  12. 1110 gosub1650:rem julian day
  13. 1120 gosub1770:rem sidereal time
  14. 1130 gosub1880:rem obliquity
  15. 1140 gosub1940:rem anomaly
  16. 1150 gosub2140:rem jup/sat peturbation
  17. 1160 gosub1910:rem radius vector
  18. 1170 gosub2210:rem heliocent ecliptic
  19. 1180 gosub2330:rem geocentric ecliptic
  20. 1190 gosub2550:rem ecliptc to equatorl
  21. 1200 gosub2490:rem solar elongation
  22. 1210 gosub2670:rem horizon co-ordinates
  23. 1220 gosub2970:rem rise and set
  24. 1230 gosub4080:rem printout strings
  25. 1240 gosub4380:rem printout
  26. 1250 gosub3170:rem menu
  27. 1260 ifzz$="d"thengoto1090:rem new date
  28. 1270 ifzz$="t"thenprint"[147]":goto1100:rem new time
  29. 1280 ifzz$="s"thengosub3450:gosub3310:goto1110:rem step day/time
  30. 1290 ifzz$="1"thenfl=1:gosub4380:rem go to 1st p/o
  31. 1300 ifzz$="2"thenfl=2:gosub4380:rem go to 2nd p/o
  32. 1310 ifzz$="3"thenfl=3:gosub4380:rem go to 3rd p/o
  33. 1320 ifzz$="i"thenfl=4:gosub4380:rem go to 4th p/o
  34. 1330 ifzz$="p"thengosub3140:gosub4380:gosub3150
  35. 1340 ifzz$="k"thengosub4720:goto1240:rem display key
  36. 1350 ifzz$="m"thengosub4800:goto1240:rem display map
  37. 1360 ifzz$="c"thengosub4990:gosub1770:goto1190:rem change co-ordinates
  38. 1370 ifzz$="b"thenstop
  39. 1380 goto1250
  40. 1390 end
  41. 1400 rem*******************************
  42. 1410 rem enter date
  43. 1420 print"[147]"
  44. 1430 print"year  ";right$(s$+ya$,5);:z$="":inputz$:ifz$<>""thenya$=z$
  45. 1440 print"month ";right$(s$+ma$,5);:z$="":inputz$:ifz$<>""thenma$=z$
  46. 1450 print"day   ";right$(s$+da$,5);:z$="":inputz$:ifz$<>""thenda$=z$
  47. 1460 ya=val(ya$):ma=val(ma$):da=val(da$)
  48. 1470 x1=int(da):x2=da-x1:gm=int(x2*2400+.5)/100
  49. 1480 de$=str$(x1):db$=right$(s$+de$,len(de$)-1):dc$=str$(fng(x2))
  50. 1490 ifgm>0thent$=str$(gm):gm$=str$(fng(gm)):x0=gm:gosub2780:t1$=h$
  51. 1500 ifgm>0thenprint"[145]day          ";db$;"  ";"(";dc$;")";"         "
  52. 1510 dt$=db$+"/"+ma$+"/"+ya$
  53. 1520 return
  54. 1530 :
  55. 1540 rem enter time
  56. 1550 print:print"dec hrs      ";gm$:print"or"
  57. 1560 print"hh*mm*ss     ";t1$
  58. 1570 print"(e.g":print"02*08*00)"
  59. 1580 print:print"time         ";gm$;
  60. 1590 z$="":inputz$:ifz$<>""thent$=z$
  61. 1600 ift$=""thent$="0"
  62. 1610 gm=val(t$):ifmid$(t$,3,1)<>"*"thengoto1630
  63. 1620 gm=gm+val(mid$(t$,4,2))/60+val(right$(t$,len(t$)-6))/3600
  64. 1630 x0=gm:gosub2780:t1$=h$:gm$=str$(fng(gm)):return
  65. 1640 :
  66. 1650 rem julian day sub
  67. 1660 prints3$;s1$;"jul day";
  68. 1670 yd=ya:mc=ma:ifmc<3thenyd=yd-1:mc=mc+12
  69. 1680 x1=int(365.25*yd):x2=int(30.6001*(mc+1))
  70. 1690 jn=x1+x2+da+1720994.5:jp=0
  71. 1700 ifjn>2299171thenx4=int(yd/100):jp=2-x4+int(x4/4):jn=jn+jp
  72. 1710 jy=jp+int(365.25*(ya-1))+1721422.5
  73. 1720 jd=jn+gm/24:dn=jd-jy:je=jd-epoch:jc=(jd-k1)/k2:yc=(jy-k1)/k2
  74. 1730 x5=(jn+1.5)/7:x6=int((x5-int(x5))*7+.5)
  75. 1740 d1$=d$(x6)
  76. 1750 return
  77. 1760 :
  78. 1770 rem sidereal time
  79. 1780 x1=o3+o4*yc+o5*yc^2:b1=24-(x1-24*(yd-1900)):x2=o0*int(dn)-b1
  80. 1790 gs=gm*o1+x2:ifgs>24thengs=gs-24
  81. 1800 ifgs<0thengs=gs+24
  82. 1810 x0=gs:gosub2780:gs$=h$
  83. 1820 ls=gs+lo/15:ifls>24thenls=ls-24
  84. 1830 ifls<0thenls=ls+24
  85. 1840 lm=gm+lo/15:iflm>24thenlm=lm-24
  86. 1850 iflm<0thenlm=lm+24
  87. 1860 return
  88. 1870 :
  89. 1880 rem obliquity sub
  90. 1890 x1=l7-(l4*jc+l5*jc^2-l6*jc^3)/3600:ob=x1*rd:return
  91. 1900 :
  92. 1910 rem radius vector
  93. 1920 fora=0to9:rv(a)=ra(a)*(1-ec(a)^2)/(1+ec(a)*cos(an(a))):nexta:return
  94. 1930 :
  95. 1940 rem anomaly sub
  96. 1950 prints3$;s1$;"anomally";
  97. 1960 fora=0to9:printa;
  98. 1970 le=le(a):lp=lp(a):ec=ec(a)
  99. 1980 x1=w4*je/365.2422/tp(a):x2=abs(x1):x3=(x2/w4-int(x2/w4))*w4
  100. 1990 ifx1<0thenx3=w4-x3
  101. 2000 am=x3+le-lp:ifam<0thenam=am+w4
  102. 2010 ifam>w4thenam=am-w4:rem orbital position
  103. 2020 :
  104. 2030 rem solve kepler
  105. 2040 x5=am
  106. 2050 x6=x5-ec*sin(x5)-am
  107. 2060 ifabs(x6)>1e-6thenx9=x6/(1-ec*cos(x5)):x5=x5-x9:goto2050
  108. 2070 x7=((1+ec)/(1-ec))^.5*tan(x5/2)
  109. 2080 an=atn(x7)*2:rem anomaly
  110. 2090 pa=an+lp:ifpa>w4thenpa=pa-w4
  111. 2100 ifpa<0thenpa=pa+w4
  112. 2110 an(a)=an:pa(a)=pa:rem anomaly & orbital longitude
  113. 2120 nexta:return
  114. 2130 :
  115. 2140 rem jup/sat peturbation
  116. 2150 x2=jc/5+.1:x3=(k3+k4*jc)*rd:x4=(k5+k6*jc)*rd:x5=5*x4-2*x3:x6=x4-x3
  117. 2160 pj=(m0-m8*x2)*sin(x5)-m2*x2*cos(x5):pa(5)=pa(5)+pj*rd
  118. 2170 x8=-l0*sin(2*x6)+l1*sin(x6)*cos(x4)+l2*cos(x6)*sin(x4)
  119. 2180 x7=(m9*x2-m4)*cos(x5)+(m5*x2-m6)*sin(x5)-m7*cos(x6)
  120. 2190 ps=x7+x8:pa(6)=pa(6)+ps*rd:return
  121. 2200 :
  122. 2210 rem h/c ecliptic sub
  123. 2220 prints3$;s1$;"heliocentric";
  124. 2230 fora=1to9:printa;:ifa=3thennexta
  125. 2240 rv=rv(a):in=in(a):ln=ln(a):pa=pa(a):an=an(a)
  126. 2250 x1=sin(pa-ln)*sin(in):qb=fns(x1):rem ecliptic lat
  127. 2260 x2=sin(pa-ln)*cos(in):x3=cos(pa-ln):x4=atn(x2/x3):gosub2860
  128. 2270 pb=x6+ln(a):ifpb>w4thenpb=pb-w4:rem h/c ecliptic long
  129. 2280 rp(a)=rv*cos(qb):rem proj radius
  130. 2290 ds(a)=(rv(3)^2+rv^2-2*rv(3)*rv*cos(pa-pa(3)))^.5:rem planet distance
  131. 2300 pb(a)=pb:qb(a)=qb
  132. 2310 nexta:ds(0)=rv(0):return
  133. 2320 :
  134. 2330 rem geo/c ecliptic sub
  135. 2340 prints3$;s1$;"geocentric";
  136. 2350 fora=1to9:printa;:ifa=3thennexta
  137. 2360 x1=pb(a)-pa(3):ifa>3thengoto2410
  138. 2370 x2=rp(a)*sin(-x1):x3=rv(3)-rp(a)*cos(-x1):x4=atn(x2/x3):gosub2860
  139. 2380 pc=w2+pa(3)+x6:ifpc>w4thenpc=pc-w4:rem inner planet g/c ecliptic long
  140. 2390 ifpc<0thenpc=pc+w4
  141. 2400 goto2440
  142. 2410 x2=rv(3)*sin(x1):x3=rp(a)-rv(3)*cos(x1):x4=atn(x2/x3):gosub2860
  143. 2420 pc=pb(a)+x6:ifpc>w4thenpc=pc-w4:rem outer planet
  144. 2430 ifpc<0thenpc=pc+w4
  145. 2440 x5=rp(a)*tan(qb(a))*sin(pc-pb(a)):x7=rv(3)*sin(x1)
  146. 2450 qc(a)=atn(x5/x7):pc(a)=pc
  147. 2460 ds(a)=ds(a)/cos(qc(a)):dk(a)=ds(a)*au:rem better value for distance
  148. 2470 nexta:pc(0)=pa(0):dk(0)=ds(0)*au:return
  149. 2480 :
  150. 2490 rem solar elongation
  151. 2500 prints3$;s1$;"elongation";
  152. 2510 fora=1to9:printa;:ifa=3thennexta
  153. 2520 se(a)=fnc(sin(qd(a))*sin(qd(0))+cos(pd(a)-pa(0))*cos(qd(0))*cos(qd(a)))
  154. 2530 nexta:return
  155. 2540 :
  156. 2550 rem    ecliptic to equatorial sub
  157. 2560 prints3$;s1$;"equatorial";
  158. 2570 fora=0to9:printa;:ifa=3thennexta
  159. 2580 x2=sin(pc(a))*cos(ob)-tan(qc(a))*sin(ob):x3=cos(pc(a)):x4=atn(x2/x3)
  160. 2590 gosub2860:pd=x6:rem rt ascension
  161. 2600 x7=sin(qc(a))*cos(ob)+cos(qc(a))*sin(ob)*sin(pc(a)):qd=fns(x7):rem decinatn
  162. 2610 gosub2920:rem precession
  163. 2620 x0=pd/rd/15:gosub2780:aa$(a)=h$:rem to hh/mm/ss
  164. 2630 x0=qd/rd:gosub2780:dd$(a)=h$:rem to deg/mm/ss
  165. 2640 pd(a)=pd:qd(a)=qd
  166. 2650 nexta:return
  167. 2660 :
  168. 2670 rem horizon coordinates
  169. 2680 prints3$;s1$;"horizon";
  170. 2690 lz=la*rd
  171. 2700 fora=0to9:printa;:ifa=3thennexta
  172. 2710 qd=qd(a):ha=ls-pd(a)/rd/15:ifha<0thenha=ha+24
  173. 2720 ha(a)=ha
  174. 2730 ha=ha*15*rd:x5=sin(qd)*sin(lz)+cos(qd)*cos(lz)*cos(ha):qf(a)=fns(x5)
  175. 2740 x6=(sin(qd)-sin(lz)*x5)/(cos(lz)*cos(qf(a))):pf(a)=fnc(x6)
  176. 2750 ifsin(ha)>0thenpf(a)=w4-pf(a)
  177. 2760 nexta:return
  178. 2770 :
  179. 2780 rem rt asc to hours/min
  180. 2790 xs$="":ifx0<0thenxs$="-":x0=abs(x0)
  181. 2800 x1=int(x0):x1$=right$(str$(x1),len(str$(x1))-1)
  182. 2810 x2=(x0-x1)*60:x3=int(x2):x3$=right$(str$(x3),len(str$(x3))-1)
  183. 2820 x4=int((x2-x3)*60):x4$=right$(str$(x4),len(str$(x4))-1)
  184. 2830 h$=xs$+x1$+"*"+x3$+"*"+x4$
  185. 2840 return
  186. 2850 :
  187. 2860 rem remove atan ambiguity
  188. 2870 ifx2>0andx3>0thenx6=x4:return
  189. 2880 ifx2>0andx3<0thenx6=x4+(NULL):return
  190. 2890 ifx2<0andx3<0thenx6=x4+(NULL):return
  191. 2900 ifx2<0andx3>0thenx6=x4+w4:return
  192. 2910 :
  193. 2920 rem precession sub
  194. 2930 x3=sin(pd):x4=cos(pd):x5=tan(qd)
  195. 2940 ac=(k7+k8*x3*x5)*je/365.2422/3600*15*rd:dc=k9*x4*je/365.2422/3600*rd
  196. 2950 pd=pd+ac:qd=qd+dc:return
  197. 2960 :
  198. 2970 rem rise/set sub
  199. 2980 prints3$;s1$;"rise/set";
  200. 2990 fora=0to9:printa;:ifa=3thennexta
  201. 3000 x1=sin(qd(a))/cos(lz):ar(a)=fnc(x1):as(a)=w4-ar(a):rem rise/set azim
  202. 3010 x2=-tan(lz)*tan(qd(a))
  203. 3020 x7=pd(a)/15/rd:x3=fnc(x2)/15/rd:x4=24+x7-x3:ifx4>24thenx4=x4-24
  204. 3030 x5=x7+x3:ifx5>24thenx5=x5-24
  205. 3040 g3(a)=x4:g4(a)=x5:nexta:rem now convt to gmt from gst
  206. 3050 :
  207. 3060 rem sidereal to gmt
  208. 3070 x2=o0*int(dn)-b1:ifx2<0thenx2=x2+24
  209. 3080 fora=0to9:ifa=3thennexta
  210. 3090 x3=g3(a)-x2:ifx3<0thenx3=x3+24
  211. 3100 x4=g4(a)-x2:ifx4<0thenx4=x4+24
  212. 3110 gu(a)=x3*o2:gd(a)=x4*o2
  213. 3120 nexta:return
  214. 3130 :
  215. 3140 open3,4:cmd3:return
  216. 3150 print#3:close3:return
  217. 3160 :
  218. 3170 rem menu sub
  219. 3180 prints4$;"change date  <d>","key          <k>
  220. 3190 [153]"change time  <t>","break        <b>
  221. 3200 print"step day/time<s>","printer      <p>
  222. 3210 [139]fl[178]4[167][153]"other p/o's  <1,2 or 3>":[137]3260
  223. 3220 [139]fl[178]1[167][153]"2nd  p/o     <2>":[153]"3rd  p/o     <3>"
  224. 3230 [139]fl[178]2[167][153]"1st  p/o     <1>":[153]"3rd  p/o     <3>"
  225. 3240 [139]fl[178]3[167][153]"1st  p/o     <1>":[153]"2nd  p/o     <2>
  226. 3250 print"intermediate <i>
  227. 3260 [153]"map(100-260) <m>","cnge lat/lon <c>
  228. 3270 :
  229. 3280 getzz$:ifzz$=""thengoto3280
  230. 3290 return
  231. 3300 :
  232. 3310 rem day to date
  233. 3320 x1=int(jd+.5):x2=jd+.5-x1
  234. 3330 ifx1>2299160thenx3=int((x1-1867216.25)/36524.25):x1=x1+1+x3-int(x3/4)
  235. 3340 x5=x1+1524:x6=int((x5-122.1)/365.25)
  236. 3350 x7=int(x6*365.25):x8=int((x5-x7)/30.6001):x9=x5-x7+x2-int(x8*30.6001)
  237. 3360 da=int(x9):gm=24*(x9-da):da$=str$(da):da$=right$(da$,len(da$)-1)
  238. 3370 x0=gm:gosub2780:t$=h$:gm$=str$(fng(gm))
  239. 3380 ma=x8-13:ifx8<14thenma=x8-1
  240. 3390 ma$=str$(ma):ma$=right$(ma$,len(ma$)-1)
  241. 3400 ya=x6-4715:ifma>2thenya=ya-1
  242. 3410 ya$=str$(ya):ya$=right$(ya$,len(ya$)-1)
  243. 3420 dt$=da$+"/"+ma$+"/"+ya$
  244. 3430 return
  245. 3440 :
  246. 3450 rem step day/time
  247. 3460 print"day   <d>":print"time  <t>  ";
  248. 3470 getzy$:ifzy$<>"d"andzy$<>"t"thengoto3470
  249. 3480 ifzy$="d"theninput"day step ";d2:jd=jd+d2:return
  250. 3490 ifzy$="t"theninput"time step (dec hrs) ";t2:jd=jd+t2/24:return
  251. 3500 :
  252. 3510 rem setup
  253. 3520 print"[147]running"
  254. 3530 dimky$(18)
  255. 3540 x1=0:x2=0:x3=0:x4=0:x5=0:x6=0:x7=0:x8=0:x9=0
  256. 3550 rd=(NULL)/180:rem deg/rad
  257. 3560 epoch=2447160.5:au=149600000
  258. 3570 fl=1:rem printout flag
  259. 3580 s3$="                                        ":s1$=""
  260. 3590 s4$="":s$="               ":bl$="  ---- "
  261. 3600 la=53.85:lo=1.53:rem lat:long leeds england
  262. 3610 data"sun0",1.00004,278.8924,282.781,.016706,.999991,0,0
  263. 3620 data"mer1",.24085,309.2256,77.266,.20563,.387098
  264. 3630 data7.0048,48.188
  265. 3640 data"ven2",.61521,357.2711,131.31,.006754,.723328
  266. 3650 data3.3946,76.571
  267. 3660 data"ear3",1.00004,98.8924,102.781,.016706,.999991,0,0
  268. 3670 data"mar4",1.88089,217.6568,335.799,.093332,1.523747
  269. 3680 data1.8499,49.468
  270. 3690 data"jup5",11.86224,29.9214,15.496,.048164,5.20303
  271. 3700 data1.3051,100.367
  272. 3710 data"sat6",29.45771,263.1975,91.459,.054031,9.52933
  273. 3720 data2.4865,113.555
  274. 3730 data"ura7",84.01247,261.8052,170.370,.045869,19.1867
  275. 3740 data.7731,73.989
  276. 3750 data"nep8",164.79558,278.7169,36.26,.009974,30.0882
  277. 3760 data1.7698,131.682
  278. 3770 data"plu9",250.9,221.4127,224.133,.246241,39.341,17.142,110.144
  279. 3780 data"sunday","monday","tuesday","wednesday","thursday","friday","saturday"
  280. 3790 data"   azm=azimuth","   alt=altitude","   raz=rising azimuth"
  281. 3800 data"   saz=seting azimuth","   rse=rise time (decimal)","   set=set time"
  282. 3810 data"  dist=distance from earth in au's"
  283. 3820 data"dis-km=distance from earth in kms
  284. 3830 [131]" rtasc=right ascension","declin=declination"
  285. 3840 [131]"   hra=hour angle","   sel=solar elongation","   rvc=radius vector"
  286. 3850 [131]"orb-lo=orbital longitude","hel-lo=heliocentric longitude"
  287. 3860 [131]"hel-la=heliocentric latitude"
  288. 3870 [131]"geo-lo=geocentric longitude","geo-la=geocentric latitude"
  289. 3880 [143] constants for jup/sat peturbation,pression,obliquity,sidereal time
  290. 3890 k1[178]2415020:k2[178]36525:k3[178]237.47555:k4[178]3034.9061:k5[178]265.9165:k6[178]1222.1139
  291. 3900 k7[178]3.07383:k8[178]1.336:k9[178]20.04
  292. 3910 m0[178].3314:m2[178].06444:m4[178].0105:m5[178].0182:m6[178].8142:m7[178].1488:m8[178].0103:m9[178].1609
  293. 3920 l0[178].0408:l1[178].0856:l2[178].0813:l4[178]46.845:l5[178].0059:l6[178].00181:l7[178]23.452294
  294. 3930 o0[178].0657098:o1[178]1.002738:o2[178].99727:o3[178]6.6460656:o4[178]2400.051262:o5[178].00002581
  295. 3940 w1[178][255][173]2:w2[178][255]:w4[178]2[172][255]
  296. 3950 [150][165]s(x)[178][193](x[173][186]([171]x[172]x[170]1)):[143] sin-1
  297. 3960 [150][165]c(x)[178][171][193](x[173][186]([171]x[172]x[170]1))[170][255][173]2:[143] cos-1
  298. 3970 [150][165]d(x)[178][181](x[172]10[174]de[170].5)[173]10[174]de
  299. 3980 [150][165]e(x)[178][181](x[170].5)
  300. 3990 [150][165]f(x)[178][181](x[172]100[170].5)[173]100
  301. 4000 [150][165]g(x)[178][181](x[172]1000[170].5)[173]1000
  302. 4010 [129]a[178]0[164]9:[135]p$(a),tp(a),le,lp,ec(a),ra(a),in,ln
  303. 4020 le(a)[178]le[172]rd:lp(a)[178]lp[172]rd:in(a)[178]in[172]rd:ln(a)[178]ln[172]rd
  304. 4030 [130]a
  305. 4040 [129]j[178]0[164]6:[135]d$(j):[130]j
  306. 4050 [129]j[178]1[164]18:[135]ky$(j):[130]j:[143] index
  307. 4060 [142]
  308. 4070 :
  309. 4080 [143] printout strings
  310. 4090 [153]s3$;s1$;"p/o strings";
  311. 4100 [129]a[178]0[164]9:[153]a;:[139]a[178]3[167][130]a
  312. 4110 de[178]0
  313. 4120 az$(a)[178][201](s$[170][196]([165]d(pf(a)[173]rd)),4[170]de):[143] azimuth
  314. 4130 al$(a)[178][201](s$[170][196]([165]d(qf(a)[173]rd)),4[170]de):[143] altitude
  315. 4140 zr$(a)[178][201](s$[170][196]([165]d(ar(a)[173]rd)),4[170]de):[143] azimuth at rise
  316. 4150 zs$(a)[178][201](s$[170][196]([165]d(as(a)[173]rd)),4[170]de):[143] azimuth at set
  317. 4160 de[178]1
  318. 4170 rt$(a)[178][201](s$[170][196]([165]d(gu(a))),4[170]de):[143] rise time (decimal hours)
  319. 4180 st$(a)[178][201](s$[170][196]([165]d(gd(a))),4[170]de):[143] set time (decimal hours)
  320. 4190 se$(a)[178][201](s$[170][196]([165]d(se(a)[173]rd)),4[170]de[170]1):[143] solar elongation
  321. 4200 ha$(a)[178][201](s$[170][196]([165]d(ha(a))),4[170]de):[143] hour angle
  322. 4210 pa$(a)[178][201](s$[170][196]([165]d(pa(a)[173]rd)),4[170]de[170]2):[143] orb posit
  323. 4220 pb$(a)[178][201](s$[170][196]([165]d(pb(a)[173]rd)),4[170]de[170]2):[143] heliocentric long
  324. 4230 pc$(a)[178][201](s$[170][196]([165]d(pc(a)[173]rd)),4[170]de[170]2):[143] geocentric long
  325. 4240 de[178]2
  326. 4250 ds$(a)[178][201](s$[170][196]([165]d(ds(a))),4[170]de):[143] distance from earth
  327. 4260 qb$(a)[178][201](s$[170][196]([165]d(qb(a)[173]rd)),4[170]de[170]1):[143] heliocentric lat
  328. 4270 qc$(a)[178][201](s$[170][196]([165]d(qc(a)[173]rd)),4[170]de[170]1):[143] geocentric lat
  329. 4280 rv$(a)[178][201](s$[170][196]([165]d(rv(a))),4[170]de):[143] radius vector
  330. 4290 as$(a)[178][201](s$[170][196]([165]d(pd(a)[173]rd)),4[170]de):[143] right ascension (degrees)
  331. 4300 de$(a)[178][201](s$[170][196]([165]d(qd(a)[173]rd)),4[170]de):[143] declination (decimal degs)
  332. 4310 aa$(a)[178][201](s$[170]aa$(a)[170]" ",11):[143] rt asc in hours/min
  333. 4320 dd$(a)[178][201](s$[170]dd$(a)[170]" ",11):[143] decl in deg/min
  334. 4330 [130]a
  335. 4340 pa$(0)[178][201](s$[170][196]([165]d(pa(0)[173]rd)),4[170]3):[143] earth orb posit
  336. 4350 pa$(3)[178][201](s$[170][196]([165]d(pa(3)[173]rd)),4[170]3):[143] earth orb posit
  337. 4360 [142]
  338. 4370 :
  339. 4380 [143] printout 1
  340. 4390 [153]"load";dt$;"  ";t$;"gmt  ";gs$;"gst
  341. 4400 printd1$;"      day no.";jd
  342. 4410 print"the position of the planets from "
  343. 4420 iffg<>0thengoto4440
  344. 4430 print"leeds "
  345. 4440 print"lat=";la;"lon=";lo;"dec-deg"
  346. 4450 iffl=2thengoto4530
  347. 4460 iffl=3thengoto4590
  348. 4470 iffl=4thengoto4650
  349. 4480 print"    ";" azm";" alt";" raz";" saz";"  rse";"  set";"  dist"
  350. 4490 fora=0to9:ifa=3thennexta
  351. 4500 printp$(a);az$(a);al$(a);zr$(a);zs$(a);rt$(a);st$(a);ds$(a)
  352. 4510 nexta
  353. 4520 return
  354. 4530 rem more p/o 2
  355. 4540 print"    ";" rtasc";"      "," declin"
  356. 4550 fora=0to9:ifa=3thennexta
  357. 4560 printp$(a);as$(a);aa$(a);de$(a);dd$(a)
  358. 4570 nexta
  359. 4580 return
  360. 4590 rem more p/o 3
  361. 4600 print"    ";"  hra";"   sel";"   rvc";" dis-km"
  362. 4610 fora=0to9:ifa=3thennexta
  363. 4620 printp$(a);ha$(a);se$(a);rv$(a);dk(a)
  364. 4630 nexta
  365. 4640 return
  366. 4650 rem more p/o 4
  367. 4660 print"    ";" orb-lo";" hel-lo";" hel-la";" geo-lo";" geo-la"
  368. 4670 fora=0to9:ifa=3ora=0thenpb$(a)=bl$:qb$(a)=bl$:pc$(a)=bl$:qc$(a)=bl$
  369. 4680 printp$(a);pa$(a);pb$(a);qb$(a);pc$(a);qc$(a)
  370. 4690 nexta
  371. 4700 return
  372. 4710 :
  373. 4720 rem key
  374. 4730 print"[147]key
  375. 4740 [129]j[178]1[164]18:[153]ky$(j):[130]j
  376. 4750 [139]rt$[178]"y"[167]rt$[178]"":[141]3150:[137]4770
  377. 4760 [153]:[153]"hardcopy <y/n>+ ";
  378. 4770 [133]"<return>";rt$:[139]rt$[178]"y"[167][141]3140:[137]4740
  379. 4780 [142]
  380. 4790 :
  381. 4800 [143] low res graphic
  382. 4810 [153]"load
  383. 4820 cm=55296:rem start of col map
  384. 4830 sm=1024:rem start of scn map
  385. 4840 ifgm>gu(0)andgm<gd(0)thenpoke53281,1:rem sunshine-white screen
  386. 4850 forj=2to24:x=j*40+20:pokesm+x,160:next:pokesm+20,19:pokesm+60,30
  387. 4860 pokesm+58,5:pokesm+59,60:pokesm+61,62:pokesm+62,23
  388. 4870 fora=0to9:ifqf(a)<0ora=3thengoto4940
  389. 4880 az=fne((pf(a)/rd-100)/4):al=fne(qf(a)/rd/4)
  390. 4890 ifaz>39oraz<0thengoto4940
  391. 4900 co=0:rem black characters
  392. 4910 po=(25-al)*40+az:ifa=0thenco=7
  393. 4920 z=peek(sm+po):ifz>47andz<58thenco=2:rem 2 in same position
  394. 4930 pokesm+po,a+48:pokecm+po,co
  395. 4940 nexta
  396. 4950 print"80 degs e&w of s<return>";:inputq$:poke53281,6
  397. 4960 return
  398. 4970 :
  399. 4980 rem co-ordinates
  400. 4990 print"[147]co-ordinates set for leeds"
  401. 5000 print"(decimal degrees)"
  402. 5010 print"lat=";la,"long=";lo
  403. 5020 print"change (y/n) n[146]"
  404. 5030 getq$:ifq$=""thengoto5030
  405. 5040 ifq$="y"theninput"decimal lat";la:input"decimal lon";lo:fg=1
  406. 5050 print"[147]":return
  407.