Snow - Simple but fine (New extended code :-) Jan.09.14

[WilliamL]

The original example give me 85% cpu load
The original with Delay(10) I get 6.5%
netmaestro's example gives me 5.5%

Now to figure out what the difference is... oh, I see, too many loops.

I think net maestro wins this one!

[walbus]

Many thanks folks, it´s very helpfull for me.

Looking for this NEW other working Code:

Endless snowfield
Each flake moves self-sufficient
Use your own landscape picture with blue sky, mountains and snow as backgroung, it´s looking fantastic
As sample :
https://www.google.de/search?sa=G&q=hig ... 90&bih=829

Make your own Snow, with many editable Parameters

regards Werner

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

[em_uk]

If we use netmaestro way of handling the Windowevent you can move the window around the screen and the snow continues to fall, but using the last update from walbus if you move the window the snow stops!

[walbus]

Please looking for the details from the extended NEW code.

The new code is completely different, a other way !!!
You find also many new user editable variables now.

netmaestro has moves the main loop from the old litle code in the BindEvent() procedure, it was a very good idea !!!

For this feature you must make ALL the new variables from the new code in the BindEvent() procedure available !
I think, it´s not necessary and looking not good on this extended code.

let it snow