318 lines
11 KiB
VB.net
318 lines
11 KiB
VB.net
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
|