Falling Sand Code?

[Gary Beene]

Has anyone tried to use PowerBASIC to generate a "falling sand" application - and would be willing to share the code?

I've been wanting to give it a try, and have found some C++ code to look at. I could also decompile one of the Java apps out there as well.

But, I'd rather start closer to home with PowerBASIC code.

I've written an app similar to sodaplay (http://sodaplay.com/) and now I wanted to try my hand at the falling sand app.

My sodaplay-like code was in VB, but I'm working to covert it to PowerBASIC. When I do, I'll post the code.

[Walt Decker]

What is "falling sand?"

[Gary Beene]

It's a particle simulation game.

http://chir.ag/stuff/sand/

The game involves four different particles falling from the top of the screen, which all look and move similar to sand. The particles resemble sand, water, salt, and oil in color. Along with these four, additional elements can be placed on the screen with the mouse, some that are solid and stationary instead of flowing. By mixing the different elements together, many colorful designs, complex structures, and systems can be created.

From my perspective, it's the how-to-programming that's of interest to me.

I was playing with it last night, and here's some PowerBASIC code that at least shows the concept for a single type of falling particle.

I haven't read the available Java/C++ code examples to know how those programs have done it. I'll play around my own code some more and then read what is available to see whether my own approach is consistent with what is out there - or whether there's an obviously better basic algorithm to use.

#Compile Exe
#Dim All

#Debug Error On     'catch array/pointer errors - OFF in production
#Debug Display On   'display untrapped errors   - OFF in production
#Tools Off          'use ON only when needed for Trace/Profile/CallStk

#Include "win32api.inc"

'use these inside procedures:
'#Debug Print "msg"  'on as-needed basis only
'#Debug Code ON      'ignored in production, use OFF for speed in development testing

Type canvas
   st  As Long   '0-empty 1-filled 2-blocked
   clr As Long   'color long integer
End Type

%ID_Timer = 500
%ID_Graphic = 600
%MaxP = 40000
%Empty = %Black
%Filled = %Red
%Blocked = %Blue

Global D() As Long   'canvas
Global TimerInterval As Long, hDlg As Dword
Global DrawLine As Long, xMax As Long, yMax As Long

Function PBMain() As Long
    Randomize Timer
    xMax = 200 : yMax = 200
    Dim D(xMax,yMax)

    Dialog New Pixels, 0, "Button Test",300,300,320,260, %WS_OverlappedWindow To hDlg
    Control Add Button, hDlg, 100,"Push", 50,10,100,20
    Control Add Graphic, hDlg, %ID_Graphic, "", 20,40,200,200, %WS_Border Or %SS_Notify
    Control Set Color hDlg, %ID_Graphic, %White, %White
    Graphic Attach hdlg, %ID_Graphic, ReDraw
    Graphic Clear %Black
    Initialize
    TimerInterval = 15
    SetTimer(hDlg, %ID_Timer, TimerInterval, 0)
    Dialog Show Modal hDlg Call DlgProc
End Function

Sub Initialize
   Dim x As Long, y As Long, i As Long
   'clear all
   For x = 0 To xMax
      For y = 0 To yMax
         'set background
         D(x,y) = %Empty
      Next y
   Next x

   'block
   For x = 40 To 90
      For y = 100 To 105
         D(x,y) = %Blocked
         Graphic Set Pixel (x,y), %Blocked
      Next y
   Next x
   For x = 150 To 180
      For y = 100 To 105
         D(x,y) = %Blocked
         Graphic Set Pixel (x,y), %Blocked
      Next y
   Next x
   For x = 80 To 160
      For y = 50 To 55
         D(x,y) = %Blocked
         Graphic Set Pixel (x,y), %Blocked
      Next y
   Next x
End Sub


CallBack Function DlgProc() As Long
   Dim XMax As Long, YMax As Long
   Select Case Cb.Msg
      Dim x As Long, y As Long
      Case %WM_Timer
         'randomly put particles in the shooter (0 position)
         For x = .3*xMax To .33*xMax : D(x,0) = Rnd(0,1)*%Red : Next i
         For x = .6*xMax To .63*xMax : D(x,0) = Rnd(0,1)*%Green : Next i
         For x = .3*xMax To .33*xMax : D(x,0) = Rnd(0,1)*D(x,0) : Next i
         For x = .6*xMax To .63*xMax : D(x,0) = Rnd(0,1)*D(x,0) : Next i

         'relocate all per rules
         For x = 1 To xMax
            For y = yMax-1 To 0 Step -1
'               'rules - this position gets color from above

               If D(x,y) <> %Blocked Then
                     Select Case D(x,y+1)
                        Case %Empty
                           D(x,y+1) = D(x,y)
                           D(x,y) = %Empty
                           Graphic Set Pixel (x,y+1), D(x,y+1)
                        Case %Red, %Green
                           Select Case D(x-1,y+1)
                              Case %Empty
                                 D(x-1,y+1) = D(x,y)
                                 D(x,y) = %Empty
                                 Graphic Set Pixel (x-1,y+1), D(x-1,y+1)
                              Case %Red, %Green
                                 Select Case D(x+1,y+1)
                                    Case %Empty
                                       D(x+1,y+1) = D(x,y)
                                       D(x,y) = %Empty
                                       Graphic Set Pixel (x+1,y+1), D(x+1,y+1)
                                    Case %Red, %Green
                                 End Select
                           End Select
                     End Select
               End If
            Next y
         Next x
         For x = 1 To xMax
            D(x,ymax) = %Empty
         Next i
         Graphic ReDraw

      Case %WM_LButtonDown
         DrawLine = 1
      Case %WM_LButtonUp
         Drawline = 0
      Case %WM_SetCursor
         If GetDlgCtrlID(Cb.WParam)=%ID_Graphic And DrawLine = 1 Then
               Dialog Set Text hdlg, "setcursor"
               Dim pt As point
               GetCursorPos pt               'pt has xy screen coordinates
               ScreenToClient Cb.WParam, pt       'pt now has client coordinates
               Graphic Ellipse (pt.x,pt.y)-(pt.x+10,pt.y+10), %Blue, %Blue
         End If
      Case %WM_Command
         Select Case Cb.Ctl
            Case 100
               If Cb.CtlMsg = %BN_Clicked Then
               End If
            End Select
    End Select
End Function