Collision detection circle <-> rectangle with position correction

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

Collision detection circle <-> rectangle with position correction

Postby badidea » Oct 19, 2018 23:01

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))
         '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)
         '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
   printAt 2, 2, "<esc> to quit"
   printAt 2, 4, "correction.x: " + str(correction.x) + " "
   printAt 2, 6, "correction.y: " + str(correction.y) + " "
   sleep 1, 1

Posts: 694
Joined: Oct 22, 2005 21:12
Location: Denmark

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

Postby h4tt3n » Oct 20, 2018 8:24

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.

Posts: 87
Joined: Feb 11, 2013 12:23

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

Postby mrminecrafttnt » Oct 20, 2018 22:55

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
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
        return 0
    end if
end function


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
dim as integer cubes_to_kill = ubound(cubes) + 1, killed_cubes

    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)
    '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
            if cubes(i).is_hit(user) = 1 then
            end if
            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       
loop until inkey <> ""

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 7 guests