Ascii Chladni Tunnel

Generates a tunnel effect.

'Ascii Chladni Tunnel
option explicit

#define chs 64
#define tw 160
#define th 128

'Jofers
Type Pixel_Color
    B As Ubyte
    G As Ubyte
    R As Ubyte
    A As Ubyte
End Type

Union Pixel
    Channel As Pixel_Color
    Value   As Uinteger
End Union

const pi = Atn(1.0) * 4

dim shared tex(0 to tw - 1, 0 to th - 1) as uinteger
dim shared ctex(0 to tw - 1, 0 to th - 1) as uinteger
dim shared ntex(0 to tw - 1, 0 to th - 1) as uinteger
dim Shared dist(tw * th) as integer
dim Shared angleData(tw * th) as integer
dim shared pal(0 to 255) as uinteger
dim as integer ct
dim as double t
dim as string key

function GetRandom(lowerbound as integer, upperbound as integer) as integer
   return Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
end function

'Interpolation code by Rattrapmax6
Sub DoPalette(pal() as UInteger, sr as integer, sg as integer, sb as integer, er as integer, eg as integer, eb as integer)
    Dim As Integer i
    Dim iStart(3) As Integer
    Dim iEnd(3) As Integer
    Dim iShow(3) As Integer
    Dim Rend(3) As Double
    Dim InterPol(3) As Double

    InterPol(0) = Ubound(pal)
    iStart(1) = sr
    iStart(2) = sg
    iStart(3) = sb
    iEnd(1) = er
    iEnd(2) = eg
    iEnd(3) = eb
    InterPol(1) = (iStart(1) - iEnd(1)) / InterPol(0)
    InterPol(2) = (iStart(2) - iEnd(2)) / InterPol(0)
    InterPol(3) = (iStart(3) - iEnd(3)) / InterPol(0)       
    Rend(1) = iStart(1)
    Rend(2) = iStart(2)
    Rend(3) = iStart(3)   

    For i = 0 To Ubound(pal)
        iShow(1) = Rend(1)
        iShow(2) = Rend(2)
        iShow(3) = Rend(3)

        pal(i) = Rgb(iShow(1),iShow(2),iShow(3))

        Rend(1) -= InterPol(1)
        Rend(2) -= InterPol(2)
        Rend(3) -= InterPol(3)
    Next

End Sub

sub GeneratePalette(pal() as integer)
    dim as integer rs, gs, bs, re, ge, be

    rs = GetRandom(0, 255)
    gs = GetRandom(0, 255)
    bs = GetRandom(0, 255)
    re = 255
    ge = 255
    be = 255   
    DoPalette pal(), rs, gs, bs, re, ge, be
end sub

sub LoadChladni
    dim as integer x, y, n, m, x2, y2, l, i, nx, ny
    dim as integer clr1, clr2, r, g, b, iterations
    dim as integer rmax
    dim as double hh, h, ambient, dif, spec
    dim as uinteger cc
    dim clr as Pixel

    iterations = 4
    rmax = 10
    'Clear to 255
    for x = 0 to tw - 1
        for y = 0 to th - 1
            tex(x, y) = 255
        next
    next
    'Generate chladni texture filling in 255 areas
    for i = 1 to iterations
        do
            n = rnd * rmax
            m = rnd * rmax
            sleep 1
        loop until (m <> n) and (m mod 2 = 0) and (n mod 2 = 0)
        GeneratePalette pal()
        for x = 0 to tw - 1
            for y = 0 to th - 1
                ambient = 0.55
                dif = 5.5
                spec = 2.0
                x2 = ( cos( n*pi*x/chs ) * cos( m*pi*y/chs ) ) * 128
                y2 = ( cos( m*pi*x/chs ) * cos( n*pi*y/chs ) ) * 128
                cc = x2 - y2
                if cc < 0 then cc = 0
                if cc > 255 then cc = 255
                if tex(x, y) = 255 then
                    tex(x, y) = cc
                    ctex(x, y) = pal(cc)
                end if
            next
        next
    next
    'Glassify image
    for x = 0 to tw - 1
        for y = 0 to th - 1
            if (x + 1) <= tw - 1 then clr1 = tex(x + 1, y)
            if (x - 1) >= 0 then clr2 = tex(x - 1, y)
            nx = clr1 - clr2
            if (y + 1) <= th - 1 then clr1 = tex(x, y + 1)
            if (y - 1) >= 0 then clr2 = tex(x, y - 1)
            ny = clr1 - clr2
            hh = 1 / sqr(nX * nX + nY * nY + 1)
            'shading = ambient + dif*dot + dot^2 * spec
            h = ambient + (dif * hh) + (hh * hh) * spec
            clr.Value = ctex(x, y)
            r = Int(clr.channel.r * h)
            g = Int(clr.channel.g * h)
            b = Int(clr.channel.b * h)
            if r < 0 then r = 0
            if g < 0 then g = 0
            if b < 0 then b = 0
            if r > 255 then r = 255
            if g > 255 then g = 255
            if b > 255 then b = 255
            ntex(x, y) = RGB(r, g, b)
        next
    next
end sub

sub InitDist
    dim as integer x, y

    for x = 0 to tw - 1
        for y = 0 to th - 1
            dist(x + (y*tw))  = ( 64 * chs / sqr( ( (x - (tw / 2.0)) * (x - (tw / 2.0)) ) + ( (y - (th / 2.0)) * (y - (th / 2.0)) ) ) ) mod chs
            angleData(x + (y*tw)) = (atan2( (th / 2.0) - y , (tw / 2.0) - x )  * chs / pi)
        next
    next   
end sub

sub DoTunnel(cl as integer)
    dim as double ctime1
    dim as uinteger texel
    dim as integer tx, ty, x, y, dv, du

    'ctime1 = GetTickCount() / 2000.0
    ctime1 = timer

    'add u,v displacement
    du = (chs * 2.0 * ctime1)
    dv = (chs * 0.5 * ctime1)     

    screenlock
    cls   
    for x = 0 to tw - 1
        for y = 0 to th - 1
            tx = (dist(x + (y * tw)) + du) mod chs
            ty = (angleData(x + (y * tw)) + dv) mod chs
            if cl then
                texel = ntex(tx, ty)
            else
                texel = ctex(tx, ty)
            end if
            color texel
            locate y + 1, x + 1
            print chr(219);
        next
    next
    screenunlock
end sub

Randomize timer

screen 21, 32,,1
width tw, th
windowtitle "Ascii Chladni"
setmouse ,,0
InitDist
LoadChladni
t = timer
do
    key = inkey
    if timer > (t + 5) then
        LoadChladni
        ct = not ct
        t = timer
    end if
    DoTunnel ct
    sleep 10
loop until key = chr(27)
setmouse ,,1
end
Unless otherwise stated, the content of this page is licensed under Creative Commons Attribution-Share Alike 2.5 License.