QB / QB64 Discussion Forum     RULES     Other Subforums, Links and Downloads    Index of Threads

 


  Next Topic >>Return to Index  

Collider Worms

August 29 2010 at 7:47 PM
  (Login codeguy)
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
Radius 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%
'radius = RND * 16
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   
AuthorReply

(Login burger2227)
R

* You should mention QB64 is necessary to run that or change it to QB.

August 30 2010, 8:42 PM 


 
 Respond to this message   
codeguy
(Login codeguy)
R

Re: Collider Worms

September 6 2010, 5:38 PM 

the only things that make this qb64-specific are the _newimage and _fullscreen, which can just be changed to a 640 * 480 pixel screen for the very same effect. sorry if anyone tried running this in qbxx and got an error! other than those things, it runs fine with those 2 things removed.

 
 Respond to this message   
Clippy
(Login burger2227)
R

* Also it uses _RGB to PAINT

September 6 2010, 10:55 PM 


 
 Respond to this message   
Current Topic - Collider Worms
  Next Topic >>Return to Index  
 Copyright © 1999-2014 Network54. All rights reserved.   Terms of Use   Privacy Statement