I made number six a bit more musical.
remstart
==============================================================
= Title : Bouncing Balls using Sphere to Sphere Collision and Sphere to Polygon Collision
= Author : Latch
= Date : 04/19/2012
= Update :
= Version: .01
==============================================================
Comments
05/11/2012
Thie example demonstrates Sphere to Sphere collision.
The collision objects do not need to be set up in this
case as this is a sort of "on the fly" function. The
basic on which the balls bounce is set up for poygon collision
in order to detect the precise point of impact.
There is a bit of a bottle neck in this example in the
_sphere_to_sphere routine. Every sphere is tested against
every other sphere each iteration which is just way too much
in a BASIC loop. A better alternative, though I haven't
tested it, might be to set up the spheres as polygon
collision objects and test for regular collision using
0 as the second parameter so that the check for all collision
objects happens within the DLL.
==============================================================
remend
rem =============================================================
rem = SET UP DISPLAY
rem =============================================================
autocam off
set display mode 800,600,32
sync on
sync rate 40
autocam off
hide mouse
randomize timer()
rem =============================================================
rem = MAIN
rem =============================================================
_main:
gosub _init
ink rgb(255,255,255),0
do
text 0,0,"Cam x = "+Str$(camera position x())
text 0,20,"Cam y = "+Str$(camera position y())
text 0,40,"Cam z = "+Str$(camera position z())
text 0,60,"Polygons = "+str$(statistic(1))
text 0,80,"FPS = "+str$(screen fps())
text 0,100,"normal x = "+str$(nx#)
text 0,120,"normal z = "+str$(nz#)
text 0,160,"Move around the perimeter with A and D"
text 0,180,"Look Around with MOUSE"
text 0,200,"W or S to look at Center"
text 0,240,str$(a#)+", "+str$(b#)+": "+str$(c#)
gosub _bounce
gosub _sphere_to_sphere
gosub _move_camera
sync
loop
end
rem =============================================================
rem = SUBROUTINES - PROCEDURES
rem =============================================================
_initialize_coldet:
rem load in the DBC library files
#INCLUDE "include_files\inc_dbccoldet.dba"
rem set up the arrays needed by the library to store memblock info
rem reserve memblocks to return most values
dim colmem(3,2)
colmem(1,1) = 247
make memblock colmem(1,1),12 : rem store 3 floats if necessary
colmem(1,2) = get memblock ptr(colmem(1,1))
colmem(2,1) = 248
make memblock colmem(2,1),18*4 : rem store 18 floats
colmem(2,2) = get memblock ptr(colmem(2,1))
colmem(3,1) = 249
make memblock colmem(3,1),10*4 : rem store 40 floats
colmem(3,2) = get memblock ptr(colmem(3,1))
rem store the working directory
cdir$=get dir$()
rem load in the dll
coldll=1
cd "bin"
load dll "dbcwithcoldet.dll",coldll
rem return to working directory
set dir cdir$
rem initialize the collision DLL with the maximum number of objects
rem needed. It's okay to leave this at it's default by setting it to 0
rem If the function is successful it will return the maximum number of objects,
rem if not 0 is returned
maxCollisionObjects=0
maxCollisionOBjects=coldetInitalize(coldll,maxCollisionObjects)
return
`================================================================
_init:
rem initialize collision
gosub _initialize_coldet
rem create the environment and objects
gosub _load_environment
gosub _make_ball
rem setup collision
gosub _setup_collision_objects
rem camera
mang#=180
yrotate camera 90
return
`================================================================
_make_ball:
rem create a few arrays to store ball characteristics
ball=2
ballct=4
rem id to store object number in
dim id(ballct)
for n=1 to ballct
id(n)=ball+n
next n
dim bounce#(ballct)
dim pos#(ballct,2)
dim ang#(ballct,2)
dim bspeed#(ballct,2)
rem make some balls to bounce around
load sound "media\Hit metal.wav",1
for obj=1 to ballct
gosub _checkerboard
make object sphere id(obj),100
texture object id(obj),id(obj)
scale object texture id(obj),2,1
set object ambient id(obj),rgb(32,32,32)
set object diffuse id(obj),rgb(255,255,255)
set object specular id(obj),rgb(255,255,255),50
pos#(obj,0)=rnd(object size x(1))-(object size x(1)/2)
pos#(obj,1)=rnd(1000)+100
pos#(obj,2)=rnd(object size z(1))-(object size z(1)/2)
position object id(obj),pos#(obj,0),pos#(obj,1),pos#(obj,2)
bspeed#(obj,1)=-20
bounce#(obj)=0
rem create a sound
clone sound obj+1,1
next obj
rem make shadows
gosub _create_shadows
radius#=50
return
`================================================================
_create_shadows:
bmp=1
while bitmap exist(bmp)
inc bmp
endwhile
create bitmap bmp,300,300
cls rgb(255,255,255)
for r=0 to 127
ink rgb(r+128,r+128,r+128),0
circle 127,127,r
circle 127,128,r
next r
get image 1000,0,0,256,256
sync
for obj=1000 to 1000+ballct
make object plain obj,100,100
texture object obj,1000
set object emissive obj,rgb(255,255,255)
ghost object on obj,1
set object obj,1,1,0
set object rotation zyx obj
next obj
delete bitmap bmp
return
`================================================================
_checkerboard:
bmp=1
while bitmap exist(bmp)
inc bmp
endwhile
create bitmap bmp,512,512
`cls rgb(255,255,255)
ink RGB(rnd(255),rnd(255),rnd(64)),0
xstart=32
for y=0 to 224 step 32
for x=xstart to 224 step 64
box x,y,x+32,y+32
next x
xstart=32-xstart
next y
get image id(obj),0,0,256,256
sync
delete bitmap bmp
return
`================================================================
_load_environment:
rem load the environment
cd "media"
load object "basin.x",1
rem brighten up the environment a bit
set object diffuse 1,rgb(255,255,255)
set object ambient 1,rgb(64,64,64)
set object specular 1,RGB(177,165,78),50
set directional light 0,1,-1,1
rem return to working directory
set dir cdir$
return
`================================================================
_setup_collision_objects:
rem After the objects are created or loaded, setup the collision environment
rem by adding any objects that need to be collided with
coldetSetupObject(coldll,1,0)
coldetUpdateObject(coldll,1,0.0,0.0,0.0,object position x(1),object position y(1),object position z(1))
rem we won't setup the collision for the ball because we are
rem just going to use sphere collision at it's location
return
`================================================================
_bounce:
for obj=1 to ballct
pos#(obj,0)=pos#(obj,0)+bspeed#(obj,0)
pos#(obj,1)=pos#(obj,1)+(bspeed#(obj,1)*bounce#(obj))
pos#(obj,2)=pos#(obj,2)+bspeed#(obj,2)
position object id(obj),pos#(obj,0),pos#(obj,1),pos#(obj,2)
xang#=wrapvalue(object angle x(id(obj))+ang#(obj,0))
yang#=wrapvalue(object angle y(id(obj))+ang#(obj,1))
zang#=wrapvalue(object angle z(id(obj))+ang#(obj,2))
rotate object id(obj),xang#,yang#,zang#
rem if any objects have bounce out reposition them
if pos#(obj,1) < -200
pos#(obj,0)=rnd(1400)-700
pos#(obj,1)=1000
pos#(obj,2)=rnd(1400)-700
position object id(obj),pos#(obj,0),pos#(obj,1),pos#(obj,2)
bounce#(obj)=0
bspeed#(obj,0)=0
bspeed#(obj,1)=-20
bspeed#(obj,2)=0
endif
rem adjust bounce direction
if bspeed#(obj,1) > 0
bounce#(obj)=bounce#(obj)-.025
if bounce#(obj)<=0
bspeed#(obj,1)=0-bspeed#(obj,1)
bounce#(obj)=0
endif
endif
if bspeed#(obj,1) < 0
bounce#(obj)=bounce#(obj)+.025
`if bounce#(obj)>=1 then bounce#(obj)=1
endif
rem check for sphere to object collision
if coldetSphereObjectCollision(coldll,1,pos#(obj,0),pos#(obj,1),pos#(obj,2),radius#)
rem play metal sound impact
rem The further the ball is from the centre the higher the pitch of the sound, like a steel drum.
a#=pos#(obj,0) : b#=pos#(obj,2)
c# = (a#^2 + b#^2)^.5
c# = c#*20
set sound speed obj,2000+c#
play sound obj
rem use the collision normals of the basin to determine the bounce direction
nx#=coldetgetT1NormalX(coldll)
if abs(nx#)<.05
nx#=nx#+(1.0/(rnd(20)+1))*(rnd(2)-1)
endif
nz#=coldetgetT1NormalZ(coldll)
if abs(nz#)<.05
nz#=nz#+(1.0/(rnd(20)+1))*(rnd(2)-1)
endif
pos#(obj,1)=pos#(obj,1)-(bspeed#(obj,1)*bounce#(obj))
bspeed#(obj,1)=0-bspeed#(obj,1)
bspeed#(obj,0)=nx#*15
bspeed#(obj,2)=nz#*15
ang#(obj,0)=nx#*20
ang#(obj,2)=nz#*20
bounce#(obj)=1
endif
rem place the shadows
gosub _place_shadow
next obj
return
`================================================================
_sphere_to_sphere:
remstart
using the sphere to sphere collision function, we can make the spheres
react to colliding with each other
remend
for obj1=1 to ballct
for obj2=1 to ballct
rem eliminate the current sphere from the check
if obj2 ! obj1
rem test sphere to sphere collision
hit=coldetSphereSphereCollision(coldll,pos#(obj1,0),pos#(obj1,1),pos#(obj1,2),radius#,pos#(obj2,0),pos#(obj2,1),pos#(obj2,2),radius#)
if hit
rem spheres bouncing off of each other
ang#=wrapvalue(atanfull(pos#(obj1,0)-pos#(obj2,0) , pos#(obj1,2)-pos#(obj2,2)))
speed#=sqrt((bspeed#(obj1,0)*bspeed#(obj1,0))+(bspeed#(obj1,2)*bspeed#(obj1,2)))
bspeed#(obj1,0)=newxvalue(0,ang#,speed#)
bspeed#(obj1,2)=newzvalue(0,ang#,speed#)
rem exit the inner loop
exit
endif
endif
next obj2
next obj1
return
`================================================================
_move_camera:
rl=(keystate(32)-keystate(30))
if keystate(17) or keystate(31)
point camera 0,440,0
endif
inc mang#,rl
camx#=700*cos(mang#)
camz#=700*sin(mang#)
position camera camx#,440,camz#
yang#=wrapvalue(camera angle y()+mousemovex())
xang#=wrapvalue(camera angle x()+mousemovey())
`move camera (upkey()-downkey())*5
rotate camera xang#,yang#,0
return
`================================================================
_place_shadow:
rem drop a ray from the ball to the metal pan
coldetRayObjectCollision(coldll,1,pos#(obj,0),pos#(obj,1),pos#(obj,2),pos#(obj,0),pos#(obj,1)-1200,pos#(obj,2),1,segmin#,segmax#)
rem position the shadow at the hit point
cx#=coldetgetcollisionx(coldll)
cy#=coldetgetcollisiony(coldll)
cz#=coldetgetcollisionz(coldll)
normx#=coldetgett1normalx(coldll)
normy#=coldetgett1normaly(coldll)
normz#=coldetgett1normalz(coldll)
position object 1000+obj,cx#,cy#+10,cz#
point object 1000+obj,cx#-normx#*10,cy#-normy#*10,cz#-normz#*10
if pos#(obj,1) > 99
scale object 1000+obj,12000.0/pos#(obj,1),12000.0/pos#(obj,1),100
endif
return
`================================================================
This is quite a significant addition to DBC mate!
(Your DLL not my plinky-plonky noises
)
You should get a mention in the newsletter for this.
WARNING: The above comment may contain sarcasm.
