Wireframe tunnel

[Shockwave]

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.

Code Select Expand


'
'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


[Rbz]

Nice tunnel, I can't wait to see it burning 

[zawran]

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.

[relsoft]

tight!

[Tetra]

Cool, cant wait to see that burn 

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

Code Select Expand


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


[zawran]

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.

[Shockwave]

Yep, my line draw code was screwed up! Cheers guys Glad you liked it.
I'm about to set fire to it today.