init commit
This commit is contained in:
sShemet
535
p2isPSX_CDToolkit/pngImage.vb
Normal file
535
p2isPSX_CDToolkit/pngImage.vb
Normal file
@@ -0,0 +1,535 @@
|
||||
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
|
||||
Reference in New Issue
Block a user