Files
P2EP_Toolkit/p2isPSX_CDToolkit/rleTools.vb
2024-09-06 13:10:59 +05:00

668 lines
21 KiB
VB.net
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

Public Class rleTools
'This is implementation from ASM of ORIGINAL ATLUS GAME UNRLE PROCEDURE
'NEED TO FIX LAST BYTES!!! Fixed!
Public Function Unrle(ByRef readFile As Byte())
Dim newF As List(Of Byte)
newF = New List(Of Byte)
Dim Overallbytes = Form1.Read32bitNum(readFile, 4) 'Compressed size
Dim readCounter = Form1.Read32bitNum(readFile, 8) 'Uncompressed size
Dim readAddr = 12
If readFile(0) = 2 Then readAddr = 16 'if picture
If readFile(0) = 3 Then readAddr = 20 'if bgm
Dim mode As Byte
Dim curByte As Byte
Dim params1readCounter As Byte
Dim readOffset As Integer
Dim writeIndex As Integer
Dim params2 As Integer
Dim params18 As Integer
Do
If mode = 0 Then
curByte = readFile(readAddr)
readAddr += 1
If (curByte And &H80) = 0 Then
params1readCounter = curByte + 1
mode = 3 'simple read mode
Else
params1readCounter = curByte - &H7D
mode = 1 'mode 1&2 - read pattern
End If
Else
readCounter -= 1
If readCounter = 0 Then Form1.readerror = True : Return newF
End If
If mode = 2 Then
LAB_80026700:
writeIndex = newF.Count - 1
readOffset = writeIndex - params2
Dim bytesCounter = params1readCounter
Do
If readOffset > newF.Count - 1 Or readOffset < 0 Then 'Can Read empty memory
curByte = 0
Else
curByte = newF(readOffset)
End If
readOffset += 1
bytesCounter -= 1
newF.Add(curByte)
Loop While bytesCounter <> 0
Else
If mode < 3 Then
If mode = 1 Then
mode = 2
curByte = readFile(readAddr)
readAddr += 1
readCounter -= 1
params2 = curByte ' offset
GoTo LAB_80026700
End If
Else
If mode = 3 Then
If readCounter < params1readCounter Then params1readCounter = readCounter
CopyBytes(readFile, newF, readAddr, params1readCounter)
readCounter -= params1readCounter
readAddr += params1readCounter
End If
End If
End If
curByte = params1readCounter
mode = 0
If readCounter <= 0 Then Return newF
If readAddr >= Overallbytes Then Return newF
Loop
Return newF
End Function
Public Function Unrle2(ByRef readFile As Byte())
Dim newF As List(Of Byte)
newF = New List(Of Byte)
Dim Overallbytes = Form1.Read32bitNum(readFile, 4) 'Compressed size
Dim readOverallCounter = Overallbytes
'THERE IS NO Uncompressed size??? 'BitConverter.ToInt16(readFile, 12) * BitConverter.ToInt16(readFile, 14)
Dim readAddr = 12
If readFile(0) = 2 Then readAddr = 16 'if picture
Dim mode As Byte
Dim curByte As Byte
Dim params1readRepeatCounter As Byte 'params[1] 80080dc8 - Bytecounter to read
Dim params2
Do
If mode = 0 Then
curByte = readFile(readAddr)
readAddr += 1
If (curByte And &H80) = 0 Then
params1readRepeatCounter = curByte + 1
mode = 3 'simple read mode
Else
params1readRepeatCounter = curByte - &H7D 'number of bytes to read
mode = 1 'mode 1 then 2 (and proc) - repeat pattern
End If
Else
If readAddr >= Overallbytes Then Return newF
readOverallCounter -= 1
If readOverallCounter = 0 Then Form1.readerror = True : Return newF
End If
'Some Testing for overreading
'If *params_addr+18h < params1 THEN params1 = params+18h
'Orig code:
'param1 = param[1]
'mode=param[0]
If mode = 2 Then
LAB_80026510:
'/////////////////////////////////////////// PUROCESS PACKET BYTE
'/////////////////////////////////////////// CPU 80022524
Dim counter = params1readRepeatCounter
Dim packetByte = params2
Dim tempByte = packetByte
Do
newF.Add(tempByte)
counter -= 1
Loop While counter <> 0
'DELETED ROUTINE WHATS MAKE 32BIT INTEGER AND FILLS MEMORY BY 4 BYTES STEPS
'/////////////////////////////////////////// '///////////////////////////////////////////
Else
If mode < 3 Then
If mode = 1 Then
mode = 2
curByte = readFile(readAddr)
readAddr += 1
readOverallCounter -= 1
params2 = curByte ' offset
GoTo LAB_80026510
End If
Else
If mode = 3 Then
If readOverallCounter < params1readRepeatCounter Then params1readRepeatCounter = readOverallCounter
CopyBytes(readFile, newF, readAddr, params1readRepeatCounter)
readOverallCounter -= params1readRepeatCounter
readAddr += params1readRepeatCounter
End If
End If
End If
mode = 0
'If readOverallCounter <= 0 Then Return newF
If readAddr >= Overallbytes Then Return newF
Loop
Return newF
End Function
Private Function ArrayCheck(ByRef bytes() As Byte, ByVal PastByteIndex As Integer, ByVal FutureByteIndex As Integer, ByVal Size As Byte)
For a = 0 To Size - 1
If PastByteIndex < 0 Or FutureByteIndex + a > UBound(bytes) Then Return -1
If bytes(PastByteIndex + a) <> bytes(FutureByteIndex + a) Then Return -1
Next
Return Size
End Function
Private Function SaveAccum(ByRef rleFile As List(Of Byte), ByRef accum As List(Of Byte))
If accum.Count > 0 Then 'если что-то есть в аккумуляторе
rleFile.Add(accum.Count - 1)
rleFile.AddRange(accum)
accum.Clear()
End If
End Function
Public Sub CopyBytes(ByRef src As Byte(), ByRef destAddr As List(Of Byte), ByVal readAddr As Integer, ByVal BytesToCopy As Byte)
Dim srcLen = UBound(src)
If 0 < BytesToCopy Then
Do
If readAddr > srcLen Then MsgBox("ERROR COPYING BYTES IN rleTools.CopyBytes." & vbCrLf & "readAddr: " & readAddr & " Len: " & srcLen) : Exit Do
Dim readedByte = src(readAddr)
readAddr += 1
BytesToCopy -= 1
destAddr.Add(readedByte)
Loop While 0 < BytesToCopy
End If
End Sub
Public Function decodeRLEnew(ByRef filetoRLE As Byte(), ByRef curFile As rleFile)
Dim start = Microsoft.VisualBasic.DateAndTime.Timer
Dim fil As List(Of Byte) = filetoRLE.ToList
Dim rleFile = New List(Of Byte)
rleFile.Add(curFile.Type) : rleFile.Add(2) '////////////////TODO: MAKE SELECTABLE COMPRESSION !
'Init new RLE with source Type/Compression
rleFile.Add(BitConverter.GetBytes(curFile.ID)(0)) 'Convert ID
rleFile.Add(BitConverter.GetBytes(curFile.ID)(1))
Dim uncomprSize = UBound(filetoRLE) + 1
'DEPENDS ON TYPE
Select Case curFile.Type
Case 1 'FOR Type1(Data) - This
rleFile.AddRange({12, 0, 0, 0}) 'Compressed size here! At least 12 (rle, mode, I, D, Comprsize, OverallSize)
Case Else
MsgBox("Unsupported type :( - " & curFile.Type) : Return New List(Of Byte)
End Select
'////////////////TODO: ADD FILE TYPE 2 - PICTURE WITH X,Y,W,H
'///////////////// THIS BYTES FOR TYPE 0
rleFile.AddRange(BitConverter.GetBytes(uncomprSize).ToList) 'UNCOMPRESSED SIZE
Dim accum = New List(Of Byte)
Dim dict = New List(Of DictElem)
Dim repeatPattern = New List(Of RepeatElem)
MakeDictTree(fil, dict, repeatPattern) 'making tree and pattern
Dim curlvl As Byte
Dim CurDickBranch As DictElem
Dim indexes = New List(Of indexElem)
For c = 0 To fil.Count - 1
'If c = 25500 Then SaveAccum(rleFile, accum) : Exit For
indexes = New List(Of indexElem)
Dim readed = fil(c)
curlvl = 0
Dim curlevel As List(Of DictElem) = dict
CurDickBranch = curlevel.Find(Function(x) x.Byt = readed) 'checking avialable indexes
If c < 4 Then GoTo start4
Do
If IsNothing(CurDickBranch) Then Exit Do
If CurDickBranch.Indexes.Count = 1 Then Exit Do
Dim lastIndexes As List(Of Integer) = CurDickBranch.Indexes
Dim filtered = (From s As Integer In lastIndexes 'FILTER INDEXES
Where s < c And s >= c - 256).ToList()
If filtered.Count < 1 Then Exit Do
For Each i In filtered
indexes.Add(New indexElem With {.len = curlvl, .index = i}) 'making index table
Next
curlvl += 1
If c + curlvl = fil.Count Then Exit Do
Dim rd = fil(c + curlvl)
curlevel = CurDickBranch.elems
CurDickBranch = curlevel.Find(Function(x) x.Byt = rd)
Loop
Dim repeat As Byte = 0
Dim byt As Byte = 0
'Testing Repeating Byte
For Each rep In repeatPattern
If rep.index < c And c < rep.index + rep.Repeat Then
repeat = rep.index + rep.Repeat - c
Exit For 'Filtering repeat pattern
End If
Next
start4:
If curlvl < 4 And repeat < 4 Then
If accum.Count = 128 Then SaveAccum(rleFile, accum)
accum.Add(readed)
Else
'repeat pattern is much better than char pattern
If repeat >= curlvl Then
SaveAccum(rleFile, accum)
rleFile.Add(&H7D + repeat) 'Команда повтора и сколько раз
rleFile.Add(0) 'Повторять со смещением 0 (последний байт)
c = c + repeat - 1
Else
SaveAccum(rleFile, accum)
indexes.Sort(Function(x, y) x.len.CompareTo(y.len))
rleFile.Add(&H7E + indexes.Last.len)
rleFile.Add(c - indexes.Last.index - 1)
c = c + indexes.Last.len
End If
End If
If c = fil.Count - 1 Then SaveAccum(rleFile, accum) : Exit For
Next
'My.Computer.FileSystem.WriteAllBytes("D:\Games\PSX\Persona.2.Innocent.Sin\Export\UnRLE\0181_ALL_SCENERY\1112.rle", rleFile.ToArray, False)
Debug.WriteLine(Microsoft.VisualBasic.DateAndTime.Timer - start)
'Set rle compressed size
rleFile(4) = BitConverter.GetBytes(rleFile.Count)(0)
rleFile(5) = BitConverter.GetBytes(rleFile.Count)(1)
rleFile(6) = BitConverter.GetBytes(rleFile.Count)(2)
rleFile(7) = BitConverter.GetBytes(rleFile.Count)(3)
'adding bytes to read MOD4
Dim addedBytes = rleFile.Count Mod 4
If addedBytes > 0 Then addedBytes = 4 - addedBytes
For a = 0 To addedBytes - 1
rleFile.Add(0)
Next
Return rleFile
End Function
Public Function decodeRLE2images(ByRef filetoRLE As Byte(), ByRef curFile As rleFile)
Dim start = Microsoft.VisualBasic.DateAndTime.Timer
Dim fil As List(Of Byte) = filetoRLE.ToList
Dim rleFile = New List(Of Byte)
rleFile.Add(curFile.Type) : rleFile.Add(1) '////////////////IMAGE COMPRESSION
'Init new RLE with source Type/Compression
rleFile.Add(BitConverter.GetBytes(curFile.ID)(0)) 'Convert ID
rleFile.Add(BitConverter.GetBytes(curFile.ID)(1))
'DEPENDS ON TYPE
Select Case curFile.Type
Case 2 'FOR Type2(Image) - This
rleFile.AddRange({12, 0, 0, 0}) 'Compressed size here! At least 12 (rle, mode, I, D, Comprsize, OverallSize)
Case Else
MsgBox("Unsupported type :( - " & curFile.Type) : Return New List(Of Byte)
End Select
For a = 8 To 15 : rleFile.Add(curFile.Bytes(a)) : Next a 'Copying image params x,y,h,w
Dim repeatPattern = New List(Of RepeatElem)
MakeRepeatPattern(fil, repeatPattern)
Dim accum = New List(Of Byte)
For c = 0 To fil.Count - 1
Dim readed = fil(c)
Dim repeat As Byte = 0
Dim byt As Byte = 0
'Testing Repeating Byte
For Each rep In repeatPattern
If rep.index = c Then
repeat = rep.Repeat
Exit For 'Filtering repeat pattern
End If
Next
If repeat < 2 Then
If accum.Count = 126 Then SaveAccum(rleFile, accum)
accum.Add(readed)
Else
SaveAccum(rleFile, accum)
rleFile.Add(&H7D + repeat) 'Команда повтора и сколько раз
rleFile.Add(readed) 'Повторять байт
c = c + repeat - 1 'Shifting For
End If
If c = fil.Count - 1 Then
SaveAccum(rleFile, accum)
End If
Next
Debug.WriteLine((Microsoft.VisualBasic.DateAndTime.Timer - start) & " - " & rleFile.Count & " bytes")
'Set rle compressed size
rleFile(4) = BitConverter.GetBytes(rleFile.Count)(0)
rleFile(5) = BitConverter.GetBytes(rleFile.Count)(1)
rleFile(6) = BitConverter.GetBytes(rleFile.Count)(2)
rleFile(7) = BitConverter.GetBytes(rleFile.Count)(3)
'adding bytes to read MOD4
Dim addedBytes = rleFile.Count Mod 4
If addedBytes > 0 Then addedBytes = 4 - addedBytes
For a = 0 To addedBytes - 1
rleFile.Add(0)
Next
Return rleFile
End Function
Public Function MakeUncompressedImage(ByRef filetoRLE As Byte(), ByRef curFile As rleFile)
Dim fil As List(Of Byte) = filetoRLE.ToList
Dim rleFile = New List(Of Byte)
rleFile.Add(2) : rleFile.Add(0) '////////////////TYPE: IMAGE / COMPRESSION - NONE
'Init new image
rleFile.Add(BitConverter.GetBytes(curFile.ID)(0)) 'Convert ID
rleFile.Add(BitConverter.GetBytes(curFile.ID)(1))
'DEPENDS ON TYPE
rleFile.AddRange({12, 0, 0, 0}) 'Uncompressed Size here! At least 12 (rle, mode, I, D, Comprsize, OverallSize)
For a = 8 To 15 : rleFile.Add(curFile.Bytes(a)) : Next a 'Copying image params x,y,h,w
rleFile.AddRange(fil) 'Add uncomressed Data
'Set file size in header
rleFile(4) = BitConverter.GetBytes(rleFile.Count)(0)
rleFile(5) = BitConverter.GetBytes(rleFile.Count)(1)
rleFile(6) = BitConverter.GetBytes(rleFile.Count)(2)
rleFile(7) = BitConverter.GetBytes(rleFile.Count)(3)
'adding bytes to read MOD4
Dim addedBytes = rleFile.Count Mod 4
If addedBytes > 0 Then addedBytes = 4 - addedBytes
For a = 0 To addedBytes - 1
rleFile.Add(0)
Next
Return rleFile
End Function
Public Function GetBranch(ByRef CurDickBranch As DictElem, ByRef fil As List(Of Byte), ByRef c As Integer, ByRef curLevel As Integer)
Dim rd = fil(c + curLevel)
Dim NextBranch As DictElem = CurDickBranch.elems.Find(Function(x) x.Byt = rd)
Dim lastIndexes As List(Of Integer) = CurDickBranch.Indexes
If NextBranch.Indexes > 1 Then
curLevel += 1
GetBranch(NextBranch, fil, c, curLevel)
Else
Return lastIndexes
End If
End Function
Public Sub MakeDictTree(ByRef fil As List(Of Byte), ByRef dict As List(Of DictElem), ByRef repeatPattern As List(Of RepeatElem))
Dim tempRepeatByte As Byte
Dim tempRepeatCounter As Integer
Dim tempIndex As Integer
Dim curByte As Integer
Dim chk As DictElem
'MAKING BYTE TREE!!!
For b = 0 To fil.Count - 1
Dim curlevel As List(Of DictElem) = dict
Dim LvlNum As Byte = 1
Dim max = 130 'maximum window
If fil.Count - b < max Then max = fil.Count - b 'if end of file - decrease window to end of file
For wind = 0 To max - 1
curByte = fil(b + wind)
chk = curlevel.Find(Function(x) x.Byt = curByte)
If IsNothing(chk) Then
Dim newElem = New DictElem With {.Byt = curByte, .Indexes = New List(Of Integer) From {b}}
curlevel.Add(newElem)
curlevel = curlevel.Last.elems
Else
chk.Indexes.add(b)
chk.lvl = LvlNum
curlevel = chk.elems
End If
Next
'REPEATPATTERN CHECK
If tempRepeatByte = fil(b) And tempRepeatCounter <= 130 Then
tempRepeatCounter += 1
Else
If tempRepeatCounter > 3 Then repeatPattern.Add(New RepeatElem With {.Byt = tempRepeatByte, .index = tempIndex, .Repeat = tempRepeatCounter})
tempIndex = b
tempRepeatCounter = 1
tempRepeatByte = fil(b)
End If
Next
dict.Sort(Function(x, y) x.Byt.CompareTo(y.Byt))
repeatPattern.Sort(Function(x, y) x.Repeat.CompareTo(y.Repeat)) 'Need to check inbeetween
Dim curdict = dict
refr:
'For Each a In curdict
' If a.Indexes.count < 3 Then curdict.Remove(a) : GoTo refr
'Next
End Sub
Public Sub MakeRepeatPattern(ByRef fil As List(Of Byte), ByRef repeatPattern As List(Of RepeatElem))
Dim tempRepeatByte As Byte
Dim tempRepeatCounter As Integer
Dim curByte As Byte
Dim tempIndex As Integer
For b = 0 To fil.Count - 1
If tempRepeatByte = fil(b) And tempRepeatCounter < 130 Then
tempRepeatCounter += 1
Else
If tempRepeatCounter > 3 Then repeatPattern.Add(New RepeatElem With {.Byt = tempRepeatByte, .index = tempIndex, .Repeat = tempRepeatCounter})
tempIndex = b
tempRepeatCounter = 1
tempRepeatByte = fil(b)
End If
'If its last byte
If tempRepeatByte = fil(b) And tempRepeatCounter < 130 And b = fil.Count - 1 Then
repeatPattern.Add(New RepeatElem With {.Byt = tempRepeatByte, .index = tempIndex, .Repeat = tempRepeatCounter})
End If
Next
repeatPattern.Sort(Function(x, y) x.index.CompareTo(y.index))
End Sub
Public Function UnrleNocompr(ByRef readFile As Byte())
Dim newF = New List(Of Byte)
Dim Overallbytes = Form1.Read32bitNum(readFile, 4) 'Compressed size
If readFile(0) = 2 Then
For a = 16 To Overallbytes - 1 'If uncompressed image (CLUT etc.)
newF.Add(readFile(a))
Next
Else
For a = 8 To Overallbytes - 1
newF.Add(readFile(a))
Next
End If
Return newF
End Function
End Class
Public Class indexElem
Public index As Integer
Public len As Byte
End Class
Public Class RepeatElem
Public Byt As Byte
Public Repeat As Byte
Public index As Integer
End Class
Public Class DictElem
Public Byt As Byte
Public lvl As Byte
Public Indexes = New List(Of Integer)
Public elems = New List(Of DictElem)
End Class
Public Class RepeatObject
Public SrcIndex
Public Offset
Public DstIndex
Public Bytes As List(Of Byte)
Public NumOfRepeat
End Class