PureBasic Forums - English

Code: Select all

; Tanzender Schnee - Dancing snow - by Werner Albus - www.nachtoptik.de

UsePNGImageDecoder()
UseJPEGImageDecoder()

Define flakes.f ,flakes_1.f
Global timer_event

; ---- More agility settings ---------------------------------------
; flakes_start=20          ; Flakes - Start
; flakes_max=400           ; Flakes Quantity (Quantity is not limited)
; agility_x=2              ; Flakes agility X
; agility_y=15             ; Flakes agility Y
; latency_x=3              ; Flakes latency X
; latency_y=17             ; Flakes latency Y
; flakes_1=5.0             ; Increment accrete Quantity Speed
; animation_speed=70       ; Animation Speed
; fall_speed=2             ; Felocity of Fall
; wind=1                   ; Wind - as sample -3 = left // 3 = right
; ------------------------------------------------------------------

flakes_start=20          ; Flakes - Start
flakes_max=400           ; Flakes Quantity (Quantity is not limited)
agility_x=3              ; Flakes agility X
agility_y=19             ; Flakes agility Y
latency_x=5              ; Flakes latency X
latency_y=20             ; Flakes latency Y
flakes_1=1.0             ; Increment accrete Quantity Speed
animation_speed=90       ; Animation Speed
fall_speed=1             ; Felocity of Fall
wind=0                   ; Wind - as sample -3 = left // 3 = right

fill_screen_at_start=0   ; 1 Filling Screen at Startup  //  0 Filling Screen slowly at startup
                         ; For filling at Startup set also flakes_start many bigger or equal flakes_max
win_x=600  ; Window X
win_y=400  ; Window Y                       

;landscape$="C:\Users\Werner\Desktop\tatra.jpg" ; Set here the pad to your own Landscape Picture, if you want !

If wind<0
  wind_1=wind*-1
Else
  wind_1=wind
EndIf
flakes=flakes_start

Procedure timer_events()
  timer_event=EventTimer()
EndProcedure

ExamineDesktops()
OpenWindow(0,DesktopWidth(0)/2-win_x/2,DesktopHeight(0)/2-win_y/2,win_x,win_y,"Dancing Snow")

If InitSprite() = 0 Or InitKeyboard() = 0 Or OpenWindowedScreen(WindowID(0),0,0,win_x,win_y,0,0,0,#PB_Screen_WaitSynchronization) = 0
  MessageRequester("Error", "Can not init Spritesystem",0)
  End
EndIf

AddWindowTimer(0,1,animation_speed)
BindEvent(#PB_Event_Timer, @timer_events())

If landscape$<>""
  LoadImage(0,landscape$)
  ResizeImage(0,win_x,win_y)
Else
  CreateImage (0,win_x,win_y) ; Create Background
  StartDrawing(ImageOutput (0))
  DrawingMode ( #PB_2DDrawing_Gradient )
  BackColor (0)
  FrontColor ($FF901E)
  LinearGradient (0,-300,0,1500)
  Box (0,0,win_x,win_y)
  StopDrawing()
EndIf

Dim flake (flakes_max,2)

Dim settle(win_x)    ; Addon - settle a little Snow
Dim settle_hat(200)  ; Addon - settle a little Snow on the Hat

For i=0 To flakes_max
  flake(i,0)=Random(win_x)
  If fill_screen_at_start
    flake(i,1)=Random(win_y)
  Else
    flake(i,1)=-Random(win_y)-2
  EndIf
Next i

  ;---------------------------
  
  Repeat 
    event=WaitWindowEvent()
    Select event
      Case #PB_Event_CloseWindow
        End
    EndSelect

    If timer_event
      timer_event=0
      FlipBuffers ()
      StartDrawing(ScreenOutput())
      DrawImage(ImageID(0),0,0)
      
      Circle(450,win_y-75,15,$EFEFEF) ; Addon - Simple Snowman :-)
      Circle(450,win_y-50,20,$EFEFEF) : Circle(450,win_y-72,6,0)
      Circle(450,win_y-75,7, $EFEFEF) : Circle(450,win_y-75,2,$0045FF)
      Circle(450,win_y-25,30,$EFEFEF) : Circle(450,win_y-55,1,0)
      Circle(443,win_y-80,1, 0)       : Circle(457,win_y-80,1,0)
      Circle(450,win_y-50,1, 0)       : Circle(450,win_y-45,1,0)
      Circle(450,win_y-30,1, 0)       : Circle(450,win_y-25,1,0) ; ----
      
    ;--------------------------- 
    
    If flakes<flakes_max ; Add Flakes slowly
      flakes+flakes_1
    EndIf
    
    For i=0 To flakes
      
      If Random(latency_x)>agility_x
        flake(i,0)+Random(2)-1+wind
      Else
        flake(i,0)+wind
      EndIf
      
      If Random(latency_y)>agility_y
        flake(i,1)+Random(fall_speed)
      Else
        flake(i,1)+fall_speed
      EndIf
      
      If wind_1
        If flake(i,0)>win_x
          flake(i,0)=Random(wind_1)
        EndIf
        If flake(i,0)<0
          flake(i,0)=win_x-Random(wind_1)
        EndIf
      Else
        If flake(i,0)>win_x+10
          flake(i,0)=-5
        EndIf
        If flake(i,0)<-10
          flake(i,0)=win_x+5
        EndIf
      EndIf
      
      If Random(2)
        Circle(flake(i,0),flake(i,1)+snow_add_y,Random(1)) 
      Else
        Circle(flake(i,0),flake(i,1)+snow_add_y,0)
      EndIf

      If flake(i,1)>win_y-fall_speed
        flake(i,1)=-Random(fall_speed)
        flake(i,0)=Random(win_x)
      EndIf
    Next i 
    
    For ii=1 To win_x-1 ; Addon - settle a little Snow -------------
      If Point(ii,win_y-2)=$FFFFFF
        settle(ii)=1
      EndIf
      If settle(ii)
        Circle(ii,win_y-1,1)
      EndIf
    Next ii
    For ii = 1 To 3 : settle(Random(win_x))=0 : Next ii ;--------
    
    For ii=1 To 26 ; Addon - settle a little Snow on the Hat --
      If Point(ii+436,win_y-100)=$FFFFFF
        settle_hat(ii)=1
      EndIf
      If settle_hat(ii)
        Circle(ii+436,win_y-99,1)
      EndIf
    Next ii
    settle_hat(Random(200))=0 ;---------------------------------
    
    Box(437,win_y-98,26,15,$828282) ;-- Addon Snowman´s Hat --
    
    StopDrawing()
    
    EndIf

  ForEver