Imports System.IO

Public Class convEventToObj
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click

        If Form1.CDFileList.SelectedIndex < 181 Or Form1.CDFileList.SelectedIndex > 577 Then MsgBox("PLEASE, SELECT PROPER SCENE FILE (181-577)!") : Exit Sub

        Dim rle = New rleTools
        Dim texWidth As Integer

        Dim fileName = "D:\Games\PSX\Persona.2.Innocent.Sin\Export3D\Scene" & Form1.CDFileList.SelectedIndex.ToString("D4")
        Dim matName = "Scene" & Form1.CDFileList.SelectedIndex.ToString("D4")
        'MAKING TEXTURE
        GenerateBigTexture(rle.Unrle(Form1.binFile(0).Bytes).ToArray, fileName, texWidth)
        createMaterial(matName, fileName)

        'MAKING 3D
        Dim fil = rle.Unrle(Form1.binFile(1).Bytes).ToArray


        Dim objectsnum = BitConverter.ToInt16(fil, 16)
        Dim HZ = BitConverter.ToInt16(fil, 18)
        Dim CoordsAddr = BitConverter.ToInt32(fil, 20)
        Dim AdditionsAddr = BitConverter.ToInt32(fil, 24)
        Dim objects = New List(Of Obj3d)


        'init objects
        Dim ObjectsPointers = New List(Of Integer)
        For a = 0 To objectsnum - 1
            ObjectsPointers.Add(BitConverter.ToInt32(fil, 28 + a * 4))
        Next

        'get all coords
        Dim coordsList = New List(Of Coord)
        For a = CoordsAddr To AdditionsAddr Step 8
            coordsList.Add(New Coord With {.X = BitConverter.ToInt16(fil, a), .Y = BitConverter.ToInt16(fil, a + 2) * -1, .Z = BitConverter.ToInt16(fil, a + 4) * -1})
        Next


        'resolve objects
        For a = 0 To objectsnum - 1
            Dim obj = New Obj3d
            Dim readAddr = ObjectsPointers(a)
            obj.commandNum = BitConverter.ToInt16(fil, readAddr)
            obj.id = BitConverter.ToInt32(fil, readAddr + 4)
            readAddr += 8                             ' Moving to ChunkData

            For x = 0 To obj.commandNum - 1             'Creating chunks
                obj.chunksAddr.Add(readAddr)
                Dim chunkLength = fil(readAddr + 1) * 4
                Dim draftChunk(chunkLength - 1) As Byte
                readAddr += 4
                Array.Copy(fil, readAddr, draftChunk, 0, chunkLength)
                obj.chunks.Add(draftChunk)
                readAddr += chunkLength

                'Getting Coords
                Dim poly As New Poly
                poly.command = draftChunk(7)
                poly.vertNum = 0
                poly.Shading = Color.FromArgb(draftChunk(4), draftChunk(5), draftChunk(6))

                Select Case poly.command
                    Case &H20, &H22, &H24, &H25, &H26, &H27, &H30, &H32, &H34, &H36
                        poly.vertNum = 3
                    Case &H28, &H2A, &H2C, &H2D, &H2E, &H2F, &H38, &H3A, &H3C, &H3E
                        poly.vertNum = 4

                    Case Else
                        Debug.WriteLine("UNKNOWN COMMAND! " & poly.command & ". Object " & a & ". ChunkAddr " & obj.chunksAddr.Last & ". ")
                End Select

                'calc Texture Position
                Select Case poly.command
                    Case &H2C, &H2D, &H2E, &H3C, &H3E
                        Dim TexPage = (draftChunk(22) And 127) - 26

                        Dim Cind1 = 12 : Dim Cind2 = 20 : Dim Cind3 = 28 : Dim Cind4 = 36

                        If poly.command = &H3C Or poly.command = &H3E Then
                            Cind2 = 24 : Cind3 = 36 : Cind4 = 48 : TexPage = (draftChunk(26) And 127) - 26
                        End If

                        poly.textureVertexs.add(New TexCoord With {.X = (draftChunk(Cind1) - 1 + TexPage * 128) / texWidth, .Y = 1 - draftChunk(Cind1 + 1) / 256})
                        poly.textureVertexs.add(New TexCoord With {.X = (draftChunk(Cind2) - 1 + TexPage * 128) / texWidth, .Y = 1 - draftChunk(Cind2 + 1) / 256})

                        poly.textureVertexs.add(New TexCoord With {.X = (draftChunk(Cind3) - 1 + TexPage * 128) / texWidth, .Y = 1 - draftChunk(Cind3 + 1) / 256})
                        poly.textureVertexs.add(New TexCoord With {.X = (draftChunk(Cind4) - 1 + TexPage * 128) / texWidth, .Y = 1 - draftChunk(Cind4 + 1) / 256})


                End Select


                ' Dim bbb As Boolean = BitConverter.ToInt16(draftChunk, UBound(draftChunk) - 1) > coordsList.Count - 1

                Dim coord1 As Coord = coordsList(BitConverter.ToInt16(draftChunk, UBound(draftChunk) - 7))
                Dim coord2 As Coord = coordsList(BitConverter.ToInt16(draftChunk, UBound(draftChunk) - 5))
                Dim coord3 As Coord = coordsList(BitConverter.ToInt16(draftChunk, UBound(draftChunk) - 3))
                Dim coord4 = New Coord
                If poly.vertNum = 4 Then
                    coord4 = coordsList(BitConverter.ToInt16(draftChunk, UBound(draftChunk) - 1))
                    poly.coords.AddRange({coord1, coord2, coord3, coord4})
                ElseIf poly.vertNum = 3 Then
                    poly.coords.AddRange({coord1, coord2, coord3})
                End If



                obj.Polys.Add(poly)

            Next



            objects.Add(obj)
        Next

        Dim objfile As String

        objfile = "#PERSONA 2 IS SCENE EXPORT /// SERGEY SHEMET" & vbCrLf & "mtllib " & matName & ".mtl" & vbCrLf & vbCrLf
        My.Computer.FileSystem.WriteAllText(fileName & ".obj", objfile, False)
        Dim vertexcount = 1
        Dim texturvertexCount = 1

        For zzz = 0 To objects.Count - 1

            Debug.WriteLine("Current object " & zzz + 1 & "\" & objects.Count)

            Dim verts = ""
            Dim surfs = ""
            objfile = vbCrLf & vbCrLf & "o Huynya_" & zzz & vbCrLf & vbCrLf

            Dim vrtsStrList = New List(Of String)
            Dim surfsStrList = New List(Of String)
            Dim verTexturList = New List(Of String)

            'verTexturList.AddRange({"vt 0.00 0.00", "vt 1.00 0.00", "vt 1.00 1.00", "vt 0.00 1.00"})

            Dim curobj As Obj3d = objects(zzz)

            For a = 0 To curobj.Polys.Count - 1

                For Each pol In curobj.Polys

                    For Each crd In pol.coords


                        Dim X As Decimal = crd.X / 100
                        Dim Y As Decimal = crd.Y / 100
                        Dim Z As Decimal = crd.Z / 100

                        vrtsStrList.Add("v " & X.ToString("F5", Globalization.CultureInfo.InvariantCulture) & " " &
                                           Y.ToString("F5", Globalization.CultureInfo.InvariantCulture) & " " &
                                           Z.ToString("F5", Globalization.CultureInfo.InvariantCulture))
                    Next

                    For Each texCoord In pol.textureVertexs
                        Dim X As Decimal = texCoord.X
                        'Dim X As Decimal = 1 - texCoord.X
                        Dim Y As Decimal = texCoord.Y
                        verTexturList.Add("vt " & X.ToString("F5", Globalization.CultureInfo.InvariantCulture) &
                                          " " & Y.ToString("F5", Globalization.CultureInfo.InvariantCulture))


                    Next


                    If pol.coords.Count = 4 Then
                        If pol.texturevertexs.Count = 4 Then
                            surfsStrList.Add("f " & vertexcount & "/" & texturvertexCount & " " &
                                             vertexcount + 1 & "/" & texturvertexCount + 1 & " " &
                                             vertexcount + 3 & "/" & texturvertexCount + 3 & " " &
                                             vertexcount + 2 & "/" & texturvertexCount + 2)
                        Else
                            surfsStrList.Add("f " & vertexcount & " " & vertexcount + 1 & " " & vertexcount + 3 & " " & vertexcount + 2)
                        End If

                    End If
                    If pol.coords.Count = 3 Then
                        surfsStrList.Add("f " & vertexcount & " " & vertexcount + 2 & " " & vertexcount +1)
                    End If

                        vertexcount += pol.coords.Count
                    texturvertexCount += pol.texturevertexs.Count

                Next

                Next

            Dim file As System.IO.StreamWriter
            file = My.Computer.FileSystem.OpenTextFileWriter(fileName & ".obj", True)


            file.WriteLine(objfile, True)

            'objfile &= verts & vbCrLf
            For Each vvv In vrtsStrList
                file.WriteLine(vvv, True)
            Next

            For Each vt In verTexturList
                file.WriteLine(vt, True)
            Next

            objfile = vbCrLf & "usemtl " & matName & vbCrLf & "s off" & vbCrLf & vbCrLf
            file.WriteLine(objfile, True)

            For Each sss In surfsStrList
                file.WriteLine(sss, True)
            Next

            file.Close()

            'If zzz = 3 Then Exit For
        Next


        MsgBox("DINE")
    End Sub


    Public Sub GenerateBigTexture(ByRef fil As Byte(), ByVal filnam As String, ByRef texwidth As Integer)

        Dim textureCount = BitConverter.ToInt32(fil, 0)
        Dim cluts = New List(Of List(Of Byte))
        Dim Pics = New List(Of List(Of Byte))

        Dim clutsOffs = New List(Of Integer)
        Dim picsOffs = New List(Of Integer)

        Dim TxOffsets = New List(Of Integer)

        For a = 0 To textureCount - 1 Step 2
            clutsOffs.Add(BitConverter.ToInt32(fil, a * 4 + 4))
            picsOffs.Add(BitConverter.ToInt32(fil, a * 4 + 8))
        Next

        For Each clut In clutsOffs
            Dim cur = clutsOffs.IndexOf(clut)

            Dim cltData(539) As Byte
            Dim picData(16391) As Byte
            Array.Copy(fil, clut, cltData, 0, 540)
            Array.Copy(fil, picsOffs(cur), picData, 0, 16392)
            Dim cl = New List(Of Byte) : cl.AddRange(cltData.ToList) : cluts.Add(cl)
            Dim pc = New List(Of Byte) : pc.AddRange(picData.ToList) : Pics.Add(pc)

        Next

        Dim png = New pngImage


        My.Computer.FileSystem.WriteAllBytes(filnam & ".png", png.makeBigTexturePng(cluts, Pics).ToArray, False)

        texwidth = picsOffs.Count * 64

    End Sub


    Public Sub createMaterial(ByVal matName As String, ByVal filnam As String)


        Dim mtl = "#Sergey Shemet Persona2 Material" & vbCrLf & vbCrLf

        mtl &= "newmtl " & matName & vbCrLf
        mtl &= "Ns 250.000000" & vbCrLf
        mtl &= "Ka 1.000000 1.000000 1.000000" & vbCrLf
        mtl &= "Kd 0.100061 0.195986 0.082515" & vbCrLf
        mtl &= "Ks 0.500000 0.500000 0.500000" & vbCrLf
        mtl &= "Ke 0.000000 0.000000 0.000000" & vbCrLf
        mtl &= "Ni 1.450000" & vbCrLf
        mtl &= "d 1.000000" & vbCrLf
        mtl &= "illum 0.5" & vbCrLf
        mtl &= "map_Kd " & matName & ".png" & vbCrLf

        My.Computer.FileSystem.WriteAllText(filnam & ".mtl", mtl, False)


    End Sub


End Class




Public Class Obj3d

    Public id As Integer
    Public commandNum As Integer
    Public chunks = New List(Of Byte())
    Public chunksAddr = New List(Of Integer)
    Public Polys = New List(Of Poly)

End Class

Public Class Poly
    Public coords = New List(Of Coord)
    Public vertNum As Byte
    Public Shading As Color
    Public command As Byte

    Public textureVertexs = New List(Of TexCoord)

End Class

Public Class Coord
    Public X As Integer
    Public Y As Integer
    Public Z As Integer
End Class

Public Class TexCoord
    Public X As Decimal
    Public Y As Decimal
End Class
