Imports Ionic
Imports Free.Ports.libpng
Imports System.IO
Imports System.IO.Compression
Imports Microsoft.VisualBasic.VBMath

Public Class pngImage
    Public MagicWord = {137, 80, 78, 71, 13, 10, 26, 10}
    Public Width As Integer
    Public Heigth As Integer
    Public bit As Byte
    Public colors As Integer
    Public Palette = New List(Of Byte)
    Public Transp = New List(Of Byte)
    Public imageDATA = New List(Of Byte)
    Public Chunks As List(Of Chunk)
    Public IMG As Bitmap

    Public Sub New()
        Chunks = New List(Of Chunk)
    End Sub

    Public Sub InitBitMap(ByVal path As String)



        IMG = Image.FromFile(path)


    End Sub

    Public Function makeBigTexturePng(ByRef cluts As List(Of List(Of Byte)), ByRef pics As List(Of List(Of Byte)))

        Dim bigWidth = 64 * pics.Count

        Dim ch = New Chunk With {.Type = "IHDR", .Size = 13}
        'Making header
        ch.Data.AddRange(BitConverter.GetBytes(bigWidth).Reverse)
        ch.Data.AddRange(BitConverter.GetBytes(256).Reverse)
        ch.Data.Add(8) '8 Bit bits per channel
        ch.Data.Add(2) 'Or 6 with alpha 'Color Type - RGB Mode (24bit) if 16bit
        ch.Data.Add(0) 'Compression (zlib)
        ch.Data.Add(0) 'Filter?
        ch.Data.Add(0) 'Interlace?
        Chunks.Add(ch)
        ch = New Chunk With {.Type = "tRNS"} : ch.Data.Add(0) : Chunks.Add(ch)          'First Color is transparent


        ch = New Chunk With {.Type = "IDAT"}
        'Adding Image data

        ''Image loop here
        Dim img = New List(Of Byte)



        For x = 0 To 255
            img.Add(0)
            For y = 0 To pics.Count - 1
                For z = 0 To 63
                    Dim curPicIndex = x * 64 + z + 8            'PIC LINE * WIDTH + CURRENT PIX IN LINE + 8(INIT BYTES)
                    Dim curCol = GetColFrom1555List(cluts(y), pics(y)(curPicIndex))
                    img.AddRange({curCol(0), curCol(1), curCol(2)})
                Next
            Next
        Next


        Dim dstream = Zlib.ZlibStream.CompressBuffer(img.ToArray)
        ch.Data = dstream.ToList
        Chunks.Add(ch)
        ch = New Chunk With {.Type = "IEND", .Size = 0}
        Chunks.Add(ch)


        Return (GenerateFile())  'Return file to mainWindow
    End Function

    Public Function GetColFrom1555List(ByRef bytes As List(Of Byte), ByVal ind As Integer)
        ind = ind * 2 + 8
        If ind > bytes.Count - 1 Then Return {0, 0, 0}

        Dim col As Integer = (bytes(ind)) + CInt(bytes(ind + 1)) * 256
        Dim a = col And &H8000 >> 15, b = ((col And &H7C00) >> 10) * 8, g = ((col And &H3E0) >> 5) * 8, r = (col And &H1F) * 8
        Return {r, g, b}
    End Function

    Public Function NewPng(ByRef pic As rleFile, ByRef clut As rleFile)

        'Need to deconctruct and construct palettes and imagedata here

        'need to set correct x&y
        If Form1.CurrentImgMode = 16 Then
            Width = pic.w

        ElseIf clut.w = 16 Or Form1.Force4bit.Checked Then
            Width = pic.w * 4
        Else
            If clut.w = 256 Then Width = pic.w * 2 Else Width = pic.w
        End If

        Heigth = pic.h


        GeneratePngChunks(pic, clut)
        Return (GenerateFile())  'Return file to mainWindow
    End Function


    Public Sub GeneratePngChunks(ByRef pic As rleFile, ByRef clut As rleFile)




        Dim ch = New Chunk With {.Type = "IHDR", .Size = 13}
        'Making header
        ch.Data.AddRange(BitConverter.GetBytes(Width).Reverse)
        ch.Data.AddRange(BitConverter.GetBytes(Heigth).Reverse)
        If Form1.CurrentImgMode <> 16 Then
            ch.Data.Add(8) '8 Bit Depth in palette
            ch.Data.Add(3) 'Color Type - Indexed Colors             'If CLUT exists first!
        Else
            ch.Data.Add(8) '8 Bit bits per channel
            ch.Data.Add(2) 'Or 6 with alpha 'Color Type - RGB Mode (24bit) if 16bit
        End If

        ch.Data.Add(0) 'Compression (zlib)
        ch.Data.Add(0) 'Filter?
        ch.Data.Add(0) 'Interlace?


        'not 16bit
        If Form1.CurrentImgMode <> 16 Then
            Chunks.Add(ch)
            ch = New Chunk With {.Type = "PLTE"}
            'Making Palette
            ch.Data.AddRange(MakeCLUTList(clut))


            Chunks.Add(ch)
            ch = New Chunk With {.Type = "tRNS"}
            'Making Trans
            If Form1.alpha0.Checked Then ch.Data.Add(0)          'First Color is transparent
        End If


        Chunks.Add(ch)
        ch = New Chunk With {.Type = "IDAT"}
        'Adding Image data



        Dim rle = New rleTools
        Dim picdata As Byte()
        If pic.Compr > 0 Then
            picdata = rle.Unrle2(pic.Bytes).ToArray
        Else
            Dim piclist = pic.Bytes.ToList
            piclist.RemoveRange(0, 16)
            picdata = piclist.ToArray
        End If



        Dim img = New List(Of Byte)

        If Form1.Force4bit.Checked Then GoTo force4bit 'force 4 bit

        If Form1.CurrentImgMode = 16 Then               'True color
            Dim piccc() = picdata.ToArray
            Dim reader = 0, x = 0
            img.Add(0)          'Fucking filter byte

            '16bit_PNG_export
            Do
                If x = Width Then x = 0 : img.Add(0)          'Fucking filter byte
                Dim curCol = GetColFrom1555(piccc, reader)
                img.AddRange({curCol(0), curCol(1), curCol(2)})
                reader += 2
                x += 1
                If reader >= picdata.Count Then Exit Do

            Loop



        Else
            'other export


            Select Case clut.w
                Case 16
                    '4bit mode
force4bit:

                    For y = 0 To Heigth - 1
                        img.Add(0)          'Fucking filter byte
                        For x = 0 To Width / 2 - 1
                            Dim fs = picdata(y * Width / 2 + x)               'Width/2 = Bytes in pic line
                            Dim lp = fs And &HF           'get left byte
                            Dim rp = (fs And &HF0) >> 4     'get right byte
                            img.Add(lp)
                            img.Add(rp)
                        Next
                    Next

                Case 256
                    '8bit mode
                    For y = 0 To Heigth - 1
                        img.Add(0)          'Fucking filter byte
                        For x = 0 To Width - 1
                            Dim fs = picdata(y * Width + x)
                            img.Add(fs)
                        Next
                    Next
            End Select


        End If


        Dim dstream = Zlib.ZlibStream.CompressBuffer(img.ToArray)

        ch.Data = dstream.ToList



        Chunks.Add(ch)
        ch = New Chunk With {.Type = "IEND", .Size = 0}
        Chunks.Add(ch)


    End Sub

    Public Function GenerateFile()

        Dim file = New List(Of Byte)
        For Each a In MagicWord
            file.Add(a)
        Next



        For Each ch As Chunk In Chunks
            Dim tempChunk = New List(Of Byte)
            ch.Size = ch.Data.Count
            file.AddRange(BitConverter.GetBytes(ch.Size).Reverse)        'Size of chunk Not Included in CRC

            For chChar = 0 To 3 : tempChunk.Add(Asc(ch.Type(chChar))) : Next    'AddingChunkName
            tempChunk.AddRange(ch.Data)

            Dim CRC = New Ionic.Crc.CRC32()
            CRC.SlurpBlock(tempChunk.ToArray, 0, tempChunk.Count)               'CRC CALCULATES HERE!
            file.AddRange(tempChunk)
            file.AddRange(BitConverter.GetBytes(CRC.Crc32Result).Reverse)

        Next


        Return file
    End Function

    Public Function MakeCLUTList(ByRef nx As rleFile)

        Dim a = New List(Of Byte)
        Dim rle As New rleTools
        Dim unrl() As Byte

        Select Case nx.Compr
            Case 0
                unrl = rle.UnrleNocompr(nx.Bytes).ToArray
            Case 1
                unrl = rle.Unrle2(nx.Bytes).ToArray      'Image
            Case Else
                unrl = rle.Unrle(nx.Bytes).ToArray   'data
        End Select



        '4bit mode
        If nx.w = 16 Or Form1.Force4bit.Checked Then
            For x = 0 To 15
                Dim b As Integer() = GetColFrom1555(unrl, Form1.CLUTid.Value * 32 + x * 2)
                a.Add(b(0)) : a.Add(b(1)) : a.Add(b(2))
            Next
            Return a
        End If


        If nx.w = 256 Then
            For x = 0 To 255
                'a.Add(GetColFrom1555(nx.Bytes, 16 + CLUTid.Value * 256 + x * 2))
                Dim b As Integer() = GetColFrom1555(unrl, x * 2)
                a.Add(b(0)) : a.Add(b(1)) : a.Add(b(2))
            Next
        End If

        Return a
    End Function

    Public Function GetColFrom1555(ByRef bytes As Byte(), ByVal ind As Integer)
        If ind > UBound(bytes) - 1 Then Return {0, 0, 0}
        Dim col As Int16 = BitConverter.ToInt16(bytes, ind)
        Dim a = col And &H8000 >> 15, b = ((col And &H7C00) >> 10) * 8, g = ((col And &H3E0) >> 5) * 8, r = (col And &H1F) * 8
        Return {r, g, b}
    End Function




    Public Function Convert888To565(ByRef col As Color)
        Dim r = col.R : Dim g = col.G : Dim b = col.B

        Dim res As Int32

        res = ((b And &HF8) << 7) Or ((g And &HF8) << 2) Or ((r And &HF8) >> 3)
        'Dim x1 = (b And &HF8) Or (g >> 5)
        'Dim x2 = ((g And &H1C) << 3) Or (r >> 3)

        'res = x2 Or (x1 << 8)

        Return res
    End Function

    Public Function ParsePNGgetData(ByRef src As List(Of Byte), ByRef rle As rleFile)
        Dim file = New List(Of Byte)


        If src(0) <> 137 And src(1) <> 80 And src(2) <> 78 Then MsgBox("Это не PNG!!!", MsgBoxStyle.Critical) : Return file


        'Loading Chunks
        Dim Reader As Integer = 8
        Do
            GenerateChunk(src, Reader)
        Loop Until Reader >= src.Count

        Dim header As List(Of Byte) = GetChunk("IHDR").Data
        Width = Read32bitNumBE(header, 0)
        Heigth = Read32bitNumBE(header, 4)


        Dim plte As Chunk = GetChunk("PLTE")
        If Form1.imp4bit.Checked Then
            bit = 4
        Else
            If Form1.Imp8bit.Checked Then
                bit = 8
            Else
                bit = 16
            End If
        End If


        Dim imgData = New List(Of Byte)
        'LoadingChunks

        Dim chunks = GetChunks("IDAT")          'CONCAT ALL IDATS....
        Dim buff = New List(Of Byte)
        For Each ch In chunks
            buff.AddRange(ch.Data)
        Next

        Dim dstream = Zlib.ZlibStream.UncompressBuffer(buff.ToArray())      '....AND DECOMPRESS

        imgData.AddRange(dstream.ToList)
        Dim filter As Integer

        Reader = 1


        Dim x, y As Integer

        If bit = 4 Or bit = 8 Then UnfilterNew(imgData, Width, Heigth)          'unfilter ALL scanlines


        Do
            Select Case bit
                Case 4
                    Dim lp = imgData(Reader)
                    Dim rp = imgData(Reader + 1) : Reader += 1
                    file.Add(((rp And &HF) << 4) Or (lp And &HF))
                    x += 2
                Case 8
                    If y = Heigth Then Exit Do
                    file.Add(imgData(Reader))
                    x += 1
                Case 16

                    Dim col As Color = IMG.GetPixel(x, y)



                    Dim res As Int32 = Convert888To565(col)
                    file.AddRange({BitConverter.GetBytes(res)(0), BitConverter.GetBytes(res)(1)})

                    x += 1
                    'Reader += 2
            End Select

            If x >= Width Then
                If Reader >= imgData.Count - 1 Then Exit Do
                x = 0
                y += 1

                Reader += 1

            End If

            If y >= Heigth Then Exit Do


            Reader += 1


        Loop



        Return file
    End Function

    Public Sub UnfilterNew(ByRef imgData As List(Of Byte), ByVal Width As Integer, ByVal Heigth As Integer)
        ''''''NEW UNFILTER FROM PNGLIB OFFICIAL LIBRARY (3rd version)

        Dim x = 0, y = 0, filter, reader As Integer
        filter = imgData(reader) ': Debug.WriteLine("Y=" & y & "FLT=" & filter)     'INIT
        reader += 1

        Do
            Select Case filter
                Case 0          'none filter

                Case 1          'sub filter
                    For a = 1 To Width - 1
                        Dim rp As Integer = imgData(reader + a)
                        Dim rpp As Integer = imgData(reader + a - 1)
                        imgData(reader + a) = (rp + rpp) And &HFF
                    Next
                Case 2          'up filter
                    For a = 0 To Width - 1
                        Dim rp As Integer = imgData(reader + a)
                        Dim pp As Integer = imgData(reader + a - Width - 1)
                        imgData(reader + a) = (rp + pp) And &HFF
                    Next
                Case 3          'average filter

                    Dim rp As Integer = imgData(reader)
                    Dim pp As Integer = imgData(reader - Width - 1)         'first pixel
                    imgData(reader) = (rp + (pp / 2)) And &HFF

                    For a = 1 To Width - 1
                        rp = imgData(reader + a)
                        pp = imgData(reader + a - Width - 1)
                        Dim rpp As Integer = imgData(reader + a - 1)
                        imgData(reader + a) = (rp + Math.Floor((pp + rpp) / 2)) And &HFF            'Other pixels
                    Next

                Case 4          'paeth 1-byte filter

                    Dim rp_end As Integer = reader + Width
                    Dim a, c As Integer
                    x = 0
                    c = imgData(reader - Width - 1)                         'first pixel
                    a = imgData(reader) + c
                    imgData(reader) = a And &HFF : reader += 1

                    While (reader < rp_end)
                        Dim b, pa, pb, pc, p As Integer
                        x = x + 1
                        a = a And &HFF      'cleaning  byte
                        b = imgData(reader - Width - 1)

                        p = b - c
                        pc = a - c

                        pa = Math.Abs(p)
                        pb = Math.Abs(pc)
                        pc = Math.Abs(p + pc)

                        If pb < pa Then pa = pb : a = b
                        If pc < pa Then a = c

                        c = b
                        a += imgData(reader)
                        imgData(reader) = a And &HFF : reader += 1
                    End While
            End Select
            If filter <> 4 Then reader += Width

            y = y + 1
            If reader >= imgData.Count - 1 Or y = Heigth Then Exit Do

            filter = imgData(reader)
            reader += 1
            'Debug.WriteLine("Y=" & y & "FLT=" & filter)

        Loop

    End Sub


    Public Sub GenerateChunk(ByRef src As List(Of Byte), ByRef reader As Integer)
        Dim cc = New Chunk
        cc.Size = Read32bitNumBE(src, reader) : reader += 4
        For x = 0 To 3 : cc.Type &= Chr(src(x + reader)) : Next : reader += 4
        For x = 0 To cc.Size - 1 : cc.Data.Add(src(x + reader)) : Next : reader += cc.Size
        reader += 4 'Nahuy CRC-check!
        Chunks.add(cc)
    End Sub
    Public Function GetChunk(ByVal Tp As String)
        For Each cc In Chunks
            If cc.Type = Tp Then Return cc
        Next
        Return Nothing
    End Function

    Public Function GetChunks(ByVal Tp As String)

        Dim a = New List(Of Chunk)
        a = Chunks.FindAll(Function(x) x.Type = Tp)

        Return a
    End Function

    Public Function Read32bitNumBE(ByRef f As List(Of Byte), ByVal bytenum As Integer)
        Return f(bytenum + 3) + f(bytenum + 2) * 256 + f(bytenum + 1) * 65536 + f(bytenum) * 16777216
    End Function
End Class

Public Class Chunk
    Public Size As Integer
    Public Type As String
    Public Data = New List(Of Byte)
End Class