Code archives/Graphics/Rebounding balls
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
| Just did this to re-acquaint myself with the basics of collision detection for rebounding balls. Creates several balls, angled walls and bollards for the balls to bounce off | |||||
;*****************************************
;Collision detection and rebounding angles
;-----------------------------------------
;Andrew Constant ukandrewc@aol.com
;-----------------------------------------
;There are faster ways to detect line/ball
;collisions, but this way, you can have
;any line position & any sprite shape
;*****************************************
Const SW=640
Const SH=480
Type IMG
Field hi,ix,iw
Field x#,y#,xi#,yi#
End Type
Type PNT
Field hi,ix
Field x,y
End Type
Type OBS
Field hi,ix,a
Field x,y,w,h
Field x1,y1,x2,y2
End Type
;Title bits
Global t$="Angles, balls and walls"
Global ts=-StringWidth(t$)
Global tx=0
;Image and wall indeces
Global bc=0
Global wc=0
Global pc=0
Global sp=3
Global repCount
Global oik=LoadSound("oik.wav")
Global wait=CreateTimer(30)
SeedRnd MilliSecs()
Graphics SW,SH
;Create some random balls
For c=1 To 5
CreateBall(64,Rand(128,255),Rand(128,255))
Next
;Create some bollards
Restore BollardData
For c=1 To 5
Read x,y
CreatePoint x,y,255,255,0
Next
.BollardData
Data 200,150
Data 250,300
Data 400,350
Data 100,400
Data 550,070
Restore WallData
For c=1 To 9
Read x1,y1,x2,y2
Createwall x1,y1,x2,y2,Rand(128,255),Rand(128,255),192
Next
.WallData
Data 010,010,629,010
Data 629,010,629,469
Data 629,469,010,469
Data 010,469,010,010
Data 150,70,550,150
Data 580,220,520,400
Data 200,220,500,220
Data 200,420,450,400
Data 170,350,70,150
;enable double buffering
SetBuffer BackBuffer()
;loop until ESC pressed...
While Not KeyDown(1)
MoveBalls()
While KeyDown(57)
;Pause while space pressed
Wend
Wend
End
Function MoveBalls()
c=WaitTimer(wait)
Cls
Color 255,255,255
;Draw walls
For wall.obs=Each OBS
DrawImage wall\hi,wall\x,wall\y
Text wall\x+(wall\w/2),wall\y+(wall\h/2),Str$(wall\a),True,True
Text wall\x1,wall\y1,"*",True,True
Text wall\x2,wall\y2,"*",True,True
Next
;Draw rebound points
For point.pnt=Each PNT
DrawImage point\hi,point\x,point\y
Text point\x,point\y,point\ix,True,True
Next
;Draw & check balls for collision
For ball.img=Each IMG
ball\x=ball\x+ball\xi
ball\y=ball\y+ball\yi
DrawImage ball\hi,ball\x,ball\y
;Draw line in front of ball
ang=ATan2(ball\yi,ball\xi)
cx=ball\x+16
cy=ball\y+16
Line cx,cy,cx+15*Cos(ang),cy+15*Sin(ang)
Text cx,cy,ang,True,True
collide=False
;Check other balls
For ball2.Img=Each Img
If ball2<>ball Then
If ImagesCollide(ball\hi,ball\x,ball\y,0,ball2\hi,ball2\x,ball2\y,0) Then
ang=ATan2(ball\y-ball2\y,ball\x-ball2\x)
collide=True
EndIf
EndIf
Next
;Check rebound points
If collide=False Then
For point.pnt=Each PNT
If ImagesCollide(ball\hi,ball\x,ball\y,0,point\hi,point\x,point\y,0) Then
ang=ATan2(ball\y-point\y,ball\x-point\x)
collide=True
EndIf
Next
EndIf
;Check walls
If collide=False Then
For wall.obs=Each OBS
;Check x1,y1 end points
If ImageRectCollide(ball\hi,ball\x,ball\y,0,wall\x1,wall\y1,1,1) Then
;Rebound away from line but keep some ball direction
ang=ATan2(wall\y1-wall\y2,wall\x1-wall\x2)+(ang/2)
repCount=RepCount+1
collide=True
;Check x2,y2 end points
ElseIf ImageRectCollide(ball\hi,ball\x,ball\y,0,wall\x2,wall\y2,1,1) Then
;Rebound away from line but keep some ball direction
ang=ATan2(wall\y2-wall\y1,wall\x2-wall\x1)+(ang/2)
collide=True
;Check mid line
ElseIf ImagesCollide(ball\hi,ball\x,ball\y,0,wall\hi,wall\x,wall\y,0) Then
;Rebound compound of ball and wall angles
ang=-ang+(wall\a*2)
collide=True
EndIf
Next
EndIf
If collide Then
;New ball direction
ball\xi=sp*Cos(ang)
ball\yi=sp*Sin(ang)
;Do extra move away
ball\x=ball\x+ball\xi
ball\y=ball\y+ball\yi
EndIf
Next
tx=tx+2
If tx=640 Then tx=ts
Color 255,255,0
Text tx,12,t$
;swap front and back buffers
Flip
End Function
;*************************
Function CreateBall(r,g,b)
bc=bc+1
ball.img = New IMG
ball\x=50
ball\y=50
ang=Rand(0,360)
ball\xi=sp*Cos(ang)
ball\yi=sp*Sin(ang)
ball\hi=CreateImage(32,32)
SetBuffer ImageBuffer(ball\hi)
;Anti-alias it a bit
Color 96,96,96
Oval 0,0,32,32
;Draw main ball
Color r,g,b
Oval 1,1,30,30
Color 0,0,0
;Text 16,16,Str$(bc),True,True
End Function
;*************************************
Function CreateWall(x1,y1,x2,y2,r,g,b)
wall.obs=New OBS
wc=wc+1
wall\ix=wc
wall\y1=y1
wall\y2=y2
wall\x1=x1
wall\x2=x2
;Size of the image
w=Abs(x1-x2)
h=Abs(y1-y2)
wall\w=w
wall\h=h
;Adjust from real world co-ords
If x1>x2 Then
wall\x=x2
x1=w:x2=0
Else
wall\x=x1
x2=w:x1=0
EndIf
If y1>y2 Then
wall\y=y2
y1=h:y2=0
Else
wall\y=y1
y2=h:y1=0
EndIf
;Keep the line's angle
a=ATan2(y2-y1,x2-x1)
wall\a=a
;Adjust To give correct rebound
If a>0 And a<90 Then wall\a=a
If a>90 And a<180 Then wall\a=a-180
;Create & draw wall image
wall\hi=CreateImage(w+1,h+1)
SetBuffer ImageBuffer(wall\hi)
Color r,g,b
Line x1,y1,x2,y2
End Function
;******************************
Function CreatePoint(x,y,r,g,b)
point.pnt=New PNT
pc=pc+1
point\ix=pc
point\x=x
point\y=y
point\hi=CreateImage(1,1)
SetBuffer ImageBuffer(point\hi)
;Draw the point
Color r,g,b
Plot 0,0
End Function |
Comments
None.
Code Archives Forum