Dark Bit Factory & Gravity

PROGRAMMING => Freebasic => Topic started by: Rbz on May 04, 2006

Title: Plasma Effect
Post by: Rbz on May 04, 2006: *** 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

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!)
Title: Re: Plasma Effect
Post by: Clyde on May 04, 2006: Nice one Rbraz and thanks for sharing a neat plasma with nice and vibrant colours.

Cool and Cheers,
Clyde.