Plasma Effect V1

[Clyde]

Here's a little Code Snippet of a Plasma which I learnt from Shockwaves BB Tutorials. With a few additions for a FB TinyPTC adaption from yours truely, with routines I developed whilst learning FreeBasic. And may prove useful to you in your demo coding quests.

Enjoy and Hope it helps.

Code Select Expand


'-------------------------------------
' Plasma Effect
' By Clyde Radcliffe May 2006.
' Adaption And Modifications from
' Shockwaves Fast Plasma BB Tutorial
' http://www.dbfinteractive.com/plasmatutorial.htm
'---------------------------------------------------

Option Static
Option Explicit

'-------------------------------------
' Includes.
'-------------------------------------
#Include Once "Tinyptc.bi"

'-------------------------------------
' Constants.
'-------------------------------------
Const XRES=320
Const YRES=240

Const PI = 3.141593

Const ARES=XRES*YRES

Const KEY_ESC=27
Const KEY_TAB= 9

'-------------------------------------
' Know what I mean 'Arry.
'-------------------------------------
Dim Shared ScreenBuffer( ARES-1 ) As Integer

Dim Shared RGBScreen( XRES, YRES )
Dim Shared PlasmaPal(1024)

Dim Shared sintable(2880) As Single
Dim Shared costable(2880) As Single

'-------------------------------------
' Meet the Globals.
'-------------------------------------
Dim Shared PlasmaAdd1, PlasmaDir1
Dim Shared PlasmaAdd2, PlasmaDir2

Dim Shared RunningTime As Double
Dim Shared PlasmaTimer As Double
Dim Shared PlasmaDuration

'-------------------------------------
' Sub / Function Initializing.
'-------------------------------------
Declare Sub CreatePal( ByVal RedInc As UByte=1, ByVal GrnInc As UByte=2, ByVal BluInc As Ubyte=3,_
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã, ByVal RedDec As Ubyte=3, ByVal GrnDec As Ubyte=2, ByVal BluDec As Ubyte=1 )


Declare Sub FeedPixels( Buffer(), Byval x As Integer, Byval y As Integer, Byval col As Integer)
Declare Sub InitializePlasma()
Declare Sub RunPlasma()
Declare Sub UpdatePlasma()

Declare Function Millisecs( Byval TimeVal As Double ) As Double

'-------------------------------------
' Running Order.
'-------------------------------------
InitializePlasma()
RunPlasma()
End


Sub CreatePal( ByVal RedInc As UByte=1, ByVal GrnInc As UByte=2, ByVal BluInc As Ubyte=3,_
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã, ByVal RedDec As Ubyte=3, ByVal GrnDec As Ubyte=2, ByVal BluDec As Ubyte=1 )
Ã,  Ã,  
Ã,  Ã,  Dim A, Red, Grn, Blu
Ã,  Ã,  Dim RedDir, GrnDir, BluDir
Ã,  

Ã,  Ã,  For A=1 To 1024
Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  If RedDir=0 And A>512 Then
Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Red=Red+RedInc
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  If Red>255 Then
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  RedÃ,  Ã,  Ã, = 255
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  RedDirÃ,  = 1
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  End If
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  End If


Ã,  Ã,  Ã,  Ã,  If GrnDir=0 Then 'And A>512 Then
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Grn=Grn+GrnInc
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  If Grn>255 Then
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  GrnÃ,  Ã,  Ã, = 255
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  GrnDirÃ,  = 1
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  End If
Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  End IF


Ã,  Ã,  Ã,  Ã,  If BluDir=0 Then
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Blu=Blu+BluInc
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  If Blu>255 Then
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  BluÃ,  Ã,  Ã, = 255
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  BluDirÃ,  = 1
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  End If
Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  End If
Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  If RedDir=1 Then
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Red=Red-RedDec
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  If Red<0 Then
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  RedÃ,  Ã,  Ã, = 0
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  RedDirÃ,  = 0
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  End If
Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  End If


Ã,  Ã,  Ã,  Ã,  If GrnDir=1 Then
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Grn=Grn-GrnDec
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  If Grn<0 Then
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  GrnÃ,  Ã,  Ã, = 0
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  GrnDirÃ,  = 0
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  End If
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  End If

Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  If BluDir=1 Then
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Blu=Blu-BluDec
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  If Blu<0 Then
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  BluÃ,  Ã,  Ã, = 0
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  BluDirÃ,  = 0
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  End If
Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  End If

Ã,  Ã,  Ã,  Ã,  '
Ã,  Ã,  Ã,  Ã,  ' Calculate colour and store.
Ã,  Ã,  Ã,  Ã,  '
Ã,  Ã,  Ã,  Ã,  PlasmaPal(A)=( Red Shl 16) Or ( Grn Shl 8) Or ( Blu Shl 0 )

Ã,  Ã,  Next
Ã,  Ã,  
End Sub


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 InitializePlasma()
Ã,  Ã,  
Ã,  Ã,  '
Ã,  Ã,  ' Setup Screen.
Ã,  Ã,  '
Ã,  Ã,  If( ptc_open( "Cool Plasma V1", XRES, YRES ) = 0 ) Then
End -1Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  
End if
Ã,  Ã,  
Ã,  Ã,  Randomize Timer()
Ã,  Ã,  
Ã,  Ã,  Dim a

Ã,  Ã,  For a=1 To 2880

Ã,  Ã,  Ã,  Ã,  sintable(a) = Sin((a * PI/180))
Ã,  Ã,  Ã,  Ã,  costable(a) = Cos((a * PI/180))

Ã,  Ã,  Next
Ã,  Ã,  
Ã,  Ã,  CreatePal( Int(Rnd*5)+1, Int(Rnd*5)+1, Int(Rnd*5)+1,_
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã, Int(Rnd*5)+1, Int(Rnd*5)+1, Int(Rnd*5)+1 )
Ã,  Ã,  
Ã,  Ã,  PlasmaDir1= Int(Rnd*5)+2
Ã,  Ã,  PlasmaDir2= Int(Rnd*5)+2
Ã,  Ã,  
End Sub


Sub RunPlasma()
Ã,  Ã,  
Ã,  Ã,  Dim Key As String
Ã,  Ã,  
Ã,  Ã,  PlasmaTimerÃ,  Ã,  Ã, = Millisecs( Timer() )
Ã,  Ã,  PlasmaDurationÃ,  = 4000
Ã,  Ã,  
Ã,  Ã,  While Key<>Chr(KEY_ESC)
Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  RunningTime = Timer()
Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  UpdatePlasma()
Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  Ptc_Update @ScreenBuffer(0)
Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  If Key=Chr(KEY_TAB) Then
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  CreatePal( Int(Rnd*5)+1, Int(Rnd*5)+1, Int(Rnd*5)+1,_
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã, Int(Rnd*5)+1, Int(Rnd*5)+1, Int(Rnd*5)+1 )
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  End If
Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  If (PlasmaTimer + PlasmaDuration) <=Millisecs( RunningTime ) then
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  PlasmaTimer = Millisecs( RunningTime )
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  CreatePal( Int(Rnd*5)+1, Int(Rnd*5)+1, Int(Rnd*5)+1,_
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã, Int(Rnd*5)+1, Int(Rnd*5)+1, Int(Rnd*5)+1 )
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  PlasmaDir1=Int(Rnd*5)+2
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  PlasmaDir2=Int(Rnd*5)+2
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  End If
Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  Key=Inkey()

Ã,  Ã,  Wend
Ã,  Ã,  
End Sub


Sub UpdatePlasma()
Ã,  Ã,  
Ã,  Ã,  Dim x,y
Ã,  Ã,  Dim cv1,cv2,ca1,ca2Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã, ' Used in calculations.
Ã,  Ã,  
Ã,  Ã,  PlasmaAdd1=PlasmaAdd1+PlasmaDir1Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  ' These additions are
Ã,  Ã,  PlasmaAdd2=PlasmaAdd2+PlasmaDir2Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  ' For different speeds X+Y.

Ã,  Ã,  If PlasmaAdd1>360 Then PlasmaAdd1=PlasmaAdd1-360
Ã,  Ã,  If PlasmaAdd2>360 Then PlasmaAdd2=PlasmaAdd2-360

Ã,  Ã,  ca1 = 50+49*costable( PlasmaAdd1 )Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã, ' You can play with these vars.
Ã,  Ã,  ca2 = 50+49*sintable( PlasmaAdd2 )Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  Ã, ' Strange things may happen though.

Ã,  Ã,  '
Ã,  Ã,  ' Calculate the plasma and store it, it's stored in case
Ã,  Ã,  ' you want to do any pixel wise effects in the same screen
Ã,  Ã,  ' array so it only needs to be drawn once.
Ã,  Ã,  '
Ã,  Ã,  For y = 1 To YRES - 1
Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  cv1 = 205+Int(ca1*sintable( PlasmaAdd2+y ))
Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  For x = 1 To XRES - 1
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  cv2 = 400+Int(ca2*costable( PlasmaAdd1+x ))
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  RGBScreen(x,y) = cv1+cv2
Ã,  Ã,  
Ã,  Ã,  Ã,  Ã,  Next
Ã,  Ã,  
Ã,  Ã,  Next

Ã,  Ã,  '-------------------------------------------------
Ã,  Ã,  ' Feed Pixels To ScreenBuffer()
Ã,  Ã,  '-------------------------------------------------
Ã,  Ã,  For y = 1 To YRES - 1
Ã,  Ã,  Ã,  Ã,  For x = 1 To XRES - 1

Ã,  Ã,  Ã,  Ã,  Ã,  Ã,  FeedPixels( ScreenBuffer(), x, y, PlasmaPal( RGBScreen( x, y )))

Ã,  Ã,  Ã,  Ã,  Next
Ã,  Ã,  Next

End Sub


Function Millisecs( ByVal TimeVal As Double ) As Double
Ã,  Ã,  
Ã,  Ã,  Return ( TimeVal * 1000.00 )
Ã,  Ã,  Ã,  Ã,  
End Function


Cheers and all ze best,
Clyde.

[relsoft]

Neat.  You may want to read my tutorial on how to make plasmas too. It discusses the way I make my plasmas. :*)

http://www.petesqbsite.com/sections/zines/qbcm/issues/4-1/default.html#plasmas

[Clyde]

Cheers Dude

[Shockwave]

Jeez, that ran too fast for my eyes!! 

[Clyde]

Looks pretty nice in 640 x 480 res too.