DNA Animation

[OldMoses]

Thanks OldMoses. I also started in AppleSoft BASIC in the 80's. Remember HOME instead of CLS? And there was GR and HGR and HGR2 for graphic screens. GR had the regular text at the bottom for a few lines. lol Actually the very first programming I did was in the 7th grade in the brand new computer lab the school got and we did a graphics language called LOGO. With LOGO we did PU PD (pen up, pen down) and the turtle walked in steps drawing your lines.

Yep, I remember HOME, although in those days I wasn't enough in the graphics to remember the commands. I also remember PR#6, to load DOS from a boot disk, I typed that one almost every time I sat down at the machine. Applesoft is the only language I can lay any claim to other than QBasic/QB64. In college I tried to get my head around Assembly, even taking a class in it, but never got anything to work right. My Apple ][+ was heisted in college. My father-in-law later gave me an Apple ][ with an Integer Basic card. I gave that to a friend of mine some years later. I still have a ][C in the attic that was my sister's. It still worked the last time I had it out.

[Kernelpanic]

Amazing how many people started with Apple Basic. This was my first computer book:

[OldMoses]

I wondered if someone would resort to sorting.

I've been looking at that sorting routine and thought I could improve upon it.

While it's still a basic bubble sort, it now works directly with the ball array _MEM block and takes advantage of the fact that I tend not to use OPTION BASE 1, but program arrays as if I do. It leaves me with the unused 0 element as a swapping buffer. The downside is that it added a bit of mindnumbing _MEM**** code, but the upside is that it eliminated two full array iterations and the "sort" UDT.

Doesn't really change the visual presentation, but I added some random ball colors and keydown "r" rotation reverser.

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         [offset]
    x AS INTEGER '                                              x position          [offset + 2]
    y AS INTEGER '                                              y position          [offset + 4]
    am AS SINGLE '                                              angular modifier    [offset + 6]
    ys AS INTEGER '                                             y axis offset       [offset + 10]
    r AS SINGLE '                                               radius              [offset + 12]
    c AS _UNSIGNED LONG '                                                           [offset + 16]
END TYPE

DIM SHARED B(12) AS ball '                                      ball array

RANDOMIZE TIMER
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
    r% = INT(RND * 256)
    g% = INT(RND * 256)
    b% = INT(RND * 256)
    B(bl%).c = _RGB32(r%, g%, b%)
NEXT bl%

_TITLE "DNA Animation by SierraKen"
SCREEN _NEWIMAGE(800, 600, 32)
DIM c AS LONG
t = 180
pi1810 = t / _PI / 10
direction = 1
c = _RGB32(0, 127, 255)
DO
    _LIMIT 40
    IF _KEYDOWN(114) THEN direction = direction * -1
    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) * pi1810 + B(bl%).ys
        B(bl%).r = COS(B(bl%).st + t + B(bl%).am) * pi1810 + 40
    NEXT bl%
    Mem_Sorter
    FOR x% = 1 TO 12 '                                          loop through the sorted balls and display
        drawBall B(x%).x, B(x%).y, B(x%).r, B(x%).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 * direction
    _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 Mem_Sorter
    DIM m AS _MEM
    m = _MEM(B())
    DO
        flips% = 0
        FOR n% = 1 TO UBOUND(B) - 1
            _MEMGET m, m.OFFSET + 20 * n% + 12, f! '                                    get radius of n%
            _MEMGET m, m.OFFSET + 20 * (n% + 1) + 12, s! '                              get radius of n%+1
            IF f! > s! THEN '                                                           compare them
                _MEMCOPY m, m.OFFSET + 20 * (n% + 1), 20 TO m, m.OFFSET '               move n%+1 to 0 element
                _MEMCOPY m, m.OFFSET + 20 * n%, 20 TO m, m.OFFSET + 20 * (n% + 1) '     move n% to n%+1
                _MEMCOPY m, m.OFFSET, 20 TO m, m.OFFSET + 20 * n% '                     move 0 element to n%
                flips% = -1 '                                                           mem swap complete
            END IF
        NEXT n%
    LOOP WHILE flips%
    _MEMFREE m
END SUB


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

[James D Jarvis]

There should just be 4 colors.

[bplus]

Yah, 4 colors for 4 amino acids A-T, C-G only 2 bonds...

@OldMoses, QSort AKA Quick Sort (seems perfect for a QB language) best general sorter, might not need Mem though probably even faster with...

[SierraKen]

Very cool OldMoses!

[OldMoses]

Very cool OldMoses!

Thank you, and thank you for DNA Animation. I'm not much for conceiving things like it myself, being chronically short on imagination, but I have a ....cough..cough "Ball" playing with them when they do come along. I was trying to find a way to link balls of each tier together with line commands, kind of how a DNA strand does, but the lines would just flash every which way or blink in and out and I gave in on that one. Maybe later...

It turns out that the Mem_Sorter subroutine works well in the printing routine of my truckload database that I use on our farm at harvest time. So an interesting mental puzzle ended up with a real world application.