Dark Bit Factory & Gravity
PROGRAMMING => Freebasic => Topic started by: rdc on November 05, 2006
-
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
-
I hate to be a lamer but any chance you could load an exe ? I'm not basic friendly and Id love to see this.
-
No problem man, happy to do it. I also added a little screenshot too.
(http://fileanchor.com/84278-t.png) (http://fileanchor.com/84278.png)
-
Thanks for sharing rdc, thats very watchable, quite mesmerising actually.
Its clear chladni is a very powerful technique for intros/demos. Its also very cleasr I need to upgrade my PC to watch the basic demos from this forum :-) Odd really I put all my monmey into my gfx card and now I need to upgrade the rest of the system to watch basic demos. Well, any excuse really ;-)
-
Thanks, I thought it was interesting to see how the wave patterns extrude into 3D, even though I am only using points. It would probably be more interesting to see them fuly modelled, but that is beyond me at the moment.
-
This one has the same effect on my eyes as I used to get when I was reading a long scroll text.. Watch a few patterns rotating and then take your eyes away from the screen and things seem to be rotating.
And before anyone thinks I've been on the sauce again, I'm sober :)
This looks very nice by the way, good work.
-
Thanks man. It does the same to me. :)
I am going to put all these little chlandi routines into a single demo. For the 3D part, I changed it a bit to make it look a little different. Sort of looks like a watercolor to me.
(http://fileanchor.com/84279-t.png) (http://fileanchor.com/84279.png)
-
Yes, I think it does too :) Nice colours.