Code archives/Graphics/Liquid Fun + Reflections

Graphics 640,480,16
SetBuffer BackBuffer() 
Global CurrentTexture=1,NextTexture=0,TempValue=0,mx,my,img
Const MAXWIDTH = 255
Const MAXHEIGHT = 255
;Change these to get different results 
Global DEPTH=-75
Global VISCOSITY#=0.0000001
Global DripRadius=12
Global DripRadiusSqu=DripRadius*DripRadius

Dim reflect(256,256)


img = LoadImage("logo.bmp") ;this is a 256x256 image
rpool = LoadImage("pool.bmp")
DrawImage rpool,0,0
For y = 0 To 255
For x = 0 To 255
 GetColor x,y
 reflect(x,y)=(ColorRed() Shl 16) + (ColorGreen() Shl 8) + ColorBlue()
Next
Next
DrawImage img,0,0
For y = 0 To 255
For x = 0 To 255
 GetColor x,y
 r1=reflect(x,y) Shr 16
 g1=reflect(x,y) Shr 8 And 255
 b1=reflect(x,y) And 255
 r2=ColorRed()
 g2=ColorGreen()
 b2=ColorBlue()
 reflect(x,y)=(((r1+r2)/2) Shl 16)+(((g1+g2)/2) Shl 8)+(((b1+b2)/2))
Next
Next


FreeImage img 
FreeImage rpool

Dim WaveMap#(4,MAXWIDTH,MAXHEIGHT) 

MoveMouse 100,100

While Not KeyDown(1) 
	Cls
	mx=MouseX()
	my=MouseY()
	If mx<3Then mx=3
	If mx>MAXWIDTH Then mx=MAXWIDTH
	If my<3Then my=3
	If my>MAXHEIGHT Then my=MAXHEIGHT
	
	UpdateWaveMap#() 

	If MouseDown(1) Then MakeDrip(mx,my,DEPTH)
	If KeyDown(57)
		For i = 1 To 360
			MakeDrip(Cos(i)*100+(255/2),Sin(i)*100+(255/2),DEPTH)
		Next
	EndIf
	
a=a+1
If MilliSecs()>ft
 b=a
 a=0
 ft=MilliSecs()+1000
EndIf
Text 1,1,Str b
	
	Flip
Wend 

Function UpdateWaveMap#() 
	LockBuffer BackBuffer()
	For y = 2 To MAXHEIGHT-2
		For x = 2 To MAXWIDTH-2 
			n#=WaveMap#(CurrentTexture,x-1,y)+WaveMap#(CurrentTexture,x+1,y)+WaveMap#(CurrentTexture,x,y-1)+WaveMap#(CurrentTexture,x,y+1)+WaveMap#(CurrentTexture,x-2,y)+WaveMap#(CurrentTexture,x+2,y)+WaveMap#(CurrentTexture,x,y-2)+WaveMap#(CurrentTexture,x,y+2)+WaveMap#(CurrentTexture,x-1,y+1)+WaveMap#(CurrentTexture,x+1,y-1)+WaveMap#(CurrentTexture,x-1,y-1)+WaveMap#(CurrentTexture,x+1,y+1)
			n#=n#/6.0
			n#=n#-WaveMap#(NextTexture,x,y)
			n#=n#-n#*VISCOSITY#
			If n#=<1 Then n#=0
			WaveMap#(NextTexture,x,y)=Int(n#)
		Next 
	Next

	TempValue=CurrentTexture 
	CurrentTexture=NextTexture 
	NextTexture=TempValue 
	
	
	For j = 1 To MAXHEIGHT-1
		For i = 1 To MAXWIDTH-1
			xoff=i
			If i >0 And i<MAXWIDTH-1
				xoff = xoff - WaveMap#(CurrentTexture,i-1,j)
				xoff = xoff + WaveMap#(CurrentTexture,i+1,j)
			EndIf
			yoff = j
			If j >0 And i<MAXHEIGHT-1
				yoff = yoff - WaveMap#(CurrentTexture,i,j-1)
				yoff = yoff + WaveMap#(CurrentTexture,i,j+1)
			EndIf
			If xoff < 0 Then xoff = 0
			If xoff > 255 Then xoff = 255
			If yoff < 0 Then yoff = 0
			If yoff > 255 Then yoff = 255
			col = reflect(xoff,yoff)
			r = col Shr 16
			g = col Shr 8 And 255
			b = col And 255
			
			r = r + WaveMap#(CurrentTexture,i,j)
			g = g + WaveMap#(CurrentTexture,i,j)
			b = b + WaveMap#(CurrentTexture,i,j)
			
			If r<0 Then r = 0
			If g<0 Then g = 0
			If b<0 Then b = 0
			If r>255 Then r = 255
			If g>255 Then g = 255
			If b>255 Then b = 255
			
			;WritePixelFast i*2,j*2,(r Shl 16) + (g Shl 8) + b
			;WritePixelFast i*2-1,j*2,(r Shl 16) + (g Shl 8) + b
			;WritePixelFast i*2,j*2-1,(r Shl 16) + (g Shl 8) + b
			;WritePixelFast i*2-1,j*2-1,(r Shl 16) + (g Shl 8) + b
			WritePixelFast i,j,(r Shl 16) + (g Shl 8) + b
		Next
	Next
	
	
	WritePixelFast mx,my,255 Shl 16
	WritePixelFast mx+1,my,255 Shl 16
	WritePixelFast mx-1,my,255 Shl 16
	WritePixelFast mx,my+1,255 Shl 16
	WritePixelFast mx,my-1,255 Shl 16

	UnlockBuffer BackBuffer()
	
End Function 

Function SquaredDist(sx,sy,dx,dy)
	Return (dx - sx) * (dx - sx) + (dy - sy) * (dy - sy)
End Function

Function MakeDrip(dmx,dmy,dep)
	For y = dmy - DripRadius To dmy + DripRadius
		For x = dmx - DripRadius To dmx + DripRadius
			If y>3 And y<253 And x>3 And x<253
				dist = SquaredDist(dmx,dmy,x,y)
				If dist<DripRadius
					fd = (depth * DripRadius - Sqr(dist))/DripRadius
					If fd >127 Then fd=127
					If fd <-127 Then fd=-127
					WaveMap#(CurrentTexture,x,y)=fd
				EndIf
			EndIf
		Next
	Next	
End Function