'        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

' 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

'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

' -------------------------

' 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

' --------------------------------------------

' 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

(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.