Code:
Program Waves;
{By CDB; to learn about particle systems}
uses crt, dos, graph;
type Timerecord = record
Hours,Minutes,Seconds,S100 : word;
Tothundreds,Lasthundreds, Timepassed:integer;
end;
Waver = record
Timepassed, Disturb, StringLevel, Detail,
Howmany,NumOfDist, Colour, Speed, Starter,StartinHeight : integer;
Disturbance : array[1..100] of record
Alive : boolean;
Start : integer;
Heights : array[1..2000] of real;
end;
end;
Waveparticles = record
x,y, vx,vy, oldx,oldy : real;
end;
var Wave : Waver;
WaveP : array[1..1100] of waveparticles;
Timer : timerecord;
FPS : integer;
Procedure Initialize; forward;
Procedure CheckForInstruction; forward;
Procedure FrameIt; forward;
Procedure WaveIt; forward;
Procedure MakeAMove; forward;
Procedure MakeAStand; forward;
Procedure MoveNDraw; forward;
Procedure Initialize;
var Gd, Gm : Smallint;
c : integer;
begin // the next 3 lines initialise the graph window
Gd:=Detect;
InitGraph(Gd,Gm,'');
If GraphResult<>0 then Halt;
Randomize;
Timer.Timepassed := 0;
FPS := 0; c:=0;
With Wave do
begin
Timepassed := 0;
Disturb := 1; // how often to create a wave (in sec/100)
StringLevel := 300; // = 'ground' level
Howmany := 550; // how many particles
NumOfDist := 100; // max number of waves at same time
Detail := 1;
colour:= 4;
Speed:=4;
Starter :=1000; // coded: if <0>1020 then starts at middle
StartinHeight := 80; // coded: if <0>1000 then default =80;
//-------Disturbance
for c:=1 to NumOfDist do
With Disturbance[c] do
begin
Alive:=false;
Start:=510;
end; {with Disturbance}
//-------Particles
for c:=1 to Howmany do
With WaveP[c] do
begin
x:= c-(Howmany-1020)div 2; // to centre it
y:=StringLevel;
oldx:=0;
oldy:=y;
end; {WaterMol}
end; {With Water}
end; {initialize}
Procedure CheckForInstruction; //to change variables or exit
var k : char; // press the correspondent letter, enter the value, press <Enter>
s : string; // Note: there are no validity checks so take care with what you input!
c : integer;
begin
if keypressed then
begin
k:=readkey;
readln(s);
With Wave do
case k of
'f': begin //flaten, reset
for c:= 1 to NumofDist do Disturbance[c].Alive:=false;
for c:= 1 to Howmany do WaveP[c].y:=StringLevel;
//and velocities if desired
end;
'h': begin Val(s,Howmany); cleardevice; end; // changes the num of particles
't': Val(s,StartinHeight); // changes how high each wave is
's': Val(s,Starter); // changes where the wave originates from
'l': Val(s,StringLevel); // changes average level
'c': Val(s,Colour); // changes colour
'v': Val(s,Speed); // changes how fast each particle gets to its destination
'd': begin Val(s,Detail); cleardevice; end; // changes display
'w': Val(s,Disturb); // changes how often to create a wave
'x': Halt; // exits
end; {case}
end; {if}
end; {CheckForInstruction}
Procedure FrameIt; //not exactly FPS but jst to give an idea of performance
var s:string;
begin
Str(FPS,s);
setcolor(0); outtextxy(10,680,s); //erase what's there
if Timer.Timepassed=0 then FPS:=100 else FPS := round(100/Timer.Timepassed);
Str(FPS,s);
setcolor(15); outtextxy(10,680,s); //write
end; {FPS}
//------------------------Wave procedures
Procedure WaveIt;
begin
MakeAStand; //creates a new wave
MakeAMove; //moves every wave
MoveNDraw; //moves and draws particles
end; {WaveIt}
Procedure MakeAStand;
var r : integer;
begin
With Wave do
begin
Wave.Timepassed += Timer.Timepassed;
if Timepassed<0>Disturb then
begin
r:=1;
while (r<=(NumOfDist+1))and(Disturbance[r].Alive) do r+=1; //find a wave in the array that is not 'Alive'
if r<=NumOfDist then
With Disturbance[r] do // and make it alive
begin
Alive:=true;
writeln('Creatin wave ',r); //jst a check, can be commented out
for r:= 1 to 2000 do Heights[r]:=0; //makes sure it's all flat
Case Starter of //Starter can be set in real time. <0>1025 will make it centered
-100..-1 : start := random(Howmany-5)+3;
0..1024 : start := Starter;
1025..10000 : start := Howmany div 2;
end; {case}
Case StartinHeight of //can be set in real time. <0>1000 will make it default
-100..-1 : Heights[start] := random(-StartinHeight);
0..1000 : Heights[start] := StartinHeight;
1001..10000 : Heights[start] := 80;
end; {case}
end; {if}
Timepassed:=0;
end; {if}
end; {with}
end; {MakeAStand}
Procedure MakeAMove; //Moves each wave sideways
var b,c : integer;
begin
With Wave do
for c:=1 to NumOfDist do
With Disturbance[c] do //goes through the Disturbance array, and if alive, moves it
if Alive then
begin
Alive:=false; //if the wave is still moving through the array, it will become true again
for b := 2 to (Start-1) do //Start is where the disturbance started
begin
if Heights[b] <> Heights[b+1] then Alive:=true; //if the wave is still moving, it has to stay alive
Heights[b] := Heights[b+1]; //Moves half of the wave to the left
end; {for}
for b := (Howmany-1)downto(Start+1) do
begin
if Heights[b] <> Heights[b-1] then Alive:=true;
Heights[b] := Heights[b-1]; //Moves half of the wave to the right
end; {for}
Heights[start] *= 4/5; if Heights[start]<5>4 then r:=4; r/=500; // serious doubts about this...
// The idea was to make the wave move depending on how long the previous round took
// so tht it wouldn't slow down, bt it doesnt seem good.
r := 1/50000;
With Wave do
for c:= 2 to (Howmany-1) do // The first and last have to be constant to set the average level
With WaveP[c] do
begin
d:=0;
for b:=1 to NumOfDist do
if Disturbance[b].Alive then d += Disturbance[b].Heights[c]; //adds all heights of waves at that point
d+= StringLevel; // adds the total to SeaLevel
vx += 0;
vy += (d-y); //vy is how far up or down the particle has to go (smthg like velocity)
x += vx*r*speed;
y += vy*r*speed; //the particle moves depending on its velocity, how long since last round, and speed
if y<10>800 then y:=800;
if (y<>oldy)or(x<oldx>2 then line(round(x),round(y),round(WaveP[c-1].x),round(WaveP[c-1].y));
end;
3: begin //line to bottom of screen (sea effect)
setcolor(0); line(round(oldx),round(oldy),round(oldx),1020);
setcolor(Colour); line(round(x),round(y),round(x),1020);
oldx:=x;
oldy:=y;
end;
4: // line to pt (0,0)
// This is where my problem is.
// I simply wanted to draw a line between every particle and the origin
// so as to create the effect of a horizontal plane being distorted in 3D.
// But, for some reason, unknown to me, it lags like crazy!
// so I tried to draw the lines only with every 5th point, but it still lags
// way too much.
// Please tell me how I could improve this!
if c mod 5=0 then begin
setcolor(0); line(round(oldx),round(oldy),0,0);
setcolor(Colour); line(round(x),round(y),0,0);
oldx:=x;
oldy:=y;
end;
else Detail:=1;
end; {case}
end; {if}
end; {for, with}
if Wave.Detail=2 then //has to be put separately because needs to be done all at once
for c:= 2 to Wave.Howmany do
With WaveP[c] do
begin
oldx:=x;
oldy:=y;
end;
end; {MoveNDraw}
//-------------------------------------
begin
Initialize;
Repeat
With Timer do
begin
Gettime(hours,minutes,seconds,s100);
Tothundreds:=(s100)+(seconds*100)+(minutes*6000)+(hours*360000);
Timepassed := Tothundreds-Lasthundreds; //time passed since last time round
Lasthundreds := Tothundreds;
if Timepassed<0 then Timepassed:=0;
end;
FrameIt;
CheckForInstruction;
WaveIt;
Until false;
end.
This is when you give all the advice you can to improve it!!! Thank you!
Reply With Quote
Bookmarks