Идет дождь

Красивая анимация движения облаков, дождя и зеленой травы. Сама техника движения фона, может пригодиться для создания аркадных игр.
Платформа: Windows, Linux
Автор: Hezad
#INCLUDE "fbgfx.bi"

Screenres 640,480,32,2,FB.GFX_ALPHA_PRIMITIVES

Randomize Timer

Const NB_RAIN = 1000
Const RAIN_POWER = 1.5

Const GSpeed1=1
Const GSpeed2=.5


'' init Rain

Dim Shared As Any Ptr Raingfx
Raingfx=ImageCreate(10+1,40+1)

Dim Shared As Single Rx(NB_RAIN),Ry(NB_RAIN),Ralpha(NB_RAIN),RSpeed(NB_RAIN)

For i As Integer = 0 To NB_RAIN
    Rx(i) = rnd*640
    Ry(i) = rnd*480
    Ralpha(i) = 10+rnd*100
    RSpeed(i) = (10+rnd*10) * RAIN_POWER
Next

Line(0,0)-(10,40),Rgb(255,0,255),bf
Line(0,0)-(10,40),Rgb(250,250,255)

Get(0,0)-(10,40),Raingfx

Cls


'' init Grass
Dim Shared As Any Ptr Grass1GFX,Grass2GFX,LGrass1(640),Lgrass2(640)
Dim Shared As Single Gx1,Gx2,LgX(640),LgX2(640)

Grass1GFX = Imagecreate(640+1,50+1)
Grass2GFX = Imagecreate(640+1,100+1)

'' grass1
Line(0,0)-(640,50),Rgb(255,0,255),bf
For i As Integer = 0 To 640
    Line(i,50)-(i+(-5+rnd*5),rnd*30),Rgb(80,120+rnd*100,80)
Next

Get(0,0)-(640-1,50-1),Grass1GFX
For i As Integer = 0 To 640
    LGrass1(i)=imageCreate(1,50)
    Get Grass1GFX,(i,0)-(i,50-1),LGrass1(i)
    LgX(i)=i
Next
Cls


'' grass2
Line(0,0)-(640,100),Rgb(255,0,255),bf
For i As Integer = 0 To 640
    Line(i,100)-(i+(-5+rnd*5),rnd*50),Rgb(150,150+rnd*100,150)
Next

Get(0,0)-(640-1,100-1),Grass2GFX
For i As Integer = 0 To 640
    LGrass2(i)=imageCreate(1,100)
    Get Grass2GFX,(i,0)-(i,100-1),LGrass2(i)
    LgX2(i)=i
Next
Cls



'' subs

Sub HandleRain()
    
    For i As Integer = 0 To NB_RAIN
        Rx(i)+=.1*RSpeed(i)
        Ry(i)+=.4*RSpeed(i)
        
        If Ry(i)>480 Then Ry(i) = -40
        If Rx(i)>640 Then Rx(i) = -10
        
        Put(Rx(i),Ry(i)),RainGfx,alpha,Ralpha(i)
    Next

End Sub


Sub HandleGrass()
    
    For i As Integer = 0 To 640 
        
        LgX2(i) -= GSpeed2
        If LgX2(i)<=0 Then LgX2(i)=640
        
        Put(LgX2(i),480-70),LGrass2(i),alpha,255
        
    Next
    
    For i As Integer = 0 To 640 
        
        LgX(i) -= GSpeed1
        If LgX(i)<=0 Then LgX(i)=640
        
        Put(LgX(i),480-50),LGrass1(i),alpha,255
    
    Next
    
End Sub


'' clouds generator

Const PI = 3.1415926535897938324626

Dim Shared As Integer R = 255
Dim Shared As Integer G = 255
Dim Shared As Integer B = 255

Sub SpreadDot(x As Integer, y As Integer,length As Integer=100,alpha As Integer=105, Zoom As Single = 0)
    
    If Length<=1 Or Alpha<=1 Then Exit Sub
   
    Dim As Single rnded = -pi+Rnd*1*pi/2
    Dim As Single rnded2 = -pi+Rnd*-3*pi
    
    If alpha<25 Then
        For i As Integer = 0 To 255-alpha Step 100
            Line(-(Zoom/2)+x-length/2,y)-((Zoom/2)+x+Length/6+length*Cos(-pi/2+rnded*PI/3),y+Length/6+length*Sin(-pi/2+rnded*PI/3)),Rgb(R,G,B)
            Line(-(Zoom/2)+x-length/2,y)-((Zoom/2)+x+Length/6+length*Cos(-pi/2+rnded2*PI/3),y+Length/6+length*Sin(pi/2+rnded2*PI/3)),Rgb(R,G,B)
        Next
    End If
   
    SpreadDot(-(Zoom/2)+x+length*Cos(-pi/2+rnded*PI/3),(Zoom/2)+y+length*sin(-pi/2+rnded*PI/3),length/1.4,Alpha/1.2,Zoom)
    SpreadDot(-(Zoom/2)+x+length*Cos(-pi/2+rnded2*PI/3),(Zoom/2)+y+length*Sin(pi/2+rnded2*PI/3),length/1.4,Alpha/1.2,Zoom)
    SpreadDot(-(Zoom/2)+x+length*cos(pi/3+rnded2*PI/3),(Zoom/2)+y+length*Sin(pi+rnded2*PI/3),length/1.4,Alpha/2,Zoom)
   
End Sub


Const CLOUDS_SPEED = 2
Const NB_CLOUDS = 50

Dim Shared As Any Ptr CloudGFX(NB_CLOUDS)
Dim Shared As Single Cx(NB_CLOUDS),Cy(NB_CLOUDS),CV(NB_CLOUDS),CAlpha(NB_CLOUDS)


For i As Integer = 0 To NB_CLOUDS
    CloudGFX(i) = Imagecreate(200,200)
    Cx(i) = rnd*640-50
    Cy(i) = rnd*200-100
    CV(i) = rnd*CLOUDS_SPEED
    CAlpha(i) = CV(i)*100
    If Calpha(i) = 0 Then Calpha(i) = 255
    
    Cls
    Line(0,0)-(640,480),Rgb(255,0,255),bf
    SpreadDot(320,140,20,rnd*30)
    
    Get(320-100,140-100)-(320+99,140+99),CloudGFX(i)
Next

Sub HandleClouds()
    
    For i As Integer = 0 To NB_CLOUDS
        
        Cx(i)+=CV(i)
        If Cx(i)>640 Then Cx(i)=-150
        
        Put(Cx(i),Cy(i)),CloudGFX(i),alpha,CAlpha(i)
        
    Next
    
End Sub



'' Main

Do
    Screenlock : Cls
    
    Line(0,0)-(640,200),Rgb(120,150,230),bf
    For j As Integer = 200 To 480
        Line(0,j)-(640,j),Rgb(120+(j-200)/4,150+(j-200)/4,230),bf
    Next
    
    HandleGrass
    
    HandleClouds
    
    HandleRain
    
    Screenunlock : Sleep 1,1
Loop Until Multikey(&h01)
FreeBasic

Идет дождь
