FB Chlandi Explorer

[rdc]

Just to show that an old dog can learn a new trick. Thanks and karma to Taj, Rbraz and mind.

Code: [Select]

'Chladni Explorer
'Thanks to RBraz and Mind for the help
'FB .17b testing (not CVS)
'Code modified from Mind example code
option explicit

#define sw 400
#define sh 300

const pi = Atn ( 1.0 ) * 4

dim shared pal(0 to 255) as uinteger
dim as integer x, y, n, m, L, x2, y2
dim as double c1, c2, c3
dim as uinteger cc
dim key as string

function Rand() as double
   return rnd * 30
end function

'Interpolation code by Rattrapmax6
Sub DoPalette
    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) = 255
    iStart(2) = 255
    iStart(3) = 255
    iEnd(1) = 1
    iEnd(2) = 1
    iEnd(3) = 1
    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

DoPalette
Randomize timer

screen 15, 32
doagain:
cls
do
    n = Rand
    m = Rand
    sleep 1
loop until m <> n
l = 300
for x = 0 to l
    for y = 0 to l
        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
        pset(x + 50, y), pal(cc)
    next
next
locate 1,1
print "n=";n;" m=";m
do
    key = inkey
    if key = chr(32) then goto doagain
    sleep 1
loop until key = chr(27)

end


[rdc]

I discovered something interesting. Maybe you already know this. I found that when n and m are both even you can tile the texture. If they are both odd, you can tile, but the images are mirrors of each other.

Code: [Select]

'Chladni Explorer
'http://local.wasp.uwa.edu.au/~pbourke/modelling/chladni/
'Thanks to RBraz and Mind @ DBF-GVY for the help
'FB .17b testing (not CVS)
'Code modified from Mind example code
option explicit

const pi = Atn ( 1.0 ) * 4
const offsetx = 6
const offsety = 18

dim shared pal(0 to 255) as uinteger
dim as integer x, y, n, m, L, x2, y2
dim as double c1, c2, c3
dim as uinteger cc
dim key as string

function Rand() as double
   return rnd * 20
end function

'Interpolation code by Rattrapmax6
Sub DoPalette
    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) = 255
    iStart(2) = 255
    iStart(3) = 255
    iEnd(1) = 0
    iEnd(2) = 0
    iEnd(3) = 0
    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

DoPalette
Randomize timer

screen 15, 32
doagain:
cls
do
    n = Rand
    m = Rand
    sleep 1
loop until m <> n
l = 128
for x = 0 to l
    for y = 0 to l
        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
        pset(x + offsetx, y + offsety), pal(cc)
        pset(x + l + offsetx, y + offsety), pal(cc)
        pset(x + (l * 2) + offsetx, y + offsety), pal(cc)
        pset(x + offsetx, y + l + offsety), pal(cc)
        pset(x + l + offsetx, y + l + offsety), pal(cc)
        pset(x + (l * 2) + offsetx, y + l + offsety), pal(cc)
    next
next
locate 1,1
print "n =";n;" m =";m
do
    key = inkey
    if key = chr(32) then goto doagain
    sleep 1
loop until key = chr(27)

end

Even on top, odd below:

[cirux]

That is very cool, I've done a little bit of learning about procedural textues (mostly celluar). Defintely going to learn about this, thanks for the source.

[taj]

Just to show that an old dog can learn a new trick. Thanks and karma to Rbraz and mind.

Just to point out the idea was mine in the first place...would have been nice to be mentioned...

[rdc]

I added a mention and karma.

[Rbz]

Nice work Rick 

[rdc]

Thanks!

[relsoft]

Wow!!!