Dark Bit Factory & Gravity
PROGRAMMING => Freebasic => Topic started by: Rbz on September 03, 2006
-
Just as I have promised to Shockwave, here is a 'Texture Mapped Tunnel' in all it's glory :P
It's not the same tunnel code that Clyde used in his demo but still the same approach.
You can easily find more info about it just googling for some detailed tutorial or article.
'---------------------------------------------------------------------
'
'Â Â Texture Mapped Tunnel
'
'Â Â Code: Rbraz - Sept 2006
'
'--------------------------------------------------------------------
Option Explicit
'Windowed
'#define PTC_WIN
'-------------------------------------
' Includes.
'-------------------------------------
#Include "windows.bi"
#Include "tinyptc.bi"
'Palette array
#Include "Data\brick03_pal.bas"
'Raw Image array
#Include "Data\brick03_raw.bas"
'Sub Routines
Declare Sub WritePixelFast( byval intX As Integer, byval intY As Integer, byval intC As Integer )
Declare Sub LoadDataTexture()
Declare Sub InitTunnel()
'Constants
Const XRES=640 'Screen Width
Const YRES=480 'Screen Height
Const ARES=XRES * YRESÂ Â Â Â Â Â Â 'Array Width
'TinyPTC Buffer
Dim Shared Buffer(ARES) as integer
'RGB color palette buffer
Dim Shared img_r(256), img_g(256), img_b(256) as shortÂ
'texture constants/array
Dim Shared as integer textureWidth = 256
Dim Shared as integer textureHeight = 256
Dim Shared texture(textureWidth * textureHeight)
'Tunnel
Dim Shared dist(ARES) as integer
Dim Shared angleData(ARES) as integer
dim ctime1 as double
dim as integer du,dv,x,y,texel
'Load Data Image
LoadDataTexture()
'Initialyze tunnel data
InitTunnel()
'Open TinyPTC window
If( ptc_open( "Texture Mapped Tunnel", XRES, YRES ) = 0 ) Then
  End -1
End if
While Inkey$() <> Chr$(27)
    ctime1 = GetTickCount() / 2000.0
   Â
    'add u,v displacement
    du = (textureWidth * 2.0 * ctime1)
    dv = (textureHeight * 0.5 * ctime1)  Â
   Â
    for y = 0 to YRES-1
      for x = 0 to XRES-1
        'Get the texel from the texture
        texel = texture( ((dist(x + (y*XRES)) + du) mod textureWidth) + ( ((angleData(x + (y*XRES)) + dv) mod textureHeight ) * textureWidth ) )
        WritePixelFast(x,y,(img_r(texel) Shl 16) Or (img_g(texel) Shl 8 ) Or img_b(texel))
      next
    next
   Â
    Ptc_Update @Buffer(0)
 Â
Wend
'Close TinyPTC window
Ptc_Close()
Sub WritePixelFast( byval intX As Integer, byval intY As Integer, byval intC As Integer )
  If ( intX>0 And intX<XRES-1 ) And ( intY>0 And intY<YRES-1 ) Then
    Buffer( intX + (intY * XRES) ) = intC
  End If Â
End Sub
Sub LoadDataTexture()
  dim i as integer
  'Load Colour palette
  for i = 0 to 255
           'Palette array name
     img_r( i ) = brick03_pal (i*3 )'Red color
     img_g( i ) = brick03_pal (i*3+1)'Green color
     img_b( i ) = brick03_pal (i*3+2)'Blue color
  Next
   Â
  for i = 0 to (textureWidth*textureHeight) - 1
           'Raw image array name
     texture(i) = brick03_raw(i)
  nextÂ
   Â
End Sub
Sub InitTunnel()
  dim as integer x,y
  'Initialyze tunnel data
  for y = 0 to YRES-1
    for x = 0 to XRES-1
      dist(x + (y*XRES)) = ( 64 * textureHeight / sqr( ( (x - (XRES / 2.0)) * (x - (XRES / 2.0)) ) + ( (y - (YRES / 2.0)) * (y - (YRES / 2.0)) ) ) ) mod textureHeight
      angleData(x + (y*XRES)) = (atan2( (YRES / 2.0) - y , (XRES / 2.0) - x ) * textureWidth / 3.1416)
    next
  next
End Sub
-
:D I particularly like the way the screen keeps spinning even after you quit the demo! Don't stare at it too long folks!
Jim
-
Very nice. I like that.....
-
Thank you very, very much Rbraz. I'd wondered for ages how to make this kind of tunnel. I will be sure to look through this very carefully and see what other possibilities that the idea holds.
Maybe a new dbf intro on the horizon with a bump mapped tunnel? :) Hehe!
-
No probs dude, sometime ago I read that you can apply your texture to any shape you like, as long as you can describe it with a mathematical formula, and that's a truth ;D
-
Nice one Rbraz :) and thanks for sharing
-
What an amazing affect - thanks for the code man its wicked!
DrewPee
-
Nice!
Freebasic/examples/gfx/re-tunnel or something. Uses the same approach.
I believe Optimus' GP32 demo used the same approach.