OMG that's one hell of a lot of code!! Not trying to be a smartarse, but you could do the same thing in under 40 lines - I don't even want to know why you are using memblocks!
eg: your code (altered slightly to make it work in DBPro)
` This code was downloaded from The Game Creators
` It is reproduced here with full permission
` http://www.thegamecreators.com
`Written by Patrick Lewis
`***Demonstration***
Sync On
Sync Rate 40
AutoCam Off
Position Camera 0,0,50,-20
Position Light 0,0,50,10
Set Normalization Off
`Create the Ground
Make Object Plain 100,1000,1000
Pitch Object Down 100,90
Color Object 100,RGB(255,255,0)
Ghost Object On 100
`Create a few random balls.
NumBalls=rnd(20)+20
For i = 1 to NumBalls
Size=rnd(10)+10
Make Object Sphere i,rnd(5)+5
x=rnd(200)-100:y=rnd(100)+50:z=rnd(100)+50
Position Object i, x,y,z
Color Object i,rgb(rnd(255),rnd(255),rnd(255))
Next i
Sync
Sleep 1000
`Woohoo!!! Now Let 'em go.
Do
For i = 1 to NumBalls
Gravity(i)
Bounce(i)
Next i
If RightKey() Then Turn Camera Right 1
If LeftKey() Then Turn Camera Left 1
Sync
Loop
`***End of Demo***
`Bounce & Gravity Functions
Function Gravity(ObjectID)
GForce=-32000:` Working in *1000 Space. It get's divided out later.
Ground#=0
If Object Exist(ObjectID)=0 Then ExitFunction
ObjectID#=ObjectID
V1=Int(ObjectID#/256)
V2=ObjectID#-(V1*256)
ID$=Chr$(V1)+Chr$(V2)
LastYVel=GetStaticVar("GV"+ID$)
LastTime=GetStaticVar("GT"+ID$)
If LastTime<0
StaticVar("GV"+ID$,-1)
StaticVar("GT"+ID$,Timer())
ExitFunction
Endif
NewTime=Timer()
DTime=NewTime-LastTime
NewYVel=LastYVel+(GForce*DTime^2)
NewYVel#=NewYVel
NewYVel#=NewYVel#/(1000^3)
HalfSize#=Object Size Y(ObjectID)/2
Ground#=Ground#+.5
If Object Position Y(ObjectID)-HalfSize#<Ground# And Abs(NewYVel)<5:`Stop sucking
NewYVel=0
NewYVel#=0
Endif
StaticVar("GV"+ID$,NewYVel)
StaticVar("GT"+ID$,NewTime)
Position Object ObjectID,Object Position X(ObjectID),Object Position Y(ObjectID)+NewYVel#,Object Position Z(ObjectID)
EndFunction
Function Bounce(ObjectID)
Bounce#=.95:` Your bounce factor. Use less than 0.99. Use 0 for no bounce.
RestVal=5:` A value to set for the balls to eventually stop bouncing.
Ground#=0:` The Ground lelvel (or you could pass the ground level for variable terrain).
If Object Exist(ObjectID)=0 Then ExitFunction
HalfSize#=Object Size Y(ObjectID)/2:` assumes object center is in it's middle
Y#=Object Position Y(ObjectID)-HalfSize#
If Y#>Ground# then ExitFunction
ObjectID#=ObjectID
V1=Int(ObjectID#/256)
V2=ObjectID#-(V1*256)
ID$=Chr$(V1)+Chr$(V2)
LastYVel#=GetStaticVar("GV"+ID$)
NewYVel#=Abs(LastYVel#)*Bounce#
If NewYVel#<RestVal Then NewYVel#=0:` Eventually come to rest
NewYVel=NewYVel#
StaticVar("GV"+ID$,NewYVel)
StaticVar("GT"+ID$,Timer())
NewYVel#=NewYVel#/(1000^3)
Position Object ObjectID,Object Position X(ObjectID),Object Position Y(ObjectID)+NewYVel#,Object Position Z(ObjectID)
EndFunction
`Written by: Patrick Lewis
`Worked out "variable" functions.
Function StaticVar(VarID$,VarValue)
`Memblocks 242 and 243 should be reserved for the static functions
`Each Static Variable takes up 16 Bytes: 8 for VarID$ and 8 for Value
`The VarID must be 4 characters in length.
If VarID$="" or Len(VarID$)>4 Then ExitFunction
VarID$=VarID$ + Space$(4-Len(VarID$))
`Convert the VarID to a DWord
VarID_DWord = Asc(Left$(VarID$,1))+(256*Asc(Left$(Mid$(VarID$,2),1)))+(65536*Asc(Left$(Mid$(VarID$,3),1)))+(16777216*Asc(Right$(VarID$,1)))
`Determine if Memblock 243 already exists and if it was created by this function
`If the Memblock does not exist, create it.
If Memblock Exist(243)
If Memblock Byte(243,0)<>243 Then Delete Memblock 243
Endif
If Memblock Exist(243)=0
Make Memblock 243,9
Write Memblock Byte 243,0,243
Write Memblock DWord 243,1,VarID_DWord
Write Memblock DWord 243,5,VarValue
ExitFunction
Endif
`At this point, we have a valid memblock created by this function.
`Next, determine if the Variable had been previously created and set pointer
MBSize =Get Memblock Size(243)
Flag=0
For i = 1 to MBSize-8 Step 8
If VarID_DWord = Memblock DWord(243,i)
Flag=1
Endif
If Flag=1 Then Exit
Next i
pointer = i
`The easy part, if the Variable already exists, simply replace the old data.
If Flag = 1
Write Memblock DWord 243,pointer+4,VarValue
ExitFunction
Endif
`The hard part. We have to make the memblock bigger.
If Memblock Exist(242) then Delete Memblock 242
Make Memblock 242,MBSize+8
Copy Memblock 243,242,0,0,MBSize
Delete Memblock 243
Make Memblock 243, MBSize+8
Copy Memblock 242,243,0,0,MBSize+8
Delete Memblock 242
`Now we can write the new data
Write Memblock DWord 243,pointer,VarID_DWord
Write Memblock DWord 243,pointer+4,VarValue
EndFunction
Function GetStaticVar(VarID$)
RetVal=-1:` Default error flag for the return value since there is no negative number functionality.
If VarID$="" or Len(VarID$)>4
ExitFunction RetVal:`Invalid VarID$ name
Else
VarID$=VarID$ + Space$(4-Len(VarID$))
EndIf
VarID_DWord = Asc(Left$(VarID$,1))+(256*Asc(Left$(Mid$(VarID$,2),1)))+(65536*Asc(Left$(Mid$(VarID$,3),1)))+(16777216*Asc(Right$(VarID$,1)))
If Memblock Exist(243)=0 Then ExitFunction RetVal:` The variable was not created or the memblock has been erased.
If Memblock Byte(243,0)<>243 Then ExitFunction RetVal:` Memblock is there but was not created by StaticVar()
`Everything checks out okay, look for the variable name
MBSize =Get Memblock Size(243)
Flag=0
For i = 1 to MBSize-8 Step 8
If VarID_DWord = Memblock DWord(243,i)
Flag=1
Endif
If Flag=1 Then Exit
Next i
pointer = i+4
If Flag = 1 Then RetVal=Memblock DWord(243,pointer)
EndFunction RetVal
Same thing in under 40 lines:
Sync On
Sync Rate 40
AutoCam Off
Position Camera 0,0,50,-20
Make Object Plain 100,1000,1000
Pitch Object Down 100,90
Color Object 100,RGB(255,255,0)
Ghost Object On 100
`Create a few random balls.
NumBalls=rnd(20)+20
For i = 1 to NumBalls
Size=rnd(10)+10
Make Object Sphere i,rnd(5)+5
x=rnd(200)-100:y=rnd(100)+50:z=rnd(100)+50
Position Object i, x,y,z
Color Object i,rgb(rnd(255),rnd(255),rnd(255))
Next i
dim v#(NumBalls)
gravity#=0.02
Do
For i = 1 to NumBalls
y#=object position y(i)
inc y#,v#(i)
dec v#(i),gravity#
if y#<0 then y#=0:v#(i)=v#(i)*-1
position object i,object position x(i),y#,object position z(i)
Next i
If RightKey() Then Turn Camera Right 1
If LeftKey() Then Turn Camera Left 1
Sync
Loop
`***End of Demo***
Nevertheless, nice effect! You could also add in a scale object command when the ball bounces to make them kind of squidgy!
