home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
GEMini Atari
/
GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso
/
files
/
astronmy
/
astro
/
sky_plot.pas
< prev
Wrap
Pascal/Delphi Source File
|
1985-11-19
|
24KB
|
562 lines
{ S K Y P L O T . P A S }
{This menu choice is perhaps the most useful for beginning astronomers and any
people who have a moderate interest in astronomy. This section will produce
three different maps of the sky, all equally useful, and, with the proper
printer selection from the main menu, screen dumps may be made which allow the
observer to actually use the data generated by this program and look for the
actual objects in the night sky. Along with the HORIZON, ZENITH and STAR ATLAS
maps, there is also a ALMANAC choice which will allow the user to obtain a
list of altitudes, azimuths, right ascensions and declinations of all the
objects that this program supports.}
procedure Do_Sky_Plot (choice : integer) ; {sky plot sub menu choice}
var skymenu : menu_ptr ; {menu pointer}
function Hor_Enter : integer ; {return inputted horizon centre}
var
ok : boolean ; x : integer ; {temporary variables}
hor_str : string[255] ;
begin
hor_str := '180' ; {default horizon centre}
prompt := 'Enter horizon centre:' ;
editfld := '___ deg.' ;
values := '999' ;
ok := Multi_Dial (prompt,editfld,values,hor_str) ;
if ok then begin
x := round (Val (hor_str)) ; {return horizon centre}
if x > 359 then x := 359 ; {check if idiot value}
end
else x := -1 ; {if cancelled, return negative flag}
Hor_Enter := x ;
end ; {Hor_Enter}
procedure Make_Table ; {get values for a solar system data table}
var
temporary : fullstr ; {hold the current output device}
l : integer ; {loop control variable}
begin
temporary := device ;
device := 'NUL:' ; {nul device for no output to screen}
for l := 1 to 19 do begin {calculate RA and Dec for each object}
case l of
1,2,4,5,6,7,8,9 : begin
obname[l] :=
concat (planet[l],' ') ;
p := l ;
Planets ;
end ;
3 : begin
obname[l]:='Sun ';
Sun ;
end ;
10 : begin
obname[l]:='Moon ';
Moon ;
end ;
otherwise : begin
obname[l] :=
concat (comet[l-10],' ') ;
c := (l - 10) ;
Comets ;
end ;
end ; {case}
right [l] := RA ; {store results in arrays}
decl [l] := Dec ; {next calculate Altitude and Azimuth of each object}
alts [l] := round (Calc_Alt (t_univ,decl[l],right[l])) ;
azim [l] := round (Calc_Azi (t_univ,decl[l],right[l])) ;
end ;
device := temporary ; {restore output device}
close (outfile) ;
for l := 1 to 166 do begin {calculate star positions for later maps}
salts[l] := round (Calc_Alt (t_univ,sdecl[l],sright[l])) ;
sazim[l] := round (Calc_Azi (t_univ,sdecl[l],sright[l])) ;
end ;
did_current := True ; {don't bother recalculating if data already found}
end ; {Make_Table}
procedure Sky_Table ; {output data table (RA,Dec,altitude,azimuth)}
var
s,t,u,spaces : fullstr ; {temporary strings}
l,x : integer ; {loop variable}
wname : Window_Title ;
begin
wname := ' Solar System Data Table ' ;
wind_open (wname) ;
if not did_current then begin
PrintAt (10,20); writeln (output,'Please wait ... Calculating Values') ;
Make_Table ;
PrintAt (10,20); writeln (output,' ') ;
end ;
spaces := ' ' ;
rewrite (outfile,device) ;
PrintAt (3,1) ; write (outfile,'Object ') ;
PrintAt (3,24) ; write (outfile,'R.A. (h m) Dec. (d m) ') ;
PrintAt (3,54) ; writeln (outfile,'Alt. (deg) Azi. (deg)') ;
PrintAt (4,1) ; writeln (outfile) ;
for l := 1 to 19 do begin {output all the data as big strings}
s := Copy (obname[l],1,23) ;
itoa (Hours(right[l]),t) ; {convert RA to string}
x := 5 - length(t) ; u := Copy (spaces,1,x) ;
s := Concat (s,u,t) ;
itoa (Minutes (right[l]),t) ;
x := 3 - length (t) ; u := Copy (spaces,1,x) ;
s := Concat (s,u,t) ;
itoa (Hours(decl[l]),t) ; {convert Dec to string}
x := 11 - length (t) ; u := Copy (spaces,1,x) ;
s := Concat (s,u,t) ;
itoa (Minutes (decl[l]),t) ;
x := 4 - length (t) ; u := Copy (spaces,1,x) ;
s := Concat (s,u,t) ;
itoa (alts[l],t) ; {convert alt to string}
x := 12 - length (t) ; u := Copy (spaces,1,x) ;
s := Concat (s,u,t) ;
itoa (azim[l],t) ; {convert azim to string}
x := 15 - length (t) ; u := Copy (spaces,1,x) ;
s := Concat (s,u,t) ;
PrintAt (l+3,1) ; writeln (outfile,s) ;
end ;
close (outfile) ;
l := txtcol ; txtcol := black ; wind_close ; txtcol := l ;
end ; {Sky_Table}
procedure Horizon_Plot ; {produce a horizon star and planet plot}
label 1234 ;
const
yscale = 4.285714286 ; {y scale factor}
xscale = 2.307692308 ; {x scale factor}
gyscale = 0.535714285 ; {graphics y scale factor}
gxscale = 0.288461538 ; {graphics x scale factor}
var
object_str : string [19] ; {string contains symbol for each object}
obj : string [ 1] ; {one of the objects in object_str}
l : integer ; {loop control}
horizon : integer ; {horizon values: centre}
lhor,rhor : integer ; {left and right}
xpos,ypos : integer ; {plotting co-ords}
wname : Window_Title ; {window name}
begin
horizon := Hor_Enter ;
if horizon = -1 then goto 1234 ; {if horizon input cancelled, get out!!!}
wname := ' Horizon Map ' ;
wind_open (wname) ;
Clearxy ; {clear a window for information}
if not did_current then begin {check if data calculated yet}
PrintAt (10,20); writeln (output,'Please wait ... Calculating Values') ;
Make_Table ;
PrintAt (10,20); writeln (output,' ') ;
end ;
object_str := 'mV*MJSUNP(ET\!HCnsh' ; {symbols for each object}
lhor := (horizon + 360 - 90) mod 360 ; {horizon is 180 degrees wide}
rhor := (horizon + 360 + 90) mod 360 ; {horizon is 60 degrees tall}
PrintAt (18,1) ; {horizon and legend for planets}
write (output,'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^') ;
write (output,'^^^^^^^^^^^^^^^^^^^^^^^') ; {ground}
PrintAt (19,2) ; {output the legend of the map}
write (output,'m - Mercury V - Venus M - Mars J - Jupiter') ;
write (output,' S - Saturn ') ;
PrintAt (20,2) ;
write (output,'U - Uranus N - Neptune P - Pluto ( - Moon ') ;
write (output,' * - Sun ') ;
PrintAt (21,2) ;
write (output,'E - Encke T - Temple 2 ! - S. W. 1 \ - S. W. 2') ;
write (output,' H - Halley ') ;
PrintAt (22,2) ;
write (output,'C - Crommelin s - Schaumase h - H. Campos n - Neujmin') ;
write (output,' 1') ; {scale around the map}
PrintAt (18,1) ;
write (output,lhor:3) ;
PrintAt (18,39) ;
write (output,horizon) ;
PrintAt (18,76) ;
write (output,rhor:3) ;
PrintAt (4,1) ; write (output,'60') ; {scale at side of map}
PrintAt (4,77) ; write (output,'60') ;
PrintAt (11,1) ; write (output,'30') ;
PrintAt (11,77) ; write (output,'30') ;
PrintAt (17,1) ; write (output,'0') ;
PrintAt (17,78) ; write (output,'0') ;
PrintAt (3,1) ; {output relevant data: date, time, lat, long}
write (output,'Date: Y ',year:4,' M ',month:2,' D ',day:2) ;
PrintAt (3,25) ;
write (output,'Time: ',Hours(t_univ):2,' h ',Minutes(t_univ):2,' m U.T.') ;
PrintAt (3,49) ;
write (output,'Lat: ',round(latitude):3,' deg. Long: ',
round (longitude):4,' deg.') ;
for l := 1 to 19 do begin {routine to plot objects on map}
if ((alts [l] > 0) and (alts [l] < 55)
and (((azim[l]-lhor+360) mod 360) <= 175)) then begin
ypos := 17 - round (alts [l] / yscale) ;
xpos := 2 + round (((azim[l]-lhor+360) mod 360)/xscale) ;
obj := Copy (object_str,l,1) ;
PrintAt (ypos,xpos) ; {plot the object!!!}
write (output,obj) ;
end ;
end ;
for l := 1 to 166 do begin {routine to plot stars on map}
if ((salts [l]> 0) and (((sazim[l]-lhor+360) mod 360) <= 175)) then begin
ypos := (124*resolution) - ((round (salts [l] / gyscale))*resolution) ;
xpos := 16 + round (((sazim[l]-lhor+360) mod 360)/gxscale) ;
Plot (xpos,ypos) ; Plot (xpos+1,ypos) ; Plot (xpos,ypos-1) ;
Plot (xpos,ypos+1) ; Plot (xpos-1,ypos) ;{plot scaled for med/high res}
end ;
end ;
wind_close ;
1234:
end ; {Horizon_Plot}
procedure Zenith_Plot ; {make an overhead map of the sky}
{map too small scale to show planets}
const
c_x = 320 ; {x centre of circle}
c_xsiz = 176 ; {x stretch of circle}
var
wname : Window_Title ;
c_ysiz : integer ; {y stretch of circle (w.r.t. resolution)}
c_y,l : integer ; {y centre of circle, loop variable}
xpos,ypos : integer ; {plotting co-ords}
rad,theta : real ; {variables for rectangular -> polar conversion}
begin
wname := ' Zenith (Overhead) Map ' ;
wind_open (wname) ;
Clearxy ; {clear a window for information}
if not did_current then begin {check if data not yet calculated}
PrintAt (10,20); writeln (output,'Please wait ... Calculating Values') ;
Make_Table ;
PrintAt (10,20); writeln (output,' ') ;
end ;
PrintAt (3,1) ; {output relevant data: date, time, lat, long}
write (output,'Date: Y ',year:4,' M ',month:2,' D ',day:2) ;
PrintAt (3,58) ;
write (output,'Time: ',Hours(t_univ):2,' h ',Minutes(t_univ):2,' m U.T.') ;
PrintAt (4,1) ;
write (output,'Lat: ',round(latitude):3,' deg.') ;
PrintAt (4,63) ;
write (output,'Long: ', round (longitude):4,' deg.') ;
PrintAt ( 3,38) ; write (output,'North') ; {output directions of map}
PrintAt (12,12) ; write (output,'East') ; {once a screendump made, the }
PrintAt (12,65) ; write (output,'West') ; {directions will match if you}
paint_style (1) ; paint_color (scrncol) ; {hold the map above your head}
if resolution = 1 then begin {y stretch of circle}
c_ysiz := 58 ;
c_y := 80 ;
end {routine to calculate the circle}
else begin {size in both medium and high}
c_ysiz := 126 ; {resolutions!!!}
c_y := 166 ;
end ;
Frame_Oval (c_x,c_y,c_xsiz,c_ysiz) ; {draw the circle}
if resolution = 2 then c_ysiz := 163
else c_ysiz := 80 ;
Line (c_x, c_y - c_ysiz, c_x, c_y - c_ysiz + 10) ; {tick marks!}
Line (c_x, c_y + c_ysiz, c_x, c_y + c_ysiz - 10) ;
Line (c_x - c_xsiz, c_y, c_x - c_xsiz + 10, c_y) ;
Line (c_x + c_xsiz, c_y, c_x + c_xsiz - 10, c_y) ;
Line (c_x - 5, c_y, c_x + 5, c_y) ; {crosshair!!}
Line (c_x, c_y + 5, c_x, c_y - 5) ;
for l := 1 to 166 do begin {routine to plot stars}
if salts[l] > 0 then begin
rad := (90.0 - salts[l]) / 93.0 ; {polar to rectangular conversion!}
theta := sazim[l] + 90.0 ;
if theta > 360.0 then theta := theta - 360.0 ;
theta := Deg_to_Rad (theta) ;
xpos := round ((rad * Cos (theta) * c_xsiz)) ; {get x co-ord}
xpos := xpos + c_x ;
ypos := round ((rad * Sin (theta) * c_ysiz)) ; {get y co-ord}
ypos := c_y - ypos ;
Plot (xpos,ypos) ; Plot (xpos+1,ypos) ; Plot (xpos,ypos-1) ;
Plot (xpos,ypos+1) ; Plot (xpos-1,ypos) ; {plot star!!}
end ;
end ;
wind_close ;
end ; {Zenith_Plot}
procedure Star_Atlas ; {output a highly detailed star atlas type map}
var
s_right, s_decl, s, t : string ; {input window centre RA and Dec}
wname : Window_Title ; {window name}
ok : boolean ; {dialog cancel/ok flag}
procedure plot_stars (sx,sy : string) ; {actual routine to plot stars at
around the point sx,sy}
const
ra_fact = 144.404 ; {plotting factors to scale to ST screen: for RA}
de_fact = 9.62464 ; {for Dec}
rad = 57.29578 ; {number degrees/radian}
max_x = 2.209 ; {number of hours on one side of centre of window}
max_y = 18.7 ; {number of degrees on 1 side of centre of window}
deg_hr = 15.0 ; {degrees per hour RA}
twelve = 12.0 ; {for readability???}
rad_hr = 0.261799 ; {radians per hour RA}
var
a,x,y,w,h,win : integer ; {loop, plot co-ords, width, height}
x1,y1,z1,cx,cy : real ; {used in rotation formulas}
x2,y2,z2 : real ; {used in rotation formulas}
theta,c_theta,s_theta : real ; {used in rotation formulas}
c_phi,s_phi,r,d,m : real ; {used in rotation formulas}
loc_string : string ; {string for Draw_String routine}
function rot_x (a,b,c,d : real) : real ; {rotate x by precalculated factors
c and d. Need a,b (old x and y co-ords)}
begin
rot_x := a * c - b * d ;
end ; {rot_x}
function rot_y (a,b,c,d : real) : real ; {rotate y by precalculated factors
c and d. Need a,b (old x and y co-ords)}
begin
rot_y := a * d + b * c ;
end ; {rot_y}
procedure plotter (x,y : integer) ; {produce a blob of pixels on screen}
begin
Plot (x + w,y + h) ;
Plot (x + w + 1,y + h) ; Plot (x + w - 1,y + h) ;
Plot (x + w,y + h + 1) ; Plot (x + w,y + h - 1) ;
end ; {plotter}
procedure Mag_Zero (x,y : integer) ; {make very big blob - < magnitude 0}
begin
plotter (x,y) ; plotter (x,y+2) ;
plotter (x,y-2) ; plotter (x+2,y) ;
plotter (x-2,y) ;
plotter (x,y+1) ; plotter (x,y-1) ;
plotter (x+1,y) ; plotter (x-1,y) ;
end ; {Mag_Zero}
procedure Mag_One (x,y : integer) ; {make almost big blob - < magnitude 1}
begin
plotter (x,y) ;
plotter (x,y+2) ; plotter (x,y-2) ;
plotter (x+2,y) ; plotter (x-2,y) ;
end ; {Mag_One}
procedure Mag_Two (x,y : integer) ; {< magnitude 2}
begin
plotter (x,y) ;
plotter (x+1,y) ; plotter (x-1,y) ;
plotter (x,y+1) ; plotter (x,y-1) ;
end ; {Mag_Two}
procedure Mag_Three (x,y : integer) ; {< magnitude 3}
begin
plotter (x,y) ;
plotter (x+1,y) ;
end ; {Mag_Three}
procedure Mag_Four (x,y : integer) ; {< magnitude 4}
begin
plotter (x,y) ;
end ; {Mag_Four}
procedure Mag_Five (x,y : integer) ; {< magnitude 5}
begin
Plot (x+w,y+h) ;
Plot (x+w+1,y+h) ;
end ; {Mag_Five}
procedure Mag_Six (x,y : integer) ; {all remaining magnitudes}
begin
Plot (x + w,y + h) ;
end ; {Mag_Six}
procedure show_legend ; {output a legend in corner of screen}
var
x,y,u,m,f : integer ; {temporary variables}
s : string ; {output string}
begin
if resolution = 1 then f := 2 else f := 1; {scaling factor for med/high res}
Paint_Rect (2,2,83,168 div f) ; {clear a box for information}
Draw_String (13,20 div f,'Legend') ;
Text_Style (Normal|Underlined) ;
Draw_String (4,38 div f,'Magnitudes') ;
Text_Style (Normal) ;
m := 0 ; x := -w + 15 ;
for y := (58 div f) to (170 div f) do begin
s := Concat ('< ',chr (48 + m)) ; {output '< ' and magnitude number}
Draw_String (33,y,s) ;
u := y - h - (7 div 2) ;
case m of
0 : Mag_Zero (x,u) ; {plot a star corresponding to magnitude}
1 : Mag_One (x,u) ;
2 : Mag_Two (x,u) ;
3 : Mag_Three (x,u) ;
4 : Mag_Four (x,u) ;
5 : Mag_Five (x,u) ;
6 : Mag_Six (x,u) ;
end ; {case}
y := y + (16 div f) ;
m := m + 1 ;
end ;
Frame_Rect (2,2,83,168 div f) ; {draw box}
end ; {show_legend}
begin
Clearxy ;
Text_Style (Outlined) ;
win := Get_Window ; {get current output window}
Work_Rect (win,x,y,w,h) ; {get width and height for scaling purposes}
w := w div 2 ;
h := h div 2 ;
cx := Val (sx) ; {convert input strings to real values}
cy := Val (sy) ;
theta := (twelve - cx) * deg_hr / rad ; {calculate predetermined rotation}
c_theta := Cos (theta) ; s_theta := Sin (theta) ; {amounts}
c_phi := Cos (cy / rad) ; s_phi := Sin (cy / rad) ;
for a := 1 to stars do begin {loop through all 1500 stars}
r := s_ra[a] * rad_hr ;
d := s_de[a] / rad ;
z1 := Cos (d) ; {convert RA and Dec to 3 dimensional cartesian co-ords}
x1 := Cos(r) * z1 ; y1 := Sin(r) * z1 ; z1 := Sin(d) ;
x2 := rot_x (x1,y1,c_theta,s_theta) ; {rotate x,y plane theta degrees}
y2 := rot_y (x1,y1,c_theta,s_theta) ;
x1 := rot_x (x2,z1,c_phi,s_phi) ; {rotate x,z plane phi degrees}
z2 := rot_y (x2,z1,c_phi,s_phi) ;
r := Ambiguity (ArcTan (y2 / x1), x1, y2) ; {convert back to ra and dec}
d := ArcSin (z2) ;
r := r / rad_hr ;
d := d * rad ;
{r and d now contain rotated co-ords to make plotting very easy and distortion
free. Rotation now centred on 12h RA and 0 d Dec (ie: old window centre is now
rotated to 12h and 0 d!!)}
x1 := twelve - r ;
if abs (x1) < max_x then begin {if star greater than 2.2 h from centre}
m := s_mag[a] ; {get magnitude of star} {don't plot}
x := round ((x1 * ra_fact) * Cos (d / rad)) ; {calculate x co-ord}
if resolution = 1 then x := x * 2 ; {change x scaling due to res}
y := round (-d * de_fact) ; {calculate y co-ord}
if m < 0 then Mag_Zero (x,y) {plot according to magnitude}
else if m < 1 then Mag_One (x,y)
else if m < 2 then Mag_Two (x,y)
else if m < 3 then Mag_Three (x,y)
else if m < 4 then Mag_Four (x,y)
else if m < 5 then Mag_Five (x,y)
else Mag_Six (x,y) ;
end ;
end ; {output centre of window data}
loc_string := Concat ('Centre of Window: ',sx,' h RA, ',sy,' d Dec') ;
if resolution = 1 then Text_Color(green) else Text_Color (txtcol) ;
Draw_String (175,10 * resolution,loc_string) ;
show_legend ; {draw legend}
if not scrnwhite then write (chr(27),'p') ;
end ; {plot_stars}
begin
s_right := '055' ;
prompt := 'Window Centre R.A.:' ; {get window centre (2 dialog boxes)}
editfld := '__._ hours' ;
values := '999' ;
ok := Multi_Dial (prompt,editfld,values,s_right) ;
if ok then begin
s_decl := '+02' ;
prompt := 'Window Centre Dec.:' ;
editfld := '___ deg.' ;
values := 'X99' ;
ok := Multi_Dial (prompt,editfld,values,s_decl) ;
if ok then begin {if box not cancelled, parse strings, and plot}
s := Copy (s_decl,1,1) ;
if s <> '-' then Delete (s_decl,1,1) ;
dummy := round (Val (s_decl)) ; {get integer value of declin}
if dummy > 89 then dummy := 89 ; {check for idiot values}
if dummy < -89 then dummy := - 89 ;
itoa (dummy,s_decl) ; {reduce it and reconvert to string}
s := Copy (s_right,1,2) ;
dummy := round (Val (s)) ; {get integer value of right ascen}
if dummy > 23 then dummy := 23 ; {check for idiot values}
itoa (dummy,s) ; {reduce it and reconvert to string}
t := Copy (s_right,3,1) ;
s_right := Concat (s,'.',t) ;
wname := ' Star Atlas ' ;
wind_open (wname) ;
plot_stars (s_right,s_decl) ; {do the plot at RA, Dec}
wind_close ;
end ;
end ;
end ; {Star_Atlas}
begin {do sky plot sub menu choice}
if choice = SOLAR then Sky_Table
else begin
Find_Menu (SKY_MENU, skymenu) ;
repeat
what_event := 0 ; {reset event}
Show_Mouse ;
Draw_Menu (skymenu);
Event (E_Message); {wait until mouse makes a menu selection}
Hide_Mouse;
Erase_Menu (skymenu) ;
if msg[3] = SKY_INFO then About_The_Desktop_Astronomer {do choice}
else case msg[4] of
IT_HOR : Horizon_Plot ;
IT_ZEN : Zenith_Plot ;
IT_ATL : Star_Atlas ;
end ; {case}
Menu_Normal (skymenu,SKY_INFO) ; {restore menus to normal}
Menu_Normal (skymenu,M_FUNC) ;
Menu_Normal (skymenu,M_QUIT) ;
until msg[3] = M_QUIT;
Delete_Menu (skymenu) ;
end ;
end ; {Do_Sky_Plot}