There seem to be a couple of people who are interested in my previous
posting on this subject, enough perhapse to warant me posting it here.
A few comments before I do however, I didn't include any comments in
the original code but it is very simple and hopefully the code will
speak for itself. The Algorithm also needs some work, it has a lot more
potential than what you see here, some speedups i've already thought of
are:
*when you do the displacment -> velocity pass only consider the right,
bottom right, bottom and bottom left points and let the equalizing force
effect both points that way you can do one pass over every point and
only have to find the difference between abjacent points once per pass.
*As I mentioned in the description but did not do in the code have
another map that contains your mass/heigt values and use it to tag fixed
points rather than what I did here which was to treat the heighest
signed 32-bit val as a taged (which has some weird effects if you apply
enough force to the system)
When I was first experimenting with the code I found that the value of
the speed and tension constants dramatically effect the model, I suggest
that if this is going to be of any use that these relationships are
refined. Also you will notice that the circular waves aren't so
circular when they get further from the source, to correct this simply
multiply the diagonal points in the Displacement -> force pass by
1/(Sqrt(2)) so that you are taking into account the circular
relationship.
I don't think there is anymore I can add, the graphics library I used
'GFX3' was written my Denthor of the demo group Asphixia in his pascal
toutorial series, that can be found just about anywhere now. Also in
this code you will notice that I split the force -> displacment pass
into two one with no div and one divided by two, this represent two
zones of different depths, I used it to examplify the refractive
properties of the model. Also the procedure WaveFront, this does
exactly as it says, in order to produce a directional wave front just
disturb the model in a line of points, just as you would in real water.
anyway I hope you can get something out of this:
program WaveModel2;
uses
crt, gfx3;
CONST
SPEED=5;
MASS=1;
DECAY=1;
TENSION=500;
type
MapM= Array[0..319, 0..99] of integer;
maP= ^MapM;
Var
Force, Velocity, Displace, pic: map;
LOOPA, LOOPB: WORD;
LOOPC:SHORTINT;
PROCEDURE FORCETOVELOCITY;
BEGIN
FOR LOOPA:=0 TO 150 DO
FOR LOOPB:=0 TO 99 DO
if not (round(displace^[loopa,loopb])=32767) then
VELOCITY^[LOOPA,LOOPB]:=(VELOCITY^[LOOPA,LOOPB]
+(FORCE^[LOOPA,LOOPB]-displace^[loopa,loopb] div
Tension));
FOR LOOPA:=150 TO 319 DO
FOR LOOPB:=0 TO 99 DO
if not (round(displace^[loopa,loopb])=32767) then
VELOCITY^[LOOPA,LOOPB]:=(VELOCITY^[LOOPA,LOOPB]
+(FORCE^[LOOPA,LOOPB]-displace^[loopa,loopb] div Tension)
div 2);
END;
PROCEDURE VELOCITYTODISPLACEMENT;
BEGIN
FOR LOOPA:=1 TO 318 DO
FOR LOOPB:=1 TO 98 DO
DISPLACE^[LOOPA, LOOPB]:=DISPLACE^[LOOPA,
LOOPB]+VELOCITY^[LOOPA,LOOPB];
END;
PROCEDURE ZEROFORCE;
BEGIN
FOR LOOPA:=0 TO 319 DO
FOR LOOPB:=0 TO 99 DO
FORCE^[LOOPA, LOOPB]:=0;
END;
PROCEDURE DISPLACEMENTTOFORCE;
VAR
DIF: integer;
BEGIN
FOR LOOPA:=1 TO 318 DO
FOR LOOPB:=1 TO 98 DO
BEGIN
IF DISPLACE^[LOOPA, LOOPB]<32767 THEN BEGIN
IF DISPLACE^[LOOPA, LOOPB]>DISPLACE^[LOOPA-1, LOOPB]
THEN
BEGIN
DIF:=(DISPLACE^[LOOPA,
LOOPB]-DISPLACE^[LOOPA-1, LOOPB]) div SPEED;
force^[LOOPA-1, LOOPB]:=force^[LOOPA-1, LOOPB]
+ DIF;
force^[LOOPA, LOOPB]:=force^[LOOPA, LOOPB] -
DIF;
END;
IF DISPLACE^[LOOPA, LOOPB]>DISPLACE^[LOOPA-1,
LOOPB+1] THEN
BEGIN
DIF:=(DISPLACE^[LOOPA,
LOOPB]-DISPLACE^[LOOPA-1, LOOPB+1]) div SPEED;
force^[LOOPA-1, LOOPB+1]:=force^[LOOPA-1,
LOOPB+1] + DIF;
force^[LOOPA, LOOPB]:=force^[LOOPA, LOOPB] -
DIF;
END;
IF DISPLACE^[LOOPA, LOOPB]>DISPLACE^[LOOPA, LOOPB+1]
THEN
BEGIN
DIF:=(+DISPLACE^[LOOPA,
LOOPB]-DISPLACE^[LOOPA, LOOPB+1]) div SPEED;
force^[LOOPA, LOOPB+1]:=force^[LOOPA, LOOPB+1]
+ DIF;
force^[LOOPA, LOOPB]:=force^[LOOPA, LOOPB] -
DIF;
END;
IF DISPLACE^[LOOPA, LOOPB]>DISPLACE^[LOOPA+1,
LOOPB+1] THEN
BEGIN
DIF:=(DISPLACE^[LOOPA,
LOOPB]-DISPLACE^[LOOPA+1, LOOPB+1]) div SPEED;
force^[LOOPA+1, LOOPB+1]:=force^[LOOPA+1,
LOOPB+1] + DIF;
force^[LOOPA, LOOPB]:=force^[LOOPA, LOOPB] -
DIF;
END;
IF DISPLACE^[LOOPA, LOOPB]>DISPLACE^[LOOPA+1, LOOPB]
THEN
BEGIN
DIF:=(DISPLACE^[LOOPA,
LOOPB]-DISPLACE^[LOOPA+1, LOOPB]) div SPEED;
force^[LOOPA+1, LOOPB]:=force^[LOOPA+1, LOOPB]
+ DIF;
force^[LOOPA, LOOPB]:=force^[LOOPA, LOOPB] -
DIF;
END;
IF DISPLACE^[LOOPA, LOOPB]>DISPLACE^[LOOPA+1,
LOOPB-1] THEN
BEGIN
DIF:=(DISPLACE^[LOOPA,
LOOPB]-DISPLACE^[LOOPA+1, LOOPB-1]) div SPEED;
force^[LOOPA+1, LOOPB-1]:=force^[LOOPA+1,
LOOPB-1] + DIF;
force^[LOOPA, LOOPB]:=force^[LOOPA, LOOPB] -
DIF;
END;
IF DISPLACE^[LOOPA, LOOPB]>DISPLACE^[LOOPA, LOOPB-1]
THEN
BEGIN
DIF:=(DISPLACE^[LOOPA, LOOPB]-DISPLACE^[LOOPA,
LOOPB-1]) div SPEED;
force^[LOOPA, LOOPB-1]:=force^[LOOPA, LOOPB-1]
+ DIF;
force^[LOOPA, LOOPB]:=force^[LOOPA, LOOPB] -
DIF;
END;
IF DISPLACE^[LOOPA, LOOPB]>DISPLACE^[LOOPA-1,
LOOPB-1] THEN
BEGIN
DIF:=(DISPLACE^[LOOPA,
LOOPB]-DISPLACE^[LOOPA-1, LOOPB-1]) div SPEED;
force^[LOOPA-1, LOOPB-1]:=force^[LOOPA-1,
LOOPB-1] + DIF;
force^[LOOPA, LOOPB]:=force^[LOOPA, LOOPB] -
DIF;
END;
END;
END;
END;
PROCEDURE ZERO;
BEGIN
FOR LOOPA:=0 TO 319 DO
FOR LOOPB:=0 TO 99 DO
begin
displace^[LOOPA, LOOPB]:=0;
velocity^[LOOPA, LOOPB]:=0;
end;
END;
PROCEDURE GETMEMMAP;
BEGIN
GETMEM(FORCE, 64000);
GETMEM(VELOCITY, 64000);
GETMEM(DISPLACE, 64000);
GETMEM(PIC, 64000);
END;
PROCEDURE FREEMEMMAP;
BEGIN
FREEMEM(FORCE, 64000);
FREEMEM(VELOCITY, 64000);
FREEMEM(DISPLACE, 64000);
FREEMEM(PIC, 64000);
END;
procedure SetPal(color:integer);
VAR i: integer;
begin
for i:=0 to 63 do {sets palette}
begin
Pal(i,0,0,0);
case color of
0 : begin
Pal(64+i,i,0,0);Pal(128+i,63,i,i);Pal(192+i,63,63,63); end;
2 : begin
Pal(64+i,0,i,0);Pal(128+i,i,63,i);Pal(192+i,63,63,63); end;
1 : begin
Pal(64+i,0,0,i);Pal(128+i,i,i,63);Pal(192+i,63,63,63); end;
end;
end;
end;
procedure MouseInfo(VAR x,y : integer; VAR lb,rb : boolean); assembler;
{returns status of mouse}
asm
mov ax,$0003
int $33
les si,x
mov [es:si],cx
les si,y
mov [es:si],dx
mov ax,bx
and al,1
les si,lb
mov [es:si],al
shr bl,1
and bl,1
les si,rb
mov [es:si],bl
end;
PROCEDURE ERECTBARRIER;
VAR LOOPA: WORD;
BEGIN
FOR LOOPA:=0 TO 319 DO DISPLACE^[LOOPA,0]:=32767;
FOR LOOPA:=0 TO 319 DO DISPLACE^[LOOPA,99]:=32767;
FOR LOOPA:=0 TO 99 DO DISPLACE^[0,LOOPA]:=32767;
FOR LOOPA:=0 TO 99 DO DISPLACE^[319,LOOPA]:=32767;
{FOR LOOPA:=0 TO 45 DO DISPLACE^[100,loopa]:=32767;
FOR LOOPA:=55 TO 99 DO DISPLACE^[100, loopa]:=32767;
FOR LOOPA:=49 TO 51 DO DISPLACE^[100, LOOPA]:=32767;}
END;
PROCEDURE WAVEFRONT;
VAR LOOPa:WORD;
BEGIN
FOR LOOPA:=0 TO 40 DO
FORCE^[loopa+90,loopa+40]:=12040;
END;
PROCEDURE DRAW;
VAR X, Y, Z: REAL;
XP, YP: INTEGER;
BEGIN
FOR LOOPA:=0 TO 319 DO
FOR LOOPB:=0 TO 99 DO
PUTPIXEL(loopa, loopb, hi(DISPLACE^[LOOPA, LOOPB]+32768),
VADDR);
FLIP(VADDR,VGA);
END;
var x,y: integer; lb, rb: boolean;
YINC, XINC: SHORTINT;
BEGIN
SETMCGA;
SETPAL(1);
GETMEMMAP;
SETUPVIRTUAL;
RANDOMIZE;
cls(vaddr,0);
zero;
zeroforce;
loopc:=0;
YINC:=1;
XINC:=1;
ERECTBARRIER;
{generateplasma(99,99,50,force,false,true);}
{loadTGA('test2.tga',force,false);}
REPEAT
{LOOPC:=LOOPC+YINC;
IF LOOPC=20 THEN
BEGIN
YINC:=-1;
XINC:=-XINC;
END;
IF LOOPC=-20 THEN
BEGIN
YINC:=1;
XINC:=-XINC;
END;
FORCE^[LOOPC+50, XINC*ROUND(SQRT(400-LOOPC*LOOPC))+50]:=50;}
{inc(loopc);
if loopc mod 5=0 then begin force^[150,45]:=-2000;
force^[150,55]:=-2000; end;}
{INC(LOOPC);
IF LOOPC MOD 10=0 THEN
WAVEFRONT;
{force^[random(319), random(99)]:=-random(30240);}
mouseinfo(x,y,lb,rb);
putpixel(x,y,255,vga);
if lb=true then force^[x,y]:=20240;
if rb=true then force^[x,y]:=-30240;
if (lb=true) and (rb=true) then begin
zero;
zeroforce;
end;
FORCETOVELOCITY;
VELOCITYTODISPLACEMENT;
ZEROFORCE;
...
read more »