Code archives/Graphics/Rebounding balls

This code has not been declared by its author to be Public Domain code, and therefore should not be assumed to be so.

Download source code

Rebounding balls by UKAndrewC
(Posted 25 years ago)
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