Plasma Effect

[Rbz]

*** From DBF ezboard ***

Code Select Expand

rbraz
CBM 128

Posts: 172
(17/4/06 2:26)
Reply
Ã, Plasma Effect
--------------------------------------------------------------------------------
It looks alot better than the B+ version Ã,
Enjoy!



'-------------------------------------
' FreeBasic Plasma - 640x480
' Ã,  Ã,  Ã,  Ã,  by Rbraz - 2006
'-------------------------------------

'Windowed
'#define PTC_WIN

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


Const Scr_Width=640, Scr_Height=480
Const W1 = Scr_Width * 2, H1 = Scr_Height * 2

Const Pi As Double = 3.1415
Const KEY_ESC Ã,  Ã,  Ã, = 27
Dim Key$

Dim Shared plasma1(Scr_Width * Scr_Height * 4) as integer
Dim Shared plasma2(Scr_Width * Scr_Height * 4) as integer
Dim Shared r(256), g(256), b(256) as integer
Dim Shared buffer(Scr_Width * Scr_Height) as integer

Dim Shared Ã, x1, y1, x2, y2, x3, y3 as integer
Dim Shared dst, src1, src2, src3 as integer
Dim Shared i, j as double
Dim Shared CTime as double

Declare Sub Precalculate()
Declare Sub Update_Buffer()
Declare Sub WritePixelFast( Byval intX As Integer, Byval intY As Integer, Byval intC As Integer )
Declare Function Millisecs( ByVal fltTimeValue As Double ) As Double


Precalculate()

If( ptc_open( "FreeBasic Plasma Example", Scr_Width, Scr_Height ) = 0 ) Then
Ã,  Ã, End -1
End if

While Key$ <> Chr$( KEY_ESC )
Ã,  
Ã, Key$=Inkey$()
Ã,  Ã,
Ã, CTime = millisecs( Timer ) shr 2

Ã, For i=0 To 255
Ã,  r(i) = ((128 + 127 * cos( i * PI / 128 + CTime/37 )) ) and 255
Ã,  g(i) = ((128 + 127 * sin( i * PI / 128 + CTime/35 )) ) and 255
Ã,  b(i) = ((128 - 127 * cos( i * PI / 128 + CTime/41 )) ) and 255
Ã, Next

Ã, x1 = 160 + (159 * Cos( (CTime/412 )))
Ã, x2 = 160 + (159 * Sin( (-CTime/580)))
Ã, x3 = 160 + (159 * Sin( (-CTime/601)))
Ã, y1 = 100 + (99 Ã, * Sin( (CTime/470 )))
Ã, y2 = 100 + (99 Ã, * Cos( (-CTime/590)))
Ã, y3 = 100 + (99 Ã, * Cos( (-CTime/645)))

Ã, src1 = (y1 * (Scr_Width*2)) + x1
Ã, src2 = (y2 * (Scr_Width*2)) + x2
Ã, src3 = (y3 * (Scr_Width*2)) + x3

Ã, dst = 0
Ã, For j=0 To Scr_Height-1
Ã,  Ã, For i=0 To Scr_Width-1
Ã,  Ã,  Ã,  buffer(dst) = (plasma1(src1) + plasma2(src2) + plasma2(src3)) And 255
Ã,  Ã,  Ã,  dst = dst + 1
Ã,  Ã,  Ã,  src1 = src1 + 1
Ã,  Ã,  Ã,  src2 = src2 + 1
Ã,  Ã,  Ã,  src3 = src3 + 1
Ã,  Ã, Next
Ã,  Ã,  Ã,  src1 = src1 + Scr_Width
Ã,  Ã,  Ã,  src2 = src2 + Scr_Width
Ã,  Ã,  Ã,  src3 = src3 + Scr_Width
Ã, Next

Ã, Update_Buffer()
Ã, Ptc_Update @buffer(0)
Ã,
Wend

ptc_close()

Sub Update_Buffer()
Ã, Dim pixel,x,y as integer
Ã, For y = 0 To Scr_Height-1
Ã,  For x = 0 To Scr_Width-1
Ã,  Ã,  Ã, pixel = buffer(x + (y * Scr_Width))
Ã,  Ã,  Ã, WritePixelFast ( x, y, (r(pixel) Shl 16) Or (g(pixel) Shl 8 ) Ã, Or b(pixel) )
Ã,  Next
Ã, Next

End Sub

Sub Precalculate()
Ã,  Ã, For j=0 To H1-1
Ã,  Ã,  Ã,  Ã, For i=0 To W1-1
Ã,  Ã,  Ã,  Ã,  Ã,  plasma1(dst) = Ã, ((Sin(((i*2+j*2)*Pi/180))*15 + Sin((j*Pi)/180)*90)) And 255
Ã,  Ã,  Ã,  Ã,  Ã,  plasma2(dst) = Ã, ((Sin(((i+j)*Pi)/180)*25 + Cos((i*Pi)/180)*90)) And 255
Ã,  Ã,  Ã,  Ã,  Ã,  dst = dst + 1
Ã,  Ã,  Ã,  Ã, Next
Ã,  Ã, Next
End Sub

Sub WritePixelFast( Byval intX As Integer, Byval intY As Integer, Byval intC As Integer )
Ã,  Ã, If ( intX>0 And intX<Scr_Width-1 ) And ( intY>0 And intY<Scr_Height-1 ) Then
Ã,  Ã,  Ã,  Ã, buffer( intX + (intY * Scr_Width) ) = intC
Ã,  Ã, End If Ã,  
End Sub

Function Millisecs( ByVal fltTimeValue As Double ) As Double
Ã,  Ã, Return ( fltTimeValue * 1000.00 )
End Function
Edited by: rbraz at: 17/4/06 2:28

5H0CKW4VE
*Administrator*

Posts: 8001
(17/4/06 11:03)
Reply
ezSupporter

Ã, Re: Plasma Effect
--------------------------------------------------------------------------------
Nice plasma pattern Rbraz. Ã,


--------------------------------------------------------------------------------


Ã,¤Ã,´Ã,¨)
Ã,¸.Ã,·Ã,´Ã,¸.Ã,·*Ã,´Ã,¨) Ã,¸.Ã,·*Ã,¨)
(Ã,¸.Ã,·Ã,´ (Ã,¸.Ã,·`Ã,¤... SHOCKWAVE / DBF...Ã,¤

VISIT DARK BIT FACTORY INTERACTIVE! (please!)

[Clyde]

Nice one Rbraz and thanks for sharing a neat plasma with nice and vibrant colours.

Cool and Cheers,
Clyde.