PokemonGameEditor/GBAPokemonGameEditor/CryFunctions.vb
Gamer2020 adad1bbceb Started importing cry code
I've started adding code for importing cries.
2016-09-27 23:04:22 -05:00

458 lines
16 KiB
VB.net

Imports System
Imports System.IO
Imports System.Text
Imports System.Media
'These functions are based off the ones found in this project: https://github.com/doom-desire/Cry-Editor
'Credit goes to doom-desire for these functions.
Module CryFunctions
Structure Cry
Public Index As Integer
Public Offset As Integer
Public Compressed As Boolean
Public Looped As Boolean
Public SampleRate As Integer
Public LoopStart As Integer
Public Size As Integer
Public Data As SByte()
End Structure
Public Function LoadCry(index As Integer, cryTable As Integer) As Cry
Dim CryToLoad As New Cry
'If ledrom Is Nothing Then
' Return False
'End If
' load cry table entry
'ledrom.Seek(cryTable + index * 12)
'Dim someValue = ledrom.ReadInt32()
'Dim cryOffset = ledrom.ReadPointer()
'Dim cryShape = ledrom.ReadInt32()
Dim someValue = Int32.Parse(ReverseHEX((ReadHEX(LoadedROM, (cryTable) + (index * 12), 4))), System.Globalization.NumberStyles.HexNumber)
Dim cryOffset = (Int32.Parse(ReverseHEX((ReadHEX(LoadedROM, (cryTable) + (index * 12) + 4, 4))), System.Globalization.NumberStyles.HexNumber) - &H8000000)
Dim cryShape = Int32.Parse(ReverseHEX((ReadHEX(LoadedROM, (cryTable) + (index * 12) + 8, 4))), System.Globalization.NumberStyles.HexNumber)
'If cryOffset = 0 Then
' Return False
'End If
' load cry data
'ledrom.Seek(cryOffset)
CryToLoad.Offset = cryOffset
CryToLoad.Index = index
'CryToLoad.Compressed = ledrom.ReadUInt16() = &H1
'CryToLoad.Looped = ledrom.ReadUInt16() = &H4000
'CryToLoad.SampleRate = ledrom.ReadInt32() >> 10
'CryToLoad.LoopStart = ledrom.ReadInt32()
'CryToLoad.Size = ledrom.ReadInt32() + 1
CryToLoad.Compressed = Int16.Parse(ReverseHEX((ReadHEX(LoadedROM, (cryOffset) + 0, 2))), System.Globalization.NumberStyles.HexNumber) = &H1
CryToLoad.Looped = Int16.Parse(ReverseHEX((ReadHEX(LoadedROM, (cryOffset) + 2, 2))), System.Globalization.NumberStyles.HexNumber) = &H4000
CryToLoad.SampleRate = Int32.Parse(ReverseHEX((ReadHEX(LoadedROM, (cryOffset) + 4, 4))), System.Globalization.NumberStyles.HexNumber) >> 10
CryToLoad.LoopStart = Int32.Parse(ReverseHEX((ReadHEX(LoadedROM, (cryOffset) + 8, 4))), System.Globalization.NumberStyles.HexNumber)
CryToLoad.Size = Int32.Parse(ReverseHEX((ReadHEX(LoadedROM, (cryOffset) + 12, 4))), System.Globalization.NumberStyles.HexNumber) + 1
If Not CryToLoad.Compressed Then
' uncompressed, 1 sample per 1 byte of size
CryToLoad.Data = New SByte(CryToLoad.Size - 1) {}
For g As Integer = 0 To CryToLoad.Size - 1
CryToLoad.Data(g) = ByteToSignedInt("&H" & (ReadHEX(LoadedROM, (cryOffset) + 16 + g, 1)))
Next
Else
' compressed, a bit of a hassle
Dim lookup = New SByte() {0, 1, 4, 9, 16, 25, _
36, 49, -64, -49, -36, -25, _
-16, -9, -4, -1}
Dim start = (cryOffset) + 16
Dim offtrack = (cryOffset) + 16
Dim alignment As Integer = 0, size As Integer = 0
Dim pcmLevel As SByte = 0
Dim data = New List(Of SByte)()
While True
If alignment = 0 Then
pcmLevel = ByteToSignedInt("&H" & (ReadHEX(LoadedROM, offtrack, 1)))
offtrack = offtrack + 1
data.Add(pcmLevel)
alignment = &H20
End If
Dim input As Byte = ("&H" & (ReadHEX(LoadedROM, offtrack, 1)))
offtrack = offtrack + 1
If alignment < &H20 Then
' first nybble
pcmLevel += lookup(input >> 4)
data.Add(pcmLevel)
End If
' second nybble
pcmLevel += lookup(input And &HF)
data.Add(pcmLevel)
' exit when currentSize >= cry.Size
size += 2
If size >= CryToLoad.Size Then
Exit While
End If
alignment -= 1
End While
CryToLoad.Data = data.ToArray()
' bytes needed to recompress
CryToLoad.Size = offtrack - start
End If
Return CryToLoad
End Function
Public Function GetCryImage(cry As Cry) As Bitmap
Dim cryImage As Bitmap
cryImage = New Bitmap(cry.Data.Length, 128)
Using g = Graphics.FromImage(cryImage)
For i As Integer = 1 To cry.Data.Length - 1
g.DrawLine(Pens.Green, i - 1, 64 + cry.Data(i - 1), i, 64 + cry.Data(i))
Next
End Using
Return cryImage
End Function
Public Sub PlayCry(cry As Cry)
' TODO: we could do this in another thread :O
If cry.Offset = 0 Then
Exit Sub
End If
Using stream = New MemoryStream()
' "save" the cry to a memorystream
Using writer As BinaryWriter = New BinaryWriter(stream, Encoding.ASCII, True)
' RIFF header
writer.Write(Encoding.ASCII.GetBytes("RIFF"))
writer.Write(0)
writer.Write(Encoding.ASCII.GetBytes("WAVE"))
' fmt chunk
writer.Write(Encoding.ASCII.GetBytes("fmt "))
writer.Write(16)
writer.Write(CUShort(1))
writer.Write(CUShort(1))
writer.Write(cry.SampleRate)
writer.Write(cry.SampleRate)
writer.Write(CUShort(1))
writer.Write(CUShort(8))
' data chunk
writer.Write(Encoding.ASCII.GetBytes("data"))
writer.Write(cry.Data.Length)
For Each sample As SByte In cry.Data
writer.Write(CByte(sample + &H80))
Next
' fix header
writer.Seek(4, SeekOrigin.Begin)
writer.Write(CInt(writer.BaseStream.Length) - 8)
End Using
' play it via a soundplayer
stream.Seek(0L, SeekOrigin.Begin)
Using player = New SoundPlayer(stream)
player.Load()
player.Play()
End Using
End Using
End Sub
Public Sub ExportCry(filename As String, cry As Cry)
If Cry.Offset = 0 Then
Return
End If
' http://www-mmsp.ece.mcgill.ca/documents/audioformats/wave/wave.html
' http://soundfile.sapp.org/doc/WaveFormat/
Using writer = New BinaryWriter(File.Create(filename))
' RIFF header
writer.Write(Encoding.ASCII.GetBytes("RIFF"))
' file ID
writer.Write(0)
' file size placeholder
writer.Write(Encoding.ASCII.GetBytes("WAVE"))
' format
' fmt chunk
writer.Write(Encoding.ASCII.GetBytes("fmt "))
' chunk ID
writer.Write(16)
' chunk size, 16 for PCM
writer.Write(CUShort(1))
' format: 1 = wave_format_pcm
writer.Write(CUShort(1))
' channel count
writer.Write(Cry.SampleRate)
' sample rate
' * 1 * 8 / 8
writer.Write(Cry.SampleRate)
' SampleRate * NumChannels * BitsPerSample/8
' * 8 / 8
writer.Write(CUShort(1))
' NumChannels * BitsPerSample/8
writer.Write(CUShort(8))
' bits per sample
' data chunk
writer.Write(Encoding.ASCII.GetBytes("data"))
' chunk ID
writer.Write(Cry.Data.Length)
' chunk size
For Each sample As SByte In cry.Data
writer.Write(CByte(sample + &H80))
Next
' wave PCM is unsigned unlike GBA PCM which is
' fix header
writer.Seek(4, SeekOrigin.Begin)
writer.Write(CInt(writer.BaseStream.Length) - 8)
End Using
End Sub
Public Function ImportCry(filename As String, CryToLoad As Cry) As Cry
'If Cry.Offset = 0 Then
' Return
'End If
' load a wave file
Using reader = New BinaryReader(File.OpenRead(filename))
' read RIFF header
If reader.ReadUInt32() <> &H46464952 Then
Throw New Exception("This is not a WAVE file!")
End If
If reader.ReadInt32() + 8 <> reader.BaseStream.Length Then
Throw New Exception("Invalid file length!")
End If
If reader.ReadUInt32() <> &H45564157 Then
Throw New Exception("This is not a WAVE file!")
End If
' read fmt chunk
If reader.ReadUInt32() <> &H20746D66 Then
Throw New Exception("Expected fmt chunk!")
End If
If reader.ReadInt32() <> 16 Then
Throw New Exception("Invalid fmt chunk!")
End If
If reader.ReadInt16() <> 1 Then
' only PCM format allowed
Throw New Exception("Cry must be in PCM format!")
End If
If reader.ReadInt16() <> 1 Then
' only 1 channel allowed
Throw New Exception("Cry cannot have more than one channel!")
End If
CryToLoad.SampleRate = reader.ReadInt32()
If reader.ReadInt32() <> CryToLoad.SampleRate Then
Throw New Exception("Invalid fmt chunk!")
End If
reader.ReadUInt16()
Dim bitsPerSample = reader.ReadUInt16()
If bitsPerSample <> 8 Then
' for now, only 8 bit PCM data
Throw New Exception("Cries must be 8-bit WAVE files! Got {bitsPerSample}-bit instead.")
End If
' data chunk
If reader.ReadUInt32() <> &H61746164 Then
Throw New Exception("Expected data chunk!!")
End If
Dim dataSize = reader.ReadInt32()
CryToLoad.Data = New SByte(dataSize - 1) {}
For i As Integer = 0 To dataSize - 1
' read 8-bit unsigned PCM and convert to GBA signed form
CryToLoad.Data(i) = CSByte(reader.ReadByte() - 128)
Next
End Using
' resetting some other properties just in case
CryToLoad.Looped = False
CryToLoad.LoopStart = 0
Return CryToLoad
End Function
Public Function SaveCry(crytosave As Cry, index As Integer, cryTable As Integer) As Boolean
If crytosave.Offset = 0 Then
Return False
End If
'var lookup = new byte[] { 0x0, 0x1, 0x4, 0x9, 0x10, 0x19, 0x24, 0x31, 0xC0, 0xCF, 0xDC, 0xE7, 0xF0, 0xF7, 0xFC, 0xFF };
Dim lookup = New SByte() {0, 1, 4, 9, 16, 25, _
36, 49, -64, -49, -36, -25, _
-16, -9, -4, -1}
' copy cry data to be written
Dim data = New List(Of Byte)()
If crytosave.Compressed Then
' data is compressed in blocks of 1 + 0x20 bytes at a time
' first byte is normal signed PCM data
' following 0x20 bytes are compressed based on previous value
' (for a value not in lookup table, closest value will be chosen instead)
'Console.WriteLine("compressed");
' each block has 0x40 samples
Dim blockCount = crytosave.Data.Length / &H40
If crytosave.Data.Length Mod &H40 > 0 Then
blockCount += 1
End If
' truncates the length of the last block
' so we don't waste space
Dim lastBlockSize = crytosave.Data.Length - crytosave.Data.Length / &H40 * &H40
If lastBlockSize = 0 Then
lastBlockSize = &H21
Else
lastBlockSize = 1 + (lastBlockSize / 2) + (If(lastBlockSize Mod 2 = 0, 0, 1))
End If
Dim blocks = New Byte(blockCount - 1)() {}
For n As Integer = 0 To blockCount - 1
' create new block
If n < blockCount - 1 Then
blocks(n) = New Byte(32) {}
Else
blocks(n) = New Byte(lastBlockSize - 1) {}
End If
Dim i As Integer = n * &H40
Dim k As Integer = 0
' set first value
blocks(n)(System.Math.Max(System.Threading.Interlocked.Increment(k), k - 1)) = CByte(crytosave.Data(i))
Dim pcm As SByte = crytosave.Data(System.Math.Max(System.Threading.Interlocked.Increment(i), i - 1))
Dim j As Integer = 1
While j < &H40 AndAlso i < crytosave.Data.Length
' get current sample
Dim sample = crytosave.Data(System.Math.Max(System.Threading.Interlocked.Increment(i), i - 1))
' difference between previous sample and this
Dim diff = sample - pcm
' check for a perfect match in lookup table
Dim lookupI = -1
For x As Integer = 0 To 15
If lookup(x) = diff Then
lookupI = x
Exit For
End If
Next
' search for the closest match in the table
If lookupI = -1 Then
Dim bestDiff = 255
For x As Integer = 0 To 15
If Math.Abs(lookup(x) - diff) < bestDiff Then
lookupI = x
bestDiff = Math.Abs(lookup(x) - diff)
End If
Next
End If
' set value in block
' on an odd value, increase position in block
If j Mod 2 = 0 Then
blocks(n)(k) = blocks(n)(k) Or CByte(lookupI << 4)
Else
blocks(n)(System.Math.Max(System.Threading.Interlocked.Increment(k), k - 1)) = blocks(n)(System.Math.Max(System.Threading.Interlocked.Increment(k), k - 1)) Or CByte(lookupI)
End If
' set previous
pcm = sample
j += 1
End While
Next
For n As Integer = 0 To blockCount - 1
data.AddRange(blocks(n))
Next
Else
' uncompressed, copy directly to data
'Console.WriteLine("uncompressed");
For Each s As SByte In crytosave.Data
data.Add(CByte(s))
Next
End If
' determine if cry requires repointing
If crytosave.Size < data.Count Then
' find a new offset for our cry
' overwrite old cry with FF bytes
'rom.Seek(Cry.Offset)
'For i As Integer = 0 To 15
' ' header
' rom.WriteByte(Byte.MaxValue)
'Next
'For i As Integer = 0 To Cry.Size - 1
' ' cry data
' rom.WriteByte(Byte.MaxValue)
'Next
' set new cry offset
crytosave.Offset = SearchFreeSpaceFourAligned(LoadedROM, &HFF, (((data.Count) / 2)), "&H" & GetString(GetINIFileLocation(), header, "StartSearchingForSpaceOffset", "800000"))
End If
'' write cry
'rom.Seek(Cry.Offset)
'rom.WriteUInt16(CUShort(If(Cry.Compressed, 1, 0)))
'rom.WriteUInt16(CUShort(If(Cry.Looped, &H4000, 0)))
'rom.WriteInt32(Cry.SampleRate << 10)
'rom.WriteInt32(Cry.LoopStart)
'rom.WriteInt32(Cry.Data.Length - 1)
'rom.WriteBytes(data.ToArray())
'' write cry table entry
'rom.Seek(cryTable + Cry.Index * 12)
'rom.WriteUInt32(If(Cry.Compressed, &H3C20UI, &H3C00UI))
'rom.WritePointer(Cry.Offset)
'rom.WriteUInt32(&HFF00FFUI)
'' write growl table entry
'rom.Seek(growlTable + Cry.Index * 12)
'rom.WriteUInt32(If(Cry.Compressed, &H3C30UI, &H3C00UI))
'' !!! not sure if 00 should be used for uncompressed
'rom.WritePointer(Cry.Offset)
'rom.WriteUInt32(&HFF00FFUI)
Return True
End Function
End Module