*** From DBF ezboard ***
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
Quote
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!)
Nice one Rbraz and thanks for sharing a neat plasma with nice and vibrant colours.
Cool and Cheers,
Clyde.