QuickSand version 0.9 Source

[madk]

For those whom it may interest or help in their quest to make a sand
game, this is an exclusive release of QuickSand version 0.9's source
code, written in BlitzPlus. Since this version's release, the physics
have been improved many ways, but the basics still stand. If you want
to see how others have done it, here is one example.

This code is written in BlitzPlus: http://www.blitzbasic.com/Products/blitzplus.php




Global gw=320,gh=240,xx,yy

SeedRnd MilliSecs()

Dim px(gw,gh)
;0 is empty, 1 is water, 2 is wall, 3 is salt, 4 is saltwater, 5 is
fire, 6 is oil, 7 is sand, 8 is plant, 9 is spout, 10 is torch

Graphics gw,gh,0,1
AppTitle "BlitzSand 0.5 alpha"
SetBuffer BackBuffer()
HidePointer()

Global fps%
Global fpstime#

Global drawing=1


Function draw(what)
For xx=-2 To 2
For yy=-2 To 2
x=xx+MouseX()
y=yy+MouseY()
If x>1 And x<gw-1 And y>1 And y<gh-1 Then px(MouseX()+xx,MouseY()
+yy)=what
Next
Next
End Function

Flip
Global inter
Repeat
Cls
drawing=MouseZ()+1
If drawing<0 drawing=0
If drawing>10 drawing=10
LockBuffer()

If MouseDown(1)
draw drawing
EndIf
If MouseDown(2)
draw 0
EndIf
If MouseDown(3)
draw 2
EndIf

inter=inter+1
For xx=0 To gw
For yy=0 To gh
If Not px(xx,yy)=0
If inter Mod 2
;fall
If gravity(px(xx,yy))>0 And Rand(0,gravity(px(xx,yy)))=0 Then
here=px(xx,yy)
If yy+1<gh Then
there=px(xx,yy+1)
If density(here)>density(there) And gravity(there)>0 Then
px(xx,yy)=there
px(xx,yy+1)=here
EndIf

EndIf
EndIf
;negative gravity
If gravity(px(xx,yy))<0 And Rand(gravity(px(xx,yy)),0)=0 Then
here=px(xx,yy)
If yy-1>0 Then
there=px(xx,yy-1)
If gravity(there)>0 Then
px(xx,yy)=there
px(xx,yy-1)=here
EndIf

EndIf
EndIf

;slip
If Rand(0,slip(px(xx,yy)))=0 And slip(px(xx,yy))>0 Then
here=px(xx,yy)
slip=Rand(-1,1)
If xx=<1 Then slip=-1
If xx=>gw-1 Then slip=1
there=px(xx+slip,yy)
If gravity(there)>0 Then
px(xx,yy)=there
px(xx+slip,yy)=here
EndIf
EndIf


;react with others
Select px(xx,yy)
Case 1
For ax=xx-1 To xx+1
For ay=yy-1 To yy+1
If ax<>0 And ay<>0 ;avoid reacting with itself
If px(ax,ay)=3 px(xx,yy)=4:px(ax,ay)=0
EndIf
Next
Next
Case 4
For ax=xx-1 To xx+1
For ay=yy-1 To yy+1
If ax<>0 And ay<>0 ;avoid reacting with itself
If px(ax,ay)=5 px(xx,yy)=3:px(ax,ay)=1
EndIf
Next
Next
Case 5
For ax=xx-1 To xx+1
For ay=yy-1 To yy+1
If ax<>0 And ay<>0 ;avoid reacting with itself
If px(ax,ay)=1 px(xx,yy)=0:px(ax,ay)=1
EndIf
Next
Next
For ax=xx-1 To xx+1
For ay=yy-1 To yy+1
If ax<>0 And ay<>0 ;avoid reacting with itself
If px(ax,ay)=0 And Rand(0,10)=0 Then px(xx,yy)=0:px(ax,ay)=0
EndIf
Next
Next
Case 6
For ax=xx-1 To xx+1
For ay=yy-1 To yy+1
If ax<>0 And ay<>0 ;avoid reacting with itself
If px(ax,ay)=5 And Rand(0,2)>0 px(xx,yy)=5:px(ax,ay)=5
EndIf
Next
Next
Case 7
For ax=xx-1 To xx+1
For ay=yy-1 To yy+1
If ax<>0 And ay<>0 ;avoid reacting with itself
If px(ax,ay)=9 And Rand(0,2)=0 px(xx,yy)=7:px(ax,ay)=0
EndIf
Next
Next
Case 8
For ax=xx-1 To xx+1
For ay=yy-1 To yy+1
If ax<>0 And ay<>0 ;avoid reacting with itself
If px(ax,ay)=5 And Rand(0,2)=0 px(xx,yy)=5:px(ax,ay)=5
EndIf
Next
Next
For ax=xx-1 To xx+1
For ay=yy-1 To yy+1
If ax<>0 And ay<>0 ;avoid reacting with itself
If px(ax,ay)=1 And Rand(0,3)=0 px(xx,yy)=8:px(ax,ay)=8
EndIf
Next
Next
Case 9
For ax=xx-1 To xx+1
For ay=yy-1 To yy+1
If ax<>0 And ay<>0 ;avoid reacting with itself
If px(ax,ay)=0 And Rand(0,3)=0 px(xx,yy)=9:px(ax,ay)=1
EndIf
Next
Next
Case 10
For ax=xx-1 To xx+1
For ay=yy-1 To yy+1
If ax<>0 And ay<>0 ;avoid reacting with itself
If px(ax,ay)=0 And Rand(0,3)=0 px(xx,yy)=10:px(ax,ay)=5
EndIf
Next
Next
End Select
EndIf
Select px(xx,yy)
Case 1
WritePixelFast xx,yy,$208AEE
Case 2
WritePixelFast xx,yy,$808080
Case 3
WritePixelFast xx,yy,$F0F0F0
Case 4
WritePixelFast xx,yy,$041090
Case 5
WritePixelFast xx,yy,IntColor(Rand(210,255),Rand(130,150),20)
Case 6
WritePixelFast xx,yy,$750A02
Case 7
WritePixelFast xx,yy,$EAE240
Case 8
WritePixelFast xx,yy,$10F108
Case 9
WritePixelFast xx,yy,$1090FF
Case 10
WritePixelFast xx,yy,$906010
End Select
EndIf
Next
Next

WritePixelFast MouseX(),MouseY(),$FFFFFF

UnlockBuffer()

Color 255,255,255
Text 12,12, "FPS: " + FPS
Local drawing2$
Select drawing
Case 0:drawing2="Empty"
Case 1:drawing2="Water"
Case 2:drawing2="Wall"
Case 3:drawing2="Salt"
Case 4:drawing2="Saltwater"
Case 5:drawing2="Fire"
Case 6:drawing2="Oil"
Case 7:drawing2="Sand"
Case 8:drawing2="Plant"
Case 9:drawing2="Spout"
Case 10:drawing2="Torch"
Default drawing2=drawing
End Select
Text 12,26,drawing2
CountFPS()

If KeyDown(1) End
Flip False
Forever



Function react(e1,e2,e3,e4)

End Function

Function density(element)
Select element
Case 0 d=1
Case 1 d=3
Case 2 d=256
Case 3 d=3
Case 4 d=4
Case 5 d=-4
Case 6 d=2
Case 7 d=5
Case 8 d=256
Case 9 d=256
Case 10 d=256
End Select
Return d
End Function

Function gravity(element)
Select element
Case 0 d=1
Case 1 d=2
Case 2 d=0
Case 3 d=2
Case 4 d=2
Case 5 d=-1
Case 6 d=1
Case 7 d=2
Case 8 d=0
Case 9 d=0
Case 10 d=0
End Select
Return d
End Function

Function slip(element)
Select element
Case 0 d=1
Case 1 d=3
Case 2 d=0
Case 3 d=2
Case 4 d=4
Case 5 d=2
Case 6 d=2
Case 7 d=1
Case 8 d=0
Case 9 d=0
Case 10 d=0
End Select
Return d
End Function


Function CountFPS()
fps = 1000.0 / (MilliSecs() - fpstime)
fpstime = MilliSecs()
End Function


Function IntColor(R,G,B,A=255)
Return A Shl 24 Or R Shl 16 Or G Shl 8 Or B Shl 0
End Function

[inferno]

I've added a page for this with a link back to this thread, along with
a link on the front page.

[madk]

Ouch.

AppTitle "BlitzSand 0.5 alpha"

You can't see this when running the game so I never changed it.
Dang, we need to be able to edit posts.