Wasser Effekt 2D
Übersicht BlitzBasic Codearchiv
Markus2Betreff: Wasser Effekt 2D |
Sa, Jan 31, 2004 23:24 Antworten mit Zitat |
|
---|---|---|
Dazu braucht ihr eine Texture (256x256) , am besten eine steinige .
Linke Maustaste drücken und man bewegt das Wasser . Sonnst fallen von alleine Regentropfen . Code: [AUSKLAPPEN] ; Aqua Effect (C) 2002 by M.Rauch from Germany ; If DebugMode = True Then it is very slow ! ; MR 14.11.2002 .Top Graphics 640,480,16,1 SetBuffer BackBuffer() ;------------------------------------------------------------------------- Texture .Texture ;a Texture size 128 x 128 is very fast Global ReflectImage=LoadImage("Texture1.jpg") ;<--- Global ReflectImageB=ImageBuffer(ReflectImage) Global OutputB=0 ;------------------------------------------------------------------------- WaterSettings .WaterSettings Global WATERSIZE=ImageWidth(ReflectImage) ;like 128 or 256 Global RainCount=0 Global DripRadius = 12 Global DripRadiusSqr = DripRadius * DripRadius Global DampingFactor# = 0.04 ;Values For damping from 0.04 - 0.0001 look pretty good (the Buffer must in float) .WaterBuffers Global BufferSize=(WATERSIZE * WATERSIZE) Dim ReadBuffer #(BufferSize) Dim WriteBuffer#(BufferSize) Dim TempBuffer #(BufferSize) Local i For i = 0 To BufferSize TempBuffer (i) = 0 ReadBuffer (i) = 0 WriteBuffer(i) = 0 Next ;------------------------------------------------------------------------- MainLoop .MainLoop While Not KeyHit(1) ; 1=Escape Local ti# ti=MilliSecs() SwapBuffers Show CheckMouse ;<- Press left Button and move the Mouse Rain ;<- automatic ProcessWater While Abs(MilliSecs()-ti)<10 Wend Flip Wend End ;------------------------------------------------------------------------- .Buffers ;------------------------------------------------------------------------- Function SetBufferR(x,y,value#) ReadBuffer(x+y*WATERSIZE)=value End Function ;------------------------------------------------------------------------- Function SetBufferW(x,y,value#) If value > 32 Then value = 32 If value < -32 Then value = -32 WriteBuffer(x+y*WATERSIZE)=value End Function ;------------------------------------------------------------------------- Function GetBufferR#(x,y) Return ReadBuffer(x+y*WATERSIZE) End Function ;------------------------------------------------------------------------- Function GetBufferW#(x,y) Return WriteBuffer(x+y*WATERSIZE) End Function ;------------------------------------------------------------------------- Function SwapBuffers() Local i ;Swap the buffers ! For i = 0 To BufferSize TempBuffer(i) =ReadBuffer(i) ReadBuffer(i) =WriteBuffer(i) WriteBuffer(i)=TempBuffer(i) Next End Function ;------------------------------------------------------------------------- .RenderTexture Function Show() Local x,y Local xoff,yoff Local xm,ym Local pix,pix2 Local r,g,b,a Local bu xm=GraphicsWidth() /2-WATERSIZE/2 ym=GraphicsHeight()/2-WATERSIZE/2 ;----------------------------------------------- OutputB=BackBuffer() LockBuffer ReflectImageB LockBuffer OutputB Local cnt=0 y=0 While y < WATERSIZE x=0 While x < WATERSIZE xoff = x If x > 0 And x < WATERSIZE - 1 Then xoff =xoff- (ReadBuffer(cnt - 1)) xoff =xoff+ (ReadBuffer(cnt + 1)) EndIf yoff = y If y > 0 And y < WATERSIZE - 1 Then yoff =yoff- ReadBuffer(cnt - WATERSIZE) yoff =yoff+ ReadBuffer(cnt + WATERSIZE) EndIf If xoff < 0 Then xoff = 0 If yoff < 0 Then yoff = 0 If xoff > WATERSIZE-1 Then xoff = WATERSIZE-1 If yoff > WATERSIZE-1 Then yoff = WATERSIZE-1 pix=ReadPixelFast(xoff,yoff,ReflectImageB) r=(pix And $ff0000)/$10000 g=(pix And $ff00)/$100 b=(pix And $ff) ;r=128 ;<- only color ;g=128 ;b=128 bu=ReadBuffer(cnt) 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 x,y,pix2,OutputB cnt=cnt+1 x=x+1 Wend y=y+1 Wend UnlockBuffer OutputB UnlockBuffer ReflectImageB 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 ;------------------------------------------------------------------------- Function SquaredDist(sx, sy, dx, dy) ;Find the Squared distance between two 2D points Return ((dx - sx) * (dx - sx)) + ((dy - sy) * (dy - sy)) End Function ;------------------------------------------------------------------------- .MouseInput Function CheckMouse() Local mx,my mx=MouseX() my=MouseY() If mx<0 Then mx=0 If my<0 Then my=0 If mx>WATERSIZE-1 Then mx=WATERSIZE-1 If my>WATERSIZE-1 Then my=WATERSIZE-1 WritePixel mx,my,ARGB(128,128,128),OutputB If MouseDown(1) Then MakeDrip mx,my,4 EndIf End Function ;------------------------------------------------------------------------- .RainInParadise Function Rain() Local mx,my Local i RainCount=RainCount+1 If RainCount > 10 Then RainCount=0 SeedRnd MilliSecs() mx=Rnd(0,WATERSIZE-1) my=Rnd(0,WATERSIZE-1) MakeDrip mx,my,4 EndIf End Function ;------------------------------------------------------------------------- .WaterDrip Function MakeDrip(xm , ym , depth) ;Creates an initial drip in the water Field ;DebugLog "MakeDrip "+x+" "+y+" "+depth Local x,y Local dist,finaldepth# y=ym - DripRadius While y < ym + DripRadius x=xm - DripRadius While x < xm + DripRadius If x => 0 And y => 0 And x < WATERSIZE And y < WATERSIZE Then dist = SquaredDist(x,y,xm,ym) If dist < DripRadiusSqr Then finaldepth = (depth * DripRadius - Sqr(dist))/DripRadius If finaldepth > 127 Then finaldepth = 127 If finaldepth < -127 Then finaldepth = -127 SetBufferW x,y,finaldepth EndIf EndIf x=x+1 Wend y=y+1 Wend End Function ;------------------------------------------------------------------------- .WaterInAction Function ProcessWater() ;Calculate New values For the water height Field Local x,y Local v# y=2 While y < WATERSIZE-2 x=2 While x < WATERSIZE-2 ;Sample a "circle" around the center point v =0 v = v + GetBufferR(x-2,y) v = v + GetBufferR(x+2,y) v = v + GetBufferR(x ,y-2) v = v + GetBufferR(x ,y+2) v = v + GetBufferR(x-1,y) v = v + GetBufferR(x+1,y) v = v + GetBufferR(x ,y-1) v = v + GetBufferR(x ,y+1) v = v + GetBufferR(x-1,y-1) v = v + GetBufferR(x+1,y-1) v = v + GetBufferR(x-1,y+1) v = v + GetBufferR(x+1,y+1) v = v / 6.0 v = v - GetBufferW(x,y) v = v - (v * DampingFactor) SetBufferW (x,y,v) x=x+1 Wend y=y+1 Wend End Function ;------------------------------------------------------------------------- |
||
Eisrabe |
So, Feb 01, 2004 19:01 Antworten mit Zitat |
|
---|---|---|
TOP ! | ||
ich habe einCode: [AUSKLAPPEN] GOTO und ich bin bereit es einzusetzen!
|
Übersicht BlitzBasic Codearchiv
Powered by phpBB © 2001 - 2006, phpBB Group