Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
To Nest or Not to Nest Else
#21
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 + ...
Reply


Messages In This Thread
To Nest or Not to Nest Else - by Dimster - 08-17-2024, 03:11 PM
RE: To Nest or Not to Nest Else - by SMcNeill - 08-17-2024, 03:35 PM
RE: To Nest or Not to Nest Else - by PhilOfPerth - 08-17-2024, 11:28 PM
RE: To Nest or Not to Nest Else - by TerryRitchie - 08-17-2024, 06:51 PM
RE: To Nest or Not to Nest Else - by Pete - 08-19-2024, 03:23 AM
RE: To Nest or Not to Nest Else - by Dimster - 08-19-2024, 07:30 PM
RE: To Nest or Not to Nest Else - by SMcNeill - 08-19-2024, 08:58 PM
RE: To Nest or Not to Nest Else - by Dimster - 08-19-2024, 09:08 PM
RE: To Nest or Not to Nest Else - by Pete - 08-19-2024, 09:52 PM
RE: To Nest or Not to Nest Else - by TerryRitchie - 08-19-2024, 10:05 PM
RE: To Nest or Not to Nest Else - by SMcNeill - 08-19-2024, 10:19 PM
RE: To Nest or Not to Nest Else - by TerryRitchie - 08-19-2024, 10:24 PM
RE: To Nest or Not to Nest Else - by Pete - 08-19-2024, 10:10 PM
RE: To Nest or Not to Nest Else - by TerryRitchie - 08-19-2024, 10:14 PM
RE: To Nest or Not to Nest Else - by SMcNeill - 08-19-2024, 10:30 PM
RE: To Nest or Not to Nest Else - by TerryRitchie - 08-19-2024, 10:35 PM
RE: To Nest or Not to Nest Else - by SMcNeill - 08-19-2024, 11:56 PM
RE: To Nest or Not to Nest Else - by Pete - 08-19-2024, 10:53 PM
RE: To Nest or Not to Nest Else - by luke - 08-20-2024, 11:17 AM
RE: To Nest or Not to Nest Else - by OldMoses - 08-20-2024, 12:06 PM
RE: To Nest or Not to Nest Else - by bplus - 08-20-2024, 01:40 PM
RE: To Nest or Not to Nest Else - by Dimster - 08-20-2024, 01:45 PM
RE: To Nest or Not to Nest Else - by bplus - 08-20-2024, 02:08 PM
RE: To Nest or Not to Nest Else - by Pete - 08-20-2024, 04:37 PM
RE: To Nest or Not to Nest Else - by dano - 08-20-2024, 10:54 PM
RE: To Nest or Not to Nest Else - by Pete - 08-20-2024, 11:39 PM
RE: To Nest or Not to Nest Else - by OldMoses - 08-22-2024, 05:28 PM
RE: To Nest or Not to Nest Else - by TerryRitchie - 08-22-2024, 06:45 PM
RE: To Nest or Not to Nest Else - by bplus - 08-22-2024, 05:41 PM



Users browsing this thread: 5 Guest(s)