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