Collision detection circle <-> rectangle with position correction

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
badidea
Posts: 2591
Joined: May 24, 2007 22:10
Location: The Netherlands

Collision detection circle <-> rectangle with position correction

Post by badidea »

A collision detection routine (and example) where the position of the circle (at the mouse position) is corrected when colliding with a rectangle.

The routine is a bit long, probably room for improvement. Also, when the mouse-cursor is inside the rectangle, there is a preference for on top or below instead of left or right.

Code: Select all

const as integer SCRN_W = 800, SCRN_H = 600

sub clearScreen()
	line(0, 0)-(SCRN_W-1, SCRN_H-1), &h00000000, bf
end sub

sub printAt(x as integer, y as integer, text as string)
	locate y, x: print text;
end sub

'-------------------------------------------------------------------------------

type xy_int
	dim as integer x, y
end type

'-------------------------------------------------------------------------------

type mouse_type
	dim as integer x, y, wheel, buttons
end type

'-------------------------------------------------------------------------------

type rect_type 'NOT AABB
	dim as xy_int p1 'position
	dim as xy_int p2 'position
	dim as ulong c
end type

sub drawRect(rect as rect_type)
	line(rect.p1.x, rect.p1.y)-(rect.p2.x, rect.p2.y), rect.c, b
end sub

'-------------------------------------------------------------------------------

type circ_type
	dim as integer x, y, r
	dim as ulong c
end type

sub drawCircle(circ as circ_type)
	circle(circ.x, circ.y), circ.r, circ.c
end sub

'-------------------------------------------------------------------------------

'rect.p1 must be top-left of rect.p2
function collisionCR(circ as circ_type, rect as rect_type) as xy_int
	dim as xy_int rectAxis, rectHalfSize, centerDist

	rectAxis.x = (rect.p1.x + rect.p2.x) \ 2
	rectAxis.y = (rect.p1.y + rect.p2.y) \ 2

	centerDist.x = rectAxis.x - circ.x 
	centerDist.y = rectAxis.y - circ.y

	rectHalfSize.x = (rect.p2.x - rect.p1.x) \ 2
	rectHalfSize.y = (rect.p2.y - rect.p1.y) \ 2

	'case: not even close
	if abs(centerDist.x) > (rectHalfSize.x + circ.r) then return type(0, 0)
	if abs(centerDist.y) > (rectHalfSize.y + circ.r) then return type(0, 0)

	'case: circle fully above or below rectangle
	if abs(centerDist.x) <= rectHalfSize.x then
		if circ.y > rectAxis.y then
			'circle below rect
			return type(0, centerDist.y + (rectHalfSize.y + circ.r))
		else
			'circle above rect
			return type(0, centerDist.y - (rectHalfSize.y + circ.r))
		end if
	end if

	'case: circle fully left or right of rectangle
	if abs(centerDist.y) <= rectHalfSize.y then
		if circ.x > rectAxis.x then
			'circle below rect
			return type(centerDist.x + (rectHalfSize.x + circ.r), 0)
		else
			'circle above rect
			return type(centerDist.x - (rectHalfSize.x + circ.r), 0)
		end if
	end if

	'case: at a corner
	dim as xy_int rectCorner
	dim as single centerDistLen, edgeDistLen, factor

	rectCorner.x = iif(circ.x > rectAxis.x, rect.p2.x, rect.p1.x) 'right corner 
	rectCorner.y = iif(circ.y > rectAxis.y, rect.p2.y, rect.p1.y) 'bottom corner

	centerDist.x = rectCorner.x - circ.x
	centerDist.y = rectCorner.y - circ.y
	centerDistLen = sqr(centerDist.x * centerDist.x + centerDist.y * centerDist.y)
	edgeDistLen = centerDistLen - circ.r
	
	'center distance < circle raduis?
	if edgeDistLen < 0 then
		factor = edgeDistLen / centerDistLen
		return type(centerDist.x * factor, centerDist.y * factor) 
	end if

	'case: no correction
	return type(0, 0)
end function

'-------------------------------------------------------------------------------

dim as mouse_type mouse 
dim as circ_type circ = (200, 100, 70, &h00ff0088)
dim as rect_type rect = (200, 190, 520, 310, &h0088bb00)

dim as xy_int correction

randomize timer

screenres SCRN_W, SCRN_H, 32
width SCRN_W \ 8, SCRN_H \ 16 

while inkey <> chr(27)
	getmouse(mouse.x, mouse.y, mouse.wheel, mouse.buttons)
	circ.x = mouse.x
	circ.y = mouse.y
	correction = collisionCR(circ, rect)
	circ.x += correction.x
	circ.y += correction.y
	screenlock
	clearScreen
	drawCircle(circ)
	drawRect(rect)
	printAt 2, 2, "<esc> to quit"
	printAt 2, 4, "correction.x: " + str(correction.x) + " "
	printAt 2, 6, "correction.y: " + str(correction.y) + " "
	screenunlock
	sleep 1, 1
wend

'resources:
'https://stackoverflow.com/questions/401847/circle-rectangle-collision-detection-intersection
'https://www.freebasic.net/forum/viewtopic.php?f=7&t=24510
h4tt3n
Posts: 698
Joined: Oct 22, 2005 21:12
Location: Denmark

Re: Collision detection circle <-> rectangle with position correction

Post by h4tt3n »

If you want to take it a step further, then look at these polygon - polygon collision detection algos by RelSoft. THey use the separating axis theorem (SAT), which is one of the commonly used algos in game physics.

viewtopic.php?t=16038&highlight=sat
mrminecrafttnt
Posts: 131
Joined: Feb 11, 2013 12:23

Re: Collision detection circle <-> rectangle with position correction

Post by mrminecrafttnt »

I made a little Minigame, based on your code with 2D cubes, have fun :D

Code: Select all

type cube_2d
    x as integer
    y as integer
    c as integer
    size as double
    declare sub draw
    declare function is_hit(cube as cube_2d) as integer
end type


'draws our cube
sub cube_2d.draw
    line(x,y)-(x+size,y+size),c,bf
end sub

'checks if cube colodies with another cube
function cube_2d.is_hit(cube as cube_2d) as integer
    if x+size >= cube.x and x <= cube.x+cube.size and y+size >= cube.y and y <= cube.y+cube.size then 
        return 1 
    else 
        return 0
    end if
end function


'example

sub add_cube(cubetable() as cube_2d)
    redim preserve cubetable(ubound(cubetable)+1)
    with cubetable(ubound(cubetable))
        .x= int(rnd*640)+1
        .y= int(rnd*480)+1
        .c= int(rnd*16)+16
        .size = int(rnd*64)
    end with
end sub




'setup screen
screenres 640,480

'setup cubes
dim as cube_2d cubes(any),user

'setup for mouseparameter
dim as integer mx,my
setmouse 320,240,0

'setup for screenpage parameter
dim as integer scr0 = 0,scr1 = 1

'setup for cubes
'user cube
user.size = 16
user.c = 4

'create testcube
    for i as integer = 0 to 20
        add_cube(cubes())
    next
    
dim as integer cubes_to_kill = ubound(cubes) + 1, killed_cubes

do
    getmouse mx,my
    
    'out of map detectection
    with user
        if .x + .size > 640 then setmouse mx-.size,my
        if .y + .size > 480 then setmouse mx,my-.size
        .x = mx
        .y = my    
    end with
    
    'draws the user(red)
    user.draw
    
    'simple object handling with colision detection
    killed_cubes = 0
    Print "Kill all Cubes"
    for i as integer = lbound(cubes) to ubound(cubes)
        if cubes(i).size > 0 then 
            cubes(i).draw
            if cubes(i).is_hit(user) = 1 then 
                cubes(i).size-=1
                user.size+=.5
            end if
        else
            killed_cubes+=1
            Print "Kill all Cubes (";killed_cubes;"/";cubes_to_kill;")"
            if killed_cubes = cubes_to_kill then 
                PRINT "YOU WON" 
                exit do
            end if
        end if        
    next
    
    
    screensync
    
    cls
loop until inkey <> ""
sleep
Post Reply