Dark Bit Factory & Gravity
PROGRAMMING => Freebasic => Topic started by: Clyde on June 09, 2008
-
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.
'
' 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.
-
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.
-
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 :)
-
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....
-
No probs Energy exe in a zip now added.
And thanks everyone else. 8)
-
Wonderful effect. Great job with the conversion Clyde.
-
Cheers Rain Storm.
-
Nice one Clyde :)
-
Thanks Hotshot 8)
-
AAh
Cool conversion... looks great and runs very well...
Thanx for exe and conversion source... :P
Cheers
energy
-
No probs, glad you liked it dude.
Cheers,
Clyde.
-
Nice :)
-
Cheers BadMrBox :)
-
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
-
No worries DrewPee, glad it's helped you out.
Cheers,
Clyde.
-
Cool stuff! :)
here's revision of the code for those who have latest Fb compiler version ;)
'
' 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
-
K+ thanks for that nkk_kan saves me doing it, Clyde you gotta upgrade dude