QB64 Phoenix Edition
MUSIC: Echo Player - Printable Version

+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Prolific Programmers (https://staging.qb64phoenix.com/forumdisplay.php?fid=26)
+---- Forum: Petr (https://staging.qb64phoenix.com/forumdisplay.php?fid=52)
+---- Thread: MUSIC: Echo Player (/showthread.php?tid=1484)

MUSIC: Echo Player - Petr - 02-19-2023

NOTE! This program is created to QB64 2.02 (and older, Phoenix version comming soon!)


Compile this program in its own folder (maybe call it echo test, it doesn't matter) and then copy some music files into that folder. The program is built on an older version of QB64, so it only supports MP3, OGG and WAV formats (you can add the other formats there on line 36 in the source code, but it is not tested with it. The program will play music files in the folder with an echo effect after running. The attached direntry.h file is needed for the function.

Code: (Select All)
'Program create new WAV soundtrack + add echo

_Title "Petr's echo player"


EchoLenght = 0.12 '0.12 seconds is echo duration
OverSampling = 10 'number of echoes sample passes

Echo& = _SndRate * EchoLenght
'to create an echo effect you need to repeat a couple of sound samples - it's the same as playing the same song twice in quick succession,
'the sound samples are also mixed. This is the principle of the function of this program.
'the number of samples to be repeated indicates the length of the echo. For 25 milliseconds, that's 25 * 441 samples.

Do Until Echo& Mod 2 = 0
    Echo& = Echo& + 1
Loop
Dim Left As _MEM, Right As _MEM, NewSound As _MEM, Audio As Integer, Audio2 As Integer, Audio3 As Integer, Audio4 As Integer
ReDim PlayableFiles(0) As String 'for music files list


'INPUT "Insert audio file name:"; a1$

Declare CustomType Library ".\direntry" 'need file direntry.h, available in SMcNeill's libraries
    Function load_dir& (s As String)
    Function has_next_entry& ()
    Sub close_dir ()
    Sub get_next_entry (s As String, flags As Long, file_size As Long)
End Declare

ReDim Dir(0) As String, File(0) As String
GetFileList _CWD$, Dir(), File() 'load files in current directory


For s = LBound(file) To UBound(file)
    Select Case UCase$(Right$(File(s), 3))
        Case "MP3", "OGG", "WAV" 'available music formats under QB64 2.02
            PlayableFiles(i) = File(s)
            i = i + 1
            ReDim _Preserve PlayableFiles(i) As String
    End Select
Next

Print "Files to play: "; i


For playit = 0 To i - 1 'play all music files (MP3, OGG, WAV) in current directory (this file list is created using direntry.h)
    a1$ = PlayableFiles(playit)
    Print "Opening file "; playit + 1; "/"; i; " - "; PlayableFiles(playit)
    If a Then _SndClose a
    a = _SndOpen(a1$)
    If a Then Print "Audio file opened" Else Print "Audio file "; a1$; " opening error.": End
    LENa = _Ceil(_SndLen(a) + EchoLenght)
    Print "Audio file lenght:"; LENa; "[sec]"
    NewTrackTime = LENa

    Left = _MemSound(a, 1)
    Right = _MemSound(a, 2)

    NewSoundSize& = _SndRate * NewTrackTime * 2 * 2 'use stereo  + use INTEGER
    NewSound = _MemNew(NewSoundSize&)

    Print "SndRate:"; _SndRate
    Print "Track memory len:"; Left.SIZE
    Print "Creating audio..."

    VolDown = 1 / OverSampling
    Create& = 0
    NewAudio& = 0
    Do Until Create& >= Left.SIZE - 2
        _MemGet Left, Left.OFFSET + Create&, Audio
        _MemGet Right, Right.OFFSET + Create&, Audio2

        If Create& > Echo& Then

            E& = Create&
            Vol = 1
            Do Until E& <= Create& - OverSampling
                Vol = Vol - VolDown
                _MemGet Left, Left.OFFSET + Create& - Echo&, Audio3
                _MemGet Left, Left.OFFSET + Create& - 2, Audio4
                Audio = (Audio + Audio3 * (Vol + .01) + Audio4 * Vol) \ 3
                E& = E& - 2
            Loop

            E& = Create&
            Vol = 1
            Do Until E& <= Create& - OverSampling
                Vol = Vol - VolDown
                _MemGet Right, Right.OFFSET + Create& - Echo&, Audio3
                _MemGet Right, Right.OFFSET + Create& - 2, Audio4
                Audio2 = (Audio2 + Audio3 * (Vol + .01) + Audio4 * Vol) \ 3
                E& = E& - 2
            Loop
        End If

        _MemPut NewSound, NewSound.OFFSET + NewAudio&, Audio 'left channel
        _MemPut NewSound, NewSound.OFFSET + NewAudio& + 2, Audio2 'right channel
        NewAudio& = NewAudio& + 4
        Create& = Create& + 2
    Loop

    Print "New sound created. Saving as Tracks-mix4.wav..."
    SAVESOUND16S NewSound, "Tracks-mix4.wav"
    Print "Sound saved, erasing RAM..."
    _MemFree Left
    _MemFree Right
    _MemFree NewSound

    Print "Playing mixed sound"
    snd = _SndOpen("tracks-mix4.wav")
    _SndPlay snd
    Do Until _SndPlaying(snd) = 0
        Locate 12
        Print "Time: "; Int(_SndGetPos(snd)); "[sec]     "
    Loop
    Cls
    _SndClose snd
    Kill "tracks-mix4.wav"
Next
End


Function ConvertOffset&& (value As _Offset)
    $Checking:Off
    Dim m As _MEM 'Define a memblock
    m = _Mem(value) 'Point it to use value
    $If 64BIT Then
        'On 64 bit OSes, an OFFSET is 8 bytes in size.  We can put it directly into an Integer64
        _MEMGET m, m.OFFSET, ConvertOffset&& 'Get the contents of the memblock and put the values there directly into ConvertOffset&&
    $Else
        'However, on 32 bit OSes, an OFFSET is only 4 bytes.  We need to put it into a LONG variable first
        _MemGet m, m.OFFSET, temp& 'Like this
        ConvertOffset&& = temp& 'And then assign that long value to ConvertOffset&&
    $End If
    _MemFree m 'Free the memblock
    $Checking:On
End Function



Sub SAVESOUND16S (arr As _MEM, file As String)

    Type head16
        chunk As String * 4 '       4 bytes  (RIFF)
        size As Long '              4 bytes  (file size)
        fomat As String * 4 '       4 bytes  (WAVE)
        sub1 As String * 4 '        4 bytes  (fmt )
        subchunksize As Long '      4 bytes  (lo / hi), $00000010 for PCM audio
        format As Integer '         2 bytes  (0001 = standard PCM, 0101 = IBM mu-law, 0102 = IBM a-law, 0103 = IBM AVC ADPCM)
        channels As Integer '       2 bytes  (1 = mono, 2 = stereo)
        rate As Long '              4 bytes  (sample rate, standard is 44100)
        ByteRate As Long '          4 bytes  (= sample rate * number of channels * (bits per channel /8))
        Block As Integer '          2 bytes  (block align = number of channels * bits per sample /8)
        Bits As Integer '           2 bytes  (bits per sample. 8 = 8, 16 = 16)
        subchunk2 As String * 4 '   4 bytes  ("data")  contains begin audio samples
        lenght As Long '            4 bytes  Data block size
    End Type '                     44 bytes  total
    Dim H16 As head16
    ch = FreeFile

    H16.chunk = "RIFF"
    H16.size = 44 + ConvertOffset(arr.SIZE)

    H16.fomat = "WAVE"
    H16.sub1 = "fmt "
    H16.subchunksize = 16
    H16.format = 1
    H16.channels = 2
    H16.rate = 44100
    H16.ByteRate = 44100 * 2 * 16 / 8
    H16.Block = 4
    H16.Bits = 16
    H16.subchunk2 = "data"
    H16.lenght = ConvertOffset(arr.SIZE)
    If _FileExists(file$) Then Kill file$

    Audio$ = Space$(ConvertOffset(arr.SIZE))
    _MemGet arr, arr.OFFSET, Audio$

    Open file$ For Binary As #ch
    Put #ch, , H16
    Put #ch, , Audio$
    Audio$ = ""

    Close ch
End Sub

Sub GetFileList (SearchDirectory As String, DirList() As String, FileList() As String)
    Const IS_DIR = 1
    Const IS_FILE = 2
    Dim flags As Long, file_size As Long

    ReDim _Preserve DirList(100), FileList(100)
    DirCount = 0: FileCount = 0

    If load_dir(SearchDirectory) Then
        Do
            length = has_next_entry
            If length > -1 Then
                nam$ = Space$(length)
                get_next_entry nam$, flags, file_size
                If (flags And IS_DIR) Or _DirExists(SearchDirectory + nam$) Then
                    DirCount = DirCount + 1
                    If DirCount > UBound(DirList) Then ReDim _Preserve DirList(UBound(DirList) + 100)
                    DirList(DirCount) = nam$
                ElseIf (flags And IS_FILE) Or _FileExists(SearchDirectory + nam$) Then
                    FileCount = FileCount + 1
                    If FileCount > UBound(filelist) Then ReDim _Preserve FileList(UBound(filelist) + 100)
                    FileList(FileCount) = nam$
                End If
            End If
        Loop Until length = -1
        close_dir
    Else
    End If
    ReDim _Preserve DirList(DirCount)
    ReDim _Preserve FileList(FileCount)
End Sub


RE: MUSIC: Echo Player - mnrvovrfc - 02-19-2023

Congratulations on being made "mini-mod"! You seem to have a lot of ideas on one of the fields I'm interested in.

RE: MUSIC: Echo Player - Petr - 02-21-2023

As is promised. I thought about how to make my work as easy as possible (Phoenix is about 10 generations ahead of the QB64 2.02 in which I wrote the program above) and so....because I'm really lazy....I wrote a subroutine with the name BackCompatibility. And it is done. I just take the MemSound output from Phoenix and convert it to QB64 2.02 compatible 16 bit output. And the rest of the program will be the same, right! And it works, it's already humming behind my back, I'm doing disco again.

So, here in the retro version, when SNDRAW was still in its infancy and I had to work around it... you can try that too. For the function, as I wrote above, you need an H file, compile the program in a new folder and add a couple of music files to that folder.


Code: (Select All)
'Program plays files in directory with echo effect, PHOENIX COMPATIBLE NOW!

_Title "Petr's echo player"


EchoLenght = 0.12 '0.12 seconds is echo duration
OverSampling = 10 'number of echoes sample passes

Echo& = _SndRate * EchoLenght
'to create an echo effect you need to repeat a couple of sound samples - it's the same as playing the same song twice in quick succession,
'the sound samples are also mixed. This is the principle of the function of this program.
'the number of samples to be repeated indicates the length of the echo. For 25 milliseconds, that's 25 * 441 samples.

Do Until Echo& Mod 2 = 0
    Echo& = Echo& + 1
Loop
Dim Left As _MEM, Right As _MEM, Original As _MEM, NewSound As _MEM, Audio As Integer, Audio2 As Integer, Audio3 As Integer, Audio4 As Integer
ReDim PlayableFiles(0) As String 'for music files list


'INPUT "Insert audio file name:"; a1$

Declare CustomType Library ".\direntry" 'need file direntry.h, available in SMcNeill's libraries
    Function load_dir& (s As String)
    Function has_next_entry& ()
    Sub close_dir ()
    Sub get_next_entry (s As String, flags As Long, file_size As Long)
End Declare

ReDim Dir(0) As String, File(0) As String
GetFileList _CWD$, Dir(), File() 'load files in current directory


For s = LBound(File) To UBound(File)
    Select Case UCase$(Right$(File(s), 3))
        Case "MP3", "OGG", "WAV", "S3M", "XM", "MOD", "IT" 'available music formats under QB64 Phoenix 3.5.0
            PlayableFiles(i) = File(s)
            i = i + 1
            ReDim _Preserve PlayableFiles(i) As String
    End Select
Next



Print "Files to play: "; i
For playit = 0 To i - 1 'play all music files (MP3, OGG, WAV) in current directory (this file list is created using direntry.h)
    a1$ = PlayableFiles(playit)
    Print "Opening file "; playit + 1; "/"; i; " - "; PlayableFiles(playit)
    If A Then _SndClose A
    A = _SndOpen(a1$)
    If A Then Print "Audio file opened" Else Print "Audio file "; a1$; " opening error.": End
    LENa = _Ceil(_SndLen(A) + EchoLenght)
    Print "Audio file lenght:"; LENa; "[sec]"
    NewTrackTime = LENa
    Original = _MemSound(A, 0)

    BackCompatible Original, Left, Right 'all sound formats return back as 16 bit stereo (so LEFT and RIGHT MEMs are back compatible with QB64 2.02!

    _MemFree Original

    ' Left = _MemSound(a, 1)
    ' Right = _MemSound(a, 2)

    NewSoundSize& = _SndRate * NewTrackTime * 4 'use stereo  + use INTEGER
    NewSound = _MemNew(NewSoundSize&)

    Print "SndRate:"; _SndRate
    Print "Track memory len: "; Left.SIZE
    Print "Calculated new Track Time: "; Left.SIZE \ _SndRate \ 2; "[sec]"
    Print "Creating audio..."

    VolDown = 1 / OverSampling
    Create& = 0
    NewAudio& = 0
    Do Until Create& >= Left.SIZE - 2
        _MemGet Left, Left.OFFSET + Create&, Audio
        _MemGet Right, Right.OFFSET + Create&, Audio2

        If Create& > Echo& Then

            E& = Create&
            Vol = 1
            Do Until E& <= Create& - OverSampling
                Vol = Vol - VolDown
                _MemGet Left, Left.OFFSET + Create& - Echo&, Audio3
                _MemGet Left, Left.OFFSET + Create& - 2, Audio4
                Audio = (Audio + Audio3 * (Vol + .01) + Audio4 * Vol) \ 3
                E& = E& - 2
            Loop

            E& = Create&
            Vol = 1
            Do Until E& <= Create& - OverSampling
                Vol = Vol - VolDown
                _MemGet Right, Right.OFFSET + Create& - Echo&, Audio3
                _MemGet Right, Right.OFFSET + Create& - 2, Audio4
                Audio2 = (Audio2 + Audio3 * (Vol + .01) + Audio4 * Vol) \ 3
                E& = E& - 2
            Loop
        End If

        _MemPut NewSound, NewSound.OFFSET + NewAudio&, Audio 'left channel
        _MemPut NewSound, NewSound.OFFSET + NewAudio& + 2, Audio2 'right channel
        NewAudio& = NewAudio& + 4
        Create& = Create& + 2
    Loop

    Print "New sound created. Saving as Tracks-mix4.wav..."
    SAVESOUND16S NewSound, "Tracks-mix4.wav"
    Print "Sound saved, erasing RAM..."
    _MemFree Left
    _MemFree Right
    _MemFree NewSound

    Print "Playing mixed sound"
    snd = _SndOpen("tracks-mix4.wav")
    _SndPlay snd
    Do Until _SndPlaying(snd) = 0
        Locate 12
        Print "Time: "; Int(_SndGetPos(snd)); "[sec]     "
    Loop
    Cls
    _SndClose snd
    Kill "tracks-mix4.wav"
Next
End

Sub BackCompatible (Snd As _MEM, Left As _MEM, Right As _MEM)
    If Snd.SIZE = 0 Then
        Print "Original sample data array is empty."
        Exit Sub
    End If
    Dim SndChannels As Long, ChannelLenght As _Offset
    Select Case Snd.TYPE
        Case 260 ' 32-bit floating point
            ChannelLenght = Snd.SIZE \ 4 'return size in INTEGERS
            If Snd.ELEMENTSIZE = 4 Then
                SndChannels = 1
            ElseIf Snd.ELEMENTSIZE = 8 Then
                SndChannels = 2
            End If
        Case 132 ' 32-bit integer
            ChannelLenght = Snd.SIZE \ 4 'return size in INTEGERS
            If Snd.ELEMENTSIZE = 4 Then
                SndChannels = 1
            ElseIf Snd.ELEMENTSIZE = 8 Then
                SndChannels = 2
            End If
        Case 130: ' 16-bit integer
            ChannelLenght = Snd.SIZE \ 2 'return size in INTEGERS
            If Snd.ELEMENTSIZE = 2 Then
                SndChannels = 1
            ElseIf Snd.ELEMENTSIZE = 4 Then
                SndChannels = 2
            End If
        Case 1153: ' 8-bit unsigned integer
            ChannelLenght = Snd.SIZE 'return size in INTEGERS
            If Snd.ELEMENTSIZE = 1 Then
                SndChannels = 1
            ElseIf Snd.ELEMENTSIZE = 2 Then
                SndChannels = 2
            End If
    End Select


    Left = _MemNew(ChannelLenght)
    Right = _MemNew(ChannelLenght)
    Dim As Integer LI, RI
    Dim As Long Oi
    Dim i As _Offset

    Do Until i = Snd.SIZE - Snd.ELEMENTSIZE 'Read Phoenix MEMSOUND and convert it as back-compatible as QB64 2.02 MEMSOUND's output.
        Select Case SndChannels
            Case 1
                Select Case Snd.TYPE
                    Case 260: sampL = _MemGet(Snd, Snd.OFFSET + i, Single) ' 32-bit floating point
                    Case 132: sampL = _MemGet(Snd, Snd.OFFSET + i, Long) / 2147483648 ' 32-bit integer
                    Case 130: sampL = _MemGet(Snd, Snd.OFFSET + i, Integer) / 32768 ' 16-bit integer
                    Case 1153: sampL = (_MemGet(Snd, Snd.OFFSET + i, _Unsigned _Byte) - 128) / 128 ' 8-bit unsigned integer
                End Select
            Case 2
                Select Case Snd.TYPE
                    Case 260: sampL = _MemGet(Snd, Snd.OFFSET + i, Single): sampR = _MemGet(Snd, Snd.OFFSET + i + Snd.ELEMENTSIZE \ 2, Single) ' 32-bit floating point
                    Case 132: sampL = _MemGet(Snd, Snd.OFFSET + i, Long) / 2147483648: sampR = _MemGet(Snd, Snd.OFFSET + i + Snd.ELEMENTSIZE \ 2, Long) / 2147483648 ' 32-bit integer
                    Case 130: sampL = _MemGet(Snd, Snd.OFFSET + i, Integer) / 32768: sampR = _MemGet(Snd, Snd.OFFSET + i + Snd.ELEMENTSIZE \ 2, Integer) / 32768 ' 16-bit integer
                    Case 1153: sampL = (_MemGet(Snd, Snd.OFFSET + i, _Unsigned _Byte) - 128) / 128: sampR = (_MemGet(Snd, Snd.OFFSET + i + Snd.ELEMENTSIZE \ 2, _Unsigned _Byte) - 128) / 128 ' 8-bit unsigned integer
                End Select
        End Select
        If SndChannels Mod 2 = 0 Then
            LI = sampL * 32767
            RI = sampR * 32767
            _MemPut Left, Left.OFFSET + Oi, LI
            _MemPut Right, Right.OFFSET + Oi, RI
        Else
            LI = sampL * 32767
            _MemPut Left, Left.OFFSET + Oi, LI
            _MemPut Right, Right.OFFSET + Oi, LI
        End If
        i = i + Snd.ELEMENTSIZE
        Oi = Oi + 2
    Loop
End Sub


Function ConvertOffset&& (value As _Offset)
    $Checking:Off
    Dim m As _MEM 'Define a memblock
    m = _Mem(value) 'Point it to use value
    $If 64BIT Then
            'On 64 bit OSes, an OFFSET is 8 bytes in size.  We can put it directly into an Integer64
            _MEMGET m, m.OFFSET, ConvertOffset&& 'Get the contents of the memblock and put the values there directly into ConvertOffset&&
    $Else
        'However, on 32 bit OSes, an OFFSET is only 4 bytes.  We need to put it into a LONG variable first
        _MemGet m, m.OFFSET, temp& 'Like this
        ConvertOffset&& = temp& 'And then assign that long value to ConvertOffset&&
    $End If
    _MemFree m 'Free the memblock
    $Checking:On
End Function



Sub SAVESOUND16S (arr As _MEM, file As String) 'DO NOT USE DIRECTLY IN PHOENIX! Just for save MEM arrays, NOT FOR _SNDNEW TRACKS!

    Type head16
        chunk As String * 4 '       4 bytes  (RIFF)
        size As Long '              4 bytes  (file size)
        fomat As String * 4 '       4 bytes  (WAVE)
        sub1 As String * 4 '        4 bytes  (fmt )
        subchunksize As Long '      4 bytes  (lo / hi), $00000010 for PCM audio
        format As Integer '         2 bytes  (0001 = standard PCM, 0101 = IBM mu-law, 0102 = IBM a-law, 0103 = IBM AVC ADPCM)
        channels As Integer '       2 bytes  (1 = mono, 2 = stereo)
        rate As Long '              4 bytes  (sample rate, standard is 44100)
        ByteRate As Long '          4 bytes  (= sample rate * number of channels * (bits per channel /8))
        Block As Integer '          2 bytes  (block align = number of channels * bits per sample /8)
        Bits As Integer '           2 bytes  (bits per sample. 8 = 8, 16 = 16)
        subchunk2 As String * 4 '   4 bytes  ("data")  contains begin audio samples
        lenght As Long '            4 bytes  Data block size
    End Type '                     44 bytes  total
    Dim H16 As head16
    ch = FreeFile

    H16.chunk = "RIFF"
    H16.size = 44 + ConvertOffset(arr.SIZE)

    H16.fomat = "WAVE"
    H16.sub1 = "fmt "
    H16.subchunksize = 16
    H16.format = 1
    H16.channels = 2
    H16.rate = _SndRate
    H16.ByteRate = _SndRate * 2 * 16 / 8
    H16.Block = 4
    H16.Bits = 16
    H16.subchunk2 = "data"
    H16.lenght = ConvertOffset(arr.SIZE)
    If _FileExists(file$) Then Kill file$

    Audio$ = Space$(ConvertOffset(arr.SIZE))
    _MemGet arr, arr.OFFSET, Audio$

    Open file$ For Binary As #ch
    Put #ch, , H16
    Put #ch, , Audio$
    Audio$ = ""

    Close ch
End Sub

Sub GetFileList (SearchDirectory As String, DirList() As String, FileList() As String)
    Const IS_DIR = 1
    Const IS_FILE = 2
    Dim flags As Long, file_size As Long

    ReDim _Preserve DirList(100), FileList(100)
    DirCount = 0: FileCount = 0

    If load_dir(SearchDirectory) Then
        Do
            length = has_next_entry
            If length > -1 Then
                nam$ = Space$(length)
                get_next_entry nam$, flags, file_size
                If (flags And IS_DIR) Or _DirExists(SearchDirectory + nam$) Then
                    DirCount = DirCount + 1
                    If DirCount > UBound(DirList) Then ReDim _Preserve DirList(UBound(DirList) + 100)
                    DirList(DirCount) = nam$
                ElseIf (flags And IS_FILE) Or _FileExists(SearchDirectory + nam$) Then
                    FileCount = FileCount + 1
                    If FileCount > UBound(FileList) Then ReDim _Preserve FileList(UBound(FileList) + 100)
                    FileList(FileCount) = nam$
                End If
            End If
        Loop Until length = -1
        close_dir
    Else
    End If
    ReDim _Preserve DirList(DirCount)
    ReDim _Preserve FileList(FileCount)
End Sub