program starfielddemo;
uses
ptccrt,
ptcgraph,sysutils;
const
MaxStars = 200;
Type
VideoPages = (Page0, Page1);
IchangeType = record
xc,yc:double;
end;
IArrayType = array[0..360] of IChangeType;
StarType = record
xposition,yposition,
xc,yc:double;
color:integer;
end;
var
InertiaTable:IArrayType;
Page: VideoPages = Page0;
gdriver,gmode:smallint;
Index:integer;
RightLStars,
LeftLStars,
RightUStars,
LeftUstars:array[0..MaxStars] of startype;
{***************** Page flipping**************}
procedure Nextactivepage;
begin
if page = page0 then page := page1
else
page := page0;
SetactivePage(Ord(Page));
end;
procedure NextVisualPage;
begin
SetVisualpage(Ord(Page));
end;
{********* Timer ****************************}
procedure frametick2(Milliseconds:integer);
var
scount,ecount:qword;
begin
scount := getTickCount64;
repeat
ecount := gettickcount64;
until ecount > scount+Milliseconds;
end;
{************* Inertia Table *******************}
Procedure BuildInertiaTable;
const
CoordIncrement = 0.01111111111;
var
index:integer;
Xchange,
Ychange,
Xaccum,
YAccum:double ;
begin
fillchar(InertiaTable,sizeof(InertiaTable),0);// ? is this needed?
Ychange := CoordIncrement;
YAccum := -1;
InertiaTable[0].yc := -1.0;
Inertiatable[360].yc := -1.0;
InertiaTable[0].xc := 0;
Inertiatable[360].xc := 0;
Xaccum := 0;
xchange := -CoordIncrement;
// build portion to 90 degrees left the yc decreases to 0 , x builds up to -1
for index := 359 downto 270 do
begin
inertiatable[index].yc := YAccum;
inertiatable[index].xc := XAccum;
Xaccum := Xaccum+Xchange;
YAccum := YAccum+Ychange;
end;
// now y will increase to 1 and x will increase to 0;
Ychange := CoordIncrement;
xchange := CoordIncrement;
xaccum := -1.0;
Yaccum := 0.0;
for index := 269 downto 180 do
begin
inertiatable[index].yc := YAccum;
inertiatable[index].xc := XAccum;
Yaccum := Yaccum+ychange;
Xaccum := Xaccum+xchange;
end;
Yaccum := 1;
Xaccum := 0;
Xchange := CoordIncrement;
YChange := -CoordIncrement;
// now y will decrease from 1 to 0 and x will increase from 0 to 1;
for index := 179 downto 90 do
begin
inertiatable[index].yc := YAccum;
inertiatable[index].xc := XAccum;
Yaccum := Yaccum+ychange;
Xaccum := Xaccum+xchange;
end;
// now y will decrease from 0 to -1 and x will decrease from 1 to 0;
Xaccum := 1;
Yaccum := 0;
Xchange := -coordincrement;
Ychange := -coordincrement;
for index := 89 downto 0 do
begin
inertiatable[index].yc := YAccum;
inertiatable[index].xc := XAccum;
Yaccum := Yaccum+ychange;
Xaccum := Xaccum+xchange;
end;
end;
{ ************* Make initial "stars" ****************}
procedure seedStars;
var
d :integer;
i:integer;
begin
// do left upper quad
for i := 1 to MaxStars do
begin
d := random(90)+270;
with LeftUstars[i] do
begin
xposition := 400;
yposition := 300;
xc := inertiatable[d].xc;
yc := inertiatable[d].yc;
color :=random(18)+1;
end;
end;
// upper right
for i := 1 to MaxStars do
begin
d := random(90);
with RightUstars[i] do
begin
xposition := 400;
yposition := 300;
xc := inertiatable[d].xc;
yc := inertiatable[d].yc;
color :=random(18)+1;
end;
end;
// lower left
for i := 1 to MaxStars do
begin
d := random(90)+180;
with LeftLstars[i] do
begin
xposition := 400;
yposition := 300;
xc := inertiatable[d].xc;
yc := inertiatable[d].yc;
color := random(18)+1;
end;
end;
//lower right
for i := 1 to MaxStars do
begin
d := random(90)+90;
with RightLstars[i] do
begin
xposition := 400;
yposition := 300;
xc := inertiatable[d].xc;
yc := inertiatable[d].yc;
color :=random(18)+1;
end;
end;
end;
{********** Animate the stars **************}
procedure AnimateStars(i:integer);
begin
with LeftUstars[i] do
begin
putpixel(round(xposition),round(Yposition),color);
xposition := xposition+xc;
yposition := yposition+yc;
if (xposition <=0) or (Yposition <=0) then
begin
xposition := 400;
yposition := 300;
end;
end;
with RightUstars[i] do
begin
putpixel(round(xposition),round(Yposition),color);
xposition := xposition+xc;
yposition := yposition+yc;
if (xposition >=getmaxx) or (Yposition <=0) then
begin
xposition := 400;
yposition := 300;
end;
end;
with LeftLstars[i] do
begin
putpixel(round(xposition),round(Yposition),color);
xposition := xposition+xc;
yposition := yposition+yc;
if (xposition <0 ) or (Yposition >=getmaxy) then
begin
xposition := 400;
yposition := 300;
end;
end;
with RightLstars[i] do
begin
putpixel(round(xposition),round(Yposition),color);
xposition := xposition+xc;
yposition := yposition+yc;
if (xposition >getmaxx ) or (Yposition >=getmaxy) then
begin
xposition := 400;
yposition := 300;
end;
end;
end;
begin
gdriver := vesa;
// uses two video pages
Gmode := installusermode(800, 600, 256, 2, 8000, 6000);
WindowTitle := 'StarField';
initgraph(gdriver, gmode, '');
BuildInertiatable;
randomize;
SeedStars;
repeat
nextactivepage;
clearviewport;
for index := 0 to maxstars do animateStars(index);
nextvisualpage;
frametick2(10);
until keypressed;;
Closegraph;
end.
Recent
