Ascii Chladni Two Variations
Here are chladni patterns in glorious ASCII.
'Chladni Fractalish Demo3
'http://local.wasp.uwa.edu.au/~pbourke/modelling/chladni/
'Thanks to Taj for the idea and Tan function suggestion
'Jim, Rbraz and Mind @ DBF-GVY for the code help
'Rattrapmax6 for interpolation code
'FB .17b testing (download page, not CVS)
'Chlandi code modified from Mind example code
option explicit
#define chs 64
#define sw 1024
#define sh 768
#define tw 128
#define th 96
'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 pal(0 to 255) as uinteger
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) = 0 then clr2 = tex(x - 1, y)
nx = clr1 - clr2
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
'Print Image
screenlock
cls
for x = 0 to tw - 1
for y = 0 to th - 1
color ntex(x, y), RGB(0,0,0)
locate y, x
print chr(219);
next
next
screenunlock
end sub
Randomize timer
screenres sw, sh, 32,,1
width tw, th
windowtitle "Ascii Chladni"
setmouse ,,0
LoadChladni
do
key = inkey
if key = chr(32) then
LoadChladni
end if
sleep 1
loop until key = chr(27)
setmouse ,,1
end
Alternative version.
'Chladni Fractalish Demo3
'http://local.wasp.uwa.edu.au/~pbourke/modelling/chladni/
'Thanks to Taj for the idea and Tan function suggestion
'Jim, Rbraz and Mind @ DBF-GVY for the code help
'Rattrapmax6 for interpolation code
'FB .17b testing (download page, not CVS)
'Chlandi code modified from Mind example code
option explicit
#define chs 64
#define sw 1024
#define sh 768
#define tw 128
#define th 96
'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 pal(0 to 255) as uinteger
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) = 0 then clr2 = tex(x - 1, y)
nx = clr1 - clr2
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
'Print Image
screenlock
cls
for x = 0 to tw - 1
for y = 0 to th - 1
color ntex(x, y), RGB(0,0,0)
locate y, x
if tex(x, y) = 7 then
print chr(178);
else
print chr(tex(x, y));
end if
next
next
screenunlock
end sub
Randomize timer
screenres sw, sh, 32,,1
width tw, th
windowtitle "Ascii Chladni"
setmouse ,,0
LoadChladni
do
key = inkey
if key = chr(32) then
LoadChladni
end if
sleep 1
loop until key = chr(27)
setmouse ,,1
end