Announcement

Collapse
No announcement yet.

Falling Sand Code?

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Falling Sand Code?

    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.

  • #2
    What is "falling sand?"
    Walt Decker

    Comment


    • #3
      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.

      Code:
      #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

      Comment

      Working...
      X