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