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("File compressed. src_size=" & fil.Count & " | cmpr_size=" & rleFile.Count & " | Time=" & 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

    Public Function attachNoCompressionHeader(ByRef curfile As rleFile, ByRef bytes As Byte())
        Dim file = New List(Of Byte) From {
            curfile.Type,
            0, 'No compression
            BitConverter.GetBytes(curfile.ID)(0), 'Convert ID
            BitConverter.GetBytes(curfile.ID)(1),
            BitConverter.GetBytes(bytes.Count + 8)(0), 'FileSize
            BitConverter.GetBytes(bytes.Count + 8)(1), 'FileSize
            BitConverter.GetBytes(bytes.Count + 8)(2), 'FileSize
            BitConverter.GetBytes(bytes.Count + 8)(3) 'FileSize
            }

        file.AddRange(bytes.ToList)
        Return file

    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