i did these code for create RayCasting:
Option Explicit
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Private Const PI As Double = 3.14159265358979
Dim LevelMap(12) As Variant
Dim CamWidth As Long
Dim CamHeight As Long
Dim CamHalfHeight As Long
Dim RayCastingPrecision As Long
Dim PlayerX As Double
Dim PlayerY As Double
Dim PlayerAngle As Long
Dim PlayerFOV As Long
Dim PlayerMovement As Double
Dim PlayerRotation As Double
Dim blnGameLoop As Boolean
Dim colors(3) As ColorConstants
Public Function Floor(ByVal x As Double) As Long
Floor = (-Int(x) * (-1))
End Function
Private Function DegreeToRadians(degree As Long) As Double
DegreeToRadians = degree * PI / 180
End Function
Private Sub DrawLine(X0 As Long, Y0 As Long, X1 As Long, Y1 As Long, Color As ColorConstants)
Me.Line (X0, Y0)-(X1, Y1), Color
End Sub
Private Sub rayCasting()
' O RayAngle é o angulo atual do "raio".
' se ele começa olhando para angulo 90º e tem fov 60, então o rayAngle vai de 60 até 120, sendo incrementado por fov/width
Dim rayAngle As Long
rayAngle = PlayerAngle - PlayerFOV / 2
' Para Cada coluna da tela
Dim raycount As Long
For raycount = 0 To CamWidth
' Player dados
Dim RayX As Double
Dim RayY As Double
RayX = PlayerX
RayY = PlayerY
' Com cosseno e seno do angulo conseguimos a direção do raio sobre o grid a partir do ponto de visão.
' Aqui teremos a direção do raio sobre a matriz e também o modulo (passo)
Dim rayCos As Double
Dim raySin As Double
rayCos = Cos(DegreeToRadians(rayAngle)) / RayCastingPrecision
raySin = Sin(DegreeToRadians(rayAngle)) / RayCastingPrecision
' Colisão do raio com as paredes
Dim Wall As Long
Wall = 0
While (Wall = 0) ' Aqui o "raio" seria tipo uma progetil que sai do personagem até colidir com uma parede
RayX = RayX + rayCos ' novo x do raio
RayY = RayY + raySin ' novo y do raio
Wall = LevelMap(Floor(RayY))(Floor(RayX)) ' verifica colisão com a parede (não nulo na matriz)
Wend
' Distancia até a parede (teorema de pitagoras), uma vez que temos o (X,Y) do personagem e da parede
Dim distance As Double
distance = Sqr((PlayerX - RayX) ^ 2 + (PlayerY - RayY) ^ 2)
' Correção olho de peixe (sem colisão com a parede), melhora a vista em corredores ou proximo de paredes
distance = distance * Cos(DegreeToRadians(rayAngle - PlayerAngle))
'Altura da parede em consequência a distancia
'quando mais longe a parede está menor ela é e vice versa, são inversamente proporcionais
Dim WallHeight As Long
WallHeight = Floor(CamHalfHeight / distance)
If (WallHeight > CamHalfHeight) Then WallHeight = CamHalfHeight
'Desenhando as paredes usando os tamanhos calculados acima
DrawLine raycount, 0, raycount, CamHalfHeight - WallHeight, ColorConstants.vbCyan 'céu
If (Wall > 0) Then
DrawLine raycount, CamHalfHeight - WallHeight, raycount, CamHalfHeight + WallHeight, colors(Wall) ' Parede
End If
DrawLine raycount, CamHalfHeight + WallHeight, raycount, CamHeight, vbMagenta ' chão
Wall = 0
' Incremento da ray
rayAngle = rayAngle + PlayerFOV / CamWidth
Next raycount
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim playerCos As Double
Dim playerSin As Double
Dim newX As Double
Dim newY As Double
If (KeyCode = vbKeyEscape) Then
blnGameLoop = False
End
ElseIf (KeyCode = vbKeyUp) Then
playerCos = Cos(DegreeToRadians(PlayerAngle)) * PlayerMovement
playerSin = Sin(DegreeToRadians(PlayerAngle)) * PlayerMovement
newX = PlayerX + playerCos
newY = PlayerY + playerSin
' Verficia colisão do player
If (LevelMap(Floor(newY))(Floor(newX)) = 0) Then
PlayerX = newX
PlayerY = newY
End If
ElseIf (KeyCode = vbKeyDown) Then
playerCos = Cos(DegreeToRadians(PlayerAngle)) * PlayerMovement
playerSin = Sin(DegreeToRadians(PlayerAngle)) * PlayerMovement
newX = PlayerX - playerCos
newY = PlayerY - playerSin
' Verficia colisão do player
If (LevelMap(Floor(newY))(Floor(newX)) = 0) Then
PlayerX = newX
PlayerY = newY
End If
ElseIf (KeyCode = vbKeyLeft) Then
PlayerAngle = PlayerAngle - PlayerRotation
ElseIf (KeyCode = vbKeyRight) Then
PlayerAngle = PlayerAngle + PlayerRotation
End If
End Sub
Private Sub Form_Load()
CamWidth = 1028
CamHeight = 720
CamHalfHeight = CInt(CamHeight / 2)
RayCastingPrecision = 100
PlayerX = 2
PlayerY = 3
PlayerAngle = 0
PlayerFOV = 60
PlayerMovement = 0.1
PlayerRotation = 0.8
Me.Show
LevelMap(0) = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
LevelMap(1) = Array(1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1)
LevelMap(2) = Array(1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1)
LevelMap(3) = Array(1, 0, 0, 0, 0, 0, 3, 3, 3, 0, 0, 0, 0, 0, 1)
LevelMap(4) = Array(1, 0, 0, 0, 0, 0, 3, 3, 3, 0, 0, 0, 0, 0, 1)
LevelMap(5) = Array(1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1)
LevelMap(6) = Array(1, 0, 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 0, 0, 1)
LevelMap(7) = Array(1, 0, 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 0, 0, 1)
LevelMap(8) = Array(1, 0, 0, 0, 0, 0, 2, 2, 2, 0, 0, 0, 0, 0, 1)
LevelMap(9) = Array(1, 0, 0, 0, 0, 0, 2, 2, 2, 0, 0, 0, 0, 0, 1)
LevelMap(10) = Array(1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1)
LevelMap(11) = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
blnGameLoop = True
colors(0) = vbBlue
colors(1) = vbGreen
colors(2) = vbRed
While (blnGameLoop = True)
Me.Cls
rayCasting
blnGameLoop = True
DoEvents
Wend
End Sub
Private Sub Form_Unload(Cancel As Integer)
blnGameLoop = False
End Submy problem is on these code:
'Desenhando as paredes usando os tamanhos calculados acima
DrawLine raycount, 0, raycount, CamHalfHeight - WallHeight, ColorConstants.vbCyan 'Sky
If (Wall > 0) Then
DrawLine raycount, CamHalfHeight - WallHeight, raycount, CamHalfHeight + WallHeight, colors(Wall) ' Wall
End If
DrawLine raycount, CamHalfHeight + WallHeight, raycount, CamHeight, vbMagenta ' floor
Wall = 0all vertical wall lines drawed have the same color even some are different color... i don't understand why :(
