Plasma Effect

[Rbz]

*** From DBF ezboard ***

Code: [Select]

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 FunctionEdited 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.