Ah yes, forgot to mention that if some of the GLFW commands are giving trouble, simply comment them out.
I don't mind having a look at your code, if you'll post it here.
Cheers,
Mike
particle based interactive fluid
-
podvornyak
- Posts: 148
- Joined: Nov 12, 2007 11:46
- Location: Russia
k, here is what I have so far.
The only bit of tech that is different in this demo compared to my other random projects is the fluid kernal function.
So I guess my question is what is a laplacian used for? What about the gradient functions I read about everywhere? Are they related to other features such as viscosity and surface tension?
The only bit of tech that is different in this demo compared to my other random projects is the fluid kernal function.
So I guess my question is what is a laplacian used for? What about the gradient functions I read about everywhere? Are they related to other features such as viscosity and surface tension?
Code: Select all
'Voltage 2011 - voltage@defame.com.au
#Define MAXPARTICLES 960
' Examples
' SL 35 SC 1000000
' SL 20 SC 320000
' SL 15 SC 60000
' SL 10 SC 10000
#Define SMOOTHINGLENGTH 30
#Define SCALE 700000
#Define DAMPENINGFACTOR 0.98
#Define MAXVELOCITY 40
Type vec3
x As Double
y As Double
z As Double
End Type
Type particle
position As vec3
vel As vec3
locked As Integer
dead As Integer
End Type
Declare Function FluidKernel(r As Double, h As double) As Double
Declare Sub setupParticles
Declare Sub drawParticles
Declare Sub moveParticles
Declare Function dist(j As Integer, i As Integer) As Double
Dim As Double x,y
Dim Shared As particle particles(MAXPARTICLES-1)
Dim Shared As vec3 gravity => (0,0.3,0)
Dim Shared As Integer dead=0, shakeup=0
Dim As String deadstr, ink
setupParticles
ScreenRes 1200,900,32
Do
moveParticles
ScreenLock
Cls
drawParticles
Locate 1,1
If shakeup Then
Print "Shake up is ON - Press <space> to turn it OFF"
Else
Print "Shake up is OFF - Press <space> to turn it ON"
EndIf
ink = InKey
If ink=" " Then
shakeup = Not(shakeup)
EndIf
ScreenUnLock
Loop Until ink=Chr(27)
Function FluidKernel(r As Double, h As double) As Double
Dim As Double rDh = r/h
Dim As Double den, num
If rDh<1 And rDh>=0 Then
den = 3.141592654*(h*h*h)
num = 1.0 - 1.5*(rDh*rDh) + 0.75*(rDh*rDh*rDh)
Return num/den
Else
If rDh<2 Then
den = 3.141592654*(h*h*h)
rDh=2.0 - rDh
num = 0.25*(rDh*rDh*rDh)
Return num/den
Else
Return 0.0
EndIf
EndIf
End Function
Sub setupParticles
Dim As Integer i
For i=0 To MAXPARTICLES-1
particles(i).position.x = Sin(i*0.5)*550+600
particles(i).position.y = 800 - (i-170)*SMOOTHINGLENGTH*0.4
particles(i).position.z = 0
particles(i).vel.x = 0
particles(i).vel.y = 0
particles(i).vel.z = 0
particles(i).locked = 0
particles(i).dead = 0
Next
End Sub
Sub drawParticles
Dim As Integer i,r,g,b
For i=0 To MAXPARTICLES-1
r = Abs(particles(i).vel.x*12)
g = Abs(particles(i).vel.y*12)
b = particles(i).position.y * 0.2
Circle(particles(i).position.x, particles(i).position.y), 15, RGB(r,g,b),,,,f
Next
End Sub
Sub moveParticles
Dim As Integer i, j
Dim As Double spring, vx, vy, vz, d
For i=0 To MAXPARTICLES-1
If particles(i).locked=0 Then
If particles(i).vel.y<MAXVELOCITY Then
particles(i).vel.y += gravity.y
End if
particles(i).position.x += particles(i).vel.x
particles(i).position.y += particles(i).vel.y
particles(i).position.z += particles(i).vel.z
If particles(i).position.y>900 Then
particles(i).position.y -= particles(i).vel.y
If shakeup Then
particles(i).vel.y *= (-0.5+Rnd*2.2)
EndIf
EndIf
If particles(i).position.x>1200 Or particles(i).position.x<0 Then
particles(i).position.x -= particles(i).vel.x
If shakeup Then
particles(i).vel.x *= (-0.5+Rnd*2.2)
EndIf
EndIf
particles(i).vel.x *= DAMPENINGFACTOR
particles(i).vel.y *= DAMPENINGFACTOR
particles(i).vel.z *= DAMPENINGFACTOR
EndIf
Next
'Now check smoothing length
For i=0 To MAXPARTICLES-1
For j=i+1 To MAXPARTICLES-1
d = dist(j,i)
If d<=SMOOTHINGLENGTH*2.0 Then
spring = FluidKernel(d ,SMOOTHINGLENGTH) * SCALE
vx = -(particles(j).position.x - particles(i).position.x)/d
vy = -(particles(j).position.y - particles(i).position.y)/d
'vz = -(particles(j).position.z - particles(i).position.z)/d
particles(i).vel.x += spring * vx
particles(j).vel.x -= spring * vx
particles(i).vel.y += spring * vy
particles(j).vel.y -= spring * vy
'particles(i).vel.z += spring * vz
'particles(j).vel.z -= spring * vz
EndIf
Next
Next
End Sub
Function dist(j As Integer, i As Integer) As Double
Dim As Double x,y,z
x = (particles(j).position.x - particles(i).position.x)
'If x>SMOOTHINGLENGTH*2.0 Then Return SMOOTHINGLENGTH*2.0
y = (particles(j).position.y - particles(i).position.y)
z = (particles(j).position.z - particles(i).position.z)
Return Sqr(x*x+y*y+z*z)
End Function
Hi voltage,
What article(s) or documentation is your code based on?
As for gradient functions, also called kernels, they're used both for calculating density, pressure, and viscosity. You can use the same kernel for all three, or you can define different ones for each task. There are many, many different ways to make them, and you are free to invent your own. There's no such thing as a single optimal combination of kernels and coefficients, it all depends on how you want your fluid to behave. Simply just experiment until you're satisfied!
Cheers,
Mike
What article(s) or documentation is your code based on?
As for gradient functions, also called kernels, they're used both for calculating density, pressure, and viscosity. You can use the same kernel for all three, or you can define different ones for each task. There are many, many different ways to make them, and you are free to invent your own. There's no such thing as a single optimal combination of kernels and coefficients, it all depends on how you want your fluid to behave. Simply just experiment until you're satisfied!
Cheers,
Mike
Hi h4tt3n
Very nice, I got it running with the adjustment after the call to GLFW.bi
I did a thing a while back, and splashed a little colour into it.
I tested with -exx -- OK, but better with -exx NOT on to improve the speed.
It performes Pseudo collisions, only a bit of fun!
Cheers
Very nice, I got it running with the adjustment after the call to GLFW.bi
I did a thing a while back, and splashed a little colour into it.
I tested with -exx -- OK, but better with -exx NOT on to improve the speed.
It performes Pseudo collisions, only a bit of fun!
Cheers
Code: Select all
'BUBBLY
#include "fbgfx.bi"
Type vector3d
As Single x,y,z
End Type
Type line3d
As vector3d v1,v2
End Type
Type bar
As Integer x,y,l,d,percent
As Uinteger col
End Type
Dim shared As Integer percentage
#define progress(value,lower,upper) 100*(value-lower)/(upper-lower)
#define vct type<vector3d>
#define ln type<line3d>
#define distance(cx,cy,px,py) sqr( (cx-px)*(cx-px)+(cy-py)*(cy-py))
Operator + (v1 As vector3d,v2 As vector3d) As vector3d
Return Type<vector3d>(v1.x+v2.x,v1.y+v2.y,v1.z+v2.z)
End Operator
Operator -(v1 As vector3d,v2 As vector3d) As vector3d
Return Type<vector3d>(v1.x-v2.x,v1.y-v2.y,v1.z-v2.z)
End Operator
Operator * Overload (f As Single,v1 As vector3d) As vector3d
Return Type<vector3d>(f*v1.x,f*v1.y,f*v1.z)
End Operator
Operator * Overload (v1 As vector3d,f As Single) As vector3d
Return Type<vector3d>(f*v1.x,f*v1.y,f*v1.z)
End Operator
Sub progressbar(b As bar)
Line(b.x+1,b.y+1)-( (b.l*b.percent/100+b.x),b.y+b.d-1),b.col,bf
Line(b.x,b.y)-(b.x+b.l,b.y+b.d),,b
End Sub
Dim shared As bar br
br=Type<bar>(100,300,600,20,0,Rgb(0,0,200))
declare Sub drawpolygon(p() As vector3d,col() As Uinteger,pnt As String="paint",im As Any Pointer=0)
declare Function inpolygon(p1() As vector3d,p2 As vector3d) As Integer
Declare Function length(v As vector3d) As Single
Declare Function normalize(v As vector3d) As vector3d
Declare Function rr(first As Single, last As Single) As Single
Declare Sub drawline(l As line3d,col As Uinteger)
Declare Function drop_perpendicular(p As vector3d,L2 As line3d) As vector3d
Declare Sub balls(n As Integer,rad As Single)
Declare Sub setlines
declare Sub back(n as integer)
Declare Function segmentdistance(L() As line3d,p As vector3d,Byref p2 As vector3d=vct(0,0,0)) As Single
Dim Shared As Single gravity =.1
Dim Shared As Integer xres,yres
Dim shared As Integer mx,my
Screen 20,32,1,fb.GFX_ALPHA_PRIMITIVES 'or fb.GFX_NO_FRAME
Screeninfo xres,yres
Dim Shared As vector3d vl1,vl2
Dim Shared As line3d lineseg(9)
dim shared as vector3d poly(9,1)
#macro incircle(cx,cy,radius,x,y)
(cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius
#endmacro
Function isleft(L As line3d,p As vector3d) As Double
Return -Sgn( (L.v1.x-L.v2.x)*(p.y-L.v2.y) - (p.x-L.v2.x)*(L.v1.y-L.v2.y))
End Function
Const As Integer numballs=400
Dim As Single radius=9'Sqr(xres*yres/(10*numballs*3.142))'9
Dim As fb.event e
dim shared as any pointer im
im=imagecreate(xres,yres,rgb(100,100,255))
setlines
back(1):back(2)
dim as uinteger cc(3)
cc(1)=255:cc(2)=00:cc(3)=200
poly(0,0).z=0
drawpolygon(poly(),cc(),"nopaint",im)
Do
Screenlock
Cls
put(0,0),im,pset
If (ScreenEvent(@e)) Then
If e.type=13 Then imagedestroy im:End
If e.type=fb.EVENT_MOUSE_BUTTON_PRESS Then
if incircle(.2*xres,.8*yres,.05*yres,mx,my) then
imagedestroy im
end
end if
end if
End If
balls(numballs,radius)
Screenunlock
Sleep 1,1
Loop until inkey=chr(27)
Sleep
imagedestroy im:end
Sub setlines
dim as single rx=xres/2,ry=yres/1.5
'set up line segments
vl1=vct(rx-.2*xres,ry-.3*yres,0):vl2=vct(rx,ry,0)
poly(1,0)=vl1:poly(2,0)=vl2'ok
lineseg(1)=ln(vl1,vl2)
vl1=vct(rx+.2*xres,ry-.3*yres,0):vl2=vct(rx,ry,0)
poly(3,0)=vl1
lineseg(2)=ln(vl1,vl2)
vl1=vct(rx+.01*yres,ry+.01*yres,0):vl2=vct(rx+.01*xres,ry+.2*yres,0)
poly(5,0)=vl2
lineseg(3)=ln(vl1,vl2)
vl1=vct(rx-.01*yres,ry+.01*yres,0):vl2=vct(rx-.01*xres,ry+.2*yres,0)
poly(9,0)=vl1':poly(8,0)=vl2
lineseg(4)=ln(vl1,vl2)
vl1=vct(rx+.01*yres,ry+.01*yres,0):vl2=vct(rx+.2*xres,ry-.3*yres,0)
poly(4,0)=vl1':poly(10,0)=vl2
lineseg(5)=ln(vl1,vl2)
vl1=vct(rx-.01*yres,ry+.01*yres,0):vl2=vct(rx-.2*xres,ry-.3*yres,0)
'poly(11,0)=vl1:poly(12,0)=vl2
lineseg(6)=ln(vl1,vl2)
vl1=vct(rx+.01*xres,ry+.2*yres,0):vl2=vct(rx+.1*xres,ry+.249*yres,0)
poly(6,0)=vl2':poly(14,0)=vl2
lineseg(7)=ln(vl1,vl2)
vl1=vct(rx-.01*xres,ry+.2*yres,0):vl2=vct(rx-.1*xres,ry+.25*yres,0)
poly(8,0)=vl1':poly(16,0)=vl2
lineseg(8)=ln(vl1,vl2)
vl1=vct(rx-.1*xres,ry+.25*yres,0):vl2=vct(rx+.1*xres,ry+.249*yres,0)
poly(7,0)=vl1':poly(0,2)=vl2
lineseg(9)=ln(vl1,vl2)
dim as uinteger cc(3)
End Sub
Function segmentdistance(L() As line3d,p As vector3d,Byref p2 As vector3d=vct(0,0,0)) As Single
Dim As vector3d near,far,pp
Dim n As Integer=L(0).v1.z
If length(p-L(n).v1) > length(p-L(n).v2) Then
far=L(n).v1
near=L(n).v2
Else
far=L(n).v2
near=L(n).v1
End If
pp=drop_perpendicular(p,L(n))
If length(far-pp)<length(L(n).v1-L(n).v2) Then
p2=pp
Return length(p-pp)
Else
p2=near
Return length(p-near)
End If
End Function
Function length(v As vector3d) As Single
Return Sqr(v.x*v.x+v.y*v.y+v.z*v.z)
End Function
Function normalize(v As vector3d) As vector3d
Dim n As Single=length(v)
If n<>0 Then
Return Type<vector3d>(v.x/n,v.y/n,v.z/n)
End If
End Function
Function rr(first As Single, last As Single) As Single
Function = Rnd * (last - first) + first
End Function
Sub drawline(l As line3d,col As Uinteger)
Line im,(l.v1.x,l.v1.y)-(l.v2.x,l.v2.y),col
End Sub
Function drop_perpendicular(p As vector3d,L2 As line3d) As vector3d
Dim As Double M1,M2,C1,C2
Dim As vector3d pt
M2=(L2.v2.y-L2.v1.y)/(L2.v2.x-L2.v1.x)
M1=-1/M2
C1=p.y-M1*p.x
C2=(L2.v1.y*L2.v2.x-L2.v1.x*L2.v2.y)/(L2.v2.x-L2.v1.x)
pt.x=(C2-C1)/(M1-M2)
pt.y=(M1*C2-M2*C1)/(M1-M2)
Return pt
End Function
Sub balls(n As Integer,rad As Single)
Static runflag As Byte
Static As vector3d b()
Redim Preserve b(1 To n)
Static As vector3d u()
Redim Preserve u(1 To n)
Static As Uinteger col()
Redim Preserve col(1 To n)
Static As Single sp()
Redim Preserve sp(1 To n)
Static As Single k()
Redim Preserve k(1 To n)
Static As vector3d startpos()
Redim Preserve startpos(1 To n)
Static As Single _rad()
Redim Preserve _rad(1 To n)
Dim As vector3d impact
If runflag=0 Then
For x As Integer=1 To n
b(x)=vct(.299*xres,.3*yres,0):u(x)=vct(0,1,0)
_rad(x)=rad+rr(-.1*rad,.2*rad)
sp(x)=1
k(x)=0
Next x
runflag=1
End If
Dim As vector3d impulse,mouse
#macro sides()
'the segments
For z2 As Integer=1 To n
For z3 As Integer=1 To 8
lineseg(0).v1.z=z3
If segmentdistance(lineseg(z3),b(z2),impact)<_rad(z2) Then
impulse=normalize(b(z2)-impact)
u(z2)=u(z2)+impulse*(2)
sp(z2)=length(u(z2))
u(z2)=normalize(u(z2))
k(z2)=0
startpos(z2)=b(z2)
End If
Next z3
'the sides
If b(z2).y>yres Then
k(z2)=0
startpos(z2).x=xres/2'.6
startpos(z2).y=-_rad(z2)*10
End If
dim as uinteger cc=255*2*segmentdistance(lineseg(3),b(z2))/yres
if cc<0 then cc=0
if cc>255 then cc=255
col(z2)=rgba(cc,0,200,200)
If b(z2).x<_rad(z2) Then
u(z2)=u(z2)+vct(1,0,0)
sp(z2)=length(u(z2))
u(z2)=normalize(u(z2))
k(z2)=0
startpos(z2)=b(z2)
End If
If b(z2).x>xres-_rad(z2) Then
u(z2)=u(z2)+vct(-1,0,0)
sp(z2)=length(u(z2))
u(z2)=normalize(u(z2))
k(z2)=0
startpos(z2)=b(z2)
End If
If b(z2).y<_rad(z2) Then
u(z2)=u(z2)+vct(0,1,0)
sp(z2)=length(u(z2))
u(z2)=normalize(u(z2))
k(z2)=0
startpos(z2)=b(z2)
End If
Getmouse(mx,my)
mouse=vct(.2*xres,.8*yres,0)
Circle(mouse.x,mouse.y),.05*yres,Rgb(250,00,200),,,,f
draw string(mouse.x-.02*xres,mouse.y),"CHEERS"
If length(b(z2)-mouse)<_rad(z2)+.05*yres Then
impulse=normalize(b(z2)-mouse)
u(z2)=u(z2)+impulse
sp(z2)=length(u(z2))
u(z2)=normalize(u(z2))
k(z2)=0
startpos(z2)=b(z2)
End If
Next z2
#endmacro
#macro ball_to_ball()
For xx As Integer=1 To n
For yy As Integer=1 To n
If xx<>yy Then
If length(b(xx)-b(yy))<=_rad(xx)+_rad(yy) Then
impulse=normalize(b(xx)-b(yy))
u(xx)=u(xx)+impulse*(1*(_rad(yy))^2/((_rad(xx))^2+(_rad(yy))^2))
u(yy)=u(yy)-impulse*(1*(_rad(xx))^2/((_rad(xx))^2+(_rad(yy))^2))
sp(xx)=length(u(xx))
sp(yy)=length(u(yy))
u(xx)= normalize(u(xx)):u(yy)=normalize(u(yy))
k(xx)=0:k(yy)=0:startpos(xx)=b(xx):startpos(yy)=b(yy)
End If
End If
Next yy
Next xx
#endmacro
dim As vector3d c
static as single copyc
sides()
ball_to_ball()
For z As Integer=1 To n
k(z)=k(z)+1
b(z)=startpos(z)+k(z)*sp(z)*u(z)+sp(z)*vct(0,gravity*k(z)*k(z),0)
if b(z).y>copyc then
Circle(b(z).x,b(z).y),_rad(z),col(z),,,,f
else
Circle(b(z).x,b(z).y),_rad(z),col(z),,,,f
end if
c.x=c.x+b(z).x:c.y=c.y+b(z).y
Next z
c.x=c.x/n:c.y=c.y/n
copyc=c.y
End Sub
Function inpolygon(p1() As vector3d,p2 As vector3d) As Integer
Dim As Single n1=p1(0,0).z
Dim As Integer index,nextindex
Dim k As Integer=Ubound(p1)+1
Dim send As line3d
Dim wn As Integer=0
For n As Integer=1 To Ubound(p1)
index=n Mod k:nextindex=(n+1) Mod k
If nextindex=0 Then nextindex=1
send.v1.x=p1(index,n1).x:send.v2.x=p1(nextindex,n1).x
send.v1.y=p1(index,n1).y:send.v2.y=p1(nextindex,n1).y
If p1(index,n1).y<=p2.y Then
If p1(nextindex,n1).y>p2.y Then
If isleft(send,p2)>0 Then
wn=wn+1
End If
End If
Else
If p1(nextindex,n1).y<=p2.y Then
If isleft(send,p2)<0 Then
wn=wn-1
End If
End If
End If
Next n
Return wn
End Function
Sub drawpolygon(p() As vector3d,col() As Uinteger,pnt As String="paint",im As Any Pointer=0)
Dim As Single n1= p(0,0).z
Dim k As Integer=Ubound(p)+1
Dim As Integer index,nextindex
Dim As Double xc,yc
For n As Integer=1 To Ubound(p)'+1
xc=xc+p(n,n1).x:yc=yc+p(n,n1).y
index=n Mod k:nextindex=(n+1) Mod k
If nextindex=0 Then nextindex=1
Line im,(p(index,n1).x,p(index,n1).y)-(p(nextindex,n1).x,p(nextindex,n1).y),Rgb(col(1),col(2),col(3))
Next
xc=xc/Ubound(p):yc=yc/Ubound(p)
If pnt="paint" Then Paint (xc,yc),Rgb(col(1),col(2),col(3)),Rgb(col(1),col(2),col(3))
End Sub
Type bow
As Integer min,max,z
As Single br,bg,bb,ba
as single xp,yp
End Type
Dim shared As bow r1
Function rainbow(p As bow,part as string="outer") As Uinteger
#define Red(c) (CUInt(c) Shr 16 And 255 )
#define green(c) (CUInt(c) Shr 8 And 255 )
#define blue(c) (CUInt(c) And 255 )
#define alpha(c) (CUInt(c) Shr 24 )
Dim As Uinteger r,g,b,col
Dim As Double gap=(p.max-p.min)/6
if part="outer" then
If p.z>=p.min-2*gap And p.z<p.min Then
col=point(p.xp,p.yp,im)
p.br=red(col)
p.bg=green(col)
p.bb=blue(col)
r=(255-p.br)*(p.z-p.min+2*gap)/(2*gap)+p.br
g=-p.bg*(p.z-p.min+2*gap)/(2*gap)+p.bg
b=-p.bb*(p.z-p.min+2*gap)/(2*gap)+p.bb
Return Rgba(r,g,b,p.ba)
End If
If p.z>=p.min And p.z<p.min+gap Then 'red to orange
r=255 ' r none
g=165*(p.z-p.min)/(gap)'0 0 g 165
b=0 'b none
Return Rgba(r,g,b,p.ba)
End If
If p.z>=p.min+gap And p.z<p.min+2*gap Then 'orange to yellow
r=255 'r none
g=90*(p.z-p.min-gap)/gap+165'165 165 g 255
b=0 'b none
Return Rgba(r,g,b,p.ba)
End If
If p.z>=p.min+2*gap And p.z<p.min+3*gap Then 'yellow to green
r=-255*(p.z-p.min-2*gap)/gap+255'255 255 r 0
g=-127*(p.z-p.min-2*gap)/gap+255'255 255 g 128
b=0
Return Rgba(r,g,b,p.ba)
End If
If p.z>=p.min+3*gap And p.z<p.min+4*gap Then 'green to blue
r=0 'r none
g=-128*(p.z-p.min-3*gap)/gap +128'128 '128 g 0
b=255*(p.z-p.min-3*gap)/gap'0 '0 b 255
Return Rgba(r,g,b,p.ba)
End If
If p.z>=p.min+4*gap And p.z<p.min+5*gap Then'blue to indigo
r=75*(p.z-p.min-4*gap)/gap'0 '0 r 75
g=0 '0 g 0
b=-125*(p.z-p.min-4*gap)/gap+255'255 '255 b 130
Return Rgba(r,g,b,p.ba)
End If
If p.z>=p.min+5*gap And p.z<p.min+6*gap Then'indigo to violet
r=163*(p.z-p.min-5*gap)/gap+75'75 ' 75 r 238
g=130*(p.z-p.min-5*gap)/gap'0 '0 g 130
b=108*(p.z-p.min-5*gap)/gap+130'130 '130 b 238
Return Rgba(r,g,b,p.ba)
End If
If p.z>=p.min+6*gap And p.z<p.min+8*gap Then
col=point(p.xp,p.yp,im)
p.br=red(col)
p.bg=green(col)
p.bb=blue(col)
r=(p.br-238)*(p.z-p.min-6*gap)/(2*gap)+238
g=(p.bg-130)*(p.z-p.min-6*gap)/(2*gap)+130
b=(p.bb-238)*(p.z-p.min-6*gap)/(2*gap)+238
Return Rgba(r,g,b,p.ba)
End If
end if
'____________________________________________________
if part="inner" then
If p.z>=p.min-2*gap And p.z<p.min Then
col=point(p.xp,p.yp,im)
p.br=red(col)
p.bg=green(col)
p.bb=blue(col)
r=(238-p.br)*(p.z-p.min+2*gap)/(2*gap)+p.br
g=(130-p.bg)*(p.z-p.min+2*gap)/(2*gap)+p.bg
b=(238-p.bb)*(p.z-p.min+2*gap)/(2*gap)+p.bb'238
Return Rgba(r,g,b,p.ba)
End If
If p.z>=p.min And p.z<p.min+gap Then 'violet to indigo
r=(75-238)*(p.z-p.min)/gap+238 ' 238 r 75
g=-130*(p.z-p.min)/(gap)+130 '0 130 g 0
b=(130-238)*(p.z-p.min)/gap+238 '238 b 130
Return Rgba(r,g,b,p.ba)
End If
If p.z>=p.min+gap And p.z<p.min+2*gap Then 'indigo to blue'''
r=(0-75)*(p.z-p.min-gap)/gap+75 '75 r 0
g=0'90*(p.z-p.min-gap)/gap+165'165 0 g 0
b= (255-130)*(p.z-p.min-gap)/gap+130 '130 b 255
Return Rgba(r,g,b,p.ba)
End If
If p.z>=p.min+2*gap And p.z<p.min+3*gap Then 'blue to green
r=0 ' 0 r 0
g=128*(p.z-p.min-2*gap)/gap ' 0 g 128
b=-255*(p.z-p.min-2*gap)/gap+255 '255 b 0
Return Rgba(r,g,b,p.ba)
End If
If p.z>=p.min+3*gap And p.z<p.min+4*gap Then 'green to yellow
r=255*(p.z-p.min-3*gap)/gap '0 r 255
g=(255-128)*(p.z-p.min-3*gap)/gap +128 '128 g 255
b=0 '0 b 0
Return Rgba(r,g,b,p.ba)
End If
If p.z>=p.min+4*gap And p.z<p.min+5*gap Then'yellow to orange
r=255 '255 r 255
g=(165-255)* (p.z-p.min-4*gap)/gap +255 '255 g 165 '255 g 165
b=0 '0 b 0
Return Rgba(r,g,b,p.ba)
End If
If p.z>=p.min+5*gap And p.z<p.min+6*gap Then'orange to red
r=255 ' 255 r 255
g= -165* (p.z-p.min-5*gap)/gap +165 '165 g 0
b=0 '0 b 0
Return Rgba(r,g,b,p.ba)
End If
If p.z>=p.min+6*gap And p.z<p.min+8*gap Then
col=point(p.xp,p.yp,im)
p.br=red(col)
p.bg=green(col)
p.bb=blue(col)
r=(p.br-255)*(p.z-p.min-6*gap)/(2*gap)+255'p.br
g=p.bg*(p.z-p.min-6*gap)/(2*gap)'+p.bg
b=p.bb*(p.z-p.min-6*gap)/(2*gap)'+p.bb
Return Rgba(r,g,b,p.ba)
End If
end if
End Function
Sub back(n as integer)
static as integer count
locate 10,10
print "Please Wait ... loading"
dim as vector3d pp
Dim As Double Xpi=100*Atn(1)
#define rads *Xpi/180
Dim As Integer x,y,z
Dim As Single cx,cy
cx=xres/2:cy=yres/2
For x=0 To xres
count=count+1
For y=0 To yres
pp.x=x:pp.y=y
if n=1 then z=100*(Sin(x rads)*Cos(y rads))^.1
if n=2 then z=10*(Sin(y rads)*Cos(x rads))
if n=1 then
If inpolygon(poly(),pp)=0 then
pset im,(x,y),rgba(z,x or y,200-z,100)
Pset im,(x,y),Rgba(100,100-z,200,200)
End If
end if
if n=2 then
If inpolygon(poly(),pp) then
Pset im,(x,y),Rgba(200,100-2*z,255,200)
End If
end if
r1.xp=x:r1.yp=y
r1.z=distance(cx,.6*yres,x,y)
r1.min=400
r1.max=450
r1.ba=100
Pset im,(x,y),rainbow(r1,"outer")
r1.min=300
r1.max=330
r1.ba=150
Pset im,(x,y),rainbow(r1,"inner")
Next y
percentage=progress(count,0,2*xres)
br.percent=percentage
progressbar(br)
Next x
End Sub
Re: particle based interactive fluid
Dear All, physics and FB lovers.
I am working occasionnally with someone who does personnal researchs about physics, and demonstrates most of his ideas using simulators written in Free Basic.
For instance he has built up a wave simulator (like the ones we have all seen in some video games), then in this "medium", he makes interferences happen by placing severall vibrating sources. Then he shows that what happens at some points has exactly the properties that physicists attribute to electrons, light, etc.
In other terms he has demonstrated that the matter that constitutes our universe could be made of waves only.
http://glafreniere.com/matter.htm
Yours,
Anselme
I am working occasionnally with someone who does personnal researchs about physics, and demonstrates most of his ideas using simulators written in Free Basic.
For instance he has built up a wave simulator (like the ones we have all seen in some video games), then in this "medium", he makes interferences happen by placing severall vibrating sources. Then he shows that what happens at some points has exactly the properties that physicists attribute to electrons, light, etc.
In other terms he has demonstrated that the matter that constitutes our universe could be made of waves only.
http://glafreniere.com/matter.htm
Yours,
Anselme
-
D.J.Peters
- Posts: 8631
- Joined: May 28, 2005 3:28
- Contact:
Re: particle based interactive fluid
@parakeet thank you for sharing.
really usefull
Joshy
really usefull
Joshy