An old routine I didn't do anything with....
'Crazy Delerium.
'By Shockwave
'
'--------------------------------------------------------------------------
OPTION STATIC
OPTION EXPLICIT
Print "PRECALCULATING"
'-------------------------------------------------------------------------
'Please ditch the defs below, they are for the shit fps counter.
'Benchmark reading when nothing is happening is;
'
'-------------------------------------------------------------------------
declare sub millisecs()
DIM SHARED AS DOUBLE oldtime,newtime
dim shared ticks,t as integer
'-------------------------------------------------------------------------
' The stuff below is needed to set up the circles;
'-------------------------------------------------------------------------
declare sub dcircle(BYVAL CX AS INTEGER , BYVAL CY AS INTEGER , BYVAL R AS INTEGER, BYVAL CLR AS INTEGER)
declare sub generate()
Dim Shared As uInteger Buffer( 640 * 480 ): ' Screen Buffer. (or your texture buffer)
Dim Shared As ubyte C_Buffer( 1280 * 1280 ):' Circles Buffer.
dim shared as Uinteger C_Palette(512): ' Circles Palette.
declare sub Make_circle_palette()
declare sub render_delerium1(BYVAL XCX AS uINTEGER , BYVAL XCY AS uINTEGER)
declare sub render_delerium2(BYVAL XCX AS uINTEGER , BYVAL XCY AS uINTEGER)
dim shared cwobble as integer
MAKE_CIRCLE_PALETTE()
GENERATE()
'-------------------------------------------------------------------------
' Includes.
'-------------------------------------------------------------------------
'#define PTC_WIN
#Include Once "tinyptc.bi"
'-------------------------------------------------------------------------
' Open Screen;
'-------------------------------------------------------------------------
If( ptc_open( "FAST DELERIUM", 640, 480 ) = 0 ) Then
End -1
End If
'-------------------------------------------------------------------------
' Main Loop;
'-------------------------------------------------------------------------
DIM SHARED GADD AS INTEGER
DO
gadd=gadd+1
render_delerium1(320+200*sin(gadd/33),420+200*sin(gadd/63))
render_delerium2(320+200*sin(gadd/43),420+200*sin(gadd/53))
millisecs()
ptc_update@buffer(0)
ticks=ticks+1 :' <-- Ditch this (FPS Counter)
LOOP UNTIL INKEY$ = CHR$(27)
'-------------------------------------------------------------------------
' Make some nice colours!.
'-------------------------------------------------------------------------
sub make_circle_palette()
dim as integer a
dim as double RD,GR,BL
RD=0
GR=0
BL=0
FOR A=1 TO 250
If A<125 and RD<250 then RD=RD+2.1
if A<125 AND GR<250 then GR=GR+2.2
if A<125 and BL<250 then BL=BL+2.3
If A>=125 and RD>3 then RD=RD-2.4
if A>=125 AND GR>3 then GR=GR-2.3
if A>=125 and BL>3 then BL=BL-2.2
C_palette(A) = RGB (int(RD),int(GR),int(BL))
NEXT
FOR A=251 TO 500
If A<375 and RD<249 then RD=RD+2.3
if A<375 AND GR<249 then GR=GR+2.2
if A<375 and BL<249 then BL=BL+2.1
If A>=375 and RD>6 then RD=RD-2.4
if A>=375 AND GR>6 then GR=GR-2.3
if A>=375 and BL>6 then BL=BL-3.2
C_palette(A) = RGB (int(RD),int(GR),int(BL))
NEXT
end sub
'-------------------------------------------------------------------------
' Render 1st circle set, clearing the buffer as we go.
'-------------------------------------------------------------------------
sub render_delerium1(BYVAL XCX AS uINTEGER , BYVAL XCY AS uINTEGER)
dim as uinteger x,y,xrs,yrs,bpos,ppos,yppre1,yppre2
cwobble=cwobble+5
' 573
for y=0 to 479
yppre1 = 640*y
yppre2 = (1280*(y+XCY))+(16+15*sin((y+cwobble))/163)
for x=0 to 639
bpos=yppre1+x
ppos=yppre2+(x+XCX)
buffer(bpos) = C_buffer(ppos)
next
next
end sub
'-------------------------------------------------------------------------
' Render 2nd circle set and convert buffer to colours
'-------------------------------------------------------------------------
sub render_delerium2(BYVAL XCX AS uINTEGER , BYVAL XCY AS uINTEGER)
dim as uinteger x,y,xrs,yrs,bpos,ppos,yppre1,yppre2
for y=0 to 479
yppre1 = 640*y
yppre2 = (1280*(y+XCY))+(50+49*sin((y+cwobble)/53))
for x=0 to 639
bpos=YPPRE1+x
ppos=YPPRE2+(x+XCX)
buffer(bpos) = C_PALETTE(buffer(bpos) + C_buffer(ppos))
next
next
end sub
'-------------------------------------------------------------------------
' Circle routine;
'-------------------------------------------------------------------------
SUB dCIRCLE(BYVAL CX AS INTEGER , BYVAL CY AS INTEGER , BYVAL R AS INTEGER, BYVAL CLR AS INTEGER)
DIM as integer r2,cc,loopy,ww,l
r2=r*r
cc=-r
for loopy = cc to r
ww = Sqr(r2-loopy*loopy)
for l = CX-ww to CX+ww
C_buffer((1280*(loopy+CY))+l)=CLR
next
next
END SUB
'-------------------------------------------------------------------------
' Create circle pattern
'-------------------------------------------------------------------------
sub GENERATE()
dim rr,lame,ccl as integer
lame=0
ccl=0
for rr=639 to 1 step-1
dcircle (640,640,rr,ccl)
if lame = 0 then ccl = ccl+1
if lame = 1 then ccl = ccl-1
if ccl>=250 then lame=1
if ccl<=2 then lame=0
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 str( (newtime) )
end if
end sub
