ein Auqa-Filter gesucht!

Übersicht

BlitzBasic

Allgemein

	INpac Betreff: ein Auqa-Filter gesucht!	Fr, Apr 30, 2004 17:39 Antworten mit Zitat
Hiho. Ich suche einen schicken aber noch akzeptabel schnellen Aquafilter. Markus' Filter sieht zwar schön aus, und läuft auch gut, allerdings simuliert dieser nur Wasseringe. Ich hingegen brächte einen Texture-Filter, der die Quelltexture in Realtime verzerrt und dem Glas- oder Ozeanwellen-Filter aus PS ähnelt. Da dieser Filter abhängig der eingestellten Optionen eingesetzt werden wird, ist es nicht schlimm, wenn er ein wenig Speed frisst. Kennt jemand einen schönen Code?

INpac

Betreff: ein Auqa-Filter gesucht!

Fr, Apr 30, 2004 17:39
Antworten mit Zitat

Hiho.

Ich suche einen schicken aber noch akzeptabel schnellen Aquafilter.

Markus' Filter sieht zwar schön aus, und läuft auch gut, allerdings simuliert dieser nur Wasseringe.

Ich hingegen brächte einen Texture-Filter, der die Quelltexture in Realtime verzerrt und dem Glas- oder Ozeanwellen-Filter aus PS ähnelt.

Da dieser Filter abhängig der eingestellten Optionen eingesetzt werden wird, ist es nicht schlimm, wenn er ein wenig Speed frisst.

Kennt jemand einen schönen Code?

	Markus2	So, Mai 02, 2004 19:19 Antworten mit Zitat
Wellen sind einfacher als diese Ringe weil du die ganze map nur mit Sin Cos überlagern brauchst und die Pixel nur an ner anderen Stelle angezeigt werden je nach Sin Cos Wert . Dafür würde ich mir aber evtl. animierte Texturen wie in UT machen . Für Glas müßstest du eine Map nehmen wo der Brechungswert drinne steht . Zusammen mit dem Fresnel Wert kann man dann die Texture noch abdunkeln je nach Winkel wie das Licht auf die Texture fällt .

Markus2

So, Mai 02, 2004 19:19
Antworten mit Zitat

Wellen sind einfacher als diese Ringe weil du die ganze map
nur mit Sin Cos überlagern brauchst und die Pixel nur an ner anderen
Stelle angezeigt werden je nach Sin Cos Wert .
Dafür würde ich mir aber evtl. animierte Texturen wie in UT machen .
Für Glas müßstest du eine Map nehmen wo der Brechungswert drinne
steht . Zusammen mit dem Fresnel Wert kann man dann die Texture
noch abdunkeln je nach Winkel wie das Licht auf die Texture fällt .

	Markus2	So, Mai 02, 2004 21:25 Antworten mit Zitat
Vieleicht kannste damit was anfangen . Code: [AUSKLAPPEN] [EINKLAPPEN] ; Wellen Effect ; If DebugMode = True Then it is very slow ! .Top Graphics 640,480,16,2 SetBuffer BackBuffer() ;------------------------------------------------------------------------- Texture .Texture ;a Texture size 128 x 128 is very fast Global WaveImage=LoadImage("Texture1.jpg") ;<--- ;WaveImage=TestImage() ;------------------------------------------------------------------------- WaterSettings .WaterSettings Global WATERSIZEX=ImageWidth (WaveImage) ;like 128 or 256 Global WATERSIZEY=ImageHeight(WaveImage) ;like 128 or 256 .WaterBuffers Dim WaveBuffer0#(WATERSIZEX,WATERSIZEY) ;<- da kommt die Texture rein Dim WaveBufferD#(WATERSIZEX,WATERSIZEY) ;zwischen puffer damit man das ganze Array bewegen kann Dim WaveBufferX#(WATERSIZEX,WATERSIZEY) ;Wellen Array Dim WaveBufferY#(WATERSIZEX,WATERSIZEY) MemoryTexture MakeWave ;------------------------------------------------------------------------- MainLoop .MainLoop While Not KeyHit(1) ; 1=Escape Local ti# ti=MilliSecs() ShowWater TileWater ProcessWater While Abs(MilliSecs()-ti)<10 Wend Flip Wend End ;------------------------------------------------------------------------- .RenderTexture Function ShowWater() Local x1,y1 Local x2,y2 Local xoff,yoff Local xm,ym Local pix,pix2 Local r,g,b,a Local bu xm=GraphicsWidth() /2-WATERSIZEX/2 ym=GraphicsHeight()/2-WATERSIZEY/2 ;----------------------------------------------- OutputB=BackBuffer() LockBuffer OutputB For x1=1 To WATERSIZEX For y1=1 To WATERSIZEY x2=x1+WaveBufferX(x1,y1) y2=y1+WaveBufferY(x1,y1) If x2>WATERSIZEX Then x2=x2-WATERSIZEX If y2>WATERSIZEY Then y2=y2-WATERSIZEY If x2<1 Then x2=x2+WATERSIZEX If y2<1 Then y2=y2+WATERSIZEY pix=WaveBuffer0(x2,y2) r=(pix And $ff0000)/$10000 g=(pix And $ff00)/$100 b=(pix And $ff) ;r=128 ;<- only color ;g=128 ;b=128 bu=-(WaveBufferX(x2,y2)+WaveBufferY(x2,y2))4.0 r = r + bu g = g + bu b = b + bu If r < 0 Then r = 0 If g < 0 Then g = 0 If b < 0 Then b = 0 If r > 255 Then r = 255 If g > 255 Then g = 255 If b > 255 Then b = 255 pix2=ARGB(r,g,b) WritePixelFast x1-1,y1-1,pix2,OutputB Next Next UnlockBuffer OutputB End Function ;------------------------------------------------------------------------- Function TileWater() CopyRect 0,0,WATERSIZEX,WATERSIZEY,WATERSIZEX,0 CopyRect 0,0,WATERSIZEX,WATERSIZEY,0,WATERSIZEX CopyRect 0,0,WATERSIZEX,WATERSIZEY,WATERSIZEX,WATERSIZEX End Function ;------------------------------------------------------------------------- .Helpers Function ARGB(r,g,b) ;Return ((128 $1000000) Or (r * $10000) Or (g * $100) Or b) Return ((r * $10000) Or (g * $100) Or b) End Function ;------------------------------------------------------------------------- .WaterInAction Function ProcessWater() ;Wasser Array bewegen Local x1,y1 Local x2,y2 Local v# ;--------------------------------------------------- ;Buffer X bewegen nach Buffer D For x1=1 To WATERSIZEX For y1=1 To WATERSIZEY v=WaveBufferX(x1,y1) x2=x1+4 y2=y1+2 If x2>WATERSIZEX Then x2=x2-WATERSIZEX If y2>WATERSIZEY Then y2=y2-WATERSIZEY If x2<1 Then x2=x2+WATERSIZEX If y2<1 Then y2=y2+WATERSIZEY WaveBufferD(x2,y2)=v Next Next ;Buffer D wieder in Buffer X kopieren For x1=1 To WATERSIZEX For y1=1 To WATERSIZEY WaveBufferX(x1,y1)=WaveBufferD(x1,y1) Next Next ;--------------------------------------------------- ;Buffer Y bewegen nach Buffer D For x1=1 To WATERSIZEX For y1=1 To WATERSIZEY v=WaveBufferY(x1,y1) x2=x1+2 y2=y1+2 If x2>WATERSIZEX Then x2=x2-WATERSIZEX If y2>WATERSIZEY Then y2=y2-WATERSIZEY If x2<1 Then x2=x2+WATERSIZEX If y2<1 Then y2=y2+WATERSIZEY WaveBufferD(x2,y2)=v Next Next ;Buffer D wieder in Buffer Y kopieren For x1=1 To WATERSIZEX For y1=1 To WATERSIZEY WaveBufferY(x1,y1)=WaveBufferD(x1,y1) Next Next End Function ;------------------------------------------------------------------------- Function MemoryTexture() ;Texture die wie Wasser aussehen soll in Array merken If WaveImage=0 Then RuntimeError "MemoryTexture -> Handle WaveImage=0 !?" Return 0 EndIf Local x,y LockBuffer ImageBuffer(WaveImage) For x=1 To WATERSIZEX For y=1 To WATERSIZEY WaveBuffer0(x,y)=ReadPixelFast(x-1,y-1,ImageBuffer(WaveImage)) Next Next UnlockBuffer ImageBuffer(WaveImage) Return 1 End Function ;------------------------------------------------------------------------- Function MakeWave() ;Zwei Arrays mit Wellen füllen Local x,y,w#,w1#,w2#,w3# w#=0.0 For x=1 To WATERSIZEX For y=1 To WATERSIZEY w3=w3+(360.0/WATERSIZEX)1.0 ;Anz. Wellen WaveBufferX(x,y)=Cos(w2)1.0+Sin(w1)2.0+Sin(w3)2.0 ;<- Wellen höhe Next w1=w1+(360.0/WATERSIZEX)1.0 ;Anz. Wellen w2=w2+(360.0/WATERSIZEX)2.0 ;Anz. Wellen Next w#=0.0 w1#=0.0 For x=1 To WATERSIZEX w1=w1+(360.0/WATERSIZEY)2.0 For y=1 To WATERSIZEY WaveBufferY(x,y)=Sin(w)2.0+Sin(w1)2.0 w=w+(360.0/WATERSIZEY)1.0 Next Next End Function Function TestImage() img=CreateImage(128,128) SetBuffer ImageBuffer(img) Color 255,255,255 Rect 0,0,128,128 Color 0,0,0 Rect 0,0,64,64 Rect 64,64,64,64 SetBuffer BackBuffer() Return img End Function

Markus2

So, Mai 02, 2004 21:25
Antworten mit Zitat

Vieleicht kannste damit was anfangen .

Code: [AUSKLAPPEN]

; Wellen Effect

; If DebugMode = True Then it is very slow !

.Top

Graphics 640,480,16,2

SetBuffer BackBuffer()

;------------------------------------------------------------------------- Texture

.Texture

;a Texture size 128 x 128 is very fast

Global WaveImage=LoadImage("Texture1.jpg") ;<---

;WaveImage=TestImage()

;------------------------------------------------------------------------- WaterSettings

.WaterSettings

Global WATERSIZEX=ImageWidth (WaveImage) ;like 128 or 256
Global WATERSIZEY=ImageHeight(WaveImage) ;like 128 or 256

.WaterBuffers

Dim WaveBuffer0#(WATERSIZEX,WATERSIZEY) ;<- da kommt die Texture rein
Dim WaveBufferD#(WATERSIZEX,WATERSIZEY) ;zwischen puffer damit man das ganze Array bewegen kann
Dim WaveBufferX#(WATERSIZEX,WATERSIZEY) ;Wellen Array
Dim WaveBufferY#(WATERSIZEX,WATERSIZEY)

MemoryTexture
MakeWave

;------------------------------------------------------------------------- MainLoop

.MainLoop

While Not KeyHit(1) ; 1=Escape

Local ti#

ti=MilliSecs()

ShowWater
TileWater

ProcessWater

While Abs(MilliSecs()-ti)<10
Wend

Flip
Wend
End

;-------------------------------------------------------------------------

.RenderTexture

Function ShowWater()

Local x1,y1
Local x2,y2
Local xoff,yoff
Local xm,ym
Local pix,pix2
Local r,g,b,a
Local bu

xm=GraphicsWidth() /2-WATERSIZEX/2
ym=GraphicsHeight()/2-WATERSIZEY/2

;-----------------------------------------------

OutputB=BackBuffer()
LockBuffer OutputB

For x1=1 To WATERSIZEX
For y1=1 To WATERSIZEY

x2=x1+WaveBufferX(x1,y1)
y2=y1+WaveBufferY(x1,y1)

If x2>WATERSIZEX Then x2=x2-WATERSIZEX
If y2>WATERSIZEY Then y2=y2-WATERSIZEY
If x2<1 Then x2=x2+WATERSIZEX
If y2<1 Then y2=y2+WATERSIZEY

pix=WaveBuffer0(x2,y2)
r=(pix And $ff0000)/$10000
g=(pix And $ff00)/$100
b=(pix And $ff)

;r=128 ;<- only color
;g=128
;b=128

bu=-(WaveBufferX(x2,y2)+WaveBufferY(x2,y2))*4.0
r = r + bu
g = g + bu
b = b + bu
If r < 0 Then r = 0
If g < 0 Then g = 0
If b < 0 Then b = 0
If r > 255 Then r = 255
If g > 255 Then g = 255
If b > 255 Then b = 255

pix2=ARGB(r,g,b)
WritePixelFast x1-1,y1-1,pix2,OutputB

Next
Next

UnlockBuffer OutputB

End Function

;-------------------------------------------------------------------------

Function TileWater()

CopyRect 0,0,WATERSIZEX,WATERSIZEY,WATERSIZEX,0
CopyRect 0,0,WATERSIZEX,WATERSIZEY,0,WATERSIZEX
CopyRect 0,0,WATERSIZEX,WATERSIZEY,WATERSIZEX,WATERSIZEX

End Function

;-------------------------------------------------------------------------

.Helpers

Function ARGB(r,g,b)

;Return ((128 * $1000000) Or (r * $10000) Or (g * $100) Or b)
Return ((r * $10000) Or (g * $100) Or b)

End Function

;-------------------------------------------------------------------------

.WaterInAction

Function ProcessWater()

;Wasser Array bewegen

Local x1,y1
Local x2,y2
Local v#

;---------------------------------------------------

;Buffer X bewegen nach Buffer D

For x1=1 To WATERSIZEX
For y1=1 To WATERSIZEY
v=WaveBufferX(x1,y1)
x2=x1+4
y2=y1+2
If x2>WATERSIZEX Then x2=x2-WATERSIZEX
If y2>WATERSIZEY Then y2=y2-WATERSIZEY
If x2<1 Then x2=x2+WATERSIZEX
If y2<1 Then y2=y2+WATERSIZEY
WaveBufferD(x2,y2)=v
Next
Next

;Buffer D wieder in Buffer X kopieren

For x1=1 To WATERSIZEX
For y1=1 To WATERSIZEY
WaveBufferX(x1,y1)=WaveBufferD(x1,y1)
Next
Next

;---------------------------------------------------

;Buffer Y bewegen nach Buffer D

For x1=1 To WATERSIZEX
For y1=1 To WATERSIZEY
v=WaveBufferY(x1,y1)
x2=x1+2
y2=y1+2
If x2>WATERSIZEX Then x2=x2-WATERSIZEX
If y2>WATERSIZEY Then y2=y2-WATERSIZEY
If x2<1 Then x2=x2+WATERSIZEX
If y2<1 Then y2=y2+WATERSIZEY
WaveBufferD(x2,y2)=v
Next
Next

;Buffer D wieder in Buffer Y kopieren

For x1=1 To WATERSIZEX
For y1=1 To WATERSIZEY
WaveBufferY(x1,y1)=WaveBufferD(x1,y1)
Next
Next

End Function

;-------------------------------------------------------------------------

Function MemoryTexture()

;Texture die wie Wasser aussehen soll in Array merken

If WaveImage=0 Then
RuntimeError "MemoryTexture -> Handle WaveImage=0 !?"
Return 0
EndIf

Local x,y

LockBuffer ImageBuffer(WaveImage)

For x=1 To WATERSIZEX
For y=1 To WATERSIZEY
WaveBuffer0(x,y)=ReadPixelFast(x-1,y-1,ImageBuffer(WaveImage))
Next
Next

UnlockBuffer ImageBuffer(WaveImage)

Return 1

End Function

;-------------------------------------------------------------------------

Function MakeWave()

;Zwei Arrays mit Wellen füllen

Local x,y,w#,w1#,w2#,w3#

w#=0.0

For x=1 To WATERSIZEX
For y=1 To WATERSIZEY
w3=w3+(360.0/WATERSIZEX)*1.0 ;Anz. Wellen
WaveBufferX(x,y)=Cos(w2)*1.0+Sin(w1)*2.0+Sin(w3)*2.0 ;<- Wellen höhe
Next
w1=w1+(360.0/WATERSIZEX)*1.0 ;Anz. Wellen
w2=w2+(360.0/WATERSIZEX)*2.0 ;Anz. Wellen
Next

w#=0.0
w1#=0.0

For x=1 To WATERSIZEX
w1=w1+(360.0/WATERSIZEY)*2.0
For y=1 To WATERSIZEY
WaveBufferY(x,y)=Sin(w)*2.0+Sin(w1)*2.0
w=w+(360.0/WATERSIZEY)*1.0
Next
Next

End Function

Function TestImage()

img=CreateImage(128,128)

SetBuffer ImageBuffer(img)

Color 255,255,255
Rect 0,0,128,128

Color 0,0,0
Rect 0,0,64,64
Rect 64,64,64,64

SetBuffer BackBuffer()

Return img

End Function