time tunnel animation - can this be done as high res and smooth as the video?

Code: (Select All)

_Title " Eye Candy #9C Closer" ' b+ 2022-03-09

DefDbl A-Z

xmax = _DesktopWidth: ymax = _DesktopHeight

Screen _NewImage(xmax, ymax, 32)

_ScreenMove 0, 0

xc = xmax / 2

yc = ymax / 2

diag = Sqr(xc * xc + yc * yc)

p2 = _Pi * 2

Dim colr(-100 To diag + 1000) As _Unsigned Long

Dim Shared cN, pR, pG, pB

While 1

    resetPlasma

    For i = -100 To diag + 1000

        colr(i) = Plasma~&

    Next



    ro = 950: s = 0

    While ro > -50 And _KeyDown(27) = 0

        k$ = InKey$

        If Len(k$) Then Exit While

        Cls

        For a = 0 To p2 / 64 Step p2 / (16 * 360)

            i = 50 * Sin(s) ' 2 * s or just s

            For r = 0 To diag

                PSet (xc + r * Cos(a), yc + r * Sin(a)), colr(r + i + ro)

            Next

            s = s + p2 / 180

        Next

        sx1 = xc: sy1 = yc: sx2 = xc + diag * Cos(.002): sy2 = yc + diag * Sin(.002): sx3 = xc + diag * Cos(p2 / 64 - .002): sy3 = yc + diag * Sin(p2 / 64 - .002)

        For a = p2 / 64 To p2 - p2 / 64 Step p2 / 64

            dx1 = xc: dy1 = yc: dx2 = xc + diag * Cos(a): dy2 = yc + diag * Sin(a): dx3 = xc + diag * Cos(a + p2 / 64): dy3 = yc + diag * Sin(a + p2 / 64)

            _MapTriangle (sx1, sy1)-(sx2, sy2)-(sx3, sy3), source& To(dx1 + Rnd * .02, dy1 + Rnd * .02)-(dx2 + Rnd * .02, dy2 + Rnd * .02)-(dx3 + Rnd * .02, dy3 + Rnd * .02), 0

        Next

        Line (0, 0)-(xc - 1.5 * yc, _Height), &HFF000000, BF

        Line (xc + 1.5 * yc, 0)-(_Width, _Height), &HFF000000, BF

        toggle = 1 - toggle

        If toggle Then _Display

        '_Limit 80

        ro = ro - 1

    Wend

    If _KeyDown(27) Then System

Wend



Function Plasma~& ()

    cN = cN + .2

    Plasma~& = _RGB32(127 + 127 * Sin(pR * cN), 127 + 127 * Sin(pG * cN), 127 + 127 * Sin(pB * cN))

End Function



Sub resetPlasma ()

    pR = Rnd ^ 2: pG = Rnd ^ 2: pB = Rnd ^ 2

End Sub

Screen _NewImage(640, 480, 32) Dim m As _MEM: m = _MemImage(0) Dim o As _Offset Do o = 0 Do r = Int(Rnd * 2) Select Case r Case 0: _MemPut m, m.OFFSET + o, &HFFFFFFFF As _UNSIGNED LONG Case 1: _MemPut m, m.OFFSET + o, &HFF000000 As _UNSIGNED LONG End Select o = o + 4 Loop Until o = m.SIZE Loop Until _KeyHit