#cmdline "-gen gcc -O 3"
'"-Wc -O3,-march=native,-mtune=native"

#Include "fbgfx.bi"
#Include "vbcompat.bi"
#include "crt.bi"

#ifdef __FB_WIN32__
#include "MyTDT\gfxresize.bas"
#endif

const BPP=32

#if BPP=32
  type pixel as ulong
  const MaxLight=255
  const cBlack=rgb(0,0,0),cWhite=rgb(255,255,255)
#elseif BPP=16
  type pixel as ushort
  const MaxLight=31
  const cBlack=rgb(0,0,0),cWhite=rgb(255,255,255)
#else
  type pixel as ubyte
  const MaxLight=63
  const cBlack=159,cWhite=1  
#endif  

type PalEntry
  union
    type
      R as ubyte
      G as ubyte
      B as ubyte
      A as ubyte
    end type
    U as ulong
  end union
end type

type axis
  as long x,y,z
end type

const ScrWid = 640, ScrHei = 480, PixPerRow = ScrWid
const PI=atn(1)*4
dim shared xyz as axis
dim shared as single posx, posy, posz, ang
dim shared as fb.image ptr pScenery

'initialize the screen, activate resizable window
'and load the palette (if bpp=8) along with the background image
#ifdef __FB_WIN32__
gfx.PreResize()
#endif
screenres ScrWid,ScrHei,BPP,,fb.GFX_HIGH_PRIORITY
line(0,0)-(ScrWid,ScrHei),cBlack,bf
color cWhite,cBlack
pScenery=ImageCreate(512,100)
bload "Tex\back.bmp",pScenery
#ifdef __FB_WIN32__
gfx.Resize(ScrWid,ScrHei,,1)
#endif

'used for 16/32bpp
static shared as byte DitTab(63) = { _
  01,49,13,61,04,52,16,64, _
  33,17,45,29,36,20,48,32, _
  09,57,05,53,12,60,08,56, _
  41,25,37,21,44,28,40,24, _
  03,51,15,63,02,50,14,62, _
  35,19,47,31,34,18,46,30, _
  11,59,07,55,10,58,06,54, _
  43,27,39,23,42,26,38,22 }

'if 8bpp then retrieve the palette into the palette array
'and calculate the lighting table for each light level
#if bpp=8  
  #undef rgb
  #define rgb NearestIndex
  static shared as PalEntry g_Pal(255)  
  function NearestIndex(iR as long , iG as long , iB as long) as ubyte
    dim as integer iDiff = 255*255*255*4, iResu=0
    for N as long = 1 to 255 '0 is transparent so does not count
      with g_Pal(N)
        var iDR = abs(iR-.R) , iDG = abs(iG-.G) , iDB= abs(iB-.B)
        var iChk = iDR*iDR*iDR + iDG*iDG*iDG + iDB*iDB*iDB
        if iChk < iDiff then iResu=N : iDiff=iChk
      end with
    next N
    return iResu
  end function  
  static shared as ubyte aLight(63,255) 'Light Level,Index
  for N as long = 0 to 255
    dim as long R=any,G=any,B=any
    palette get N,R,G,B
    g_Pal(N).R = R : g_Pal(N).G = G : g_Pal(N).B = B
  next N  
  for N as long = 0 to 255
    with g_Pal(N)
      for L as long = 0 to 63
        aLight(L, N) = NearestIndex((.R*L)\63,(.G*L)\63,(.B*L)\63)
      next L
    end with
    print (N*100)\255 & !"%\r";    
  next N  
#endif

function ScaleImage(pSrc as fb.image ptr,iWid as long,iHei as long) as fb.image ptr
  var iHei0 = pSrc->Height, iWid0 = pSrc->Width
  var pTemp = ImageCreate(iWid,iHei0)
  for N as long = 0 to iWid-1
    put pTemp,(N,0),pSrc,( (N*iWid0)\iWid , 0 )-step(0,iHei0-1),pset
  next N
  var pResu = ImageCreate(iWid,iHei)
  for N as long = 0 to iHei-1
    put pResu,(0,N),pTemp,( 0 , (N*iHei0)\iHei )-step(iWid-1,0),pset
  next N
  ImageDestroy(pTemp)
  return pResu
end function

randomize 64  '10 '50 '64

dim as long x=0 , y

static shared as fb.image ptr pic(5)	
static shared as long board(0 to 63,0 to 63)
static shared as long iAnim4,iAnim4c
static shared as byte bSky=true
const TexCount = ubound(pic)

for N as long = 1 to TexCount
  var sFile = "Tex\Tex" & N & ".bmp", f = freefile()  
  if open(sFile for binary access read as #f) then 
    pic(N)=imagecreate(64,64,cWhite) : continue for
  else
    dim as long iWid,iHei
    get #f,19,iWid : get #f,,iHei : close #f
    pic(N)=imagecreate(iWid,iHei,1)
    bload sFile,pic(N)
  end if
next N	

for z as long = 0 to 63 'Generate random board (0 is invisible, 1-4 are walls)
  board(z, 0) = int(TexCount * rnd) + 1
  board(0, z) = int(TexCount * rnd) + 1
  board(z, 63) = int(TexCount * rnd) + 1
  board(63, z) = int(TexCount * rnd) + 1
next z

for z as long = 0 to 1023
  board(int(62 * rnd) + 1, int(62 * rnd) + 1) = int(TexCount * rnd) + 1
next z

'The length of the side of a cube is 1
'Since the 2D board map is 64*64, posx and posy range from 0-64
'posz ranges from -.5 to .5 (0 is the middle)
do	'Make sure starting position isn't inside a cube
  x = int(62 * rnd) + 2
  y = int(62 * rnd) + 2
loop while board(x, y) <> 0
posx = x + .5: posy = y + .5: posz = 0: ang = PI * 2 * rnd

dim as double dFPS = timer
dim as long iFPS,iFPCount

function GenerateBackground( Wid as long , Hei as long , XY as byte = false ) as fb.image ptr
  var pBack = cast(fb.image ptr,ImageCreate(Wid,Hei))  
  #define _rgb(_r,_g,_b) rgb((_r)*fMul,(_g)*fMul,(_b)*fMul)
  #define _Ceiling _rgb(144, 84, 60)
  #define _Floor   _rgb(128,128,128)
  if XY then
    for N as long = 0 to Wid\2
      var fMul = 1-(N/(Wid\2))
      line pBack,(        N,0)-step(0,Hei),_Ceiling,bf
      line pBack,((Hei-1)-N,0)-step(0,Wid),_Floor  ,bf
    next N
  else
    #if bpp = 8
      var pPix=cptr(pixel ptr,pBack+1)
      var iRow=0,iCor=-1,iOff=0
      dim as ubyte iNewCor
      dim as single fMul        
      for N as long = 0 to Hei
        if N < (Hei\2) then
          fMul = 1-(N/(Hei\2))
          iNewCor = _Ceiling
        else
          fMul = ((N-(Hei\2))/(Hei\2))
          iNewCor = _Floor
        end if
        if N=Hei orelse iNewCor <> iCor then          
          if iCor=-1 then iCor=iNewCor:continue for          
          var iDiff = (N-iRow) : iRow=N
          for Y as long = 0 to iDiff-1
            var iVal = (Y*63)\iDiff
            for X as long = 0 to Wid-1
              *pPix = iif(iVal >= DitTab(iOff+(X and 7)) , iNewCor , iCor )
              pPix += 1
            next X
            iOff = (iOff+8) and 63
          next Y
          iCor = iNewCor
        end if
      next N
    #else
      for N as long = 0 to Hei\2
        var fMul = 1-(N/(Hei\2))
        line pBack,(0,N        )-step(Wid,0),_Ceiling,bf
        line pBack,(0,(Hei-1)-N)-step(Wid,0),_Floor  ,bf
      next N
    #endif
  end if

  return pBack
end function
sub RenderAsTexture( pTarget as fb.image ptr , posx as single , posy as single, posz as single, ang as single , bMirror as byte=0 )
  const TexWid = 64, TexHei = 64, RowPix = TexWid
  static as fb.image ptr pBack
  if pBack=0 then pBack=GenerateBackground(TexWid,TexHei,true)
  
  put pTarget,(0,0),pBack,pset
  dim as single cosang = cos(ang) , sinang = sin(ang)
  dim as single vxinc = sinang*-2 / TexWid , vx = cosang + sinang + vxinc*.5
  dim as single vyinc = cosang* 2 / TexWid , vy = sinang - cosang + vyinc*.5
  
  for sx as long = 0 to TexWid-1
    
    'Raytrace in 2D to see what block is hit, and where it gets hit
    dim as long xscan = int(posx) , xdir = sgn(vx)
    dim as long yscan = int(posy) , ydir = sgn(vy)
    dim as single incx = abs(vx) , incy = abs(vy)
    dim as single xtemp = posx - xscan: if xdir > 0 then xtemp = 1 - xtemp
    dim as single ytemp = posy - yscan: if ydir > 0 then ytemp = 1 - ytemp
    dim as single d = xtemp * incy - ytemp * incx
    dim as single hx, hy
    dim as long bbx
        
    var bHalfLight = false
    do
      if d < 0 then
        xscan = xscan + xdir
        if board(xscan, yscan) then
          hx = xscan: if xdir < 0 then hx = hx + 1
          hy = posy + vy * (hx - posx) / vx
          bbx = int((hy - int(hy)) * 64)
          if xdir < 0 then bbx = 63 - bbx
          exit do
        end if
        d = d + incy
      else
        yscan = yscan + ydir
        if board(xscan, yscan) then
          hy = yscan: if ydir < 0 then hy = hy + 1
          hx = posx + vx * (hy - posy) / vy
          bbx = int((hx - int(hx)) * 64)
          if ydir > 0 then bbx = 63 - bbx
          bHalfLight=true: exit do
        end if
        d = d - incx
      end if
    loop
    
    dim as single dist = cosang * (hx - posx) + sinang * (hy - posy)
    dim as long sy1, sy2, by, byi
    const hval = TexWid\2
    'Find the ceiling	floor borders, and the texture mapping equation
    if dist > 1/64 then
      sy1 = int(TexHei\2 + (-posz - .5) * hval / dist)
      sy2 = int(TexHei\2 + (-posz + .5) * hval / dist)
      if sy1 < 0 then sy1 = 0
      if sy2 > TexHei then sy2 = TexHei
      byi = ((dist * 65536) * 64) \ hval
      by = (sy1 + 1 - TexHei\2) * byi  + (posz + .5) * 65536 * 64 - 1
      by += (bbx * 64) * 65536
      'by = by + ((board(xscan, yscan) - 1) * 4096 + bbx * 64) * 65536
    else
      sy1 = TexHei \ 2: sy2 = sy1
    end if				
    
        
    #if BPP=32
      var light = 255-(((TexHei-sy2)*255)*2\TexHei)      
    #elseif BPP=16
      var light = 31-(31*dist\7)
    #else
      var light = 0
    #endif
    if light < 0 then light = 0    
    if bHalfLight then light shr= 1
    
    var pPix = cast( pixel ptr , pTarget+1 )+sx*RowPix    
    
    'Walls    
    var pTex = cast(pixel ptr,pic(board(xscan, yscan))+1)
    for Row as long = sy1 to sy2-1
      var uPix = pTex[(by\65536) and ((64*64)-1)]
      #if BPP=32
      pPix[Row] = ((((uPix and &hFF00FF)*light) shr 8) and &hFF00FF)+ _
                ((((uPix and &hFF00)*light) shr 8) and &hFF00)
      #elseif BPP=16
      pPix[Row] = ((((uPix and &hF81F)*light) shr 5) and &hF81F)+ _
                ((((uPix and &h7E0)*light) shr 5) and &h7E0)
      #else
        pPix[Row]=uPix
      #endif
      'next pixel and texture
      by += byi
    next Row
    
    'Floors
    'pe = row+TexHei
    'do while p < pe : pPix[p].u=p\((RowPix*4)) : p = p + 1 : loop
    
    vx = vx + vxinc
    vy = vy + vyinc
  next sx
  
  line pTarget,(0,0)-(TexWid-1,TexHei-1),cBlack,b
  
  
end sub

var pTemp = ScaleImage(pScenery,ScrWid*2,ScrHei\2)
ImageDestroy(pScenery):pScenery=pTemp

var pBack = GenerateBackground(ScrWid,ScrHei)

setmouse ScrWid\2,ScrHei\2,0,1

dim as double dFrame=timer
dim as single fJmpSpd
dim as single CamAng
dim as double dSumGeo,dSumRdr

type RayColumn
  StartRow as ushort
  EndRow   as ushort
  pTex     as pixel ptr
  TexCoord as ulong
  TexInc   as ulong
  TexLight as ubyte 
end type  

#ifdef UseColOrder
static shared as RayColumn tCols(ScrWid-1)
#endif

do
  dim as DOUBLE dRender=timer
  dim as single cosang = cos(ang) , sinang = sin(ang)
  
  dim as integer iFrames
  
  'events at engine rage (60hz)
  while (timer-dFrame) > 1/60
    dFrame += 1/60 : iFrames += 1 : CamAng = CamAng+.01
    'Keyboard control code
    var fSpd = iif(multikey(fb.SC_LSHIFT) or multikey(fb.SC_RSHIFT),.05,.025)
    if multikey(fb.SC_LEFT) then ang = ang - .1
    if multikey(fb.SC_RIGHT) then ang = ang + .1
    if multikey(fb.SC_A) then
      posx = posx + sinang * fSpd
      posy = posy - cosang * fSpd
    end if
    if multikey(fb.SC_D) then 
      posx = posx - sinang * fSpd
      posy = posy + cosang * fSpd
    end if
    if multikey(fb.SC_W) then 
      posx = posx + cosang * fSpd
      posy = posy + sinang * fSpd
    end if
    if multikey(fb.SC_S) then
      posx = posx - cosang * fSpd
      posy = posy - sinang * fSpd
    end if    
    if (fJmpSpd) then    
      posz += fJmpSpd : fJmpSpd += .01
      if fJmpSpd > .1 then fJmpSpd = 0
    end if    
  wend
    
  do 'single press keyboard
    var sKey=inkey : if len(sKey)=0 then exit do
    dim as long iKey = sKey[0] : if iKey=255 then iKey=-sKey[1]        
    select case iKey    
    case -fb.SC_F10: bsave "sshot.bmp",0 : end
    case  9: bSky = (bSky=0)
    case 32: fJmpSpd = -.1
    case 27,-asc("k"): end
    end select
  loop
  
  'mouse movement
  dim as long mX,mY,mB
  if getmouse(mX,mY,,mB)=0 then
    if mX<>(ScrWid\2) then 
      ang += (mX-(ScrWid\2))/100
      SetMouse ScrWid\2,ScrHei\2,0,1
    end if
  end if

  'Don't let your view escape the board
  if posx < 1.25 then posx = 1.25
  if posy < 1.25 then posy = 1.25
  if posx > 62.75 then posx = 62.75
  if posy > 62.75 then posy = 62.75
  if posz < -.5 then posz = -.5
  if posz > .5 then posz = .5
  
  '---------- dynamic textures ----------
  #if 1
  if iFrames then
    'scrolling tile
    var pTemp = ImageCreate(64,iFrames)
    put pTemp,(0,0),pic(1),pset
    put pic(1),(0,-iFrames),pic(1),pset
    put pic(1),(0,64-iFrames),pTemp,pset
    ImageDestroy(pTemp)    
    'moving circle
    'static as long iOff: iOff = (iOff+1*iFrames) and 255
    'for N as long = 48 to 1 step -1
    '  var iVal = (N+iOff) and 255
    '  circle pic(2),(32,32),N,rgb(iVal,255-iVal,0),,,,f
    'next N
    'self-camera
    RenderAsTexture( pic(3) , posx , posy , posz , Ang+PI )    
  end if  
  #endif
  
  iAnim4c += iFrames
  while iAnim4c >= (60\4)
    iAnim4c -= (60\4) : iAnim4 = (iAnim4+1) and 3
  wend
  
  screenlock      
  
  #if 0
    scope
      const BlkSz = 64*64
      var XDst = ScrWid\64, YDst = ScrHei\64
      var pPix = cptr(pixel ptr,pic(3)+1)        
      var uPos = 0
      for Y as long = 0 to 63
        var pScr = cptr(pixel ptr,screenptr)+Y*YDst*ScrWid
        for X as long = 0 to 63
          pPix[uPos] = *pScr : uPos=(uPos+64) and (BlkSz-1)
          pScr += XDst
        next X
        uPos=(uPos+1) and (BlkSz-1)
      next Y
    end scope
  #endif
  
  ang = fmodf(ang+PI*2,PI*2)
  var iAng = cint((ang*ScrWid)/PI)
  
  if bSky then
    put(-iAng,0),pScenery,pset
    put(-iAng+ScrWid*2,0),pScenery,pset
    put(0,ScrHei\2),pBack,(0,ScrHei\2)-(ScrWid-1,ScrHei-1),pset
  else
    put(0,0),pBack,pset
  end if
  
  dim as single vxinc = sinang*-2 / ScrWid , vx = cosang + sinang + vxinc*.5
  dim as single vyinc = cosang* 2 / ScrWid , vy = sinang - cosang + vyinc*.5
   
  dim as double dTemp = timer
  dim as long iFirst=ScrHei,iLast=0
  for sx as long = 0 to ScrWid-1
    'Raytrace in 2D to see what block is hit, and where it gets hit
    dim as long xscan = int(posx) , xdir = sgn(vx)
    dim as long yscan = int(posy) , ydir = sgn(vy)
    dim as single incx = abs(vx) , incy = abs(vy)
    dim as single xtemp = posx - xscan: if xdir > 0 then xtemp = 1 - xtemp
    dim as single ytemp = posy - yscan: if ydir > 0 then ytemp = 1 - ytemp
    dim as single d = xtemp * incy - ytemp * incx
    dim as single hx, hy
    dim as long bbx
        
    var bHalfLight = false
    do
      if d < 0 then
        xscan = xscan + xdir
        if board(xscan, yscan) then
          hx = xscan: if xdir < 0 then hx = hx + 1
          hy = posy + vy * (hx - posx) / vx
          bbx = int((hy - int(hy)) * 64)
          if xdir < 0 then bbx = 63 - bbx
          exit do
        end if
        d = d + incy
      else
        yscan = yscan + ydir
        if board(xscan, yscan) then
          hy = yscan: if ydir < 0 then hy = hy + 1
          hx = posx + vx * (hy - posy) / vy
          bbx = int((hx - int(hx)) * 64)
          if ydir > 0 then bbx = 63 - bbx
          bHalfLight=true: exit do
        end if
        d = d - incx
      end if
    loop
    
    dim as single dist = cosang * (hx - posx) + sinang * (hy - posy)
    dim as long sy1, sy2, by, byi
    const hval = ScrWid\2
    'Find the ceiling	floor borders, and the texture mapping equation
    if dist > 1/64 then
      sy1 = int(ScrHei\2 + (-posz - .5) * hval / dist)
      sy2 = int(ScrHei\2 + (-posz + .5) * hval / dist)
      if sy1 < 0 then sy1 = 0
      if sy2 > ScrHei then sy2 = ScrHei
      byi = ((dist * 65536) * 64) \ hval
      by = (sy1 + 1 - ScrHei\2) * byi  + (posz + .5) * 65536 * 64 - 1
      by += (bbx * 64) * 65536
      'by = by + ((board(xscan, yscan) - 1) * 4096 + bbx * 64) * 65536
    else
      sy1 = ScrHei \ 2: sy2 = sy1
    end if
        
    var light = MaxLight-(MaxLight*dist\10)
    if light < 0 then light = 0    
    if bHalfLight then light shr= 1    
    
    if board(xscan, yscan)=3 then light = MaxLight
    var pPic = pic(board(xscan, yscan))
    var pTex = cast(pixel ptr,pPic+1)
    pTex = pTex+((iAnim4*64) and (pPic->Height-1))*64
    
    #ifdef UseColOrder
      with tCols(sx)      
        if sy1 < iFirst then iFirst = sy1
        if sy2 > iLast then iLast = sy2
        .StartRow = sy1 : .EndRow   = sy2
        .pTex     = pTex: .TexLight = Light
        .TexCoord = by  : .TexInc   = byi
      end with
    #else    
      dim as long p = sx+sy1*PixPerRow, pe = sy2 * PixPerRow
      var pPix = cptr(pixel ptr,screenptr)
      while p < pe            
        var uPix = pTex[(by\65536) and ((64*64)-1)]
        #if BPP=32
        pPix[p] = ((((uPix and &hFF00FF)*light) shr 8) and &hFF00FF)+ _
                  ((((uPix and &hFF00)*light) shr 8) and &hFF00)
        #elseif BPP=16
        pPix[p] = ((((uPix and &hF81F)*light) shr 5) and &hF81F)+ _
                  ((((uPix and &h7E0)*light) shr 5) and &h7E0)
        #else
          pPix[p]= aLight(light, uPix)
        #endif
        p += PixPerRow : by += byi
      wend
    #endif  
    
    vx = vx + vxinc
    vy = vy + vyinc    
  next sx  
  dSumGeo += timer-dTemp:dTemp=timer
  
  #ifdef UseColOrder
  var pPix = cptr(pixel ptr,screenptr)+iFirst*PixPerRow  
  for iY as long = iFirst to iLast
    for iX as long = 0 to ScrWid-1      
      with tCols(iX)
        if iY>=.StartRow andalso iY<.EndRow then          
          var uPix=.pTex[(.TexCoord\65536) and ((64*64)-1)]          
          #if BPP=32
            pPix[iX] = ((((uPix and &hFF00FF)*.TexLight) shr 8) and &hFF00FF)+ _
                      ((((uPix and &hFF00)*.TexLight) shr 8) and &hFF00)
          #elseif BPP=16
            pPix[iX] = ((((uPix and &hF81F)*.TexLight) shr 5) and &hF81F)+ _
                      ((((uPix and &h7E0)*.TexLight) shr 5) and &h7E0)
          #else
            pPix[iX] = aLight(.TexLight, uPix)
          #endif
          'next pixel and texture
          .TexCoord += .TexInc
        end if      
      end with
    next iX
    pPix += PixPerRow
  next iY  
  #endif
  dSumRdr += timer-dTemp
  
  static dAvg as double, iFps as long
  dAvg += 1/(timer-dRender): iFps += 1  
  if iFps > 60 then 
    dAvg /= 2 : iFps \= 2
    dSumGeo /= 2 : dSumRdr /= 2 
  end if
  'printf(!"max fps: %i  \r",cint(dAvg/iFps))
  locate 1,1: print cint(dAvg/iFps)
  var iPct = cint((100*dSumGeo)/dSumRdr)
  locate 2,1: print right("  " & iPct,3);right("  " & (100-iPct),3)
  screenunlock
    
  sleep 30,1
  'sleep 0,1
  'screensync  
  
loop

function pic2axis(addr as long) as axis

  dim as axis temp = any
  
  temp.x =(addr and 63)
  temp.y =(addr mod 64) and (64^2-1)
  temp.z =(addr mod 64*64)
  
  return temp

end function
