Demo 2D - Metaballs
Publié : jeu. 10/nov./2016 10:32
une demo bien gluante
ATTENTION : enlever le débogueur
Code : Tout sélectionner
; demo 2d metaballs - pf shadoko -2016
EnableExplicit
Procedure.l ColorBlend(c1.l, c2.l, m.f)
Protected r.w,g.w,b.w,a.w
r= Red(c1) + (Red(c2) - Red(c1)) * m
g=Green(c1) + (Green(c2) - Green(c1)) * m
b= Blue(c1) + (Blue(c2) - Blue(c1)) * m
a=Alpha(c1) + (Alpha(c2) - Alpha(c1)) * m
ProcedureReturn RGBA(r,g,b,a)
EndProcedure
Procedure.l HSLToRGB(hue, saturation, lightness, alpha=0)
Protected.f h=hue *6/256
Protected.f s=saturation/255
Protected.f l=lightness/255
Protected.f c,x,r_,v_,b_,m
c=(1-Abs(2*l-1))*s
x=c*(1-Abs(Mod(h, 2) -1))
Select Int(h)
Case 0:r_=c:v_=x
Case 1:r_=x:v_=c
Case 2:v_=c:b_=x
Case 3:v_=x:b_=c
Case 4:r_=x:b_=c
Case 5:r_=c:b_=x
EndSelect
m=l-c/2
Protected r,v,b
r=Int((r_+m)*255)
v=Int((v_+m)*255)
b=Int((b_+m)*255)
ProcedureReturn RGBA(r,v,b,alpha)
EndProcedure
Procedure.l cola(col,a=$ff)
ProcedureReturn col|(a<<24)
EndProcedure
Macro copyimagetosprite(im,sp)
CreateSprite(sp,ImageWidth(im),ImageHeight(im),#PB_Sprite_AlphaBlending)
StartDrawing(SpriteOutput(sp))
DrawingMode(#PB_2DDrawing_AllChannels)
DrawAlphaImage(ImageID(im),0,0)
StopDrawing()
EndMacro
Procedure min(a,b)
If a<b:ProcedureReturn a:Else:ProcedureReturn b:EndIf
EndProcedure
Procedure max(a,b)
If a>b:ProcedureReturn a:Else:ProcedureReturn b:EndIf
EndProcedure
;====================================================================================
Structure sballe
x.f
y.f
dx.f
dy.f
EndStructure
Global nb=15 ; nombre de balle
Global relief ; relief (granulosité)
Global dangle.f ; vitesse rotation lumiere
Global di=400 ; largeur image
Global dj=300 ; hauteur image
Global zoom=2 ; zoom
#delais=60*3 ; delais entre changement couleur/relief (en 60eme de seconde)
#delta=64-1 ; largeur balle (+zone d'influence)
#lim=#delta/2
Global Dim b.sballe(nb)
Global Dim reflet.l(255,255)
Global Dim balle.l(#delta*2+1,#delta*2+1)
Global Dim conv.l(32767)
Global Dim angle.w(2047)
Global Dim couleur.l(2)
Global Dim acouleur.l(2)
Global Dim rnd.f(31)
InitSprite()
InitMouse()
InitKeyboard()
Procedure couleurMAJ(v.f)
Macro lum(x,y,r,nc,a=$ff)
c=colorblend(acouleur(nc),couleur(nc),v)
ResetGradientColors()
GradientColor(0.0,cola(c,a))
GradientColor(0.2,cola(c,a*0.5))
GradientColor(1.0,cola(c,0))
CircularGradient(x,y,r)
Circle(x,y,r)
EndMacro
Static angle.f=1:angle+dangle
Protected i,r,l,x,y,c,agx.f,agy.f
StartDrawing(ImageOutput(0))
DrawingMode(#PB_2DDrawing_AllChannels)
Box(0,0,256,256,0)
DrawingMode(#PB_2DDrawing_Gradient|#PB_2DDrawing_AlphaBlend )
lum(128,128,200,0)
For i=0 To 15
agx=angle*rnd(i+0)
agy=angle*rnd(i+16)
x=128+80*Sin(agx)
y=128+80*Sin(agy)
lum(x,y,40,i % 2+1)
Next
CopyMemory(DrawingBuffer(),@ reflet(0,0),256*256*4)
StopDrawing()
EndProcedure
Procedure initparam()
Protected i,j
Protected.f v,d,x,y
dangle=Random(1)*0.02
relief=Random(2)*6
#taille=10:#dmax=#delta/#taille
For i=0 To #delta*2-1:For j=0 To #delta*2-1
x=(i-#delta)/#taille
y=(j-#delta)/#taille
d=Sqr(1.0+x*x+y*y)
If d<#dmax:v=0.05*Pow(#dmax*#dmax-d*d,3)+Random(relief):Else:v=0:EndIf
balle(i,j)=v
Next:Next
For i=0 To 2:acouleur(i)=couleur(i):couleur(i)=HSLToRGB(Random($ff),$ff,63+128*Bool(i)):Next
For i=0 To ArraySize(conv()):v=200.0*Log(i-1000):If v<0:v=0:EndIf:conv(i)=v:Next
For i=-1024 To 1023:angle(i+1024)=ATan2(1,i/50)*256/#PI+128:Next
EndProcedure
Procedure RenderFrame()
Static cpt:cpt+1:If cpt=#delais:cpt=0:initparam():EndIf
Protected Dim bmp.l(dj-1,di-1)
Protected Dim t.w(di-1,dj-1)
Protected i,j,k,x,y,t00,rx,ry
ExamineKeyboard()
couleurMAJ(cpt/#delais)
For k=0 To nb
With b(k)
\x+\dx:If \x<#lim Or \x>di-#lim:\dx=-\dx:EndIf
\y+\dy:If \y<#lim Or \y>dj-#lim:\dy=-\dy:EndIf
For j=max(\y-#delta,0) To min(dj-1,\y+#delta)
For i=max(\x-#delta,0) To min(di-1,\x+#delta)
x=i-\x+#delta
y=j-\y+#delta
t(i,j)+balle(x,y)
Next
Next
EndWith
Next
For j=0 To dj-1
For i=0 To di-1
t(i,j)=conv(t(i,j))
Next
Next
For j=0 To dj-2
For i=0 To di-2
t00=t(i,j)
If t00
rx=angle(t(i+1,j)-t00+1024)
ry=angle(t(i,j+1)-t00+1024)
bmp(j,i)=reflet(ry,rx)
EndIf
Next
Next
StartDrawing(SpriteOutput(0))
CopyMemory(@bmp(0,0),DrawingBuffer(),di*dj*4)
StopDrawing()
DisplaySprite(10,0,0)
DisplayTransparentSprite(0,0,0)
If KeyboardReleased(#PB_Key_Escape):End:EndIf
EndProcedure
Procedure init()
Protected i,j,x,y,r,c
OpenWindow(0,0,0,di* zoom,dj* zoom,"",#PB_Window_BorderLess|#PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(0),0,0,di,dj,1,0,0)
CreateSprite(0,di,dj,#PB_Sprite_AlphaBlending)
CreateImage(0,256,256,32,#PB_Image_Transparent)
CreateImage(1,di,dj,32,#PB_Image_Transparent)
; image de fond
StartVectorDrawing(ImageVectorOutput(1))
VectorSourceColor(cola(Random($ffffff)))
FillVectorOutput()
For i=0 To di Step 20
For j=0 To dj Step 20
x=i+Random(20)
y=j+Random(20)
r=5+Random(30)
c=Random($ffffff)
VectorSourceCircularGradient(x, y, r)
VectorSourceGradientColor(cola(c,128),0.0)
VectorSourceGradientColor(cola(c,64),0.8)
VectorSourceGradientColor(cola(c,0 ),1.0)
AddPathCircle(x,y,r)
FillPath()
Next
Next
StopVectorDrawing()
copyimagetosprite(1,10)
; position et vitesse initial des balles
For i=0 To nb:b(i)\x=Random(di-#lim*2,#lim):b(i)\y=Random(dj-#lim*2,#lim):b(i)\dx=(Random(1000)-500)/500:b(i)\dy=(Random(1000)-500)/500:Next
; coef mouvement des lumieres
For i=0 To 31:rnd(i)=(Random(2000)-1000)/1000:Next
initparam()
initparam()
Repeat:WindowEvent():RenderFrame():FlipBuffers(): ForEver
EndProcedure
init()
Joli !