Here is a little 3D version of the Chladni code:
'Chladni 3D Demo
'Richard Clark
'http://local.wasp.uwa.edu.au/~pbourke/modelling/chladni/
'Thanks to Taj for the idea
'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 300
#define sw 640
#define sh 480
#define chrange 20
#define backchange 10
#define rangle .0001
type chtype
cx as integer
cy as integer
cz as integer
end type
const pi = Atn(1.0) * 4
const centerx = sw / 2
const centery = sh / 2
dim shared ch(-(chs / 2) to (chs / 2), -(chs / 2) to (chs / 2)) as chtype
dim shared cpal(0 to 255) as uinteger
dim shared cmap(-(chs / 2) to (chs / 2), -(chs / 2) to (chs / 2)) as uinteger
dim as single tt
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(cpal() 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(cpal)
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(cpal)
iShow(1) = Rend(1)
iShow(2) = Rend(2)
iShow(3) = Rend(3)
cpal(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
dim as integer rs, gs, bs, re, ge, be
rs = Getrandom(0, 255)
gs = Getrandom(0, 255)
bs = Getrandom(0, 255)
re = Getrandom(0, 255)
ge = Getrandom(0, 255)
be = Getrandom(0, 255)
DoPalette cpal(), rs, gs, bs, re, ge, be
end sub
sub RotateChladni
dim as integer x, y
for x = -(chs / 2) to (chs / 2)
for y = -(chs / 2) to (chs / 2)
'rotation around x axis (a.k.a. pitch)
ch(x, y).cy = cos(rangle) * ch(x, y).cy - sin(rangle) * ch(x, y).cz
ch(x, y).cz = sin(rangle) * ch(x, y).cy + cos(rangle) * ch(x, y).cz
'rotation around y axis (a.k.a. yaw)
ch(x, y).cz = cos(rangle) * ch(x, y).cz - sin(rangle) * ch(x, y).cx
ch(x, y).cx = sin(rangle) * ch(x, y).cz + cos(rangle) * ch(x, y).cx
'rotation around z axis (a.k.a. roll)
ch(x, y).cx = cos(rangle) * ch(x, y).cx - sin(rangle) * ch(x, y).cy
ch(x, y).cy = sin(rangle) * ch(x, y).cx + cos(rangle) * ch(x, y).cy
next
next
end sub
sub LoadChladni
dim as integer x, y, n, m, x2, y2, i, l
dim as uinteger cc
i = GetRandom(1, 10)
if i mod 2 = 0 then
'Get even seed values
do
n = rnd * chrange
m = rnd * chrange
sleep 1
loop until (m mod 2 = 0) and (n mod 2 = 0) and (m <> n)
else
'Get odd seed values
do
n = rnd * chrange
m = rnd * chrange
sleep 1
loop until (m mod 2 <> 0) and (n mod 2 <> 0) and (m <> n)
end if
l = chs
'Calculate values
for x = -(chs / 2) to (chs / 2)
for y = -(chs / 2) to (chs / 2)
ch(x, y).cx = x
ch(x, y).cy = y
x2 = ( cos( n*pi*x/l ) * cos( m*pi*y/l ) ) * 128
y2 = ( cos( m*pi*x/l ) * cos( n*pi*y/l ) ) * 128
cc = x2 - y2
if cc < 0 then cc = 0
if cc > 255 then cc = 255
ch(x, y).cz = cc
cmap(x, y) = cc
next
next
end sub
sub PrintChlandi
dim as integer i, x, y, ccx, ccy, ccz
cls
for x = -(chs / 2) to (chs / 2)
for y = -(chs / 2) to (chs / 2)
if ch(x, y).cz <> 0 then
ccx = ch(x, y).cx + centerx
ccy = ch(x, y).cy + centery
ccz = ch(x, y).cz
if ccx >= 0 and ccx <= sw and ccy >= 0 and ccy <= sh then
pset(ccx, ccy), cpal(cmap(x, y))
end if
end if
next
next
screencopy
end sub
Randomize timer
'Open ptc window
screen 18, 32, 2, 1
screenset 1, 0
windowtitle "Chladni 3D"
setmouse ,,0
GeneratePalette
LoadChladni
PrintChlandi
sleep 500
tt = timer
do
if timer > (tt + backchange) then
GeneratePalette
LoadChladni
PrintChlandi
sleep 500
tt = timer
end if
RotateChladni
PrintChlandi
sleep 1
loop until inkey <> ""
setmouse ,,1
end
