Here's a rough draft of a tidier thing I made that may be used in a forthcoming DBF prod. Here's the source to the half working version.
'
' RGB PLASMA BY SHOCKWAVE^DBF
' ===========================
'--------------------------------------------------------------------------
OPTION STATIC
OPTION EXPLICIT
print "PRE-CALCULATING PLEASE WAIT"
'-------------------------------------------------------------------------
'Please ditch the defs below, they are for the shit fps counter.
'Benchmark reading when nothing is happening is;
'1876 ++ on my comp.
'
'During runtime it's;
'
'998 - 1038
'-------------------------------------------------------------------------
declare sub millisecs()
DIM SHARED AS DOUBLE oldtime,newtime
dim shared ticks,t as integer
'-------------------------------------------------------------------------
' Colour tables for plasmas!
'-------------------------------------------------------------------------
dim shared ctabler(1024*1096) as ubyte
dim shared ctableg(1024*1096) as ubyte
dim shared ctableb(1024*1096) as ubyte
dim shared as integer pmr,pmg,pmb,pmm
declare sub plasma_palette ()
plasma_palette()
declare sub plasmoid()
'-------------------------------------------------------------------------
' Includes.
'-------------------------------------------------------------------------
'#define PTC_WIN
#Include Once "tinyptc.bi"
'-------------------------------------------------------------------------
' Open Screen;
'-------------------------------------------------------------------------
If( ptc_open( "FAST RGB PLASMA BY SHOCKWAVE^DBF", 640, 480 ) = 0 ) Then
End -1
End If
Dim Shared As uInteger Buffer( 640 * 480 ):' Screen Buffer.
'-------------------------------------------------------------------------
' Main Loop;
'-------------------------------------------------------------------------
DO
plasmoid()
millisecs()
ptc_update@buffer(0)
ticks=ticks+1 :' <-- Ditch this (FPS Counter)
LOOP UNTIL INKEY$ = CHR$(27)
'-------------------------------------------------------------------------
' Renders the plasma onto the screen buffer!
'-------------------------------------------------------------------------
sub plasmoid()
DIM CC,DD AS UINTEGER
dim as uinteger a2,a,x,y , pmry,pmgy,pmby
pmm=pmm+1
pmr=140+139*sin(pmm/93)
pmg=140+139*sin(pmm/87)
pmb=140+139*sin(pmm/79)
pmry=100+99*sin(pmm/91)
pmry=(pmry*1024)+pmr
pmgy=100+99*sin(pmm/101)
pmgy=(pmgy*1024)+pmg
pmby=100+99*sin(pmm/111)
pmby=(pmby*1024)+pmb
for y=0 to 479
CC=640*Y
DD=1024*Y
for x=0 to 639
a=CC+x
a2=DD+X
buffer(a)=rgb(ctabler((a2)+pmry),ctableg((a2)+pmgy),ctableb((a2)+pmby))
next
next
end sub
'-------------------------------------------------------------------------
' Shit FPS Counter, discard.
'-------------------------------------------------------------------------
SUB Millisecs()
dim as double t
t=timer
if t-oldtime >=1 then
newtime = ticks
ticks=0
oldtime=timer
print "PLASMA ON SPEED FPS:"+str( (newtime) )
end if
end sub
'-------------------------------------------------------------------------
' Precalculate some plasma patterns!
'-------------------------------------------------------------------------
sub plasma_palette()
dim as integer l , x , y,cnut
for y = 0 to 1096
cnut=30+29*sin(y/91)
for x = 0 to 1024
L=(1024*Y)+X
ctabler(l)=int(125+(60*sin(((x+y)/33)))+(cnut*cos((y/15))))
ctableg(l)=int(125+(cnut*sin((x/58)))+(64*cos((y/49))))
ctableb(l)=int(125+(60*cos((x/27)))+(64*cos(((y-x)/19))))
next
next
end sub
