Angle Collisions

[James D Jarvis]

I experimented a little, I didn't get the complete results I hoped for... but something happens a little like you'd hope, some of the time. I had to make the lines at the boundaries fatter so they wouldn't get missed too often while the program looked for them so the line drawing to do that is in there too.  

Code: (Select All)

'caveball
ms& = _NewImage(800, 600, 32)
border& = _NewImage(800, 600, 32)
Randomize Timer
Dim c1 As Long
Dim klr As _Unsigned Long
Dim empty As _Unsigned Long
Screen border&
c1 = _RGB(255, 255, 255)
x1 = 50
y1 = 50
flag = 0
While flag = 0
    x2 = (Rnd * 80) + 80 + x1
    If x2 > 750 Then
        x2 = 750
        flag = 1
    End If
    y2 = Rnd * 60 + 20
    fatline x1, y1, x2, y2, 2, c1
    x1 = x2
    y1 = y2
Wend

flag = 0
While flag = 0
    y2 = (Rnd * 80) + 80 + y1
    If y2 > 550 Then
        y2 = 550
        flag = 1
    End If
    x2 = 750 - (Rnd * 60 + 20)
    fatline x1, y1, x2, y2, 2, c1
    x1 = x2
    y1 = y2
Wend

flag = 0
While flag = 0
    x2 = x1 - ((Rnd * 80) + 80)
    If x2 < 50 Then
        x2 = 50
        flag = 1
    End If
    y2 = 550 - (Rnd * 60 + 20)
    fatline x1, y1, x2, y2, 2, c1
    x1 = x2
    y1 = y2
Wend

flag = 0
While flag = 0
    y2 = y1 - ((Rnd * 80) + 80)
    If y2 < 50 Then
        y2 = 50
        flag = 1
    End If
    x2 = Rnd * 60 + 20
    If flag = 1 Then x2 = 50
    fatline x1, y1, x2, y2, 2, c1
    x1 = x2
    y1 = y2
Wend
bx = 400
by = 400
speed = 2
Screen ms&

bang = 11
Do
    _Limit 60
    Cls
    _PutImage , border&, ms&
    bang = bang + bm
    bx = bx + speed * Cos(0.01745329 * bang)
    by = by + speed * Sin(0.01745329 * bang)
    bm = 0
    For bv = bang - 120 To bang + 120 Step 10
        checkx = bx + (12 * bang / bv) * Cos(0.01745329 * bv)
        checky = by + (12 * bang / bv) * Sin(0.01745329 * bv)
        klr = Point(checkx, checky)

        If klr = c1 And bm = 0 Then

            bm = bm + bv

            ' bx = bx + 2 * Cos(0.01745329 * bang)
            'by = by + 2 * Sin(0.01745329 * bang)
        End If
    Next

    Circle (bx, by), 10, c1
    _Display
    kk$ = InKey$




Loop Until kk$ = Chr$(27)







Sub circleBF (cx As Long, cy As Long, r As Long, klr As _Unsigned Long)
    rsqrd = r * r
    y = -r
    While y <= r
        x = Sqr(rsqrd - y * y)
        Line (cx - x, cy + y)-(cx + x, cy + y), klr, BF
        y = y + 1
    Wend
End Sub

Sub fatline (x0, y0, x1, y1, r, klr As _Unsigned Long)
    If Abs(y1 - y0) < Abs(x1 - x0) Then
        If x0 > x1 Then
            lineLow x1, y1, x0, y0, r, klr

        Else
            lineLow x0, y0, x1, y1, r, klr
        End If
    Else
        If y0 > y1 Then
            lineHigh x1, y1, x0, y0, r, klr
        Else
            lineHigh x0, y0, x1, y1, r, klr
        End If
    End If
End Sub
Sub lineLow (x0, y0, x1, y1, r, klr As _Unsigned Long)
    dx = x1 - x0
    dy = y1 - y0
    yi = 1
    If dy < 0 Then
        yi = -1
        dy = -dy
    End If
    'D = (2 * dy) - dx
    d = (dy + dy) - dx
    y = y0
    For x = x0 To x1
        circleBF x, y, r, klr

        If d > 0 Then
            y = y + yi
            ' D = D + (2 * (dy - dx))
            d = d + ((dy - dx) + (dy - dx))
        Else
            ' D = D + 2 * dy
            d = d + dy + dy
        End If
    Next x
End Sub
Sub lineHigh (x0, y0, x1, y1, r, klr As _Unsigned Long)
    dx = x1 - x0
    dy = y1 - y0
    xi = 1
    If dx < 0 Then
        xi = -1
        dx = -dx
    End If
    ' D = (2 * dx) - dy
    D = (dx + dx) - dy
    x = x0
    For y = y0 To y1
        circleBF x, y, r, klr

        If D > 0 Then
            x = x + xi
            ' D = D + (2 * (dx - dy))
            D = D + ((dx - dy) + (dx - dy))
        Else
            ' D = D + 2 * dx
            D = D + dx + dx
        End If
    Next y
End Sub