Ir ao conteúdo
  • Cadastre-se

Outro VB6 - como calcular o RayCasting?


Posts recomendados

como fazer o RayCasting em VB6?

eu tenho esta função para desenhar 1 linha do RayCasting:
 

Private Sub DrawRays2()
    Dim AY As Double
    Dim AX As Double
    Dim StepX As Double
    Dim StepY As Double
    Dim VertX As Double
    Dim VertY As Double
    
    Dim HorizX As Double
    Dim HorizY As Double
    Dim MapX As Long
    Dim MapY As Long
    Dim HorizDist As Double
    Dim VertDist As Double
    Dim WallDistance As Double
    Dim RayHeight As Double
    
    On Error Resume Next
    
    ' Check for horizontal intersections:
    If (Player.Radians >= 0 And Player.Radians <= PI) Then ' Facing down
        AY = (Int(Player.PosY / ObjectSize) * ObjectSize) + ObjectSize ' Calculate grid position
        StepY = ObjectSize
    Else 'Facing Up
        AY = (Int(Player.PosY / ObjectSize) * ObjectSize) - 1
        StepY = -ObjectSize
    End If
    AX = Player.PosX + (AY - Player.PosY) / Tan(Player.Radians)
    HorizX = AX
    HorizY = AY
    StepX = StepY / Tan(Player.Radians)
    MapX = Fix((HorizX) / ObjectSize)
    MapY = Fix((HorizY) / ObjectSize)
    
    A.SetPixel (Fix(HorizX)), (Fix(HorizY)), ColorConstants.vbCyan
    If ((MapY < 9 Or MapY >= 0) Or (MapX < 9 Or MapX >= 0)) Then
        If LevelMap0(MapY, MapX) <> vbBlue Then
            Do
                HorizX = HorizX + StepX
                HorizY = HorizY + StepY
                A.SetPixel (Fix(HorizX)), (Fix(HorizY)), ColorConstants.vbCyan
                MapX = Fix((HorizX) / ObjectSize)
                MapY = Fix((HorizY) / ObjectSize)
                If ((MapY > 9 Or MapY < 0) Or (MapX > 9 Or MapX < 0)) Then Exit Do
                If LevelMap0(MapY, MapX) = vbBlue Then
                    A.SetPixel (Fix(HorizX)), (Fix(HorizY)), ColorConstants.vbCyan
                    Exit Do
                End If
                DoEvents
            Loop
        End If
    End If
    HorizDist = Sqr(((HorizX - Player.PosX) * (HorizX - Player.PosX)) + ((HorizY - Player.PosY) * (HorizY - Player.PosY)))
    
    
    ' Check for vertical intersections:
    If (Player.Radians >= (PI / 2) And Player.Radians <= (3 * PI / 2)) Then ' Facing right
        AX = (Int(Player.PosX / ObjectSize) * ObjectSize) - 1 ' Calculate grid position
        StepX = -ObjectSize
    Else 'Facing left
        AX = (Int(Player.PosX / ObjectSize) * ObjectSize) + ObjectSize
        StepX = ObjectSize
    End If
    AY = Player.PosY + (Player.PosX - AX) * -Tan(Player.Radians)
    VertX = AX
    VertY = AY
    StepY = StepX * Tan(Player.Radians)
    MapX = Fix((VertX) / ObjectSize)
    MapY = Fix((VertY) / ObjectSize)
    A.SetPixel (Fix(VertX)), (Fix(VertY)), vbYellow
    
    If LevelMap0(MapY, MapX) <> vbBlue Then
        Do
            VertX = VertX + StepX
            VertY = VertY + StepY
            If (VertX < 0 Or VertX > (9 * ObjectSize) Or VertY < 0 Or VertY > (9 * ObjectSize)) Then Exit Sub
            A.SetPixel (Fix(VertX)), (Fix(VertY)), vbYellow
            MapX = Fix((VertX) / ObjectSize)
            MapY = Fix((VertY) / ObjectSize)
            If ((MapY > 9 And MapY < 0) Or (MapX > 9 And MapX < 0)) Then Exit Do
            If LevelMap0(MapY, MapX) = vbBlue Then
                A.SetPixel (Fix(VertX)), (Fix(VertY)), vbYellow
                Exit Do
            End If
            DoEvents
        Loop
    End If
    
    VertDist = Sqr((VertX - Player.PosX) * (VertX - Player.PosX)) + ((VertY - Player.PosY) * (VertY - Player.PosY))
    A.ForeColor vbRed
    WallDistance = Max(VertDist, HorizDist) * Cos(Player.Radians)
    If (WallDistance = VertDist) Then
        A.DrawLine Fix(Player.PosX), Fix(Player.PosY), Fix(VertX), Fix(VertY)
    Else
        A.DrawLine Fix(Player.PosX), Fix(Player.PosY), Fix(HorizX), Fix(HorizY)
    End If
    RayHeight = ObjectSize / WallDistance * 320
    A.ForeColor vbBlue
    A.DrawLine 475 + 50, 200 / 2 - RayHeight / 2, 475 + 50, 200 / 2 + RayHeight / 2
    
End Sub

mas noto alguns erros:
1 - a linha desenhada pode ultrapassar o tamanho da tabela\array(9*ObjectSize);
2 - dependendo de alguns angulos,a linha não é desenhada...
eu tenho os if's para tentar evitar esses erros, mas parecem ignorados 😞
onde estou a errar?

Link para o comentário
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisa ser um usuário para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...

Ebook grátis: Aprenda a ler resistores e capacitores!

EBOOK GRÁTIS!

CLIQUE AQUI E BAIXE AGORA MESMO!