unit TDStar;
interface
uses
dos,MemGrfx;
const
NofStars = 50;
ZFactor = 200;
Xc = 160;
Yc = 100;
Palette : array[0..$2ff] of byte = (
0,0,0,2,2,2,4,4,4,6,6,6,8,8,8,
10,10,10,12,12,12,14,14,14,16,16,16,18,18,18,20,
20,20,22,22,22,24,24,24,26,26,26,28,28,28,30,30,
30,33,33,33,35,35,35,37,37,37,39,39,39,41,41,41,
43,43,43,45,45,45,47,47,47,49,49,49,51,51,51,53,
53,53,55,55,55,57,57,57,59,59,59,61,61,61,63,63,
63,63,51,51,63,63,51,51,63,51,51,63,63,51,51,63,
63,51,63,63,39,39,63,51,39,63,63,39,51,63,39,39,
63,39,39,63,51,39,63,63,39,51,63,39,39,63,51,39,
63,63,39,63,63,39,51,63,27,27,63,39,27,63,51,27,
63,63,27,51,63,27,39,63,27,27,63,27,27,63,39,27,
63,51,27,63,63,27,51,63,27,39,63,27,27,63,39,27,
63,51,27,63,63,27,63,63,27,51,63,27,39,63,15,15,
63,27,15,63,39,15,63,51,15,63,63,15,51,63,15,39,
63,15,27,63,15,15,63,15,15,63,27,15,63,39,15,63,
51,15,63,63,15,51,63,15,39,63,15,27,63,15,15,63,
27,15,63,39,15,63,51,15,63,63,15,63,63,15,51,63,
15,39,63,15,27,63,3,15,63,3,3,63,15,3,63,27,
3,63,39,3,63,51,3,63,63,3,51,63,3,39,63,3,
27,63,3,15,63,3,3,63,3,3,63,15,3,63,27,3,
63,39,3,63,51,3,63,63,3,51,63,3,39,63,3,27,
63,3,15,63,3,3,63,15,3,63,27,3,63,39,3,63,
51,3,63,63,3,63,63,3,51,63,3,39,63,3,27,51,
3,15,51,3,3,51,15,3,51,27,3,51,39,3,51,51,
3,39,51,3,27,51,3,15,51,3,3,51,3,3,51,15,
3,51,27,3,51,39,3,51,51,3,39,51,3,27,51,3,
15,51,3,3,51,15,3,51,27,3,51,39,3,51,51,3,
51,51,3,39,51,3,27,39,3,15,39,3,3,39,15,3,
39,27,3,39,39,3,27,39,3,15,39,3,3,39,3,3,
39,15,3,39,27,3,39,39,3,27,39,3,15,39,3,3,
39,15,3,39,27,3,39,39,3,39,39,3,27,27,3,15,
27,3,3,27,15,3,27,27,3,15,27,3,3,27,3,3,
27,15,3,27,27,3,15,27,3,3,27,15,3,27,27,3,
27,15,3,3,15,15,3,3,15,3,3,15,15,3,3,15,
15,3,15,27,15,15,27,27,15,15,27,15,15,27,27,15,
15,27,27,15,27,39,15,15,39,27,15,39,39,15,27,39,
15,15,39,15,15,39,27,15,39,39,15,27,39,15,15,39,
27,15,39,39,15,39,39,15,27,51,15,15,51,27,15,51,
39,15,51,51,15,39,51,15,27,51,15,15,51,15,15,51,
27,15,51,39,15,51,51,15,39,51,15,27,51,15,15,51,
27,15,51,39,15,51,51,15,51,51,15,39,51,15,27,51,
27,27,51,39,27,51,51,27,39,51,27,27,51,27,27,51,
39,27,51,51,27,39,51,27,27,51,39,27,51,51,27,51,
51,27,39,51,39,39,51,51,39,39,51,39,39,51,51,39,
39,51,51,39,51,39,27,27,39,39,27,27,39,27,27,39,
39,27,27,39,39,27,39,3,3,3,15,15,15,27,27,27,
39,39,39,51,51,51,63,63,63,63,22,3,39,7,5,36,
36,63,0,0,0,22,22,22,38,38,38,52,52,52,63,0,0);
type
StarRec = record
X,Y,Z: integer;
end;
StarPos = array[0..NofStars] of StarRec;
StarSpd = array[0..NofStars] of word;
var
Stars : StarPos;
Speed : StarSpd;
procedure Init;
procedure DoStars;
Procedure Do3DStarField;
implementation
procedure Init;
var
Regs : registers;
C : word;
I,X,Y : byte;
begin
randomize; { Initialize stars }
for I := 0 to NofStars do begin
Stars[I].X := random(100)-50;
Stars[I].Y := random(100)-50;
Stars[I].Z := random(900)+200;
Speed[I] := 0;
end;
C := 0; { Set palette }
for I := 0 to $ff do begin
port[$3C8] := I;
port[$3C9] := Palette[C];
port[$3C9] := Palette[C+1];
port[$3C9] := Palette[C+2];
inc(C,3);
end;
end;
{----------------------------------------------------------------------------}
procedure DoStars;
var
X,Y,Count : integer;
I,Color : byte;
procedure NewStar(Num : byte);
var
X,Y : integer;
begin
X := Xc+round(Stars[Num].X*Stars[Num].Z/ZFactor);
Y := Yc+round(Stars[Num].Y*Stars[Num].Z/ZFactor);
if (X > 0) and (X < 320) and (Y > 0) and (Y < 200) then
PutPixel(x,y,0,vga);
Stars[Num].X := random(100)-50;
Stars[Num].Y := random(100)-50;
Stars[Num].Z := random(100)+200;
end;
begin
Count:=0;
repeat
waitretrace;
for I := 0 to NofStars do begin { Stars }
X := Xc+round(Stars[I].X*Stars[I].Z/ZFactor);
Y := Yc+round(Stars[I].Y*Stars[I].Z/ZFactor);
if getpixel(x,y,vga) <= 31 then putpixel (x,y,0,vga);
X := Xc+round(Stars[I].X*(Stars[I].Z+Speed[I])/ZFactor);
Y := Yc+round(Stars[I].Y*(Stars[I].Z+Speed[I])/ZFactor);
if (X > 0) and (X < 320) and (Y > 0) and (Y < 200) then begin
Color := 6+(Stars[I].Z div 150);
if Color > 31 then Color := 31;
if mem[$a000:Y*320+X] = 0 then mem[$a000:Y*320+X] := Color;
end else NewStar(I);
inc(Stars[I].Z,Speed[I]); if Stars[I].Z > 20000 then NewStar(I);
Speed[I] := (Stars[I].Z div 150)*(5-(abs(Stars[I].X*Stars[I].Y) div 500));
end;
Inc(Count);
until (Escpressed=True) Or (Count=650);
end;
{----------------------------------------------------------------------------}
Procedure Do3DStarField;
begin
Init;
DoStars;
end;
End.
