Flou Guillossien
Publié : jeu. 14/mai/2020 23:31
mieux que le flou gaussien, le flou Guillossien !! (ou Guillotien)
j'ai pas pu m'empecher de ramener ma fraise
j'ai adapté aux images la fonction de flou que j'utilise pour mes reliefs et textures dans mes démos 3d
je pense que la méthode est analogue au flou rapide de manababel (cf poste "sos flou gaussien")
(elle est aussi rapide quelque soit la largeur du flou)
elle permet en outre
- utilisation 24 ou 32 bit
- le reglage horizontal et vertical
- bouclé ou non (pour les textures)
- nombre de passe variable de 1 à 3
1 passe : parfois pas très propre
2 passes : impeccable
3 passes : pour les snobes (très proche du flou gaussien (mieux à mon avis))
j'ai pas pu m'empecher de ramener ma fraise
j'ai adapté aux images la fonction de flou que j'utilise pour mes reliefs et textures dans mes démos 3d
je pense que la méthode est analogue au flou rapide de manababel (cf poste "sos flou gaussien")
(elle est aussi rapide quelque soit la largeur du flou)
elle permet en outre
- utilisation 24 ou 32 bit
- le reglage horizontal et vertical
- bouclé ou non (pour les textures)
- nombre de passe variable de 1 à 3
1 passe : parfois pas très propre
2 passes : impeccable
3 passes : pour les snobes (très proche du flou gaussien (mieux à mon avis))
Code : Tout sélectionner
Procedure ImageBlur(Image,ImageSource,di.w, dj.w,pass=1,loop=0)
If di=0 And dj=0:ProcedureReturn:EndIf
Protected i,ii,j,k,d,dii,djj,dx,dy,dij,_dij.f,tx.l, o,p,n
dx = ImageWidth(ImageSource)-1 :If di>dx:di=dx:EndIf
dy = ImageHeight(ImageSource)-1:If dj>dy:dj=dy:EndIf
p= ImageDepth(ImageSource)/8
Dim s.a(dy,(dx+1)*p-1)
Dim d.a(dy,(dx+1)*p-1)
StartDrawing(ImageOutput(ImageSource)):CopyMemory(DrawingBuffer(),@s(0,0),(dx+1)*(dy+1)*p):StopDrawing()
dii=di+1
djj=dj+1
dij = dii * djj:_dij=1/dij
If loop
d=dx-dii/2:Dim lx(dx + 2*dii): For i = 0 To dx + 2*dii: lx(i) = (i+d) % (dx+1): Next
d=dy-djj/2:Dim ly(dy + 2*djj): For i = 0 To dy + 2*djj: ly(i) = (i+d) % (dy+1): Next
Else
Dim lx(dx + 2*dii): For i = 0 To dx + 2*dii:ii=i-1-dii/2:If ii<0:ii=0:ElseIf ii>dx:ii=dx:EndIf: lx(i) = ii: Next
Dim ly(dy + 2*djj): For i = 0 To dy + 2*djj:ii=i-1-djj/2:If ii<0:ii=0:ElseIf ii>dy:ii=dy:EndIf: ly(i) = ii: Next
EndIf
For k=1 To pass
For o=0 To p-1
Dim ty.l(dx)
For j = 0 To djj - 1:ii=o: For i = 0 To dx: ty(i) + s(ly(j),ii):ii+p: Next: Next
For j = 0 To dy
ii=o:For i = 0 To dx: ty(i) + s(ly(djj+j),ii) - s(ly(j),ii):ii+p: Next
tx=0:For i = 0 To dii-1: tx+ty(lx(i)): Next
ii=o:For i = 0 To dx: tx + ty(lx(dii+i)) - ty(lx(i) ): d(j,ii) = tx *_dij:ii+p: Next
Next
Next
CopyArray(d(),s())
Next
n=CreateImage(Image,dx+1,dy+1,p*8):If Image=-1:Image=n:EndIf
StartDrawing(ImageOutput(Image)):CopyMemory(@d(0,0),DrawingBuffer(),(dx+1)*(dy+1)*p):StopDrawing()
ProcedureReturn Image
EndProcedure
OpenWindow(0, 0, 0, 1024, 720, "flou", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
CreateImage(0,1024,700)
LoadFont(0,"Arial",100,#PB_Font_Bold)
StartDrawing(ImageOutput(0))
DrawingFont(FontID(0))
For i=0 To 20:DrawRotatedText(Random(OutputWidth()),Random(OutputHeight()),"FLOU",Random(360),Random($ffffff)):Next
StopDrawing()
n=ImageBlur(#PB_Any,0,20,20,2,0)
StartDrawing(WindowOutput(0))
DrawImage(ImageID(n),0,0)
StopDrawing()
Repeat:Until WaitWindowEvent()= #PB_Event_CloseWindow
