Author Topic: first ever tunnel  (Read 2762 times)

0 Members and 1 Guest are viewing this topic.

Offline ninogenio

  • Pentium
  • *****
  • Posts: 1666
  • Karma: 133
    • View Profile
first ever tunnel
« on: March 19, 2013 »
hello everyone i thought after all this time i better blow the dust off so here is something ive been tinkering with for a couple of days nothing amazing really just a good old tunnel. its something i always wanted too do but could never get right.

i was rustier than first expected, myself and the function sin has had a major falling out with me blaming failure on it, And it calling me an illiterate idiot that should have went to school more often..  :)

its actually coded for a demo im working on but while its still in this stage i thought id post it up if anyone has ideas to improve please post.. as it is right now its just coded the way i thought it could be achieved i know there is probably a thousand better ways of doing it.

Code: [Select]
#Include "Tinyptc_ext.Bi"
#Include "Windows.Bi"

Const XRes = 800
Const YRes = 600
Dim Shared As Double WndOrgX = XRes/2
Dim Shared As Double WndOrgY = YRes/2

RANDOMIZE TIMER

Type TimerType
   
    Frequency As LARGE_INTEGER
    LiStart As LARGE_INTEGER
    LiStop As LARGE_INTEGER
    LlTimeDiff As LONGLONG
    MDuration As Double

End Type



Type RingPoints
    Z As Double
    X As Double
    Y As Double
End Type



Type RingEntity
    CurrentRingId As Integer
    Rad As Double
    XScale As Integer
    YScale As Integer
    SinAngle As Double
    CosAngle As Double
    XPos As Double
    YPos As Double
    ZPos As Double
    Rpoint As RingPoints Ptr
End Type

Declare Sub         MyLine( byval x1 as integer, byval y1 as integer, byval x2 as integer, byval y2 as integer, ByVal Col As Integer )
Declare Sub         PtcOpen()
Declare Sub         CleanUpTunnel()
Declare Sub         SetUpTunnel()
Declare Sub         AnimateTunnel( EntityPtr As RingEntity Ptr )
Declare Sub         RenderTunnel()
Declare Sub         CreatePoints( EntityPtr As RingEntity Ptr )
Declare Sub         DeleteRing( Ring As RingEntity Ptr )
Declare Sub         StartTimer( TempTimer As TimerType Ptr )
Declare Sub         DestroyTimer( TempTimer As TimerType Ptr )
Declare Function    NewRing() As RingEntity Ptr
Declare Function    NewTimer() As TimerType Ptr
Declare Function    GetTimerMs( TempTimer As TimerType Ptr ) As Double
Declare Function    GetTimerSec( TempTimer As TimerType Ptr ) As Double

Dim Shared As Integer Buffer( XRes * YRes )
Dim Shared As Double NoOfRings = 29
Dim Shared As Double NoOfPoints = 12
Dim Shared As Double CamZ = 10
Dim Shared As Double Z, TempPointX( NoOfPoints ), TempPointY( NoOfPoints )
Dim Shared As Double Pre = 0
Dim Shared As TimerType Ptr FrameTimer
Dim Shared As RingEntity Ptr TunnelRing( NoOfRings )

FrameTimer = NewTimer()

PtcOpen()
SetUpTunnel()
While ( GetAsyncKeyState( VK_ESCAPE ) <> -32767 )
   
    StartTimer( FrameTimer )

    RenderTunnel()
   
    Ptc_Update( @Buffer(0) )
    For X = 0 To XRes*YRes
        Buffer(x)=0
    next
     do
    Loop While (  GetTimerMs( FrameTimer ) <= 1000.0/60.0 )'60fps Clamp
   
Wend
CleanUpTunnel()



Sub SetUpTunnel()
   
    Dim As Integer X
   
    TempPointX( 0 ) =  0
    TempPointY( 0 ) = -3
    TempPointX( 1 ) = +2
    TempPointY( 1 ) = -2
    TempPointX( 2 ) = +3
    TempPointY( 2 ) = 0
    TempPointX( 3 ) = +2
    TempPointY( 3 ) = +2
    TempPointX( 4 ) = 0
    TempPointY( 4 ) = +3
    TempPointX( 5 ) = -2
    TempPointY( 5 ) = +2
    TempPointX( 6 ) = -3
    TempPointY( 6 ) = 0
    TempPointX( 7 ) = -2
    TempPointY( 7 ) = -2
    TempPointX( 8 ) = 0
    TempPointY( 8 ) = -3
   
    For X = 0 To NoOfRings - 1
        TunnelRing( X ) = NewRing()
        TunnelRing( X )->Rad = 100
        TunnelRing( X )->XScale = 100
        TunnelRing( X )->YScale = 100
        TunnelRing( X )->ZPos = ( 2+X )
        pre += 0.01
       
        TunnelRing( X )->Xpos += 6*sin(pre/12)
        TunnelRing( X )->Ypos -= 9*Cos(pre/12)     
    Next
   
End Sub



Sub CleanUpTunnel()
    Dim As Integer X
    For X = 0 To NoOfRings
        DeleteRing( TunnelRing( X ) )
    Next
End Sub



Sub CreatePoints( EntityPtr As RingEntity Ptr )
   
    Dim Dia As Double
    Dim Z As Double
    Dim As Double ReciP
    Dim TempY As Integer
    Dim As Double CircaX, CircaY
   
    if EntityPtr->Rad < 0 then Return
   
    ReciP = 1.0 / ( ( EntityPtr->Zpos ) * 0.2 )
    Dia = ( EntityPtr->Rad )
   
    For Z = 0 To NoOfPoints - 1
        CircaX = TempPointX( z )*Dia
        CirCaY = TempPointY( z )*Dia
        If ( Z < NoOfPoints - 1 ) Then
            EntityPtr->Rpoint[ Z ]->X = ( ( EntityPtr->Xpos + CircaX ) * ReciP ) + WndOrgX
            EntityPtr->Rpoint[ Z ]->Y = ( ( EntityPtr->Ypos + CircaY ) * ReciP ) + WndOrgY
        End If
    Next
   
End Sub


Sub AnimateTunnel( EntityPtr As RingEntity Ptr )
   
    Dim As Integer X
    Dim As RingEntity Ptr T1sorter, T2sorter
   
    T1sorter = NewRing()
    T2sorter = NewRing()
   
    EntityPtr->Zpos -= 0.11
   
    If TunnelRing( 0 )->Zpos < 1.0 Then
        T1sorter->Zpos = TunnelRing( 0 )->Zpos
        For X = 0 To NoofRings-2
            T2sorter->Xpos = TunnelRing( X+1 )->Xpos
            T2sorter->Ypos = TunnelRing( X+1 )->Ypos
            T2sorter->Zpos = TunnelRing( X+1 )->Zpos
            TunnelRing( X )->Zpos = T2Sorter->Zpos
            TunnelRing( X )->Xpos = T2Sorter->Xpos
            TunnelRing( X )->Ypos = T2Sorter->Ypos
        Next
        TunnelRing( NoOfRings - 2 )->ZPos = T1sorter->Zpos + NoOfRings
        TunnelRing( NoOfRings - 2 )->XPos = T1sorter->Xpos
        TunnelRing( NoOfRings - 2 )->YPos = T1sorter->Ypos
    End If
   
    DeleteRing( T1sorter )
    DeleteRing( T2sorter )
   
End Sub



Sub RenderTunnel()
   
    Dim As Integer Ind = 0, Ind2 = 0
    Dim As Integer X = 0
    Dim As Double Xpoint( 4 ) ,Ypoint( 4 ), ClipX, ClipY, Temp = 0
   
    For Ind = 0 to noOfrings-2
        pre += 0.01
       
        TunnelRing( ind )->Xpos += 6*sin(pre/12)
        TunnelRing( ind )->Ypos -= 9*Cos(pre/12)       
    next
   
    For X=0 To NoOfRings -1
        CreatePoints( TunnelRing( X ) )
        AnimateTunnel( TunnelRing( X ) )
    Next
   
    Dim As Integer ColSwitch = 0
    Dim col As Integer
    Col = 0
    For X = ( NoOfRings - 1 ) To 1 Step - 1
       
        If Col < 160 And ColSwitch = 0 Then
            Col +=  4
            If Col > 70 Then ColSwitch = 1
        End If
       
        If ColSwitch = 1 Then Col -= 2
        If Col < 0 Then Col = 0
       ' Col = 255
        For Ind = 0 To 7
               
                Xpoint( 0 ) = TunnelRing( X )->Rpoint[ Ind ]->X
                Ypoint( 0 ) = TunnelRing( X )->Rpoint[ Ind ]->Y
                Xpoint( 1 ) = TunnelRing( X )->Rpoint[ Ind+1 ]->X
                Ypoint( 1 ) = TunnelRing( X )->Rpoint[ Ind+1 ]->Y
                Xpoint( 2 ) = TunnelRing( X-1 )->Rpoint[ Ind ]->X
                Ypoint( 2 ) = TunnelRing( X-1 )->Rpoint[ Ind ]->Y
                Xpoint( 3 ) = TunnelRing( X-1 )->Rpoint[ Ind+1 ]->X
                Ypoint( 3 ) = TunnelRing( X-1 )->Rpoint[ Ind+1 ]->Y
               
                MyLine( Xpoint( 0 ) , Ypoint( 0 ), Xpoint( 1 ), Ypoint( 1 ), Rgb(Col,col,col) )
                MyLine( Xpoint( 2 ) , Ypoint( 2 ), Xpoint( 3 ), Ypoint( 3 ), Rgb(Col,Col,Col) )
               
                Temp = TunnelRing( X )->Zpos - TunnelRing( X-1 )->Zpos
                If Temp > 0.9 Then
                    MyLine( Xpoint(0) , Ypoint(0), Xpoint( 2 ), Ypoint( 2 ), Rgb(col,col,col))
                    MyLine( Xpoint(1) , Ypoint(1), Xpoint( 3 ), Ypoint( 3 ), Rgb(col,col,col))
                EndIf
        Next
    Next
   
End Sub



Sub PtcOpen()
   
    Ptc_AllowClose(0)
    Ptc_SetDialog(1,"NinosFirstTunnel"+CHR$(13)+"FullScreen",0)
    Ptc_SetFlip(1)
    If ( Ptc_Open( "Tunnel", XRes, YRes ) = 0 ) Then
        End - 1
    End If
   
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'infamous line algorythm found years ago some where in google world'
'ported From c                                                     '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub MyLine( byval x1 as integer, byval y1 as integer, byval x2 as integer, byval y2 as integer, ByVal Col As Integer )
   
    dim i, deltax, deltay, numpixels as integer
    dim d, dinc1, dinc2 as integer
    dim x, xinc1, xinc2 as integer
    dim y, yinc1, yinc2 as integer
   
    'If X1 < 1 Then X1 = 1
    'If X1 > Xres Then X1 = Xres-1
    'If X2 < 1 Then X2 = 1
    'If X2 > Xres Then X2 = Xres-1
   
    'If Y1 < 1 Then Y1 = 1
    'If Y1 > Yres Then Y1 = Yres-1
    'If Y2 < 1 Then Y2 = 1
    'If Y2 > Yres Then Y2 = Yres-1
   
    'calculate deltaX and deltaY
    deltax = abs(Cast(integer,x2 - x1))
    deltay = abs(Cast(integer,y2 - y1))
         
    'initialize
    if ( deltax >= deltay ) then
        'If x is independent variable
        numpixels = deltax + 1
        d = ( 2 * deltay ) - deltax
        dinc1 = deltay shl 1
        dinc2 = ( deltay - deltax ) shl 1
        xinc1 = 1
        xinc2 = 1
        yinc1 = 0
        yinc2 = 1
    else
        'if y is independent variable
        numpixels = deltay + 1
        d = ( 2 * deltax ) - deltay
        dinc1 = deltax shl 1
        dinc2 = ( deltax - deltay ) shl 1
        xinc1 = 0
        xinc2 = 1
        yinc1 = 1
        yinc2 = 1
    endif
         
    'move the right direction
    if ( int(x1) > int(x2) ) then
        xinc1 = -xinc1
        xinc2 = -xinc2
    endif
         
    if ( int(y1) > int(y2) ) then
        yinc1 = -yinc1
        yinc2 = -yinc2
    endif
         
    X = Cast(Integer,X1)
    Y = Cast(Integer,Y1)
         
    'draw the pixels
    For I = 1 To NumPixels
        If Y > 2 And Y < Yres - 2 Then
            If X > 2  and X < Xres - 2 Then
                Buffer( Y*Xres+X ) = Col
            End If
        End If
       
        If ( d < 0 ) Then
            d = d + dinc1
            x = x + xinc1
            y = y + yinc1
        Else
            d = d + dinc2
            x = x + xinc2
            y = y + yinc2
        EndIf
    Next
         
End Sub



Function NewTimer() As TimerType Ptr
   
    Dim As TimerType Ptr TempTimer
   
    TempTimer = CAllocate( SizeOf( TimerType ) )
    QueryPerformanceFrequency( @TempTimer->Frequency )
    NewTimer = TempTimer
   
End Function



Sub StartTimer( TempTimer As TimerType Ptr )
   
    QueryPerformanceCounter( @TempTimer->LiStart )
   
End Sub



Function GetTimerMs( TempTimer As TimerType Ptr ) As Double
   
    QueryPerformanceCounter( @TempTimer->LiStop )
    TempTimer->LlTimeDiff = TempTimer->LiStop.QuadPart - TempTimer->LiStart.QuadPart
    TempTimer->MDuration = Cast( Double, TempTimer->LlTimeDiff ) * 1000.0 / Cast( Double , TempTimer->Frequency.QuadPart )
    GetTimerMs = TempTimer->MDuration
   
End Function



Function GetTimerSec( TempTimer As TimerType Ptr ) As Double
   
    QueryPerformanceCounter( @TempTimer->LiStop )
    TempTimer->LlTimeDiff = TempTimer->LiStop.QuadPart - TempTimer->LiStart.QuadPart
    TempTimer->MDuration = Cast( Double, TempTimer->LlTimeDiff ) * 1000.0 / Cast( Double , TempTimer->Frequency.QuadPart )
    GetTimerSec = TempTimer->MDuration/1000.0
   
End Function



Sub DestroyTimer( TempTimer As TimerType Ptr )
   
    If ( TempTimer ) Then
        DeAllocate( TempTimer )
    EndIf
   
End Sub



Function NewRing() As RingEntity Ptr
    Dim As RingEntity Ptr TempRingEntity
    TempRingEntity = Callocate( SizeOf( RingEntity ) )
    TempRingEntity->Rpoint = Callocate( NoOfPoints*SizeOf( RingEntity ) )
    NewRing = TempRingEntity
End Function



Sub DeleteRing( Ring As RingEntity Ptr )
    If ( Ring ) Then
        If ( Ring->RPoint ) Then
            DeAllocate( Ring->Rpoint )
        EndIf
        DeAllocate( Ring )
    End If
End Sub

« Last Edit: March 19, 2013 by ninogenio »
Challenge Trophies Won:

Offline Raizor

  • Founder Member
  • Pentium
  • ********
  • Posts: 1150
  • Karma: 174
    • View Profile
    • Raizor's Dev Blog
Re: first ever tunnel
« Reply #1 on: March 19, 2013 »
Looks good ninogenio :) It runs REALLY fast here though, too fast to make out what's going on without clicking the title bar to slow things down. It might looks cool with some solid color shading too. Nice one, K++
raizor

Challenge Trophies Won:

Offline ninogenio

  • Pentium
  • *****
  • Posts: 1666
  • Karma: 133
    • View Profile
Re: first ever tunnel
« Reply #2 on: March 19, 2013 »
Cheers for that Raizor, yup totally see what you mean when i disabled vsync in my drivers i was like wtf?? lol.

everythings now been updated too use 60fps frame clamping so should be nice and smooth on everyones machines.
yeah some solid color would be cool and i have all the points already there so should be a simple case of two triangles per quad ill give it a bash!
Challenge Trophies Won:

Offline Hotshot

  • DBF Aficionado
  • ******
  • Posts: 2114
  • Karma: 91
    • View Profile
Re: first ever tunnel
« Reply #3 on: March 19, 2013 »
Excellent Wireframe of Tunnels

Nice one  :clap:

Offline Shockwave

  • good/evil
  • Founder Member
  • DBF Aficionado
  • ********
  • Posts: 17378
  • Karma: 497
  • evil/good
    • View Profile
    • My Homepage
Re: first ever tunnel
« Reply #4 on: March 19, 2013 »
I really like the movement there Nino :) Nice tunnel!

I'd love to see it shaded and maybe spinning too, nice first routine especially considering you've been away for a while!
Shockwave ^ Codigos
Challenge Trophies Won:

Offline combatking0

  • JavaScript lives!
  • Senior Member
  • DBF Aficionado
  • ********
  • Posts: 4569
  • Karma: 235
  • Retroman!
    • View Profile
    • Combat King's Barcode Battler Home
Re: first ever tunnel
« Reply #5 on: March 19, 2013 »
Cool - it's like following a funnel web spider into its endless lair 8)
You are our 9001st visitor.
Challenge Trophies Won:

Offline ninogenio

  • Pentium
  • *****
  • Posts: 1666
  • Karma: 133
    • View Profile
Re: first ever tunnel
« Reply #6 on: March 20, 2013 »
thanks very very much guys!!!

excellent suggestions too, attached is solid filled and shaded version it looks really really cool now better than i had hoped for actually!.

now i need to make it spin which will be awsome.
« Last Edit: March 20, 2013 by ninogenio »
Challenge Trophies Won:

Offline Kirl

  • Senior Member
  • Pentium
  • ********
  • Posts: 1200
  • Karma: 230
    • View Profile
    • Homepage
Re: first ever tunnel
« Reply #7 on: March 20, 2013 »
Looks great with the fills!  :clap:
www.kirl.nl
Challenge Trophies Won:

Offline Raizor

  • Founder Member
  • Pentium
  • ********
  • Posts: 1150
  • Karma: 174
    • View Profile
    • Raizor's Dev Blog
Re: first ever tunnel
« Reply #8 on: March 20, 2013 »
Lovely ninogenio :)

Runs really smooth here and the filled shapes and the fogging/shading looks really great too.
raizor

Challenge Trophies Won:

Offline ninogenio

  • Pentium
  • *****
  • Posts: 1666
  • Karma: 133
    • View Profile
Re: first ever tunnel
« Reply #9 on: March 21, 2013 »
cheers guys :cheers: this has given me a taste for old school type stuff. ive got a few diffrent effects ive always wanted to try so ill probably be posting a few more routines over the next few days.
Challenge Trophies Won:

Offline Shockwave

  • good/evil
  • Founder Member
  • DBF Aficionado
  • ********
  • Posts: 17378
  • Karma: 497
  • evil/good
    • View Profile
    • My Homepage
Re: first ever tunnel
« Reply #10 on: March 22, 2013 »
That reminds me of olschool toothpaste :)

It looks very nice shaded.
Shockwave ^ Codigos
Challenge Trophies Won:

Offline combatking0

  • JavaScript lives!
  • Senior Member
  • DBF Aficionado
  • ********
  • Posts: 4569
  • Karma: 235
  • Retroman!
    • View Profile
    • Combat King's Barcode Battler Home
Re: first ever tunnel
« Reply #11 on: March 22, 2013 »
It's a lot smoother than the wireframe looked. Nice progression from the original program.
You are our 9001st visitor.
Challenge Trophies Won:

Offline ninogenio

  • Pentium
  • *****
  • Posts: 1666
  • Karma: 133
    • View Profile
Re: first ever tunnel
« Reply #12 on: March 23, 2013 »
cheers guys!!

@nick.. i never noticed that but your totally right haha..

for anyone sitting boered wondering what too code next. code a tunnel!! there great fun too do, ive not stoped tinkering for the last couple of days trying to make it spin which is proving harder than i thought the whole thing takes off. and smooth gtri shading which looks cool.

Challenge Trophies Won:

Offline Baudsurfer

  • C= 64
  • **
  • Posts: 46
  • Karma: 18
    • View Profile
    • x86 Assembly language page
Re: first ever tunnel
« Reply #13 on: March 26, 2013 »
Nice tunnel ninogenio ! Works flawless.