04-18-2025, 10:10 AM
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!
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