This is really very unfinished, very very unfinished in fact but I thought it was worth posting before I set fire to it and make things more complicated.
I'd like to thank Optimus for making me think about coding a tunnel that I'd be able to burn in the new intro, this should be pretty much a cut and paste job to get it into the new intro now.
'
'WORK IN PROGRESS
'BY SHOCKWAVE ^ DBF 2006
'------------------------------------------------------------------------------
'-------------------------------------
' Includes.
'-------------------------------------
#define dbfcls reDim Shared As Integer Buffer( 800 * 600 )
'#define ptc_win
#Include Once "tinyptc.bi"
option dynamic
option explicit
'-------------------------------------------------------------------------
' Open 800 X 600 Screen.
'-------------------------------------------------------------------------
If( ptc_open( "DBF TUNNEL", 640, 480 ) = 0 ) Then
End -1
End If
'--------------------------------------------------------------------------
' Define Storage;
'--------------------------------------------------------------------------
defint a-z
Dim Shared As Integer Buffer( 640 * 480 ) , a
dim shared rings as integer
rings=25
dim shared rx(rings) as double
dim shared ry(rings) as double
dim shared orx(1440) as integer
dim shared ory(1440) as integer
dim shared rz(rings) as double
dim shared gadd as integer
dim shared zsp as double
dim shared zdiv as double
dim shared move as double
dim shared circx(1440) as double
dim shared circy(1440) as double
dim shared offs as integer
offs=1
for a=1 to 1440
circx(a)=2900*sin(a*3.14/720)
circy(a)=2900*cos(a*3.14/720)
next
move=.0
zsp=rings*2
gadd=0
for a=1 to rings
rx(a)=920*sin(gadd/23)
ry(a)=920*sin(gadd/25)
rz(a)=(zsp+3)
zsp=zsp-2
gadd=gadd+5
next
'--------------------------------------------------------------------------
' Define Subs;
'--------------------------------------------------------------------------
declare sub DBFWPF(BYVAL BX AS INTEGER, BYVAL BY AS INTEGER , BYVAL CH AS INTEGER )
declare sub DBFLINE(BYVAL X1 AS INTEGER , BYVAL Y1 AS INTEGER , BYVAL X2 AS INTEGER , BYVAL Y2 AS INTEGER , BYVAL CR AS INTEGER)
declare sub draw_rings()
DO
draw_rings()
Ptc_Update @Buffer(0)
dbfcls
LOOP UNTIL INKEY$<>""
sub draw_rings()
move=move+.1
dim tx,ty, clr,bmm,z,ttx1,tty1,b,ttx2,tty2,ttx3,tty3,tx2,ty2 as integer
dim rst as integer
offs=offs+1
if offs>160 then offs=offs-160
for a=1 to rings -1
tx=(rx(a)/(rz(a)-move))+320
ty=(ry(a)/(rz(a)-move))+240
tx2=(rx(a+1)/(rz(a+1)-move))+320
ty2=(ry(a+1)/(rz(a+1)-move))+240
clr=a shl 2
bmm=(int(-rz(a)+53)) shl 1
clr=rgb(bmm ,bmm ,bmm)
for z=offs to 1280+offs step 160
if a<rings then
ttx3=(circx(z)/(rz(a+1)-move))+tx2
tty3=(circy(z)/(rz(a+1)-move))+ty2
end if
ttx1=(circx(z)/(rz(a)-move))+tx
tty1=(circy(z)/(rz(a)-move))+ty
if z<=1280 then
ttx2=(circx(z+160)/(rz(a)-move))+tx
tty2=(circy(z+160)/(rz(a)-move))+ty
else
ttx2=(circx(offs)/(rz(a)-move))+tx
tty2=(circy(offs)/(rz(a)-move))+ty
end if
'dbfwpf (ttx,tty,&hffffff)
dbfline (ttx1,tty1,ttx2,tty2,clr)
if a<rings then
dbfline (ttx1,tty1,ttx3,tty3,clr)
end if
next
next
if move>2 then
gadd=gadd-130
for a=1 to rings
rx(a)=920*sin(gadd/23)
ry(a)=920*sin(gadd/25)
gadd=gadd+5
next
move=move-2
end if
end sub
SUB DBFWPF (BYVAL BX AS INTEGER , BYVAL BY AS INTEGER , BYVAL CH AS INTEGER)
IF (BX>0) AND (BX<640) AND (BY>0) AND (BY<480) THEN
BUFFER ((BY*640)+BX)=CH
END IF
END SUB
sub DBFLINE(BYVAL X1 AS INTEGER , BYVAL Y1 AS INTEGER , BYVAL X2 AS INTEGER , BYVAL Y2 AS INTEGER , BYVAL CR AS INTEGER)
DIM LINEXDV AS DOUBLE
DIM LINEYDV AS DOUBLE
DIM startx AS DOUBLE
DIM starty AS DOUBLE
DIM xdistance AS DOUBLE
DIM ydistance AS DOUBLE
DIM greaterx AS INTEGER
DIM lesserx AS INTEGER
DIM greatery AS INTEGER
DIM lessery AS INTEGER
DIM Lineloopsize AS INTEGER
DIM lineloop AS INTEGER
If x1 < x2 Then
lesserx = x1
greaterx = x2
lessery = y1
greatery = y2
Else
lesserx = x2
greaterx = x1
lessery = y2
greatery = y1
End If
If y1 < y2 Then
lessery = y1
greatery = y2
lesserx = x1
greaterx = x2
Else
Lessery = y2
greatery = y1
lesserx = x2
greaterx = x1
End If
xdistance = (greaterx-lesserx)
ydistance = (greatery-lessery)
If xdistance=0 THEN xdistance=1
If ydistance=0 THEN ydistance=1
If xdistance>=ydistance Then
lineloopsize = int(xdistance)
Else
lineloopsize = int(ydistance)
End If
LINEXDV=(greaterx-lesserx)/lineloopsize
LINEYDV=(greatery-lessery)/lineloopsize
startx=lesserx
starty=lessery
For lineloop=0 To lineloopsize
DBFWPF (startx,starty,CR)
startx=startx+(LINEXDV)
starty=starty+(LINEYDV)
Next
END SUB
Nice tunnel, I can't wait to see it burning :)
Good looking tunnel. On my computer it does however show a bug, not sure where the problem lies though as I haven't looked that close at the code. I have made a snapshot to show how it appears. On the top and bottom, when lines are almost horizontal, i looks like its only doing a dotted line with a large space between the dots.
(http://zac-interactive.dk/temp/tun.jpg)
tight!
O0
Cool, cant wait to see that burn >:D
Hope you dont mind, but I made a new line function, mite not be as fast but its based on the equation of a line. Could save you a bit of head scratching :)
sub DBFLINE(BYVAL X1 AS INTEGER , BYVAL Y1 AS INTEGER , BYVAL X2 AS INTEGER , BYVAL Y2 AS INTEGER , BYVAL CR AS INTEGER)
DIM xdistance AS DOUBLE
DIM ydistance AS DOUBLE
DIM i AS INTEGER
DIM h2 AS INTEGER
DIM StartX AS DOUBLE
DIM StartY AS DOUBLE
DIM XRatio AS DOUBLE
DIM YRatio AS DOUBLE
xdistance = X2 - X1
ydistance = Y2 - Y1
h2 = sqr( xdistance * xdistance + ydistance * ydistance )
StartX = X1
StartY = Y1
XRatio = xdistance * ( 1.0 / h2 )
YRatio = ydistance * ( 1.0 / h2 )
for i = 0 to h2
DBFWPF ( StartX , StartY, CR )
StartX = StartX + XRatio
StartY = StartY + YRatio
next i
END SUB
I have just tried it again replacing the line sub with what Tetra made. That makes the problem go away, so there must be some kind of bug in the original line sub when lines are almost horizontal. Still a good looking tunnel.
Yep, my line draw code was screwed up! Cheers guys :) Glad you liked it.
I'm about to set fire to it today.