+- 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: Cut Music Files (/showthread.php?tid=1633)
Cut Music Files - Petr - 04-21-2023
A simple program for cuting music files according to data in a text file. It supports all audio formats supported in QB64PE as source, WAV file as output.
Code: (Select All)
'wav cut
'extended version, based on https://staging.qb64phoenix.com/showthread.php?tid=1631&pid=15348#pid15348
'unlocked for all QB64PE compatible sound formats
'
'The program is used to cut audio files based on data in a text file.
'For example - the original audio file contains 10 songs (for example, when backing up vinyl records or audio cassettes to your computer)
'and you know the length of the audio track and want to cut it into your own file, or you just want to get a piece of the audio file.
'The program cuts the specified section of sound and saves it in WAV format to a file named according to the entry in the text file.
'
'split.txt file content:
'
'5 <---- how much files create
'"allinone.mp3" <---- sound file, which contains your sounds, can be all, what QB64 support (XM, MOD, IT, MP3, WAV, S3M....)
'"Track 01", 1:10 <---- cut from allinone.mp3 sound to file Track 01.wav in lenght 1 minute, 10 seconds (output format is just one - WAV 16bit, stereo)
'"Silent 1", 0:3 <---- cut next sound from allinone.mp3 (start after the end position previous Track 01)
'"Track 02", 2:20
'"Silent 2", 0:3
'"Track 03", 3:00
'end of txt file
'
Type TrackType
Time As Single
Song As String
End Type
Type WAVHead
chunk As String * 4 ' 4 bytes (RIFF)
size As _Unsigned Long ' 4 bytes (file size) velikost souboru
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 _Unsigned Long ' 4 bytes Data block size
End Type ' 44 bytes total
Dim WavHead As WAVHead
Dim WavNew As WAVHead
SplitTxt$ = "split.txt"
ff = FreeFile
If _FileExists(SplitTxt$) Then
Open SplitTxt$ For Input As ff
If LOF(ff) > 0 Then
Input #ff, tracks$
Tracks = Val(tracks$)
If Tracks <= 0 Then
Print "Can not create negative or zero new tracks.": End
Else
Input #ff, source$
' If LCase$(Right$(source$, 4)) <> ".wav" Then source$ = source$ + ".wav" 'IN THIS VERSION IS IT EXTENDED FOR ALL QB64PE SUPPORTED FORMATS
If _FileExists(source$) Then
Dim tracks(Tracks) As TrackType
While Not EOF(ff)
Input #ff, TrackName$, TrackTime$
If LCase$(Right$(TrackName$, 4)) <> ".wav" Then TrackName$ = TrackName$ + ".wav"
tracks(ti).Song = TrackName$
separator = InStr(1, TrackTime$, ":")
If separator = 0 Then Print "Invalid track time. Use format Min:Sec": End
Min = Val(Left$(TrackTime$, separator - 1))
Sec = Val(Right$(TrackTime$, separator))
tracks(ti).Time = Min * 60 + Sec
ti = ti + 1
If ti > Tracks Then Print "Txt file contains more records than is declared on line 1 in txt file "; SplitTxt$; Tracks; ti: End
Wend
Else
Print "Source file: "; source$; " not exists.": End
End If
End If
Else
Print "File lenght "; SplitTxt$; " is not valid.": End
End If
Else
Print "File: "; SplitTxt$; " not exists."
End If
Print "Total declared tracks:"; Tracks
Print "Source sound file: "; source$
Close ff
Dim As _MEM O, L, R, NwSnd
snd& = _SndOpen(source$)
O = _MemSound(snd&, 0)
BackCompatible O, L, R 'convert all QB64PE sound option as 16 bit stereo, but use real _SndRate as in QB64PE
_MemFree O
NwSnd = _MemNew(L.SIZE * 2)
Mix_Left_Right_as_Wav L, R, NwSnd
_MemFree L
_MemFree R
For TimeTest = 0 To Tracks
TotalTime = TotalTime + tracks(TimeTest).Time
Next
Print "Total Time in "; Tracks; " tracks is:"; TotalTime
SAFLEN = _SndLen(snd&)
If SAFLEN < TotalTime Then Print "Source audio file is shorter than the total required length. Some audio tracks may therefore have silence at the end."
Print "Source audio file lenght:"; SAFLEN
Print "Source audio file format: 16 bits" 'BakcCompatible static outputs
Print "Source audio file channels: 2"
For split = 0 To Tracks - 1
Print "Creating track "; tracks(split).Song; " ["; LTrim$(Str$(tracks(split).Time)); "S]"
DataSize& = 4 * _SndRate * tracks(split).Time
If nwsndi& + DataSize& > NwSnd.SIZE Then Print "Memory out of range prevent: Program try read out of memory block!": DataSize& = ConvertOffset(NwSnd.SIZE) - nwsndi&
datas$ = Space$(DataSize&)
_MemGet NwSnd, NwSnd.OFFSET + nwsndi&, datas$
nwsndi& = nwsndi& + DataSize&
WavNew.Bits = 16
WavNew.channels = 2
WavNew.rate = _SndRate
WavNew.chunk = "RIFF"
WavNew.size = DataSize& + 44
WavNew.fomat = "WAVE"
WavNew.sub1 = "fmt "
WavNew.subchunksize = &H10
WavNew.ByteRate = _SndRate * 4
WavNew.Block = 4
WavNew.subchunk2 = "data"
WavNew.format = 1
WavNew.lenght = DataSize&
' Print "New WAV bits: "; WavNew.Bits
' Print "New WAV channels: "; WavNew.channels
' Print "New WAV sound rate: "; WavNew.rate
' Print "New WAV size: "; WavNew.size
ff2 = FreeFile
Open tracks(split).Song For Binary As ff2
Put ff2, , WavNew
Put ff2, , datas$
Close ff2
datas$ = ""
Next
_SndClose snd&
_MemFree NwSnd
Sub Mix_Left_Right_as_Wav (left As _MEM, right As _MEM, wav As _MEM)
Dim As Integer LData, RData
Do Until i& = left.SIZE
_MemGet left, left.OFFSET + i&, LData
_MemGet right, right.OFFSET + i&, RData
_MemPut wav, wav.OFFSET + j&, LData
_MemPut wav, wav.OFFSET + j& + 2, RData
i& = i& + 2
j& = j& + 4
Loop
End Sub
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
If Snd.ELEMENTSIZE = 4 Then
SndChannels = 1
ChannelLenght = Snd.SIZE \ 2 'return size in INTEGERS
ElseIf Snd.ELEMENTSIZE = 8 Then
SndChannels = 2
ChannelLenght = Snd.SIZE \ 4 'return size in INTEGERS
End If
Case 132 ' 32-bit integer
If Snd.ELEMENTSIZE = 4 Then
SndChannels = 1
ChannelLenght = Snd.SIZE \ 2 'return size in INTEGERS
ElseIf Snd.ELEMENTSIZE = 8 Then
SndChannels = 2
ChannelLenght = Snd.SIZE \ 4 'return size in INTEGERS
End If
Case 130: ' 16-bit integer
If Snd.ELEMENTSIZE = 2 Then
SndChannels = 1
ChannelLenght = Snd.SIZE 'return size in INTEGERS
ElseIf Snd.ELEMENTSIZE = 4 Then
SndChannels = 2
ChannelLenght = Snd.SIZE \ 2 'return size in INTEGERS
End If
Case 1153: ' 8-bit unsigned integer
If Snd.ELEMENTSIZE = 1 Then
SndChannels = 1
ChannelLenght = Snd.SIZE * 2 'return size in INTEGERS
ElseIf Snd.ELEMENTSIZE = 2 Then
SndChannels = 2
ChannelLenght = Snd.SIZE * 4 'return size in INTEGERS This option is not tested
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 10 'this is out of order this time - program create always 2 channels - stereo or mono/mono
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 1, 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, RI
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, temp&& 'Get the contents of the memblock and put the values there directly into ConvertOffset&&
ConvertOffset&& = temp&&
$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