home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 523a.lha / Ephemer / EphGB.HS < prev    next >
Encoding:
Text File  |  1991-06-10  |  43.1 KB  |  1,394 lines
  1. '************************************
  2. '*                                  *
  3. '*       E P H E M E R I S          *
  4. '*                                  *
  5. '*        by Yvon Alemany           *
  6. '*      28 ch de St-Laurent         *
  7. '*  F 06800 Cagnes-sur-Mer  FRANCE  *
  8. '*                                  *
  9. '************************************
  10.  
  11. REM $OPTION Y+,L-
  12.  
  13. Initialization:
  14. '--------------
  15. SCREEN 2,640,256,2,2
  16. WINDOW 2,"                    =====   E P H E M E R I S   ===== ",,16,2
  17. CLS
  18. DEFINT i-j
  19. DEFDBL a-h,k-w
  20. pi=3.1415926535897#
  21. z$(0)="MONDAY": z$(1)="TUESDAY": z$(2)="WEDNESDAY": z$(3)="THURSDAY": z$(4)="FRIDAY"
  22. z$(5)="SATURDAY": z$(6)="SUNDAY"
  23.  
  24. Title:
  25. '-----
  26. CLS
  27. LOCATE 3,28: PRINT " E P H E M E R I S "
  28. LOCATE 4,28: PRINT " ----------------- "
  29. LOCATE 6,30: PRINT "by Yvon Alemany"
  30. LOCATE , 28: PRINT "28 ch de St-Laurent"
  31. LOCATE , 24: PRINT "F 06800 Cagnes-sur-Mer  FRANCE"
  32. LOCATE 12,12: PRINT "This programme calculates, for any place and any date:"
  33. PRINT :PRINT "  -   the astronomical data of the Sun, the Moon and the planets;
  34. "
  35. PRINT: PRINT "  -   the display of the concerned portion of zodiac where is the"
  36. PRINT "      planet;"
  37. PRINT: PRINT "  -   the display of positions where the planet was at former"
  38. PRINT        "      periods previously chosen."
  39. GOSUB Waiting
  40. GOSUB Place
  41. GOSUB DateHour
  42. GOTO FirstCalc
  43.  
  44. Place:
  45. '----
  46. CLS
  47. LOCATE 3,16: PRINT " C O N D I T I O N S   O F   O B S E R V A T I O N "
  48. LOCATE 8,5: PRINT "Enter the geographic coordinates of the place:"
  49. LOCATE 11,5: PRINT "Latitude  (dd,mm,ss) (Minus if SOUTH) : ";
  50. INPUT "",d,m,s
  51. la=ABS(d*3600)+m*60+s: la=la*SGN(d): la=la/3600: laa=la
  52. LOCATE 11,55: PRINT "i.e.: ";:PRINT USING "###.####";la;:PRINT " deg"
  53. LOCATE 14,5: PRINT "Longitude (dd,mm,ss) (Minus if  EAST) : ";
  54. INPUT "",d,m,s
  55. lo=ABS(d*3600)+m*60+s:lo=lo*SGN(d): lo=lo/3600: loa=lo
  56. LOCATE 14,55: PRINT "i.e.: ";:PRINT USING "###.####";lo;:PRINT " deg"
  57. lzd=lod: lor=lor*pi/180
  58. GOSUB Waiting
  59. RETURN
  60.  
  61. DateHour:
  62. '----------
  63. CLS
  64. LOCATE 3,16: PRINT " C O N D I T I O N S   O F   O B S E R V A T I O N "
  65. LOCATE 8,5:PRINT   "Enter date and hour :"
  66. LOCATE 11,5: PRINT "Date  (dd,mm,yyyy)  .............. : ";
  67. INPUT "",j,m1,an: jour=j: mois=m1: annee=an
  68. LOCATE 14,5: PRINT "Hour  UT  (hh,mm,ss) ............. : ";
  69. INPUT "",h,t,s1: heure=h: minute=t: seconde=s1
  70.  
  71. CalculateN:
  72. '---------
  73. hs=h/24+t/1440+s1/86400&: j!=j+hs: anq=an
  74. n!=an*365+31*(m1-1)+j!
  75. IF m1<=2 THEN  an=an-1
  76. n!=n!+INT(an/4)-INT(an/100)+INT(an/400)
  77. IF m1>2 THEN n!=n!-INT((m1-1)*.4+2.7)
  78. n!=n!-694325&: ninit!=n!
  79. nv=anq*365+1: anv=anq-1
  80. nva=nv+INT(anv/4)-INT(anv/100)+INT(anv/400)
  81. nva=nva-694325&: nva=INT(nva): nob=n!: quant=nob-nva+1
  82. LOCATE 17,5: PRINT "Day number = ";: PRINT USING "###.##";quant
  83. LOCATE 19,5: PRINT "N = ";INT(n!*1000)/1000;
  84. i=INT((n!/7-INT(n!/7))*7+.05)
  85. IF i=7 THEN i=0
  86. PRINT SPC(6);"It was "; z$(i)
  87. GOSUB Waiting
  88. RETURN
  89.  
  90. FirstCalc:
  91. '-----------
  92. j=0: READ l0(j), lp(j), p0(j), pp(j), o0(j), op(j), e(j), i#(j), a(j)
  93. DATA 4.011656734308, 7.14254534E-2, 1.3249318, 7.42319099E-7, .82304491
  94. DATA 5.66126989E-7, .2056149, .12222565, .38709830982
  95.  
  96. j=1: READ l0(j), lp(j), p0(j), pp(j), o0(j), op(j), e(j), i#(j), a(j)
  97. DATA 3.60860785, 2.7963119E-2, 2.27161583, 6.55749494E-7, 1.32290721
  98. DATA 4.3667637E-7, .0068164, .0592301237, .7332981996
  99.  
  100. j=2: READ l0(j), lp(j), p0(j), pp(j), o0(j), op(j), e(j), i#(j), a(j)
  101. DATA 2.17756004, 9.14676587E-3, 5.83378047, 8.79420795E-7, .851615954
  102. DATA 3.71259108E-7, .0933088, 3.22938756E-2, 1.52367934191
  103.  
  104. j=3: READ l0(j), lp(j), p0(j), pp(j), o0(j), op(j), e(j), i#(j), a(j)
  105. DATA 4.68359104, 1.45088204E-3, .222302586, 7.69317345E-7, 1.7357823
  106. DATA 4.82875741E-7, .0483348, .0228417541, 5.260319132
  107.  
  108. j=4: READ l0(j), lp(j), p0(j), pp(j), o0(j), op(j), e(j), i#(j), a(j)
  109. DATA 4.86552416, 5.84648212E-4, 1.59029165, 9.35819818E-7, 1.96855686
  110. DATA 4.17251675E-7, .0558923, 4.35026708E-2,9.55490959574
  111.  
  112. j=5: READ l0(j), lp(j), p0(j), pp(j), o0(j), op(j), e(j), i#(j), a(j)
  113. DATA 4.336916, 2.05408196E-4, 2.99433922, 7.09334513E-7, 1.28250284
  114. DATA 2.38285427E-7, .0463444, 1.34820382E-2, 19.21844606178
  115.  
  116. j=6: READ l0(j), lp(j), p0(j), pp(j), o0(j), op(j), e(j), i#(j), a(j)
  117. DATA 1.5123627, 1.05071409E-4, .815801799, 6.80730175E-7, 2.28102316
  118. DATA 5.25125225E-7, .008997, .0310306311, 30.11038686942
  119.  
  120. j=7: READ l0(j), lp(j), p0(j), pp(j), o0(j), op(j), e(j), i#(j), a(j)
  121. DATA 1.6406, 701214E-10, 3.8978, 6.672E-7, 1.9034
  122. DATA 66.72E-08, .250236, .29968, 39.438712#
  123.  
  124. '-----------
  125. CLS: LOCATE 14,15
  126. PRINT "Accurate calculation for then Sun?  (Y/N) : ";:INPUT "",ch$: ch$=UCASE$(ch$)
  127. CLS
  128.  
  129. CalcSun:
  130. '------------
  131. RESTORE DataSun
  132. DataSun:
  133.  DATA 4.86886002, 1.7202791395E-2
  134. DATA 4.908476721674, 8.19212342E-7
  135. DATA .01675104, 1.00000101778, 4
  136. READ l0,lp,p0,pp,e,a,ke
  137. IF LEFT$(ch$,1)="Y" THEN
  138.   GOSUB AccurateSun
  139.   GOTO ContCalcSun
  140. END IF
  141. p=p0+pp*n!:  m=l0+lp*n!-p
  142. m8=m
  143. IF m8>2*pi THEN m8=m8-2*pi*INT(m8/2/pi)
  144. u=m :          ' Kepler' Equation
  145. FOR i=0 TO ke
  146.   u=m+e*SIN(u)
  147. NEXT i
  148. v=2*ATN(TAN(u/2)*SQR((1+e)/(1-e)))
  149. r=a*(1-e*COS(u)): l=v+p
  150. lm=l
  151. IF lm>2*pi THEN lm=lm-2*pi*INT(lm/2/pi)
  152. IF lm<0 THEN lm=lm+2*pi
  153.  
  154. ContCalcSun:
  155. '---------------
  156. xs=r*COS(l): ys=r*SIN(l)
  157. ld=l*180/pi: ld=(ld/360-INT(ld/360))*360
  158. IF ld<0 THEN ld=ld+360
  159. ld=INT(ld*10000+.5)/10000
  160. lsol=ld+180: IF lsol>360 THEN lsol=lsol-360
  161. l8=l0+lp*n!: l8=l8-INT(l8/pi/2)*2*pi
  162. CLS
  163. so$="S U N"
  164. LINE (0,0)-(630,23),3,bf:COLOR 1,3
  165. LOCATE 2,1: PRINT "On ";mois;"/";jour;"/";annee
  166. LOCATE 2,58: PRINT "at ";heure;"h";minute;"m";seconde;"s"
  167. LOCATE 2,40-LEN(so$)/2: PRINT  so$: LOCATE 3,40-LEN(so$)/2: PRINT  STRING$(LEN(so$),"-")
  168. PRINT:COLOR 1,0
  169. PRINT "Longitude of the Sun"; TAB(23);": ";:PRINT USING "###.###";ld;: PRINT" deg"
  170. xp=xs: yp=ys: zp=0
  171. b=0
  172. GOSUB CoordEquat
  173. r0=149597871#: a0=.533128
  174. da=a0*(1+e*COS(v))/(1-e^2): da=ABS(da)
  175. PRINT
  176. PRINT "Sun-Earth Distance "; TAB(23);": ";: PRINT USING "####.######^^^^";r*r0;: PRINT " km"
  177. PRINT "in AU"; TAB(23);": ";: PRINT USING "##.######";r
  178. d=INT(da): m9=(da-d)*60: m=INT(m9): s=INT((m9-m)*60)
  179. PRINT "Apparent Diameter"; TAB(23);": ";: PRINT USING "##.######";da;: PRINT " deg"
  180. PRINT "or "; TAB(23);": ";d;"°";m;"'";s;"''"
  181. GOSUB RiseSet
  182. GOTO Others
  183.  
  184. AccurateSun:
  185. '------------
  186. PerturbationsByPlanets:
  187. '------------------------
  188. a1=17.9+.6165298*n!: a1=a1*pi/180
  189. b=306+1.2330596#*n!: b=b*pi/180
  190. c=115.9+.2474593*n!: c=c*pi/180
  191. d=222.1+.858513*n!: d=d*pi/180
  192. e1=199.2-.121611*n!: e1=e1*pi/180
  193. F=38.3+.9231589*n!: F=F*pi/180
  194. g=256.9-.0624422*n!: g=g*pi/180
  195. h=281.6+.9025161*n!: h=h*pi/180
  196. j1#=7.6-.0830856*n!: j1#=j1#*pi/180
  197. k=291.4+1.80503*n!: k=k*pi/180
  198. p1=316+.8194305*n!: p1=p1*pi/180
  199. q=114.3+12.1907494#*n!: q=q*pi/180
  200. r1=231.4+.00055305#*n!: r1=r1*pi/180
  201.  
  202. t=n!/36525&
  203. ls=.0003*pi/180
  204. l=l0+lp*n!+ls*t^2
  205. lm=l
  206. IF lm>2*pi THEN lm=lm-INT(lm/2/pi)*2*pi
  207.  
  208. Correction.longitude:
  209. '--------------------
  210. dl=134*COS(a1)+154*COS(b)+69*COS(c)+43*COS(d)+28*COS(e1)+57*COS(F)+49*COS(g)+200*COS(h)+72*COS(j1#)+76*COS(k)+45*COS(p1)+179*SIN(q)+178*SIN(r1)
  211. dl=dl*.00001: dl=dl*pi/180
  212.  
  213. e=.01675062#-.0000418*t-.000000137#*t^2
  214. p=p0+pp*n!
  215. m=l-p: ke=5
  216. m8=m
  217. u=m        ' Kepler's Equation
  218. FOR i=0 TO ke
  219.   u=m+e*SIN(u)
  220. NEXT i
  221. v=2*ATN(TAN(u/2)*SQR((1+e)/(1-e)))
  222. l=v+p+dl
  223. l8=l
  224. r=a*(1-e*COS(u))
  225.  
  226. CorrectionR.Vector:
  227. '-------------------
  228. dr=543*SIN(a1)+1575*SIN(b)+200*SIN(c)+345*SIN(d)+474*SIN(F)+1627*SIN(h)+927*SIN(k)+106*SIN(p1)+3076*COS(q)
  229. dr=dr*1E-08
  230. r=r+dr
  231. RETURN
  232.  
  233. RiseSet:
  234. '------
  235. tt=lz/15: lat=la*pi/180
  236. ml=p+m8
  237. IF ml<0 THEN ml=ml+2*pi:' Mean Long.
  238. IF ml>2*pi THEN ml=ml-2*pi*INT(ml/2/pi)
  239. et=rd-ml: et=et-pi*INT(et/pi)
  240. IF ABS(et)>.9*pi THEN et=et-SGN(et)*pi
  241. mm=COS(lat-d5): mn=-COS(lat+d5): m6=0
  242. IF -mm*mn>0 THEN cr=.055555555#/SQR(-mm*mn)
  243. IF -mm*mn<=0 AND ((lat>0 AND mois<9) OR (lat<0 AND mois >9))  THEN
  244.   cr=0:PRINT "No SUNSET": flag=1
  245. END IF
  246. IF mn>m6 THEN m6=mn
  247. IF mm<m6 THEN PRINT "No SUNRISE": GOSUB Waiting: RETURN
  248. x=SQR((m6-mn)/(mm-m6))
  249. je#=1-(2/pi*ATN(x)): ' Fraction of lighted day
  250. dc=12*je#: ' Number of hours for the culmination
  251. hl=12-(dc+cr-et*12/pi): hl=hl+tt
  252. hl=hl*3600: h=INT(hl/3600): h=h-INT(h/24)*24
  253. m5=hl-h*3600: m=INT(m5/60): s=m5-m*60: s=INT(100*s)/100
  254. IF flag<>1 THEN PRINT "Rising Time  (UT)";TAB(23);": ";h;"h ";m;"m ";s;"s"
  255. hc=12+(dc+cr+et*12/pi): hc=hc+tt
  256. hc=hc*3600:h=INT(hc/3600): h=h-INT(h/24)*24
  257. m5=hc-h*3600: m=INT(m5/60): s=m5-m*60: s=INT(100*s)/100
  258. IF flag<>1 THEN PRINT "Setting Time (UT)";TAB(23);": ";h;"h ";m;"m ";: PRINT USING "##";s;: PRINT "s"
  259. fm=.5*((mm+mn)*je#+(mm-mn)*SIN(pi*je#)/pi)
  260. fm=INT(fm*118886.4#)/100
  261. PRINT
  262. PRINT "The available ENERGY above the atmosphere is: ";
  263. PRINT USING "####.###";fm;: PRINT " M.Joule/m2"
  264. flag=0
  265. GOSUB Waiting
  266. RETURN
  267.  
  268. Others:
  269. '-----
  270. CLS
  271. n!=ninit!
  272. LOCATE 2,17:PRINT "CALCULATION FOR THE MOON AND OTHER PLANETS"
  273. LOCATE 3,17:PRINT "------------------------------------------"
  274. LOCATE 5,1:PRINT "     1 - Mercury"
  275. PRINT "     2 - Venus": PRINT "     3 - Mars": PRINT "     4 - Jupiter": PRINT "     5 - Saturn"
  276. PRINT "     6 - Uranus": PRINT "     7 - Neptune": PRINT "     8 - Pluto": PRINT "     9 - Moon"
  277. PRINT "    10 - Zodiacal Sight": PRINT "    11 - Positions at j, j-D, j-2D, j-3D"
  278. PRINT "    12 - Another calculation"
  279. PRINT "     0 - Quit"
  280. PRINT :INPUT"     CHOICE ? ",ch
  281. IF ch<0 OR ch>12 THEN Others
  282.  
  283.  
  284. IF ch=0 THEN
  285.   CLS
  286.   WINDOW CLOSE 2
  287.   SCREEN CLOSE 2
  288.   END
  289. END IF
  290.  
  291. Menus:
  292. IF ch=1 THEN GOSUB Mercury
  293. IF ch=2 THEN GOSUB Venus
  294. IF ch=3 THEN GOSUB Mars
  295. IF ch=4 THEN GOSUB Jupiter
  296. IF ch=5 THEN GOSUB Saturn
  297. IF ch=6 THEN GOSUB Uranus
  298. IF ch=7 THEN GOSUB Neptune
  299. IF ch=8 THEN GOSUB Pluto
  300. IF ch=9 THEN GOSUB Moon
  301. IF ch=10 THEN GOSUB Zodiac
  302. IF ch=11 THEN GOSUB PastPos
  303. IF ch=12 THEN GOSUB AnotherCalc
  304. GOTO Others
  305.  
  306. Mercury:
  307. '-------
  308. di=6.74: j=0: ke=5: t$="M E R C U R Y"
  309. GOTO CalcPlsimple
  310.  
  311. Venus:
  312. '-----
  313. di=16.92: j=1: ke=3: t$="V E N U S"
  314. GOTO CalcPlsimple
  315.  
  316. Mars:
  317. '----
  318. di=9.36: j=2: ke=5: t$="M A R S"
  319. GOTO CalcPlsimple
  320.  
  321. Jupiter:
  322. '-------
  323. di=196.74: j=3: ke=5: t$="J U P I T E R"
  324. GOTO CalcPlprecis
  325.  
  326. Saturn:
  327. '-------
  328. di=165.6: j=4: ke=4: t$="S A T U R N"
  329. GOTO CalcPlprecis
  330.  
  331. Uranus:
  332. '------
  333. di=65.8: j=5: ke=4: t$="U R A N U S"
  334. GOTO CalcPlprecis
  335.  
  336. Neptune:
  337. '-------
  338. di=62.2: j=6: ke=3: t$="N E P T U N E"
  339. GOTO CalcPlprecis
  340.  
  341. Pluto:
  342. '------
  343. di=8.2: j=7: ke=7: t$="P L U T O"
  344. GOTO CalcPlsimple
  345.  
  346. PastPos:
  347. ppass=11: retro=1
  348. CLS
  349. LOCATE 6,11
  350. PRINT "Enter the step, in days, for examination dates of the"
  351. PRINT "          astral position."
  352. PRINT
  353. PRINT "          For the Moon try a step < .2 and increase it if"
  354. PRINT "          we stay in the same zodiacal area."
  355. PRINT: PRINT : INPUT "                          Enter the step = ",nbj
  356. LOCATE 15,22: PRINT "Select the astral body to examine"
  357. GOSUB Waiting
  358. GOTO Others
  359.  
  360. AnotherCalc:
  361. '----------
  362. CLS
  363. LOCATE 2,22: PRINT "A N O T H E R    C A L C U L A T I O N"
  364. LOCATE 3,27: PRINT "--------------------------------------"
  365. LOCATE 8,1: PRINT "   1 - Another Place and Another Date"
  366. PRINT "   2 - Another Place and Same Date"
  367. PRINT "   3 - Same Place and Another Date"
  368. PRINT :PRINT :PRINT "   CHOICE ?  ";:INPUT "",ch
  369. IF ch<1 OR ch>3 THEN AnotherCalc
  370. IF ch=1 THEN
  371.   RESTORE: GOTO Title
  372. END IF
  373. IF ch=2 THEN
  374.   GOSUB Place: RESTORE: GOTO FirstCalc
  375. END IF
  376. IF ch=3 THEN
  377.   GOSUB DateHour
  378.   la=laa: lo=loa
  379.   RESTORE: GOTO FirstCalc
  380. END IF
  381. GOTO AnotherCalc
  382.  
  383. Moon:
  384. '----
  385. ke=5: t$="M O O N"
  386. ld=33.231+13.17639653#*n!: ld=ld-INT(ld/360)*360: lr=ld*pi/180
  387. od=239.882-.052953922#*n!: od=od-INT(od/360)*360: ow=od*pi/180
  388. md=18.294+13.06499245#*n!: md=md-INT(md/360)*360: mr=md*pi/180
  389. d=lr-l8: F=lr-ow
  390. xa=6.28875*SIN(mr)+.2136*SIN(2*mr)+.6583*SIN(2*d)-.1856*SIN(m8)+1.274*SIN(2*d-mr)-.1143*SIN(2*F)
  391. xb=.0588*SIN(2*d-2*mr)+.0572*SIN(2*d-mr-m8)+.0533*SIN(2*d+mr)+.0459*SIN(2*d-m8)+.041*SIN(mr-m8)-.0305*SIN(mr+m8)-.0348*SIN(d)
  392. l9=ld+xa+xb
  393. ya=5.128*SIN(F)+.2806*SIN(mr+F)+.2777*SIN(mr-F)+.1732*SIN(2*d-F)+.0554*SIN(2*d-mr+F)+.0462*SIN(2*d-mr-F)+.0326*SIN(2*d+F)
  394. ya=ya-INT(ya/360)*360
  395. IF ya>270 THEN ya=ya-360
  396. IF l9>360 THEN l9=l9-INT(l9/360)*360
  397.  
  398. AfficheCoordLune:
  399. '----------------
  400. CLS
  401. IF ppass=11 THEN Moons
  402. LINE (0,0)-(630,15),3,bf: COLOR 1,3
  403. LOCATE 1,1: PRINT "Thee ";mois;"/";jour;"/";annee
  404. LOCATE 1,58:
  405.  PRINT "at ";heure;"h";minute;"m";seconde;"s"
  406. cl$="The  M O O N"
  407. LOCATE 1,38-LEN(cl$)/2: PRINT  cl$: LOCATE 2,38-LEN(cl$)/2:PRINT  STRING$(LEN(cl$),"-")
  408. PRINT: COLOR 1,0
  409. PRINT "Ascend.Node Longitude"; TAB(23);": ";: PRINT USING "###.###";od;: PRINT " deg"
  410. PRINT "Mean Anomaly"; TAB(23);": ";: PRINT USING "###.###";md;: PRINT " deg"
  411. PRINT
  412. PRINT "Longitude"; TAB(23);": ";: PRINT USING "###.###";l9;: PRINT " deg"
  413. PRINT "Latitude "; TAB(23);": ";: PRINT USING "+##.###";ya;: PRINT " deg"
  414. Moons:
  415. l=l9*pi/180: b=ya*pi/180
  416. IF ppass=11 THEN
  417.   GOSUB CoordEquat
  418.   hp(retro)=hp: dp(retro)=dp
  419.   IF retro <4 THEN retro=retro+1: n!=n!-nbj: GOTO Menus
  420.   LOCATE 15,26
  421.   PRINT "Choose:  10 - Zodiacal Sight"
  422.   GOSUB Waiting
  423.   GOTO Others
  424. END IF
  425.  
  426. GOSUB CoordEquat
  427. GOSUB RSHour
  428. GOSUB Waiting
  429. RestoreData:
  430. '-----------
  431. RESTORE  DataSun
  432. READ x1, x2, x3, x4, x5, x6, x7
  433. RETURN
  434.  
  435. CalcPlsimple:
  436. '------------
  437. p=p0(j)+pp(j)*n!: px=p*180/pi: l1=l0(j)+lp(j)*n!: lx=l1*180/pi: m=l1-p
  438. e=e(j)
  439. u=m:           ' Kepler's Equation
  440. FOR i=0 TO ke  '
  441.   u=m+e*SIN(u) '
  442. NEXT i
  443. v=2*ATN(TAN(u/2)*SQR((1+e)/(1-e)))
  444. o=o0(j)+op(j)*n!: c=v+p-o
  445.  
  446. ContPls:
  447. '------
  448. IF COS(c)=0 THEN
  449.   d=c: GOTO ContPls
  450. END IF
  451. d=ATN(TAN(c)*COS(i#(j)))
  452. IF COS(c)<0 THEN d=d+pi
  453. ls=d+o
  454. bs=ATN(SIN(d)*TAN(i#(j)))
  455. rs=a(j)*(1-e*COS(u))
  456. xp=rs*COS(bs)*COS(ls)+xs
  457. yp=rs*COS(bs)*SIN(ls)+ys
  458. zp=rs*SIN(bs)
  459. r=SQR(xp*xp+yp*yp): b=ATN(zp/r): l=ATN(yp/xp)
  460. IF xp<0 THEN l=l+pi
  461.  
  462. ld=l*180/pi: ld=(ld/360-INT(ld/360))*360  ' Conversion
  463. IF ld<0 THEN ld=ld+360                   '   deg
  464. ld=INT(ld*10000+.5)/10000                '   rad
  465. GOTO DisplayPln
  466.  
  467. CalcPlprecis:
  468. '------------
  469. IF ch=4 THEN
  470.   v1=135.036+.00115674#*n!
  471.   GOTO JuLongPer
  472. END IF
  473.  
  474. IF ch=5 THEN
  475.   v1=135.036+.00115674#*n!
  476.   GOTO SALongCourtPer
  477. END IF
  478.  
  479. IF ch=6 THEN
  480.   v1=284.159+.000233*n!
  481.   GOTO UrLongPer
  482. END IF
  483.  
  484. IF ch=7 THEN
  485.   v1= 284.159+.000233*n!
  486.   GOTO NeLongPer
  487. END IF
  488.  
  489. JuLongPer:
  490. '---------
  491. v2=v1*pi/180
  492. l2=.3314*SIN(v2)
  493. e2=.000361*SIN(v2)+.000129*COS(v2)
  494. p4=.007*SIN(v2)-.02*COS(v2)
  495. a2=.000263*COS(v2): a3=0: l3=0: e3=0: p5=0
  496. GOSUB JuSaUrNe
  497. GOTO ContPls
  498.  
  499. SALongCourtPer:
  500. '--------------
  501. v2=v1*pi/180
  502. l2=-.8142*SIN(v2)-.011*COS(v2)+.008*SIN(2*v2)
  503. e2=-.000793*SIN(v2)+.00134*COS(v2)
  504. p4=.078*SIN(v2)+.046*COS(v2)
  505. a2=.000049*SIN(v2)+.002933*COS(v2)
  506. DEF FNa(l5)=c4+s5*SIN(l5)+c5*COS(l5)+s6*SIN(2*l5)+c6*COS(2*l5)
  507. l4=278.062+.03346*n!: l5=l4*pi/180
  508. k4=10.316-.03346*n!: k5=k4*pi/180
  509. c4=-.149*SIN(k5)-.041*SIN(2*k5)-.015*SIN(3*k5)-.006*SIN(4*k5)
  510. s5=-.006-.009*SIN(k5)+.082*COS(k5)-.017*SIN(2*k5)+.015*COS(2*k5)-.006*SIN(3*k5)
  511. c5=.086*SIN(k5)+.025*COS(k5)+.014*COS(2*k5)
  512. s6=.006*SIN(k5)-.005*COS(k5)+.009*SIN(2*k5)+.005*COS(2*k5)
  513. c6=-.005*COS(k5)+.005*SIN(2*k5)-.008*COS(2*k5)
  514. l3=FNa(l5):           ' Dl
  515. c4=0: s5=.00124+.00266*COS(k5)-.00047*COS(2*k5)-.00019*COS(3*k5)
  516. c5=-.00127*SIN(k5)-.00042*SIN(2*k5)
  517. s6=.00022*SIN(k5)-.00028*COS(k5)-.00022*SIN(2*k5)+.0002*COS(2*k5)
  518. c6=.00028*SIN(k5)-.00016*COS(k5)+.00022*COS(2*k5)
  519. e3=FNa(l5) :          ' De
  520. c4=-.007*SIN(k5)
  521. s5=-.076*SIN(k5)-.025*SIN(2*k5)-.009*SIN(3*k5)
  522. c5=-.073-.15*COS(k5)+.027*COS(2*k5)+.01*COS(3*k5)
  523. s6=-.014*SIN(k5)-.008*COS(k5)+.014*COS(2*k5)
  524. c6=-.014*SIN(k5)+.015*COS(k5)+.012*SIN(2*k5)-.013*COS(2*k5)
  525. p5=FNa(l5) :          ' E*Dp
  526. c4=.0337*COS(k5)-.00308*COS(2*k5)-.00143*COS(3*k5)-.00067*COS(4*k5)
  527. s5=-.00281*SIN(k5)+.00214*COS(k5)+.00069*SIN(2*k5)-.001*COS(2*k5)
  528. c5=.0022*SIN(k5)+.00288*COS(k5)-.00159*SIN(2*k5)+.00217*COS(2*k5)
  529. s6=-.00027*SIN(2*k5)-.00078*COS(k5)+.00049*COS(2*k5)+.00025*COS(3*k5)
  530. c6=-.00065*SIN(k5)+.00044*SIN(2*k5)+.0003*COS(2*k5)
  531. a3=FNa(l5) :           ' Da
  532. GOSUB JuSaUrNe
  533. GOTO ContPls
  534.  
  535. UrLongPer:
  536. '---------
  537. v2=v1*pi/180
  538. l2=.864*SIN(v2)+.082*COS(v2)+.036*SIN(2*v2)
  539. e2=.000335*SIN(v2)+.0021*COS(v2)
  540. p4=.1203*SIN(v2)+.0194*COS(v2)+.006*SIN(2*v2)
  541. a2=-.003824*SIN(v2)+.0082*COS(v2): a3=0: l3=0: e3=0: p5=0
  542. GOSUB JuSaUrNe
  543. GOTO ContPls
  544.  
  545. NeLongPer:
  546. '---------
  547. v2=v1*pi/180
  548. l2=-.5926*SIN(v2)-.0561*COS(v2)-.0243*SIN(2*v2)
  549. e2=.00044*SIN(v2)+.000426*COS(v2)-.006*COS(2*v2)
  550. p4=.024*SIN(v2)-.025*COS(v2)+.006*SIN(2*v2)-.006*COS(2*v2)
  551. a2=-.00082*SIN(v2)+.0082*COS(v2): a3=0: l3=0: e3=0: p5=0
  552. GOSUB JuSaUrNe
  553. GOTO ContPls
  554.  
  555. JuSaUrNe:
  556. '--------
  557. p=p0(j)+pp(j)*n!: l1=l0(j)+lp(j)*n!
  558. e4=e(j)+e2: p2=p4/e4:                ' Dp
  559. l2=l2*pi/180: l3=l3*pi/180
  560. l1=l1+l2+l3: a(j)=a(j)+a2+a3
  561. e=e4+e3: p3=p5/e:                    ' Dp2
  562. p2=p2*pi/180: p3=p3*pi/180
  563. p=p+p2+p3: m=l1-p
  564. lx=l1*180/pi: px=p*180/pi
  565. u=m :                                 ' Kepler's Equat
  566. FOR i=0 TO ke
  567.   u=m+e*SIN(u)
  568. NEXT i
  569. v=2*ATN(TAN(u/2)*SQR((1+e)/(1-e)))
  570. o=o0(j)+op(j)*n!: c=v+p-o
  571. RETURN
  572.  
  573. DisplayPln:
  574. '---------
  575. CLS
  576. IF ppass=11 THEN
  577.  
  578.   GOSUB CoordEquat
  579.   hp(retro)=hp: dp(retro)=dp
  580.   IF retro <4 THEN retro=retro+1: n!=n!-nbj: GOTO Menus
  581.   LOCATE 15,26
  582.   PRINT "Choose:  10 - Zodiacal Sight"
  583.   GOSUB Waiting
  584.   GOTO Others
  585. END IF
  586.  
  587. LINE (0,0)-(630,23),3,bf: COLOR 1,3
  588. LOCATE 2,1: PRINT "The ";mois;"/";jour;"/";annee
  589. LOCATE 2,58: PRINT "at ";heure;"h";minute;"m";seconde;"s"
  590. LOCATE 2,30: PRINT  t$: LOCATE 3,30: PRINT  STRING$(LEN(t$),"-")
  591. COLOR 1,0
  592. LOCATE 5,1
  593. PRINT "Longitude = ";: PRINT USING "###.####";ld;: PRINT " deg"; TAB(35);"Latitude = ";: PRINT USING "###.###";b*180/pi;: PRINT " deg"
  594. GOSUB CoordEquat
  595. GOSUB RSHour
  596. LOCATE 20,25:INPUT "Detailed information?  (Y/N)  ",r$:r$=UCASE$(r$)
  597. IF LEFT$(r$,1)="Y" THEN
  598.   GOSUB Detail
  599.   GOTO Others
  600. END IF
  601. RETURN
  602.  
  603. Detail:
  604. '------
  605. CLS
  606. LINE (0,0)-(630,19),3,bf: COLOR 1,3
  607. LOCATE 2,1: PRINT "The ";mois;"/";jour;"/";annee
  608. LOCATE 2,58: PRINT "at ";heure;"h";minute;"m";seconde;"s"
  609. r$="ITEM OF  "
  610. LOCATE 2,(38-(LEN(r$)+LEN(t$))/2)
  611. PRINT  r$+t$
  612. PRINT: COLOR 1,0
  613. PRINT "Heliographic Coordinates:"
  614. lx=lx-INT(lx/360)*360:lxd=INT(lx*1000)/1000
  615. dlong=ABS(lxd-lsol)
  616. PRINT "Mean Longitude    = ";:PRINT USING "###.###";lxd;: PRINT " deg";:PRINT TAB(40);"Eccentricity   = ";: PRINT USING "#.######";e(j)
  617. px=px-INT(px/360)*360: pxd=INT(px*1000)/1000
  618. PRINT "Perihelion        = ";:PRINT USING "###.###";pxd;: PRINT " deg";:PRINT TAB(40);"Inclination    = ";: PRINT USING "##.###";i#(j)*180/pi;: PRINT " deg"
  619. o=o-INT(o/(pi))*pi
  620. PRINT "Node              = ";: PRINT USING "###.###";o*180/pi;: PRINT " deg";: PRINT TAB(40);"Semi-major axis= ";: PRINT USING "##.######";a(j)
  621. PRINT "                M = ";: PRINT USING "###.###";(lx-px)
  622. IF u>2*pi THEN u=u-INT(u/pi)*pi
  623. IF u<0 THEN u=u+2*pi
  624. IF v<0 THEN v=v+2*pi
  625. PRINT "Eccentric Anomaly = ";: PRINT USING "###.###";u*180/pi;: PRINT" deg"; TAB(40);"True Anomaly   = ";: PRINT USING "###.###";v*180/pi;: PRINT " deg"
  626. IF ls<0 THEN ls=ls+2*pi
  627. PRINT "Longitude         = ";: PRINT USING "###.###";ls*180/pi;: PRINT " deg";TAB(40);"Latitude       = ";: PRINT USING "+##.###";bs*180/pi;: PRINT " deg"
  628. PRINT "Vector Radius     = ";: PRINT USING "###.######";rs
  629. PRINT
  630. PRINT"Cartesian Geocentric Coordinates:"
  631. PRINT "For then Sun    X = ";INT(xs*1000000!)/1000000!; TAB(40);"Y = ";INT(ys*1000000!)/1000000!
  632. PRINT "For Astral      X = ";INT(xp*1000000!)/1000000!; TAB(40);"Y = ";INT(yp*1000000!)/1000000!;"    Z = ";INT(zp*1000000!)/1000000!
  633. PRINT
  634. PRINT "Equatorial Geocentric Coordinates:"
  635. IF l<0 THEN l=l+2*pi
  636. PRINT "Longitude         = ";: PRINT USING "###.###";(l*180/pi);: PRINT " deg";
  637. TAB(40);"Latitude       = ";: PRINT USING "+##.###";(b*180/pi);: PRINT " deg"
  638. PRINT "Radius            = ";: PRINT USING "##.######";r;: PRINT TAB(40);"Apparent Diam. = ";: PRINT USING "##.#####";(di/r);: PRINT " sec"
  639. q=SQR(a(j))
  640. theta=ATN((q-1)/q*SQR(1+q*q))*180/pi
  641. sens$="Retrograde"
  642. IF dlong>theta THEN sens$="Direct"
  643. PRINT
  644. PRINT "Direction of the geocentric motion = ";sens$
  645. GOSUB Waiting
  646. RETURN
  647.  
  648. END
  649.  
  650. CoordEquat:
  651. '----------
  652. ep=.409138058#
  653. sd=COS(ep)*SIN(b)+SIN(ep)*COS(b)*SIN(l)
  654. de=ATN(sd/SQR(1-sd*sd))
  655. sr=COS(ep)*COS(b)*SIN(l)-SIN(ep)*SIN(b)
  656. rd=ATN(sr/COS(b)/COS(l))
  657. IF COS(l)*COS(b)<0 THEN rd=rd+pi
  658. IF rd<0 THEN rd=rd+2*pi
  659. rd=(rd/2/pi-INT(rd/2/pi))*2*pi
  660. r5=rd
  661. h=INT(rd/pi*12)
  662. m=INT((rd-h*pi/12)*720/pi)
  663. s=INT((rd-h*pi/12-m*pi/720)*43200&/pi)
  664. d5=de
  665. IF ch=9 THEN
  666.   LINE (0,70)-(632,92),3,bf
  667.   ELSE
  668.   LINE (0,46)-(632,68),3,bf
  669. END IF
  670. COLOR 1,3
  671. PRINT
  672. hp=h+m/60
  673. LOCATE ,5
  674. IF ppass<>11 THEN
  675.         PRINT "Right Ascension"; TAB(23);": ";
  676.         PRINT USING "##";h;: PRINT "h ";: PRINT USING "##";m;: PRINT "m ";: PRINT USING "##.#";s;: PRINT "s"
  677. END IF
  678. de=de*180/pi: d0=INT(de): IF d0<0 THEN d0=d0+1
  679. m9=ABS((de-d0)*60): m0=INT(m9): s=INT((m9-m0)*60)
  680. dp=de
  681. LOCATE ,5
  682. IF ppass<>11 THEN
  683.    PRINT "Déclination"; TAB(23);": ";
  684.         PRINT USING "+##";d0;: PRINT "° ";: PRINT USING "##";m0;: PRINT "' ";: PRINT USING "##.#";s;: PRINT "''"
  685. END IF
  686. COLOR 1,0
  687. IF ch=9 THEN GOSUB RestoreData
  688. PRINT
  689. IF ppass<>11 THEN PRINT "Rectangular Coord. :"; TAB(23);": ";"X = ";xp;"  Y = ";yp;"  Z = ";zp
  690. RETURN
  691.  
  692. DegRad:
  693. '------
  694. ld=l*180/pi
  695. ld=(ld/360-INT(ld/360))*360
  696. IF ld<0 THEN ld=ld+360
  697. ld=INT(ld*10000+.5)/10000
  698. RETURN
  699.  
  700. RSHour:
  701. '-------
  702. lar=laa*pi/180: lor=loa*pi/180: hd=r5/pi*12
  703. tl=TAN(lar): td=TAN(d5): x=-tl*td
  704. IF (1-x*x)<0 THEN PRINT: PRINT "In this place Sighting is not possible": RETURN
  705. xx=-ATN(x/SQR(1-x*x))+pi/2
  706. h=xx*12/pi
  707. lv=24-h+hd: IF lv>24 THEN lv=lv-24
  708. ch=h+hd: IF ch>24 THEN ch=ch-24
  709. lh=lor*12/pi
  710. l1=lv+lh
  711. IF l1>24 THEN l1=l1-24
  712. IF l1<0 THEN l1=l1+24
  713. l2=ch+lh
  714. IF l2>24 THEN l2=l2-24
  715. IF l2<0 THEN l2=l2+24
  716. GOSUB CalculB
  717. l9=l1: GOSUB CalculLC
  718. PRINT
  719. LOCATE ,5: PRINT "Rising Time             = ";h;"H";: PRINT USING "##.##";m;: PRINT "M"
  720. h1=l7
  721. l9=l2: GOSUB CalculLC
  722. LOCATE ,5: PRINT "Setting Time            = ";h;"H";: PRINT USING "##.##";m;: PRINT "M"
  723. h2=l7: IF h1<h2 THEN h3=h1+(h2-h1)/2: GOTO SuiteC
  724. h3=h1+(24-h1+h2)/2
  725. IF h3>24 THEN h3=h3-24
  726. SuiteC:
  727. h=INT( h3): h=h-INT(h/24)*24: IF h<0 THEN h=h+24: m=INT((h3-h)*60)
  728. LOCATE ,5: PRINT "Passage at the meridian = ";h;"H";: PRINT USING "##.##";m;: PRINT "M"
  729. RETURN
  730.  
  731. CalculLC:
  732. t0=quant*.0657098-b3: IF t0<0 THEN t0=t0+24
  733. l8=l9-t0: IF l8<0 THEN l8=l8+24
  734. l7=l8*.99727
  735. h=INT(l7): h=h-INT(h/24)*24:IF h<0 THEN h=h+24: m=INT((l7-h)*60)
  736. RETURN
  737.  
  738. CalculB:
  739. JulianD#=nva+2415383.5#
  740. s3=JulianD#-2415020&
  741. t3=s3/36525&
  742. r3=6.6460656#+(2400.051262#*t3)+(.00002581#*t3*t3)
  743. u3=r3-(24*(annee-1900))
  744. b3=24-u3
  745. RETURN
  746.  
  747. Waiting:
  748. '-------
  749. COLOR 1,3
  750. PRINT: PRINT:LOCATE ,25: INPUT " Hit <RETURN> to continue .... ", q$
  751. COLOR 1,0
  752. RETURN
  753.  
  754. Zodiac:
  755.   CLS
  756.   IF hp<= 8 OR (ppass=11 AND hp(1)<=8) THEN ZodI
  757.   IF (hp>8 AND hp<=16) OR (ppass=11 AND (hp(1)>8 AND hp(1)<=16)) THEN ZodII
  758.   IF (hp>16 AND hp<24) OR (ppass=11 AND (hp(1)>16 AND hp(1)<24)) THEN ZodIII
  759.   GOTO Others
  760.  
  761. ZodI:
  762. '******************************************************
  763. '       Zodiac for R.A. 00 to 08 hours                *
  764. '******************************************************
  765.  
  766. dx = 15: dy = 120: dh=0: b=47
  767. DEF FNeclipt1(x) =dy+b*SIN((x)/900*pi-2*pi/3)
  768. coul = 3
  769. h=hp: d=dp: GOSUB coord: xp=x: yp=y
  770. LOCATE 5,30: PRINT "ZODIACAL  SIGHT"
  771. LOCATE 10,15: INPUT "With referencial grid ? .................  (Y/N) : ",a$
  772. LOCATE 12,15: INPUT "With symbolic out-line of constellations?  (Y/N) : ",b$
  773. cl = 2
  774. a$=UCASE$(LEFT$(a$,1))
  775. b$=UCASE$(LEFT$(b$,1))
  776. CLS
  777. LOCATE 1,5: t$=UCASE$(t$)
  778. pln$="planet  ": IF t$="M O O N" THEN pln$=""
  779. COLOR 3
  780. PRINT "Position of  ";pln$; t$;"  the "mois"/"jour"/"annee"  at  "heure"h"minute
  781. COLOR 1
  782. IF a$= "N"  AND b$ = "N" THEN coul=0: cl=0: GOTO eclipticI
  783. IF a$ = "N"  AND b$ <> "N" THEN coul=0: cl = 2: GOTO eclipticI
  784. IF b$ = "N" THEN cl = 0
  785.  
  786. ' right ascension
  787. FOR i=0 TO 8
  788.   LINE (dx+75*i,20)-(dx+75*i,220),coul
  789. NEXT
  790.  
  791. LOCATE 2,1
  792. PRINT "R.A."
  793. LOCATE 3,2
  794. PRINT "8h"; TAB(12)"7h";TAB(21)"6h";TAB(30)"5h";TAB(39)"4h";
  795. PRINT TAB(49)"3h";TAB(58)"2h";TAB(67)"1h";TAB(77)"0h"
  796.  
  797. ' déclinatison
  798. FOR i=1 TO 7
  799.   FOR j=0 TO 635 STEP 2
  800.     LINE (j,30*i)-(j,30*i),coul
  801. NEXT j,i
  802. LOCATE 8,2: PRINT "30°"
  803. LOCATE 15,2: PRINT "0°"
  804. LOCATE 23,1: PRINT "-30°"
  805.  
  806. eclipticI:
  807. FOR i=-dx TO 600+dx STEP 3
  808.   y=FNeclipt1(i)
  809.   PSET (dx+i,y),3
  810. NEXT
  811.  
  812. LOCATE 28,7
  813. PRINT "G E M I N I"; TAB(26) "T A U R U S";
  814. PRINT TAB(45) "A R I E S"; TAB(64) "P I S C E S"
  815.  
  816. ' stars
  817. PATTERN &H8888
  818.  
  819. pegasus1:
  820.   COLOR 1
  821.   h=.15: d=15: GOSUB coord: x1=x: y1=y: GOSUB mag1
  822.   h=.1: d=29.2: GOSUB coord: x2=x: y2=y: GOSUB mag1
  823.   h=1.1: d=35.4: GOSUB coord: x3=x: y3=y: GOSUB mag1
  824.   h=2: d=42: GOSUB coord: x4=x: y4=y: GOSUB mag1
  825.   COLOR cl: IF cl=0 THEN pisces
  826.   LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4)
  827. pisces:
  828.   COLOR 1
  829.   h=0: d=7: GOSUB coord: x1=x: y1=y: PSET (x,y)
  830.   h=1: d=7: GOSUB coord: x2=x: y2=y: PSET (x,y)
  831.   h=2: d=4.5: GOSUB coord: x3=x: y3=y: PSET (x,y)
  832.   h=1.55: d=16: GOSUB coord: x4=x: y4=y: PSET (x,y)
  833.   COLOR cl: IF cl=0 THEN aries
  834.   LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4)
  835. aries:
  836.   COLOR 1
  837.   h=1.9: d=20: GOSUB coord: x1=x: y1=y: GOSUB mag1
  838.   h=2.08: d=23.7: GOSUB coord: x2=x: y2=y: GOSUB mag1
  839.   h=3: d=20: GOSUB coord: x3=x: y3=y: PSET (x,y)
  840.   h=3.2: d=18: GOSUB coord: x4=x: y4=y: PSET (x,y)
  841.   COLOR cl: IF cl=0 THEN taurus
  842.   LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4)
  843. taurus:
  844.   COLOR 1
  845.   h=4.55: d=17: GOSUB coord: x1=x: y1=y: GOSUB mag2
  846.   h=5.6: d=22: GOSUB coord: x2=x: y2=y: GOSUB mag1
  847.   h=4.33: d=16: GOSUB coord: PSET (x,y)
  848.   h=4.37: d=18: GOSUB coord: PSET (x,y)
  849.   h=4.46: d=19.8: GOSUB coord: PSET (x,y)
  850.   COLOR cl: IF cl=0 THEN gemini
  851.   LINE (x1,y1)-(x2,y2)
  852. gemini:
  853.   COLOR 1
  854.   h=7.6: d=33: GOSUB coord: x1=x: y1=y: GOSUB mag2
  855.   h=7.75: d=28: GOSUB coord: x2=x: y2=y: GOSUB mag2
  856.   h=7.3: d=22: GOSUB coord: x3=x: y3=y: PSET (x,y)
  857.   h=7.26: d=17: GOSUB coord: x4=x: y4=y: PSET (x,y)
  858.   h=7.06: d=20: GOSUB coord: x5=x: y5=y: PSET (x,y)
  859.   h=6.6: d=17: GOSUB coord: x6=x: y6=y: GOSUB mag1
  860.   h=6.4: d=22: GOSUB coord: x7=x: y7=y: PSET (x,y)
  861.   h=6.25: d=22: GOSUB coord: PSET (x,y)
  862.   COLOR cl: IF cl=0 THEN cetus
  863.   LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4)
  864.   LINE -(x5,y5): LINE -(x6,y6): LINE -(x7,y7): LINE -(x1,y1)
  865. cetus:
  866.   COLOR 1
  867.   h=.65: d=-18.3: GOSUB coord: GOSUB mag1
  868.   h=3: d=4: GOSUB coord: GOSUB mag1
  869.   h=.25: d=-8: GOSUB coord: PSET (x,y)
  870.   h=1.1: d=-10: GOSUB coord: PSET (x,y)
  871.   h=1.9: d=-10: GOSUB coord: PSET (x,y)
  872.   h=1.37: d=-8: GOSUB coord: PSET (x,y)
  873.   h=.7: d=-16: GOSUB coord: PSET (x,y)
  874. phoenix:
  875.   COLOR 1
  876.   h=.35: d=-42.8: GOSUB coord: GOSUB mag1
  877. orion:
  878.   COLOR 1
  879.   h=5.9: d=8: GOSUB coord: x1=x: y1=y: GOSUB mag2
  880.   h=5.4: d=7: GOSUB coord: x2=x: y2=y: GOSUB mag1
  881.   h=5.25: d=-8: GOSUB coord: x3=x: y3=y: GOSUB mag2
  882.   h=5.77: d= -9: GOSUB coord: x4=x: y4=y: GOSUB mag1
  883.   h=5.7: d=-3: GOSUB coord: GOSUB mag1
  884.   h=5.6: d=-1.5: GOSUB coord: GOSUB mag1
  885.   h=5.5: d=0: GOSUB coord: GOSUB mag1
  886.   COLOR cl: IF cl=0 THEN perseus
  887.   LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4): LINE -(x1,y1)
  888. perseus:
  889.   COLOR 1
  890.   h=3.85: d=32.5: GOSUB coord: GOSUB mag1
  891.   h=3.92: d=40: GOSUB coord: GOSUB mag1
  892.   h=3.7: d=33: GOSUB coord: PSET (x,y)
  893.   h=3.04: d=38: GOSUB coord: PSET (x,y)
  894.   h=3.11: d=40: GOSUB coord: PSET (x,y)
  895. pleiades:
  896.   COLOR 1
  897.   h=3.72: d=24: GOSUB coord: GOSUB mag1
  898.   h=3.71: d=22: GOSUB coord: PSET (x,y)
  899.   h=3.65: d=23: GOSUB coord: PSET (x,y)
  900.   h=3.62: d=25: GOSUB coord: PSET (x,y)
  901.   h=3.67: d=25.5: GOSUB coord: PSET (x,y)
  902.   h=3.67: d=24.7: GOSUB coord: PSET (x,y)
  903. lepus:
  904.   COLOR 1
  905.   h=5.45: d=-20.5: GOSUB coord: GOSUB mag1
  906.   h=5.55: d=-17.7: GOSUB coord: GOSUB mag1
  907. canisMajor:
  908.   COLOR 1
  909.   h=6.35: d=-18: GOSUB coord: x1=x: y1=y: GOSUB mag1
  910.   h=6.75: d=-16.5: GOSUB coord: x2=x: y2=y: GOSUB mag2
  911.   h=7.13: d=-27: GOSUB coord: x3=x: y3=y: GOSUB mag1
  912.   h=7.4: d=-29.2: GOSUB coord: x4=x: y4=y: GOSUB mag1
  913.   h=6.93: d=-29: GOSUB coord: x5=x: y5=y: GOSUB mag1
  914.   COLOR cl: IF cl=0 THEN auriga
  915.   LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4)
  916.   LINE -(x5,y5): LINE -(x3,y3)
  917. auriga:
  918.   COLOR 1
  919.   h=5.93: d=45: GOSUB coord: x1=x: y1=y: GOSUB mag1
  920.   h=5.97: d=37: GOSUB coord: x2=x: y2=y: GOSUB mag1
  921.   h=5.4: d=28.2: GOSUB coord: x3=x: y3=y: GOSUB mag1
  922.   h=4.9: d=33: GOSUB coord: x4=x: y4=y: GOSUB mag1
  923.   h=5: d=44: GOSUB coord: x5=x: y5=y: PSET (x,y)
  924.   COLOR cl: IF cl=0 THEN eridanus
  925.   LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4): LINE -(x5,y5)
  926. eridanus:
  927.   COLOR 1
  928.   h=5.1: d=-4: GOSUB coord: GOSUB mag1
  929.   h=4.6: d=-3: GOSUB coord: PSET (x,y)
  930.   h=4.18: d=-6: GOSUB coord: PSET (x,y)
  931.   h=3.92: d=-14: GOSUB coord: PSET (x,y)
  932.   h=3.7: d=-9.5: GOSUB coord: PSET (x,y)
  933.   h=3.55: d=-9.4: GOSUB coord: PSET (x,y)
  934.   h=3.6: d=-22: GOSUB coord: PSET (x,y)
  935.   h=3: d=-25: GOSUB coord: PSET (x,y)
  936.   h=4.6: d=-14.5: GOSUB coord: PSET (x,y)
  937.   h=4.55: d=-24: GOSUB coord: PSET (x,y)
  938.   h=4.28: d=-34: GOSUB coord: PSET (x,y)
  939. canisMinor:
  940.   COLOR 1
  941.   h=7.6: d=5.8: GOSUB coord: GOSUB mag2
  942.   h=7.45: d=10: GOSUB coord: PSET (x,y)
  943. colombe:
  944.   COLOR 1
  945.   h=5.65: d=-34: GOSUB coord: GOSUB mag1
  946. divers1:
  947.   COLOR 1
  948.   h=7.3: d=-38: GOSUB coord: GOSUB mag1
  949.   h=8.1: d=-25: GOSUB coord: GOSUB mag1
  950.  
  951. IF ppass<>11 THEN  GOSUB Planet
  952. IF ppass=11 THEN GOSUB Planets: GOTO SuitePln
  953.  
  954. LOCATE 30,40: INPUT "",a$
  955. GOTO Others
  956.  
  957. ZodII:
  958. '******************************************************
  959. '     Zodiac for R.A.  08 to 16 hours                 *
  960. '******************************************************
  961. dx = 15: dy = 120: dh=8: b=47
  962. DEF FNeclipt2(x) = dy+b*SIN((x)/900*pi+2*pi/3)
  963. coul = 3
  964. h=hp: d=dp: GOSUB coord: xp=x: yp=y
  965. LOCATE 5,30: PRINT "ZODIACAL  SIGHT"
  966. LOCATE 10,15: INPUT "With referencial grid? ..................  (Y/N) : ",a$
  967. LOCATE 12,15: INPUT "With symbolic out-line of constellations?  (Y/N) : ",b$
  968. cl = 2
  969. a$=UCASE$(LEFT$(a$,1))
  970. b$=UCASE$(LEFT$(b$,1))
  971. CLS
  972. LOCATE 1,5: t$=UCASE$(t$)
  973. pln$="planet  ": IF t$="M O O N" THEN pln$=""
  974. COLOR 3
  975. PRINT "Position of  ";pln$; t$;"  The "mois"/"jour"/"annee"  at  "heure"h"minute
  976. COLOR 1
  977. IF a$= "N"  AND b$ = "N" THEN coul=0: cl=0: GOTO eclipticII
  978. IF a$ = "N"  AND b$ <> "N" THEN coul=0: cl = 2: GOTO eclipticII
  979. IF b$ = "N" THEN cl = 0
  980.  
  981. ' right ascension
  982. FOR i=0 TO 8
  983.   LINE (dx+75*i,20)-(dx+75*i,220),coul
  984. NEXT
  985. LOCATE 2,1
  986. PRINT "R.A."
  987. LOCATE 3,2
  988. PRINT "16h"; TAB(12)"15h";TAB(21)"14h";TAB(30)"13h";TAB(39)"12h";
  989. PRINT TAB(49)"11h";TAB(58)"10h";TAB(67)"9h";TAB(77)"8h"
  990.  
  991. ' déclination
  992. FOR i=1 TO 7
  993.   FOR j=0 TO 635 STEP 2
  994.     LINE (j,30*i)-(j,30*i),coul
  995. NEXT j,i
  996. LOCATE 8,2: PRINT "30°"
  997. LOCATE 15,2: PRINT "0°"
  998. LOCATE 23,1: PRINT "-30°"
  999.  
  1000. eclipticII:
  1001. FOR i=-dx TO 600+dx STEP 3
  1002.   y=FNeclipt2(i)
  1003.   PSET (dx+i,y),3
  1004. NEXT
  1005.  
  1006. LOCATE 28,8
  1007. PRINT "L I B R A"; TAB(27) "V I R G O";
  1008. PRINT TAB(47) "L E O"; TAB(64) "C A N C E R"
  1009.  
  1010. ' stars
  1011. PATTERN &H8888
  1012. cancer:
  1013.   COLOR 1
  1014.   h=8.95: d=12: GOSUB coord: x1=x: y1=y: PSET (x,y)
  1015.   h=8.75: d=19: GOSUB coord: x2=x: y2=y: PSET (x,y)
  1016.   h=8.25: d=10: GOSUB coord: x3=x: y3=y: GOSUB mag1
  1017.   h=8.7: d=22: GOSUB coord: x4=x: y4=y: PSET (x,y)
  1018.   COLOR cl: IF cl=0 THEN leo
  1019.   LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE (x4,y4)-(x2,y2)
  1020. leo:
  1021.   COLOR 1
  1022.   h=10.1: d=12: GOSUB coord: x1=x: y1=y: GOSUB mag2
  1023.   h=10.1: d=18: GOSUB coord: x2=x: y2=y: PSET (x,y)
  1024.   h=10.3: d=21: GOSUB coord: x3=x: y3=y: GOSUB mag1
  1025.   h=11.23: d=21.1: GOSUB coord: x4=x: y4=y: GOSUB mag1
  1026.   h=11.77: d=15: GOSUB coord: x5=x: y5=y: GOSUB mag1
  1027.   h=11.28: d=16: GOSUB coord: x6=x: y6=y: PSET (x,y)
  1028.   h=10.32: d=24.2: GOSUB coord: x7=x: y7=y: PSET (x,y)
  1029.   h=9.84: d=27: GOSUB coord: x8=x:y8=y: PSET (x,y)
  1030.   h=9.76: d=24: GOSUB coord: x9=x: y9=y: PSET (x,y)
  1031.   COLOR cl: IF cl=0 THEN virgo
  1032.   LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4): LINE -(x5,y5)
  1033.   LINE -(x6,y6): LINE -(x1,y1): LINE (x3,y3)-(x7,y7)
  1034.   LINE -(x8,y8): LINE -(x9,y9)
  1035. virgo:
  1036.   COLOR 1
  1037.   h=13.4: d=-11: GOSUB coord: x1=x: y1=y: GOSUB mag2
  1038.   h=13.6: d=0: GOSUB coord: x2=x: y2=y: PSET (x,y)
  1039.   h=12.96: d=11.5: GOSUB coord: x3=x: y3=y: GOSUB mag1
  1040.   h=12.9: d=6: GOSUB coord: x4=x: y4=y: PSET (x,y)
  1041.   h=12.62: d=-1: GOSUB coord: x5=x: y5=y: GOSUB mag1
  1042.   h=12.3: d=0: GOSUB coord: x6=x: y6=y: PSET (x,y)
  1043.   h=11.83: d=3.5: GOSUB coord: x7=x: y7=y: PSET (x,y)
  1044.   COLOR cl: IF cl=0 THEN libra
  1045.   LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4)
  1046.   LINE -(x5,y5): LINE -(x1,y1): LINE (x5,y5)-(x6,y6): LINE -(x7,y7)
  1047. libra:
  1048.   COLOR 1
  1049.   h=14.75: d=-16: GOSUB coord: x1=x: y1=y: GOSUB mag1
  1050.   h=15.25: d=-9: GOSUB coord: x2=x: y2=y: GOSUB mag1
  1051.   h=15.62: d=-14: GOSUB coord: x3=x: y3=y: PSET (x,y)
  1052.   h=15.2: d=-19: GOSUB coord: x4=x: y4=y: PSET (x,y)
  1053.   COLOR cl: IF cl=0 THEN scorpius2
  1054.   LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4): LINE -(x1,y1)
  1055. scorpius2:
  1056.   COLOR 1
  1057.   h=15.9: d=-26: GOSUB coord: GOSUB mag1
  1058.   h=15.95: d=-22: GOSUB coord: GOSUB mag1
  1059.   h=16.05: d=-19.5: GOSUB coord: GOSUB mag1
  1060. corvus:
  1061.   COLOR 1
  1062.   h=12.55: d=-23: GOSUB coord: x1=x: y1=y: GOSUB mag1
  1063.   h=12.5: d=-16: GOSUB coord: x2=x: y2=y: PSET (x,y)
  1064.   h=12.25: d=-17.2: GOSUB coord: x3=x: y3=y: GOSUB mag1
  1065.   h=12.15: d=-22.2: GOSUB coord: x4=x: y4=y: PSET (x,y)
  1066.   COLOR cl: IF cl=0 THEN lynx
  1067.   LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4): LINE -(x1,y1)
  1068. lynx:
  1069.   COLOR 1
  1070.   h=9.4: d=35: GOSUB coord: x1=x: y1=y: PSET (x,y)
  1071.   h=9.3: d=37: GOSUB coord: x2=x: y2=y: PSET (x,y)
  1072.   h=8.3: d=44: GOSUB coord: x3=x: y3=y: PSET (x,y)
  1073.   COLOR cl: IF cl=0 THEN leoMinor
  1074.   LINE (x1,y1)-(x2,y2): LINE -(x3,y3)
  1075. leoMinor:
  1076.   COLOR 1
  1077.   h=11.35: d=34: GOSUB coord: x1=x: y1=y: PSET (x,y)
  1078.   h=10.9: d=35.2: GOSUB coord: x2=x: y2=y: PSET (x,y)
  1079.   h=10.4: d=35.1: GOSUB coord: x3=x: y3=y: PSET (x,y)
  1080.   h=10.47: d=37.6: GOSUB coord: x4=x: y4=y: PSET (x,y)
  1081.   COLOR cl: IF cl=0 THEN hydra
  1082.   LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4): LINE -(x2,y2)
  1083. hydra:
  1084.   COLOR 1
  1085.   h=8.65: d=4.2: GOSUB coord: x1=x: y1=y: PSET (x,y)
  1086.   h=8.6: d=6.4: GOSUB coord: x2=x: y2=y: PSET (x,y)
  1087.   h=8.75: d=6.6: GOSUB coord: x3=x: y3=y: PSET (x,y)
  1088.   h=8.9: d=6.4: GOSUB coord: x4=x: y4=y: PSET (x,y)
  1089.   h=9.23: d=3.2: GOSUB coord: x5=x: y5=y: PSET (x,y)
  1090.   h=9.4: d=-8.5: GOSUB coord: x6=x: y6=y: GOSUB mag1
  1091.   h=10.15: d=-13: GOSUB coord: x7=x: y7=y: PSET (x,y)
  1092.   h=11.5: d=-32: GOSUB coord: x8=x: y8=y: PSET (x,y)
  1093.   h=11.96: d=-33.5: GOSUB coord: x9=x: y9=y: PSET (x,y)
  1094.   h=13.3: d=-22: GOSUB coord: x10=x: y10=y: PSET (x,y)
  1095.   h=14.05: d=-26: GOSUB coord: x11=x: y11=y: PSET (x,y)
  1096.   COLOR cl: IF cl=0 THEN bootes
  1097.   LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4): LINE -(x5,y5)
  1098.   LINE -(x6,y6): LINE -(x7,y7): LINE -(x8,y8): LINE -(x9,y9)
  1099.   LINE -(x10,y10): LINE -(x11,y11)
  1100. bootes:
  1101.   COLOR 1
  1102.   h=13.9: d=19: GOSUB coord: x1=x: y1=y: GOSUB mag1
  1103.   h=14.27: d=19.5: GOSUB coord: x2=x: y2=y: GOSUB mag2
  1104.   h=14.7: d=27.7: GOSUB coord: x3=x: y3=y: GOSUB mag1
  1105.   h=15.28: d=34: GOSUB coord: x4=x: y4=y: PSET (x,y)
  1106.   h=15.03: d=41.6: GOSUB coord: x5=x: y5=y: PSET (x,y)
  1107.   h=14.46: d=40: GOSUB coord: x6=x: y6=y: GOSUB mag1
  1108.   h=14.5: d=31: GOSUB coord: x7=x: y7=y: PSET (x,y)
  1109.   h=14.68: d=14.8: GOSUB coord: x8=x: y8=y: PSET (x,y)
  1110.   COLOR cl: IF cl=0 THEN divers2
  1111.   LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4): LINE -(x5,y5)
  1112.   LINE -(x6,y6): LINE -(x7,y7): LINE -(x2,y2): LINE -(x8,y8)
  1113. divers2:
  1114.   COLOR 1
  1115.   h=8.1: d=-24: GOSUB coord: GOSUB mag1
  1116.   h=13.32: d=-36.5: GOSUB coord: GOSUB mag1
  1117.   h=14.05: d=-36: GOSUB coord: GOSUB mag1
  1118.   h=14.57: d=-42: GOSUB coord: GOSUB mag1
  1119.   h=14.92: d=-43: GOSUB coord: GOSUB mag1
  1120.   h=15.55: d=-41: GOSUB coord: GOSUB mag1
  1121.   h=15.7: d=7: GOSUB coord: GOSUB mag1
  1122.   h=15.6: d=27.5: GOSUB coord: GOSUB mag1
  1123.   h=12.9: d=39: GOSUB coord: GOSUB mag1
  1124.   h=12.6: d=42: GOSUB coord: PSET (x,y)
  1125.   h=11.3: d=-15: GOSUB coord: PSET (x,y)
  1126.  
  1127. IF ppass<>11 THEN  GOSUB Planet
  1128. IF ppass=11 THEN GOSUB Planets: GOTO SuitePln
  1129.  
  1130. LOCATE 30,40: INPUT "",a$
  1131. GOTO Others
  1132.  
  1133. ZodIII:
  1134. '******************************************************
  1135. '     Zodiac for R.A.  16 to 24 hours                 *
  1136. '******************************************************
  1137. dx = 15: dy = 120: dh=16: b=47
  1138. DEF FNeclipt3(x) =dy+b*SIN((x)/900*pi)
  1139. coul = 3
  1140. h=hp: d=dp: GOSUB coord: xp=x: yp=y
  1141. LOCATE 5,30: PRINT "ZODIACAL  SIGHT"
  1142. LOCATE 10,15: INPUT "With referencial grid? ..................  (Y/N) : ",a$
  1143. LOCATE 12,15: INPUT "With symbolic out-line of constellations?  (Y/N) : ",b$
  1144. cl = 2
  1145. a$=UCASE$(LEFT$(a$,1))
  1146. b$=UCASE$(LEFT$(b$,1))
  1147. CLS
  1148. LOCATE 1,5: t$=UCASE$(t$)
  1149. pln$="planet  ": IF t$="M O O N" THEN pln$=""
  1150. COLOR 3
  1151. PRINT "Position of  "; pln$; t$;"  the "mois"/"jour"/"annee"  at  "heure"h"minute
  1152. COLOR 1
  1153. IF a$= "N"  AND b$ = "N" THEN coul=0: cl=0: GOTO eclipticIII
  1154. IF a$ = "N"  AND b$ <> "N" THEN coul=0: cl = 2: GOTO eclipticIII
  1155. IF b$ = "N" THEN cl = 0
  1156.  
  1157. ' right ascension
  1158. FOR i=0 TO 8
  1159.   LINE (dx+75*i,20)-(dx+75*i,220),coul
  1160. NEXT
  1161. LOCATE 2,1
  1162. PRINT "A.D."
  1163. LOCATE 3,2
  1164. PRINT "24h"; TAB(12)"23h";TAB(21)"22h";TAB(30)"21h";TAB(39)"20h";
  1165. PRINT TAB(49)"19h";TAB(58)"18h";TAB(67)"17h";TAB(77)"16h"
  1166.  
  1167. ' déclination
  1168. FOR i=1 TO 7
  1169.   FOR j=0 TO 635 STEP 2
  1170.     LINE (j,30*i)-(j,30*i),coul
  1171. NEXT j,i
  1172. LOCATE 8,2: PRINT "30°"
  1173. LOCATE 15,2: PRINT "0°"
  1174. LOCATE 23,1: PRINT "-30°"
  1175.  
  1176. eclipticIII:
  1177. FOR i=-dx TO 600+dx STEP 3
  1178.   y=FNeclipt3(i)
  1179.   PSET (dx+i,y),3
  1180. NEXT
  1181.  
  1182. LOCATE 28,5
  1183. PRINT "A Q U A R I U S"; TAB(25) "C A P R I C ";
  1184. PRINT TAB(44) "S A G I T T" ; TAB(62) "S C O R P I U S"
  1185.  
  1186. ' stars
  1187. PATTERN &H8888
  1188. scorpius3:
  1189.   COLOR 1
  1190.   h=15.9: d=-25.5: GOSUB coord: x1=x: y1=y: GOSUB mag1
  1191.   h=15.96: d=-22: GOSUB coord: x2=x: y2=y: GOSUB mag1
  1192.   h=16.05: d=-20: GOSUB coord: x3=x: y3=y: GOSUB mag1
  1193.   h=16.45: d=-25.8: GOSUB coord: x4=x: y4=y: GOSUB mag2
  1194.   h=16.55: d=-26: GOSUB coord: x5=x: y5=y: GOSUB mag1
  1195.   h=16.75: d=-34: GOSUB coord: x6=x: y6=y: GOSUB mag1
  1196.   h=16.8: d=-37: GOSUB coord: x7=x: y7=y: PSET (x,y)
  1197.   h=16.85: d=-41.2: GOSUB coord: x8=x: y8=y: PSET (x,y)
  1198.   h=17.15: d=-42.5: GOSUB coord: x9=x: y9=y: PSET (x,y)
  1199.   h=17.6: d=-42: GOSUB coord: x10=x: y10=y: GOSUB mag1
  1200.   h=17.68: d=-38: GOSUB coord: x11=x: y11=y: GOSUB mag1
  1201.   h=17.6: d=-36: GOSUB coord: x12=x: y12=y: GOSUB mag1
  1202.   h=17.5: d=-36.4: GOSUB coord: x13=x: y13=y: GOSUB mag1
  1203.   COLOR cl: IF cl=0 THEN sagittarius
  1204.   LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4): LINE -(x5,y5)
  1205.   LINE -(x6,y6): LINE -(x7,y7): LINE -(x8,y8): LINE -(x9,y9)
  1206.   LINE -(x10,y10): LINE -(x11,y11): LINE -(x12,y12): LINE -(x13,y13)
  1207. sagittarius:
  1208.   COLOR 1
  1209.   h=18.3: d=-36: GOSUB coord: x1=x: y1=y: PSET (x,y)
  1210.   h=18.4: d=-35: GOSUB coord: x2=x: y2=y: GOSUB mag1
  1211.   h=18.3: d=-29.7: GOSUB coord: x3=x: y3=y: GOSUB mag1
  1212.   h=18.4: d=-27: GOSUB coord: x4=x: y4=y: GOSUB mag1
  1213.   h=18.7: d=-28: GOSUB coord: x5=x: y5=y: PSET (x,y)
  1214.   h=18.95: d=-30: GOSUB coord: x6=x: y6=y: GOSUB mag1
  1215.   h=19.1: d=-27: GOSUB coord: x7=x: y7=y: PSET (x,y)
  1216.   h=18.9: d=-26: GOSUB coord: x8=x: y8=y: GOSUB mag1
  1217.   h=18.2: d=-19: GOSUB coord: x9=x: y9=y: PSET (x,y)
  1218.   h=18.93: d=-19.3: GOSUB coord: x10=x: y10=y: PSET (x,y)
  1219.   h=19.1: d=-18.7: GOSUB coord: x11=x: y11=y: PSET (x,y)
  1220.   COLOR cl: IF cl=0 THEN capricornus
  1221.   LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4): LINE -(x5,y5)
  1222.   LINE -(x6,y6): LINE -(x7,y7): LINE -(x8,y8): LINE -(x5,y5)
  1223.   LINE (x4,y4)-(x9,y9): LINE -(x10,y10): LINE -(x11,y11)
  1224. capricornus:
  1225.   COLOR 1
  1226.   h=20.27: d=-15: GOSUB coord: x1=x: y1=y: PSET (x,y)
  1227.   h=21.07: d=-16.5: GOSUB coord: x2=x: y2=y: PSET (x,y)
  1228.   h=21.4: d=-16.5: GOSUB coord: x3=x: y3=y: PSET (x,y)
  1229.   h=21.75: d=-16: GOSUB coord: x4=x: y4=y: GOSUB mag1
  1230.   COLOR cl: IF cl=0 THEN aquarius
  1231.   LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4)
  1232. aquarius:
  1233.   COLOR 1
  1234.   h=20.8: d=-10: GOSUB coord: x1=x: y1=y: PSET (x,y)
  1235.   h=21.5: d=-6: GOSUB coord: x2=x: y2=y: PSET (x,y)
  1236.   h=22.1: d=0: GOSUB coord: x3=x: y3=y: GOSUB mag1
  1237.   h=22.35: d=-.5: GOSUB coord: x4=x: y4=y: GOSUB mag1
  1238.   h=22.9: d=-16: GOSUB coord: x5=x: y5=y: PSET (x,y)
  1239.   COLOR cl: IF cl=0 THEN serpens
  1240.   LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4): LINE -(x5,y5)
  1241. serpens:
  1242.   COLOR 1
  1243.   h=15.95: d=16.3: GOSUB coord: x1=x: y1=y: PSET (x,y)
  1244.   h=15.8: d=16: GOSUB coord: x2=x: y2=y: PSET (x,y)
  1245.   h=15.6: d=12: GOSUB coord: x3=x: y3=y: PSET (x,y)
  1246.   h=15.75: d=7: GOSUB coord: x4=x: y4=y: GOSUB mag1
  1247.   h=15.8: d=-4: GOSUB coord: x5=x: y5=y: PSET (x,y)
  1248.   h=16.6: d=-10: GOSUB coord: x6=x: y6=y: GOSUB mag1
  1249.   h=17.1: d=-15.2: GOSUB coord: x7=x: y7=y: GOSUB mag1
  1250.   h=17.3: d=-23: GOSUB coord: x8=x: y8=y: PSET (x,y)
  1251.   h=16.2: d=-4: GOSUB coord: x9=x: y9=y: PSET (x,y)
  1252.   h=16.55: d=3: GOSUB coord: x10=x: y10=y: PSET (x,y)
  1253.   h=16.95: d=11: GOSUB coord: x11=x: y11=y: PSET (x,y)
  1254.   h=17.6: d=13: GOSUB coord: x12=x: y12=y: GOSUB mag1
  1255.   h=17.7: d=5.5: GOSUB coord: x13=x: y13=y: GOSUB mag1
  1256.   h=17.8: d=3.8: GOSUB coord: x14=x: y14=y: PSET (x,y)
  1257.   COLOR cl: IF cl=0 THEN aquila
  1258.   LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4): LINE -(x5,y5)
  1259.   LINE -(x6,y6): LINE -(x7,y7): LINE -(x8,y8): LINE (x6,y6)-(x9,y9)
  1260.   LINE -(x10,y10): LINE -(x11,y11): LINE -(x12,y12)
  1261.   LINE -(x13,y13): LINE -(x14,y14)
  1262. aquila:
  1263.   COLOR 1
  1264.   h=19.1: d=-6: GOSUB coord: x1=x: y1=y: PSET (x,y)
  1265.   h=19.4: d=5: GOSUB coord: x2=x: y2=y: PSET (x,y)
  1266.   h=19.8: d=10: GOSUB coord: x3=x: y3=y: GOSUB mag2
  1267.   h=19.75: d=12: GOSUB coord: x4=x: y4=y: GOSUB mag1
  1268.   h=19.92: d=8: GOSUB coord: x5=x: y5=y: PSET (x,y)
  1269.   h=20.2: d=-.5: GOSUB coord: x6=x: y6=y: PSET (x,y)
  1270.   h=19.65: d=0: GOSUB coord: x7=x: y7=y: PSET (x,y)
  1271.   h=19.05: d=14.5: GOSUB coord: x8=x: y8=y: PSET (x,y)
  1272.   COLOR cl: IF cl=0 THEN pegasus3
  1273.   LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE (x3,y3)-(x4,y4)
  1274.   LINE -(x5,y5): LINE -(x6,y6): LINE (x7,y7)-(x2,y2): LINE -(x8,y8)
  1275. pegasus3:
  1276.   COLOR 1
  1277.   h=21.7: d=9.5: GOSUB coord: x1=x: y1=y: GOSUB mag1
  1278.   h=22.17: d=7: GOSUB coord: x2=x: y2=y: PSET (x,y)
  1279.   h=22.7: d=12.5: GOSUB coord: x3=x: y3=y: PSET (x,y)
  1280.   h=23.07: d=15: GOSUB coord: x4=x: y4=y: GOSUB mag1
  1281.   h=24.15: d=15: GOSUB coord: x5=x: y5=y: GOSUB mag1
  1282.   h=24.1: d=29.2: GOSUB coord: x6=x: y6=y: GOSUB mag1
  1283.   h=23.05: d=28: GOSUB coord: x7=x: y7=y: GOSUB mag1
  1284.   COLOR cl: IF cl=0 THEN piscisAust
  1285.   LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4): LINE -(x5,y5)
  1286.   LINE -(x6,y6): LINE -(x7,y7): LINE -(x4,y4)
  1287. piscisAust:
  1288.   COLOR 1
  1289.   h=22.5: d=-32: GOSUB coord: x1=x: y1=y: PSET (x,y)
  1290.   h=22.9: d=-30: GOSUB coord: x2=x: y2=y: GOSUB mag1
  1291.   h=22.65: d=-26: GOSUB coord: x3=x: y3=y: PSET (x,y)
  1292.   COLOR cl: IF cl=0 THEN cygnus
  1293.   LINE (x1,y1)-(x2,y2): LINE -(x3,y3)
  1294. cygnus:
  1295.   COLOR 1
  1296.   h=21.8: d=30: GOSUB coord: x1=x: y1=y: PSET (x,y)
  1297.   h=21.25: d=30: GOSUB coord: x2=x: y2=y: PSET (x,y)
  1298.   h=20.75: d=34: GOSUB coord: x3=x: y3=y: GOSUB mag1
  1299.   h=20.36: d=42: GOSUB coord: x4=x: y4=y: GOSUB mag1
  1300.   h=19.75: d=45: GOSUB coord: x5=x: y5=y: GOSUB mag1
  1301.   h=20.58: d=45: GOSUB coord: x6=x: y6=y: GOSUB mag1
  1302.   h=19.54: d=28: GOSUB coord: x7=x: y7=y: PSET (x,y)
  1303.   COLOR cl: IF cl=0 THEN lyra
  1304.   LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4): LINE -(x5,y5)
  1305.   LINE (x6,y6)-(x4,y4): LINE -(x7,y7)
  1306. lyra:
  1307.   COLOR 1
  1308.   h=18.6: d=39: GOSUB coord: x1=x: y1=y: GOSUB mag2
  1309.   h=18.8: d=34: GOSUB coord: x2=x: y2=y: PSET (x,y)
  1310.   h=19: d=33: GOSUB coord: x3=x: y3=y: PSET (x,y)
  1311.   h=19.28: d=38.5: GOSUB coord: x4=x: y4=y: PSET (x,y)
  1312.   COLOR cl: IF cl=0 THEN hercules
  1313.   LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4): LINE -(x1,y1)
  1314. hercules:
  1315.   COLOR 1
  1316.   h=17.95: d=38.5: GOSUB coord: x1=x: y1=y: PSET (x,y)
  1317.   h=17.28: d=38: GOSUB coord: x2=x: y2=y: PSET (x,y)
  1318.   h=16.7: d=39: GOSUB coord: x3=x: y3=y: PSET (x,y)
  1319.   h=16.65: d=32.7: GOSUB coord: x4=x: y4=y: GOSUB mag1
  1320.   h=16.45: d=21: GOSUB coord: x5=x: y5=y: GOSUB mag1
  1321.   h=17.23: d=15: GOSUB coord: x6=x: y6=y: PSET (x,y)
  1322.   h=17.23: d=25.3: GOSUB coord: x7=x: y7=y: PSET (x,y)
  1323.   h=17: d=31.5: GOSUB coord: x8=x: y8=y: PSET (x,y)
  1324.   h=17.8: d=28: GOSUB coord: x9=x: y9=y: PSET (x,y)
  1325.   COLOR cl: IF cl=0 THEN divers3
  1326.   LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4): LINE -(x5,y5)
  1327.   LINE -(x6,y6): LINE -(x7,y7): LINE -(x8,y8): LINE -(x2,y2)
  1328.   LINE (x9,y9)-(x7,y7): LINE (x4,y4)-(x8,y8)
  1329. divers3:
  1330.   COLOR 1
  1331.   h=20.6: d=15: GOSUB coord: PSET (x,y)
  1332.  
  1333. IF ppass<>11 THEN GOSUB Planet
  1334. IF ppass=11 THEN GOSUB Planets: GOTO SuitePln
  1335.  
  1336. LOCATE 30,40: INPUT "",a$
  1337. GOTO Others
  1338.  
  1339. coord:
  1340.   x=615-75*(h-dh): y=120-2*d
  1341. RETURN
  1342.  
  1343. mag1:
  1344. FOR i=-1 TO 1
  1345.   PSET (x,y+i): PSET (x+2*i,y)
  1346. NEXT
  1347. RETURN
  1348.  
  1349. mag2:
  1350. FOR i=-2 TO 2
  1351.   PSET (x,y+i): PSET (x+2*i,y)
  1352.   PSET (x-1,y-1): PSET (x-1,y+1): PSET (x+1,y-1): PSET (x+1,y+1)
  1353. NEXT
  1354. RETURN
  1355.  
  1356. Planet:
  1357. COLOR 3
  1358.   x=xp: y=yp
  1359.   PSET (x,y-2): PSET (x-2,y-1): PSET (x,y-1): PSET (x+2,y-1)
  1360.   PSET (x-1,y-1): PSET (x+1,y-1)
  1361.   PSET (x-4,y): PSET (x-2,y): PSET (x,y): PSET (x+2,y): PSET (x+4,y)
  1362.   PSET (x-3,y): PSET (x-1,y): PSET (x+1,y): PSET (x+3,y)
  1363.   PSET (x-2,y+1): PSET (x,y+1): PSET (x+2,y+1): PSET (x,y+2)
  1364.   PSET (x-1,y+1): PSET (x+1,y+1)
  1365.   COLOR 1
  1366.   PSET (x,y)
  1367.   CIRCLE (x,y),12,1,,,.52
  1368. RETURN
  1369.  
  1370. Planets:
  1371. FOR i=1 TO 4
  1372.   h=hp(i): d=dp(i): GOSUB coord
  1373.   COLOR 3
  1374.   PSET (x,y-2): PSET (x-2,y-1): PSET (x,y-1): PSET (x+2,y-1)
  1375.   PSET (x-1,y-1): PSET (x+1,y-1)
  1376.   PSET (x-4,y): PSET (x-2,y): PSET (x,y): PSET (x+2,y): PSET (x+4,y)
  1377.   PSET (x-3,y): PSET (x-1,y): PSET (x+1,y): PSET (x+3,y)
  1378.   PSET (x-2,y+1): PSET (x,y+1): PSET (x+2,y+1): PSET (x,y+2)
  1379.   PSET (x-1,y+1): PSET (x+1,y+1)
  1380.   COLOR 1
  1381.   PSET (x,y)
  1382.   IF i>1 THEN Fplns
  1383.   CIRCLE (x,y),6,1,,,.52
  1384. Fplns:
  1385. NEXT
  1386. RETURN
  1387.  
  1388.  
  1389. SuitePln:
  1390.   LOCATE 30,40: INPUT "",a$
  1391.   retro=1: ppass=0
  1392.   GOTO Others
  1393.  
  1394.