PureBasic Forums - English

Posted: **Tue Aug 24, 2004 2:47 am**

Just something I did with Purebasic.

If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
  MessageRequester("Error", "Can't open DirectX 7 Or later", 0)
  End
EndIf


numar=200

Structure part 
x.f
y.f
sopas.b
EndStructure

Dim sand.part(numar)

For n=0 To numar
sand(n)\x=5+Random(789)
sand(n)\y=Random(200)
Next 


If OpenScreen(800,600,32,"Dabidu")
Else
  MessageRequester("Error", "Can't open a 800*600 - 32 bit screen !", 0)
EndIf

fondo=CreateSprite(#PB_Any,800,100,0)

StartDrawing(SpriteOutput(fondo))
  folor=RGB(0,155,20)
  LineXY(0,95,200,90,folor)
  LineXY(200,90,398,50,folor)
  LineXY(398,50,398,20,folor)
  LineXY(398,20,799,0,folor)
  FillArea(790,80,folor,folor)
  Box(0,0,10,100)
StopDrawing()

subfond=CreateSprite(#PB_Any,800,600,0)

StartDrawing(SpriteOutput(subfond))
  folor=RGB(0,155,20)
  Box(0,0,5,600,folor)
  Box(795,0,5,600,folor)
  Box(65,400,150,5,folor)
  Box(80,479,5,120,folor)
  LineXY(200,479,300,400)
  LineXY(200,479,200,485)
  LineXY(200,485,300,406)
  LineXY(300,400,300,406)
  FillArea(202,482,folor,folor)
  LineXY(430,200,700,400)
  LineXY(430,206,700,406)
  LineXY(430,200,430,206)
  LineXY(700,400,700,406)
  FillArea(432,203,folor,folor)
StopDrawing()

 Repeat
    
;=========================================================================================
DisplaySprite(subfond,0,0)
DisplayTransparentSprite(fondo,0,499)
;=========================================================================================

StartDrawing(ScreenOutput())
  FrontColor(255,255,0)
    For n=0 To numar
    
       Plot(sand(n)\x,sand(n)\y)
       
    If Point(sand(n)\x,sand(n)\y+1)=0
      sand(n)\y=sand(n)\y+1
    Else
      samba=0
      
        If Point(sand(n)\x-1,sand(n)\y+1)<>0
          samba=samba+2
        EndIf
        
        If Point(sand(n)\x+1,sand(n)\y+1)<>0
           samba=samba+4
        EndIf
        
        If Point(sand(n)\x-2,sand(n)\y+1)<>0
            samba=samba+8
        EndIf
        
        If Point(sand(n)\x+2,sand(n)\y+1)<>0
          samba=samba+16
        EndIf
 
          Select samba
          
            Case 0
              If Random(1)
                sand(n)\x=sand(n)\x+1
              Else
                sand(n)\x=sand(n)\x-1
              EndIf
              
  
            Case 2
              sand(n)\x=sand(n)\x+1


            Case 4
              sand(n)\x=sand(n)\x-1


            Case 6
              If Random(1)
                sand(n)\x=sand(n)\x+1
              Else
                sand(n)\x=sand(n)\x-1
              EndIf
              
  
            Case 8
              sand(n)\x=sand(n)\x+1
              

            Case 10
              sand(n)\x=sand(n)\x+1


            Case 14
              sand(n)\x=sand(n)\x+1


            Case 16
              sand(n)\x=sand(n)\x-1


            Case 20
              sand(n)\x=sand(n)\x-1


            Case 22
              sand(n)\x=sand(n)\x-1


            Case 26
              sand(n)\x=sand(n)\x+1
  
  
            Case 28
              sand(n)\x=sand(n)\x-1
 
  
            Case 30
              sand(n)\sopas=1
  
          EndSelect
  
    EndIf
    
  Next
    
StopDrawing()
;====================================
;====================================

StartDrawing(SpriteOutput(subfond))
  For n=0 To numar
    If sand(n)\sopas
      pichi=Random(55)+200
      FrontColor(pichi,pichi,0)
      Plot(sand(n)\x,sand(n)\y)

      sand(n)\x=5+Random(789)
      sand(n)\y=0
      sand(n)\sopas=0

    EndIf 
  Next 
StopDrawing()
;====================================
;====================================
 FlipBuffers(0)    
     
    ExamineKeyboard()
 
 Until KeyboardPushed(#PB_Key_Escape)
  
      End

Posted: **Tue Aug 24, 2004 3:05 am**

Hehehe, I like it!

Would make a great screensaver.

Suggestion: Make the "slopes" random with each run, as it might get boring
watching the sand fall in the same place every time. Good stuff though!

Posted: **Tue Aug 24, 2004 3:17 am**

Thanks for that MadMax.

I like it very much. Gives me some ideas.

Posted: **Tue Aug 24, 2004 5:07 am**

Nice work! Took less then an hour to fill my screen.

Posted: **Tue Aug 24, 2004 6:25 am**

Stop it!

I just lost about 10 minutes mesmerised by tiny sand particles.

Posted: **Fri Apr 13, 2018 10:23 am**

MadMax hasn't posted here for over a decade, so I tried to update his code to PureBasic v5.62 (by fixing FrontColor) but the sand doesn't fall. Anyone want to finish the job?

Code: Select all

If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
  MessageRequester("Error", "Can't open DirectX 7 Or later", 0)
  End
EndIf

numar=200

Structure part
  x.f
  y.f
  sopas.b
EndStructure

Dim sand.part(numar)

For n=0 To numar
  sand(n)\x=5+Random(789)
  sand(n)\y=Random(200)
Next


If OpenScreen(800,600,32,"Dabidu")
Else
  MessageRequester("Error", "Can't open a 800*600 - 32 bit screen !", 0)
EndIf

fondo=CreateSprite(#PB_Any,800,100,0)

StartDrawing(SpriteOutput(fondo))
folor=RGB(0,155,20)
LineXY(0,95,200,90,folor)
LineXY(200,90,398,50,folor)
LineXY(398,50,398,20,folor)
LineXY(398,20,799,0,folor)
FillArea(790,80,folor,folor)
Box(0,0,10,100)
StopDrawing()

subfond=CreateSprite(#PB_Any,800,600,0)

StartDrawing(SpriteOutput(subfond))
folor=RGB(0,155,20)
Box(0,0,5,600,folor)
Box(795,0,5,600,folor)
Box(65,400,150,5,folor)
Box(80,479,5,120,folor)
LineXY(200,479,300,400)
LineXY(200,479,200,485)
LineXY(200,485,300,406)
LineXY(300,400,300,406)
FillArea(202,482,folor,folor)
LineXY(430,200,700,400)
LineXY(430,206,700,406)
LineXY(430,200,430,206)
LineXY(700,400,700,406)
FillArea(432,203,folor,folor)
StopDrawing()

Repeat
  
  ;=========================================================================================
  DisplaySprite(subfond,0,0)
  DisplayTransparentSprite(fondo,0,499)
  ;=========================================================================================
  
  StartDrawing(ScreenOutput())
  FrontColor(RGB(255,255,0))
  For n=0 To numar
    
    Plot(sand(n)\x,sand(n)\y)
    
    If Point(sand(n)\x,sand(n)\y+1)=0
      sand(n)\y=sand(n)\y+1
    Else
      samba=0
      
      If Point(sand(n)\x-1,sand(n)\y+1)<>0
        samba=samba+2
      EndIf
      
      If Point(sand(n)\x+1,sand(n)\y+1)<>0
        samba=samba+4
      EndIf
      
      If Point(sand(n)\x-2,sand(n)\y+1)<>0
        samba=samba+8
      EndIf
      
      If Point(sand(n)\x+2,sand(n)\y+1)<>0
        samba=samba+16
      EndIf
      
      Select samba
          
        Case 0
          If Random(1)
            sand(n)\x=sand(n)\x+1
          Else
            sand(n)\x=sand(n)\x-1
          EndIf
          
          
        Case 2
          sand(n)\x=sand(n)\x+1
          
          
        Case 4
          sand(n)\x=sand(n)\x-1
          
          
        Case 6
          If Random(1)
            sand(n)\x=sand(n)\x+1
          Else
            sand(n)\x=sand(n)\x-1
          EndIf
          
          
        Case 8
          sand(n)\x=sand(n)\x+1
          
          
        Case 10
          sand(n)\x=sand(n)\x+1
          
          
        Case 14
          sand(n)\x=sand(n)\x+1
          
          
        Case 16
          sand(n)\x=sand(n)\x-1
          
          
        Case 20
          sand(n)\x=sand(n)\x-1
          
          
        Case 22
          sand(n)\x=sand(n)\x-1
          
          
        Case 26
          sand(n)\x=sand(n)\x+1
          
          
        Case 28
          sand(n)\x=sand(n)\x-1
          
          
        Case 30
          sand(n)\sopas=1
          
      EndSelect
      
    EndIf
    
  Next
  
  StopDrawing()
  ;====================================
  ;====================================
  
  StartDrawing(SpriteOutput(subfond))
  For n=0 To numar
    If sand(n)\sopas
      pichi=Random(55)+200
      FrontColor(RGB(pichi,pichi,0))
      Plot(sand(n)\x,sand(n)\y)
      
      sand(n)\x=5+Random(789)
      sand(n)\y=0
      sand(n)\sopas=0
      
    EndIf
  Next
  StopDrawing()
  ;====================================
  ;====================================
  FlipBuffers()
  
  ExamineKeyboard()
  
Until KeyboardPushed(#PB_Key_Escape)

Posted: **Fri Apr 13, 2018 3:13 pm**

The problem was with LineXY() not having the right color specified so that FillArea() would fill the whole screen.

Code: Select all

  LineXY(200,479,300,400)
  LineXY(200,479,200,485)
  LineXY(200,485,300,406)
  LineXY(300,400,300,406)
  FillArea(202,482,folor,folor)
  LineXY(430,200,700,400)
  LineXY(430,206,700,406)
  LineXY(430,200,430,206)
  LineXY(700,400,700,406)
  FillArea(432,203,folor,folor)

Fixed Code:

Code: Select all

If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
  MessageRequester("Error", "Can't open DirectX 7 Or later", 0)
  End
EndIf


numar=200

Structure part
x.f
y.f
sopas.b
EndStructure

Dim sand.part(numar)

For n=0 To numar
sand(n)\x=5+Random(789)
sand(n)\y=Random(200)
Next


If OpenScreen(800,600,32,"Dabidu")
Else
  MessageRequester("Error", "Can't open a 800*600 - 32 bit screen !", 0)
EndIf

fondo=CreateSprite(#PB_Any,800,100,0)

StartDrawing(SpriteOutput(fondo))
  folor=RGB(0,155,20)
  LineXY(0,95,200,90,folor)
  LineXY(200,90,398,50,folor)
  LineXY(398,50,398,20,folor)
  LineXY(398,20,799,0,folor)
  FillArea(790,80,folor,folor)
  Box(0,0,10,100,folor)
StopDrawing()

subfond=CreateSprite(#PB_Any,800,600,0)

StartDrawing(SpriteOutput(subfond))
  folor=RGB(0,155,20)
  Box(0,0,5,600,folor)
  Box(795,0,5,600,folor)
  Box(65,400,150,5,folor)
  Box(80,479,5,120,folor)
  LineXY(200,479,300,400,folor)
  LineXY(200,479,200,485,folor)
  LineXY(200,485,300,406,folor)
  LineXY(300,400,300,406,folor)
  FillArea(202,482,folor,folor)
  LineXY(430,200,700,400,folor)
  LineXY(430,206,700,406,folor)
  LineXY(430,200,430,206,folor)
  LineXY(700,400,700,406,folor)
  FillArea(432,203,folor,folor)
StopDrawing()

 Repeat
   
;=========================================================================================
DisplaySprite(subfond,0,0)
DisplayTransparentSprite(fondo,0,499)
;=========================================================================================

StartDrawing(ScreenOutput())
  FrontColor(RGB(255,255,0))
    For n=0 To numar
   
       Plot(sand(n)\x,sand(n)\y)
       
    If Point(sand(n)\x,sand(n)\y+1)=0
      sand(n)\y=sand(n)\y+1
    Else
      samba=0
     
        If Point(sand(n)\x-1,sand(n)\y+1)<>0
          samba=samba+2
        EndIf
       
        If Point(sand(n)\x+1,sand(n)\y+1)<>0
           samba=samba+4
        EndIf
       
        If Point(sand(n)\x-2,sand(n)\y+1)<>0
            samba=samba+8
        EndIf
       
        If Point(sand(n)\x+2,sand(n)\y+1)<>0
          samba=samba+16
        EndIf
 
          Select samba
         
            Case 0
              If Random(1)
                sand(n)\x=sand(n)\x+1
              Else
                sand(n)\x=sand(n)\x-1
              EndIf
             
 
            Case 2
              sand(n)\x=sand(n)\x+1


            Case 4
              sand(n)\x=sand(n)\x-1


            Case 6
              If Random(1)
                sand(n)\x=sand(n)\x+1
              Else
                sand(n)\x=sand(n)\x-1
              EndIf
             
 
            Case 8
              sand(n)\x=sand(n)\x+1
             

            Case 10
              sand(n)\x=sand(n)\x+1


            Case 14
              sand(n)\x=sand(n)\x+1


            Case 16
              sand(n)\x=sand(n)\x-1


            Case 20
              sand(n)\x=sand(n)\x-1


            Case 22
              sand(n)\x=sand(n)\x-1


            Case 26
              sand(n)\x=sand(n)\x+1
 
 
            Case 28
              sand(n)\x=sand(n)\x-1
 
 
            Case 30
              sand(n)\sopas=1
 
          EndSelect
 
    EndIf
   
  Next
   
StopDrawing()
;====================================
;====================================

StartDrawing(SpriteOutput(subfond))
  For n=0 To numar
    If sand(n)\sopas
      pichi=Random(55)+200
      FrontColor(RGB(pichi,pichi,0))
      Plot(sand(n)\x,sand(n)\y)

      sand(n)\x=5+Random(789)
      sand(n)\y=0
      sand(n)\sopas=0

    EndIf
  Next
StopDrawing()
;====================================
;====================================
 FlipBuffers()   
     
    ExamineKeyboard()
 
 Until KeyboardPushed(#PB_Key_Escape)
 
      End

Posted: **Fri Apr 13, 2018 4:02 pm**

Nice one,you may add these lines to spend more time...

Code: Select all

	Ellipse(400,180,100,140)
	Ellipse(400,450,100,140)
	Ellipse(400,180,90,130,#Black)
	Ellipse(400,450,90,130,#Black)
	Box(260,40,280,100,#Black)
	Box(260,500,280,140,#Black)
	Box(399,300,2,22,#Black);      Gap=2, 1 will block the sand...
	Box(300,500,200,12)

Posted: **Sat Apr 14, 2018 12:19 am**

Could someone add the ability to have the sand particles be blown around in a wind as they fall? I think this code is great time waster (and I can't help myself watching)

Posted: **Sat Apr 14, 2018 3:25 am**

Thanks for the fix, Sirius.

And thanks for the hourglass code, Michael.

Sorry for bringing up this very old thread, but it was such cool code.

BTW, the sand falling speed is a bit slow on my PC, but there's no Delay() or anything in there. How would I speed it up a bit, then? I see that a lot with DirectX examples here... and I don't understand how they can be sped up any more than they are?

Posted: **Sat Apr 14, 2018 6:41 am**

@Dude,
No! Thank you for bringing up this very old thread.

Posted: **Sat Apr 14, 2018 8:23 am**

Thank you Dude very much for focusing the attention to this great demo, it is showing physics behavior but without physics !!, still don't understand how all this works.
and thanks for Sirius-2337 for fixing the code, since i have tried but failed.
the code works originally with PB v 3.90 downloaded from the purebasic archive. the falling of sands is speedy in v3.9 may be because in v3.9 the CreateSprite have parameter 0 and from the v3.9 doc
0 : Default mode. Sprite resides in video memory (if possible)
#PB_Sprite_Memory : Sprite is loaded into main PC memory

so using 0 is using the video memory
this is my personal viewpoint on why the sands falling speedy in 3.9 and slow in other versions. may i am wrong and it is just needs a suitable tweaking

Posted: **Sat Apr 14, 2018 9:26 am**

A very nice demo,
it reminds me very much of my snow demo

In principle, this is very easy to code, you just have to try to find the simplest possible solution, which avoids any calculations

So it is definitely helpful to be good at mathematics to create cool programs
However, mathematics does not replace a special talent for creating innovative programs

Code: Select all

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

UsePNGImageDecoder()
UseJPEGImageDecoder()

Define b_snow_add_yy_y.f ,b_snow_add_yy_yy.f ,flakes.f ,flakes_1.f

flakes_start=2          ; Flakes - Start
flakes_max=400           ; Flakes Quantity (Quantity is not limited)
agility_x=4              ; 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
alpha=255                ; Flakes brightness - You can make herewit also rain or hail

; ---- 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=3             ; Felocity of Fall
; wind=1                   ; Wind - as sample -3 = left // 3 = right
; alpha=255                ; Flakes brightness - You can make herewit also rain or hail
; ------------------------------------------------------------------

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

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

win_x=800  ; Window X
win_y=500   ; Window Y

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

Procedure timer_events()
  Select EventTimer()
    Case 1
      timer_event_1=1
  EndSelect
EndProcedure

ExamineDesktops()
OpenWindow(0,DesktopWidth(0)/2-win_x/2,DesktopHeight(0)/2-win_y/2,win_x,win_y,"Dancing Snow - Simple but fine - By Werner Albus")

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

CopyImage(0,1)

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
  
  If timer_event_1
    timer_event_1=0
    StartDrawing(ImageOutput(0))
    DrawImage(ImageID(1),0,0)
    DrawingMode(#PB_2DDrawing_AlphaBlend)
    Circle(450,win_y-75,15,$FFFFFFFF)   ; Addon ------- Snowman ---------------
    Circle(450,win_y-50,20,$FFFFFFFF) : Circle(450,win_y-72,6,$FF000000)
    Circle(450,win_y-75,7, $FFFFFFFF) : Circle(450,win_y-75,2,$FF0045FF)
    Circle(450,win_y-25,30,$FFFFFFFF) : Circle(450,win_y-55,1,$FF000000)
    Circle(443,win_y-80,1, $FF000000) : Circle(457,win_y-80,1,$FF000000)
    Circle(450,win_y-50,1, $FF000000) : Circle(450,win_y-45,1,$FF000000)
    Circle(450,win_y-30,1, $FF000000) : Circle(450,win_y-25,1,$FF000000)
    Box(437,win_y-98,26,15,$FF828282) ; ------- Addon - Snowman´s Hat ---------
    Line(0,win_y-1,win_x,1,$FFFDFDFD) ; --------- Addon Base line -------------
    
    If flakes<flakes_max ; Add Flakes slowly
      flakes+flakes_1
      If flakes>flakes_max
        flakes=flakes_max
      EndIf
    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),RGBA(255,255,255,alpha)) 
      Else
        Circle(flake(i,0),flake(i,1)+snow_add_y,0,RGBA(255,255,255,alpha))
      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-1)<>$FDFDFD
        settle(ii)=1
      EndIf
      If settle(ii)
        Circle(ii,win_y-2,1,RGBA(255,255,255,alpha))
      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-98)<>$828282
        settle_hat(ii)=1
      EndIf
      If settle_hat(ii)=1
        Circle(ii+436,win_y-99,1,RGBA(255,255,255,alpha))
      EndIf
    Next ii
    settle_hat(Random(200))=0 ;--------------------------------------
    
  EndIf
  
  StopDrawing()
  
  ;---------------------------
  
  StartDrawing(WindowOutput(0))
  DrawImage(ImageID(0),0,0)
  StopDrawing()
  
  Repeat 
    event=WaitWindowEvent(1)
    Select event
      Case #PB_Event_CloseWindow
        quit=1
    EndSelect
  Until event=0
  
  ;---------------------------
  
Until quit

Posted: **Sat Apr 14, 2018 10:17 am**

walbus wrote:it reminds me very much of my snow demo...

Truly delightful. And quite mesmerising too.

Posted: **Sat Apr 14, 2018 11:03 am**

Many Thanks TI-994A

I had done this code once when I started with PB, just to try how PB works and what to do with it

On the TI there was a nice demo, "Falling Text",
I might do that again, it was very nice to see

PureBasic Forums - English

Fill your PC with sand

Fill your PC with sand

Re: Fill your PC with sand

Re:

Re: Fill your PC with sand

Re: Fill your PC with sand

Re: Fill your PC with sand

Re: Fill your PC with sand

Re: Fill your PC with sand

Re: Fill your PC with sand

Re: Fill your PC with sand

Re: Fill your PC with sand

Re: Fill your PC with sand