Collider Worms

August 29 2010 at 7:47 PM
R

'* this also makes a cool little screensaver
'* this is a program i wrote just messing around, however, it follows all the physical laws concerning
'* mass and elastic collisions. in order to show z-plane travel, i made the balls smaller according to a
'* linear scale -- that is, that the farther the spheres are back in the z-plane (low z-numbers), the
'* smaller the spere appears. to get a more accurate visual of this, use same-sized spheres, rather than
'* randomly sized ones. also, in order to increase the likelihood of collisions, use a smaller z-plane distance
'* or make it 2-d (either by setting the flag for 2d to true or eliminating the code referring to z-plane)
'* v2 now features COR -- coefficient of restitution, which in a nutshell describes how "sticky" or "repulsive"
'* an object is to collision. Low COR's essentially stick together (think steel ball colliding into soft butter), while
'* high COR's bounce like steel balls off an equally hard steel floor. The COR must be a number from 0 to 1.
'* same as before, works well for n=256 balls, but once past 1000, gets pretty syrupy. I just added the COR
'* code today. So there you have it. Anyone who wants to add point light sources and do Phong shading can
'* make this program REALLY shine, especially if they can make it run decently for n=16 ball system.

TYPE BallRec
px AS DOUBLE
py AS DOUBLE
pz AS DOUBLE
vx AS DOUBLE
vy AS DOUBLE
vz AS DOUBLE
Mass AS DOUBLE
colr AS INTEGER
COR AS DOUBLE
END TYPE
const MaxScreenX=640
const MinScreenX=0
const MinScreenY=0
const MaxScreenY=480
const MinScreenZ=0
const MaxScreenZ=100
const Minvx=0
const Maxvx=16
const Minvy=0
const Maxvy=16
const Minvz=0

const Maxvz=16
const aspectR=1
schermo = _NEWIMAGE(Maxscreenx, Maxscreeny, 256)
SCREEN schermo: _FULLSCREEN
VIEW (Minscreenx, Minscreeny)-(Maxscreenx - 1, Maxscreeny - 1), 0
NBalls% = 255
DIM b(NBalls%) AS BallRec
FOR i& = 0 TO NBalls%
b(i&).px = Minscreenx + RND * (Maxscreenx - radius)
b(i&).py = Minscreeny + RND * (Maxscreeny - radius)
b(i&).pz = Minscreenz + RND * (Maxscreenz - radius)
b(i&).vx = Minvx + RND * (Maxvx - Minvx) * (-1 ^ i& MOD 2)
b(i&).vy = Minvy + RND * (Maxvy - Minvy) * (-1 ^ i& MOD 2)
b(i&).vz = Minvz + RND * (Maxvz - Minvz) * (-1 ^ i& MOD 2)
b(i&).Radius = 16 'INT(RND * 16) + 1
b(i&).Mass = RND * 2 + 1
b(i&).colr = INT(RND * 255) + 1
b(i&).COR = INT(RND * 1)
NEXT
just2d% = -1
DO
FOR i& = 0 TO NBalls%
FOR j& = 0 TO NBalls% - 1
IF i& <> j& THEN
IF b(i&).px + b(i&).vx - (b(j&).px + b(j&).vx) > b(i&).Radius + b(j&).Radius THEN
ELSE
IF b(i&).py + b(i&).vy - (b(j&).py + b(j&).vy) > b(i&).Radius + b(j&).Radius THEN
ELSE
IF (b(i&).pz + b(i&).vz - (b(j&).pz + b(j&).vz) <= b(i&).Radius + b(j&).Radius) AND (NOT just2d%) THEN
ELSEIF NOT just2d% AND (b(i&).pz + b(i&).vz - (b(j&).pz + b(j&).vz) <= b(i&).Radius + b(j&).Radius) THEN
SELECT CASE RND
CASE IS < 1 / 2
CalcVelocities b(), i&, j&
CASE ELSE
CalcVelocitiesCOR b(), i&, j&
END SELECT
EXIT FOR
END IF
END IF
END IF
END IF
NEXT
CIRCLE (b(i&).px, b(i&).py), (b(i&).Radius * b(i&).pz / Maxscreenz), b(i).colr, 0, 6.28, Aspectr
IF b(i&).px + b(i&).vx < Minscreenx THEN
b(i&).vx = -b(i&).vx
ELSEIF b(i&).px + b(i&).vx > Maxscreenx THEN
b(i&).vx = -b(i&).vx
ELSE
b(i&).px = b(i&).px + b(i&).vx
END IF

IF b(i&).py + b(i&).vy < Minscreeny THEN
b(i&).vy = -b(i&).vy
ELSEIF b(i&).py + b(i&).vy > Maxscreeny THEN
b(i&).vy = -b(i&).vy
ELSE
b(i&).py = b(i&).py + b(i&).vy
END IF

IF b(i&).pz + b(i&).vz < Minscreenz THEN
b(i&).vz = -b(i&).vz
ELSEIF b(i&).pz + b(i&).vz > Maxscreenz THEN
b(i&).vz = -b(i&).vz
ELSE
b(i&).pz = b(i&).pz + b(i&).vz
END IF
CIRCLE (b(i&).px, b(i&).py), (b(i&).Radius * b(i&).pz / Maxscreenz), b(i&).colr, 0, 6.28, Aspectr
PAINT (b(i&).px, b(i&).py), _RGB32(16 * b(i&).colr, 8 * b(i&).colr, b(i&).colr)
NEXT
k\$ = INKEY\$
IF k\$ > "" THEN
EXIT DO
END IF
LOOP
SYSTEM
SUB CalcVelocities (b() AS BallRec, i&, j&)
temp1 = b(i&).vx
temp2 = b(j&).vx
totalMass = (b(i&).Mass + b(j&).Mass)
b(i&).vx = (temp1 * (b(i&).Mass - b(j&).Mass) + (2 * b(j&).Mass * temp2)) / totalMass
b(j&).vx = (temp2 * (b(j&).Mass - b(i&).Mass) + (2 * b(i&).Mass * temp1)) / totalMass
temp1 = b(i&).vy
temp2 = b(j&).vy
b(i&).vy = (temp1 * (b(i&).Mass - b(j&).Mass) + (2 * b(j&).Mass * temp2)) / totalMass
b(j&).vy = (temp2 * (b(j&).Mass - b(i&).Mass) + (2 * b(i&).Mass * temp1)) / totalMass
temp1 = b(i&).vz
temp2 = b(j&).vz
b(i&).vz = (temp1 * (b(i&).Mass - b(j&).Mass) + (2 * b(j&).Mass * temp2)) / totalMass
b(j&).vz = (temp2 * (b(j&).Mass - b(i&).Mass) + (2 * b(i&).Mass * temp1)) / totalMass
END SUB

'* Normalize COR's of 2 objects to 1, otherwise Conservation of Momentum is violated -- adding energy to the closed system.
'* According to the great physicists out there, roughly half of all collisions in a system are inelastic to some extent.

SUB CalcVelocitiesCOR (b() AS BallRec, i&, j&) ' * varying levels of elasticity from 0 (perfectly inelastic) to 1 (perfectly elastic)
vx1 = b(i&).Mass * b(i&).vx + b(j&).Mass * b(j&).vx + b(j&).Mass * ((b(i&).COR + b(j&).COR) / 2) * (b(i&).vx - b(j&).vx)
vx2 = b(i&).Mass * b(i&).vx + b(j&).Mass * b(j&).vx + b(i&).Mass * ((b(i&).COR + b(j&).COR) / 2) * (b(j&).vx - b(i&).vx)
b(i&).vx = vx1
b(j&).vx = vx2
vy1 = b(i&).Mass * b(i&).vy + b(j&).Mass * b(j&).vy + b(j&).Mass * ((b(i&).COR + b(j&).COR) / 2) * (b(i&).vy - b(j&).vy)
vy2 = b(i&).Mass * b(i&).vy + b(j&).Mass * b(j&).vy + b(i&).Mass * ((b(i&).COR + b(j&).COR) / 2) * (b(j&).vy - b(i&).vy)
b(i&).vy = vy1
b(j&).vy = vy2
vz1 = b(i&).Mass * b(i&).vz + b(j&).Mass * b(j&).vz + b(j&).Mass * ((b(i&).COR + b(j&).COR) / 2) * (b(i&).vz - b(j&).vz)
vz2 = b(i&).Mass * b(i&).vz + b(j&).Mass * b(j&).vz + b(i&).Mass * ((b(i&).COR + b(j&).COR) / 2) * (b(j&).vz - b(i&).vz)
b(i&).vz = vz1
b(j&).vz = vz2
END SUB

 Respond to this message
 Response Title Author Date * You should mention QB64 is necessary to run that or change it to QB. Clippy Aug 30, 2010 Re: Collider Worms codeguy Sep 6, 2010 * Also it uses _RGB to PAINT Clippy Sep 6, 2010