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

   
  724  855  599  923  575  468  400  206  147  564  878  823  652  556 bxor cross forever
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

Forum Jump:


Users browsing this thread: 1 Guest(s)