home *** CD-ROM | disk | FTP | other *** search
/ Compute! Gazette 1987 October / 1987-10.d64 / stars (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  7KB  |  201 lines
  1. 10 rem copyright 1987 compute! publications, inc. - all rights reserved
  2. 20 poke55,0:poke56,84:clr:rd=(NULL)/180
  3. 30 dimsx(150),sy(150),sm(200),mo(12),c$(35),cs(35),et(12),mt(12),b%(35)
  4. 40 print"[147][144]copyright 1987 compute! pub., inc."
  5. 50 printtab(11)"all rights reserved"
  6. 60 print""tab(16)" stars [146]":print"please wait 20 seconds..."
  7. 70 fori=1to12:readet(i),mt(i):next
  8. 80 fori=1to33:reada:poke49151+i,a:x=x+a:next
  9. 90 ifx<>5810thenprint"error in ml data statement.":stop
  10. 100 poke56334,peek(56334)and254:poke1,peek(1)and251
  11. 110 sys49152:poke1,peek(1)or4:poke56334,peek(56334)or1
  12. 120 fori=1to4:readpo(i),di(i):next:gosub550
  13. 130 fori=1to12:readmo(i):next
  14. 140 fori=0to3:a%(i)=peek(63+i):next:print"[147]":qz=0
  15. 150 poke198,0:print"      menu      [146]"
  16. 160 print"(press return for default responses)":print"0 - quit"
  17. 170 print"1 - simulation":print"2 - constellation study"
  18. 180 print"3 - constellation study with quiz":input" choice (1 - 3):[146] 2[157][157][157]";aa
  19. 190 ifaa<1oraa>3thenend
  20. 200 onaagoto210,250,250
  21. 210 aa=4:input"hourly or monthly simulation(h or m)[146]  m[157][157][157]";a$
  22. 220 ifa$="h"thenhb=1:db=0:goto250
  23. 230 ifa$="m"thenhb=0:db=30:goto250
  24. 240 goto210
  25. 250 gosub1270:gosub590
  26. 260 is=0:lb$="computing":x=869:gosub840
  27. 270 readra:ifra>0then320
  28. 280 ifra=0then380
  29. 290 readlb$:ci=ra*-1:x=949:bh=0:ifla>.5andci=20then380
  30. 300 gosub1260:gosub840
  31. 310 sm(is)=6:sx(is)=ci:is=is+1:c$(ci)=lb$:goto360
  32. 320 readdc,mg:ifbh=1thenmg=5:goto350
  33. 330 gosub1500:ifal<0thenmg=5:bh=1:goto350
  34. 340 gosub930:ifaa>1thengosub750
  35. 350 sx(is)=x:sy(is)=y:sm(is)=mg:is=is+1
  36. 360 ifpeek(653)=4thengosub490:goto150
  37. 370 goto270
  38. 380 sm(is)=255:ifaa=4thenaa=1:goto410
  39. 390 onaagoto400,480,960
  40. 400 gosub590:gosub700
  41. 410 a2=a2+hb:ifa2>=24thena2=a2-24:dd=dd+1:jd=jd+1
  42. 420 dd=dd+db:jd=jd+db
  43. 430 ifdd>mo(mm)thendd=dd-mo(mm):mm=mm+1:ifmm>12thenmm=1
  44. 440 ifdd>mo(mm)then430
  45. 450 tm=int(a2)+an/60
  46. 460 fori=0to3:poke63+i,a%(i):next:la=la/rd
  47. 470 gosub1380:goto260
  48. 480 lb$="press return":x=868:gosub1260:gosub840:poke198,0:wait198,1
  49. 490 fori=0to3:poke63+i,a%(i):next:la=la/rd:gosub500:goto150
  50. 500 poke53272,20:poke56576,3:poke53265,peek(53265)and223:poke648,4:poke53280,15
  51. 510 return
  52. 520 xc=int(x0/8):yr=int(y0/8):ln=y0and7
  53. 530 pt=ad+yr*320+xc*8+ln:xb=7-(x0and7)
  54. 540 pokept,peek(pt)or2^xb:return
  55. 550 s8=32769:l8=8000:n6=32768:poke40769,0:gosub860:ad=n6
  56. 560 fori=1to180step2:x0=127*sin(2*i*rd)+127:y0=100*cos(2*i*rd)+100
  57. 570 gosub520:next
  58. 580 forj=1to4:x=po(j):y=di(j):gosub850:next:return
  59. 590 bg=0:iftm>mt(mm)andtm<et(mm)thenbg=6
  60. 600 poke53280,bg:ad=24576:s8=23553:l8=1000:n6=23552:poke24553,bg+16:gosub860
  61. 610 s8=32768:l8=8000:n6=ad:gosub860
  62. 620 poke53265,peek(53265)or32:poke53272,120:poke56576,2:ad=24576
  63. 630 x=27:lb$=str$(mm):gosub820
  64. 640 x=29:y=376:gosub850
  65. 650 x=31:lb$=str$(dd):gosub820
  66. 660 a4=int(a2):td$="am":ifa4>=12thentd$="pm":ifa4>12thena4=a4-12
  67. 670 x=67:lb$=str$(a4):gosub820:x=69:y=464:gosub850
  68. 680 a4=int(an):x=70:lb$=str$(a4):iflen(lb$)=2thenlb$=" 0"+right$(lb$,1)
  69. 690 gosub820:x=73:lb$=td$:gosub840:return
  70. 700 is=0
  71. 710 mg=sm(is):x=sx(is):y=sy(is):ifmg=255thenreturn
  72. 720 ifx=0then740
  73. 730 gosub750
  74. 740 is=is+1:goto710
  75. 750 onmggoto760,790,800,800,810,810
  76. 760 x0=x:y0=y+1:gosub520:x0=x+1:y0=y:gosub520:x0=x+2:y0=y:gosub520
  77. 770 x0=x+3:y0=y+1:gosub520
  78. 780 x0=x+1:y0=y+2:gosub520:x0=x+2:y0=y+2:gosub520
  79. 790 x0=x+1:y0=y+1:gosub520
  80. 800 x0=x+2:y0=y+1:gosub520
  81. 810 return
  82. 820 forj=1tolen(lb$)-1:y=(val(mid$(lb$,j+1,1))+48)*8:gosub850:x=x+1
  83. 830 next:return
  84. 840 forj=1tolen(lb$):y=(asc(mid$(lb$,j,1))-64)*8:gosub850:x=x+1:next:return
  85. 850 l8=7:s8=21504+abs(y):n6=ad+x*8:gosub860:return
  86. 860 l8=l8+1:e6=n6+l8:e8=s8+l8
  87. 870 a%=l8/256:a6=l8-256*a%
  88. 880 b%=(e6-a6)/256:b6=e6-256*b%-a6
  89. 890 c%=(e8-a6)/256:c6=e8-256*c%-a6
  90. 900 poke781,a%+1:poke782,a6:poke91,c%:poke90,c6:poke89,b%:poke88,b6
  91. 910 ifa6=0thensys41971:return
  92. 920 sys41964:return
  93. 930 az=2*(NULL)-az:q=sin((NULL)/4-al/2)/cos((NULL)/4-al/2)
  94. 940 x=int((100*q*sin(az)+100)*1.27)
  95. 950 y=99-int(100*q*cos(az)):return
  96. 960 is=1:i=0:gosub590:lb$="sorting":x=950:gosub840
  97. 970 bh=0
  98. 980 ifsm(i)=255thencs(is)=0:goto1050
  99. 990 cs(is)=sx(i)
  100. 1000 ifsm(i+1)>5theni=i+1:goto980
  101. 1010 i=i+1:ifsm(i)=5thenbh=1
  102. 1020 ifsm(i)<6then1010
  103. 1030 ifbh=0thenis=is+1
  104. 1040 goto970
  105. 1050 nc=is-1
  106. 1060 fori=1tonc:b%(i)=i:next
  107. 1070 forj=1to5:fork=1tonc:l=b%(int(rnd(1)*nc+1)):t9=b%(k):b%(k)=b%(l)
  108. 1080 b%(l)=t9:nextk,j
  109. 1090 forks=1tonc:is=0:bh=0:js=b%(ks)
  110. 1100 mg=sm(is):x=sx(is):y=sy(is):ifmg=255thengoto1150
  111. 1110 ifmg=6thencn=x:goto1140
  112. 1120 ifcn=cs(js)thenbh=1:gosub750
  113. 1130 ifcn<>cs(js)andbh=1then1150
  114. 1140 is=is+1:goto1100
  115. 1150 gosub1260:lb$="name":x=949:gosub840:y=464:gosub850:g$="":x=989
  116. 1160 poke198,0:wait198,1:getlb$:ifasc(lb$)=13then1190
  117. 1170 ifasc(lb$)=20thengosub1250:goto1160
  118. 1180 gosub840:g$=g$+lb$:goto1160
  119. 1190 ifg$=c$(cs(js))thenlb$="correct":x=910:gosub840:qz=qz+1:goto1210
  120. 1200 lb$=c$(cs(js)):x=909:gosub840:fori=1to500:nexti
  121. 1210 gosub1260
  122. 1220 nextks
  123. 1230 print"[147]you answered";qz;"[157] correct out of";nc;"[157] [146]"
  124. 1240 gosub500:print"please wait":gosub550:goto490
  125. 1250 lb$=" ":x=x-1:g$=left$(g$,len(g$)-1):gosub840:x=x-1:return
  126. 1260 forj=0to2:s8=31849+j*320:l8=96:n6=s8-1:pokes8+l8,0:gosub860:nextj:return
  127. 1270 print"[147]":ifaa=4thenprint"starting ";
  128. 1280 print"date and time of sky display"
  129. 1290 poke198,0:input"month (1-12):[146]  1[157][157][157]";mm:ifmm<1ormm>12then1290
  130. 1300 input"          day:[146] 1[157][157][157]";dd:ifdd<1ordd>31then1300
  131. 1310 jd=2446429.5:da=dd:ifmm>1thenfori=1tomm-1:da=da+mo(i):next
  132. 1320 jd=jd+da
  133. 1330 a2=0:an=0:poke198,0:input"hour (0-12):[146] 9[157][157][157]";a2:b$=" "
  134. 1340 ifa2<12thenprint" am or pm [146]   pm[157][157][157][157]";:inputb$
  135. 1350 ifb$="pm"thena2=a2+12
  136. 1360 tm=a2:an=(tm-int(tm))*60
  137. 1370 poke198,0:print"     latitude:[146]   40[157][157][157][157]";:input la
  138. 1380 fd=tm/24+.5:iffd=>1thenfd=fd-1:jd=jd+1
  139. 1390 da=da+fd:d3=jd-2451545
  140. 1400 t3=d3/36525:t1=int(t3)
  141. 1410 t2=(jd-t1*36525-2451544.5)/36525
  142. 1420 s3=24110.54841+184.812866*t1+8640184.812866*t2+.093104*t3*t3
  143. 1430 s3=(s3-0.0000062*t3*t3*t3)/86400:s3=24*(s3-int(s3)+(fd-.5)*1.002737909)
  144. 1440 ifs3<0thens3=s3+24
  145. 1450 ifs3>24thens3=s3-24
  146. 1460 h3=int(s3):m3=int(60*(s3-h3))
  147. 1470 tg=h3+m3/60
  148. 1480 la=la*rd
  149. 1490 return
  150. 1500 dc=dc*rd:ra=ra*15*rd
  151. 1510 t5=tg*15*rd-ra
  152. 1520 s1=sin(la)*sin(dc)+cos(la)*cos(dc)*cos(t5)
  153. 1530 c1=1-s1*s1
  154. 1540 ifc1>0thenc1=sqr(c1)
  155. 1550 ifc1<=0thenal=sgn(s1)*(NULL)/2:goto1570
  156. 1560 al=atn(s1/c1)
  157. 1570 c2=cos(la)*sin(dc)-sin(la)*cos(dc)*cos(t5)
  158. 1580 s2=-cos(dc)*sin(t5)
  159. 1590 ifc2=0thenaz=sgn(s2)*(NULL)/2:goto1620
  160. 1600 az=atn(s2/c2)
  161. 1610 ifc2<0thenaz=az+(NULL)
  162. 1620 ifaz<0thenaz=az+2*(NULL)
  163. 1630 print"[147]":return
  164. 1640 data 19,6,19,6,20,5,21,4,21,3,22,3,21,3,20,4,20,4,19,5,18,5,18,6
  165. 1650 rem ml data is in next 2 lines
  166. 1660 data 169,0,133,251,133,253,169,208,133,252,169,84,133,254,162,16,160,0
  167. 1670 data 177,251,145,253,136,208,249,230,252,230,254,202,208,240,96
  168. 1680 data 16,112,480,40,976,152,511,184
  169. 1690 data31,28,31,30,31,30,31,31,30,31,30,31
  170. 1700 data -1,"polaris",2,89,2
  171. 1710 data -2,"big dipper"
  172. 1720 data 11,57,2,11,63,2,11.8,54,2,12.2,58,3,12.9,57,2,13.4,55,2,13.7,50,2
  173. 1730 data -3,"arcturus",14.3,19.5,1
  174. 1740 data -4,"virgo",13.4,-11,1,12.6,-1,3,12.9,3,3,13,11,3
  175. 1750 data -5,"pegasus",0.2,15,3,23,14,2,23,28,2,.1,29,2
  176. 1760 data -6,"auriga",5.2,46,1,5.9,45,2,5.9,37,2,4.9,33,3,5.4,29,2
  177. 1770 data -7,"orion",5.9,8,1,5.4,7,2,5.75,-2,2,5.6,-1,2,5.45,0,2
  178. 1780 data 5.6,-5.5,4,5.2,-8.5,1,5.8,-10,2
  179. 1790 data -8,"vega",18.6,39,1,-9,"cygnus"
  180. 1800 data 20.7,45,1,20.3,40,2,19.7,45,3,20.75,34,2,19.5,28,3,19.9,35,4
  181. 1810 data -10,"canis major",6.7,-17,1,6.4,-18,2
  182. 1820 data-11,"aquila",19.8,9,1,19.1,13.5,3,20.1,-1,3,19.4,3,3,19.1,-5,3
  183. 1830 data -12,"scorpius",16.5,-26,1,16,-20,2,15.9,-22,2,15.9,-26,3
  184. 1840 data 17.6,-43,2,16.7,-34,2,17.6,-37,2,16.7,-38,3,17.2,-43,3
  185. 1850 data -13,"cassiopeia",1.9,63.5,4,1.4,60,3,0.9,60.5,2,0.6,56,2,0.1,59,2
  186. 1860 data -14,"taurus",4.6,16,1,4.2,15,4,4.4,19,3
  187. 1870 data -15,"canis minor",7.6,6,1,7.4,9,3
  188. 1880 data -16,"gemini",7.5,32,1,7.7,28,1,6.7,25,3,6.6,16,2,6.3,22,3
  189. 1890 data -17,"leo"
  190. 1900 data10.1,12.5,1,10.1,17,3,10.3,20,2,10.3,24,3,9.8,26,4,9.7,24,3
  191. 1910 data 11.2,21,2,11.2,16,3,11.8,15,2
  192. 1920 data-18,"sagittarius",18.3,-30,3,18,-30.5,3,18.4,-25,3,18.9,-26,2,19,-30,2