home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-385-Vol-1of3.iso
/
m
/
miscpas.zip
/
GALEXY.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1984-06-12
|
4KB
|
142 lines
Program GALEXY;
{ This program projects a view of our galexy on the IBM PC hi-res graphics }
{ screen. The view is anamated giving leaving the viewer with the impres- }
{ sion that he is traveling at an incredible speed though the Milky Way. }
{ Writen for Turbo Pascal v2.0. The 8087 version of Turbo Pascal should }
{ be used in order to achieve real time updating. }
{ The program uses the external procedure POINT.INV and CLS.INV. Both of }
{ these must be resident on the default disk in order to compile the prgm. }
{ Adapted by Jeff Firestone; May 23, 1984. HAL-PC Pascal SIG. }
{ Original Source: Mark Dahmke's article in Byte, April 1978, pp. 66-80. }
Const
Size = 131; { Number of Stars in Stars.DTA }
xx = 639; { Screen X resolution }
yy = 199; { Screen Y resolution }
VAR
i, count : integer;
hp, xl, yl, xo, yo : real;
cra, cdec, cxy, cdist, dist, ra, dec, vel : real;
axy, ax, ay, az, xp, yp, zp, nra, newr, ndec, tmp : real;
KeyBufPointer : Integer;
F : text;
fx, fy, fz : array [0..size] of real;
x1, y1 : array [0..size] of integer;
Procedure cls; External 'Cls.inv';
Procedure Dot(a,b,c:integer); External 'Point.inv';
Procedure InitVars;
begin
dist := -1000; { Distance from Earth in light years }
ra := pi; { Right ascension in degrees }
dec := 0; { Declination in degrees }
vel := 20; { Velocity in light years per update }
hp := pi / 2;
xl := xx / pi;
yl := yy / pi;
xo := xx;
yo := yy / 2;
KeyBufPointer:= MemW[$0040:$001A];
end;
Procedure ReadArrays;
begin
assign(f, 'stars.dat');
reset(f);
FOR i := 1 TO size do
begin
READ(F, cra,cdec,cdist);
{ Convert CRA and CDEC to radians }
cra := cra * 0.261799;
cdec := cdec * 0.01745;
cxy := cdist * COS(cdec);
fx[i] := cxy * COS(cra);
fy[i] := cxy * SIN(cra);
fz[i] := cdist * SIN(cdec);
end;
end;
Function KeyWasPressed : Boolean;
begin
if KeyBufPointer <> MemW[$0040:$001A]
then
KeyWasPressed:= True
Else
KeyWasPressed:= False;
end;
Procedure PlotIt;
var
cosdec, cosra, sinra, sindec : real;
begin
hires; hirescolor(7);
CosDec := cos(dec);
CosRa := cos(ra);
SinRa := sin(ra);
SinDec := sin(dec);
count:= 0;
repeat
{ Advance the distance counter }
dist := dist + vel;
{ Compute the new location in space from RA, DEC, DIST }
axy := dist * CosDec;
ax := axy * CosRa;
ay := axy * SinRa;
az := dist * SinDec;
{ Convert the shifted coordinates to celestial coordinates and plot }
FOR i := 1 TO size do
begin
xp := fx[i] - ax;
yp := fy[i] - ay;
zp := fz[i] - az;
nra := ArcTan(yp / xp);
newr := SQRT(xp * xp + yp * yp + zp * zp);
tmp := zp / newr;
ndec := ArcTan(tmp / (SQR(1 - (tmp * tmp)))); { ArcSin function }
{ Test for quadrants messed up by the acrtangent function }
IF (xp < 0) THEN nra := nra + hp;
IF (xp > 0) AND (yp < 0) THEN nra := nra + pi;
{ Test for screen limits }
IF (nra > pi) THEN nra := nra - pi;
IF (nra < 0) THEN nra := nra + pi;
{ Scale for screen }
x1[i] := round(xo - (nra * xl));
y1[i] := round((ndec * yl) + yo);
end;
cls;
for i:= 1 to size do plot(x1[i], y1[i], 1);
count:= count + 1;
Until (count = 100) or (KeyWasPressed);
end;
begin
InitVars;
ReadArrays;
PlotIt;
end.