08-20-2024, 01:40 PM
hmm... I wonder if that InRange% Function might simplify this:
Code: (Select All)
_Title "Box Intersect" 'b+ 2019-12-26
' 2023-01-27 rewrote CollisionIntersect2Boxes to Intersect2Boxes, renamed Collision% to BoxCollision%
' 2024-08-20 remove old CollisionIntersect2Boxes stuff start toggle ON
Const xmax = 800, ymax = 600, nBoxes = 250
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 300, 40
Type boxType
x As Single
y As Single
dx As Single
dy As Single
w As Single
h As Single
c As _Unsigned Long
End Type
Dim testbx As boxType, mousebx As boxType
newBox 300, 200, 200, 200, &HFFFFFFFF, testbx
newBox 100, 100, 300, 50, &HFFFFFF00, mousebx
_Title "Mouse around to check intersect of two boxes, PRESS Escape for Tons of floating box collisions..."
'Mouse test for building collisionIntersect2Boxes sub
While _KeyHit <> 27
Cls
ix = -1
Line (testbx.x, testbx.y)-Step(testbx.w, testbx.h), testbx.c, B
While _MouseInput: Wend
mousebx.x = _MouseX: mousebx.y = _MouseY
Line (mousebx.x, mousebx.y)-Step(mousebx.w, mousebx.h), mousebx.c, B
If BoxCollision%(testbx.x, testbx.y, testbx.w, testbx.h, mousebx.x, mousebx.y, mousebx.w, mousebx.h) Then Locate 1, 1: Print "Collision" Else Print "No Collision"
Intersect2Boxes testbx.x, testbx.y, testbx.w, testbx.h, mousebx.x, mousebx.y, mousebx.w, mousebx.h, ix, iy, iw, ih
If ix <> -1 Then
Line (ix, iy)-Step(iw, ih), &HFFFF0000, BF
End If
_Display
_Limit 100
Wend
_KeyClear
Dim bxs(nBoxes) As boxType, scrnbx As boxType
newBox 0, 0, xmax, ymax, &HFF000000, scrnbx
For i = 0 To nBoxes
newBox Rnd * (xmax - 50) + 25, Rnd * (ymax - 50) + 25, Rnd * 70 + 10, Rnd * 50 + 10, _RGB32(0, 255 * Rnd, 205 * Rnd + 50), bxs(i)
Next
_Title "Intersections are red boxes, press spacebar to toggle box edges, press a to toggle alpha mode on/off"
'OK now let's run a test
toggle = 1
While _KeyHit <> 27
Cls
k$ = InKey$
If k$ = " " Then
toggle = 1 - toggle
ElseIf k$ = "a" Then
alpha = 1 - alpha
End If
For i = 0 To nBoxes
If alpha = 1 Then
Line (bxs(i).x, bxs(i).y)-Step(bxs(i).w, bxs(i).h), &H55FF0000, BF
Else
For j = i + 1 To nBoxes
If i <> j Then
Intersect2Boxes bxs(i).x, bxs(i).y, bxs(i).w, bxs(i).h, bxs(j).x, bxs(j).y, bxs(j).w, bxs(j).h, ix, iy, iw, ih
If ix <> -1 Then Line (ix, iy)-Step(iw, ih), &HFFFF0000, BF
'collisionIntersect2Boxes bxs(j).x, bxs(j).y, bxs(j).w, bxs(j).h, bxs(i).x, bxs(i).y, bxs(i).w, bxs(i).h, ix, iy, iw, ih
'IF ix <> -1 THEN LINE (ix, iy)-STEP(iw, ih), &HFFFF0000, BF
End If
Next
End If
Next
For i = 0 To nBoxes
If toggle Then Line (bxs(i).x, bxs(i).y)-Step(bxs(i).w, bxs(i).h), bxs(i).c, B
bxs(i).x = bxs(i).x + bxs(i).dx: bxs(i).y = bxs(i).y + bxs(i).dy
'bounce boxes back if they hit an edge
If bxs(i).x < 0 Then bxs(i).dx = -bxs(i).dx: bxs(i).x = 0
If bxs(i).x + bxs(i).w > xmax Then bxs(i).dx = -bxs(i).dx: bxs(i).x = xmax - bxs(i).w
If bxs(i).y < 0 Then bxs(i).dy = -bxs(i).dy: bxs(i).y = 0
If bxs(i).y + bxs(i).h > ymax Then bxs(i).dy = -bxs(i).dy: bxs(i).y = ymax - bxs(i).h
Next
_Display
_Limit 30
Wend
Sub newBox (x, y, w, h, c As _Unsigned Long, bx As boxType)
bx.x = x
bx.y = y
bx.w = w
bx.h = h
bx.c = c
bx.dx = Rnd * 8 - 4
bx.dy = Rnd * 6 - 3
End Sub
Function BoxCollision% (b1x, b1y, b1w, b1h, b2x, b2y, b2w, b2h)
' x, y represent the box left most x and top most y
' w, h represent the box width and height which is the usual way sprites / tiles / images are described
' such that boxbottom = by + bh
' and boxright = bx + bw
If (b1y + b1h < b2y) Or (b1y > b2y + b2h) Or (b1x > b2x + b2w) Or (b1x + b1w < b2x) Then
BoxCollision% = 0
Else
BoxCollision% = 1
End If
End Function
' this needs max, min functions as well as BoxCollision%
Sub Intersect2Boxes (b1x, b1y, b1w, b1h, b2x, b2y, b2w, b2h, bix, biy, biw, bih)
If b2x >= b1x And b2x <= b1x + b1w And b2y >= b1y And b2y <= b1y + b1h Then 'top left corner in 2nd box
bix = b2x: biy = b2y
If b2x + b2w <= b1x + b1w Then biw = b2w Else biw = b1x + b1w - b2x
If b2y + b2h <= b1y + b1h Then bih = b2h Else bih = b1y + b1h - b2y
ElseIf b2x >= b1x And b2x <= b1x + b1w And b2y + b2h >= b1y And b2y + b2h <= b1y + b1h Then 'bottom left corner of 2nd box in first
bix = b2x
If b2x + b2w <= b1x + b1w Then biw = b2w Else biw = b1x + b1w - b2x
If b2y <= b1y Then biy = b1y: bih = b2y + b2h - b1y Else biy = b2y: bih = b2h
ElseIf b2x + b2w >= b1x And b2x + b2w <= b1x + b1w And b2y >= b1y And b2y <= b1y + b1h Then 'right top corner 2nd box in first
If b2x >= b1x Then bix = b2x: biw = b2w Else bix = b1x: biw = b2x + b2w - b1x
biy = b2y
If b2y + b2h <= b1y + b1h Then bih = b2h Else bih = b1y + b1h - b2y
ElseIf b2x + b2w >= b1x And b2x + b2w <= b1x + b1w And b2y + b2h >= b1y And b2y + b2h <= b1y + b1h Then 'left bottom corners in first box
If b2x >= b1x Then bix = b2x: biw = b2w Else bix = b1x: biw = b2x + b2w - b1x
If b2y >= b1y Then biy = b2y: bih = b2h Else biy = b1y: bih = b2y + b2h - b1y
ElseIf BoxCollision%(b1x, b1y, b1w, b1h, b2x, b2y, b2w, b2h) Then
bix = max(b1x, b2x): biy = max(b1y, b2y)
biw = min(b1x + b1w, b2x + b2w) - bix: bih = min(b1y + b1h, b2y + b2h) - biy
Else 'no intersect
bix = -1: biy = -1: biw = 0: bih = 0
End If
End Sub
Function max (a, b)
If a > b Then max = a Else max = b
End Function
Function min (a, b)
If a < b Then min = a Else min = b
End Function
b = b + ...