'Raycaster in FreeBasic
'Converted from Lode's raycaster:
'http://www.student.kuleuven.be/~m0216922/CG/index.html
'Copyright (c) 2004-2007, Lode Vandevenne
'
'All rights reserved.
'
'Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
'
'    * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
'    * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
'
'THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
'"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
'LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
'A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
'CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
'EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
'PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
'PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
'LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
'NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
'SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
'
'Original comments perserved.
'========================================================================
'Wall graphic data.
#Include "bluestone.bi"
#Include "colorstone.bi"
#Include "eagle.bi"
#Include "greystone.bi"
#Include "mossy.bi"
#Include "purplestone.bi"
#Include "redbrick.bi"
#Include "wood.bi"
#Include "floor.bi"
#Include "ceiling.bi"
#Include "crt/math.bi"
#Include "fbgfx.bi"

Using fb

#Define screenWidth 640
#Define screenHeight 480
#Define texWidth 64
#Define texHeight 64
#Define mapWidth 24
#Define mapHeight 24

Dim Shared worldmap (mapWidth, mapHeight) As Integer
Dim Shared buffer (screenWidth, screenHeight) As UInteger

Dim As Double posX = 22.0, posY = 11.5  'x and y start position
Dim As Double dirX = -1.0, dirY = 0.0 'initial direction vector
Dim As Double planeX = 0.0, planeY = 0.66 'the 2d raycaster version of camera plane
Dim As Double ctime = 0 'time of current frame
Dim As Double oldTime = 0 'time of previous frame
Dim As Integer done = 0
Dim As Integer x, y, scrw
Dim framebuffer As UInteger Ptr
   
'Loads the map data.
Sub LoadMapData
	Restore mapdata
	
	For x As Integer = 0 To mapWidth - 1
		For y As Integer = 0 To mapHeight - 1
			Read worldmap(x, y)
		Next
	Next
End Sub

'Returns texture color for given texture
Function GetTextureColor(texnum As Integer, x As Integer, y As Integer, isfloor As Integer = 0) As UInteger
	Dim As UInteger pixel
	Dim As Integer twh
	
	If isfloor = 0 Then
		twh = texHeight
	Else
		twh = texWidth
	EndIf
	'RDC make sure values are in range here	
	If x < 0 Then x = 0
	If x > 63 Then x = 63
	If y < 0 Then y = 0
	If y > 63 Then y = 63
	
	If texnum = 1 Then 
  		pixel = eagle(twh * Y + X)
	EndIf
	If texnum = 2 Then 
  		pixel = redbrick(twh * Y + X)
	EndIf
	If texnum = 3 Then 
  		pixel = purplestone(twh * Y + X)
	EndIf
	If texnum = 4 Then 
  		pixel = greystone(twh * Y + X)
	EndIf
	If texnum = 5 Then 
  		pixel = bluestone(twh * Y + X)
	EndIf
	If texnum = 6 Then
  		pixel = mossy(twh * Y + X)
	EndIf
	If texnum = 7 Then 
  		pixel = wood(twh * Y + X)
	EndIf
	If texnum = 8 Then 
  		pixel = colorstone(twh * Y + X)
	EndIf
	If texnum = 9 Then 
  		pixel = tfloor(twh * Y + X)
	EndIf
	If texnum = 10 Then 
  		pixel = tceiling(twh * Y + X)
	EndIf
	
	Return pixel
End Function

'Draws buffer to screen.
Sub DrawBuffer
    Dim As Integer x, y, scrw
    Dim framebuffer As UInteger Ptr

    framebuffer = ScreenPtr
    If framebuffer Then
        ScreenInfo scrw
        ScreenLock
        For x = LBound(buffer, 1) To UBound(buffer, 1)
            For y = LBound(buffer, 2) To UBound(buffer, 2)
            	Poke UInteger, framebuffer + (y * scrw + x), buffer(x, y)
            Next
        Next
        ScreenUnlock
    End If
End Sub


'Set up graphic screen.
ScreenRes screenWidth, screenHeight, 32
framebuffer = ScreenPtr
ScreenInfo scrw
LoadMapData

Do
   ScreenLock
   Cls
	For x As Integer = 0 To screenWidth - 1

      'calculate ray position and direction
      Dim As Double cameraX = 2 * x / CDbl(screenWidth) - 1 'x-coordinate in camera space
      Dim As Double rayPosX = posX
      Dim As Double rayPosY = posY
      Dim As Double rayDirX = dirX + planeX * cameraX
      Dim As Double rayDirY = dirY + planeY * cameraX

      'which box of the map we're in
      Dim As Integer mapX = Int(rayPosX)
      Dim As Integer mapY = Int(rayPosY)

      '//length of ray from current position to next x or y-side
      Dim As Double sideDistX
      Dim As Double sideDistY

      'length of ray from one x or y-side to next x or y-side
      Dim As Double deltaDistX = sqrt(1 + (rayDirY * rayDirY) / (rayDirX * rayDirX))
      Dim As Double deltaDistY = sqrt(1 + (rayDirX * rayDirX) / (rayDirY * rayDirY))
      Dim As double perpWallDist

      '//what direction to step in x or y-direction (either +1 or -1)
      Dim As Integer stepX
      Dim As Integer stepY

      Dim As Integer hit = 0 '//was there a wall hit?
      Dim As Integer side '//was a NS or a EW wall hit?

      'calculate step and initial sideDist
      If rayDirX < 0 Then
      	stepX = -1
      	sideDistX = (rayPosX - mapX) * deltaDistX
      Else
        stepX = 1
        sideDistX = (mapX + 1.0 - rayPosX) * deltaDistX
      End If
      
      If rayDirY < 0 Then
        stepY = -1
        sideDistY = (rayPosY - mapY) * deltaDistY
      Else
        stepY = 1
        sideDistY = (mapY + 1.0 - rayPosY) * deltaDistY
      End If
      'perform DDA
      Do While (hit = 0)
        'jump to next map square, OR in x-direction, OR in y-direction
        If sideDistX < sideDistY Then
          sideDistX += deltaDistX
          mapX += stepX
          side = 0
        Else
          sideDistY += deltaDistY
          mapY += stepY
          side = 1
        End If
        'Check if ray has hit a wall
        If worldMap(mapX, mapY) > 0 Then hit = 1
      Loop

      'Calculate distance of perpendicular ray (oblique distance will give fisheye effect!)
      If side = 0 Then 
      	perpWallDist = fabs((mapX - rayPosX + (1 - stepX) / 2) / rayDirX)
      Else           
      	perpWallDist = fabs((mapY - rayPosY + (1 - stepY) / 2) / rayDirY)
      End If

      'Calculate height of line to draw on screen
      Dim As Integer lineHeight = Abs(Int(screenHeight / perpWallDist))

      'calculate lowest and highest pixel to fill in current stripe
      Dim As Integer drawStart = -lineHeight / 2 + screenHeight / 2
      If drawStart < 0 Then drawStart = 0
      Dim As Integer drawEnd = lineHeight / 2 + screenHeight / 2
      If drawEnd >= screenHeight Then drawEnd = screenHeight - 1

      'texturing calculations
      Dim As Integer texNum = worldMap(mapX, mapY)

      'calculate value of wallX
      Dim As double wallX 
      'where exactly the wall was hit
      If side = 1 Then 
      	wallX = rayPosX + ((mapY - rayPosY + (1 - stepY) / 2) / rayDirY) * rayDirX
      Else           
      	wallX = rayPosY + ((mapX - rayPosX + (1 - stepX) / 2) / rayDirX) * rayDirY
      End If
      wallX -= Floor((wallX))

      'x coordinate on the texture
      Dim As Integer texX = Int(wallX * CDbl(texWidth))
      If (side = 0) And (rayDirX > 0) Then texX = texWidth - texX - 1
      If (side = 1) And (rayDirY < 0) Then texX = texWidth - texX - 1

      For y As Integer = drawStart To drawEnd - 1
        Dim As Integer d = y * 256 - screenHeight * 128 + lineHeight * 128  '256 and 128 factors to avoid floats
        Dim As Integer texY = ((d * texHeight) / lineHeight) / 256
        '//make color darker for y-sides: R, G and B byte each divided through two with a "shift" and an "and"
        If side = 1 Then
        		Poke UInteger, framebuffer + (y * scrw + x), (GetTextureColor(texNum, texX,  texY) Shr 1) And 8355711
        		'buffer(x, y) = (GetTextureColor(texNum, texX,  texY) Shr 1) And 8355711
        Else
        		Poke UInteger, framebuffer + (y * scrw + x), GetTextureColor(texNum, texX,  texY)
        		'buffer(x, y) = GetTextureColor(texNum, texX,  texY)
        EndIf
      Next

      'FLOOR CASTING
      Dim As double floorXWall, floorYWall '//x, y position of the floor texel at the bottom of the wall

      '//4 different wall directions possible
      If (side = 0) and (rayDirX > 0) Then
        floorXWall = mapX
        floorYWall = mapY + wallX
      ElseIf (side = 0) and (rayDirX < 0) Then
        floorXWall = mapX + 1.0
        floorYWall = mapY + wallX
      ElseIf (side = 1) And (rayDirY > 0) Then
        floorXWall = mapX + wallX
        floorYWall = mapY
      else
        floorXWall = mapX + wallX
        floorYWall = mapY + 1.0
      End If
      
      Dim As double distWall, distPlayer, currentDist

      distWall = perpWallDist
      distPlayer = 0.0
      if (drawEnd < 0) Then drawEnd = screenHeight '//becomes < 0 when the integer overflows
      '//draw the floor from drawEnd to the bottom of the screen
      For y As Integer = drawEnd + 1 To screenHeight  - 1
        currentDist = screenHeight / (2.0 * y - screenHeight) '//you could make a small lookup table for this instead

        Dim As double weight = (currentDist - distPlayer) / (distWall - distPlayer)
         
        Dim As double currentFloorX = weight * floorXWall + (1.0 - weight) * posX
        Dim As double currentFloorY = weight * floorYWall + (1.0 - weight) * posY
        
        Dim As Integer floorTexX, floorTexY
        floorTexX = int(currentFloorX * texWidth) Mod texWidth
        floorTexY = int(currentFloorY * texHeight) Mod texHeight 
        
        '//floor
        'buffer(x, y) = (GetTextureColor(9, floorTexX,  floorTexY, 1)  Shr 1) And 8355711
         Poke UInteger, framebuffer + (y * scrw + x), (GetTextureColor(9, floorTexX,  floorTexY, 1)  Shr 1) And 8355711
        '//ceiling (symmetrical!)
        'buffer(x, screenHeight - y) = GetTextureColor(10, floorTexX,  floorTexY, 1)
        Poke UInteger, framebuffer + ((screenHeight - y) * scrw + x), GetTextureColor(10, floorTexX,  floorTexY, 1)
      Next
	Next

	'DrawBuffer
	'//clear the buffer instead of cls()
	'Erase buffer
	ScreenUnLock
	
   'timing for input and FPS counter
    oldTime = ctime
    ctime = Timer
    Dim As Double frameTime = ctime - oldTime '/ 1000.0 'frametime is the time this frame has taken, in seconds

    'speed modifiers
    Dim As Double moveSpeed = frameTime * 5.0 'the constant value is in squares/second
    Dim As Double rotSpeed = frameTime * 3.0 'the constant value is in radians/second

    'move forward if no wall in front of you
    if Multikey(SC_UP) Then
      If worldMap(int(posX + dirX * moveSpeed), int(posY)) = 0 Then posX += dirX * moveSpeed
      If worldMap(int(posX), int(posY + dirY * moveSpeed)) = 0 Then posY += dirY * moveSpeed
    End If

    if Multikey(SC_DOWN) Then
      If worldMap(int(posX - dirX * moveSpeed), int(posY)) = 0 Then posX -= dirX * moveSpeed
      If worldMap(int(posX), int(posY - dirY * moveSpeed)) = 0 Then posY -= dirY * moveSpeed
    End If
    
    'rotate to the right
    if Multikey(SC_RIGHT) Then
      'both camera direction and camera plane must be rotated
      Dim As Double oldDirX = dirX
      dirX = dirX * cos(-rotSpeed) - dirY * sin(-rotSpeed)
      dirY = oldDirX * sin(-rotSpeed) + dirY * cos(-rotSpeed)
      Dim As Double oldPlaneX = planeX
      planeX = planeX * cos(-rotSpeed) - planeY * sin(-rotSpeed)
      planeY = oldPlaneX * sin(-rotSpeed) + planeY * cos(-rotSpeed)
    End If

    if Multikey(SC_LEFT) Then
      'both camera direction and camera plane must be rotated
      Dim As Double oldDirX = dirX
      dirX = dirX * cos(rotSpeed) - dirY * sin(rotSpeed)
      dirY = oldDirX * sin(rotSpeed) + dirY * cos(rotSpeed)
      Dim As Double oldPlaneX = planeX
      planeX = planeX * cos(rotSpeed) - planeY * sin(rotSpeed)
      planeY = oldPlaneX * sin(rotSpeed) + planeY * cos(rotSpeed)
    EndIf

	If MultiKey(SC_ESCAPE) Then
		done = 1
	EndIf
	
	Sleep 1
Loop Until done


mapdata:
Data 4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,7,7,7,7,7,7,7,7
Data 4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,7,0,0,0,0,0,0,7
Data 4,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,7
Data 4,0,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,7
Data 4,0,3,0,0,0,0,0,0,0,0,0,0,0,0,0,7,0,0,0,0,0,0,7
Data 4,0,4,0,0,0,0,5,5,5,5,5,5,5,5,5,7,7,0,7,7,7,7,7
Data 4,0,5,0,0,0,0,5,0,5,0,5,0,5,0,5,7,0,0,0,7,7,7,1
Data 4,0,6,0,0,0,0,5,0,0,0,0,0,0,0,5,7,0,0,0,0,0,0,8
Data 4,0,7,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,7,7,7,1
Data 4,0,8,0,0,0,0,5,0,0,0,0,0,0,0,5,7,0,0,0,0,0,0,8
Data 4,0,0,0,0,0,0,5,0,0,0,0,0,0,0,5,7,0,0,0,7,7,7,1
Data 4,0,0,0,0,0,0,5,5,5,5,0,5,5,5,5,7,7,7,7,7,7,7,1
Data 6,6,6,6,6,6,6,6,6,6,6,0,6,6,6,6,6,6,6,6,6,6,6,6
Data 8,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4
Data 6,6,6,6,6,6,0,6,6,6,6,0,6,6,6,6,6,6,6,6,6,6,6,6
Data 4,4,4,4,4,4,0,4,4,4,6,0,6,2,2,2,2,2,2,2,3,3,3,3
Data 4,0,0,0,0,0,0,0,0,4,6,0,6,2,0,0,0,0,0,2,0,0,0,2
Data 4,0,0,0,0,0,0,0,0,0,0,0,6,2,0,0,5,0,0,2,0,0,0,2
Data 4,0,0,0,0,0,0,0,0,4,6,0,6,2,0,0,0,0,0,2,2,0,2,2
Data 4,0,6,0,6,0,0,0,0,4,6,0,0,0,0,0,5,0,0,0,0,0,0,2
Data 4,0,0,5,0,0,0,0,0,4,6,0,6,2,0,0,0,0,0,2,2,0,2,2
Data 4,0,6,0,6,0,0,0,0,4,6,0,6,2,0,0,5,0,0,2,0,0,0,2
Data 4,0,0,0,0,0,0,0,0,4,6,0,6,2,0,0,0,0,0,2,0,0,0,2
Data 4,4,4,4,4,4,4,4,4,4,1,1,1,2,2,2,2,2,2,3,3,3,3,3
