DNA Animation

[OldMoses]

Yeah I see what you mean about loose artifacts OldMoses. But I'm just going to keep it as it is. I'll just say that the bands are tilted and not lined up. It looks good enough for me.

Ah, but you're so close! It's a great algorithm, and just needed a couple tweaks. Allow me to have a go at it...

The main issue is the many different variables for each ball, which make it difficult to compare them with simple tests and/or iterate through them with looping structures that can reduce code dramatically. The solution would be to either do multiple arrays indexed to each ball, or a single UDT array containing all the ball's data. I'll do a UDT array for the balls and also a small one for sorting purposes. Then add a sorting SUB to rearrange the balls after their position and radius data are updated in the loop. Arranging in ascending order of radius means they will be drawn from furthest away to closest, and thus will naturally overlap properly.

Code: (Select All)

'DNA Animation by SierraKen
'Ball design by B+ and OldMoses
'UDT array and sorting tweaks by OldMoses
'July 31, 2022

TYPE ball
    st AS INTEGER '                                             start point
    x AS INTEGER '                                              x position
    y AS INTEGER '                                              y position
    am AS SINGLE '                                              angular modifier
    ys AS INTEGER '                                             y axis offset
    r AS SINGLE '                                               radius
END TYPE

TYPE sort '                                                     used in SUB Sorter to sort by specific value
    index AS INTEGER
    value AS SINGLE
END TYPE

DIM SHARED B(12) AS ball '                                      ball array

FOR bl% = 1 TO 12 '                                             load static ball parameters
    IF bl% > 6 THEN
        B(bl%).st = 180
    ELSE
        B(bl%).st = 45
    END IF
    READ B(bl%).am, B(bl%).ys
NEXT bl%

_TITLE "DNA Animation by SierraKen"
SCREEN _NEWIMAGE(800, 600, 32)
DIM c AS LONG
t = 180
c = _RGB32(0, 127, 255)
DO
    _LIMIT 40
    FOR bl% = 1 TO 12 '                                         loop through position and radius computations
        'Ken's base algorithm- just tweaked to accept the UDT array
        B(bl%).x = (SIN(B(bl%).st + t + B(bl%).am) * 180) + 400
        B(bl%).y = (COS(B(bl%).st + t + B(bl%).am) * 180) / _PI / 10 + B(bl%).ys
        B(bl%).r = (COS(B(bl%).st + t + B(bl%).am) * 180) / _PI / 10 + 40
    NEXT bl%
    Sorter '                                                    next we will sort, by radius, smaller to larger
    FOR x% = 1 TO 12 '                                          loop through the sorted balls and display
        drawBall B(x%).x, B(x%).y, B(x%).r, c '                 balls earlier in the loop are smaller and thus farther
    NEXT x% '                                                   away and will be necessarily overlapped by later, larger balls
    t = t - .05
    _DISPLAY
    CLS
LOOP UNTIL INKEY$ = CHR$(27)
END

'static ball parameters for 12 paired balls
DATA 0,100,.7,165,1.4,230,2.1,295,2.8,360,3.5,425
DATA 0,100,.7,165,1.4,230,2.1,295,2.8,360,3.5,425


SUB Sorter
    'This may be a rather clumsy method, but seems to be fast enough to work
    DIM temp(UBOUND(B)) AS ball
    DIM s(UBOUND(B)) AS sort
    FOR x% = 1 TO UBOUND(B) '                                   iterate through the array
        temp(x%) = B(x%) '                                      copy original into a temporary array
        s(x%).index = x% '                                      set sorter index
        s(x%).value = B(x%).r '                                 set sorter value to radius of ball
    NEXT x%
    DO '                                                        bubble sort the array
        flips% = 0 '                                            reset flip flag for this loop
        FOR n% = 1 TO UBOUND(B) - 1 '                           loop through all but last array element
            IF s(n%).value > s(n% + 1).value THEN '             if radius greater than next radius
                SWAP s(n%), s(n% + 1) '                         swap the two and...
                flips% = -1 '                                   set flip flag to true
            END IF
        NEXT n%
    LOOP WHILE flips% '                                         loop until no more flips happen. No flips = fully sorted
    FOR x% = 1 TO UBOUND(B) '                                   iterate the array again
        B(x%) = temp(s(x%).index) '                             set ball order to sort order
    NEXT x%
END SUB 'Sorter


SUB drawBall (x, y, r, c AS _UNSIGNED LONG)
    DIM rred AS LONG, grn AS LONG, blu AS LONG, rr AS LONG, f
    rred = _RED32(c): grn = _GREEN32(c): blu = _BLUE32(c)
    FOR rr = r TO 0 STEP -1
        f = 1 - SIN(rr / r)
        fillCircle x, y, rr, _RGB32(rred * f, grn * f, blu * f)
    NEXT
END SUB


'from Steve Gold standard
SUB fillCircle (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