Basic Univers
Structure WaveFileHeader
dwRiff.l
dwSize.l
dwWave.l
EndStructure
Structure WaveChunk
dwTag.l
dwSize.l
EndStructure
Structure WaveFormatChunk
dwFormat.l
dwSize.l
wFormatTag.w
wChannels.w
dwSamplesPerSec.l
dwAvgBytesPerSec.l
wBlockAlign.w
wBitsPerSample.w
EndStructure
Structure WaveDataChunk
dwData.l
dwSize.l
EndStructure
Structure WaveFile
dwRiff.l
dwSize.l
dwWave.l
dwFormat.l
dwFormatSize.l
wFormatTag.w
wChannels.w
dwSamplesPerSec.l
dwAvgBytesPerSec.l
wBlockAlign.w
wBitsPerSample.w
dwData.l
dwDataSize.l
EndStructure
#Wave_Sample_Raw = %0000
#Wave_Sample_Percent = %0001
#Wave_Sample_Left = %0010
#Wave_Sample_Right = %0100
Enumeration 1
#Wave_Channels_Mono
#Wave_Channels_Stereo
EndEnumeration
Declare ReadChunk()
Declare FreeChunk(*chunk.WaveChunk)
Declare LoadWave(Location.s)
Declare SaveWave(*wf.WaveFile, Location.s)
Declare FreeWave(*wf.WaveFile)
Declare IsWave(*wf.WaveFile)
Declare CloneWave(*wf.WaveFile)
Declare WaveChannels(*wf.WaveFile)
Declare WaveFrequency(*wf.WaveFile)
Declare WaveDepth(*wf.WaveFile)
Declare WaveSamples(*wf.WaveFile)
Declare WaveRate(*wf.WaveFile)
Declare WaveLength(*wf.WaveFile)
Declare WaveSample(*wf.WaveFile, Position.l, Mode.l)
Declare WaveSamplePos(*wf.WaveFile, Time.l)
Declare PlayWave(*wf.WaveFile, Option.l)
Declare StopWave(*wf.WaveFile)
Procedure ReadChunk()
Protected Tag.l, Size.l, *chunk.WaveChunk
If Lof() - Loc() > 8
Tag = ReadLong()
Size = ReadLong()
If Lof() - Loc() >= Size
*chunk = AllocateMemory(Size + 8)
*chunk\dwTag = Tag
*chunk\dwSize = Size
ReadData(*chunk + SizeOf(WaveChunk), Size)
EndIf
EndIf
ProcedureReturn *chunk
EndProcedure
Procedure FreeChunk(*chunk.WaveChunk)
FreeMemory(*chunk)
EndProcedure
Procedure LoadWave(Location.s)
Protected File.l, HasFormat.l, HasData.l, WaveSize.l, *wf.WaveFile, BytesPerSample
Protected wfh.WaveFileHeader, *chunk.WaveChunk, wfc.WaveFormatChunk, *wdc.WaveDataChunk
File = ReadFile(#PB_Any, Location)
If File
UseFile(File)
ReadData( wfh, SizeOf(WaveFileHeader) )
If wfh\dwRiff = 'FFIR' And wfh\dwWave = 'EVAW' And wfh\dwSize + 8 = Lof()
*chunk = ReadChunk()
While *chunk
If *chunk\dwTag = ' tmf'
If *chunk\dwSize + 8 > SizeOf(WaveFormatChunk)
*chunk\dwSize = SizeOf(WaveFormatChunk)
EndIf
CopyMemory(*chunk, wfc, *chunk\dwSize + 8)
wfc\dwSize = SizeOf(WaveFormatChunk) - 8
BytesPerSample = wfc\wBitsPerSample >> 3
If wfc\wFormatTag = #Wave_Format_PCM
If BytesPerSample > 0 And BytesPerSample <= 4
If wfc\wChannels = #Wave_Channels_Mono Or wfc\wChannels = #Wave_Channels_Stereo
HasFormat = #True
EndIf
EndIf
EndIf
ElseIf *chunk\dwTag = 'atad'
HasData = #True
*wdc = AllocateMemory(*chunk\dwSize + 8)
CopyMemory(*chunk, *wdc, *chunk\dwSize + 8)
EndIf
FreeChunk(*chunk)
*chunk = ReadChunk()
Wend
If HasFormat And HasData
WaveSize = SizeOf(WaveFileHeader) + SizeOf(WaveFormatChunk)
WaveSize + SizeOf(WaveDataChunk) + *wdc\dwSize + SizeOf(Long)
*wf = AllocateMemory(WaveSize)
*wf\dwRiff = 'FFIR'
*wf\dwSize = WaveSize - 8
*wf\dwWave = 'EVAW'
CopyMemory( wfc, *wf + SizeOf(WaveFileHeader), SizeOf(WaveFormatChunk) )
CopyMemory(*wdc, *wf + SizeOf(WaveFileHeader) + SizeOf(WaveFormatChunk), *wdc\dwSize + 8)
FreeMemory(*wdc)
PokeL(*wf + *wf\dwSize + 8, 0)
EndIf
EndIf
CloseFile(File)
EndIf
ProcedureReturn *wf
EndProcedure
Procedure SaveWave(*wf.WaveFile, Location.s)
Protected Saved.l, File.l
If IsWave(*wf)
File = CreateFile(#PB_Any, Location)
If File
Saved = 1
WriteData(*wf, *wf\dwSize + 8)
CloseFile(File)
EndIf
EndIf
ProcedureReturn Saved
EndProcedure
Procedure FreeWave(*wf.WaveFile)
If IsWave(*wf)
FreeMemory(*wf)
EndIf
EndProcedure
Procedure IsWave(*wf.WaveFile)
Protected IsWave.l
If *wf
If *wf\dwRiff = 'FFIR' And *wf\dwWave = 'EVAW' And *wf\dwFormat = ' tmf' And *wf\dwData = 'atad'
IsWave = #True
EndIf
EndIf
ProcedureReturn IsWave
EndProcedure
Procedure CloneWave(*wf.WaveFile)
Protected *clone.WaveFile
If IsWave(*wf)
*clone = AllocateMemory(*wf\dwSize + 8)
CopyMemory(*wf, *clone, *wf\dwSize + 8)
EndIf
ProcedureReturn *clone
EndProcedure
Procedure WaveChannels(*wf.WaveFile)
Protected Channels.l
If IsWave(*wf)
Channels = *wf\wChannels
EndIf
ProcedureReturn Channels
EndProcedure
Procedure WaveFrequency(*wf.WaveFile)
Protected Frequency.l
If IsWave(*wf)
Frequency = *wf\dwSamplesPerSec
EndIf
ProcedureReturn Frequency
EndProcedure
Procedure WaveDepth(*wf.WaveFile)
Protected Frequency.l
If IsWave(*wf)
Frequency = *wf\wBitsPerSample
EndIf
ProcedureReturn Frequency
EndProcedure
Procedure WaveSamples(*wf.WaveFile)
Protected Samples.l
If IsWave(*wf)
Samples = *wf\dwDataSize /(*wf\wBlockAlign * *wf\wChannels)
EndIf
ProcedureReturn Samples
EndProcedure
Procedure WaveRate(*wf.WaveFile)
Protected Rate.l
If IsWave(*wf)
Rate = *wf\dwAvgBytesPerSec >> 10
EndIf
ProcedureReturn Rate
EndProcedure
Procedure WaveLength(*wf.WaveFile)
Protected Length.l
If IsWave(*wf)
Length =(1000 * *wf\dwDataSize) /(*wf\wBlockAlign * *wf\wChannels * *wf\dwSamplesPerSec)
EndIf
ProcedureReturn Length
EndProcedure
Procedure WaveSample(*wf.WaveFile, Position.l, Mode.l)
Protected Sample.l, Left.l, Right.l, Saturation.l, BytesPerSample.l, *ptr.l, i.l
If IsWave(*wf) And Position >= 0 And Position < WaveSamples(*wf)
BytesPerSample = *wf\wBitsPerSample >> 3
*ptr = *wf + SizeOf(WaveFile) + Position * *wf\wBlockAlign
If *wf\wChannels = #Wave_Channels_Mono
While i < BytesPerSample
Sample + PeekB(*ptr + i) <<(i << 3)
i + 1
Wend
Else
While i < BytesPerSample
Left + PeekB(*ptr + i) <<(i << 3)
Right + PeekB(*ptr + i + BytesPerSample) <<(i << 3)
i + 1
Wend
If Mode & #Wave_Sample_Left
Right = Left
ElseIf Mode & #Wave_Sample_Right
Left = Right
EndIf
Sample =(Right + Left) >> 1
EndIf
If *wf\wBitsPerSample = 8
If Sample < 0
Sample + 256
EndIf
Sample - 127
EndIf
If Mode & #Wave_Sample_Percent
Select *wf\wBitsPerSample
Case 8
Saturation = 128
Case 16
Saturation = 32767
Case 32
Saturation = 2147483583
EndSelect
Sample * 100.0 / Saturation
EndIf
EndIf
ProcedureReturn Sample
EndProcedure
Procedure WaveSamplePos(*wf.WaveFile, Time.l)
Protected SamplePos.l, Length.l
Length = WaveLength(*wf)
If IsWave(*wf) And Time >= 0 And Time < Length
SamplePos =(Time * WaveSamples(*wf)) / Length
EndIf
ProcedureReturn SamplePos
EndProcedure
Procedure PlayWave(*wf.WaveFile, Option.l)
If Option <> #SND_Async
Option = #Null
EndIf
ProcedureReturn PlaySound_(*wf, #Null, Option|#SND_Memory)
EndProcedure
Procedure StopWave(*wf.WaveFile)
EndProcedure