Converted Lode's Plasma To Freebasic.

[Clyde]

This I was inspired upon by a link by Energy for tutorials on Plasmas and have had a go at adapting them to Freebasic. Hope you find it of some use.

Code: [Select]

'
' Plasma Mk1.
'
#Include Once "TinyPtc_Ext.bi"

Const XRES=640
Const YRES=480

Const ARES=XRES*YRES
Const PI As Single = 3.14159

'
' Globals.
'
Dim Shared ScreenBuffer(ARES)
Dim Shared Pal(256)
Dim Shared x,y,inc
Dim Shared ARGB
Dim Shared Key As String

'
' Subroutines.
'
Declare Sub FeedPixels( Buffer(), ByVal x As Integer, ByVal y As Integer, ByVal col As Integer)

Declare Sub GeneratePalette(    ByVal Val1 As Integer,_
                                ByVal Val2 As Integer,_
                                ByVal Val3 As Integer )
'
' Setup.
'
PTC_SetDialog(0,"",0,0)
PTC_Open("Plasma Mk1",XRES,YRES)

GeneratePalette(16,128,0)

'
' Main Loop.
'
While Key<>chr(27)
   
    For x = 0 To XRES-1
        For y = 0 To YRES-1
       
        ARGB=    int(  128.0 + (128.0 * sin(x / 16.0))_
            + 128.0 + (128.0 * sin(y / 32.0))_
            + 128.0 + (128.0 * sin(sqr(cdbl((x - XRES / 2.0)* (x - XRES / 2.0) + (y - YRES / 2.0) * (y - YRES / 2.0))) / 8.0))_
            + 128.0 + (128.0 * sin(sqr(cdbl(x * x + y * y)) / 8.0))) / 4
           
            FeedPixels(ScreenBuffer(),x, y, Pal(ARGB+inc and 255))
   
        Next
    Next
   
    inc=inc+16
   
    Ptc_Update @ScreenBuffer(0)
    Erase ScreenBuffer
    Key=Inkey()
   
Wend

'
' Shutdown.
'
PTC_Close()


Sub FeedPixels( Buffer(), ByVal x As Integer, ByVal y As Integer, ByVal col As Integer)
       
    If X>0 And X<XRES-1 And Y>0 And Y<YRES-1 Then
        Buffer(Y * XRES + X) = col
    End If

End Sub


Sub GeneratePalette(    ByVal Val1 As Integer,_
                        ByVal Val2 As Integer,_
                        ByVal Val3 As Integer )
    '
    ' Local variables.
    '
    Dim A,R,G,B As Integer
   
    For A=0 To 255
       
        R = int(128.0 + 128 * sin(PI * A / Val1))
        G = int(128.0 + 128 * sin(PI * A / Val2))
        B = int(128.0 + 128 * sin(PI * A / Val3))

        Pal( A ) = ( R Shl 16 ) Or ( G Shl 8 ) Or ( B Shl 0 )
   
    Next

End Sub

Cheers and all the best,
Clyde.

[ninogenio]

very cool conversion clyde k+,

ive never fully understood plasma but i can see the basics of how it works now cheers!

loads of intresting stuff can be done with simple tweaks.

[Shockwave]

Nice looking pattern, I am sure you could optimise it a lot by using pointers instead of that feedpixels subroutine which is really crippling your program.. The calculations could be simplified a lot too.

Thanks for converting it though Clyde, always nice to see plasmas

[energy]

Hi Clyde...
Are yu able to compile the exe and adapt it to post?
Im curious to see it, but i dont use Freebasic! 
Thanx....

[Clyde]

No probs Energy exe in a zip now added.
And thanks everyone else. 

[rain_storm]

Wonderful effect. Great job with the conversion Clyde.

[Clyde]

Cheers Rain Storm.

[Hotshot]

Nice one Clyde   

[Clyde]

Thanks Hotshot 

[energy]

AAh
Cool conversion... looks great and runs very well...
Thanx for exe and conversion source... 
Cheers
energy

[Clyde]

No probs, glad you liked it dude.

Cheers,
Clyde.

[BadMrBox]

Nice

[Clyde]

Cheers BadMrBox

[DrewPee]

Nice code Clyde, thanks for the source!
Cool effect - I didn't have any idea how to do this - I do now!!!

Cheers
DrewPee / Andy

[Clyde]

No worries DrewPee, glad it's helped you out.

Cheers,
Clyde.

[nkk_kan]

Cool stuff!

here's revision of the code for those who have latest Fb compiler version

Code: [Select]

'
' Plasma Mk1.
'
#Include Once "TinyPtc_Ext.bi"

Const XRES=640
Const YRES=480

Const ARES=XRES*YRES
Const PI As Single = 3.14159

'
' Globals.
'
Dim Shared ScreenBuffer(ARES) as integer
Dim Shared Pal(256) as integer
Dim Shared  as integer x,y,inc
Dim Shared ARGB  as integer
Dim Shared Key As String

'
' Subroutines.
'
Declare Sub FeedPixels( Buffer() as integer, ByVal x As Integer, ByVal y As Integer, ByVal col As Integer)

Declare Sub GeneratePalette(    ByVal Val1 As Integer,_
                                ByVal Val2 As Integer,_
                                ByVal Val3 As Integer )
'
' Setup.
'
PTC_SetDialog(0,"",0,0)
PTC_Open("Plasma Mk1",XRES,YRES)

GeneratePalette(16,128,0)

'
' Main Loop.
'
While Key<>chr(27)
   
    For x = 0 To XRES-1
        For y = 0 To YRES-1
       
        ARGB=    int(  128.0 + (128.0 * sin(x / 16.0))_
            + 128.0 + (128.0 * sin(y / 32.0))_
            + 128.0 + (128.0 * sin(sqr(cdbl((x - XRES / 2.0)* (x - XRES / 2.0) + (y - YRES / 2.0) * (y - YRES / 2.0))) / 8.0))_
            + 128.0 + (128.0 * sin(sqr(cdbl(x * x + y * y)) / 8.0))) / 4
           
            FeedPixels(ScreenBuffer(),x, y, Pal(ARGB+inc and 255))
   
        Next
    Next
   
    inc=inc+16
   
    Ptc_Update @ScreenBuffer(0)
    Erase ScreenBuffer
    Key=Inkey()
   
Wend

'
' Shutdown.
'
PTC_Close()


Sub FeedPixels( Buffer() as integer, ByVal x As Integer, ByVal y As Integer, ByVal col As Integer)
       
    If X>0 And X<XRES-1 And Y>0 And Y<YRES-1 Then
        Buffer(Y * XRES + X) = col
    End If

End Sub


Sub GeneratePalette(    ByVal Val1 As Integer,_
                        ByVal Val2 As Integer,_
                        ByVal Val3 As Integer )
    '
    ' Local variables.
    '
    Dim as integer A,R,G,B
   
    For A=0 To 255
       
        R = int(128.0 + 128 * sin(PI * A / Val1))
        G = int(128.0 + 128 * sin(PI * A / Val2))
        B = int(128.0 + 128 * sin(PI * A / Val3))

        Pal( A ) = ( R Shl 16 ) Or ( G Shl 8 ) Or ( B Shl 0 )
   
    Next

End Sub

[rain_storm]

K+ thanks for that nkk_kan saves me doing it, Clyde you gotta upgrade dude