Posts: 513
Threads: 65
Joined: May 2022
Reputation:
83
01-19-2025, 03:13 PM
(This post was last modified: 01-19-2025, 03:16 PM by Petr.)
Some WAV formats use (but there are really very few of them) ADPCM compression. And since its implementation is not too complicated, I tried it. So what's the point here:
If you want to slightly reduce the sound in WAV format, you have these options:
1) Reduce the bit depth (so instead of a 32-bit WAV file you use an 8-bit one) - the sound is slightly worse, but on cheap speakers you won't notice the difference. But it's not Hi-fi anymore. The space saving is fourfold.
2) Use mono instead of stereo. You'll lose the sound depth. This will reduce the sound in WAV format by half.
3) Reduce the sound refresh rate - so instead of 44100 records per minute you'll use only 22050, or 11025. This is a drastic loss of sound samples and it's very audible. The ratio of the original and new sizes is given by the ratio of discarded samples (if you go from 44100 to 22050, you get half the size, etc.)
4) You use a better form of data recording with minimal signal difference.
This is an example. ADPCM simply calculates the difference between two consecutive samples and records only this difference. The step it uses to do this is divided into 8 levels (because an 8-bit signal has 256 levels and ADPCM uses 4-bit notation to save space). The maximum value with a sign of 8 can fit into a 4-bit notation (one bit indicates whether it is a positive or negative value). In this way, sound can be stored with minimal loss of quality in half the file size. This compression cause small noise in signal.
The first example shows a function on an array of numbers and does not require any music file:
Code: (Select All)
' ADPCM compression and decompression in QB64
' ----------------------------------------------------------
' This example uses 4-bit quantization for ADPCM compression
Dim originalSamples(0 To 9) As Single
Dim compressedData(0 To 9) As Integer
Dim decompressedSamples(0 To 9) As Single
'Original signal values
originalSamples(0) = 0
originalSamples(1) = 10
originalSamples(2) = 20
originalSamples(3) = 35
originalSamples(4) = 25
originalSamples(5) = 10
originalSamples(6) = 25
originalSamples(7) = 15
originalSamples(8) = 5
originalSamples(9) = 0
Print "Original Values:"
For i = 0 To 9
Print Using "###.##"; originalSamples(i);
Next
Print
' Compression (ADPCM)
Dim predicted As Single
Dim difference As Single
predicted = 0 ' first prediction
For i = 0 To 9
difference = originalSamples(i) - predicted
compressedData(i) = Quantize(difference) ' Kvantování rozdílu
predicted = predicted + Dequantize(compressedData(i)) ' Aktualizace predikce
Next
Print "Compressed Data (4 bite): "
For i = 0 To 9
Print compressedData(i);
Next
Print
' Decompressing process
predicted = 0 ' First prediciton
For i = 0 To 9
decompressedSamples(i) = predicted + Dequantize(compressedData(i))
predicted = decompressedSamples(i)
Next
Print "Decompressed Samples:"
For i = 0 To 9
Print Using "###.##"; decompressedSamples(i);
Next
End
' Difference quantization function
Function Quantize (difference As Single)
Q = Int(difference / 5) ' Quentization step 5
If Q > 7 Then Q = 7 ' limit to 4 bite
If Q < -8 Then Q = -8
Quantize = Q
End Function
' Difference dequantization function
Function Dequantize (quantizedDifference As Integer)
Dequantize = quantizedDifference * 5 ' The reverse process of quantization
End Function
The second example shows the use on real audio (change the MP3 to another MP3 in stereo on line 20)
The result is the sound so as it would sound if written in 4 bits. Note the small background noise, which is an quantization bug of the original, because this program does not have floating compression.
This program actually saves an 8 bit stereo WAV file with the original sample rate, but in 4 bits. In this case only to memory, it does not save anything to the hard disk.
Code: (Select All)
' ADPCM compression and decompression in QB64 for an 8-bit audio signal
' -----------------------------------
' This example uses 4-bit quantization for ADPCM compression of an audio signal in the range 0 to 255.
_Title "ADPCM compression in QB4PE"
Screen _NewImage(100, 24, 0)
Dim originalSamplesL(0 To 9) As Integer
Dim compressedDataL(0 To 9) As Integer
Dim decompressedSamplesL(0 To 9) As Integer
Dim originalSamplesR(0 To 9) As Integer
Dim compressedDataR(0 To 9) As Integer
Dim decompressedSamplesR(0 To 9) As Integer
Dim m As _MEM, Snd As Long
Snd = _SndOpen("A.mp3")
m = _MemSound(Snd, 0)
Locate 1
Do Until a& >= m.SIZE
j = 0
'load music samples
For i = 0 To 9
originalSamplesL(i) = 128 + (_MemGet(m, m.OFFSET + a&, Single) * 127)
originalSamplesR(i) = 128 + (_MemGet(m, m.OFFSET + a& + 4, Single) * 127)
a& = a& + 8
If a& >= m.SIZE Then Exit Do
Next i
' Compression (ADPCM)
ReDim predicted As Single
ReDim difference As Single
predictedL = 128
predictedR = 128 ' Initial assumption (mean value for 8-bit range)
For i = 0 To 9
differenceL = originalSamplesL(i) - predictedL
differenceR = originalSamplesR(i) - predictedR
compressedDataL(i) = Quantize(differenceL) ' Difference quantization
compressedDataR(i) = Quantize(differenceR)
predictedL = predictedL + Dequantize(compressedDataL(i)) ' Update prediction
predictedR = predictedR + Dequantize(compressedDataR(i)) ' Update prediction
'Range verification for prediction
If predictedL < 0 Then predictedL = 0
If predictedL > 255 Then predictedL = 255
If predictedR < 0 Then predictedR = 0
If predictedR > 255 Then predictedR = 255
Next
Print
Print "Original sound samples (0-255) (Left):"
For i = 0 To 9
Print Using "####"; originalSamplesL(i);
Next
Print
Print "Original sound samples (0-255) (Right):"
For i = 0 To 9
Print Using "####"; originalSamplesR(i);
Next
Print
Print "Compressed data (4bite):"
For i = 0 To 9
Print compressedDataL(i);
Print compressedDataR(i);
Next
Print
' Decompresing process
predictedL = 128 'Initial assumption (mean value for 8-bit range)
predictedR = 128
For i = 0 To 9
decompressedSamplesL(i) = predictedL + Dequantize(compressedDataL(i))
decompressedSamplesR(i) = predictedR + Dequantize(compressedDataR(i))
' Range verification for reconstructed samples
If decompressedSamplesL(i) < 0 Then decompressedSamplesL(i) = 0
If decompressedSamplesL(i) > 255 Then decompressedSamplesL(i) = 255
If decompressedSamplesR(i) < 0 Then decompressedSamplesR(i) = 0
If decompressedSamplesR(i) > 255 Then decompressedSamplesR(i) = 255
predictedL = decompressedSamplesL(i)
predictedR = decompressedSamplesR(i)
Next
Print
Print "Decompressed samples (0-255) Left:"
For i = 0 To 9
Print Using "####"; decompressedSamplesL(i);
Next
Print
Print "Decompressed samples (0-255) Right:"
For i = 0 To 9
Print Using "####"; decompressedSamplesR(i);
Next
For i = 0 To 9
L = (decompressedSamplesL(i) - 128) / 128
R = (decompressedSamplesR(i) - 128) / 128
_SndRaw L, R
Next i
Do Until _SndRawLen < .1
_Display
_Limit 20
Loop
Loop
End
' Difference quantization function
Function Quantize# (difference As Single)
Dim Q As Integer
Q = Int(difference / 8) ' Quantization step 8 for 8-bit signal
If Q > 7 Then Q = 7 ' limit to 4 bites
If Q < -8 Then Q = -8
Quantize# = Q
End Function
' Function for dequantizing the difference
Function Dequantize (quantizedDifference As Integer)
Dequantize = quantizedDifference * 8 ' The reverse process of quantization
End Function
Posts: 513
Threads: 65
Joined: May 2022
Reputation:
83
16 bit version - trying ADPCM Microsoft standard...
You would certainly be interested in how 16-bit sound would sound if it were compressed by ADPCM and then decompressed. This program will show you exactly this. How it works. Indeed, the differences between signal samples are also written using 4 bits in this case. But how is that possible, you ask yourself. After all, with normal linear stepping it would be jumping in the signal by a huge 32767 /15 (2184) levels in the signal! That would ruin the sound terribly!
Well, for this purpose Microsoft has developed a table (StepTable) that has 88 steps. The program simply jumps in these 88 positions to the nearest similar step value, which is listed in the table. The maximum jump size in the table is currently limited to 15 bits, in this case one bit is no longer used to determine the sign. Values 0–7 indicate the negative direction (delta 0–7). Values 8–15 indicate the positive direction (delta 0–7). This approach causes the sound to be not completely clean, however the resulting file should be 4x smaller in size than a normal 16bite wav file with similar quality. It is possible (almost certain) that the algorithm can be improved somehow...
Rename MP3 - row 44
Code: (Select All)
'ADPCM - downsize 16bit file 4x
' Original signal array (16bite value, -32768 to 32767)
Dim originalSignalL(0 To 255) As Integer
Dim originalSignalR(0 To 255) As Integer
' ADPCM Microsoft Step Table
Dim stepTable(0 To 87) As Integer
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,1059,1164,1278,1403,1539,1687,1849
Data 2025,2217,2426,2653,2899,3166,3456,3769,4107,4471,4863,5285
Data 5737,6222,6741,7296,7889,8521,9195,9912,10674,11483,12341
Data 13250,14213,15231,16307,17444,18644,19909,21243,22648,24127
For i = 0 To 87
Read stepTable(i)
Next i
' Starting values for left and right channel
Dim stepIndexL As Integer, stepIndexR As Integer
Dim currentStepL As Integer, currentStepR As Integer
Dim predictedValueL As Integer, predictedValueR As Integer
stepIndexL = 0
stepIndexR = 0
currentStepL = stepTable(stepIndexL)
currentStepR = stepTable(stepIndexR)
predictedValueL = 0
predictedValueR = 0
' Output compressed data (4 bite to sample)
Dim compressedDataL(0 To 255) As Integer
Dim compressedDataR(0 To 255) As Integer
ReDim FullCompressedL(0) As Integer
ReDim FullCompressedR(0) As Integer
' Arry for decompressed values
Dim decompressedSignalL(0 To 255) As Integer
Dim decompressedSignalR(0 To 255) As Integer
' Load sound from file
Dim m As _MEM, Snd As Long
Snd = _SndOpen("n.mp3")
m = _MemSound(Snd, 0)
Dim a As Long
Do Until a& >= m.SIZE
' Load 256 samples into buffer
predictedValueL = 0
predictedValueR = 0
For i = 0 To 255
If a& >= m.SIZE Then Exit Do
originalSignalL(i) = _MemGet(m, m.OFFSET + a&, Single) * 32768
originalSignalR(i) = _MemGet(m, m.OFFSET + a& + 4, Single) * 32768
a& = a& + 8
Next i
' ADPCM compression for lft and right channel
For i = 1 To UBound(originalSignalL)
' left channel
diffL = originalSignalL(i) - predictedValueL
directionL = 0
If diffL >= 0 Then directionL = 1 Else diffL = -diffL
deltaL = diffL \ currentStepL
If deltaL > 7 Then deltaL = 7
compressedValueL = directionL * 8 + deltaL
compressedDataL(i - 1) = compressedValueL
stepChangeL = (deltaL + 0.5) * currentStepL
If directionL = 0 Then stepChangeL = -stepChangeL
predictedValueL = predictedValueL + stepChangeL
If predictedValueL > 32767 Then predictedValueL = 32767
If predictedValueL < -32768 Then predictedValueL = -32768
decompressedSignalL(i) = predictedValueL
stepIndexL = stepIndexL + deltaL - 4
If stepIndexL < 0 Then stepIndexL = 0
If stepIndexL > 87 Then stepIndexL = 87
currentStepL = stepTable(stepIndexL)
' right channel
diffR = originalSignalR(i) - predictedValueR
directionR = 0
If diffR >= 0 Then directionR = 1 Else diffR = -diffR
deltaR = diffR \ currentStepR
If deltaR > 7 Then deltaR = 7
compressedValueR = directionR * 8 + deltaR
compressedDataR(i - 1) = compressedValueR
stepChangeR = (deltaR + 0.5) * currentStepR
If directionR = 0 Then stepChangeR = -stepChangeR
predictedValueR = predictedValueR + stepChangeR
If predictedValueR > 32767 Then predictedValueR = 32767
If predictedValueR < -32768 Then predictedValueR = -32768
decompressedSignalR(i) = predictedValueR
stepIndexR = stepIndexR + deltaR - 4
If stepIndexR < 0 Then stepIndexR = 0
If stepIndexR > 87 Then stepIndexR = 87
currentStepR = stepTable(stepIndexR)
Print "Current compressed sample value: "; compressedDataR(i); compressedDataL(i); " "
If compresseddataR > 15 Or compressedDataL > 15 Then Print "Compression failure!" 'never printed!
Next i
ReDim signalL(0 To 512) As Integer
ReDim signalR(0 To 512) As Integer
' LowPassFilter decompressedSignalL(), signalL(), 10000, _SndRate
' LowPassFilter decompressedSignalR(), signalR(), 10000, _SndRate
'Play decompressed signal
For i = 0 To UBound(decompressedSignalL)
_SndRaw decompressedSignalL(i) / 32768, decompressedSignalR(i) / 32768
'_SndRaw signalL(i) / 32768, signalR(i) / 32768
Next i
Do Until _SndRawLen < .1
Loop
Loop
_MemFree m
_SndClose Snd
End
Sub LowPassFilter (inputSignal() As Integer, outputSignal() As Integer, cutoffFreq As Single, sampleRate As Single)
Dim kernel(0 To 31) As Single ' Filter coefficients (FIR Window, 32 samples)
Dim sum As Single
Dim normFactor As Single
Dim N As Integer
Dim halfN As Integer
N = UBound(kernel)
halfN = N \ 2
' Creating a low-pass filter (Hamming window)
For i = -halfN To halfN
If i = 0 Then
kernel(i + halfN) = 2 * cutoffFreq / sampleRate
Else
kernel(i + halfN) = Sin(2 * 3.14159 * cutoffFreq * i / sampleRate) / (3.14159 * i)
End If
kernel(i + halfN) = kernel(i + halfN) * (0.54 - 0.46 * Cos(2 * 3.14159 * (i + halfN) / N)) ' Hamming window
Next i
' Normalize kernel
For i = 0 To N
normFactor = normFactor + kernel(i)
Next i
For i = 0 To N
kernel(i) = kernel(i) / normFactor
Next i
' Apply filter to input signal
For i = 0 To UBound(inputSignal)
sum = 0
For j = 0 To N
If i - j >= 0 Then
sum = sum + inputSignal(i - j) * kernel(j)
End If
Next j
outputSignal(i) = Int(sum)
Next i
End Sub
Posts: 513
Threads: 65
Joined: May 2022
Reputation:
83
The previous examples are rather theoretical. Here is a practical example of compressing audio to WAV format (The _SndOpen function in QB64PE supports this format).
The attached program will take your MP3 file and save it as a compressed monophonic WAV file. It will also calculate the size in which this audio would be saved in uncompressed form and list both sizes for you.
change your mp3 file name on row 32!
Code: (Select All)
' -------------------------
' QB64PE IMA ADPCM
' -------------------------
_Title "IMA ADPCM"
' Microsoft WAV compression format
' Tables for IMA ADPCM
ReDim Shared IMA_StepTable(88) As Integer
ReDim Shared IMA_IndexTable(15) As Integer
Dim Shared debugOutput As String
' Shared string for debug output
' Initialize IMA ADPCM tables
IMA_InitTables
' Generate a simple sine wave signal (e.g., 249 samples)
Dim sampleRate As Long
sampleRate = 44100 ' Sampling rate
Dim frequency As Single
frequency = 440 ' Frequency in Hz (A4)
Dim duration As Single
duration = 30 ' Duration in seconds
Dim WavLeft(sampleRate * duration) As Integer
' Array for left-channel PCM samples
' Load raw audio data from "s.mp3" into WavLeft() for set time (in seconds) or -1 for whole track.
Print "Loading audio to RAM..."
GKS WavLeft(), "n.mp3", -1
' Predictor and index at the start of the block
Dim predRef As Long
Dim indexRef As Long
predRef = WavLeft(0)
indexRef = 0
Dim blockAlign As Long
blockAlign = 128 ' Block size in bytes
ReDim compressedData(31 * 44100) As _Unsigned _Byte
' Pre-allocate compressed data buffer
Dim totalSamples As Long
totalSamples = UBound(compressedData) + 1
' Total number of samples
Dim Shared As Long UncompressedSize, CompressedSize
' Shared variables to hold file sizes
' Convert PCM data to ADPCM
ConvertPCMToADPCM WavLeft(), blockAlign, compressedData(), totalSamples - 1
' Save to WAV file
OutFile$ = "ADPCM.Wav"
SaveIMAADPCMWavMono OutFile$, sampleRate, totalSamples, compressedData()
fff = FreeFile
Open OutFile$ For Binary As fff
CompressedSize = LOF(fff)
Close fff
_SndPlayFile OutFile$
Print "Saved as compressed wav file (mono): "; OutFile$
Print "File size as uncompressed wav file: "; UncompressedSize
Print "File size as compressed wav file: "; CompressedSize
Sub GKS (wavleft() As Integer, SourceFile As String, duration As Single)
' Load raw audio data as mono from SourceFile into array wavleft()
Dim m As _MEM
Dim s As Long
Dim k As Long
Dim i As Long
s = _SndOpen(SourceFile$)
_Delay .7
If duration < 1 Then duration = _SndLen(s)
ReDim wavleft(duration * _SndRate) As Integer
If s < 1 Then Print "Sound source file not found.": _SndClose s: End
UncompressedSize = UBound(wavleft) * 2
m = _MemSound(s, 0)
Do Until k& = _SndRate * duration * 8 ' mono
wavleft(i) = .5 * (32767 * _MemGet(m, m.OFFSET + k&, Single)) + .5 * (32767 * _MemGet(m, m.OFFSET + k& + 4, Single))
i = i + 1
k& = k& + 8
Loop
_MemFree m
_SndClose s
End Sub
' Encodes one ADPCM block with debug outputs
Sub EncodeBlockADPCM (samples() As Integer, startPos As Long, framesProcessed As Long, compressedBlock() As _Unsigned _Byte, predRef As Long, indexRef As Long)
Dim stepVal As Long, diff As Long, delta As Long, vpdiff As Long
Dim nibble As Long, writePos As Long
compressedBlock(0) = predRef And &HFF
compressedBlock(1) = (predRef \ 256) And &HFF
compressedBlock(2) = indexRef And &HFF
compressedBlock(3) = 0 ' Reserved byte
writePos = 4
' Compress samples
Dim i As Long
For i = 0 To framesProcessed - 1
' Check for buffer overflow
If startPos + i >= UBound(samples) + 1 Then Exit For
stepVal = IMA_StepTable(indexRef)
diff = samples(startPos + i) - predRef
delta = 0
If diff < 0 Then
nibble = 8 ' Set sign bit
diff = -diff
Else
nibble = 0
End If
If diff >= stepVal Then
nibble = nibble Or 4
diff = diff - stepVal
End If
If diff >= stepVal \ 2 Then
nibble = nibble Or 2
diff = diff - (stepVal \ 2)
End If
If diff >= stepVal \ 4 Then
nibble = nibble Or 1
End If
' Update predictor
vpdiff = stepVal \ 8
If (nibble And 4) <> 0 Then vpdiff = vpdiff + stepVal
If (nibble And 2) <> 0 Then vpdiff = vpdiff + (stepVal \ 2)
If (nibble And 1) <> 0 Then vpdiff = vpdiff + (stepVal \ 4)
If (nibble And 8) <> 0 Then
predRef = predRef - vpdiff
Else
predRef = predRef + vpdiff
End If
' Clamp predictor to valid range
If predRef > 32767 Then predRef = 32767
If predRef < -32768 Then predRef = -32768
' Update index
indexRef = indexRef + IMA_IndexTable(nibble And 7)
If indexRef < 0 Then indexRef = 0
If indexRef > 88 Then indexRef = 88
' Write nibble to output
If i Mod 2 = 0 Then
compressedBlock(writePos) = nibble And &HF
Else
compressedBlock(writePos) = compressedBlock(writePos) Or ((nibble And &HF) * 16)
writePos = writePos + 1
End If
' Ensure output buffer is not exceeded
If writePos > UBound(compressedBlock) Then Exit For
Next i
End Sub
' Initialize step and index tables for IMA ADPCM
Sub IMA_InitTables
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,1059,1164,1278,1403,1539,1687,1849
Data 2025,2217,2426,2653,2899,3166,3456,3769,4107,4471,4863,5285
Data 5737,6222,6741,7296,7889,8521,9195,9912,10674,11483,12341
Data 13250,14213,15231,16307,17444,18644,19909,21243,22648,24127
Dim i As Long
For i = 0 To 88
Read IMA_StepTable(i)
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
' Save mono ADPCM data as a WAV file
Sub SaveIMAADPCMWavMono (fname As String, sRate As Long, totalSamples As Long, cData() As _Unsigned _Byte)
Dim ff As Integer
ff = FreeFile
Open fname For Binary As #ff
' RIFF header
Dim riffID As String * 4
riffID = "RIFF"
Put #ff, , riffID
Dim fileSize As Long
fileSize = 4 + (8 + 20) + (8 + 4) + (8 + (UBound(cData) + 1))
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
Dim fmtSize As Long
fmtSize = 20
Put #ff, , fmtSize
Dim wFormatTag As Integer
wFormatTag = &H11 ' IMA (DVI) ADPCM
Put #ff, , wFormatTag
Dim nChannels As Integer
nChannels = 1 ' Mono
Put #ff, , nChannels
Dim nSamplesPerSec As Long
nSamplesPerSec = sRate
Put #ff, , nSamplesPerSec
' Average bytes per second estimate
Dim nAvgBytesPerSec As Long
nAvgBytesPerSec = sRate \ 2
Put #ff, , nAvgBytesPerSec
Dim blockAl As Integer
blockAl = 128
Put #ff, , blockAl
Dim wBitsPerSample As Integer
wBitsPerSample = 4
Put #ff, , wBitsPerSample
Dim cbSize As Integer
cbSize = 2
Put #ff, , cbSize
Dim nSamplesPerBlock As Integer
nSamplesPerBlock = 249
Put #ff, , nSamplesPerBlock
' fact chunk
Dim factID As String * 4
factID = "fact"
Put #ff, , factID
Dim factSize As Long
factSize = 4
Put #ff, , factSize
' Number of mono frames
Put #ff, , totalSamples
' data chunk
Dim dataID As String * 4
dataID = "data"
Put #ff, , dataID
Dim dataSize As Long
dataSize = UBound(cData) + 1
Put #ff, , dataSize
Put #ff, , cData()
Close #ff
End Sub
' Convert entire PCM array to ADPCM
Sub ConvertPCMToADPCM (wavLeft() As Integer, blockAlign As Long, compressedData() As _Unsigned _Byte, totalSamples As Long)
Dim totalSamplesLeft As Long
totalSamplesLeft = UBound(wavLeft) + 1
' Calculate samples per ADPCM block
Dim framesPerBlock As Long
framesPerBlock = (blockAlign - 4) * 2
Dim blockCount As Long
blockCount = (totalSamplesLeft + framesPerBlock - 1) \ framesPerBlock
Dim estSize As Long
estSize = blockCount * blockAlign
ReDim compressedData(estSize - 1) As _Unsigned _Byte
Dim predRefLng As Long
Dim indexRefLng As Long
predRefLng = wavLeft(0) ' First sample
indexRefLng = 0
Dim globalWritePos As Long
Dim blockStart As Long
Dim framesProcessed As Long
For blockStart = 0 To totalSamplesLeft - 1 Step framesPerBlock
If blockStart + framesPerBlock > totalSamplesLeft Then
framesProcessed = totalSamplesLeft - blockStart
Else
framesProcessed = framesPerBlock
End If
Dim blockBytes As _Unsigned _Byte
ReDim blockBytes(blockAlign - 1) As _Unsigned _Byte
' Encode one ADPCM block
EncodeBlockADPCM wavLeft(), blockStart, framesProcessed, blockBytes(), predRefLng, indexRefLng
' Copy compressed block to output buffer
Dim i As Long
For i = 0 To blockAlign - 1
compressedData(globalWritePos + i) = blockBytes(i)
Next i
globalWritePos = globalWritePos + blockAlign
Next blockStart
' Trim output buffer to actual size
ReDim _Preserve compressedData(globalWritePos - 1) As _Unsigned _Byte
totalSamples = totalSamplesLeft
End Sub
' Encode a single PCM sample to ADPCM nibble
Sub IMA_AdpcmEncodeSample (inSample As Long, predRef As Long, indexRef As Long, nibResult As Long)
Dim stepVal As Long
stepVal = IMA_StepTable(indexRef)
Dim diff As Long
diff = inSample - predRef
Dim signBit As _Unsigned _Byte
signBit = 0
If diff < 0 Then
signBit = 8 ' Set sign bit
diff = -diff
End If
Dim delta As Long
delta = 0
If diff >= stepVal Then
delta = delta + 4
diff = diff - stepVal
End If
If diff >= (stepVal \ 2) Then
delta = delta + 2
diff = diff - (stepVal \ 2)
End If
If diff >= (stepVal \ 4) Then
delta = delta + 1
End If
nibResult = delta Or signBit
Dim vpdiff2 As Long
vpdiff2 = (stepVal \ 8)
If delta >= 4 Then vpdiff2 = vpdiff2 + stepVal
If delta >= 2 Then vpdiff2 = vpdiff2 + (stepVal \ 2)
If delta >= 1 Then vpdiff2 = vpdiff2 + (stepVal \ 4)
If signBit <> 0 Then
predRef = predRef - vpdiff2
Else
predRef = predRef + vpdiff2
End If
If predRef > 32767 Then predRef = 32767
If predRef < -32768 Then predRef = -32768
End Sub
Posts: 1,215
Threads: 162
Joined: Apr 2022
Reputation:
34
04-18-2025, 12:49 PM
(This post was last modified: 04-18-2025, 12:50 PM by madscijr.)
This is really cool stuff @Petr!
I still haven't gotten around to making use of your AVI code (saving webcam video to a file) and now this!
One thing I want to do is make a simple recorder / overdub program, that plays a WAV file only in the left channel and lets the user record along with it in realtime from the line in, and writes the result to a new WAV file with old audio in left channel and new audio in the right, and lets the user "mix" the result by adjusting the left / right volume. Or better yet a simple 4-track recorder.
Another one would be a kind of "rap music generator" that takes text input, and records it with text to speech, and breaks down the syllables to match the rhythm of a given beat (where the user can choose between different time signatures and bpm, e.g., 4/4 at 120 bpm). I was even looking for of ways to assign musical notes or pitches to the voice so it could sing (which is why I started converting the old SAM software automated mouth which uses formative speech synthesis which can do pitch/singing, see my post on that).
Anyway, your WAV file code is neat, I'm looking forward to playing with it to generate sound effects and music in stereo in the future. Thanks for sharing.
Posts: 513
Threads: 65
Joined: May 2022
Reputation:
83
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.
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
Posts: 1,215
Threads: 162
Joined: Apr 2022
Reputation:
34
I am not familiar with ADPCM. Is that format preferable to MP3 (like, is there some weird licensing in place for MP3?) or other formats such as OGG?
Thanks for sharing this!
Posts: 513
Threads: 65
Joined: May 2022
Reputation:
83
@madscijr
MP3 is subject to a license. MP2 and MP1 have expired licenses, but there are tables that are part of the standards and still require payment. Although these values can be found on GitHub, I think it could be considered problematic content here, and I don't want to cause any issues. I haven’t worked on this yet anyway.
As for this format, it’s quite simple. Think of it this way: if you want to store audio in a video file (even in your own format, it doesn’t have to be just AVI), you need to synchronize the image and the sound. That’s why you need an encoder, so you can “cut” the audio data into parts that match the video frames. Then you have options: uncompressed WAV 8-bit, 16-bit, 24-bit, 32-bit, mono or stereo, and you can set the bitrate. But the resulting audio files are gigantic, even though compared to video files they’re still tiny.
For audio in video, you have the option of MP2 (ideally inspired by the C parser from GitHub). No one has written this in BASIC, and as far as I know, OGG doesn’t work well with AVI.
Posts: 243
Threads: 15
Joined: Apr 2024
Reputation:
30
(11-19-2025, 08:55 PM)Petr Wrote: @madscijr
MP3 is subject to a license. MP2 and MP1 have expired licenses, but there are tables that are part of the standards and still require payment. Although these values can be found on GitHub, I think it could be considered problematic content here, and I don't want to cause any issues. I haven’t worked on this yet anyway.
As for this format, it’s quite simple. Think of it this way: if you want to store audio in a video file (even in your own format, it doesn’t have to be just AVI), you need to synchronize the image and the sound. That’s why you need an encoder, so you can “cut” the audio data into parts that match the video frames. Then you have options: uncompressed WAV 8-bit, 16-bit, 24-bit, 32-bit, mono or stereo, and you can set the bitrate. But the resulting audio files are gigantic, even though compared to video files they’re still tiny.
For audio in video, you have the option of MP2 (ideally inspired by the C parser from GitHub). No one has written this in BASIC, and as far as I know, OGG doesn’t work well with AVI.
Ahh Petr The U.S. Patents on mp3 expired in 2017, The European patents some time before that.
I don't know how anyone could still be collecting licensing fees for mp3 anymore !
Posts: 513
Threads: 65
Joined: May 2022
Reputation:
83
@ahenry3068
I don't know. So I have bad information? It's possible. According to Google, you're right. In that case, I'll look into it.
|
