Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Ellipse trouble
#11
(08-24-2022, 12:47 AM)Pete Wrote: This thread reminded me of the old .rip ellipse project. If I recall correctly, Mark, Steve and Bill, and I came up with the gold standard for ellipse drawing speed. It was fun to blow Bill's mind by putting SQR in the formula in such a way it made it faster. Of course, in his defense, Bill's only a theoretical physicist!

Pete Big Grin

I'd be interested in knowing how to speed up something like this:
(it's a rough version of a rotating ellipse)


Code: (Select All)
'ellipse rotate
'james2464



Dim scx, scy As Integer

scx = 800
scy = 600

Screen _NewImage(scx, scy, 32)

Randomize Timer
Const PI = 3.141592654#


Dim c0(100) As Long
Dim x
Dim yy, mm
Dim a, b, y
Dim a1, a2, a3
Dim b1, b2, b3
Dim dir, dv


c0(0) = _RGB(0, 0, 0) 'black
c0(1) = _RGB(255, 255, 255) 'white


Cls




'initial ellipse

a = 50
b = 150
yy = 210
mm = 260
For j = 0 To b
    y = b - j
    x = Sqr((1 - y ^ 2 / b ^ 2) * a ^ 2)
    Line (mm - x, yy - y)-(mm + x, yy - y), c0(1)
    Line (mm - x, yy + y)-(mm + x, yy + y), c0(1)
Next j


a = 40
b = 140
yy = 210
mm = 260
For j = 0 To b
    y = b - j
    x = Sqr((1 - y ^ 2 / b ^ 2) * a ^ 2)
    Line (mm - x, yy - y)-(mm + x, yy - y), c0(0)
    Line (mm - x, yy + y)-(mm + x, yy + y), c0(0)
Next j



'==================================================================

'==================================================================

'==================================================================

'==================================================================

'==================================================================

'==================================================================



'commence crude rotation


a1 = 60
a2 = 58
a3 = 56

b1 = 160
b2 = 158
b3 = 156

yy = 210
mm = 260

dir = 1
dv = 220

Do
    If dir = 1 Then
        a1 = a1 + 1
        a2 = a2 + 1
        a3 = a3 + 1
        If a1 >= b1 Then
            a1 = b1
            dir = 2
        End If
    End If
    If dir = 2 Then
        a1 = a1 - 1
        a2 = a2 - 1
        a3 = a3 - 1
        If a1 <= 1 Then
            a1 = 1
            dir = 1
        End If
    End If


    For j = 0 To b1
        y = b1 - j
        x = Sqr((1 - y ^ 2 / b1 ^ 2) * a1 ^ 2)
        Line (mm - x, yy - y)-(mm + x, yy - y), c0(0)
        Line (mm - x, yy + y)-(mm + x, yy + y), c0(0)
    Next j

    For j = 0 To b2
        y = b2 - j
        x = Sqr((1 - y ^ 2 / b2 ^ 2) * a2 ^ 2)
        Line (mm - x, yy - y)-(mm + x, yy - y), c0(1)
        Line (mm - x, yy + y)-(mm + x, yy + y), c0(1)
    Next j

    For j = 0 To b3
        y = b3 - j
        x = Sqr((1 - y ^ 2 / b3 ^ 2) * a3 ^ 2)
        Line (mm - x, yy - y)-(mm + x, yy - y), c0(0)
        Line (mm - x, yy + y)-(mm + x, yy + y), c0(0)
    Next j



    '======================================================

    'adjust display speed using "w" and "s" keys


    keypress$ = InKey$

    If keypress$ = Chr$(115) Then dv = dv + 2
    If keypress$ = Chr$(119) Then dv = dv - 2

    If dv > 500 Then dv = 500
    If dv < 50 Then dv = 50

    For del1 = 1 To dv * 10000
    Next del1




Loop



End
Reply
#12
That's a good start on a neat effect. Hardware acceleration comes to mind, along with a "Coin flipping" demo program that was posted on the old .rip site.

https://qb64forum.alephc.xyz/index.php?t...#msg120751

A bit more advanced using map triangle and hardware imaging...

https://qb64forum.alephc.xyz/index.php?t...#msg120751 Hopefully the proggy is still available at Dropbox.

Oh, I looked up that project I mentioned at .rip...

Code: (Select All)
SCREEN _NEWIMAGE(800, 600, 32)
    
    DIM TransRed AS _UNSIGNED LONG
    DIM TransGreen AS _UNSIGNED LONG
    DIM TransBlue AS _UNSIGNED LONG
    TransRed = _RGBA(255, 0, 0, 128)
    TransGreen = _RGBA(0, 255, 0, 128)
    TransBlue = _RGBA(0, 0, 255, 128)
    
    CALL CircleFill(100, 100, 75, TransRed)
    CALL CircleFill(120, 120, 75, TransBlue)
    
    CALL EllipseFill(550, 100, 150, 75, TransBlue)
    CALL EllipseFill(570, 120, 150, 75, TransGreen)
    
    CALL EllipseTilt(200, 400, 150, 75, 0, TransGreen)
    CALL EllipseTilt(220, 420, 150, 75, 3.14 / 4, TransRed)
    
    CALL EllipseTiltFill(0, 550, 400, 150, 75, 3.14 / 6, TransRed)
    CALL EllipseTiltFill(0, 570, 420, 150, 75, 3.14 / 4, TransGreen)
    
    END
    
    SUB CircleFill (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
        ' CX = center x coordinate
        ' CY = center y coordinate
        '  R = radius
        '  C = fill color
        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 EllipseFill (CX AS INTEGER, CY AS INTEGER, a AS INTEGER, b AS INTEGER, C AS _UNSIGNED LONG)
        ' CX = center x coordinate
        ' CY = center y coordinate
        '  a = semimajor axis
        '  b = semiminor axis
        '  C = fill color
        IF a = 0 OR b = 0 THEN EXIT SUB
        DIM h2 AS _INTEGER64
        DIM w2 AS _INTEGER64
        DIM h2w2 AS _INTEGER64
        DIM x AS INTEGER
        DIM y AS INTEGER
        w2 = a * a
        h2 = b * b
        h2w2 = h2 * w2
        LINE (CX - a, CY)-(CX + a, CY), C, BF
        DO WHILE y < b
            y = y + 1
            x = SQR((h2w2 - y * y * w2) \ h2)
            LINE (CX - x, CY + y)-(CX + x, CY + y), C, BF
            LINE (CX - x, CY - y)-(CX + x, CY - y), C, BF
        LOOP
    END SUB
    
    SUB EllipseTilt (CX, CY, a, b, ang, C AS _UNSIGNED LONG)
        '  CX = center x coordinate
        '  CY = center y coordinate
        '   a = semimajor axis
        '   b = semiminor axis
        ' ang = clockwise orientation of semimajor axis in radians (0 default)
        '   C = fill color
        FOR k = 0 TO 6.283185307179586 + .025 STEP .025
            i = a * COS(k) * COS(ang) + b * SIN(k) * SIN(ang)
            j = -a * COS(k) * SIN(ang) + b * SIN(k) * COS(ang)
            i = i + CX
            j = -j + CY
            IF k <> 0 THEN
                LINE -(i, j), C
            ELSE
                PSET (i, j), C
            END IF
        NEXT
    END SUB
    
    SUB EllipseTiltFill (destHandle&, CX, CY, a, b, ang, C AS _UNSIGNED LONG)
        '  destHandle& = destination handle
        '  CX = center x coordinate
        '  CY = center y coordinate
        '   a = semimajor axis
        '   b = semiminor axis
        ' ang = clockwise orientation of semimajor axis in radians (0 default)
        '   C = fill color
        DIM max AS INTEGER, mx2 AS INTEGER, i AS INTEGER, j AS INTEGER
        DIM prc AS _UNSIGNED LONG
        DIM D AS INTEGER, S AS INTEGER
        D = _DEST: S = _SOURCE
        prc = _RGB32(255, 255, 255, 255)
        IF a > b THEN max = a + 1 ELSE max = b + 1
        mx2 = max + max
        tef& = _NEWIMAGE(mx2, mx2)
        _DEST tef&
        _SOURCE tef&
        FOR k = 0 TO 6.283185307179586 + .025 STEP .025
            i = max + a * COS(k) * COS(ang) + b * SIN(k) * SIN(ang)
            j = max + 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) + CX - max, y + CY - max)-(xright(y) + CX - max, y + CY - max), C, BF
        NEXT
        _DEST D: _DEST S
        _FREEIMAGE tef&
    END SUB


Link: https://qb64forum.alephc.xyz/index.php?t...#msg135800

Pete
Reply
#13
I have so many questions....

But not enough time right now, unfortunately.  But I'll ask the easy one.  Is the .rip website actually a reference to the one that closed recently (qb64.org)?  I'm assuming qb64forum.alephc.xyc is some sort of archiving site.  

Optimizing the efficiency/speed of graphics or animations seems like a great challenge.  I'm guessing that using sprites is probably better than actual calculations with LINE commands filling in the spaces, at a certain level.

Cheers
Reply
#14
Yes, .rip is what I call the old .org site.

The link is a mirror that a member made. I don't know if it contains all the posts, but I have used it to look up a few things and found them.

I hardy ever do graphics, but I would imagine using sprites or images would be faster than drawing.

Pete
Reply
#15
Thanks, I'll bookmark that mirror site.

I'm curious about that project, but the link is dead.

Quote:This thread reminded me of the old .rip ellipse project. If I recall correctly, Mark, Steve and Bill, and I came up with the gold standard for ellipse drawing speed. It was fun to blow Bill's mind by putting SQR in the formula in such a way it made it faster. Of course, in his defense, Bill's only a theoretical physicist!

I was hoping to read this thread!  Haha oh well
Reply




Users browsing this thread: 2 Guest(s)