Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Box and Pixel Collisions pkg
#1
I used Terry's method of pixel collision detection and added it to my Box Collision detection code because I saw Terry's method as an extension of Box Collision. So in same amount of code as Terry's self contained PixelCollide routine, I have 5 routines that give me more than just Pixel collision detection, mainly BoxCollsion TF and Intersect2Boxes plus minor Max and Min Functions which is commonly needed.

Anyway after getting that going I revised my spider code with an Experiment of turning one spider when it collides instead of reversing both spiders when there is collision. It turned out to be nice effect so I leave the code here but the whole collision code zip package has:

Quote:Box and Pixel Collision pkg Manifest Jan 28, 2023 b+

3 Pairs of Image Files all png:
1. Red and Green Ovals from Terry's original post at forum.
2. starRed and starBlue
3. Rock1 and rock2

3 Pixel Collision Demo Files:
1. Pixel Intersect from Box Intersect.bas - code I used to combine Terry's pixel
collision detection method with my own BoxCollision Code to factor Terry's
Pixel Collide single self contained routine into 5 Routines that do more than
just pixel collision detection with about same amount of Lines-Of-Code.

This one took a whole day of frustration to track down a bug holding up my test
of it with Spiders. But now it's pretty good so not only do you have Pixel
Collision detection, you have Max, Min Functions, BoxCollision TF function
Intersect2Boxes that returns the intersect box which was used in Pixel Collision
Detection, PixelCollision& that returns first pixel detected as well as return
TF collsion.

This is pure Pixel Collison detection code though needing the other routines
to reduce PixelCollision code itself. But also used Intersect2Boxes code to
display the ovelap of the 2 images when they did along with the yellow circle
for the actual pixel collsion, first detected when that happened.

2. Pixel Intersect from Box Intersect full demo.bas - has updated Box Collision
demo code before PixelCollision showing off BoxCollison TF and Intersect2Boxes
that returns the box of Intersect.

3. Terry Update Pixel Collision.bas - demo that I modified a tiny bit for testing
pairs of images to see how good it was. Nice approach Terry Richie!

3 Spiders files:
1. Spiders with Terrys Pixel Collisions.bas - this one I posted at forum already
in Programs Board.
2. Spiders with b+ factored Collisions.bas - Same Spiders Code as above testing
the 5 factored routines to make sure they worked the sameas 1. Spiders file.
3. Spiders refactored Collison Experiment.bas - My feature app! I experimented
with another approach to spider collisons turning only the first one of the two
that collided. Nice effect! Now I can use 100% collision for spider reactions.
Got's to check this one out!


Code: (Select All)
Option _Explicit
_Title "Spiders refactored Collision Experiment" 'b+ 2023-01-28    !!! Speaker volume around 20 maybe! !!!
' Experiment is to only change direction of spider that bumps into another (first) not both spiders
' I want to see I can avoid pile ups that way instead of changing directions 30% of time.

' Yes! I luv the spinning spiders and 100% reactions to collisions by 1 spider at least

' !!!!!!!!!!!!!!!!!!!          Escape to Quit         !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

Randomize Timer
Dim Shared xmax As Integer, ymax As Integer
xmax = _DesktopWidth
ymax = _DesktopHeight
Const nSpinners = 30
Type SpinnerType
    x As Single
    y As Single
    dx As Single
    dy As Single
    a As Single
    sz As Single
    c As _Unsigned Long
End Type
Dim Shared s(1 To nSpinners) As SpinnerType

Type boxType ' for PixelCollison&
    As Single dx, dy
    As Long img, x, y, w, h
    c As _Unsigned Long
End Type

Dim power1
Dim As Long i, j, iImg, jImg, lc, i2, sc, intx, inty
Dim As boxType sIo, sJo

sc = _ScreenImage
Screen _NewImage(xmax, ymax, 32)
_FullScreen
For i = 1 To nSpinners
    newSpinner i
Next
i2 = 1
While InKey$ <> Chr$(27)
    _PutImage , sc, 0
    lc = lc + 1
    If lc Mod 100 = 99 Then
        lc = 0
        If i2 < nSpinners Then i2 = i2 + 1
    End If
    For i = 1 To i2

        'ready for collision check

        ' max sz = .75 which needs 140 x 140 image square  +++++++++++++++++++++++++
        iImg = _NewImage(140, 140, 32)
        _Dest iImg
        drawSpinner iImg, 70, 70, s(i).sz, _Atan2(s(i).dy, s(i).dx), s(i).c
        _Dest 0
        sIo.x = s(i).x - 70
        sIo.y = s(i).y - 70
        sIo.w = 140
        sIo.h = 140
        sIo.img = iImg ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++

        s(i).a = _Atan2(s(i).dy, s(i).dx)
        power1 = (s(i).dx ^ 2 + s(i).dy ^ 2) ^ .5
        'imoved = 0
        For j = i + 1 To i2

            ' max sz = .75 which needs 140 x 140 image square +++++++++++++++++++++
            jImg = _NewImage(140, 140, 32)
            _Dest jImg
            drawSpinner jImg, 70, 70, s(j).sz, _Atan2(s(j).dy, s(j).dx), s(j).c
            _Dest 0
            sJo.x = s(j).x - 70
            sJo.y = s(j).y - 70
            sJo.w = 140
            sJo.h = 140
            sJo.img = jImg

            If PixelCollision&(sIo, sJo, intx, inty) Then '+++++++++++++++++++++++++++++++++++++++
                Sound Rnd * 5000 + 1000, .1 * Rnd
                s(i).a = s(i).a + _Pi(.33) ' turn 30 degrees
                s(i).dx = power1 * Cos(s(i).a) 'update dx, dy
                s(i).dy = power1 * Sin(s(i).a)
                s(i).x = s(i).x + 3 * s(i).dx 'now boost spider out
                s(i).y = s(i).y + 3 * s(i).dy
                Exit For
            End If
            _FreeImage jImg
        Next
        s(i).x = s(i).x + s(i).dx
        s(i).y = s(i).y + s(i).dy
        If s(i).x < -100 Or s(i).x > xmax + 100 Or s(i).y < -100 Or s(i).y > ymax + 100 Then newSpinner i
        _PutImage (s(i).x - 70, s(i).y - 70), iImg, 0
        _FreeImage iImg
    Next
    _Display
    _Limit 15
Wend

Sub newSpinner (i As Integer) 'set Spinners dimensions start angles, color?
    Dim r
    s(i).sz = Rnd * .25 + .5
    If Rnd < .5 Then r = -1 Else r = 1
    s(i).dx = (s(i).sz * Rnd * 8) * r * 2 + 2: s(i).dy = (s(i).sz * Rnd * 8) * r * 2 + 2
    r = Int(Rnd * 4)
    Select Case r
        Case 0: s(i).x = Rnd * (xmax - 120) + 60: s(i).y = 0: If s(i).dy < 0 Then s(i).dy = -s(i).dy
        Case 1: s(i).x = Rnd * (xmax - 120) + 60: s(i).y = ymax: If s(i).dy > 0 Then s(i).dy = -s(i).dy
        Case 2: s(i).x = 0: s(i).y = Rnd * (ymax - 120) + 60: If s(i).dx < 0 Then s(i).dx = -s(i).dx
        Case 3: s(i).x = xmax: s(i).y = Rnd * (ymax - 120) + 60: If s(i).dx > 0 Then s(i).dx = -s(i).dx
    End Select
    r = Rnd * 100 + 40
    s(i).c = _RGB32(r, .5 * Rnd * r, Rnd * .25 * r)
End Sub

Sub drawSpinner (idest&, x As Integer, y As Integer, scale As Single, heading As Single, c As _Unsigned Long)
    Dim x1, x2, x3, x4, y1, y2, y3, y4, r, a, a1, a2, lg, d, rd, red, blue, green
    Static switch As Integer
    switch = switch + 2
    switch = switch Mod 16 + 1
    red = _Red32(c): green = _Green32(c): blue = _Blue32(c)
    r = 10 * scale
    x1 = x + r * Cos(heading): y1 = y + r * Sin(heading)
    r = 2 * r 'lg lengths
    For lg = 1 To 8
        If lg < 5 Then
            a = heading + .9 * lg * _Pi(1 / 5) + (lg = switch) * _Pi(1 / 10)
        Else
            a = heading - .9 * (lg - 4) * _Pi(1 / 5) - (lg = switch) * _Pi(1 / 10)
        End If
        x2 = x1 + r * Cos(a): y2 = y1 + r * Sin(a)
        drawLink idest&, x1, y1, 3 * scale, x2, y2, 2 * scale, _RGB32(red + 20, green + 10, blue + 5)
        If lg = 1 Or lg = 2 Or lg = 7 Or lg = 8 Then d = -1 Else d = 1
        a1 = a + d * _Pi(1 / 12)
        x3 = x2 + r * 1.5 * Cos(a1): y3 = y2 + r * 1.5 * Sin(a1)
        drawLink idest&, x2, y2, 2 * scale, x3, y3, scale, _RGB32(red + 35, green + 17, blue + 8)
        rd = Int(Rnd * 8) + 1
        a2 = a1 + d * _Pi(1 / 8) * rd / 8
        x4 = x3 + r * 1.5 * Cos(a2): y4 = y3 + r * 1.5 * Sin(a2)
        drawLink idest&, x3, y3, scale, x4, y4, scale, _RGB32(red + 50, green + 25, blue + 12)
    Next
    r = r * .5
    fcirc x1, y1, r, _RGB32(red - 20, green - 10, blue - 5)
    x2 = x1 + (r + 1) * Cos(heading - _Pi(1 / 12)): y2 = y1 + (r + 1) * Sin(heading - _Pi(1 / 12))
    fcirc x2, y2, r * .2, &HFF000000
    x2 = x1 + (r + 1) * Cos(heading + _Pi(1 / 12)): y2 = y1 + (r + 1) * Sin(heading + _Pi(1 / 12))
    fcirc x2, y2, r * .2, &HFF000000
    r = r * 2
    x1 = x + r * .9 * Cos(heading + _Pi): y1 = y + r * .9 * Sin(heading + _Pi)
    TiltedEllipseFill idest&, x1, y1, r, .7 * r, heading + _Pi, _RGB32(red, green, blue)
End Sub

Sub drawLink (idest&, x1, y1, r1, x2, y2, r2, c As _Unsigned Long)
    Dim a, a1, a2, x3, x4, x5, x6, y3, y4, y5, y6
    a = _Atan2(y2 - y1, x2 - x1)
    a1 = a + _Pi(1 / 2)
    a2 = a - _Pi(1 / 2)
    x3 = x1 + r1 * Cos(a1): y3 = y1 + r1 * Sin(a1)
    x4 = x1 + r1 * Cos(a2): y4 = y1 + r1 * Sin(a2)
    x5 = x2 + r2 * Cos(a1): y5 = y2 + r2 * Sin(a1)
    x6 = x2 + r2 * Cos(a2): y6 = y2 + r2 * Sin(a2)
    fquad idest&, x3, y3, x4, y4, x5, y5, x6, y6, c
    fcirc x1, y1, r1, c
    fcirc x2, y2, r2, c
End Sub

'need 4 non linear points (not all on 1 line) list them clockwise so x2, y2 is opposite of x4, y4
Sub fquad (idest&, x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, x3 As Integer, y3 As Integer, x4 As Integer, y4 As Integer, c As _Unsigned Long)
    ftri idest&, x1, y1, x2, y2, x4, y4, c
    ftri idest&, x3, y3, x4, y4, x1, y1, c
End Sub

Sub ftri (idest&, x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
    Dim a&
    a& = _NewImage(1, 1, 32)
    _Dest a&
    PSet (0, 0), K
    _Dest idest&
    _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
    _FreeImage a& '<<< this is important!
End Sub

Sub fcirc (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
    Dim Radius As Integer, RadiusError As Integer
    Dim X As Integer, Y As Integer
    Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
    If Radius = 0 Then PSet (CX, CY), C: Exit Sub
    Line (CX - X, CY)-(CX + X, CY), C, BF
    While X > Y
        RadiusError = RadiusError + Y * 2 + 1
        If RadiusError >= 0 Then
            If X <> Y + 1 Then
                Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
                Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            End If
            X = X - 1
            RadiusError = RadiusError - X * 2
        End If
        Y = Y + 1
        Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    Wend
End Sub

Sub TiltedEllipseFill (destHandle&, x0, y0, a, b, ang, c As _Unsigned Long)
    Dim TEmax As Integer, mx2 As Integer, i As Integer, j As Integer, k As Single, lasti As Single, lastj As Single
    Dim prc As _Unsigned Long, tef As Long
    prc = _RGB32(255, 255, 255, 255)
    If a > b Then TEmax = a + 1 Else TEmax = b + 1
    mx2 = TEmax + TEmax
    tef = _NewImage(mx2, mx2)
    _Dest tef
    _Source tef 'point wont read without this!
    For k = 0 To 6.2832 + .05 Step .1
        i = TEmax + a * Cos(k) * Cos(ang) + b * Sin(k) * Sin(ang)
        j = TEmax + a * Cos(k) * Sin(ang) - b * Sin(k) * Cos(ang)
        If k <> 0 Then
            Line (lasti, lastj)-(i, j), prc
        Else
            PSet (i, j), prc
        End If
        lasti = i: lastj = j
    Next
    Dim xleft(mx2) As Integer, xright(mx2) As Integer, x As Integer, y As Integer
    For y = 0 To mx2
        x = 0
        While Point(x, y) <> prc And x < mx2
            x = x + 1
        Wend
        xleft(y) = x
        While Point(x, y) = prc And x < mx2
            x = x + 1
        Wend
        While Point(x, y) <> prc And x < mx2
            x = x + 1
        Wend
        If x = mx2 Then xright(y) = xleft(y) Else xright(y) = x
    Next
    _Dest destHandle&
    For y = 0 To mx2
        If xleft(y) <> mx2 Then Line (xleft(y) + x0 - TEmax, y + y0 - TEmax)-(xright(y) + x0 - TEmax, y + y0 - TEmax), c, BF
    Next
    _FreeImage tef
End Sub

'Function PixelCollide (Obj1 As TypeSPRITE, Obj2 As TypeSPRITE, Intersect As TypePOINT)
'    '--------------------------------------------------------------------------------------------------------
'    '- Checks for pixel perfect collision between two rectangular areas. -
'    '- Returns -1 if in collision                                        -
'    '- Returns  0 if no collision                                        -
'    '-                                                                   -
'    '- obj1 - rectangle 1 coordinates                                    -
'    '- obj2 - rectangle 2 coordinates                                    -
'    '---------------------------------------------------------------------
'    Dim x%, y%
'    Dim x1%, y1% ' upper left x,y coordinate of rectangular collision area
'    Dim x2%, y2% ' lower right x,y coordinate of rectangular collision area
'    Dim Test1& '   overlap image 1 to test for collision
'    Dim Test2& '   overlap image 2 to test for collision
'    Dim Hit% '     -1 (TRUE) if a collision occurs, 0 (FALSE) otherwise
'    Dim Osource& ' original source image handle
'    Dim p1~& '     alpha value of pixel on image 1
'    Dim p2~& '     alpha value of pixel on image 2

'    Obj1.x2 = Obj1.x1 + _Width(Obj1.image) - 1 '  calculate lower right x,y coordinates of both objects
'    Obj1.y2 = Obj1.y1 + _Height(Obj1.image) - 1
'    Obj2.x2 = Obj2.x1 + _Width(Obj2.image) - 1
'    Obj2.y2 = Obj2.y1 + _Height(Obj2.image) - 1
'    Hit% = 0 '                                    assume no collision

'    '+-------------------------------------+
'    '| perform rectangular collision check |
'    '+-------------------------------------+

'    If Obj1.x2 >= Obj2.x1 Then '                  rect 1 lower right X >= rect 2 upper left  X ?
'        If Obj1.x1 <= Obj2.x2 Then '              rect 1 upper left  X <= rect 2 lower right X ?
'            If Obj1.y2 >= Obj2.y1 Then '          rect 1 lower right Y >= rect 2 upper left  Y ?
'                If Obj1.y1 <= Obj2.y2 Then '      rect 1 upper left  Y <= rect 2 lower right Y ?

'                    '+-----------------------------------------------------------------------+
'                    '| rectangular collision detected, perform pixel perfect collision check |
'                    '+-----------------------------------------------------------------------+

'                    If Obj2.x1 <= Obj1.x1 Then x1% = Obj1.x1 Else x1% = Obj2.x1 '        calculate overlapping coordinates
'                    If Obj2.y1 <= Obj1.y1 Then y1% = Obj1.y1 Else y1% = Obj2.y1
'                    If Obj2.x2 <= Obj1.x2 Then x2% = Obj2.x2 Else x2% = Obj1.x2
'                    If Obj2.y2 <= Obj1.y2 Then y2% = Obj2.y2 Else y2% = Obj1.y2
'                    Test1& = _NewImage(x2% - x1% + 1, y2% - y1% + 1, 32) '               make overlap image of object 1
'                    Test2& = _NewImage(x2% - x1% + 1, y2% - y1% + 1, 32) '               make overlap image of object 2
'                    _PutImage (-(x1% - Obj1.x1), -(y1% - Obj1.y1)), Obj1.image, Test1& ' place overlap area of object 1
'                    _PutImage (-(x1% - Obj2.x1), -(y1% - Obj2.y1)), Obj2.image, Test2& ' place overlap area of object 2
'                    x% = 0 '                                                             reset overlap area coordinate counters
'                    y% = 0
'                    Osource& = _Source '                                                 remember calling source
'                    Do '                                                                 begin pixel collide loop
'                        _Source Test1& '                                                 read from image 1
'                        p1~& = _Alpha32(Point(x%, y%)) '                                 get alpha level of pixel
'                        _Source Test2& '                                                 read from image 2
'                        p2~& = _Alpha32(Point(x%, y%)) '                                 get alpha level of pixel
'                        If (p1~& <> 0) And (p2~& <> 0) Then '                            are both pixels transparent?
'                            Hit% = -1 '                                                  no, there must be a collision
'                            Intersect.x = x1% + x% '                                     return collision coordinates
'                            Intersect.y = y1% + y% '
'                        End If
'                        x% = x% + 1 '                                                    increment column counter
'                        If x% > _Width(Test1&) - 1 Then '                                beyond last column?
'                            x% = 0 '                                                     yes, reset x
'                            y% = y% + 1 '                                                increment row counter
'                        End If
'                    Loop Until y% > _Height(Test1&) - 1 Or Hit% '                        leave when last row or collision detected
'                    _Source Osource& '                                                   restore calling source
'                    _FreeImage Test1& '                                                  remove temporary image from RAM
'                    _FreeImage Test2&
'                End If
'            End If
'        End If
'    End If
'    PixelCollide = Hit% '                                                                return result of collision check

'End Function

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 As Long, biy As Long, biw As Long, bih As Long)
    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

' this sub needs Intersect2Boxes which uses  max, min, and BoxCollision Functions
Function PixelCollision& (img1 As boxType, img2 As boxType, intx As Long, inty As Long)
    ' boxType here needs at least an x, y, w, h and img
    Dim As Long x, y, ix, iy, iw, ih
    Dim As _Unsigned Long p1, p2
    intx = -1: inty = -1 ' no collision set
    Intersect2Boxes img1.x, img1.y, img1.w, img1.h, img2.x, img2.y, img2.w, img2.h, ix, iy, iw, ih
    If ix <> -1 Then ' the boxes intersect
        y = iy: x = ix
        Do
            _Source img1.img
            p1 = Point(x - img1.x, y - img1.y) ' point minus img x, y location = location in image I hope
            _Source img2.img
            p2 = Point(x - img2.x, y - img2.y)
            If (p1 <> 0) And (p2 <> 0) Then
                PixelCollision& = -1: intx = x: inty = y: Exit Function
            End If
            If (x + 1) > (ix + iw - 1) Then ' get rid of 2 slow For Loops
                x = ix: y = y + 1
                If y >= (iy + ih - 1) Then
                    _Source 0: Exit Function
                Else
                    y = y + 1
                End If
            Else
                x = x + 1
            End If
        Loop
    End If
End Function


Attached Files
.zip   Box and Pixel Collision pkg.zip (Size: 38.53 KB / Downloads: 33)
b = b + ...
Reply
#2
Yeah
a fine job!
Surely the results are good running your demos!
Reply
#3
Well I am glad someone looked at it.

@TempodiBasic what did you think of the revised Spiders that turn away when colliding instead of both spiders reversing directions. 

Actually I should get the spider clear of the collision and then reverse it or turn it. That would likely solve the original problem with reversing both spiders. If they aren't clear of each other they will reverse direction again and come together and collide again... thus getting stuck. The same goes for balls colliding with walls, just changing direction works but it is inaccurate. It should be backed up to point of collision and then direction changed.
b = b + ...
Reply
#4
(01-30-2023, 04:40 PM)bplus Wrote: Well I am glad someone looked at it.

@TempodiBasic what did you think of the revised Spiders that turn away when colliding instead of both spiders reversing directions. 

Actually I should get the spider clear of the collision and then reverse it or turn it. That would likely solve the original problem with reversing both spiders. If they aren't clear of each other they will reverse direction again and come together and collide again... thus getting stuck. The same goes for balls colliding with walls, just changing direction works but it is inaccurate. It should be backed up to point of collision and then direction changed.

Surely it is more mimic for natural behaviour of animals towards a "bouncing back to the origin" behaviour after collision.
I like it more.
About the origin point of changing direction, it can be managed using as point of the sprite the center point at the place of the UpperLeftPoint of sprite.
And Yes, the movement must start after a change of sprite direction without changing the position. But we must think that a monochrome ball does not show so many graphic differences in its parts. This becomes different when the ball has ,yes , one color but it shows the effects of lights and shadows along its path. In this case we have left the flat monochrome color graphic for a multicolor (256 or 32 bit) colors graphic.
Reply
#5
(01-28-2023, 08:54 PM)bplus Wrote: Anyway after getting that going I revised my spider code

Well the good news, it works!

The bad news is, it reminded me of this video that I was trying to forget I ever saw!
Confused

So... thanks?
LoL
Reply
#6
LOL you got to learn to face your fears a step at a time. Hey start with spiders you know aren't real!

Got say though, I hate jumping spiders and some can really jump!

The only thing worse would be flying spiders... oops! On no!....
b = b + ...
Reply
#7
(02-02-2023, 06:21 PM)bplus Wrote: LOL you got to learn to face your fears a step at a time. Hey start with spiders you know aren't real!

Got say though, I hate jumping spiders and some can really jump!

The only thing worse would be flying spiders... oops! On no!....

Isn't evolution fun? LoL
Reply
#8
(01-30-2023, 04:40 PM)bplus Wrote: Actually I should get the spider clear of the collision and then reverse it or turn it. That would likely solve the original problem with reversing both spiders. If they aren't clear of each other they will reverse direction again and come together and collide again... thus getting stuck. The same goes for balls colliding with walls, just changing direction works but it is inaccurate. It should be backed up to point of collision and then direction changed.

I tried it with a few changes that eschew the angle part and just orient one spider away from the one it's colliding with. Orientation is based upon a reversal of the displacement between the two, such that even when additional collisions are detected, they will not seriously alter the direction. With some tweaking I might be able to get spiders to chase each other.

Code: (Select All)
OPTION _EXPLICIT
_TITLE "Spiders refactored Collision Experiment" 'b+ 2023-01-28    !!! Speaker volume around 20 maybe! !!!
' Experiment is to only change direction of spider that bumps into another (first) not both spiders
' I want to see I can avoid pile ups that way instead of changing directions 30% of time.

' Yes! I luv the spinning spiders and 100% reactions to collisions by 1 spider at least

' !!!!!!!!!!!!!!!!!!!          Escape to Quit         !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

RANDOMIZE TIMER
DIM SHARED xmax AS INTEGER, ymax AS INTEGER
xmax = _DESKTOPWIDTH
ymax = _DESKTOPHEIGHT
CONST nSpinners = 30
TYPE Vec2
    x AS SINGLE
    y AS SINGLE
END TYPE
TYPE SpinnerType
    p AS Vec2
    d AS Vec2
    'a AS SINGLE
    sz AS SINGLE
    c AS _UNSIGNED LONG
END TYPE
DIM SHARED s(1 TO nSpinners) AS SpinnerType

TYPE boxType ' for PixelCollison&
    AS SINGLE dx, dy
    'AS Vec2 d
    AS LONG img, x, y, w, h
    c AS _UNSIGNED LONG
END TYPE

'DIM power1
DIM AS LONG i, j, iImg, jImg, lc, i2, sc, intx, inty
DIM AS boxType sIo, sJo

sc = _SCREENIMAGE
SCREEN _NEWIMAGE(xmax, ymax, 32)
_FULLSCREEN
FOR i = 1 TO nSpinners
    newSpinner i
NEXT
i2 = 1
WHILE INKEY$ <> CHR$(27)
    _PUTIMAGE , sc, 0
    lc = lc + 1
    IF lc MOD 100 = 99 THEN
        lc = 0
        IF i2 < nSpinners THEN i2 = i2 + 1
    END IF
    FOR i = 1 TO i2

        'ready for collision check

        ' max sz = .75 which needs 140 x 140 image square  +++++++++++++++++++++++++
        iImg = _NEWIMAGE(140, 140, 32)
        _DEST iImg
        drawSpinner iImg, 70, 70, s(i).sz, _ATAN2(s(i).d.y, s(i).d.x), s(i).c
        _DEST 0
        sIo.x = s(i).p.x - 70
        sIo.y = s(i).p.y - 70
        sIo.w = 140
        sIo.h = 140
        sIo.img = iImg ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++

        's(i).a = _ATAN2(s(i).d.y, s(i).d.x)
        'power1 = _HYPOT(s(i).d.x, s(i).d.y) '(s(i).dx ^ 2 + s(i).dy ^ 2) ^ .5
        'imoved = 0
        FOR j = i + 1 TO i2

            ' max sz = .75 which needs 140 x 140 image square +++++++++++++++++++++
            jImg = _NEWIMAGE(140, 140, 32)
            _DEST jImg
            drawSpinner jImg, 70, 70, s(j).sz, _ATAN2(s(j).d.y, s(j).d.x), s(j).c
            _DEST 0
            sJo.x = s(j).p.x - 70
            sJo.y = s(j).p.y - 70
            sJo.w = 140
            sJo.h = 140
            sJo.img = jImg

            IF PixelCollision&(sIo, sJo, intx, inty) THEN '+++++++++++++++++++++++++++++++++++++++
                SOUND RND * 5000 + 1000, .1 * RND
                's(i).a = s(i).a + _PI(.33) ' turn 30 degrees
                's(i).d.x = power1 * COS(s(i).a) 'update dx, dy
                's(i).d.y = power1 * SIN(s(i).a)
                DIM sep AS Vec2
                sep = s(i).p: R2_Add sep, s(j).p, -1 'separation vector between spiders
                R2_Norm s(i).d, sep, R2_Mag(s(i).d) 'set displacement to separation vector same speed
                R2_Add s(i).p, s(i).d, 3 'add 3x displacement "jump" to position
                EXIT FOR
            END IF
            _FREEIMAGE jImg
        NEXT
        R2_Add s(i).p, s(i).d, 1
        IF s(i).p.x < -100 OR s(i).p.x > xmax + 100 OR s(i).p.y < -100 OR s(i).p.y > ymax + 100 THEN newSpinner i
        _PUTIMAGE (s(i).p.x - 70, s(i).p.y - 70), iImg, 0
        _FREEIMAGE iImg
    NEXT
    _DISPLAY
    _LIMIT 15
WEND

SUB newSpinner (i AS INTEGER) 'set Spinners dimensions start angles, color?
    DIM r
    s(i).sz = RND * .25 + .5
    IF RND < .5 THEN r = -1 ELSE r = 1
    s(i).d.x = (s(i).sz * RND * 8) * r * 2 + 2: s(i).d.y = (s(i).sz * RND * 8) * r * 2 + 2
    r = INT(RND * 4)
    SELECT CASE r
        CASE 0: s(i).p.x = RND * (xmax - 120) + 60: s(i).p.y = 0: IF s(i).d.y < 0 THEN s(i).d.y = -s(i).d.y
        CASE 1: s(i).p.x = RND * (xmax - 120) + 60: s(i).p.y = ymax: IF s(i).d.y > 0 THEN s(i).d.y = -s(i).d.y
        CASE 2: s(i).p.x = 0: s(i).p.y = RND * (ymax - 120) + 60: IF s(i).d.x < 0 THEN s(i).d.x = -s(i).d.x
        CASE 3: s(i).p.x = xmax: s(i).p.y = RND * (ymax - 120) + 60: IF s(i).d.x > 0 THEN s(i).d.x = -s(i).d.x
    END SELECT
    r = RND * 100 + 40
    s(i).c = _RGB32(r, .5 * RND * r, RND * .25 * r)
END SUB

SUB drawSpinner (idest&, x AS INTEGER, y AS INTEGER, scale AS SINGLE, heading AS SINGLE, c AS _UNSIGNED LONG)
    DIM x1, x2, x3, x4, y1, y2, y3, y4, r, a, a1, a2, lg, d, rd, red, blue, green
    STATIC switch AS INTEGER
    switch = switch + 2
    switch = switch MOD 16 + 1
    red = _RED32(c): green = _GREEN32(c): blue = _BLUE32(c)
    r = 10 * scale
    x1 = x + r * COS(heading): y1 = y + r * SIN(heading)
    r = 2 * r 'lg lengths
    FOR lg = 1 TO 8
        IF lg < 5 THEN
            a = heading + .9 * lg * _PI(1 / 5) + (lg = switch) * _PI(1 / 10)
        ELSE
            a = heading - .9 * (lg - 4) * _PI(1 / 5) - (lg = switch) * _PI(1 / 10)
        END IF
        x2 = x1 + r * COS(a): y2 = y1 + r * SIN(a)
        drawLink idest&, x1, y1, 3 * scale, x2, y2, 2 * scale, _RGB32(red + 20, green + 10, blue + 5)
        IF lg = 1 OR lg = 2 OR lg = 7 OR lg = 8 THEN d = -1 ELSE d = 1
        a1 = a + d * _PI(1 / 12)
        x3 = x2 + r * 1.5 * COS(a1): y3 = y2 + r * 1.5 * SIN(a1)
        drawLink idest&, x2, y2, 2 * scale, x3, y3, scale, _RGB32(red + 35, green + 17, blue + 8)
        rd = INT(RND * 8) + 1
        a2 = a1 + d * _PI(1 / 8) * rd / 8
        x4 = x3 + r * 1.5 * COS(a2): y4 = y3 + r * 1.5 * SIN(a2)
        drawLink idest&, x3, y3, scale, x4, y4, scale, _RGB32(red + 50, green + 25, blue + 12)
    NEXT
    r = r * .5
    fcirc x1, y1, r, _RGB32(red - 20, green - 10, blue - 5)
    x2 = x1 + (r + 1) * COS(heading - _PI(1 / 12)): y2 = y1 + (r + 1) * SIN(heading - _PI(1 / 12))
    fcirc x2, y2, r * .2, &HFF000000
    x2 = x1 + (r + 1) * COS(heading + _PI(1 / 12)): y2 = y1 + (r + 1) * SIN(heading + _PI(1 / 12))
    fcirc x2, y2, r * .2, &HFF000000
    r = r * 2
    x1 = x + r * .9 * COS(heading + _PI): y1 = y + r * .9 * SIN(heading + _PI)
    TiltedEllipseFill idest&, x1, y1, r, .7 * r, heading + _PI, _RGB32(red, green, blue)
END SUB

SUB drawLink (idest&, x1, y1, r1, x2, y2, r2, c AS _UNSIGNED LONG)
    DIM a, a1, a2, x3, x4, x5, x6, y3, y4, y5, y6
    a = _ATAN2(y2 - y1, x2 - x1)
    a1 = a + _PI(1 / 2)
    a2 = a - _PI(1 / 2)
    x3 = x1 + r1 * COS(a1): y3 = y1 + r1 * SIN(a1)
    x4 = x1 + r1 * COS(a2): y4 = y1 + r1 * SIN(a2)
    x5 = x2 + r2 * COS(a1): y5 = y2 + r2 * SIN(a1)
    x6 = x2 + r2 * COS(a2): y6 = y2 + r2 * SIN(a2)
    fquad idest&, x3, y3, x4, y4, x5, y5, x6, y6, c
    fcirc x1, y1, r1, c
    fcirc x2, y2, r2, c
END SUB

'need 4 non linear points (not all on 1 line) list them clockwise so x2, y2 is opposite of x4, y4
SUB fquad (idest&, x1 AS INTEGER, y1 AS INTEGER, x2 AS INTEGER, y2 AS INTEGER, x3 AS INTEGER, y3 AS INTEGER, x4 AS INTEGER, y4 AS INTEGER, c AS _UNSIGNED LONG)
    ftri idest&, x1, y1, x2, y2, x4, y4, c
    ftri idest&, x3, y3, x4, y4, x1, y1, c
END SUB

SUB ftri (idest&, x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
    DIM a&
    a& = _NEWIMAGE(1, 1, 32)
    _DEST a&
    PSET (0, 0), K
    _DEST idest&
    _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
    _FREEIMAGE a& '<<< this is important!
END SUB

SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
    DIM Radius AS INTEGER, RadiusError AS INTEGER
    DIM X AS INTEGER, Y AS INTEGER
    Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
    IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
    LINE (CX - X, CY)-(CX + X, CY), C, BF
    WHILE X > Y
        RadiusError = RadiusError + Y * 2 + 1
        IF RadiusError >= 0 THEN
            IF X <> Y + 1 THEN
                LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            END IF
            X = X - 1
            RadiusError = RadiusError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    WEND
END SUB

SUB TiltedEllipseFill (destHandle&, x0, y0, a, b, ang, c AS _UNSIGNED LONG)
    DIM TEmax AS INTEGER, mx2 AS INTEGER, i AS INTEGER, j AS INTEGER, k AS SINGLE, lasti AS SINGLE, lastj AS SINGLE
    DIM prc AS _UNSIGNED LONG, tef AS LONG
    prc = _RGB32(255, 255, 255, 255)
    IF a > b THEN TEmax = a + 1 ELSE TEmax = b + 1
    mx2 = TEmax + TEmax
    tef = _NEWIMAGE(mx2, mx2)
    _DEST tef
    _SOURCE tef 'point wont read without this!
    FOR k = 0 TO 6.2832 + .05 STEP .1
        i = TEmax + a * COS(k) * COS(ang) + b * SIN(k) * SIN(ang)
        j = TEmax + a * COS(k) * SIN(ang) - b * SIN(k) * COS(ang)
        IF k <> 0 THEN
            LINE (lasti, lastj)-(i, j), prc
        ELSE
            PSET (i, j), prc
        END IF
        lasti = i: lastj = j
    NEXT
    DIM xleft(mx2) AS INTEGER, xright(mx2) AS INTEGER, x AS INTEGER, y AS INTEGER
    FOR y = 0 TO mx2
        x = 0
        WHILE POINT(x, y) <> prc AND x < mx2
            x = x + 1
        WEND
        xleft(y) = x
        WHILE POINT(x, y) = prc AND x < mx2
            x = x + 1
        WEND
        WHILE POINT(x, y) <> prc AND x < mx2
            x = x + 1
        WEND
        IF x = mx2 THEN xright(y) = xleft(y) ELSE xright(y) = x
    NEXT
    _DEST destHandle&
    FOR y = 0 TO mx2
        IF xleft(y) <> mx2 THEN LINE (xleft(y) + x0 - TEmax, y + y0 - TEmax)-(xright(y) + x0 - TEmax, y + y0 - TEmax), c, BF
    NEXT
    _FREEIMAGE tef
END SUB

'Function PixelCollide (Obj1 As TypeSPRITE, Obj2 As TypeSPRITE, Intersect As TypePOINT)
'    '--------------------------------------------------------------------------------------------------------
'    '- Checks for pixel perfect collision between two rectangular areas. -
'    '- Returns -1 if in collision                                        -
'    '- Returns  0 if no collision                                        -
'    '-                                                                   -
'    '- obj1 - rectangle 1 coordinates                                    -
'    '- obj2 - rectangle 2 coordinates                                    -
'    '---------------------------------------------------------------------
'    Dim x%, y%
'    Dim x1%, y1% ' upper left x,y coordinate of rectangular collision area
'    Dim x2%, y2% ' lower right x,y coordinate of rectangular collision area
'    Dim Test1& '   overlap image 1 to test for collision
'    Dim Test2& '   overlap image 2 to test for collision
'    Dim Hit% '     -1 (TRUE) if a collision occurs, 0 (FALSE) otherwise
'    Dim Osource& ' original source image handle
'    Dim p1~& '     alpha value of pixel on image 1
'    Dim p2~& '     alpha value of pixel on image 2

'    Obj1.x2 = Obj1.x1 + _Width(Obj1.image) - 1 '  calculate lower right x,y coordinates of both objects
'    Obj1.y2 = Obj1.y1 + _Height(Obj1.image) - 1
'    Obj2.x2 = Obj2.x1 + _Width(Obj2.image) - 1
'    Obj2.y2 = Obj2.y1 + _Height(Obj2.image) - 1
'    Hit% = 0 '                                    assume no collision

'    '+-------------------------------------+
'    '| perform rectangular collision check |
'    '+-------------------------------------+

'    If Obj1.x2 >= Obj2.x1 Then '                  rect 1 lower right X >= rect 2 upper left  X ?
'        If Obj1.x1 <= Obj2.x2 Then '              rect 1 upper left  X <= rect 2 lower right X ?
'            If Obj1.y2 >= Obj2.y1 Then '          rect 1 lower right Y >= rect 2 upper left  Y ?
'                If Obj1.y1 <= Obj2.y2 Then '      rect 1 upper left  Y <= rect 2 lower right Y ?

'                    '+-----------------------------------------------------------------------+
'                    '| rectangular collision detected, perform pixel perfect collision check |
'                    '+-----------------------------------------------------------------------+

'                    If Obj2.x1 <= Obj1.x1 Then x1% = Obj1.x1 Else x1% = Obj2.x1 '        calculate overlapping coordinates
'                    If Obj2.y1 <= Obj1.y1 Then y1% = Obj1.y1 Else y1% = Obj2.y1
'                    If Obj2.x2 <= Obj1.x2 Then x2% = Obj2.x2 Else x2% = Obj1.x2
'                    If Obj2.y2 <= Obj1.y2 Then y2% = Obj2.y2 Else y2% = Obj1.y2
'                    Test1& = _NewImage(x2% - x1% + 1, y2% - y1% + 1, 32) '               make overlap image of object 1
'                    Test2& = _NewImage(x2% - x1% + 1, y2% - y1% + 1, 32) '               make overlap image of object 2
'                    _PutImage (-(x1% - Obj1.x1), -(y1% - Obj1.y1)), Obj1.image, Test1& ' place overlap area of object 1
'                    _PutImage (-(x1% - Obj2.x1), -(y1% - Obj2.y1)), Obj2.image, Test2& ' place overlap area of object 2
'                    x% = 0 '                                                             reset overlap area coordinate counters
'                    y% = 0
'                    Osource& = _Source '                                                 remember calling source
'                    Do '                                                                 begin pixel collide loop
'                        _Source Test1& '                                                 read from image 1
'                        p1~& = _Alpha32(Point(x%, y%)) '                                 get alpha level of pixel
'                        _Source Test2& '                                                 read from image 2
'                        p2~& = _Alpha32(Point(x%, y%)) '                                 get alpha level of pixel
'                        If (p1~& <> 0) And (p2~& <> 0) Then '                            are both pixels transparent?
'                            Hit% = -1 '                                                  no, there must be a collision
'                            Intersect.x = x1% + x% '                                     return collision coordinates
'                            Intersect.y = y1% + y% '
'                        End If
'                        x% = x% + 1 '                                                    increment column counter
'                        If x% > _Width(Test1&) - 1 Then '                                beyond last column?
'                            x% = 0 '                                                     yes, reset x
'                            y% = y% + 1 '                                                increment row counter
'                        End If
'                    Loop Until y% > _Height(Test1&) - 1 Or Hit% '                        leave when last row or collision detected
'                    _Source Osource& '                                                   restore calling source
'                    _FreeImage Test1& '                                                  remove temporary image from RAM
'                    _FreeImage Test2&
'                End If
'            End If
'        End If
'    End If
'    PixelCollide = Hit% '                                                                return result of collision check

'End Function

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 AS LONG, biy AS LONG, biw AS LONG, bih AS LONG)
    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

' this sub needs Intersect2Boxes which uses  max, min, and BoxCollision Functions
FUNCTION PixelCollision& (img1 AS boxType, img2 AS boxType, intx AS LONG, inty AS LONG)
    ' boxType here needs at least an x, y, w, h and img
    DIM AS LONG x, y, ix, iy, iw, ih
    DIM AS _UNSIGNED LONG p1, p2
    intx = -1: inty = -1 ' no collision set
    Intersect2Boxes img1.x, img1.y, img1.w, img1.h, img2.x, img2.y, img2.w, img2.h, ix, iy, iw, ih
    IF ix <> -1 THEN ' the boxes intersect
        y = iy: x = ix
        DO
            _SOURCE img1.img
            p1 = POINT(x - img1.x, y - img1.y) ' point minus img x, y location = location in image I hope
            _SOURCE img2.img
            p2 = POINT(x - img2.x, y - img2.y)
            IF (p1 <> 0) AND (p2 <> 0) THEN
                PixelCollision& = -1: intx = x: inty = y: EXIT FUNCTION
            END IF
            IF (x + 1) > (ix + iw - 1) THEN ' get rid of 2 slow For Loops
                x = ix: y = y + 1
                IF y >= (iy + ih - 1) THEN
                    _SOURCE 0: EXIT FUNCTION
                ELSE
                    y = y + 1
                END IF
            ELSE
                x = x + 1
            END IF
        LOOP
    END IF
END FUNCTION

SUB R2_Add (re AS Vec2, se AS Vec2, m AS INTEGER)
    re.x = re.x + se.x * m
    re.y = re.y + se.y * m
END SUB 'R3_Add

SUB R2_Norm (re AS Vec2, v AS Vec2, scalar AS SINGLE)
    DIM m!
    DIM t AS Vec2
    t = v
    m! = R2_Mag!(t)
    IF m! = 0 THEN
        re.x = 0: re.y = 0
    ELSE
        re.x = (t.x / m!) * scalar
        re.y = (t.y / m!) * scalar
    END IF
END SUB 'R2_Norm

FUNCTION R2_Mag! (v AS Vec2)
    '--------------------------------------------------------------------------
    '-Obtain the scalar magnitude of 2D vector (v)                            -
    '--------------------------------------------------------------------------
    R2_Mag! = _HYPOT(v.x, v.y)
END FUNCTION 'R2_Mag!
DO: LOOP: DO: LOOP
sha_na_na_na_na_na_na_na_na_na:
Reply
#9
Thumbs Up 
(02-03-2023, 12:19 PM)OldMoses Wrote:
(01-30-2023, 04:40 PM)bplus Wrote: Actually I should get the spider clear of the collision and then reverse it or turn it. That would likely solve the original problem with reversing both spiders. If they aren't clear of each other they will reverse direction again and come together and collide again... thus getting stuck. The same goes for balls colliding with walls, just changing direction works but it is inaccurate. It should be backed up to point of collision and then direction changed.

I tried it with a few changes that eschew the angle part and just orient one spider away from the one it's colliding with. Orientation is based upon a reversal of the displacement between the two, such that even when additional collisions are detected, they will not seriously alter the direction. With some tweaking I might be able to get spiders to chase each other.

Code: (Select All)
OPTION _EXPLICIT
_TITLE "Spiders refactored Collision Experiment" 'b+ 2023-01-28    !!! Speaker volume around 20 maybe! !!!
' Experiment is to only change direction of spider that bumps into another (first) not both spiders
' I want to see I can avoid pile ups that way instead of changing directions 30% of time.

' Yes! I luv the spinning spiders and 100% reactions to collisions by 1 spider at least

' !!!!!!!!!!!!!!!!!!!          Escape to Quit         !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

RANDOMIZE TIMER
DIM SHARED xmax AS INTEGER, ymax AS INTEGER
xmax = _DESKTOPWIDTH
ymax = _DESKTOPHEIGHT
CONST nSpinners = 30
TYPE Vec2
    x AS SINGLE
    y AS SINGLE
END TYPE
TYPE SpinnerType
    p AS Vec2
    d AS Vec2
    'a AS SINGLE
    sz AS SINGLE
    c AS _UNSIGNED LONG
END TYPE
DIM SHARED s(1 TO nSpinners) AS SpinnerType

TYPE boxType ' for PixelCollison&
    AS SINGLE dx, dy
    'AS Vec2 d
    AS LONG img, x, y, w, h
    c AS _UNSIGNED LONG
END TYPE

'DIM power1
DIM AS LONG i, j, iImg, jImg, lc, i2, sc, intx, inty
DIM AS boxType sIo, sJo

sc = _SCREENIMAGE
SCREEN _NEWIMAGE(xmax, ymax, 32)
_FULLSCREEN
FOR i = 1 TO nSpinners
    newSpinner i
NEXT
i2 = 1
WHILE INKEY$ <> CHR$(27)
    _PUTIMAGE , sc, 0
    lc = lc + 1
    IF lc MOD 100 = 99 THEN
        lc = 0
        IF i2 < nSpinners THEN i2 = i2 + 1
    END IF
    FOR i = 1 TO i2

        'ready for collision check

        ' max sz = .75 which needs 140 x 140 image square  +++++++++++++++++++++++++
        iImg = _NEWIMAGE(140, 140, 32)
        _DEST iImg
        drawSpinner iImg, 70, 70, s(i).sz, _ATAN2(s(i).d.y, s(i).d.x), s(i).c
        _DEST 0
        sIo.x = s(i).p.x - 70
        sIo.y = s(i).p.y - 70
        sIo.w = 140
        sIo.h = 140
        sIo.img = iImg ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++

        's(i).a = _ATAN2(s(i).d.y, s(i).d.x)
        'power1 = _HYPOT(s(i).d.x, s(i).d.y) '(s(i).dx ^ 2 + s(i).dy ^ 2) ^ .5
        'imoved = 0
        FOR j = i + 1 TO i2

            ' max sz = .75 which needs 140 x 140 image square +++++++++++++++++++++
            jImg = _NEWIMAGE(140, 140, 32)
            _DEST jImg
            drawSpinner jImg, 70, 70, s(j).sz, _ATAN2(s(j).d.y, s(j).d.x), s(j).c
            _DEST 0
            sJo.x = s(j).p.x - 70
            sJo.y = s(j).p.y - 70
            sJo.w = 140
            sJo.h = 140
            sJo.img = jImg

            IF PixelCollision&(sIo, sJo, intx, inty) THEN '+++++++++++++++++++++++++++++++++++++++
                SOUND RND * 5000 + 1000, .1 * RND
                's(i).a = s(i).a + _PI(.33) ' turn 30 degrees
                's(i).d.x = power1 * COS(s(i).a) 'update dx, dy
                's(i).d.y = power1 * SIN(s(i).a)
                DIM sep AS Vec2
                sep = s(i).p: R2_Add sep, s(j).p, -1 'separation vector between spiders
                R2_Norm s(i).d, sep, R2_Mag(s(i).d) 'set displacement to separation vector same speed
                R2_Add s(i).p, s(i).d, 3 'add 3x displacement "jump" to position
                EXIT FOR
            END IF
            _FREEIMAGE jImg
        NEXT
        R2_Add s(i).p, s(i).d, 1
        IF s(i).p.x < -100 OR s(i).p.x > xmax + 100 OR s(i).p.y < -100 OR s(i).p.y > ymax + 100 THEN newSpinner i
        _PUTIMAGE (s(i).p.x - 70, s(i).p.y - 70), iImg, 0
        _FREEIMAGE iImg
    NEXT
    _DISPLAY
    _LIMIT 15
WEND

SUB newSpinner (i AS INTEGER) 'set Spinners dimensions start angles, color?
    DIM r
    s(i).sz = RND * .25 + .5
    IF RND < .5 THEN r = -1 ELSE r = 1
    s(i).d.x = (s(i).sz * RND * 8) * r * 2 + 2: s(i).d.y = (s(i).sz * RND * 8) * r * 2 + 2
    r = INT(RND * 4)
    SELECT CASE r
        CASE 0: s(i).p.x = RND * (xmax - 120) + 60: s(i).p.y = 0: IF s(i).d.y < 0 THEN s(i).d.y = -s(i).d.y
        CASE 1: s(i).p.x = RND * (xmax - 120) + 60: s(i).p.y = ymax: IF s(i).d.y > 0 THEN s(i).d.y = -s(i).d.y
        CASE 2: s(i).p.x = 0: s(i).p.y = RND * (ymax - 120) + 60: IF s(i).d.x < 0 THEN s(i).d.x = -s(i).d.x
        CASE 3: s(i).p.x = xmax: s(i).p.y = RND * (ymax - 120) + 60: IF s(i).d.x > 0 THEN s(i).d.x = -s(i).d.x
    END SELECT
    r = RND * 100 + 40
    s(i).c = _RGB32(r, .5 * RND * r, RND * .25 * r)
END SUB

SUB drawSpinner (idest&, x AS INTEGER, y AS INTEGER, scale AS SINGLE, heading AS SINGLE, c AS _UNSIGNED LONG)
    DIM x1, x2, x3, x4, y1, y2, y3, y4, r, a, a1, a2, lg, d, rd, red, blue, green
    STATIC switch AS INTEGER
    switch = switch + 2
    switch = switch MOD 16 + 1
    red = _RED32(c): green = _GREEN32(c): blue = _BLUE32(c)
    r = 10 * scale
    x1 = x + r * COS(heading): y1 = y + r * SIN(heading)
    r = 2 * r 'lg lengths
    FOR lg = 1 TO 8
        IF lg < 5 THEN
            a = heading + .9 * lg * _PI(1 / 5) + (lg = switch) * _PI(1 / 10)
        ELSE
            a = heading - .9 * (lg - 4) * _PI(1 / 5) - (lg = switch) * _PI(1 / 10)
        END IF
        x2 = x1 + r * COS(a): y2 = y1 + r * SIN(a)
        drawLink idest&, x1, y1, 3 * scale, x2, y2, 2 * scale, _RGB32(red + 20, green + 10, blue + 5)
        IF lg = 1 OR lg = 2 OR lg = 7 OR lg = 8 THEN d = -1 ELSE d = 1
        a1 = a + d * _PI(1 / 12)
        x3 = x2 + r * 1.5 * COS(a1): y3 = y2 + r * 1.5 * SIN(a1)
        drawLink idest&, x2, y2, 2 * scale, x3, y3, scale, _RGB32(red + 35, green + 17, blue + 8)
        rd = INT(RND * 8) + 1
        a2 = a1 + d * _PI(1 / 8) * rd / 8
        x4 = x3 + r * 1.5 * COS(a2): y4 = y3 + r * 1.5 * SIN(a2)
        drawLink idest&, x3, y3, scale, x4, y4, scale, _RGB32(red + 50, green + 25, blue + 12)
    NEXT
    r = r * .5
    fcirc x1, y1, r, _RGB32(red - 20, green - 10, blue - 5)
    x2 = x1 + (r + 1) * COS(heading - _PI(1 / 12)): y2 = y1 + (r + 1) * SIN(heading - _PI(1 / 12))
    fcirc x2, y2, r * .2, &HFF000000
    x2 = x1 + (r + 1) * COS(heading + _PI(1 / 12)): y2 = y1 + (r + 1) * SIN(heading + _PI(1 / 12))
    fcirc x2, y2, r * .2, &HFF000000
    r = r * 2
    x1 = x + r * .9 * COS(heading + _PI): y1 = y + r * .9 * SIN(heading + _PI)
    TiltedEllipseFill idest&, x1, y1, r, .7 * r, heading + _PI, _RGB32(red, green, blue)
END SUB

SUB drawLink (idest&, x1, y1, r1, x2, y2, r2, c AS _UNSIGNED LONG)
    DIM a, a1, a2, x3, x4, x5, x6, y3, y4, y5, y6
    a = _ATAN2(y2 - y1, x2 - x1)
    a1 = a + _PI(1 / 2)
    a2 = a - _PI(1 / 2)
    x3 = x1 + r1 * COS(a1): y3 = y1 + r1 * SIN(a1)
    x4 = x1 + r1 * COS(a2): y4 = y1 + r1 * SIN(a2)
    x5 = x2 + r2 * COS(a1): y5 = y2 + r2 * SIN(a1)
    x6 = x2 + r2 * COS(a2): y6 = y2 + r2 * SIN(a2)
    fquad idest&, x3, y3, x4, y4, x5, y5, x6, y6, c
    fcirc x1, y1, r1, c
    fcirc x2, y2, r2, c
END SUB

'need 4 non linear points (not all on 1 line) list them clockwise so x2, y2 is opposite of x4, y4
SUB fquad (idest&, x1 AS INTEGER, y1 AS INTEGER, x2 AS INTEGER, y2 AS INTEGER, x3 AS INTEGER, y3 AS INTEGER, x4 AS INTEGER, y4 AS INTEGER, c AS _UNSIGNED LONG)
    ftri idest&, x1, y1, x2, y2, x4, y4, c
    ftri idest&, x3, y3, x4, y4, x1, y1, c
END SUB

SUB ftri (idest&, x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
    DIM a&
    a& = _NEWIMAGE(1, 1, 32)
    _DEST a&
    PSET (0, 0), K
    _DEST idest&
    _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
    _FREEIMAGE a& '<<< this is important!
END SUB

SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
    DIM Radius AS INTEGER, RadiusError AS INTEGER
    DIM X AS INTEGER, Y AS INTEGER
    Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
    IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
    LINE (CX - X, CY)-(CX + X, CY), C, BF
    WHILE X > Y
        RadiusError = RadiusError + Y * 2 + 1
        IF RadiusError >= 0 THEN
            IF X <> Y + 1 THEN
                LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            END IF
            X = X - 1
            RadiusError = RadiusError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    WEND
END SUB

SUB TiltedEllipseFill (destHandle&, x0, y0, a, b, ang, c AS _UNSIGNED LONG)
    DIM TEmax AS INTEGER, mx2 AS INTEGER, i AS INTEGER, j AS INTEGER, k AS SINGLE, lasti AS SINGLE, lastj AS SINGLE
    DIM prc AS _UNSIGNED LONG, tef AS LONG
    prc = _RGB32(255, 255, 255, 255)
    IF a > b THEN TEmax = a + 1 ELSE TEmax = b + 1
    mx2 = TEmax + TEmax
    tef = _NEWIMAGE(mx2, mx2)
    _DEST tef
    _SOURCE tef 'point wont read without this!
    FOR k = 0 TO 6.2832 + .05 STEP .1
        i = TEmax + a * COS(k) * COS(ang) + b * SIN(k) * SIN(ang)
        j = TEmax + a * COS(k) * SIN(ang) - b * SIN(k) * COS(ang)
        IF k <> 0 THEN
            LINE (lasti, lastj)-(i, j), prc
        ELSE
            PSET (i, j), prc
        END IF
        lasti = i: lastj = j
    NEXT
    DIM xleft(mx2) AS INTEGER, xright(mx2) AS INTEGER, x AS INTEGER, y AS INTEGER
    FOR y = 0 TO mx2
        x = 0
        WHILE POINT(x, y) <> prc AND x < mx2
            x = x + 1
        WEND
        xleft(y) = x
        WHILE POINT(x, y) = prc AND x < mx2
            x = x + 1
        WEND
        WHILE POINT(x, y) <> prc AND x < mx2
            x = x + 1
        WEND
        IF x = mx2 THEN xright(y) = xleft(y) ELSE xright(y) = x
    NEXT
    _DEST destHandle&
    FOR y = 0 TO mx2
        IF xleft(y) <> mx2 THEN LINE (xleft(y) + x0 - TEmax, y + y0 - TEmax)-(xright(y) + x0 - TEmax, y + y0 - TEmax), c, BF
    NEXT
    _FREEIMAGE tef
END SUB

'Function PixelCollide (Obj1 As TypeSPRITE, Obj2 As TypeSPRITE, Intersect As TypePOINT)
'    '--------------------------------------------------------------------------------------------------------
'    '- Checks for pixel perfect collision between two rectangular areas. -
'    '- Returns -1 if in collision                                        -
'    '- Returns  0 if no collision                                        -
'    '-                                                                   -
'    '- obj1 - rectangle 1 coordinates                                    -
'    '- obj2 - rectangle 2 coordinates                                    -
'    '---------------------------------------------------------------------
'    Dim x%, y%
'    Dim x1%, y1% ' upper left x,y coordinate of rectangular collision area
'    Dim x2%, y2% ' lower right x,y coordinate of rectangular collision area
'    Dim Test1& '   overlap image 1 to test for collision
'    Dim Test2& '   overlap image 2 to test for collision
'    Dim Hit% '     -1 (TRUE) if a collision occurs, 0 (FALSE) otherwise
'    Dim Osource& ' original source image handle
'    Dim p1~& '     alpha value of pixel on image 1
'    Dim p2~& '     alpha value of pixel on image 2

'    Obj1.x2 = Obj1.x1 + _Width(Obj1.image) - 1 '  calculate lower right x,y coordinates of both objects
'    Obj1.y2 = Obj1.y1 + _Height(Obj1.image) - 1
'    Obj2.x2 = Obj2.x1 + _Width(Obj2.image) - 1
'    Obj2.y2 = Obj2.y1 + _Height(Obj2.image) - 1
'    Hit% = 0 '                                    assume no collision

'    '+-------------------------------------+
'    '| perform rectangular collision check |
'    '+-------------------------------------+

'    If Obj1.x2 >= Obj2.x1 Then '                  rect 1 lower right X >= rect 2 upper left  X ?
'        If Obj1.x1 <= Obj2.x2 Then '              rect 1 upper left  X <= rect 2 lower right X ?
'            If Obj1.y2 >= Obj2.y1 Then '          rect 1 lower right Y >= rect 2 upper left  Y ?
'                If Obj1.y1 <= Obj2.y2 Then '      rect 1 upper left  Y <= rect 2 lower right Y ?

'                    '+-----------------------------------------------------------------------+
'                    '| rectangular collision detected, perform pixel perfect collision check |
'                    '+-----------------------------------------------------------------------+

'                    If Obj2.x1 <= Obj1.x1 Then x1% = Obj1.x1 Else x1% = Obj2.x1 '        calculate overlapping coordinates
'                    If Obj2.y1 <= Obj1.y1 Then y1% = Obj1.y1 Else y1% = Obj2.y1
'                    If Obj2.x2 <= Obj1.x2 Then x2% = Obj2.x2 Else x2% = Obj1.x2
'                    If Obj2.y2 <= Obj1.y2 Then y2% = Obj2.y2 Else y2% = Obj1.y2
'                    Test1& = _NewImage(x2% - x1% + 1, y2% - y1% + 1, 32) '               make overlap image of object 1
'                    Test2& = _NewImage(x2% - x1% + 1, y2% - y1% + 1, 32) '               make overlap image of object 2
'                    _PutImage (-(x1% - Obj1.x1), -(y1% - Obj1.y1)), Obj1.image, Test1& ' place overlap area of object 1
'                    _PutImage (-(x1% - Obj2.x1), -(y1% - Obj2.y1)), Obj2.image, Test2& ' place overlap area of object 2
'                    x% = 0 '                                                             reset overlap area coordinate counters
'                    y% = 0
'                    Osource& = _Source '                                                 remember calling source
'                    Do '                                                                 begin pixel collide loop
'                        _Source Test1& '                                                 read from image 1
'                        p1~& = _Alpha32(Point(x%, y%)) '                                 get alpha level of pixel
'                        _Source Test2& '                                                 read from image 2
'                        p2~& = _Alpha32(Point(x%, y%)) '                                 get alpha level of pixel
'                        If (p1~& <> 0) And (p2~& <> 0) Then '                            are both pixels transparent?
'                            Hit% = -1 '                                                  no, there must be a collision
'                            Intersect.x = x1% + x% '                                     return collision coordinates
'                            Intersect.y = y1% + y% '
'                        End If
'                        x% = x% + 1 '                                                    increment column counter
'                        If x% > _Width(Test1&) - 1 Then '                                beyond last column?
'                            x% = 0 '                                                     yes, reset x
'                            y% = y% + 1 '                                                increment row counter
'                        End If
'                    Loop Until y% > _Height(Test1&) - 1 Or Hit% '                        leave when last row or collision detected
'                    _Source Osource& '                                                   restore calling source
'                    _FreeImage Test1& '                                                  remove temporary image from RAM
'                    _FreeImage Test2&
'                End If
'            End If
'        End If
'    End If
'    PixelCollide = Hit% '                                                                return result of collision check

'End Function

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 AS LONG, biy AS LONG, biw AS LONG, bih AS LONG)
    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

' this sub needs Intersect2Boxes which uses  max, min, and BoxCollision Functions
FUNCTION PixelCollision& (img1 AS boxType, img2 AS boxType, intx AS LONG, inty AS LONG)
    ' boxType here needs at least an x, y, w, h and img
    DIM AS LONG x, y, ix, iy, iw, ih
    DIM AS _UNSIGNED LONG p1, p2
    intx = -1: inty = -1 ' no collision set
    Intersect2Boxes img1.x, img1.y, img1.w, img1.h, img2.x, img2.y, img2.w, img2.h, ix, iy, iw, ih
    IF ix <> -1 THEN ' the boxes intersect
        y = iy: x = ix
        DO
            _SOURCE img1.img
            p1 = POINT(x - img1.x, y - img1.y) ' point minus img x, y location = location in image I hope
            _SOURCE img2.img
            p2 = POINT(x - img2.x, y - img2.y)
            IF (p1 <> 0) AND (p2 <> 0) THEN
                PixelCollision& = -1: intx = x: inty = y: EXIT FUNCTION
            END IF
            IF (x + 1) > (ix + iw - 1) THEN ' get rid of 2 slow For Loops
                x = ix: y = y + 1
                IF y >= (iy + ih - 1) THEN
                    _SOURCE 0: EXIT FUNCTION
                ELSE
                    y = y + 1
                END IF
            ELSE
                x = x + 1
            END IF
        LOOP
    END IF
END FUNCTION

SUB R2_Add (re AS Vec2, se AS Vec2, m AS INTEGER)
    re.x = re.x + se.x * m
    re.y = re.y + se.y * m
END SUB 'R3_Add

SUB R2_Norm (re AS Vec2, v AS Vec2, scalar AS SINGLE)
    DIM m!
    DIM t AS Vec2
    t = v
    m! = R2_Mag!(t)
    IF m! = 0 THEN
        re.x = 0: re.y = 0
    ELSE
        re.x = (t.x / m!) * scalar
        re.y = (t.y / m!) * scalar
    END IF
END SUB 'R2_Norm

FUNCTION R2_Mag! (v AS Vec2)
    '--------------------------------------------------------------------------
    '-Obtain the scalar magnitude of 2D vector (v)                            -
    '--------------------------------------------------------------------------
    R2_Mag! = _HYPOT(v.x, v.y)
END FUNCTION 'R2_Mag!

Nice mod @Oldmoses, You have achieved a better spider reaction to collision, one I was hoping to get.

When a slow spider gets in front of a large (which moves faster) it keeps getting bumped forward. A little less same direction and it gets slowly spun out of way as bigger spider plows through.

Your vector magic looking good!
b = b + ...
Reply
#10
Thanks, I am working on a way to get the larger spider to chase the smaller one after a collision, but there seems to be a tendency for the two to get stuck and oscillate back and forth in one place. A bit of a head scratcher...
DO: LOOP: DO: LOOP
sha_na_na_na_na_na_na_na_na_na:
Reply




Users browsing this thread: 1 Guest(s)