mod3d.bas

Attribute VB_Name = "Module1"
Option Explicit

Public Type vector
    x As Double
    y As Double
    z As Double
End Type

Public Type Angle
    pitch As Double
    yaw As Double
End Type


Public Type particle
    x As Single
    y As Single
    z As Single
    colour As Long
    connect() As Boolean
    label As String
End Type

Public Type entity
    pos As vector
    vertex() As particle
    visible As Boolean
    name As String
End Type

Public entity(100) As entity



Public selfAng As Angle
Public selfPos As vector
Public selfRoll As Double
Public FOV As Single

Public l As vector, u As vector, w As vector
Public n2 As vector, n As vector
Public nOk As Boolean

Public speed As Single
Public sens As Single

Public turnLeft As Integer
Public turnRight As Integer
Public turnUp As Integer
Public turnDown As Integer
Public turnRollLeft As Integer
Public turnRollRight As Integer

Public moveLeft As Integer
Public moveRight As Integer
Public moveUp As Integer
Public moveDown As Integer
Public moveForward As Integer
Public moveBackward As Integer
Public Function turnVect(vect1 As vector, vect2 As vector, theta As Double) As vector
    turnVect.x = vect1.x * Cos(theta * Pi / 180) + vect2.x * Sin(theta * Pi / 180)
    turnVect.y = vect1.y * Cos(theta * Pi / 180) + vect2.y * Sin(theta * Pi / 180)
    turnVect.z = vect1.z * Cos(theta * Pi / 180) + vect2.z * Sin(theta * Pi / 180)
End Function
Public Function Vect(x As Double, y As Double, z As Double) As vector
    Vect.x = x
    Vect.y = y
    Vect.z = z
End Function
Public Function PosNeg(thing As Double) As String
    If thing >= 0 Then
        PosNeg = "+"
    Else
        PosNeg = "-"
    End If
End Function
Public Function deVect(Vect As vector, Optional decPlace As Integer = 2) As String
    Dim x$, y$, z$
        x = CStr(Round(decPlace, Abs(Vect.x)))
        y = " " & CStr(Round(decPlace, Abs(Vect.y)))
        z = " " & CStr(Round(decPlace, Abs(Vect.z)))
    If x = "1" Then x = ""
    If y = " 1" Then y = " "
    If z = " 1" Then z = " "
    If Vect.x = 0 Then x = "" Else x = x & "i "
    If Vect.y = 0 Then y = "" Else y = PosNeg(Vect.y) & y & "j "
    If Vect.z = 0 Then z = "" Else z = PosNeg(Vect.z) & z & "k"
    If Vect.x < 0 Then x = "-" & x

    deVect = x & y & z
    
    deVect = Trim(deVect)
    If Left(deVect, 1) = "+" Then deVect = Mid(deVect, 2)
    If Left(deVect, 1) = "-" And Mid(deVect, 2, 1) = " " Then deVect = Left(deVect, 1) & Mid(deVect, 3)
    deVect = Trim(deVect)
    If deVect = "" Then deVect = "0"
End Function
Public Function Mag(Vect As vector) As Double
    Mag = (Vect.x ^ 2 + Vect.y ^ 2 + Vect.z ^ 2) ^ 0.5
End Function
Public Function PosVect(p As particle) As vector
    PosVect.x = p.x
    PosVect.y = p.y
    PosVect.z = p.z
End Function

Public Function Unit(Vect As vector) As vector
    Dim m As Double
    m = Mag(Vect)
    If m = 0 Then Exit Function
    Unit.x = Vect.x / m
    Unit.y = Vect.y / m
    Unit.z = Vect.z / m
End Function
Public Function DotProd(vect1 As vector, vect2 As vector) As Double
    DotProd = vect1.x * vect2.x + vect1.y * vect2.y + vect1.z * vect2.z
End Function
Public Function CrossProd(vect1 As vector, vect2 As vector) As vector
    CrossProd.x = vect2.z * vect1.y - vect2.y * vect1.z
    CrossProd.y = vect2.x * vect1.z - vect2.z * vect1.x
    CrossProd.z = vect2.y * vect1.x - vect2.x * vect1.y
End Function
Public Function arccos(y As Double) As Double
    y = Round(15, y)
    If y >= -1 And y <= 1 Then
        If y = 0 Then
            arccos = 90
        Else
            arccos = Atn((1 - y ^ 2) ^ 0.5 / y) / Pi * 180 - (y < 0) * 180
        End If
    Else
        arccos = 0
        MsgBox "Condition: -1 <= y <= 1 not correct where y=" & y & " !", vbCritical, "Error!"
    End If
End Function
Public Function Dirc(ang As Angle) As vector
    Select Case ang.yaw
        Case 0
            Dirc.x = 0
            Dirc.z = 1
        Case Is < 90
            Dirc.x = Tan(ang.yaw * Pi / 180)
            Dirc.z = 1
        Case 90
            Dirc.x = 1
            Dirc.z = 0
        Case Is < 180
            Dirc.x = -Tan(ang.yaw * Pi / 180)
            Dirc.z = -1
        Case 180
            Dirc.x = 0
            Dirc.z = -1
        Case Is < 270
            Dirc.x = -Tan((ang.yaw - 180) * Pi / 180)
            Dirc.z = -1
        Case 270
            Dirc.x = -1
            Dirc.z = 0
        Case Is < 360
            Dirc.x = Tan((ang.yaw - 180) * Pi / 180)
            Dirc.z = 1
    End Select
    Do
        If ang.pitch < -180 Then ang.pitch = ang.pitch + 360
        If ang.pitch > 180 Then ang.pitch = ang.pitch - 360
    Loop Until ang.pitch <= 180 And ang.pitch >= -180
    Select Case ang.pitch
        Case -90
            Dirc.x = 0
            Dirc.z = 0
            Dirc.y = -1
        Case 90
            Dirc.x = 0
            Dirc.z = 0
            Dirc.y = 1
        Case 0
            Dirc.y = 0
        Case 270
            
        Case Else
            Dirc.y = (Dirc.x ^ 2 + Dirc.z ^ 2) ^ 0.5 * Tan(ang.pitch * Pi / 180)
    End Select
    Dirc = Unit(Dirc)
End Function
Public Function Angle(v As vector) As Angle
    If v.x = 0 Then
        If v.z = 0 Then
            Angle.yaw = 0
            Angle.pitch = (2 * (v.y < 0) + 1) * 90
        ElseIf v.z > 0 Then
            Angle.yaw = 0
            Angle.pitch = Atn(v.y / v.z) * 180 / Pi
        Else
            Angle.yaw = 180
            Angle.pitch = Atn(v.y / (-v.z)) * 180 / Pi
        End If
    ElseIf v.x > 0 Then
        If v.z = 0 Then
            Angle.yaw = 90
            Angle.pitch = Atn(v.y / v.x) * 180 / Pi
        ElseIf v.z > 0 Then
            Angle.yaw = Atn(v.x / v.z) * 180 / Pi
            Angle.pitch = Atn(v.y / (v.z ^ 2 + v.x ^ 2) ^ 0.5) * 180 / Pi
        Else
            Angle.yaw = 180 + Atn(v.x / v.z) * 180 / Pi
            Angle.pitch = Atn(v.y / (v.z ^ 2 + v.x ^ 2) ^ 0.5) * 180 / Pi
        End If
    Else
        If v.z = 0 Then
            Angle.yaw = 270
            Angle.pitch = Atn(v.y / (-v.x)) * 180 / Pi
        ElseIf v.z > 0 Then
            Angle.yaw = 360 + Atn(v.x / v.z) * 180 / Pi
            Angle.pitch = Atn(v.y / (v.z ^ 2 + v.x ^ 2) ^ 0.5) * 180 / Pi
        Else
            Angle.yaw = 180 + Atn(v.x / v.z) * 180 / Pi
            Angle.pitch = Atn(v.y / (v.z ^ 2 + v.x ^ 2) ^ 0.5) * 180 / Pi
        End If
    End If
End Function
Public Function makeAng(yaw As Double, pitch As Double) As Angle
    makeAng.yaw = yaw
    makeAng.pitch = pitch
End Function
Public Function deAngle(ang As Angle) As String
    deAngle = "YAW: " & Round(2, ang.yaw) & " PIT:" & Round(2, ang.pitch)
End Function
Public Sub Test()
    Dim i%
    Dim a As vector
    Dim b As vector
    Dim ang As Angle
    Dim c As vector
    a.x = 1
    a.y = 1
    a.z = 1
End Sub