Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Another small filled circe sub (not as fast as fcirc)
Thanks, @bplus.  Smile

I updated the BALLRAIN demo posted last September with the new FC SUB and also incorporated a movable bigball and collision and overlapping technique used in the last demo.  It's easier to see how it works in this one I think, although it's only doing collision detecting with the bigball and not with other balls.

FC draws much faster than the way I did it last year (had to hardware images to go this smooth last year).

- Dav

Code: (Select All)
'=============
'BALLRAIN3.BAS
'=============
'Balls rain from the top, some drop, some bounce then sink away.
'Move bigball with mouse to block and knock them out of the way.
'Coded by Dav for QB64 Phoenix Edition, SEP/2024

'This is an updated BALLRAIN demo that demonstrates the FC SUB and how
'to do collision detection using vector reflection & overlap correction.

'Demo ends when the balls stop raining, or you press ESC.

Screen _NewImage(1000, 600, 32)

balls = 300 'number of balls on screen

Dim ballx(balls), bally(balls), ballxvel(balls), ballyvel(balls), ballsize(balls)
Dim ballred(balls), ballgrn(balls), ballblu(balls)

'make random ball values
For b = 1 To balls
    ballx(b) = Rnd * (_Width) 'x position
    bally(b) = Rnd * -(_Height) 'y position
    ballxvel(b) = Int(Rnd * 2) 'x speed
    ballyvel(b) = Int(Rnd * 2) 'y speed
    ballsize(b) = Rnd * 20 + 10 'ball size
    ballred(b) = Rnd * 255 'red color
    ballgrn(b) = Rnd * 255 'green color
    ballblu(b) = Rnd * 255 'blue color
Next

_MouseMove _Width / 2, _Height / 2

bigballsize = 100 'bigball size
bigballclr& = _RGBA(255, 0, 255, 200) 'bigball color

Do
    Cls

    While _MouseInput: Wend
    bigballx = _MouseX: bigbally = _MouseY

    'do all falling balls
    For b = 1 To balls

        If bally(b) < _Height - ballsize(b) Then

            ballx(b) = ballx(b) + ballxvel(b)
            bally(b) = bally(b) + ballyvel(b)

            If ballx(b) < ballsize(b) Or ballx(b) > _Width - ballsize(b) Then
                ballxvel(b) = -ballxvel(b)
            End If

            If bally(b) < ballsize(b) Or bally(b) > _Height - (ballsize(b) * 2) Then
                ballyvel(b) = -ballyvel(b)
            End If

            ballyvel(b) = ballyvel(b) + 3 'gravity value

            'do collision detection of balls and bigball
            'calculate distance from center
            dis = Sqr((ballx(b) - bigballx) ^ 2 + (bally(b) - bigbally) ^ 2)
            If dis < (bigballsize + ballsize(b)) Then
                'calculate the normal vector
                x = (ballx(b) - bigballx) / dis
                y = (bally(b) - bigbally) / dis
                'reflect the velocity off the normal vector
                vr = ballxvel(b) * x + ballyvel(b) * y
                ballxvel(b) = ballxvel(b) - 2 * vr * x
                ballyvel(b) = ballyvel(b) - 2 * vr * y
                'calculate how much it's overlapping
                over = (bigballsize + ballsize(b)) - dis
                'move it away from the bigball
                ballx(b) = ballx(b) + x * over
                bally(b) = bally(b) + y * over
            End If

            'draw ball, but only if it's actually on the screen
            If ballx(b) > ballsize(b) And ballx(b) < _Width + ballsize(b) Then
                If bally(b) > ballsize(b) And bally(b) < _Height + ballsize(b) Then
                    fc ballx(b), bally(b), ballsize(b), _RGBA(ballred(b), ballgrn(b), ballblu(b), 225), 1
                End If
            End If

        End If
    Next

    ' Draw the big ball
    fc bigballx, bigbally, bigballsize, bigballclr&, 1

    'Check if all the balls are off-screen
    onscreen = 0
    For b = 1 To balls
        If bally(b) < _Height - ballsize(b) Then onscreen = 1
    Next
    If onscreen = 0 Then Exit Do

    _Display
    _Limit 24

Loop Until InKey$ <> ""


Sub fc (cx, cy, radius, clr~&, grad)

    If radius = 0 Then Exit Sub ' safety bail

    If grad = 1 Then
        red = _Red32(clr~&)
        grn = _Green32(clr~&)
        blu = _Blue32(clr~&)
        alpha = _Alpha32(clr~&)
    End If
    r2 = radius * radius
    For y = -radius To radius
        x = Sqr(r2 - y * y)
        ' If doing gradient
        If grad = 1 Then
            For i = -x To x
                dis = Sqr(i * i + y * y) / radius
                red2 = red * (1 - dis) + (red / 2) * dis
                grn2 = grn * (1 - dis) + (grn / 2) * dis
                blu2 = blu * (1 - dis) + (blu / 2) * dis
                clr2~& = _RGBA(red2, grn2, blu2, alpha)
                Line (cx + i, cy + y)-(cx + i, cy + y), clr2~&, BF
            Next
        Else
            Line (cx - x, cy + y)-(cx + x, cy + y), clr~&, BF
        End If
    Next
End Sub

Find my programs here in Dav's QB64 Corner
Reply


Messages In This Thread
RE: Another small filled circe sub (not as fast as fcirc) - by Dav - 09-04-2024, 06:57 PM



Users browsing this thread: 23 Guest(s)