NewsForumsCodeLogsGallerySpecsSearch

Code archives/Graphics/Plasma

This code has been declared by its author to be Public Domain code.

Download source code

Plasma by jfk EO-111102002
Used for several FX. Seamless Animation 
; This is the Original Source for many of my Plasma-FX.
; Original QB-Plasma, ported to BB . By CSP 2001.

; Note: Turn Off the Debugger, or it will be way too slow
Graphics 640,480,16,2
SetBuffer BackBuffer()
plasma=CreateImage(320,320)
Dim cosinus(640)
position = 0
For c = 0 To 640
 cosinus(c) = Cos((115*3.14159265358 * c) / 320) * 32 + 32
Next 
;Create some Color Arrays
Dim r(255) : Dim g(255) : Dim b(255) : Dim mrgb(255)
For i=0 To 63 : r(i)=i*4 : g(i)=0 : b(i)=255-(i*4) : Next
For i=0 To 63 : r(i+64)=255-(i*4) : g(i+64)=i*2 : b(i+64)=0 : Next
For i=0 To 63 : r(i+128)=i*2 : g(i+128)=128-(i*2) : b(i+128)=i*4 : Next
For i=0 To 63 : r(i+192)=128+(i*2) : g(i+192)=i : b(i+192)=255-(i*4) : Next
For i=0 To 255 : mrgb(i)=((r(i)*$10000)+(g(i)*$100)+b(i))And $FFFFFF : Next
; mainloop
While a<>27
 a=GetKey()
 Gosub qbplasma
 Flip
Wend
End
.qbplasma
 wave1 = wave1 + 2
 If wave1 >= 320 Then wave1 = 0 
 wave2 = wave2 + 2
 If wave2 >= 320 Then wave2 = 0
 wave3 = wave3 + 3
 If wave3 >= 320 Then wave3 = 0
 SetBuffer ImageBuffer(plasma)
 LockBuffer
   For y = 0 To 319
    d = cosinus(y + wave2) + cosinus(y + wave3)
    For x = 0 To 319
     f = (cosinus(x + wave1) + cosinus(x + y) + d) And $FF
     WritePixelFast x,y,mrgb(f)
   Next 
  Next
 UnlockBuffer
 SetBuffer BackBuffer()
 DrawImage plasma,0,0
Return

Comments

Boiled Sweets2006
Awesome. Can anyone get this to work in 1024 * 768?


xlsior2006
1024x768. A tad slow, though.
Note that you can change the 'zoom' factor on this line: cosinus(c) = Cos((115*3.14159265358 * c) / 640) * 32 + 32
by changing the '640' to something else.




puki2006
WHAT!

I've never seen this before.

I posted a few months ago for plasma routines and nobody had a clue.

I love plasma routines.


puki2006
That second example is borked - quick edit of original by me ("puki"):

; This is the Original Source for many of my Plasma-FX.
; Original QB-Plasma, ported to BB . By CSP 2001.

; Note: Turn Off the Debugger, or it will be way too slow

width=1024
height=768
w2=width/2
Graphics width,height,16,2
SetBuffer BackBuffer()
plasma=CreateImage(width/2,w2)
Dim cosinus(width)
position = 0
For c = 0 To width
 cosinus(c) = Cos((115*3.14159265358 * c) / w2) * 32 + 32
Next 
;Create some Color Arrays
Dim r(255) : Dim g(255) : Dim b(255) : Dim mrgb(255)
For i=0 To 63 : r(i)=i*4 : g(i)=0 : b(i)=255-(i*4) : Next
For i=0 To 63 : r(i+64)=255-(i*4) : g(i+64)=i*2 : b(i+64)=0 : Next
For i=0 To 63 : r(i+128)=i*2 : g(i+128)=128-(i*2) : b(i+128)=i*4 : Next
For i=0 To 63 : r(i+192)=128+(i*2) : g(i+192)=i : b(i+192)=255-(i*4) : Next
For i=0 To 255 : mrgb(i)=((r(i)*$10000)+(g(i)*$100)+b(i))And $FFFFFF : Next
; mainloop
While a<>27
 a=GetKey()
 Gosub qbplasma
 Flip
Wend
End
.qbplasma
 wave1 = wave1 + 2
 If wave1 >= w2 Then wave1 = 0 
 wave2 = wave2 + 2
 If wave2 >= w2 Then wave2 = 0
 wave3 = wave3 + 3
 If wave3 >= w2 Then wave3 = 0
 SetBuffer ImageBuffer(plasma)
 LockBuffer
   For y = 0 To w2-1
    d = cosinus(y + wave2) + cosinus(y + wave3)
    For x = 0 To w2-1
     f = (cosinus(x + wave1) + cosinus(x + y) + d) And $FF
     WritePixelFast x,y,mrgb(f)
   Next 
  Next
 UnlockBuffer
 SetBuffer BackBuffer()
 DrawImage plasma,0,0
Return



xlsior2006
what's wrong with the 2nd sample? Seems to work OK without error for me?

Your sample doesn't show the plasma effect full screen.


puki2006
Well, when I run yours I get a MAV.


puki2006
Right, I have re-designed the ultimate version:

set width=640 and height=480 for speed.


; This is the Original Source for many of my Plasma-FX.
; Original QB-Plasma, ported to BB . By CSP 2001.

; Note: Turn Off the Debugger, or it will be way too slow
width=640
height=480
w2=width/2
Graphics width,height,16,1
SetBuffer BackBuffer()
plasma=CreateImage(width,height)
Dim cosinus(2560)
position = 0
For c = 0 To 2560
 cosinus(c) = Cos((115*3.14159265358 * c) / w2) * 32 + 32
Next 
;Create some Color Arrays
Dim r(255) : Dim g(255) : Dim b(255) : Dim mrgb(255)
For i=0 To 63 : r(i)=i*4 : g(i)=0 : b(i)=255-(i*4) : Next
For i=0 To 63 : r(i+64)=255-(i*4) : g(i+64)=i*2 : b(i+64)=0 : Next
For i=0 To 63 : r(i+128)=i*2 : g(i+128)=128-(i*2) : b(i+128)=i*4 : Next
For i=0 To 63 : r(i+192)=128+(i*2) : g(i+192)=i : b(i+192)=255-(i*4) : Next
For i=0 To 255 : mrgb(i)=((r(i)*$10000)+(g(i)*$100)+b(i))And $FFFFFF : Next
; mainloop
While a<>27
 a=GetKey()
 Gosub qbplasma
 Flip
Wend
End
.qbplasma
 wave1 = wave1 + 2
 If wave1 >= width Then wave1 = 0 
 wave2 = wave2 + 2
 If wave2 >= width Then wave2 = 0
 wave3 = wave3 + 3
 If wave3 >= width Then wave3 = 0
 SetBuffer ImageBuffer(plasma)
 LockBuffer
   For y = 0 To height-1
    d = cosinus(y + wave2) + cosinus(y + wave3)
    For x = 0 To width-1
     f = (cosinus(x + wave1) + cosinus(x + y) + d) And $FF
     WritePixelFast x,y,mrgb(f)
   Next 
  Next
 UnlockBuffer
 SetBuffer BackBuffer()
 DrawImage plasma,0,0
Return



Code Archives Forum