Code: Select all
const w=800, h=600
screenres w, h,24
dim shared as integer Waves (w,h,1)
Dim texture As unsigned byte Ptr = ImageCreate( w, h ,24 )
dim as integer x,y
dim as integer f
paint texture,(1,1),rgb(0,0,255)
for i as integer=0 to 80
draw string texture,(0,i*8),"This is a test for the FreeBasic. This is a test for the FreeBasic. This is a test for the FreeBasic"
next
do
dim as integer mx, my, mb
getmouse mx, my,, mb
if mb=1 then Waves(mx, my,f)= (10000*rnd())
for y=1 to h-1
dim as integer ofs=y*w
for x=1 to w-1
Waves(x,y,1-f)=((Waves(x-1,y,f)+Waves(x+1,y,f)+Waves(x,y-1,f)+Waves(x,y+1,f)) shr 1) - Waves(x,y,1-f)
Waves(x,y,1-f)-=Waves(x,y,1-f) shr 5
next
next
f=1-f
dim tmp as unsigned byte ptr = texture + 8*4 ' Skip header data
dim as unsigned byte ptr target=screenptr
screenlock
for y=1 to h-1
dim as integer ofs=y*w
for x=1 to w-1
dim as integer dx, dy
dx=Waves(x-1,y,f)-Waves(x+1,y,f)
dy=Waves(x,y-1,f)-Waves(x,y+1,f)
dim as integer tx=((y+dy) and &h1ff) * w*4 + ((x + dx) and &h1ff) * 4
dim as integer r, g, b
b=tmp[tx]
g=tmp[tx+1]
r=tmp[tx+2]
r-=dx:
#define min(a,b) (iif(a<b, a, b))
#define max(a,b) (iif(a>b, a, b))
target[ofs*4 + x*4]=min(max(b-dx, 0), 255)
target[ofs*4 + x*4 + 1]=min(max(g-dx, 0), 255)
target[ofs*4 + x*4 + 2]=min(max(r-dx, 0), 255)
target[ofs*4 + x*4 + 4]=&hFF
next
next
screenunlock
screensync
loop until multikey(1)