init commit

p2isPSX_CDToolkit/convEventToObj.vb

@@ -0,0 +1,317 @@
+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