Basic Univers
;- By Dr Dri

;******************************************
;* Structures de donnee des fichiers wave *
;******************************************

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
  ; Header
  dwRiff.l
  dwSize.l
  dwWave.l
  ; Format
  dwFormat.l
  dwFormatSize.l
  wFormatTag.w
  wChannels.w
  dwSamplesPerSec.l
  dwAvgBytesPerSec.l
  wBlockAlign.w
  wBitsPerSample.w
  ; Data
  dwData.l
  dwDataSize.l
EndStructure

;***********************************
;* Déclaration des constantes wave *
;***********************************

#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

;**********************************
;* Déclaration des fonctions wave *
;**********************************

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)

;***************************************
;* Fonctions de lecture des chunk pour *
;*  le chargement des sons en mémoire  *
;***************************************

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

;***********************************************
;* Fonctions de manipulation des fichiers wave *
;***********************************************

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()
      ; 'FFIR' : "RIFF" en little endian
      ; 'EVAW' : "WAVE" en little endian
      
      *chunk = ReadChunk()
      While *chunk
        
        If *chunk\dwTag = ' tmf'
          ; ' tmf' : "fmt " en little endian
          
          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'
          ; 'atad' : "data" en little endian
          
          HasData = #True
          *wdc = AllocateMemory(*chunk\dwSize + 8)
          CopyMemory(*chunk, *wdc, *chunk\dwSize + 8)
          
        EndIf
        
        FreeChunk(*chunk)
        *chunk = ReadChunk()
      Wend
            
      ; On ne garde que les chunk format et data
      If HasFormat And HasData
        ;-a corriger
        ; les conditions à tester plus haut (format et channel)
        ; ajouter le test 8, 16, 24, 32 bits
        
        WaveSize = SizeOf(WaveFileHeader) + SizeOf(WaveFormatChunk)
        WaveSize + SizeOf(WaveDataChunk)  + *wdc\dwSize + SizeOf(Long)
        *wf = AllocateMemory(WaveSize)
        
        ; Header
        *wf\dwRiff = 'FFIR'
        *wf\dwSize = WaveSize - 8
        *wf\dwWave = 'EVAW'
        
        ; Format
        CopyMemory( wfc, *wf + SizeOf(WaveFileHeader),  SizeOf(WaveFormatChunk) )
        
        ; Data
        CopyMemory(*wdc, *wf + SizeOf(WaveFileHeader) + SizeOf(WaveFormatChunk), *wdc\dwSize + 8)
        FreeMemory(*wdc)
        
        ; Fin
        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

;*******************************************
;* Fonctions de manipulation des sons wave *
;*******************************************

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

;*****************************************
;* Fonctions d'utilisation des sons wave *
;*****************************************

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

;- routine de test
; Son = LoadWave("son.wav")
; If IsWave(Son)
;   ;Debug PlayWave(Son, #Null)
;   For i = 0 To WaveSamples(Son)
;     Debug WaveSample(Son, i, 1)
;   Next i
;   FreeWave(Son)
; EndIf