Attribute VB_Name = "Importer_WavefrontOBJ"

Option Explicit

Private Type VertexRef
    Pos As Long
    UV As Long
    Normal As Long
End Type

Private Type Triangle
    NewMaterialName As String 'When this is not empty, make a new part with a new material.
    Vert(2) As VertexRef
End Type

Private Type Material
    Name As String
    DiffuseFilename As String
    DiffuseColor As Vector3
End Type

'Positions
Dim PositionArray() As Vector3
Dim NumberOfPositions As Long

'Texture coordinates
Dim TexcoordArray() As Vector2
Dim NumberOfTexcoords As Long

'Normals
Dim NormalArray() As Vector3
Dim NumberOfNormals As Long

'Triangles
Dim TriangleArray() As Triangle
Dim NumberOfTriangles As Long

'Materials
Dim MaterialArray() As Material
Dim NumberOfMaterials As Long

Dim CurrentModel As Long
Dim CurrentPart As Long
Dim CurrentTriangle As Long
Dim NextMaterialName As String 'Store it here until the first triangle can place it in NewMaterialName
Dim CurrentColor As Vector3
Dim Words() As String
Dim NumberOfWords As Integer

Public Sub Importer_WavefrontOBJ_Init()
    ReDim Words(0 To 32)
    ReDim PositionArray(0 To 100)
    ReDim TexcoordArray(0 To 100)
    ReDim NormalArray(0 To 100)
    ReDim TriangleArray(0 To 100)
    ReDim MaterialArray(0 To 32)
End Sub

Private Sub AddPosition(NewValue As Vector3)
    If NumberOfPositions > UBound(PositionArray()) Then
        ReDim Preserve PositionArray(0 To UBound(PositionArray()) * 2)
    End If
    PositionArray(NumberOfPositions) = NewValue
    NumberOfPositions = NumberOfPositions + 1
End Sub

Private Sub AddTexcoord(NewValue As Vector2)
    If NumberOfTexcoords > UBound(TexcoordArray()) Then
        ReDim Preserve TexcoordArray(0 To UBound(TexcoordArray()) * 2)
    End If
    TexcoordArray(NumberOfTexcoords) = NewValue
    NumberOfTexcoords = NumberOfTexcoords + 1
End Sub

Private Sub AddNormal(NewValue As Vector3)
    If NumberOfNormals > UBound(NormalArray()) Then
        ReDim Preserve NormalArray(0 To UBound(NormalArray()) * 2)
    End If
    NormalArray(NumberOfNormals) = NewValue
    NumberOfNormals = NumberOfNormals + 1
End Sub

Private Sub AddTriangle(Tri As Triangle)
    If NumberOfTriangles > UBound(TriangleArray()) Then
        ReDim Preserve TriangleArray(0 To UBound(TriangleArray()) * 2)
    End If
    TriangleArray(NumberOfTriangles) = Tri
    NumberOfTriangles = NumberOfTriangles + 1
End Sub

Private Sub AddWord(T As String)
    If NumberOfWords > UBound(Words()) Then
        ReDim Preserve Words(0 To UBound(Words()) * 2)
    End If
    Words(NumberOfWords) = T
    NumberOfWords = NumberOfWords + 1
End Sub

Private Sub AddMaterial(Name As String)
    If NumberOfMaterials > UBound(MaterialArray()) Then
        ReDim Preserve MaterialArray(0 To UBound(Words()) * 2)
    End If
    MaterialArray(NumberOfMaterials).Name = Name
    MaterialArray(NumberOfMaterials).DiffuseFilename = ""
    NumberOfMaterials = NumberOfMaterials + 1
End Sub

'PreCondition: Filename must refer to a Wavefront OBJ file.
'PostCondition: Returns the model handle to a new model loaded from Filename.
Public Function Importer_WavefrontOBJ_LoadFromFile(Filename As String) As Long
    'Load the content of the file
    Static Content As String
    Content = ReadText(Filename)
    If Content = "" Then Exit Function
    
    'Create an empty model
    CurrentModel = frmMain.DGE.Model_CreateEmpty: RE
    
    'Reset the data
    NextMaterialName = ""
    CurrentPart = -1
    CurrentTriangle = -1
    NumberOfPositions = 0
    NumberOfTexcoords = 0
    NumberOfNormals = 0
    NumberOfTriangles = 0
    NumberOfMaterials = 0
    
    'Parse each line
    Static I As Long
    Static NewChar As String
    Static NewLine As String
    NewLine = ""
    For I = 1 To Len(Content)
        NewChar = TakeChar(Content, I)
        If NewChar = Chr(10) Then
            If NewLine <> "" Then
                CompileLine RemoveOutterSpaces(NewLine)
            End If
            NewLine = ""
        ElseIf NewChar <> Chr(13) Then
            NewLine = NewLine & NewChar
        End If
    Next I
    If NewLine <> "" Then
        CompileLine RemoveOutterSpaces(NewLine)
    End If
    NewLine = ""
    
    'Build the model
    BuildModel
    
    'Return it
    Importer_WavefrontOBJ_LoadFromFile = CurrentModel
End Function

Private Sub LoadMaterialLibrary(Filename As String)
    'Parse each line
    Static I As Long
    Static NewChar As String
    Static NewLine As String
    Static Content As String
    Content = ReadText(Filename)
    NewLine = ""
    For I = 1 To Len(Content)
        NewChar = TakeChar(Content, I)
        If NewChar = Chr(10) Then
            If NewLine <> "" Then
                CompileLine_mtllib RemoveOutterSpaces(NewLine)
            End If
            NewLine = ""
        ElseIf NewChar <> Chr(13) Then
            NewLine = NewLine & NewChar
        End If
    Next I
    If NewLine <> "" Then
        CompileLine RemoveOutterSpaces(NewLine)
    End If
    NewLine = ""
End Sub

Private Sub Tokenize(T As String)
    Static I As Long
    Static NewChar As String
    Static NewWord As String
    NumberOfWords = 0
    NewWord = ""
    For I = 1 To Len(T)
        NewChar = TakeChar(T, I)
        If NewChar = " " Then
            If NewWord <> "" Then
                AddWord NewWord
            End If
            NewWord = ""
        Else
            NewWord = NewWord & NewChar
        End If
    Next I
    If NewWord <> "" Then AddWord NewWord
    
    'Use this call if you need to see the result from the tokenizer
    'DebugWordList
End Sub

Private Sub CompileLine_mtllib(T As String)
    If Left(T, 1) <> "#" And Len(T) > 0 Then
        Tokenize T
        Select Case Words(0)
        Case "newmtl"
            'Create a new material
            If NumberOfWords <> 2 Then MsgBox "Wrong number of arguments to the keyword newmtl.", vbCritical, "Error in Wavefront MTL file!"
            AddMaterial Words(1)
        Case "map_Kd"
            'Set the diffuse texture for the last material
            If NumberOfWords <> 2 Then MsgBox "Wrong number of arguments to the keyword map_Kd.", vbCritical, "Error in Wavefront MTL file!"
            MaterialArray(NumberOfMaterials - 1).DiffuseFilename = Words(1)
        Case "Kd"
            'Set the diffuse color for the last material
            If NumberOfWords <> 4 Then MsgBox "Wrong number of arguments to the keyword v.", vbCritical, "Error in Wavefront OBJ file!"
            MaterialArray(NumberOfMaterials - 1).DiffuseColor = MakeVector3(Val(Words(1)), Val(Words(2)), Val(Words(3)))
        End Select
    End If
End Sub

Private Function IndexFromMaterial(Material As String) As Long
    Static I As Long
    For I = 0 To NumberOfMaterials - 1
        If MaterialArray(I).Name = Material Then
            IndexFromMaterial = I
            Exit Function
        End If
    Next I
    IndexFromMaterial = -1
End Function

Private Sub CompileLine(T As String)
    If Left(T, 1) <> "#" And Len(T) > 0 Then
        Tokenize T
        Select Case Words(0)
        Case "mtllib"
            'Load all diffuse texture names in the library
            If NumberOfWords <> 2 Then MsgBox "Wrong number of arguments to the keyword mtllib.", vbCritical, "Error in Wavefront OBJ file!"
            LoadMaterialLibrary Words(1) 'The wordlist no longer belong to this routine after this call
        Case "usemtl"
            'Store a change of material in the list of triangles
            If NumberOfWords <> 2 Then MsgBox "Wrong number of arguments to the keyword usemtl.", vbCritical, "Error in Wavefront OBJ file!"
            NextMaterialName = Words(1)
        Case "v"
            'Pos X Y Z
            If NumberOfWords <> 4 Then MsgBox "Wrong number of arguments to the keyword v.", vbCritical, "Error in Wavefront OBJ file!"
            AddPosition MakeVector3(Val(Words(1)), Val(Words(2)), Val(Words(3)))
        Case "vt"
            'Texcoord U V
            'Allow having any number of useless texture coordinates after U and V that are just ignored
            If NumberOfWords < 3 Then MsgBox "Too few arguments to the keyword vt.", vbCritical, "Error in Wavefront OBJ file!"
            AddTexcoord MakeVector2(Val(Words(1)), Val(Words(2)))
        Case "vn"
            'Normal X Y Z
            If NumberOfWords <> 4 Then MsgBox "Wrong number of arguments to the keyword vn.", vbCritical, "Error in Wavefront OBJ file!"
            AddNormal MakeVector3(Val(Words(1)), Val(Words(2)), Val(Words(3)))
        Case "f"
            'Face refering to an arbitrary number of vertices counting from 1.
            If NumberOfWords < 4 Then MsgBox "A polygon must have at least 3 vertices.", vbCritical, "Error in Wavefront OBJ file!"
            Static EndPoint As Long
            Static Tri As Triangle
            For EndPoint = 3 To (NumberOfWords - 1)
                'Triangulate the polygon from the first vertice
                Tri.NewMaterialName = NextMaterialName
                Tri.Vert(0) = GetVertexRefFromToken(Words(1))
                Tri.Vert(1) = GetVertexRefFromToken(Words(EndPoint - 1))
                Tri.Vert(2) = GetVertexRefFromToken(Words(EndPoint))
                AddTriangle Tri
                
                'Consume the material name after using it
                If NextMaterialName <> "" Then NextMaterialName = ""
            Next EndPoint
        End Select
    End If
End Sub

Private Function GetVertexRefFromToken(T As String) As VertexRef
    Static I As Long
    Static NewChar As String
    Static CurrentInteger As String
    Static FoundSlashes As Integer
    GetVertexRefFromToken.Pos = -1
    GetVertexRefFromToken.UV = -1
    GetVertexRefFromToken.Normal = -1
    CurrentInteger = ""
    FoundSlashes = 0
    For I = 1 To Len(T)
        NewChar = Mid(T, I, 1)
        If NewChar = "/" Then
            Select Case FoundSlashes
            Case 0
                GetVertexRefFromToken.Pos = Val(CurrentInteger)
            Case 1
                GetVertexRefFromToken.UV = Val(CurrentInteger)
            Case 2
                GetVertexRefFromToken.Normal = Val(CurrentInteger)
            End Select
            FoundSlashes = FoundSlashes + 1
            CurrentInteger = ""
        Else
            CurrentInteger = CurrentInteger & NewChar
        End If
    Next I
    Select Case FoundSlashes
    Case 0
        GetVertexRefFromToken.Pos = Val(CurrentInteger)
    Case 1
        GetVertexRefFromToken.UV = Val(CurrentInteger)
    Case 2
        GetVertexRefFromToken.Normal = Val(CurrentInteger)
    End Select
End Function

Private Sub DebugWordList()
    Static I As Long
    Static WordList As String
    WordList = ""
    For I = 0 To NumberOfWords - 1
        WordList = WordList & "  <" & Words(I) & ">"
    Next I
    Debug.Print WordList
End Sub

Private Sub NewPart(Name As String)
    InsertStringToEngine Name
    CurrentPart = frmMain.DGE.Model_Part_Create_InSB(CurrentModel, 32): RE
    CurrentTriangle = -1
End Sub

Private Sub BuildModel()
    Static I As Long
    Static J As Long
    Static MatIndex As Long
    Static MatName As String
    Static DifName As String
    On Error Resume Next 'Skip writing to the model if an index is corruċt in the file. Usually from non existing texture coordinates.
    For I = 0 To NumberOfTriangles - 1
        MatName = TriangleArray(I).NewMaterialName
        If MatName <> "" Then
            'Create a new part with the material's name
            NewPart MatName
            
            'Look up the diffuse texture name using the material name
            MatIndex = IndexFromMaterial(MatName)
            If MatIndex > -1 Then
                If MatName = "(NULL)" Then
                    'Give a white color
                    CurrentColor = MakeVector3(1, 1, 1)
                    InsertStringToEngine "M_Multiply_0Tex"
                    frmMain.DGE.Model_Part_SetShader_ByName_InSB CurrentModel, CurrentPart, 0: RE
                Else
                    'Get the diffuse color
                    CurrentColor = MaterialArray(MatIndex).DiffuseColor
                    
                    'Get the diffuse texture's filename
                    DifName = MaterialArray(MatIndex).DiffuseFilename
                    
                    If DifName <> "" Then
                        'Give the diffuse texture to texture channel 0
                        InsertStringToEngine DifName
                        frmMain.DGE.Model_Part_SetTexture_ByName_InSB CurrentModel, CurrentPart, 0: RE
                        
                        'Select the texture shader
                        InsertStringToEngine "M_Multiply_1Tex"
                        frmMain.DGE.Model_Part_SetShader_ByName_InSB CurrentModel, CurrentPart, 0: RE
                    Else
                        'Select the color shader
                        InsertStringToEngine "M_Multiply_0Tex"
                        frmMain.DGE.Model_Part_SetShader_ByName_InSB CurrentModel, CurrentPart, 0: RE
                    End If
                End If
                
                'Use a default shadowcasting shader
                InsertStringToEngine "M_Shadow_Solid"
                frmMain.DGE.Model_Part_SetShader_ByName_InSB CurrentModel, CurrentPart, 1: RE
            End If
        End If
        If CurrentPart = -1 Then
            NewPart "NoMaterial"
        End If
        CurrentTriangle = frmMain.DGE.Model_Part_InsertTriangle(CurrentModel, CurrentPart)
        For J = 0 To 2
            frmMain.DGE.Model_Part_Vertice_SetColor CurrentModel, CurrentPart, CurrentTriangle, J, CurrentColor.X, CurrentColor.Y, CurrentColor.Z, 1
            If TriangleArray(I).Vert(J).Pos > -1 And TriangleArray(I).Vert(J).Pos <= NumberOfPositions Then
                frmMain.DGE.Model_Part_Vertice_SetPos CurrentModel, CurrentPart, CurrentTriangle, J, PositionArray(TriangleArray(I).Vert(J).Pos - 1).X, PositionArray(TriangleArray(I).Vert(J).Pos - 1).Y, PositionArray(TriangleArray(I).Vert(J).Pos - 1).Z
            End If
            If TriangleArray(I).Vert(J).UV > -1 And TriangleArray(I).Vert(J).UV <= NumberOfTexcoords Then
                frmMain.DGE.Model_Part_Vertice_SetTexCoord CurrentModel, CurrentPart, CurrentTriangle, J, TexcoordArray(TriangleArray(I).Vert(J).UV - 1).X, TexcoordArray(TriangleArray(I).Vert(J).UV - 1).Y, 0, 0
            End If
            If TriangleArray(I).Vert(J).Normal > -1 And TriangleArray(I).Vert(J).Normal <= NumberOfNormals Then
                frmMain.DGE.Model_Part_Vertice_SetNormal CurrentModel, CurrentPart, CurrentTriangle, J, NormalArray(TriangleArray(I).Vert(J).Normal - 1).X, NormalArray(TriangleArray(I).Vert(J).Normal - 1).Y, NormalArray(TriangleArray(I).Vert(J).Normal - 1).Z
            End If
        Next J
    Next I
End Sub
