Help with water

Blitz3D Forums/Blitz3D Programming/Help with water

MusicianKool

(Posted 2011) [#1]

Well I'm trying to make a 2d fluid simulation around a single point.
all I have right now is basically a gravity simulation with very poor collision reaction for anything resembling water. everything is based oh circles so it should be somewhat easier to do. any help or tips would be appreciated.

code

Graphics 800,600,32,2
SetBuffer BackBuffer()
SeedRnd MilliSecs()

Type Particle
	Field X#,Y#
	Field Ax#,Ay#
	Field Vx#,Vy#
	Field Lx#,Ly#
	Field Mass#
	Field viscosity#
	Field surfaceTension#
	Field Radius#
	Field r,g,b
End Type

Global ParticlesCount =0 
Global GravitationalConstant# = .6672
Local I,This.Particle,This2.Particle
Local ang#,dist#,force#,tx#,ty#

For I = 1 To 200
	This.Particle = New Particle
	.retry
	This\X = Rand(800)
	This\Y = Rand(600)
	ang# = Angle2D(This\X,This\Y,400,300)
	dist# = Distance2D(This\X,This\Y,400,300)
	This\Radius = 3.4
	This2.Particle = First Particle
	
	;
	While This2 <> Null
		If This2 = This Then Goto skipp
		DebugLog Distance2D#(This\X,This\Y,This2\X,This2\Y)
		DebugLog This\X + "   " + This\Y + "    " + This2\X + "    " + This2\Y
		If Distance2D#(This\X,This\Y,This2\X,This2\Y)<(This\Radius) Then Goto retry
		.skipp
		This2 = After This2
	Wend
	
	This\Mass = 1;Rnd(10000)
	
	If I = 1 Then
		This\X = 400
		This\Y = 300
		This\Mass = 100
		This\Radius = 100
	EndIf
	
	This2.Particle = First Particle
	This\Vx = GravitationalConstant * (Sin(ang-90)*((This2\Mass*This\Mass) / dist*3))
	This\Vy = GravitationalConstant * (Cos(ang-90)*((This2\Mass*This\Mass) / dist*3))
	This\r = Rand(255)
	This\g = Rand(255)
	This\b = Rand(255)
	ParticlesCount = ParticlesCount + 1
	
Next


Global TimeStep# = 2
While Not KeyHit(1)
	Cls
	;LockBuffer BackBuffer()
	UpdateGravity()
	;UnlockBuffer BackBuffer()
	Flip
Wend


Function Distance2D#(x#,y#,x2#,y2#)
	
	Return Sqr(((x#-x2#)*(x#-x2#))+((y#-y2#)*(y#-y2#)))
End Function

Function Angle2D#( x1#,y1#,x2#,y2# )
	Return ATan2(x2-x1,y2-y1)
End Function

Function UpdateGravity()
	Local P.Particle,P2.Particle,P3.Particle
	Local Dist#,Angl#,tx#,ty#,Factor#,AX#,AY#,VL#
	P2.Particle = First Particle
	For P.Particle = Each Particle
		;clear acceleration
		P\Ax = 0
		P\Ay = 0
		
		If (ParticlesCount > 1) Then
			; store last position
			P\Lx = P\X
			P\Ly = P\Y
			
			;If P = P2 Then Goto skip
			If P = First Particle Then Goto skip
			
			Dist# = Distance2D(P\X,P\Y,P2\X,P2\Y)
			Angl# = Angle2D(P\X,P\Y,P2\X,P2\Y)
			
			;calculate gravitational factor
			Factor = (GravitationalConstant*((P\Mass*P2\Mass)/(Dist*Dist)))/P\Mass
			
			
			; apply gravity to acceleration
			P\Ax = P\Ax + (Sin(Angl) * Factor)
			P\Ay = P\Ay + (Cos(Angl) * Factor)
			
			; apply acceleration to velocity
			P\Vx = P\Vx + P\Ax
			P\Vy = P\Vy + P\Ay
			
			; apply velocity to position
			P\X = P\X + P\Vx
			P\Y = P\Y + P\Vy
			
			;keep the first particle at center
			If P = First Particle Then P\X = 400:P\Y=300
			
			.skip
			
			;draw the particle
			Color P\r,P\g,P\b
			If P\X < GraphicsWidth() And P\X > 0 And P\Y < GraphicsHeight() And P\Y > 0 Then
				;WritePixelFast P\X,P\Y,GetRGB(P\r,P\g,P\b),BackBuffer()
				Oval P\X-P\Radius,P\Y-P\Radius,P\Radius*2,P\Radius*2,0
			EndIf
			
			;collision detection and action ( where i think the water thing needs to be)
			P3.Particle = After P
			While P3 <> Null
				If Distance2D(P\X,P\Y,P3\X,P3\Y) < P\Radius+P3\Radius Then
					t_dist# = Distance2D(P3\X,P3\Y,P3\Lx,P3\Ly)
					t_angl# = Angle2D(P3\X,P3\Y,P3\Lx,P3\Ly)
					P3\X = P3\X+Sin(t_angl)*(t_dist+.1)
					P3\Y = P3\Y+Cos(t_angl)*(t_dist+.1)
					;P3\X = P3\Lx
					;P3\Y = P3\Ly
					Angl = Angle2D(P\X,P\Y,P3\X,P3\Y)
					p_angl# = Angle2D(0,0,P\Vx,P\Vy)
					p_dist# = Distance2D(0,0,P\Vx,P\Vy)
					P3_angl# = Angle2D(0,0,P3\Vx,P3\Vy)
					p3_dist# = Distance2D(0,0,P3\Vx,P3\Vy)
					
					P\Vx = (Sin(p_angl+180)*p_dist/2)
					P\Vy = (Cos(P_Angl+180)*p_dist/2)
					P3\Vx = (Sin(p3_angl+180)*p3_dist/2)
					P3\Vy = (Cos(P3_Angl+180)*p3_dist/2)
				EndIf
				P3 = After P3
			Wend
			
		EndIf
	Next
	
End Function

Function GetRGB(r,g,b)
	Return b Or (g Shl 8) Or (r Shl 16)
End Function

Function GetR(RGB)
    Return RGB Shr 16 And %11111111
End Function

Function GetG(RGB)
	Return RGB Shr 8 And %11111111
End Function

Function GetB(RGB)
	Return RGB And %11111111
End Function

Last edited 2011

MusicianKool

(Posted 2011) [#2]

I need help with conservation of momentum for circular objects such as pool.

MusicianKool

(Posted 2011) [#3]

Well now I need help optimizing the code so I can use more then 200 without slowing down. still a little fun to play with.

right mouse moves center circle to mouse's position
left mouse slows things down a lot.

Graphics 800,600,32,2
SetBuffer BackBuffer()
SeedRnd MilliSecs()


Type Particle
	Field X#,Y#
	Field Lx#,Ly#
	Field Mass#
	Field Radius#
	Field unmoveable
	Field Va.Vector
	Field Vv.Vector
	Field C.Color
End Type

Type Vector
	Field X#,Y#,Z#
End Type

Type Color
	Field R,G,B
End Type

Const GravityEnabled = False
Const OrbitEnabled = False

Global SlowDown#=.2
Global ParticlesCount =0 
Global GravitationalConstant# = 66.72
Local I,This.Particle,This2.Particle
Local ang#,dist#,force#,tx#,ty#

For I = 1 To 300
	This.Particle = New Particle
	This\Vv.Vector = New Vector
	This\Va.Vector = New Vector
	.retry
	This\X = Rand(800)
	This\Y = Rand(600)
	ang# = Angle2D(This\X,This\Y,400,300)
	dist# = Distance2D(This\X,This\Y,400,300)
	This\Radius = 2
	This2.Particle = First Particle
	This\Mass = .1
	This\unmoveable = 0
	If I = 1 Then
		This\X = GraphicsWidth()/2
		This\Y = GraphicsHeight()/2
		This\Radius = 100
		This\unmoveable = 1
		This\Mass = 1000
	EndIf
	
	While This2 <> Null
		If This2 = This Then Goto skipp
		If Distance2D#(This\X,This\Y,This2\X,This2\Y)<(This\Radius) Then Goto retry
		.skipp
		This2 = After This2
	Wend
	
	This2.Particle = First Particle
	
	;The commented code below is for orbital velocity with gravity enabled
	If GravityEnabled = True And OrbitEnabled = True Then
		This\Vv\X = (GravitationalConstant * (Sin(ang-90)*((This2\Mass*This\Mass) / dist)))/2
		This\Vv\Y = (GravitationalConstant * (Cos(ang-90)*((This2\Mass*This\Mass) / dist)))/2
	Else 
		This\Vv\X = 0
		This\Vv\Y = 0
	EndIf
	This\C.Color = New Color
	This\C\R = 0;Rand(255)
	This\C\G = 0;Rand(255)
	This\C\B = (128 + Rand(128))-1
	ParticlesCount = ParticlesCount + 1
	
Next


Global TimeStep# = 2
While Not KeyHit(1)
	Cls
	;LockBuffer BackBuffer()
	UpdateGravity()
	;UnlockBuffer BackBuffer()
	Color 0,0,0
	;Oval This2\X-This2\Radius,This2\Y-This2\Radius,This2\Radius*2,This2\Radius*2,1
	Color 255,255,255
	Oval This2\X-This2\Radius,This2\Y-This2\Radius,This2\Radius*2,This2\Radius*2,0
	
	If MouseDown(1) Then This2\X = MouseX(): This2\Y = MouseY()
	SlowDown = .94
	If MouseDown(2) Then SlowDown = .1
	Flip
Wend

Function Distance2D#(x#,y#,x2#,y2#)
	Return Sqr(((x#-x2#)*(x#-x2#))+((y#-y2#)*(y#-y2#)))
End Function

Function Angle2D#( x1#,y1#,x2#,y2# )
	Return ATan2(x2-x1,y2-y1)
End Function

Function UpdateGravity()
	Local P.Particle,P2.Particle,P3.Particle
	Local Dist#,Angl#,tx#,ty#,Factor#,AX#,AY#,VL#
	Local c.Particle,c2.Particle
	Local CollisionDistance#,ActualDistance#
	Local CollNormalAngle#
	Local MoveDist1#,MoveDist2#
	Local NX#,NY#,A1#,A2#
	Local OptimisedP#
	
	
	
	P2.Particle = First Particle
	
	For P.Particle = Each Particle
		If P = P2 Then P = After P
		;clear acceleration
		P\Va\X = 0
		P\Va\Y = 0
		
		If (ParticlesCount > 1) Then
			; store last position
			P\Lx = P\X
			P\Ly = P\Y
			
			;If P = P2 Then Goto skip
			If P = First Particle Then Goto skip
			
			Dist# = Distance2D(P\X,P\Y,P2\X,P2\Y)
			Angl# = Angle2D(P\X,P\Y,P2\X,P2\Y)
			
			;calculate gravitational factor
			If GravityEnabled = True Then 
				Factor = (GravitationalConstant*((P\Mass*P2\Mass)/(Dist)))/P2\Mass
			Else
				Factor = .7
			EndIf
			
			; apply gravity to acceleration
			P\Va\X = P\Va\X + (Sin(Angl) * Factor)
			P\Va\Y = P\Va\Y + (Cos(Angl) * Factor)
			
			; apply acceleration to velocity
			P\Vv\X = (P\Vv\X + P\Va\X)*SlowDown
			P\Vv\Y = (P\Vv\Y + P\Va\Y)*SlowDown
			
			; apply velocity to position
			If Not P\unmoveable Then
				P\X = P\X + P\Vv\X
				P\Y = P\Y + P\Vv\Y
			EndIf
			
			.skip
			
			;collision detection and action ( where i think the water thing needs to be)
			P3.Particle = P2
			While P3 <> Null
				
				c.Particle = P
				c2.Particle = P3
				
				
				;Found this bit of code in the Archives By Joseph 'Phish' Humfrey
				;helped out alot but still not as fast I was hopping for.
				
				CollisionDistance# = c\Radius+c2\Radius
				ActualDistance# = Sqr((c2\X-c\X)^2+(c2\Y-c\Y)^2)
					
				;Collided or not?
				If ActualDistance<CollisionDistance Then
						
					CollNormalAngle#=ATan2(c2\Y-c\Y, c2\X-c\X)
						
					;Position exactly touching, no intersection
					MoveDist1#=(CollisionDistance-ActualDistance)*(c2\Mass/Float((c\Mass+c2\Mass)))
					MoveDist2#=(CollisionDistance-ActualDistance)*(c\Mass/Float((c\Mass+c2\Mass)))
					If Not c\unmoveable Then
						c\X=c\X + MoveDist1*Cos(CollNormalAngle+180)
						c\Y=c\Y + MoveDist1*Sin(CollNormalAngle+180)
					EndIf
					If Not c2\unmoveable Then
						c2\X=c2\X + MoveDist2*Cos(CollNormalAngle)
						c2\Y=c2\Y + MoveDist2*Sin(CollNormalAngle)
					EndIf
						
					;------------------------------------------
					;COLLISION RESPONSE
					;------------------------------------------
					;n = vector connecting the centers of the circles.
					;we are finding the components of the normalised vector n
					NX#=Cos(CollNormalAngle)
					NY#=Sin(CollNormalAngle)
						
					;now find the length of the components of each movement vectors
					;along n, by using dot product.
					A1# = c\Vv\X*NX  +  c\Vv\Y*NY
					A2# = c2\Vv\X*NX +  c2\Vv\Y*NY
						
					;optimisedP = 2(a1 - a2)
					;             ----------
					;              m1 + m2
					OptimisedP# = (2.05 * (A1-A2)) / (c\Mass + c2\Mass)
						
					;now find out the resultant vectors
					;r1 = c1\v - optimisedP * mass2 * n
					If Not c\unmoveable Then
						c\Vv\X = (c\Vv\X - (OptimisedP*c2\Mass*NX))
						c\Vv\Y = (c\Vv\Y - (OptimisedP*c2\Mass*NY))
					EndIf
					
					;r2 = c2\v - optimisedP * mass1 * n
					If Not c2\unmoveable Then
						c2\Vv\X = (c2\Vv\X + (OptimisedP*c\Mass*NX))
						c2\Vv\Y = (c2\Vv\Y + (OptimisedP*c\Mass*NY))
					EndIf
				End If
				P3 = After P3	
			Wend
			;draw the particle
			
			If P\X < GraphicsWidth() And P\X > 0 And P\Y < GraphicsHeight() And P\Y > 0 Then
				Color P\C\R,P\C\G,P\C\B
				;WritePixelFast P\X,P\Y,GetRGB(P\C),BackBuffer()
				Oval P\X-P\Radius,P\Y-P\Radius,P\Radius*2,P\Radius*2,1
			EndIf
		EndIf
	Next
	
End Function

Function GetRGB(c.Color)
	Return c\B Or (c\G Shl 8) Or (c\R Shl 16)
End Function

Function GetR(RGB)
    Return RGB Shr 16 And %11111111
End Function

Function GetG(RGB)
	Return RGB Shr 8 And %11111111
End Function

Function GetB(RGB)
	Return RGB And %11111111
End Function

Last edited 2011

Serpent

(Posted 2011) [#4]

I'll look into this a bit more later (I tried doing something like this before and failed miserably...) but you can do all of the collision stuff with nothing but vectors.
For instance, to get NX and NY you just have to divide the X and Y distances (c2\X - c\X) by the actual distance.
Also, I'd check if the masses are equal and if so leave out that part of the calculations.
Probably the biggest time killer is collision detection. There are a few things that can be changed here:
- Checking for collisions can be faster if you don't bother square rooting the distance. You can just square the collision distance instead, which should be faster.
- I'm not sure if powers are optimised when compiling, but it might help to replace the ' ^2 's with a multiplication.
- At the moment, each particle is checked against every other particle for collisions. This could be improved by checking only the particles afterwards, almost halving the number of collision checks.

Last edited 2011

SLotman

(Posted 2011) [#5]

This speeds it up a little:

Graphics 800,600,32,2
SetBuffer BackBuffer()
SeedRnd MilliSecs()


Type Particle
	Field X#,Y#
	Field Lx#,Ly#
	Field Mass#
	Field Radius#
	Field unmoveable
	Field Va.Vector
	Field Vv.Vector
	Field C.Color
End Type

Type Vector
	Field X#,Y#,Z#
End Type

Type Color
	Field R,G,B
End Type

Const GravityEnabled = False
Const OrbitEnabled = False

Global SlowDown#=.2
Global ParticlesCount =0 
Global GravitationalConstant# = 66.72
Local I,This.Particle,This2.Particle
Local ang#,dist#,force#,tx#,ty#

For I = 1 To 200
	This.Particle = New Particle
	This\Vv.Vector = New Vector
	This\Va.Vector = New Vector
	.retry
	This\X = Rand(800)
	This\Y = Rand(600)
	ang# = Angle2D(This\X,This\Y,400,300)
	dist# = Sqr(Distance2D(This\X,This\Y,400,300))
	This\Radius = 2
	This2.Particle = First Particle
	This\Mass = .1
	This\unmoveable = 0
	If I = 1 Then
		This\X = 400
		This\Y = 300
		This\Radius = 100
		This\unmoveable = 1
		This\Mass = 1000
	EndIf
	
	rad#=this\radius*this\radius
	While This2 <> Null
		If This2 = This Then Goto skipp
		If Distance2D#(This\X,This\Y,This2\X,This2\Y)<rad Then Goto retry
		.skipp
		This2 = After This2
	Wend
	
	This2.Particle = First Particle
	
	;The commented code below is for orbital velocity with gravity enabled
	If GravityEnabled = True And OrbitEnabled = True Then
		This\Vv\X = (GravitationalConstant * (Sin(ang-90)*((This2\Mass*This\Mass) / dist)))/2
		This\Vv\Y = (GravitationalConstant * (Cos(ang-90)*((This2\Mass*This\Mass) / dist)))/2
	Else 
		This\Vv\X = 0
		This\Vv\Y = 0
	EndIf
	This\C.Color = New Color
	This\C\R = 0;Rand(255)
	This\C\G = 0;Rand(255)
	This\C\B = (128 + Rand(128))-1
	ParticlesCount = ParticlesCount + 1
	
Next


Global TimeStep# = 2
While Not KeyHit(1)
	Cls
	;LockBuffer BackBuffer()
	UpdateGravity()
	;UnlockBuffer BackBuffer()
	Color 0,0,0
	;Oval This2\X-This2\Radius,This2\Y-This2\Radius,This2\Radius*2,This2\Radius*2,1
	Color 255,255,255
	rad#=this2\radius*2
	Oval This2\X-This2\Radius,This2\Y-This2\Radius,rad,rad,0
	
	If MouseDown(1) Then This2\X = MouseX(): This2\Y = MouseY()
	SlowDown = .94
	If MouseDown(2) Then SlowDown = .1
	Flip 0
Wend

Function Distance2D#(x#,y#,x2#,y2#)
	xd#=x-x2
	yd#=y-y2
	Return (xd*xd+yd*yd)
End Function

Function Angle2D#( x1#,y1#,x2#,y2# )
	Return ATan2(x2-x1,y2-y1)
End Function

Function UpdateGravity()
	Local P.Particle,P2.Particle,P3.Particle
	Local Dist#,Angl#,tx#,ty#,Factor#,AX#,AY#,VL#
	Local c.Particle,c2.Particle
	Local CollisionDistance#,ActualDistance#
	Local CollNormalAngle#
	Local MoveDist1#,MoveDist2#
	Local NX#,NY#,A1#,A2#
	Local OptimisedP#
	
	
	
	P2.Particle = First Particle
	
	For P.Particle = Each Particle
		If P = P2 Then P = After P
		;clear acceleration
		P\Va\X = 0
		P\Va\Y = 0
		
		If (ParticlesCount > 1) Then
			; store last position
			P\Lx = P\X
			P\Ly = P\Y
			
			;If P = P2 Then Goto skip
			If P = First Particle Then Goto skip
			
			Dist# = Distance2D(P\X,P\Y,P2\X,P2\Y)
			Angl# = Angle2D(P\X,P\Y,P2\X,P2\Y)
			
			;calculate gravitational factor
			If GravityEnabled = True Then 
				Factor = (GravitationalConstant*((P\Mass*P2\Mass)/(Dist)))/P2\Mass
			Else
				Factor = .7
			EndIf
			
			; apply gravity to acceleration
			P\Va\X = P\Va\X + (Sin(Angl) * Factor)
			P\Va\Y = P\Va\Y + (Cos(Angl) * Factor)
			
			; apply acceleration to velocity
			P\Vv\X = (P\Vv\X + P\Va\X)*SlowDown
			P\Vv\Y = (P\Vv\Y + P\Va\Y)*SlowDown
			
			; apply velocity to position
			If Not P\unmoveable Then
				P\X = P\X + P\Vv\X
				P\Y = P\Y + P\Vv\Y
			EndIf
			
			.skip
			
			;collision detection and action ( where i think the water thing needs to be)
			P3.Particle = P2
			While P3 <> Null
				
				c.Particle = P
				c2.Particle = P3
				
				
				;Found this bit of code in the Archives By Joseph 'Phish' Humfrey
				;helped out alot but still not as fast I was hopping for.
				
				CollisionDistance# = (c\Radius+c2\Radius)
				dx#=(c2\x-c\x)
				dy#=(c2\y-c\y)
				ActualDistance# = Sqr(dx*dx+dy*dy)

				cold#=CollisionDistance-ActualDistance
					
				;Collided or not?
				If ActualDistance<CollisionDistance Then
						
					CollNormalAngle#=ATan2(dy, dx)
					;------------------------------------------

					;COLLISION RESPONSE
					;------------------------------------------
					;n = vector connecting the centers of the circles.
					;we are finding the components of the normalised vector n
					NX#=Sin(CollNormalAngle)
					NY#=Cos(CollNormalAngle)
					
					TTMass# = c\Mass+c2\Mass
						
					;Position exactly touching, no intersection
					MoveDist1#=(cold)*(c2\Mass/TTMass)
					MoveDist2#=(cold)*(c\Mass/TTMass)
					If Not c\unmoveable Then
						c\X=c\X + MoveDist1*Cos(CollNormalAngle+180)
						c\Y=c\Y + MoveDist1*Sin(CollNormalAngle+180)
					EndIf
					If Not c2\unmoveable Then
						c2\X=c2\X + MoveDist2*NX
						c2\Y=c2\Y + MoveDist2*NY
					EndIf
						
						
					;now find the length of the components of each movement vectors
					;along n, by using dot product.
					A1# = c\Vv\X*NX  +  c\Vv\Y*NY
					A2# = c2\Vv\X*NX +  c2\Vv\Y*NY
						
					;optimisedP = 2(a1 - a2)
					;             ----------
					;              m1 + m2
					OptimisedP# = (2.05 * (A1-A2)) / TTMass
						
					;now find out the resultant vectors
					;r1 = c1\v - optimisedP * mass2 * n
					If Not c\unmoveable Then
						c\Vv\X = (c\Vv\X - (OptimisedP*c2\Mass*NX))
						c\Vv\Y = (c\Vv\Y - (OptimisedP*c2\Mass*NY))
					EndIf
					
					;r2 = c2\v - optimisedP * mass1 * n
					If Not c2\unmoveable Then
						c2\Vv\X = (c2\Vv\X + (OptimisedP*c\Mass*NX))
						c2\Vv\Y = (c2\Vv\Y + (OptimisedP*c\Mass*NY))
					EndIf
				End If
				P3 = After P3	
			Wend
			;draw the particle
			
			If P\X < GraphicsWidth() And P\X > 0 And P\Y < GraphicsHeight() And P\Y > 0 Then
				Color P\C\R,P\C\G,P\C\B
				;WritePixelFast P\X,P\Y,GetRGB(P\C),BackBuffer()
				rad=P\Radius*2
				Oval P\X-P\Radius,P\Y-P\Radius,rad,rad,1
			EndIf
		EndIf
	Next
	
End Function

Function GetRGB(c.Color)
	Return c\B Or (c\G Shl 8) Or (c\R Shl 16)
End Function

Function GetR(RGB)
    Return RGB Shr 16 And %11111111
End Function

Function GetG(RGB)
	Return RGB Shr 8 And %11111111
End Function

Function GetB(RGB)
	Return RGB And %11111111
End Function

I can go up to 600 here :)

Serpent

(Posted 2011) [#6]

A few things seem to be broken though...

Serpent

(Posted 2011) [#7]

Some optimisation, works with up to 800 on my PC:

Graphics 800,600,32,2
SetBuffer BackBuffer()
SeedRnd MilliSecs()


Type Particle
	Field X#,Y#
	Field Lx#,Ly#
	Field Mass#
	Field Radius#
	Field unmoveable
	Field Va.Vector
	Field Vv.Vector
	Field C.Color
End Type

Type Vector
	Field X#,Y#,Z#
End Type

Type Color
	Field R,G,B
End Type

Const GravityEnabled = False
Const OrbitEnabled = False

Global SlowDown#=.2
Global ParticlesCount =0 
Global GravitationalConstant# = 66.72
Local I,This.Particle,This2.Particle
Local ang#,dist#,force#,tx#,ty#

;Original:  Maximum of 300 without lag

For I = 1 To 800
	This.Particle = New Particle
	This\Vv.Vector = New Vector
	This\Va.Vector = New Vector
	.retry
	This\X = Rand(800)
	This\Y = Rand(600)
	ang# = Angle2D(This\X,This\Y,400,300)
	dist# = Distance2D(This\X,This\Y,400,300)
	This\Radius = 2
	This2.Particle = First Particle
	This\Mass = .1
	This\unmoveable = 0
	If I = 1 Then
		This\X = GraphicsWidth()/2
		This\Y = GraphicsHeight()/2
		This\Radius = 100
		This\unmoveable = 1
		This\Mass = 1000
	EndIf
	
	While This2 <> Null
		If This2 = This Then Goto skipp
		If Distance2D#(This\X,This\Y,This2\X,This2\Y)<(This\Radius) Then Goto retry
		.skipp
		This2 = After This2
	Wend
	
	This2.Particle = First Particle
	
	;The commented code below is for orbital velocity with gravity enabled
	If GravityEnabled = True And OrbitEnabled = True Then
		This\Vv\X = (GravitationalConstant * (Sin(ang-90)*((This2\Mass*This\Mass) / dist)))/2
		This\Vv\Y = (GravitationalConstant * (Cos(ang-90)*((This2\Mass*This\Mass) / dist)))/2
	Else 
		This\Vv\X = 0
		This\Vv\Y = 0
	EndIf
	This\C.Color = New Color
	This\C\R = 0;Rand(255)
	This\C\G = 0;Rand(255)
	This\C\B = (128 + Rand(128))-1
	ParticlesCount = ParticlesCount + 1
	
Next


Global TimeStep# = 2
While Not KeyHit(1)
	Cls
	;LockBuffer BackBuffer()
	UpdateGravity()
	;UnlockBuffer BackBuffer()
	Color 0,0,0
	;Oval This2\X-This2\Radius,This2\Y-This2\Radius,This2\Radius*2,This2\Radius*2,1
	Color 255,255,255
	Oval This2\X-This2\Radius,This2\Y-This2\Radius,This2\Radius*2,This2\Radius*2,0
	
	If MouseDown(1) Then This2\X = MouseX(): This2\Y = MouseY()
	SlowDown = .94
	If MouseDown(2) Then SlowDown = .1
	Flip
Wend

Function Distance2D#(x#,y#,x2#,y2#)
	Return Sqr(((x#-x2#)*(x#-x2#))+((y#-y2#)*(y#-y2#)))
End Function

Function Angle2D#( x1#,y1#,x2#,y2# )
	Return ATan2(x2-x1,y2-y1)
End Function

Function UpdateGravity()
	Local P.Particle,P2.Particle,P3.Particle
	Local Dist#,Angl#,tx#,ty#,Factor#,DX#,DY#,AX#,AY#,VL#
	Local c.Particle,c2.Particle
	Local CollisionDistance#,ActualDistance#
	Local CollisionDistance2#, ActualDistance2#
	Local CollNormalAngle#
	Local Move1#,Move2#
	Local NX#,NY#,A1#,A2#
	Local OptimisedP#
	
	
	
	P2.Particle = First Particle
	
	For P.Particle = Each Particle
		;If P = P2 Then P = After P
		
		;clear acceleration
		P\Va\X = 0
		P\Va\Y = 0
		
		If (ParticlesCount > 1) Then
			; store last position
			P\Lx = P\X
			P\Ly = P\Y
			
			If P = P2 Then Goto skip
			;If P = First Particle Then Goto skip
			
			Dist# = Distance2D(P\X,P\Y,P2\X,P2\Y)
			;Angl# = Angle2D(P\X,P\Y,P2\X,P2\Y)
			
			;calculate gravitational factor
			If GravityEnabled = True Then 
				Factor = (GravitationalConstant*((P\Mass*P2\Mass)/(Dist)))/P2\Mass
			Else
				Factor = .7
			EndIf
			
			; apply gravity to acceleration
			P\Va\X = P\Va\X + ((P2\X - P\X) / Dist * Factor)
			P\Va\Y = P\Va\Y + ((P2\Y - P\Y) / Dist * Factor)
			
			; apply acceleration to velocity
			P\Vv\X = (P\Vv\X + P\Va\X)*SlowDown
			P\Vv\Y = (P\Vv\Y + P\Va\Y)*SlowDown
			
			; apply velocity to position
			If Not P\unmoveable Then
				P\X = P\X + P\Vv\X
				P\Y = P\Y + P\Vv\Y
			EndIf
			
			.skip
			
			;collision detection and action ( where i think the water thing needs to be)
			P3.Particle = After P
			While P3 <> Null
				
				c.Particle = P
				c2.Particle = P3
				
				
				;Found this bit of code in the Archives By Joseph 'Phish' Humfrey
				;helped out alot but still not as fast I was hopping for.
				
				CollisionDistance# = c\Radius+c2\Radius
				CollisionDistance2# = CollisionDistance# * CollisionDistance#
				DX# = c2\X-c\X
				DY# = c2\Y-c\Y
				ActualDistance2# = (DX)*(DX)+(DY)*(DY)
				
				;Collided or not?
				If ActualDistance2<CollisionDistance2 Then
					;If P = P2 And KeyDown(57) Then Stop
					;CollNormalAngle#=ATan2(c2\Y-c\Y, c2\X-c\X)
					ActualDistance# = Sqr#(ActualDistance2)
					CollisionDistance# = Sqr#(CollisionDistance2) - ActualDistance
					
					;------------------------------------------
					;COLLISION RESPONSE
					;------------------------------------------
					;n = vector connecting the centers of the circles.
					;we are finding the components of the normalised vector n
					;NX#=Cos(CollNormalAngle)
					;NY#=Sin(CollNormalAngle)
					NX# = DX# / ActualDistance#
					NY# = DY# / ActualDistance#
					
					;Position exactly touching, no intersection
					Move1#=(c2\Mass/Float#(c\Mass+c2\Mass))
					Move2#=(c\Mass/Float#(c\Mass+c2\Mass))
					If Not c\unmoveable Then
						c\X=c\X + Move1*NX*CollisionDistance
						c\Y=c\Y + Move1*NY*CollisionDistance
					EndIf
					If Not c2\unmoveable Then
						c2\X=c2\X + Move2*NX*CollisionDistance
						c2\Y=c2\Y + Move2*NY*CollisionDistance
					EndIf
					
					;now find the length of the components of each movement vectors
					;along n, by using dot product.
					A1# = c\Vv\X*NX  +  c\Vv\Y*NY
					A2# = c2\Vv\X*NX +  c2\Vv\Y*NY
					
					;optimisedP = 2(a1 - a2)
					;             ----------
					;              m1 + m2
					OptimisedP# = (2.0 * (A1-A2)) / (c\Mass + c2\Mass)
					
					;now find out the resultant vectors
					;r1 = c1\v - optimisedP * mass2 * n
					If Not c\unmoveable Then
						c\Vv\X = (c\Vv\X - (OptimisedP*c2\Mass*NX))
						c\Vv\Y = (c\Vv\Y - (OptimisedP*c2\Mass*NY))
					EndIf
					
					;r2 = c2\v - optimisedP * mass1 * n
					If Not c2\unmoveable Then
						c2\Vv\X = (c2\Vv\X + (OptimisedP*c\Mass*NX))
						c2\Vv\Y = (c2\Vv\Y + (OptimisedP*c\Mass*NY))
					EndIf
				End If
				P3 = After P3	
			Wend
			;draw the particle
			
			If P\X < GraphicsWidth() And P\X > 0 And P\Y < GraphicsHeight() And P\Y > 0 Then
				Color P\C\R,P\C\G,P\C\B
				;WritePixelFast P\X,P\Y,GetRGB(P\C),BackBuffer()
				Oval P\X-P\Radius,P\Y-P\Radius,P\Radius*2,P\Radius*2,1
			EndIf
		EndIf
	Next
	
End Function

Function GetRGB(c.Color)
	Return c\B Or (c\G Shl 8) Or (c\R Shl 16)
End Function

Function GetR(RGB)
    Return RGB Shr 16 And %11111111
End Function

Function GetG(RGB)
	Return RGB Shr 8 And %11111111
End Function

Function GetB(RGB)
	Return RGB And %11111111
End Function

MusicianKool

(Posted 2011) [#8]

This is very good Thank you!