Well I've updated the simulation with 2 more effects.
+ Code Snippetremstart
Water Wave Effect
by Mariusz Skowronski (2003)
optimized by D Man
remend
#constant EFFECT_PATH 1
#constant EFFECT_RAIN1 2
#constant EFFECT_RAIN2 3
disable escapekey
rem global vars
rem bitmap size and color depth
global g_bmpWidth as integer
global g_bmpHeight as integer
global g_bmpBpp as integer
global g_bytesPerPixel as integer
rem memblock pointers (for faster access)
global g_srcMemPtr as dword
global g_dstMemPtr as dword
rem screen dimensions
global g_scrWidth as integer
global g_scrHeight as integer
rem height array swap index (current and new)
global g_ch as integer
global g_nh as integer
global g_effect as integer
rem properties
rem wave amplitude
global g_waveForce as integer
rem drop size
global g_dropRadius as integer
rem damping value (the smaller value the faster waves disappear) 1 - 100
global g_waveDamp as integer
rem init vars
g_scrWidth = 640
g_scrHeight = 480
g_waveForce = 300
g_dropRadius = 8
g_waveDamp = 20 : rem DON'T USE ZERO
g_effect = EFFECT_PATH
rem begin
set display mode g_scrWidth, g_scrHeight, 32
sync on : sync rate 0
rem load bitmap (remember the smaller bitmap the faster it runs)
load bitmap "example1.jpg", 1
g_bmpWidth = bitmap width(1)
g_bmpHeight = bitmap height(1)
g_bmpBpp = bitmap depth(1)
g_bytesPerPixel = g_bmpBpp/8
rem create bitmap memblock
make memblock from bitmap 2, 1
rem get memblock addresses
g_srcMemPtr = get memblock ptr(2)
rem dont need this bitmap anymore
delete bitmap 1
rem allocate 2 height maps
dim g_heightMap(1, g_bmpWidth-1, g_bmpHeight-1) as integer
rem clear height maps
ClearHeights()
rem set current height map to 0
g_ch = 0: g_nh = 1
`make image from memblock 1, 2
`paste image 1,0,0
sync
`delete image 1
set text opaque
randomize 100
lastTime = 0
do
UpdateHeights()
select g_effect
case EFFECT_PATH:
if mouseclick() then MakeWave(mousex(), mousey(), g_dropRadius, g_waveForce)
endcase
case EFFECT_RAIN1:
MakeWave(rnd(g_bmpWidth), rnd(g_bmpHeight), rnd(2)+1, g_waveForce)
MakeWave(rnd(g_bmpWidth), rnd(g_bmpHeight), rnd(2)+1, g_waveForce)
endcase
case EFFECT_RAIN2:
if timer()-lastTime > 2000
lastTime = timer()
MakeWave(rnd(g_bmpWidth), rnd(g_bmpHeight), rnd(6)+8, g_waveForce)
endif
endcase
endselect
char$ = inkey$()
select char$
case "1"
g_effect = EFFECT_PATH
g_waveForce = 300 : g_dropRadius = 8 : g_waveDamp = 20
endcase
case "2"
g_effect = EFFECT_RAIN1
g_waveForce = 800 : g_waveDamp = 6
endcase
case "3"
g_effect = EFFECT_RAIN2
lastTime = timer()
g_waveForce = 200 : g_waveDamp = 30
endcase
endselect
if escapekey() then exit
text screen width()-text width("FPS: "+str$(screen fps())), 10,"FPS: "+str$(screen fps())
sync
loop
delete memblock 2
rem that's all
end
rem this clears height maps
function ClearHeights()
local x, y
for y=0 to g_bmpHeight-1
for x=0 to g_bmpWidth-1
g_heightMap(0, x, y) = 0
g_heightMap(1, x, y) = 0
next x
next y
endfunction
rem this makes a new wave
function MakeWave(x, y, radius, mul)
local u, v, sqru, sqrv, sqrr
sqrr = radius*radius
rem check if not out of bitmap boundary
if (x>radius) and (x<g_bmpWidth-1-radius) and (y>radius) and (y<g_bmpHeight-1-radius)
for v=y-radius to y+radius
sqrv = (v-y)*(v-y)
for u=x-radius to x+radius
sqru = (u-x)*(u-x)
rem for speed reasons check (dx^2 + dy^2) <= r^2
rem instead of real formula: sqrt(dx^2 + dy^) < r
if (sqru+sqrv)<=sqrr:
g_heightMap(g_ch,u,v) = mul*int(radius - sqrt(sqru+sqrv)+1)
endif
next u
next v
endif
endfunction
rem this is only for debug (shows waves in grayscale)
function DrawHeights()
local x, y, height, color
local dstAddr as dword
rem for each height
for y=0 to g_bmpHeight-1
for x=0 to g_bmpWidth-1
height = g_heightMap(g_ch, x, y)/10
rem prepare gray color
color = rgb(height+128, height+128, height+128)
rem dont need this if useing one color depth
select g_bytesPerPixel
case 2: dstAddr = g_dstMemPtr +12+(y*g_bmpWidth+x)*2: endcase
case 4: dstAddr = g_dstMemPtr +12+(y*g_bmpWidth+x)*4: endcase
endselect
*dstAddr = color
next x
next y
endfunction
rem the meat. this updates height map
function UpdateHeights()
local x, y, height, temp
lock backbuffer
backptr=get backbuffer ptr()
rem we need skip bitmap edges couse we're making kind of area sampling
for y=2 to g_bmpHeight-3
for x=2 to g_bmpWidth-3
rem calculate height difference
rem read 12 height values surrounding (x,y), divide by 6 so we've got twice as much as average value
rem and then subtract current height at (x, y)
height = g_heightMap(g_ch,x-1,y)
inc height,g_heightMap(g_ch,x-2,y)+g_heightMap(g_ch,x+1,y)+g_heightMap(g_ch,x+2,y)+g_heightMap(g_ch,x,y-1)+g_heightMap(g_ch,x,y-2)+g_heightMap(g_ch,x,y+1)+g_heightMap(g_ch,x,y+2)+g_heightMap(g_ch,x-1,y-1)+g_heightMap(g_ch,x+1,y-1)+g_heightMap(g_ch,x-1,y+1)+g_heightMap(g_ch,x+1,y+1)
height = int(height/6) - g_heightMap(g_nh,x,y)
rem add some dampig reducing amplitudes
dec height,height/g_waveDamp + 1
g_heightMap(g_nh, x, y) = height
tx = x + (g_heightMap(g_ch, x-1, y) - height)/10: rem divide couse height values are too high
ty = y + (g_heightMap(g_ch, x, y-1) - height)/10
rem if (tx, ty) still inside bitmap bounds
`if tx>=0 and tx<g_bmpWidth and ty>=0 and ty<g_bmpHeight and g_heightMap(g_ch, x-1, y)<>g_heightMap(g_ch, x, y-1)
if tx>=0 and tx<g_bmpWidth and ty>=0 and ty<g_bmpHeight and g_heightMap(g_ch, x, y)<>g_heightMap(g_nh, x, y)
rem read color from coords we've calculated
select g_bytesPerPixel
case 2 : copy memory backptr+12+(y*screen width()+x)*2,g_srcMemPtr+12+(ty*g_bmpWidth+tx)*2,2 : endcase
case 4 : copy memory backptr+12+(y*screen width()+x)*4,g_srcMemPtr+12+(ty*g_bmpWidth+tx)*4,4 : endcase
endselect
endif
next x
next y
unlock backbuffer
rem swap height maps
temp = g_ch
g_ch = g_nh
g_nh = temp
endfunction