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