Original post from relsoft, taken from the ezboard forum
Squigly Flower Tunnel.... enjoy!
'squigly Flower tunnel
'relsoft 2006
'rel.betterwebber.com
defint a-z
OPTION EXPLICIT
'$include: 'tinyptc.bi'
declare sub DrawTunnel( Buffer() as integer, Texture() as integer,_
Tangle() as integer, Tdepth() 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 Tangle( TWID, THEI) as integer
dim shared Tdepth( TWID, THEI) 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
if( ptc_open( "freeBASIC v0.01 - Blob 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(), Tangle(), Tdepth(), (TWID shr 1)* sin(t * .5),_
(t *.
* (THEI shr 1)
ptc_update @buffer(0)
loop until inkey$""
ptc_close
end
private sub DrawTunnel(Buffer() as integer, Texture() as integer,_
Tangle() as integer, Tdepth() as integer,_
byval addx as integer, byval addy as integer)
dim pbuff, ptext as integer ptr
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 fold_scale = 0.07' * sin(timer / 512.0)
static as single fold_num = 5
static as single rad_factor = 0
dim as integer diameter
frame +=1
diameter = 128
diamxscale = 64 * diameter
cx = (TWID\2)+ sin(addx/80)*70
cy = (THEI\2)+ sin(addy/90)*70
dim temp as short
temp = 512/pi
dim angle as single
fold_off += 0.2
fold_scale = 0.5 * sin(frame / 40)
for y = 0 to THEIM1
cymy = cy - y
for x = 0 to TWIDM1
cxmx = cx -x
tx = int(angle * temp) + addx
xdist = sqr((cxmx*cxmx) + (cymy*cymy))
angle = atan2(cymy,cxmx)
'angle = angle + (((sin(fold_off + 7 * xdist/180)) * .5)+1)
angle = angle + (((sin(fold_off + 3 * xdist/180)) * .5)+1)
xdist = xdist * ((sin(fold_off + fold_num * angle) * fold_scale)+1)
ty = (diamxscale / xdist) + addy
tx = tx and 255
ty = ty and 255
buffer( y * SCR_WIDTH + x) = texture(tx, ty)
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 * (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 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 'if c > 1.0 then c = 1.0
r = 255 - (c * 255)
g = (c * 255)
b = 255 - (c * (r-255))
texture(x , y) = r shl 16 or g shl 8 or b
next x
next y
end sub
[Edit - Smileys Edited out ~ SW]
Edited by: 5H0CKW4VE at: 23/4/06 16:06
5H0CKW4VE
*Administrator*
Posts: 8028
(23/4/06 16:12)
Reply | Edit | Del
ezSupporter
New Post Re: Squigly Flower Tunnel.... Thanks for posting the source, I can't run it though.. I think that the smileys may have ruined it. I tried editing them out but still no joy :\
Going to turn off the emoticons in this forum, sorry.
¤´¨)
¸.·´¸.·*´¨) ¸.·*¨)
(¸.·´ (¸.·`¤... SHOCKWAVE / DBF...¤
VISIT DARK BIT FACTORY INTERACTIVE! (please!)
rbraz
CBM 128
Posts: 193
(23/4/06 17:21)
Reply | Edit | Del
New Post Re: Squigly Flower Tunnel.... I can't run it too
AlienEye0
*Administrator*
Posts: 182
(23/4/06 18:00)
Reply | Edit | Del
New Post Re: Squigly Flower Tunnel.... Can't run it either
jimshawx
ZX SPECTRUM
Posts: 40
(24/4/06 8:35)
Reply | Edit | Del New Post is this it? I think it's supposed to look a bit like this (apologies if I messed it up) - cool psycho fx there from relsoft!
'squigly Flower tunnel
'relsoft 2006
'rel.betterwebber.com
defint a-z
OPTION EXPLICIT
'#define PTC_WIN
'$include: 'tinyptc.bi'
declare sub DrawTunnel( Buffer() as integer, Texture() as integer,_
Tangle() as integer, Tdepth() 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 Tangle( TWID, THEI) as integer
dim shared Tdepth( TWID, THEI) 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
if( ptc_open( "freeBASIC v0.01 - Blob 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(), Tangle(), Tdepth(), (TWID shr 1)* sin(t * .5),_
(t *. * (THEI shr 1)
ptc_update @buffer(0)
loop until inkey$<>""
ptc_close
end
private sub DrawTunnel(Buffer() as integer, Texture() as integer,_
Tangle() as integer, Tdepth() as integer,_
byval addx as integer, byval addy as integer)
dim pbuff, ptext as integer ptr
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 fold_scale = 0.07' * sin(timer / 512.0)
static as single fold_num = 5
static as single rad_factor = 0
dim as integer diameter
frame +=1
diameter = 128
diamxscale = 64 * diameter
cx = (TWID\2)+ sin(addx/80)*70
cy = (THEI\2)+ sin(addy/90)*70
dim temp as short
temp = 512/pi
dim angle as single
fold_off += 0.2
fold_scale = 0.5 * sin(frame / 40)
for y = 0 to THEIM1
cymy = cy - y
for x = 0 to TWIDM1
cxmx = cx -x
tx = int(angle * temp) + addx
xdist = sqr((cxmx*cxmx) + (cymy*cymy))
angle = atan2(cymy,cxmx)
'angle = angle + (((sin(fold_off + 7 * xdist/180)) * .5)+1)
angle = angle + (((sin(fold_off + 3 * xdist/180)) * .5)+1)
xdist = xdist * ((sin(fold_off + fold_num * angle) * fold_scale)+1)
ty = (diamxscale / xdist) + addy
tx = tx and 255
ty = ty and 255
buffer( y * SCR_WIDTH + x) = texture(tx, ty)
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 > (TEXT_XMAX + 1) then
ycoords(i) = rnd * (TEXT_YMAX + 1)
next i
return d
end function
sub init_texture()
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 > maxdist then maxdist = distance
if distance < mindist then mindist = 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 'if c > 1.0 then c = 1.0
r = 255 - (c * 255)
g = (c * 255)
b = 255 - (c * (r-255))
texture(x , y) = r shl 16 or g shl 8 or b
next x
next y
end sub
Jim
5H0CKW4VE
*Administrator*
Posts: 8038
(24/4/06 16:23)
Reply | Edit | Del
ezSupporter
New Post Re: is this it? Jim fixed it for you :-)
Looks pretty too.
¤´¨)
¸.·´¸.·*´¨) ¸.·*¨)
(¸.·´ (¸.·`¤... SHOCKWAVE / DBF...¤
VISIT DARK BIT FACTORY INTERACTIVE! (please!)
Clyde Radcliffe
Fuzzy Wuzzy
Posts: 18291
(24/4/06 20:48)
Reply | Edit | Del
New Post Re: is this it? Awesome Squigly Tunnel biz Relsoft
rbraz
CBM 128
Posts: 196
(24/4/06 23:43)
Reply | Edit | Del
New Post Re: is this it? Browsing the FB site, I found this :
www.freebasic.net/forum/viewtopic.php?t=3892and this one:
www.freebasic.net/forum/viewtopic.php?t=3647Nice work dude !
relsoft
ZX 81
Posts: 3
(25/4/06 14:17)
Reply | Edit | Del New Post Re: is this it? Thanks guys. I've been nto tunnels ever since I could remember.
I've made tunnels using the method above, a fake method that used almost the same algo, a ratraced one, an opengl based one, etc.
I don't know why I liked tunnels so much. :*)
edit: added lighting and a better texture
[quote]'squigly Flower tunnel
'relsoft 2006
'rel.betterwebber.com
'added light ;*)
defint a-z
OPTION EXPLICIT
'$include: 'tinyptc.bi'
declare sub DrawTunnel( Buffer() as integer, Texture() as integer,_
Tangle() as integer, Tdepth() 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 Tangle( TWID, THEI) as integer
dim shared Tdepth( TWID, THEI) 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
if( ptc_open( "freeBASIC v0.01 - Blob 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(), Tangle(), Tdepth(), (TWID shr 1)* sin(t * .5),_
(t *.8)* (THEI shr 1)
ptc_update @buffer(0)
loop until inkey$""
ptc_close
end
private sub DrawTunnel(Buffer() as integer, Texture() as integer,_
Tangle() as integer, Tdepth() as integer,_
byval addx as integer, byval addy as integer)
dim pbuff, ptext as integer ptr
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 fold_scale = 0.07' * sin(timer / 512.0)
static as single fold_num = 5
static as single rad_factor = 0
dim as integer diameter
frame +=1
diameter = 128
diamxscale = 64 * diameter
cx = (TWID\2)+ sin(addx/80)*70
cy = (THEI\2)+ sin(addy/90)*70
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 maxdist=1/sqr(100*100+160*160)
for y = 0 to THEIM1
cymy = cy - y
for x = 0 to TWIDM1
cxmx = cx -x
xdist = sqr((cxmx*cxmx) + (cymy*cymy))
angle = atan2(cymy,cxmx)
tx = int(angle * temp) + addx
angle = angle + (((sin((fold_off+PI) + 3 * xdist/180)) * .3)+1)
xdist = xdist * ((sin(fold_off + fold_num * angle) * fold_scale)+1)
light = xdist * 5
if light > 255 then light = 255
light = 255 - light
ty = (diamxscale / xdist) + addy
tx = (tx) and 255
ty = (ty) and 255
buffer( y * SCR_WIDTH + x) = texture(tx, ty) or (light shl 16 or light shl 8 or light)
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 * (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 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 'if c > 1.0 then c = 1.0
r = 255 - (c * 255)
g = (c * 255)
b = r'255 - (c * (r-255))
texture(x , y) = r shl 16 or g shl 8 or b
next x
next y
end sub[/quote]
Edited by: relsoft at: 25/4/06 15:57
5H0CKW4VE
*Administrator*
Posts: 8043
(25/4/06 16:02)
Reply | Edit | Del
ezSupporter
New Post Re: is this it? Meh! I can't get that one working either!
¤´¨)
¸.·´¸.·*´¨) ¸.·*¨)
(¸.·´ (¸.·`¤... SHOCKWAVE / DBF...¤
VISIT DARK BIT FACTORY INTERACTIVE! (please!)
relsoft
ZX 81
Posts: 5
(25/4/06 16:09)
Reply | Edit | Del New Post Re: is this it? Try this:
www.freebasic.net/forum/v...php?t=38925H0CKW4VE
*Administrator*
Posts: 8056
(27/4/06 15:47)
Reply | Edit | Del
ezSupporter
New Post Re: is this it? It looks cool, but then I am a sucker for software rendered stuff.
btw, I think that the formatting tags of ezboard are messing up your source listings here. I can't think why it's happening to your source except that you may be posting the source and then going back in to edit the [ code ] tags in later? Just a thought because we appreciate any posts, especially those with code!
¤´¨)
¸.·´¸.·*´¨) ¸.·*¨)
(¸.·´ (¸.·`¤... SHOCKWAVE / DBF...¤
VISIT DARK BIT FACTORY INTERACTIVE! (please!)
Clyde Radcliffe
Fuzzy Wuzzy
Posts: 18309
(27/4/06 17:36)
Reply | Edit | Del
New Post Re: is this it? And awesome work to boot. Any more where that came from Relsoft dude!
Wicked and Cheers,
Clyde.
