11-19-2025, 06:25 PM
So, I finally managed to fix the encoder for ADPCM WAV 16-bit stereo.
The program loads an MP3 file, converts it and compresses it into ADPCM WAV format (IMA ADPCM, stereo), and then plays it using _SndPlay, since this format is also supported in QB64PE.
The resulting compressed WAV file is usually about 3× larger than the original MP3, but around 4.5× smaller than an uncompressed 16-bit stereo WAV at the same sample rate.
This audio format (as well as the mono version from the previous post) is supported in AVI containers as audio tracks.
Some slight to moderate distortion may be noticeable, since this is a lossy compression format.
Don't forget to change the name of the MP3 file on line 22. The audio must be in MP3 format, the program expects this.
The program loads an MP3 file, converts it and compresses it into ADPCM WAV format (IMA ADPCM, stereo), and then plays it using _SndPlay, since this format is also supported in QB64PE.
The resulting compressed WAV file is usually about 3× larger than the original MP3, but around 4.5× smaller than an uncompressed 16-bit stereo WAV at the same sample rate.
This audio format (as well as the mono version from the previous post) is supported in AVI containers as audio tracks.
Some slight to moderate distortion may be noticeable, since this is a lossy compression format.
Don't forget to change the name of the MP3 file on line 22. The audio must be in MP3 format, the program expects this.
Code: (Select All)
' --------------------------------------------
' QB64PE IMA ADPCM Stereo (4-bit, 2 channels) done after 9 months. Some bugs!!!
' --------------------------------------------
_Title "IMA ADPCM Stereo"
ReDim Shared IMA_StepTable(88) As Integer
ReDim Shared IMA_IndexTable(15) As Integer
IMA_InitTables
' ----------------
' Parametry
' ----------------
Dim sampleRate As Long: sampleRate = 44100
Dim duration As Single: duration = 30
' PCM buffery (16bit signed)
Dim WavLeft(sampleRate * duration) As Integer
Dim WavRight(sampleRate * duration) As Integer
Print "Loading stereo audio to RAM..." ' --------------------------------------------------------------------------
GKS_Stereo WavLeft(), WavRight(), "a.mp3", -1 ' <- here must be mp3 file because is internaly loaded do MEM as 4byte record
' --------------------------------------------------------------------------
Dim totalFrames As Long
totalFrames = UBound(WavLeft) + 1
' ----------------
' ADPCM block
' ----------------
Dim blockAlign As Integer
blockAlign = 256 'block size in bytes
Dim framesPerBlock As Long
framesPerBlock = blockAlign - 7 ' MS IMA ADPCM stereo specification
Dim compressedData As _Unsigned _Byte
ReDim compressedData(0) As _Unsigned _Byte
ConvertPCMToADPCMStereo WavLeft(), WavRight(), blockAlign, framesPerBlock, compressedData(), totalFrames
' ------------------------------------------------
' Save stereo ADPCM compressed WAV file (finally!)
' ------------------------------------------------
Dim OutFile As String
OutFile = "ADPCM_Stereo.wav"
If _FileExists(OutFile) Then Kill OutFile
SaveIMAADPCMWavStereo OutFile, sampleRate, totalFrames, blockAlign, framesPerBlock, compressedData()
ff = FreeFile
Dim FileSize As Long
Open OutFile For Binary As ff
FileSize = LOF(ff)
Close ff
snd = _SndOpen(OutFile)
SndLen = _SndLen(snd)
Print "Saved stereo ADPCM WAV: "; OutFile
Print "File sizes:"
Print "Created ADPCM (compressed) stereo wav, 16bit,"; _SndRate; ":"; FileSize
Dim CalcSize As Long
CalcSize = 44 + 2 * _SndRate * SndLen * 2 '44 = header, 2 byte / sample, soundrate typical 44100 and channels: 2
Print "Calculated uncompressed wav (16 bit, stereo) size: "; CalcSize
Print "Track lenght:"; SndLen; " (seconds)"
_SndPlay snd
End
'===========================================================
' Load PCM audio data from file (float -> 16bit PCM)
'===========================================================
Sub GKS_Stereo (wavL() As Integer, wavR() As Integer, SourceFile As String, duration As Single)
Dim m As _MEM, s As Long, i As Long, k As Long
s = _SndOpen(SourceFile)
_Delay .7
If s < 1 Then Print "Sound source file not found.": End
If duration < 1 Then duration = _SndLen(s)
ReDim wavL(duration * _SndRate) As Integer
ReDim wavR(duration * _SndRate) As Integer
m = _MemSound(s, 0)
Do Until k& >= _SndRate * duration * 8 - 8
wavL(i) = 32767 * _MemGet(m, m.OFFSET + k&, Single)
wavR(i) = 32767 * _MemGet(m, m.OFFSET + k& + 4, Single)
i = i + 1
k& = k& + 8
Loop
'truncation to actual number
If i > 0 Then
ReDim _Preserve wavL(i - 1) As Integer
ReDim _Preserve wavR(i - 1) As Integer
End If
_MemFree m
_SndClose s
End Sub
'===========================================================
' convert stereo PCM -> IMA ADPCM (Microsoft stereo layout)
'===========================================================
Sub ConvertPCMToADPCMStereo(wavL() As Integer, wavR() As Integer, _
blockAlign As Integer, framesPerBlock As Long, _
outData() As _Unsigned _Byte, totalFrames As Long)
Dim samplesPerBlock As Long
samplesPerBlock = framesPerBlock ' = blockAlign - 7
Dim blockCount As Long
blockCount = (totalFrames + samplesPerBlock - 1) \ samplesPerBlock
Dim outSize As Long
outSize = blockCount * blockAlign
ReDim outData(outSize - 1) As _Unsigned _Byte
Dim writePos As Long
writePos = 0
Dim b As Long
For b = 0 To blockCount - 1
Dim startS As Long
startS = b * samplesPerBlock
Dim count As Long
count = samplesPerBlock
If startS + count > totalFrames Then
count = totalFrames - startS
If count <= 0 Then Exit For
End If
Dim block As _Unsigned _Byte
ReDim block(blockAlign - 1) As _Unsigned _Byte ' defaultně nulová vyplň
'----- channels headers --------
Dim predL As Long, predR As Long
Dim idxL As Long, idxR As Long
predL = wavL(startS)
predR = wavR(startS)
idxL = 0
idxR = 0
' Left header
block(0) = predL And &HFF
block(1) = (predL \ 256) And &HFF
block(2) = idxL And &HFF
block(3) = 0
' Right header
block(4) = predR And &HFF
block(5) = (predR \ 256) And &HFF
block(6) = idxR And &HFF
block(7) = 0
' ---- DATA: interleaving after 4 bytes (8 samples) L/R ----
Dim poss As Long
poss = 8
Dim posL As Long, posR As Long
Dim nRemL As Long, nRemR As Long
Dim iL As Long, iR As Long
iL = 1: iR = 1
nRemL = count - 1
nRemR = count - 1
Dim j As Long
Dim s1L As Integer, s2L As Integer
Dim s1R As Integer, s2R As Integer
Dim nib1 As _Unsigned _Byte, nib2 As _Unsigned _Byte
Do While nRemL > 0 Or nRemR > 0
' 4 byte LEFT
For j = 0 To 3
If nRemL <= 0 Then Exit For
s1L = wavL(startS + iL)
iL = iL + 1
nRemL = nRemL - 1
If nRemL > 0 Then
s2L = wavL(startS + iL)
iL = iL + 1
nRemL = nRemL - 1
Else
s2L = s1L
End If
EncodeNibble s1L, predL, idxL, nib1
EncodeNibble s2L, predL, idxL, nib2
block(poss) = (nib2 * 16) Or (nib1 And &HF)
poss = poss + 1
Next j
' 4 byte RIGHT
For j = 0 To 3
If nRemR <= 0 Then Exit For
s1R = wavR(startS + iR)
iR = iR + 1
nRemR = nRemR - 1
If nRemR > 0 Then
s2R = wavR(startS + iR)
iR = iR + 1
nRemR = nRemR - 1
Else
s2R = s1R
End If
EncodeNibble s1R, predR, idxR, nib1
EncodeNibble s2R, predR, idxR, nib2
block(poss) = (nib2 * 16) Or (nib1 And &HF)
poss = poss + 1
Next j
Loop
' block to output
Dim k As Long
For k = 0 To blockAlign - 1
outData(writePos + k) = block(k)
Next k
writePos = writePos + blockAlign
Next b
ReDim _Preserve outData(writePos - 1) As _Unsigned _Byte
End Sub
'===========================================================
' IMA ADPCM nibble encoder (standard Intel/Microsoft)
'===========================================================
Sub EncodeNibble (inS As Integer, pred As Long, idx As Long, nib As _Unsigned _Byte)
Dim stepVal As Long
Dim diff As Long
Dim vpdiff As Long
stepVal = IMA_StepTable(idx)
diff = inS - pred
nib = 0
If diff < 0 Then
nib = nib Or 8
diff = -diff
End If
If diff >= stepVal Then
nib = nib Or 4
diff = diff - stepVal
End If
If diff >= stepVal \ 2 Then
nib = nib Or 2
diff = diff - (stepVal \ 2)
End If
If diff >= stepVal \ 4 Then
nib = nib Or 1
End If
vpdiff = stepVal \ 8
If (nib And 4) <> 0 Then vpdiff = vpdiff + stepVal
If (nib And 2) <> 0 Then vpdiff = vpdiff + (stepVal \ 2)
If (nib And 1) <> 0 Then vpdiff = vpdiff + (stepVal \ 4)
If (nib And 8) <> 0 Then
pred = pred - vpdiff
Else
pred = pred + vpdiff
End If
If pred > 32767 Then pred = 32767
If pred < -32768 Then pred = -32768
idx = idx + IMA_IndexTable(nib And 7)
If idx < 0 Then idx = 0
If idx > 88 Then idx = 88
End Sub
'===========================================================
' Save as Microsoft IMA ADPCM WAV (stereo)
'===========================================================
Sub SaveIMAADPCMWavStereo (fname As String, sRate As Long, totalFrames As Long, blockAlign As Integer, framesPerBlock As Long, cData() As _Unsigned _Byte)
Dim ff As Integer
ff = FreeFile
Open fname For Binary As #ff
Dim riffID As String * 4: riffID = "RIFF": Put #ff, , riffID
Dim fmtSize As Long: fmtSize = 20
Dim factSize As Long: factSize = 4
Dim dataSize As Long: dataSize = UBound(cData) + 1
Dim fileSize As Long
fileSize = 4 + (8 + fmtSize) + (8 + factSize) + (8 + dataSize)
Put #ff, , fileSize
Dim waveID As String * 4: waveID = "WAVE": Put #ff, , waveID
' fmt chunk
Dim fmtID As String * 4: fmtID = "fmt ": Put #ff, , fmtID
Put #ff, , fmtSize
Dim wFormatTag As Integer: wFormatTag = &H11: Put #ff, , wFormatTag
Dim nChannels As Integer: nChannels = 2: Put #ff, , nChannels
Dim nSamplesPerSec As Long: nSamplesPerSec = sRate: Put #ff, , nSamplesPerSec
Dim nAvgBytesPerSec As Long
nAvgBytesPerSec = (sRate * blockAlign) \ framesPerBlock
Put #ff, , nAvgBytesPerSec
Dim wBlockAlign As Integer: wBlockAlign = blockAlign: Put #ff, , wBlockAlign
Dim wBitsPerSample As Integer: wBitsPerSample = 4: Put #ff, , wBitsPerSample
Dim cbSize As Integer: cbSize = 2: Put #ff, , cbSize
Dim wSamplesPerBlock As Integer: wSamplesPerBlock = framesPerBlock
Put #ff, , wSamplesPerBlock
' fact chunk
Dim factID As String * 4: factID = "fact": Put #ff, , factID
Put #ff, , factSize
Put #ff, , totalFrames
' data chunk
Dim dataID As String * 4: dataID = "data": Put #ff, , dataID
Put #ff, , dataSize
Put #ff, , cData()
Close #ff
End Sub
'===========================================================
' IMA tables inits (standard table)
'===========================================================
Sub IMA_InitTables
Dim i As Integer, R As Long
' standard IMA ADPCM step table (0..88)
Data 7,8,9,10,11,12,13,14,16,17,19,21,23,25,28,31
Data 34,37,41,45,50,55,60,66,73,80,88,97,107,118,130,143
Data 157,173,190,209,230,253,279,307,337,371,408,449,494,544
Data 598,658,724,796,876,963,1060,1166,1282,1411,1552,1707,1878,2066
Data 2272,2499,2749,3024,3327,3660,4026,4428,4871,5358,5894,6484,7132
Data 7845,8630,9493,10442,11487,12635,13899,15289,16818,18500,20350
Data 22385,24623,27086,29794,32767
For i = 0 To 88
Read R
IMA_StepTable(i) = R
Next i
IMA_IndexTable(0) = -1
IMA_IndexTable(1) = -1
IMA_IndexTable(2) = -1
IMA_IndexTable(3) = -1
IMA_IndexTable(4) = 2
IMA_IndexTable(5) = 4
IMA_IndexTable(6) = 6
IMA_IndexTable(7) = 8
IMA_IndexTable(8) = -1
IMA_IndexTable(9) = -1
IMA_IndexTable(10) = -1
IMA_IndexTable(11) = -1
IMA_IndexTable(12) = 2
IMA_IndexTable(13) = 4
IMA_IndexTable(14) = 6
IMA_IndexTable(15) = 8
End Sub