Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Another small filled circe sub (not as fast as fcirc)
#91
(09-02-2024, 07:40 PM)bplus Wrote: +1 @Dav it's certainly faster than my DrawBall version
[...]
I am adding $Checking: Off | On to these routines.
nice meta analysis, bplus, so is mine on the podium there?
Reply
#92
Code: (Select All)
'vince's circle fill   this one does not bother with types good almost identical to Steve's
Sub fcirc1 (x, y, r, c As _Unsigned Long)
    x0 = r
    y0 = 0
    e = -r
    Do While y0 < x0
        If e <= 0 Then
            y0 = y0 + 1
            Line (x - x0, y + y0)-(x + x0, y + y0), c, BF
            Line (x - x0, y - y0)-(x + x0, y - y0), c, BF
            e = e + 2 * y0
        Else
            Line (x - y0, y - x0)-(x + y0, y - x0), c, BF
            Line (x - y0, y + x0)-(x + y0, y + x0), c, BF
            x0 = x0 - 1
            e = e - 2 * x0
        End If
    Loop
    Line (x - r, y)-(x + r, y), c, BF
End Sub

Read the thread, I used this in Speed tests and Samuel saw it and used it in his version.
b = b + ...
Reply
#93
I made mine just a tick slower than Steve's out of respect, so if his is #1 I'll take the solid silver
Reply
#94
I suspect I know what this is doing:
Code: (Select All)
e = e + 2 * y0
else
e = e - 2 * x0

Can you put it into words so maybe I can confirm my suspicions.

BTW what we are calling Steve's is a version of Bresenham
from StackOverFlow
void circle(Point p, int r) {
int x = 0;
int y = r;
int f = 1-r;

// plot vert/horiz points indepedently

while (x<y) {
x++;

if (f<0) {
f += 2*x+1;
} else {
y--;
f += 2*(x-y+1);
}

glRecti(p.x+x, p.y+y, p.x+x+1, p.y+y+1);
// plot other points using 8 way symmetry

// attempt to fill the circle - didn't go well
plotLine(Point(p.x, p.y+x), Point(p.x+x, p.y+x));

}
}


Update: that code is wrong! "didn't go well" indeed! Smile

which looks more like vince version!

No creators here just copiers LOL we stand on shoulders of other great copiers.
BTW I was just watching argument of Creationist against evolution because I got into discussion about man not evolving from ape but BOTH evolving from a common ancestor species down the tree of Life.
b = b + ...
Reply
#95
yeah the "meta" algorithm is called Bresenham's and it's only a matter of from who each of us stole it from.  I attached the couple of PDFs from where i learned it, then just typed it out in QB64, nothing original

the superficial way to draw a circle is to use square root, ie r = sqr(x^2 + y^2) and go from there, and likely on modern processors a simple square root might be as fast as addition, depending on how and where -- bresenham's just optimizes it away into sheer addition.  the next consideration for filled circles is transparency support, avoiding overlapping lines, and assuming LINE BF is super fast as it should be


Attached Files
.pdf   BCIRCLE.PDF (Size: 42.31 KB / Downloads: 18)
.pdf   BELIPSE.PDF (Size: 46.68 KB / Downloads: 13)
Reply
#96
Thankyou vince for PDF's because I was considering doing a Circle, one to replace our faulty Circle built-in, ie you can NOT do transparent circles without lighter pixels on the x, y axis. It might come in handy for someone needing Transparent Circle edges.

Update: yeah these
Code: (Select All)
e = e + 2 * y0
else
e = e - 2 * x0

are what's getting around the need for SQR. Something about using the derivative of Square function for X^2 = 2x plus some fooling around Smile
b = b + ...
Reply
#97
Hey, @NakedApe.  That's cool!   Runs smooth for me here even on my kinda slow 12 year old laptop.  

Deserves it's own thread, to make sure others can notice it

I think I'm going to make a BALL demos thread in my forum area, collecting so many ball demos now.

- Dav

Find my programs here in Dav's QB64 Corner
Reply
#98
@Dav you might throw in an exit sub if radius = 0 or do a pixel then exit. So SQR(r2 - y*y) stays > 0
b = b + ...
Reply
#99
Good idea, @bplus. Thanks.

- Dav

Find my programs here in Dav's QB64 Corner
Reply
Well, it looks like this thread is finally winding down.  Thanks for all the fun action, everyone!  I'll will post my final FC SUB and last ball demo here using it.   This had to be the most fun and challenging ball demo I've worked on.  Bouncing balls inside a big ball, moving on the screen.  It was a great learning experience, and I tried to fully comment the code.  Hope you like it.  FC SUB is posted at the bottom.

- Dav

Code: (Select All)
'===============
'BIGBALLDEMO.BAS
'===============
'Bouncing balls demo using vector reflection.
'By Dav, SEP 3rd/2024, for QB64 Phoenix Edition.

'===============
'About this demo
'===============

'This demo shows balls bouncing inside a bigger ball, and other balls
'bouncing on the outside.  It uses my FC SUB to draw all the balls.
'Use the mouse to move the big ball.  Press Any key to exit the demo.

'============================
'More details about this demo
'============================

'This demo was a challenge and a great learning experience for me.
'Instead of just reversing velocity direction when a ball hits an object,
'this demo uses 'vector reflection' to make them bounce realistically.
'When two balls collide, their velocity vector changes direction based on
'angle of impact, and the normal vector at the contact point.  Their
'reflection velocities are computed based on their sizes, and their x/y
'positions are adjusted to prevent overlapping after collision.

Randomize Timer

Screen _NewImage(1000, 700, 32)

'=== defaults for the bigball ===
bigballsize = 200
bigballx = _Width / 2
bigbally = _Height / 2

'=== arrays for inside balls ===
insidenum = 50 'num of inside balls
Dim insidex(insidenum) 'x positions of inside balls
Dim insidey(insidenum) 'ypositions of inside balls
Dim insidexv(insidenum) 'x velocities of inside balls
Dim insideyv(insidenum) 'y velocities of inside balls
Dim insidesize(insidenum) 'sizes of inside balls
Dim insideclr~&(insidenum) 'colors of inside balls

'=== arrays for outside balls ===
outsidenum = 150 'num of outside balls
Dim outsidex(outsidenum) 'x positions of outside balls
Dim outsidey(outsidenum) 'y positions of outside balls
Dim outsidexv(outsidenum) 'x velocities of outside balls
Dim outsideyv(outsidenum) 'y velocities of outside balls
Dim outsidesizes(outsidenum) 'sizes of outside balls
Dim outsideclr~&(outsidenum) 'colors of outside balls

'=== initialize inside balls ===
For i = 0 To insidenum - 1
    insidesize(i) = 5 + (Rnd * 15) 'random size
    insideclr~&(i) = _RGBA(Rnd * 255, Rnd * 255, Rnd * 255, 200) 'color
    insidexv(i) = (Rnd * 2 + 1) * (2 * Rnd - 1) 'x velocity between -3 and 3
    insideyv(i) = (Rnd * 2 + 1) * (2 * Rnd - 1) 'y velocity between -3 and 3
Next

'=== initialize outside Balls ===
For j = 0 To outsidenum - 1
    outsidesizes(j) = Int(Rnd * 26) + 5 'random size
    outsideclr~&(j) = _RGBA(Rnd * 225, Rnd * 225, Rnd * 225, 125) 'color
    outsidex(j) = Int(Rnd * _Width) 'x position
    outsidey(j) = Int(Rnd * _Height) 'y position
    outsidexv(j) = (Rnd * 2 + 1) * (2 * Rnd - 1) 'x velocity between -3 and 3
    outsideyv(j) = (Rnd * 2 + 1) * (2 * Rnd - 1) 'y velocity between -3 and 3
Next

'=== draw a background image ===
For i = 1 To 1000
    fc Rnd * _Width, Rnd * _Height, 20, _RGBA(55 + (Rnd * 100), 55 + (Rnd * 150), 55 + (Rnd * 200), 30), 0
Next: back& = _CopyImage(_Display)

'=== put mouse in middle of screen ===
_MouseMove _Width / 2, _Height / 2

'=========
'MAIN LOOP
'=========

Do

    '=== put down background image ===
    Cls: _PutImage (0, 0), back&

    '=== get mouse input ===
    While _MouseInput: Wend

    '=== assign bigball x/y to mouse x/y ===
    bigballx = _MouseX: bigbally = _MouseY

    '=== handle inside balls ===
    For i = 0 To insidenum - 1
        '== move inside balls ==
        insidex(i) = insidex(i) + insidexv(i)
        insidey(i) = insidey(i) + insideyv(i)

        '=== check if they collide with bigball edge ===
        'calculate distance from the center x/y of bigball
        dis = Sqr((insidex(i) - bigballx) ^ 2 + (insidey(i) - bigbally) ^ 2)

        'check if distance + insideball size exceeds bigball size
        If dis + insidesize(i) > bigballsize Then
            'calculate normal vector for reflection
            x = (insidex(i) - bigballx) / dis
            y = (insidey(i) - bigbally) / dis
            'calculate the reflection of velocity based impact angle
            vr = insidexv(i) * x + insideyv(i) * y
            'update velocity of insideball based on the normal
            insidexv(i) = insidexv(i) - 2 * vr * x
            insideyv(i) = insideyv(i) - 2 * vr * y
            'below prevents overlapping by pushing insideball back
            over = (dis + insidesize(i)) - bigballsize
            insidex(i) = insidex(i) - x * over
            insidey(i) = insidey(i) - y * over
        End If

        '=== finally draw insideball ===
        fc insidex(i), insidey(i), insidesize(i), insideclr~&(i), 1
    Next

    '=== handle collisions of insideballs ===
    For i = 0 To insidenum - 1
        For j = i + 1 To insidenum - 1
            If i <> j Then
                'calculate distance between the two insideballs
                dx = insidex(j) - insidex(i)
                dy = insidey(j) - insidey(i)
                dis = Sqr(dx * dx + dy * dy)
                'check for collision, if so...
                If dis < (insidesize(i) + insidesize(j)) Then
                    'calculate normal vector and overlapping distance
                    x = dx / dis: y = dy / dis 'normal
                    over = (insidesize(i) + insidesize(j)) - dis 'overlap distance
                    'move balls apart based on overlap amount
                    insidex(i) = insidex(i) - x * (over / 2)
                    insidey(i) = insidey(i) - y * (over / 2)
                    insidex(j) = insidex(j) + x * (over / 2)
                    insidey(j) = insidey(j) + y * (over / 2)
                    'reflect velocities based on collision
                    vr = (insidexv(j) - insidexv(i)) * x + (insideyv(j) - insideyv(i)) * y
                    'update ball velocities based on collision
                    insidexv(i) = insidexv(i) + vr * x: insideyv(i) = insideyv(i) + vr * y
                    insidexv(j) = insidexv(j) - vr * x: insideyv(j) = insideyv(j) - vr * y
                End If
            End If
        Next
    Next

    '=== handle Outside balls ===
    For j = 0 To outsidenum - 1
        'draw outside ball
        fc outsidex(j), outsidey(j), outsidesizes(j), outsideclr~&(j), 1
        outsidex(j) = outsidex(j) + outsidexv(j)
        outsidey(j) = outsidey(j) + outsideyv(j)
        'these bounce the ball off the edges of screen.
        'if outsideballs hits the edge, reverse directions.
        If outsidex(j) < outsidesizes(j) Then
            outsidex(j) = outsidesizes(j): outsidexv(j) = -outsidexv(j)
        End If
        If outsidex(j) > _Width - outsidesizes(j) Then
            outsidex(j) = _Width - outsidesizes(j): outsidexv(j) = -outsidexv(j)
        End If
        If outsidey(j) < outsidesizes(j) Then
            outsidey(j) = outsidesizes(j): outsideyv(j) = -outsideyv(j)
        End If
        If outsidey(j) > _Height - outsidesizes(j) Then
            outsidey(j) = _Height - outsidesizes(j): outsideyv(j) = -outsideyv(j)
        End If

        '==== check for otsideball collision with bigball ===
        'calculate distance from center
        dis = Sqr((outsidex(j) - bigballx) ^ 2 + (outsidey(j) - bigbally) ^ 2)
        If dis < (bigballsize + outsidesizes(j)) Then
            'calculate the normal vector
            x = (outsidex(j) - bigballx) / dis
            y = (outsidey(j) - bigbally) / dis
            'reflect the velocity off the normal vector
            vr = outsidexv(j) * x + outsideyv(j) * y
            outsidexv(j) = outsidexv(j) - 2 * vr * x
            outsideyv(j) = outsideyv(j) - 2 * vr * y
            'move outside ball back
            'calculate how much it's overlapping...
            over = (bigballsize + outsidesizes(j)) - dis
            'move it away from the bigball
            outsidex(j) = outsidex(j) + x * over
            outsidey(j) = outsidey(j) + y * over
        End If
    Next

    '=== handle collisions between the outsideballs ===
    For i = 0 To outsidenum - 1
        For j = i + 1 To outsidenum - 1
            If i <> j Then
                'get distance between the two outside balls
                dx = outsidex(j) - outsidex(i)
                dy = outsidey(j) - outsidey(i)
                dis = Sqr(dx * dx + dy * dy)
                'check for collision, if so...
                If dis < (outsidesizes(i) + outsidesizes(j)) Then
                    'calculate normal vector and overlapping distance
                    x = dx / dis: y = dy / dis
                    'total overlap distance
                    over = (outsidesizes(i) + outsidesizes(j)) - dis
                    'move balls apart based on overlap
                    outsidex(i) = outsidex(i) - x * (over / 2)
                    outsidey(i) = outsidey(i) - y * (over / 2)
                    outsidex(j) = outsidex(j) + x * (over / 2)
                    outsidey(j) = outsidey(j) + y * (over / 2)
                    'reflect velocities between balls
                    vr = (outsidexv(j) - outsidexv(i)) * x + (outsideyv(j) - outsideyv(i)) * y
                    'update velocities based on collision
                    outsidexv(i) = outsidexv(i) + vr * x
                    outsideyv(i) = outsideyv(i) + vr * y
                    outsidexv(j) = outsidexv(j) - vr * x
                    outsideyv(j) = outsideyv(j) - vr * y
                End If
            End If
        Next
    Next

    '=== draw the bigball ===
    fc bigballx, bigbally, bigballsize, _RGBA(100, 200, 255, 75), 0
    'draw an edge around it
    Circle (bigballx, bigbally), bigballsize, _RGBA(255, 255, 255, 75)

    _Display
    _Limit 60

Loop Until InKey$ <> ""


Sub fc (cx, cy, radius, clr~&, grad)
    'FC SUB by Dav
    'Draws filled circle at cx/cy with given radius and color.
    'If grad=1 it will create a gradient effect, otherwise it's a solid color.

    If radius = 0 Then Exit Sub 'a safety bail (thanks bplus!)

    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

Code: (Select All)
Sub fc (cx, cy, radius, clr~&, grad)
    'FC SUB by Dav
    'Draws filled circle at cx/cy with given radius and color.
    'If grad=1 it will create a gradient effect, otherwise it's a solid color.

    If radius = 0 Then Exit Sub 'a safety bail (thanks bplus!)

    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




Users browsing this thread: 70 Guest(s)