Think I posted this on the old forum but here's the tunnel I made:
'squigly Flower tunnel
'relsoft 2006
'http://rel.betterwebber.com
'added light ;*)
defint a-z
OPTION EXPLICIT
'$include: 'tinyptc.bi'
declare sub DrawTunnel( Buffer() as integer, Texture() as integer,_
byval addx as integer, byval addy as integer)
declare sub Init_Texture()
declare function wrapdist(x as single,y as single, px as single,py as single) as single
declare function dist (byval x as single,byval y as single,_
xc() as single, yc() as single,_
byref nearest_dist as single ) as single
const SCR_WIDTH = 320 * 1
const SCR_HEIGHT = 240 * 1
const SCR_SIZE = SCR_WIDTH * SCR_HEIGHT
const TWID = SCR_WIDTH
const THEI = SCR_HEIGHT
const TWIDM1 = TWID - 1
const THEIM1 = THEI - 1
const TEXT_XMAX = 256
const TEXT_YMAX = 256
const MAXPOINTS = 32
const XMID = SCR_WIDTH \ 2
const YMID = SCR_HEIGHT \ 2
const PI = 3.141593
const TWOPI = (2 * PI)
dim shared Buffer( 0 to SCR_SIZE-1 ) as integer
dim shared Texture( 255, 255) as integer
dim shared Distbuffer( 255, 255) as single
dim shared xcoords(MAXPOINTS) as single
dim shared ycoords(MAXPOINTS) as single
dim shared sqrt(-(XMID^2 + YMID^2)*2 to (XMID^2 + YMID^2)*2) as single
dim shared atan(-YMID*2 to YMID*2, -XMID*2 to XMID*2) as single
dim shared as integer current_time, time_scale
dim as integer x,y
for x = -XMID*2 to XMID*2
for y = -YMID*2 to YMID*2
atan(y,x) = atan2(y,x)
next y
next x
for x = -(XMID^2 + YMID^2)*2 to (XMID^2 + YMID^2)*2
sqrt(x) = sqr(x)
next x
if( ptc_open( "freeBASIC v0.01 - tunnel demo(Relsoft)", SCR_WIDTH, SCR_HEIGHT ) = 0 ) then
end -1
end if
randomize timer
init_texture()
dim t as single
do
t = timer
DrawTunnel Buffer(), Texture(), (TWID shr 1)* sin(t * .5),_
(t *.8)* (THEI shr 1)
ptc_update @buffer(0)
sleep 1
loop until inkey$<>""
ptc_close
end
private sub DrawTunnel(Buffer() as integer, Texture() as integer,_
byval addx as integer, byval addy as integer)
dim x, y, tx, ty as integer
static as integer cx= 160, cy =120
dim xdist as single
dim cxmx, cymy, diamxscale as integer
static frame as short
static as single fold_off = 0.02
static as single squig_off = 0.02
static as single fold_scale = 0.07' * sin(timer / 512.0)
static as single fold_num = 5
static as single rad_factor = 0
dim as integer diameter
static as integer old_scale_sign = 0
frame +=1
diameter = 128
diamxscale = 64 * diameter
cx = (TWID\2)+ sin(addx/80)*50
cy = (THEI\2)+ sin(addy/90)*50
dim temp as short
temp = 512/pi
dim angle as single
fold_off += 0.2
fold_scale = 0.5 * sin(frame / 40)
dim as integer light
dim as single inv_180 = 1/180
if sgn(fold_scale)<>0 then
if sgn(fold_scale)<> old_scale_sign then
fold_num = (fold_num+1) mod 6
old_scale_sign = sgn(fold_scale)
end if
end if
dim p as integer ptr
p = @buffer(0)
for y = 0 to THEIM1
cymy = cy - y
for x = 0 to TWIDM1
cxmx = cx -x
xdist = sqrt((cxmx*cxmx) + (cymy*cymy))
angle = atan(cymy,cxmx) + (((sin((fold_off) + (fold_num-3) * xdist*inv_180)) * fold_scale)+1)
tx = int(angle * temp) + addx
xdist = xdist * ((sin(fold_off + fold_num * angle) * fold_scale)+1)
light = xdist * 15
if light > 255 then light = 255
light = 255 - light
ty = (diamxscale / xdist) + addy
tx = (tx) and 255
ty = (ty) and 255
*p = texture(tx, ty) or (light shl 16 or light shl 8 or light )
p += 1
next x
next y
end sub
function dist ( byval x as single,byval y as single,_
xc() as single, yc() as single,_
byref nearest_dist as single ) as single
dim mindist as single
dim max as integer
dim d as single
dim dx as single, dy as single
dim diff as single
dim i as integer
mindist = 1D+32
max = ubound(xc)
for i = 0 to max
dx = abs(xc(i) - x)
dy = abs(yc(i) - y)
if dx > TEXT_XMAX/2.0 then dx = TEXT_XMAX-dx
if dy > TEXT_YMAX/2.0 then dy = TEXT_YMAX-dy
d = sqr( dx*dx + dy*dy )
if d < mindist then
nearest_dist = mindist
mindist = d
end if
next i
dist = mindist
end function
sub Init_Texture()
dim i as integer
dim frame as integer
for i = 0 to MAXPOINTS
xcoords(i) = rnd * (TEXT_XMAX + 1)
ycoords(i) = rnd * (TEXT_YMAX + 1)
next i
frame = 0
dim mindist as single
dim maxdist as single
mindist = 1D+32
maxdist = 0
dim tx as single
dim ty as single
dim x as integer
dim y as integer
dim distance as single
dim distance2 as single
dim nearest_dist as single
for y = 0 to TEXT_YMAX - 1
for x = 0 to TEXT_XMAX - 1
tx = x
ty = y
distance = dist(tx, ty, xcoords(), ycoords(), nearest_dist)
distbuffer(x, y) = distance
'distbuffer(x, y) = nearest_dist
'distbuffer(x, y) = nearest_dist - distance
'distbuffer(x, y) = sqr(nearest_dist * distance)
'distbuffer(x, y) = sqr(nearest_dist^2 - distance^2)
if distance < mindist then mindist = distance
if distance > maxdist then maxdist = distance
next x
next y
dim c as single
dim as ubyte r,g, b
for y = 0 to TEXT_YMAX - 1
for x = 0 to TEXT_XMAX - 1
c = (distbuffer(x, y) - mindist) / ((maxdist - mindist))
'if c < 0.0 then c = 0.0
'if c > 1.0 then c = 1.0
r = 255 - (c * 255)
g = (c * 255)
'g = r
b = r'255 - (c * (r-255))
texture(x , y) = r shl 16 or g shl 8 or b
next x
next y
end sub
