Simple Wather Rippler

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
Haubitze
Posts: 44
Joined: May 20, 2016 8:42

Simple Wather Rippler

Post by Haubitze »

hi i have sean a video on yt where an nice guy talk about wather ripple and other stuff writen in java.
so i wrote an simple wather rippler in freebasic.
i hope another can take the idea and make a more powerfull demo ;D


salute

here my code:

Code: Select all

#Include "fbgfx.bi"
Using FB

Type wather_t
	Declare Constructor(x_size As UInteger,y_size As uinteger)
	Declare Destructor()
	
	Declare Sub update_buffer(damping As Single)
	Declare Sub render_buffer()
	
	buffer1 As Single Ptr ptr
	buffer2 As Single Ptr Ptr
	
	x_size As UInteger
	y_size As UInteger
End Type
Constructor wather_t(x_size As UInteger,y_size As uinteger)
	this.x_size=x_size
	this.y_size=y_size
	
	buffer1=New single Ptr[x_size]
	buffer2=New Single Ptr[x_size]
	For i As UInteger=0 To x_size-1
	buffer1[i]=New Single[y_size]
	buffer2[i]=New Single[y_size]		
	Next
End Constructor
Destructor wather_t()
	For i As UInteger=0 To x_size-1
		Delete [] buffer1[i]
		Delete [] buffer2[i]
	Next
		Delete [] buffer1
		Delete [] buffer2
		buffer1=0
		buffer2=0
End Destructor
Sub wather_t.update_buffer(damping As Single)
	buffer2[int(Rnd*x_size)][int(Rnd*y_size)]=1.0
	For i As UInteger=1 To x_size-2
		For j As UInteger=1 To y_size-2
			buffer2[i][j]=Abs(buffer1[i+1][j]+buffer1[i-1][j]+buffer1[i][j+1]+buffer1[i][j-1])/2.0-buffer2[i][j]
			buffer2[i][j]=buffer2[i][j]*damping
			'If buffer2[i][j]>1.0 Then buffer2[i][j]=1.0
			'If buffer2[i][j]<0.0 Then buffer2[i][j]=0.0
		Next
	Next
End Sub
Sub wather_t.render_buffer()
	Dim c As UByte
	ScreenLock
	For i As UInteger=0 To x_size-1
		For j As UInteger=0 To y_size-1
			c=abs(buffer2[i][j]*255)
			PSet (i,j),RGB(c,c,c)
		Next
	Next
	ScreenUnLock
	screensync
	Swap buffer1,buffer2
End Sub




Randomize timer
ScreenRes 1024,600,32


Dim w As wather_t=wather_t(1024,600)

While Not(MultiKey(SC_ESCAPE))
	w.update_buffer(0.975)
	w.render_buffer()
Wend
paul doe
Moderator
Posts: 1733
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: Simple Wather Rippler

Post by paul doe »

Hello, Haubitze

Reminds me of rainy days from yore =D
I expanded it a little bit to be able to handle fb.image buffers too. Nice work!

Code: Select all

#Include "fbgfx.bi"

Using FB

Type wather_t
	public:
		Declare Constructor( byval As UInteger, byval As uinteger )
		Declare Constructor( byval As UInteger, byval as uinteger, byval as fb.image ptr )
		
		Declare Destructor()
		
		Declare Sub update_buffer( byval As Single)
		Declare Sub render_buffer()
		
		declare property renderBuffer() as fb.image ptr
		
	private:
		m_bitmap	as fb.image ptr
		
		buffer1		as single ptr ptr
		buffer2		as single ptr ptr
				
		x_size As UInteger
		y_size As UInteger
End Type

Constructor wather_t( byval x_size As UInteger, byval y_size As uinteger )
	this.x_size=x_size
	this.y_size=y_size
		
	buffer1=New single Ptr[x_size]
	buffer2=New Single Ptr[x_size]
	
	For i As UInteger=0 To x_size-1
		buffer1[i]=New Single[y_size]
		buffer2[i]=New Single[y_size]      
	Next	
End Constructor

constructor wather_t( byval x_size as uinteger, byval y_size as uinteger, byval pBitmap as fb.image ptr )
	this.x_size=x_size
	this.y_size=y_size
	
	buffer1=New single Ptr[x_size]
	buffer2=New Single Ptr[x_size]
	
	For i As UInteger=0 To x_size-1
		buffer1[i]=New Single[y_size]
		buffer2[i]=New Single[y_size]      
	Next

	m_bitmap = pBitmap
end constructor

Destructor wather_t()
	For i As UInteger=0 To x_size-1
	  Delete [] buffer1[i]
	  Delete [] buffer2[i]
	Next
  
  Delete [] buffer1
  Delete [] buffer2
  
  buffer1=0
  buffer2=0
  
  if( m_bitmap <> 0 ) then
  	imageDestroy( m_bitmap )
  	m_bitmap = 0
  end if
End Destructor

property wather_t.renderBuffer() as fb.image ptr
	return( m_bitmap )
end property

Sub wather_t.update_buffer( byval damping As Single)
	buffer2[int(Rnd*x_size)][int(Rnd*y_size)]=1.0
	
	For y As UInteger=1 To y_size-2
	  For x As UInteger=1 To x_size-2
			buffer2[x][y]=Abs(buffer1[x+1][y]+buffer1[x-1][y]+buffer1[x][y+1]+buffer1[x][y-1])/2.0-buffer2[x][y]
			buffer2[x][y]=buffer2[x][y]*damping
	  Next
	Next
End Sub

Sub wather_t.render_buffer()
	Dim c As UByte
	dim as ulong ptr b
	dim as integer pitch
	
	if( m_bitmap = 0 ) then
		b = screenPtr()
		screenInfo( , , , , pitch )
		
		pitch \= sizeOf( ulong )
	else
		b = cptr( ulong ptr, m_bitmap ) + sizeOf( fb.image ) \ sizeOf( ulong )
		pitch = m_bitmap->pitch \ sizeOf( ulong )
	end if
	
	'ScreenLock
	
	For y As UInteger=0 To y_size-1
		For x As UInteger=0 To x_size-1
			c = abs( buffer2[ x ][ y ] * 255 )
			b[ ( y * pitch ) + x ] = rgb( c, c, c )
			
			'PSet (i,j),RGB(c,c,c)
		Next
	Next
	
	'ScreenUnLock
	'screensync
	
	Swap buffer1,buffer2
End Sub

Randomize timer
ScreenRes 1024,600,32

Dim w As wather_t=wather_t( 1024,600 )
Dim w1 As wather_t = wather_t( 320, 200, imageCreate( 320, 200 ) )

do
	screenLock()
	
	w.update_buffer(0.975)
	w.render_buffer()
	
	w1.update_buffer(0.975)
	w1.render_buffer()
	
	put( 0, 0 ), w1.renderBuffer, pset
	
	screenUnlock()
	
	sleep( 1, 1 )
loop until( inkey() <> "" )
Haubitze
Posts: 44
Joined: May 20, 2016 8:42

Re: Simple Wather Rippler

Post by Haubitze »

nice paul, how do you think about this code sniped?

Code: Select all

buffer2[i][j]= _
			Abs( buffer1[i+1][j]+buffer1[i-1][j]+buffer1[i][j+1]+buffer1[i][j-1]+ _
				  buffer1[i+1][j+1]+buffer1[i-1][j-1]+buffer1[i-1][j+1]+buffer1[i+1][j-1] _
				 )/4.0-buffer2[i][j]
i think it looks a bit more circle like.

salute
paul doe
Moderator
Posts: 1733
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: Simple Wather Rippler

Post by paul doe »

Haubitze wrote:i think it looks a bit more circle like.
Indeed, but I like the other version more. More rainy-like =D
Haubitze
Posts: 44
Joined: May 20, 2016 8:42

Re: Simple Wather Rippler

Post by Haubitze »

i add to the update sub an parameter where you can set the number of new drops. so you can make a big storm :D
and i take your updated version, but i think the image version slows down the program.

Code: Select all

#Include "fbgfx.bi"
Using FB
'#Include "wather-ripple.bi"



Type wather_t
   public:
      Declare Constructor( byval As UInteger, byval As uinteger )
      Declare Constructor( byval As UInteger, byval as uinteger, byval as fb.image ptr )
      
      Declare Destructor()
      
      Declare Sub update_buffer( byval As Single,nr_new_drops As UInteger)
      Declare Sub render_buffer()
      
      declare property renderBuffer() as fb.image ptr
      
   private:
      m_bitmap   as fb.image ptr
      
      buffer1      as single ptr ptr
      buffer2      as single ptr ptr
            
      x_size As UInteger
      y_size As UInteger
End Type

Constructor wather_t( byval x_size As UInteger, byval y_size As uinteger )
   this.x_size=x_size
   this.y_size=y_size
      
   buffer1=New single Ptr[x_size]
   buffer2=New Single Ptr[x_size]
   
   For i As UInteger=0 To x_size-1
      buffer1[i]=New Single[y_size]
      buffer2[i]=New Single[y_size]     
   Next   
End Constructor

constructor wather_t( byval x_size as uinteger, byval y_size as uinteger, byval pBitmap as fb.image ptr )
   this.x_size=x_size
   this.y_size=y_size
   
   buffer1=New single Ptr[x_size]
   buffer2=New Single Ptr[x_size]
   
   For i As UInteger=0 To x_size-1
      buffer1[i]=New Single[y_size]
      buffer2[i]=New Single[y_size]     
   Next

   m_bitmap = pBitmap
end constructor

Destructor wather_t()
   For i As UInteger=0 To x_size-1
     Delete [] buffer1[i]
     Delete [] buffer2[i]
   Next
 
  Delete [] buffer1
  Delete [] buffer2
 
  buffer1=0
  buffer2=0
 
  if( m_bitmap <> 0 ) then
     imageDestroy( m_bitmap )
     m_bitmap = 0
  end if
End Destructor

property wather_t.renderBuffer() as fb.image ptr
   return( m_bitmap )
end property

Sub wather_t.update_buffer( byval damping As Single,nr_new_drops As UInteger)
	For i As UInteger=0 To nr_new_drops-1
	buffer2[int(Rnd*x_size)][int(Rnd*y_size)]=1.0
	Next
	'buffer2[int(Rnd*x_size)][int(Rnd*y_size)]=1.0
   
   For x As UInteger=1 To x_size-2
     For y As UInteger=1 To y_size-2
         buffer2[x][y]= _
         Abs(buffer1[x+1][y]+buffer1[x-1][y]+buffer1[x][y+1]+buffer1[x][y-1])/2.0-buffer2[x][y]
         'buffer2[x][y]= _
			'Abs(buffer1[x+1][y]+buffer1[x-1][y]+buffer1[x][y+1]+buffer1[x][y-1]+ _
			'buffer1[x+1][y+1]+buffer1[x-1][y-1]+buffer1[x-1][y+1]+buffer1[x+1][y-1] _
			')/4.0-buffer2[x][y]
        buffer2[x][y]=buffer2[x][y]*damping
     Next
   Next
End Sub

Sub wather_t.render_buffer()
   Dim c As UByte
   dim as ulong ptr b
   dim as integer pitch
   
   if( m_bitmap = 0 ) then
      b = screenPtr()
      screenInfo( , , , , pitch )
      
      pitch \= sizeOf( ulong )
   else
      b = cptr( ulong ptr, m_bitmap ) + sizeOf( fb.image ) \ sizeOf( ulong )
      pitch = m_bitmap->pitch \ sizeOf( ulong )
   end if
   
   'ScreenLock
   
   For y As UInteger=0 To y_size-1
      For x As UInteger=0 To x_size-1
         c = abs( buffer2[ x ][ y ] * 255 )
         b[ ( y * pitch ) + x ] = rgb( c, c, c )
         
         'PSet (i,j),RGB(c,c,c)
      Next
   Next
   
   'ScreenUnLock
   'screensync
   
   Swap buffer1,buffer2
End Sub

Randomize timer
ScreenRes 1024,600,32

Dim w As wather_t=wather_t( 1024,600 )
Dim w1 As wather_t = wather_t( 320, 200, imageCreate( 320, 200 ) )

do
   screenLock()
   
   w.update_buffer(0.975,10)
   w.render_buffer()
   
   w1.update_buffer(0.975,10)
   w1.render_buffer()
   
   put( 0, 0 ), w1.renderBuffer, pset
   
   screenUnlock()
   
   sleep( 1, 1 )
loop until( inkey() <> "" )
paul doe
Moderator
Posts: 1733
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: Simple Wather Rippler

Post by paul doe »

Haubitze wrote:i add to the update sub an parameter where you can set the number of new drops. so you can make a big storm :D
and i take your updated version, but i think the image version slows down the program.
By all means, do so. The slowdown comes from the fact that you're calculating two buffers into one loop. Use one or the other, I put the image version to test it =D

It could be used to composite the drops with another image. Look:

Code: Select all

#Include "fbgfx.bi"

Using FB

Type wather_t
   public:
      Declare Constructor( byval As UInteger, byval As uinteger )
      Declare Constructor( byval As UInteger, byval as uinteger, byval as fb.image ptr )
      
      Declare Destructor()
      
      Declare Sub update_buffer( byval As Single)
      Declare Sub render_buffer()
      
      declare property renderBuffer() as fb.image ptr
      
   private:
      m_bitmap   as fb.image ptr
      
      buffer1      as single ptr ptr
      buffer2      as single ptr ptr
            
      x_size As UInteger
      y_size As UInteger
End Type

Constructor wather_t( byval x_size As UInteger, byval y_size As uinteger )
   this.x_size=x_size
   this.y_size=y_size
      
   buffer1=New single Ptr[x_size]
   buffer2=New Single Ptr[x_size]
   
   For i As UInteger=0 To x_size-1
      buffer1[i]=New Single[y_size]
      buffer2[i]=New Single[y_size]     
   Next   
End Constructor

constructor wather_t( byval x_size as uinteger, byval y_size as uinteger, byval pBitmap as fb.image ptr )
   this.x_size=x_size
   this.y_size=y_size
   
   buffer1=New single Ptr[x_size]
   buffer2=New Single Ptr[x_size]
   
   For i As UInteger=0 To x_size-1
      buffer1[i]=New Single[y_size]
      buffer2[i]=New Single[y_size]     
   Next

   m_bitmap = pBitmap
end constructor

Destructor wather_t()
   For i As UInteger=0 To x_size-1
     Delete [] buffer1[i]
     Delete [] buffer2[i]
   Next
 
  Delete [] buffer1
  Delete [] buffer2
 
  buffer1=0
  buffer2=0
 
  if( m_bitmap <> 0 ) then
     imageDestroy( m_bitmap )
     m_bitmap = 0
  end if
End Destructor

property wather_t.renderBuffer() as fb.image ptr
   return( m_bitmap )
end property

Sub wather_t.update_buffer( byval damping As Single)
   buffer2[int(Rnd*x_size)][int(Rnd*y_size)]=1.0
   
   For y As UInteger=1 To y_size-2
     For x As UInteger=1 To x_size-2
         buffer2[x][y]=Abs(buffer1[x+1][y]+buffer1[x-1][y]+buffer1[x][y+1]+buffer1[x][y-1])/2.0-buffer2[x][y]
         buffer2[x][y]=buffer2[x][y]*damping
     Next
   Next
End Sub

Sub wather_t.render_buffer()
   Dim c As UByte
   dim as ulong ptr b
   dim as integer pitch
   
   if( m_bitmap = 0 ) then
      b = screenPtr()
      screenInfo( , , , , pitch )
      
      pitch \= sizeOf( ulong )
   else
      b = cptr( ulong ptr, m_bitmap ) + sizeOf( fb.image ) \ sizeOf( ulong )
      pitch = m_bitmap->pitch \ sizeOf( ulong )
   end if
   
   'ScreenLock
   
   For y As UInteger=0 To y_size-1
      For x As UInteger=0 To x_size-1
         c = abs( buffer2[ x ][ y ] * 255 )
         b[ ( y * pitch ) + x ] = rgba( c, c, c, c )
         
         'PSet (i,j),RGB(c,c,c)
      Next
   Next
   
   'ScreenUnLock
   'screensync
   
   Swap buffer1,buffer2
End Sub

Randomize timer
dim as integer screenWidth = 1280, screenHeight = 720

screenRes( screenWidth, screenHeight, 32, , fb.gfx_alpha_primitives )

'' Creates an image to be used as background
dim as fb.image ptr background = imageCreate( screenWidth, screenHeight )

'' Load an image into the background buffer. Change to the one you like, the darker the better ;)
bload( "image.bmp", background )

'' Creates a raindrops object
dim as wather_t rainDrops = wather_t( _
	screenWidth, screenHeight, imageCreate( screenWidth, screenHeight, rgba( 0, 0, 0, 0 ) ) )

do
   screenLock()
   
   '' Draw the background first
   put( 0, 0 ), background, pset
   
   '' Update raindrops
   rainDrops.update_buffer(0.975)
   rainDrops.render_buffer()
   
   '' Composite them with the background
   put( 0, 0 ), rainDrops.renderBuffer, add
   
   screenUnlock()
   
   sleep( 1, 1 )
loop until( inkey() <> "" )

imageDestroy( background )
=D
Haubitze
Posts: 44
Joined: May 20, 2016 8:42

Re: Simple Wather Rippler

Post by Haubitze »

ah yeah i see, looks good :D
paul doe
Moderator
Posts: 1733
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: Simple Wather Rippler

Post by paul doe »

Haubitze wrote:ah yeah i see, looks good :D
To increase the speed, since you're using normalized values (between 0 and 1), simply use ubytes instead of singles, and do the needed math with those. It'll get way faster, trust me =D
Haubitze
Posts: 44
Joined: May 20, 2016 8:42

Re: Simple Wather Rippler

Post by Haubitze »

Now i code a fire effect. it is most the same prozedure iuse in the wather-ripple.

the pallete is not the best but it works. also the code for the cooling map is not the best. i think a 2d-perlin-noise will give betther results.
so here is the idea.

Code: Select all

#Include "fbgfx.bi"
Using FB
'#Include "fire-ripple.bi"

Type fire_t
	Declare Constructor(x_size As UInteger,y_size As UInteger)
	Declare Destructor()

	Declare Sub update_buffer()
	Declare Sub render_buffer()


	palet As UInteger Ptr
	buffer1 As Short Ptr Ptr
	buffer2 As Short Ptr Ptr
	cool As Short Ptr Ptr

	x_size As UInteger
	y_size As UInteger
	p_size As UInteger
End Type
Constructor fire_t(x_size As UInteger,y_size As UInteger)
this.p_size=9
this.x_size=x_size
this.y_size=y_size
palet=New UInteger[p_size]
buffer1=New Short Ptr[x_size]
buffer2=New Short Ptr[x_size]
cool=New Short Ptr[x_size]
For i As UInteger=0 To x_size-1
	buffer1[i]=New Short[y_size]
	buffer2[i]=New Short[y_size]
	cool[i]=New Short[y_size]
Next
'craete palette
palet[8]=RGB(204, 216, 253)
palet[7]=RGB(242, 241, 254	)
palet[6]=RGB(254, 229, 207	)
palet[5]=RGB(254, 199, 140	)
palet[4]=RGB(254, 164 , 73	)
palet[3]=RGB(254, 123 ,  0	)
palet[2]=RGB(253,  74 ,  0	)
palet[1]=RGB(254,   0 ,  0	)
palet[0]=RGB(0,   0 ,  0	)
'create the cooling map
'better results with a 2d-perlin noise
	For i As UInteger=0 To x_size-1
		For j As UInteger=0 To y_size-1
			cool[i][j]=Rnd*255
		Next
	Next
End Constructor
Destructor fire_t()
For i As UInteger=0 To x_size-1
	Delete [] buffer1[i]
	Delete [] buffer2[i]
	Delete [] cool[i]
Next
Delete [] buffer1
Delete [] buffer2
Delete [] cool
Delete [] palet
palet=0
cool=0
buffer1=0
buffer2=0
End Destructor
Sub fire_t.update_buffer()
	'create fire
	For i As UInteger=50 To x_size-1-50
		'buffer1[i][y_size-1]=255
		buffer2[i][y_size-1]=255
		buffer2[i][y_size-2]=255
	Next
	'create new cooling values on the cool map
	'bether result with 2d-perlin noise
	For i As UInteger=0 To 20
		cool[Int(Rnd*x_size)][y_size-1]=Rnd*2
	Next
	'lets burn
	For i As UInteger=1 To x_size-2
		For j As UInteger=1 To y_size-2
			buffer1[i][j]=(buffer2[i-1][j]+buffer2[i+1][j]+buffer2[i][j-1]+buffer2[i][j+1]+buffer2[i-1][j-1]+buffer2[i+1][j-1]+buffer2[i+1][j+1]+buffer2[i-1][j+1])/8
			buffer1[i][j]-=cool[i][j]
			If buffer1[i][j]>=255 Then buffer1[i][j]=255
			If buffer1[i][j]<=0 Then buffer1[i][j]=0
			buffer2[i][j-1]=(buffer1[i][j])
		Next
	Next
	'scroll cool map one line up
	For i As UInteger=0 To x_size-1
		For j As UInteger=1 To y_size-1
			cool[i][j-1]=cool[i][j]
		Next
	Next

End Sub
Sub fire_t.render_buffer()
	For i As UInteger=0 To x_size-1
		For j As UInteger=0 To y_size-1
			'render pixel with pallete
			PSet(i,j),palet[buffer1[i][j]\31]
		Next
	Next
End Sub


Randomize Timer

ScreenRes 400,300,32

Dim f As fire_t=fire_t(400,300)


While Not(MultiKey(SC_ESCAPE))
f.update_buffer()
f.render_buffer()	
Wend
salute
MrSwiss
Posts: 3910
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Simple Wather Rippler

Post by MrSwiss »

Since I personally don't (at all) like *Program Escaping*, you might want to re-code
the loop, as follows (gets *out* of program also, on a mouse-click on the [X]):

Code: Select all

While 1 ' endless loop (also a option: Do ... Loop)
    If Len(InKey) > 0 Then Exit While   ' quit loop (end prog.)
    f.update_buffer()
    f.render_buffer()   
Wend
Post Reply