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

Share your advanced PureBasic knowledge/code with the community.
Post Reply
walbus
Addict
Addict
Posts: 929
Joined: Sat Mar 02, 2013 9:17 am

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

Post by walbus »

---------For the extended Code looking the latest posting´s below !!!!------------

Code: Select all

; Snow - by Werner Albus - www.nachtoptik.de

Procedure timer_events()
  Global time_event=EventTimer()
EndProcedure

ExamineDesktops()
OpenWindow(0,DesktopWidth(0)/2-100,DesktopHeight(0)/2-300,600,400,"Simple Snow")

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

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

CreateImage (0,600,400) ; Create Background
StartDrawing(ImageOutput (0))
DrawingMode ( #PB_2DDrawing_Gradient )
BackColor (0)
FrontColor ($FF901E)
LinearGradient (0,-300,0,1500)
Box (0,0,600,400)
StopDrawing()

Dim snow_x(1400) : Dim snow_y(1400); Create Snow Field

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

For i=1 To 1400
  snow_x(i)=Random(598)+1 ; X Range -2
  snow_y(i)=-Random(1400)
Next i

Repeat
  
  If time_event=1
    FlipBuffers ()
    time_event=0
    StartDrawing(ScreenOutput())
    DrawImage(ImageID(0),0,0)
    
    Circle(450,325,15,$EFEFEF) ; Addon - Simple Snowman :-)
    Circle(450,350,20,$EFEFEF) : Circle(450,328,6,0)
    Circle(450,325,7, $EFEFEF) : Circle(450,325,2,$0045FF)
    Circle(450,385,30,$EFEFEF) : Circle(450,345,1,0)
    Circle(443,320,1, 0)       : Circle(457,320,1,0)
    Circle(450,350,1, 0)       : Circle(450,355,1,0)
    Circle(450,370,1, 0)       : Circle(450,375,1,0) ; ----

    For ix=1 To 1400  ; Let it snow
      go=snow_y(ix)+snow_add_y
      If go>0 And go<400
        If Not Random(2)
          Plot(snow_x(ix)+Random(1)-1,snow_y(ix)+snow_add_y)
        Else
          Circle(snow_x(ix)+Random(1)-1,snow_y(ix)+snow_add_y,Random(1))
        EndIf
      EndIf
    Next ix
    
    snow_add_y+1
    If snow_add_y>1400
      snow_add_y=400
    EndIf
    
    For ii=1 To 599 ; Addon - settle a little Snow ---
      If Point(ii,398)=$FFFFFF
        settle(ii)=1
      EndIf
      If settle(ii)
        Circle(ii,399,1)
      EndIf
    Next ii
    settle(Random(600))=0
    settle(Random(600))=0
    settle(Random(600))=0 ;----------------------------
    
    For ii=1 To 26 ; Addon - settle a little Snow on the Hat --
      If Point(ii+436,300)=$FFFFFF
        settle_hat(ii)=1
      EndIf
      If settle_hat(ii)
        Circle(ii+436,301,1)
      EndIf
    Next ii
    settle_hat(Random(200))=0 ;---------------------------------
    
    Box(437,302,26,15,$828282) ;-- Addon Snowman´s Hat --
    
    StopDrawing()
  EndIf
  
  Repeat 
    event=WindowEvent()
    Select event
      Case #PB_Event_CloseWindow
        quit=1
    EndSelect
  Until event=0
  
Until quit
Last edited by walbus on Thu Jan 09, 2014 10:28 am, edited 21 times in total.
Top
IdeasVacuum
Always Here
Always Here
Posts: 6426
Joined: Fri Oct 23, 2009 2:33 am
Location: Wales, UK
Contact:
Contact IdeasVacuum

Re: A Simple but fine Snow Simulation :-)

Post by IdeasVacuum »

nice - but it doesn't settle on the ground and where is the snowman? :D
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
Top
walbus
Addict
Addict
Posts: 929
Joined: Sat Mar 02, 2013 9:17 am

Re: A Simple but fine Snow Simulation :-)

Post by walbus »

Yep, settle snow, you can simple add.
With the Snowman, unfortunately, we have here to time Fog and it is to warm !
regards from Germany - Werner
Top
User avatar
Demivec
Addict
Addict
Posts: 4270
Joined: Mon Jul 25, 2005 3:51 pm
Location: Utah, USA

Re: Simple but fine Snow Simulation :-)

Post by Demivec »

I tried the code but got no snow until I changed line 22:

Code: Select all

;replace
If ElapsedMilliseconds()>timer_0+90

;with
If ElapsedMilliseconds()>timer_0+90 Or timer_0 - ElapsedMilliseconds() > 100
In the original code if the computer has been on long enough for ElapsedMilliseconds() to return a negative number it may be 21 or more days before you see snow. :)


The snow is nice but I agree it needs something more. Maybe something will come along . . .
Top
walbus
Addict
Addict
Posts: 929
Joined: Sat Mar 02, 2013 9:17 am

Re: Simple but fine Snow Simulation :-)

Post by walbus »

Yep, this is correct, after code test i have forgotten to set a timer ,now it´s OK; THANKS.
Top
User avatar
luis
Addict
Addict
Posts: 3895
Joined: Wed Aug 31, 2005 11:09 pm
Location: Italy

Re: Simple but fine Snow Simulation :-)

Post by luis »

@walbus

I like the twinkle effect obtained in a so simple way, consider it stolen. :)

@demivec

Right ! It's that time of year again ! Going to find my hat.
"Have you tried turning it off and on again ?"
Top
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Re: Simple but fine Snow Simulation :-)

Post by netmaestro »

Ha, you're right! Now where is that thing, time to dust it off..
BERESHEIT
Top
User avatar
flaith
Enthusiast
Enthusiast
Posts: 704
Joined: Mon Apr 25, 2005 9:28 pm
Location: $300:20 58 FC 60 - Rennes
Contact:
Contact flaith

Re: Simple but fine Snow Simulation :-)

Post by flaith »

Nice effect :)
But when I move my mouse on the screen, it freezes the animation.
“Fear is a reaction. Courage is a decision.” - WC
Top
walbus
Addict
Addict
Posts: 929
Joined: Sat Mar 02, 2013 9:17 am

Re: Simple but fine Snow Simulation :-)

Post by walbus »

I am very glad that you like it
It´s colder to day.
To evening, or Sunday morning, (i must working today & Christmas party (Beer :-)
I make a Snowman and a little more :-)

@ flaith (a mouse issue ??? hmm)

best regards Werner
Top
Fred
Administrator
Administrator
Posts: 18247
Joined: Fri May 17, 2002 4:39 pm
Location: France
Contact:
Contact Fred

Re: Simple but fine Snow Simulation :-)

Post by Fred »

walbus wrote:@ flaith (a mouse issue ??? hmm)
No, it's not a mouse issue. You need to process all the events at every loop (WaitWindowEvent() only process the last one, you need to have another loop until WindowEvent() returns 0.
Top
walbus
Addict
Addict
Posts: 929
Joined: Sat Mar 02, 2013 9:17 am

Re: Simple but fine Snow Simulation :-)

Post by walbus »

Many thanks Fred !
The code is changed now

More new Things added :-)
Top
User avatar
em_uk
Enthusiast
Enthusiast
Posts: 366
Joined: Sun Aug 08, 2010 3:32 pm
Location: Manchester UK

Re: Snow - Simple but fine

Post by em_uk »

Hi, very nice - however, your loop WaitEvent loop consumes a lot of CPU resources :

if you take this :

Code: Select all

ExamineDesktops()
OpenWindow(0,DesktopWidth(0)/2-100,DesktopHeight(0)/2-300,600,400,"Simple Snow")

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

Repeat

  Repeat 
    event=WindowEvent()
    Select event
      Case #PB_Event_CloseWindow
        quit=1
    EndSelect
  Until event=0
  
Until quit
And check taskmanager, on my system with 4 cores, it immeditaly takes up 25% seeming doing nothing. I have added a delay(1) in to the final loop which reduces the CPU consumption by almost all of it.

Code: Select all

; Snow - by Werner Albus - www.nachtoptik.de

Procedure timer_events()
  Global time_event=EventTimer()
EndProcedure

ExamineDesktops()
OpenWindow(0,DesktopWidth(0)/2-100,DesktopHeight(0)/2-300,600,400,"Simple Snow")

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

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

CreateImage (0,600,400) ; Create Background
StartDrawing(ImageOutput (0))
DrawingMode ( #PB_2DDrawing_Gradient )
BackColor (0)
FrontColor ($FF901E)
LinearGradient (0,-300,0,1500)
Box (0,0,600,400)
StopDrawing()

Dim snow_x(1400) : Dim snow_y(1400); Create Snow Field

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

For i=1 To 1400
  snow_x(i)=Random(598)+1 ; X Range -2
  snow_y(i)=-Random(1400)
Next i

Repeat
  
  If time_event=1
    FlipBuffers ()
    time_event=0
    StartDrawing(ScreenOutput())
   DrawImage(ImageID(0),0,0)
    
    Circle(450,325,15,$EFEFEF) ; Addon - Simple Snowman :-)
    Circle(450,350,20,$EFEFEF) : Circle(450,328,6,0)
    Circle(450,325,7, $EFEFEF) : Circle(450,325,2,$0045FF)
    Circle(450,385,30,$EFEFEF) : Circle(450,345,1,0)
    Circle(443,320,1, 0)       : Circle(457,320,1,0)
    Circle(450,350,1, 0)       : Circle(450,355,1,0)
    Circle(450,370,1, 0)       : Circle(450,375,1,0) ; ----

    For ix=1 To 1400  ; Let it snow
      go=snow_y(ix)+snow_add_y
      If go>0 And go<400
        If Not Random(2)
          Plot(snow_x(ix)+Random(1)-1,snow_y(ix)+snow_add_y)
        Else
          Circle(snow_x(ix)+Random(1)-1,snow_y(ix)+snow_add_y,Random(1))
        EndIf
      EndIf
    Next ix
    
    snow_add_y+1
    If snow_add_y>1400
      snow_add_y=400
    EndIf
    
    For ii=1 To 599 ; Addon - settle a little Snow ---
      If Point(ii,398)=$FFFFFF
        settle(ii)=1
      EndIf
      If settle(ii)
        Circle(ii,399,1)
      EndIf
    Next ii
    settle(Random(600))=0
    settle(Random(600))=0
    settle(Random(600))=0 ;----------------------------
    
    For ii=1 To 26 ; Addon - settle a little Snow on the Hat --
      If Point(ii+436,300)=$FFFFFF
        settle_hat(ii)=1
      EndIf
      If settle_hat(ii)
        Circle(ii+436,301,1)
      EndIf
    Next ii
    settle_hat(Random(200))=0 ;---------------------------------
    
    Box(437,302,26,15,$828282) ;-- Addon Snowman´s Hat --
    
    StopDrawing()
  EndIf
  
  Repeat 
    event=WindowEvent()
    Select event
      Case #PB_Event_CloseWindow
        quit=1
    EndSelect
    Delay(1)   ; Don't know if this is the best practice but it works! :)
  Until event=0
  
Until quit
----

R Tape loading error, 0:1
Top
User avatar
ts-soft
Always Here
Always Here
Posts: 5756
Joined: Thu Jun 24, 2004 2:44 pm
Location: Berlin - Germany

Re: Snow - Simple but fine

Post by ts-soft »

Better:

Code: Select all

  Repeat
    event=WaitWindowEvent(1)
    Select event
      Case #PB_Event_CloseWindow
        quit=1
    EndSelect
    ;Delay(1)   ; Don't know if this is the best practice but it works! :)
  Until event=0
PureBasic 5.73 | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image
Top
WilliamL
Addict
Addict
Posts: 1252
Joined: Mon Aug 04, 2008 10:56 pm
Location: Seattle, USA

Re: Snow - Simple but fine

Post by WilliamL »

This is fun! The blinking snow is nice and the accumulation is great.

Yes, I see the cpu usage too. In fact, I find that Delay(10) works the best for me as far a cpu usage and temperature control (laptop begins to heat up). It looks the same to me...
MacBook Pro-M1 (2021), Sequoia 15.4, PB 6.20
Top
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Re: Snow - Simple but fine

Post by netmaestro »

Best not to use a delay at all if you're already using a timer anyway. This has cpu load less than 1% and usually 0:

Code: Select all

; Snow - by Werner Albus - www.nachtoptik.de

Global Dim snow_x(1400) 
Global Dim snow_y(1400); Create Snow Field

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

Procedure timer_events()
  Static snow_add_y
  FlipBuffers ()
  StartDrawing(ScreenOutput())
    DrawImage(ImageID(0),0,0)
    
    For ix=1 To 1400  ; Let it snow
      go=snow_y(ix)+snow_add_y
      If go>0 And go<400
        If Not Random(2)
          Plot(snow_x(ix)+Random(1)-1,snow_y(ix)+snow_add_y)
        Else
          Circle(snow_x(ix)+Random(1)-1,snow_y(ix)+snow_add_y,Random(1))
        EndIf
      EndIf
    Next ix
    
    snow_add_y+1
    If snow_add_y>1400
      snow_add_y=400
    EndIf
    
    For ii=1 To 599 ; Addon - settle a little Snow ---
      If Point(ii,398)=$FFFFFF
        settle(ii)=1
      EndIf
      If settle(ii)
        Circle(ii,399,1)
      EndIf
    Next ii
    settle(Random(600))=0
    settle(Random(600))=0
    settle(Random(600))=0 ;----------------------------
    
    For ii=1 To 26 ; Addon - settle a little Snow on the Hat --
      If Point(ii+436,300)=$FFFFFF
        settle_hat(ii)=1
      EndIf
      If settle_hat(ii)
        Circle(ii+436,301,1)
      EndIf
    Next ii
    settle_hat(Random(200))=0 ;---------------------------------

  StopDrawing()
  
EndProcedure

ExamineDesktops()
OpenWindow(0,DesktopWidth(0)/2-100,DesktopHeight(0)/2-300,600,400,"Simple Snow")

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

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

CreateImage (0,600,400) ; Create Background
StartDrawing(ImageOutput (0))
  DrawingMode ( #PB_2DDrawing_Gradient )
  BackColor (0)
  FrontColor ($FF901E)
  LinearGradient (0,-300,0,1500)
  Box (0,0,600,400)
  DrawingMode(#PB_2DDrawing_Default)
  Circle(450,325,15,$EFEFEF) ; Addon - Simple Snowman :-)
  Circle(450,350,20,$EFEFEF) : Circle(450,328,6,0)
  Circle(450,325,7, $EFEFEF) : Circle(450,325,2,$0045FF)
  Circle(450,385,30,$EFEFEF) : Circle(450,345,1,0)
  Circle(443,320,1, 0)       : Circle(457,320,1,0)
  Circle(450,350,1, 0)       : Circle(450,355,1,0)
  Circle(450,370,1, 0)       : Circle(450,375,1,0) ; ----
  Box(437,302,26,15,$828282) ;-- Addon Snowman´s Hat --
StopDrawing()

For i=1 To 1400
  snow_x(i)=Random(598)+1 ; X Range -2
  snow_y(i)=-Random(1400)
Next i

Repeat:Until WaitWindowEvent()=#PB_Event_CloseWindow
BERESHEIT
Top
Post Reply

Return to “Tricks 'n' Tips”