Play Sound WAV (Windows [32-bit], [64-bit], Linux [32-bit], [64-bit])

User projects written in or related to FreeBASIC.
VANYA
Posts: 1245
Joined: Oct 24, 2010 15:16
Location: Ярославль
Contact:

Play Sound WAV (Windows [32-bit], [64-bit], Linux [32-bit], [64-bit])

Postby VANYA » Aug 06, 2017 14:09

Hi All!

Source codes that help you play WAV files on systems Linux 32-bit , Linux 64-bit , Windows 32-bit , Windows 64-bit. To compile, you can use 32-bit compilier OR 64-bit compilier. Playable formats WAV: PCM 16-LE, PCM IEEE FLOATING-POINT.

The interface for Linux and Windows is the same. You can play several files at the same time (note: in Linux, the system must be properly configured for this. On Linux Mint, everything is configured by default). To compile in Linux, a low-level ALSA library for developers libasound-dev or libasound2-dev must be installed. It can always be installed from the program manager, either manually: sudo apt-get install libasound-dev or sudo apt-get install libasound2-dev.

You can use the source codes from this page as you please without any restrictions!

Description of functions:

LoadWav - load WAV file to buffer from file

PlayWav - audio playback. When recalling again, while playing the current buffer, playback starts again.

PauseWav - pause during playback. When you call again, starts playing from the current position

StopWav - stops playback and resets playback to the beginning.

FreeWav - stops playback (if not stopped) and releases all resources associated with the sound.

StatusPlay - returns the playback status (0-not played, 1-played, 2-pause)

GetLengthSeconds - returns the length of the track in seconds.

Files for Linux:

alsa.bi

Code: Select all

Dim Shared As Any Ptr alsa

'ALSA declarations
alsa = Dylibload("asound")

Const EAGAIN                       = -11 ' Try again
Const EPIPE                        = -32 ' Broken pipe
Const ESTRPIPE                     = -86 ' Streams pipe error

const EIO                     = -5  ' I/O error
const EBADFD                  = -77 ' File descriptor in bad state

Const BLOCK                        = 0
Const NONBLOCK                     = 1
Const ASYNC                        = 2

Const SND_PCM_STREAM_PLAYBACK      = 0
Const SND_PCM_STREAM_CAPTURE       = 1
Const SND_PCM_ACCESS_RW_INTERLEAVED= 3

enum     snd_pcm_format_t
  SND_PCM_FORMAT_UNKNOWN = -1
  SND_PCM_FORMAT_S8 = 0
  SND_PCM_FORMAT_U8
  SND_PCM_FORMAT_S16_LE
  SND_PCM_FORMAT_S16_BE
  SND_PCM_FORMAT_U16_LE
  SND_PCM_FORMAT_U16_BE
  SND_PCM_FORMAT_S24_LE
  SND_PCM_FORMAT_S24_BE
  SND_PCM_FORMAT_U24_LE
  SND_PCM_FORMAT_U24_BE
  SND_PCM_FORMAT_S32_LE
  SND_PCM_FORMAT_S32_BE
  SND_PCM_FORMAT_U32_LE
  SND_PCM_FORMAT_U32_BE
  SND_PCM_FORMAT_FLOAT_LE
  SND_PCM_FORMAT_FLOAT_BE
  SND_PCM_FORMAT_FLOAT64_LE
  SND_PCM_FORMAT_FLOAT64_BE
  SND_PCM_FORMAT_IEC958_SUBFRAME_LE
  SND_PCM_FORMAT_IEC958_SUBFRAME_BE
  SND_PCM_FORMAT_MU_LAW, SND_PCM_FORMAT_A_LAW
  SND_PCM_FORMAT_IMA_ADPCM
  SND_PCM_FORMAT_MPEG
  SND_PCM_FORMAT_GSM
  SND_PCM_FORMAT_SPECIAL = 31
  SND_PCM_FORMAT_S24_3LE = 32
  SND_PCM_FORMAT_S24_3BE
  SND_PCM_FORMAT_U24_3LE
  SND_PCM_FORMAT_U24_3BE
  SND_PCM_FORMAT_S20_3LE
  SND_PCM_FORMAT_S20_3BE
  SND_PCM_FORMAT_U20_3LE
  SND_PCM_FORMAT_U20_3BE
  SND_PCM_FORMAT_S18_3LE
  SND_PCM_FORMAT_S18_3BE
  SND_PCM_FORMAT_U18_3LE
  SND_PCM_FORMAT_U18_3BE
  SND_PCM_FORMAT_G723_24
  SND_PCM_FORMAT_G723_24_1B
  SND_PCM_FORMAT_G723_40
  SND_PCM_FORMAT_G723_40_1B
  SND_PCM_FORMAT_DSD_U8
  SND_PCM_FORMAT_DSD_U16_LE
  SND_PCM_FORMAT_DSD_U32_LE
  SND_PCM_FORMAT_DSD_U16_BE
  SND_PCM_FORMAT_DSD_U32_BE
  SND_PCM_FORMAT_LAST = SND_PCM_FORMAT_DSD_U32_BE
  SND_PCM_FORMAT_S16 = SND_PCM_FORMAT_S16_LE
  SND_PCM_FORMAT_U16 = SND_PCM_FORMAT_U16_LE
  SND_PCM_FORMAT_S24 = SND_PCM_FORMAT_S24_LE
  SND_PCM_FORMAT_U24 = SND_PCM_FORMAT_U24_LE
  SND_PCM_FORMAT_S32 = SND_PCM_FORMAT_S32_LE
  SND_PCM_FORMAT_U32 = SND_PCM_FORMAT_U32_LE
  SND_PCM_FORMAT_FLOAT = SND_PCM_FORMAT_FLOAT_LE
  SND_PCM_FORMAT_FLOAT64 = SND_PCM_FORMAT_FLOAT64_LE
  SND_PCM_FORMAT_IEC958_SUBFRAME = SND_PCM_FORMAT_IEC958_SUBFRAME_LE
end enum

#IFNDEF NULL
#DEFINE NULL 0
#ENDIF

Type snd_pcm_t           As Any Ptr
Type snd_pcm_hw_params_t As Any Ptr
Type snd_output_t        As Any Ptr

' PCM


Dim Shared snd_strerror As Function ( _
Byval ecode As long) As Zstring Ptr
snd_strerror= Dylibsymbol(alsa, "snd_strerror")

Dim Shared snd_pcm_open As Function ( _
Byval pcm          As snd_pcm_t Ptr, _
Byval device       As Zstring Ptr, _
Byval direction    As long, _
Byval mode         As long) As long
snd_pcm_open= Dylibsymbol(alsa, "snd_pcm_open")

Dim Shared snd_pcm_close As Function ( _
Byval pcm          As snd_pcm_t) As long
snd_pcm_close= Dylibsymbol(alsa, "snd_pcm_close")

Dim Shared snd_pcm_start As Function ( _
Byval pcm          As snd_pcm_t) As long
snd_pcm_start= Dylibsymbol(alsa, "snd_pcm_start")

Dim Shared snd_pcm_drain As Function ( _
Byval pcm          As snd_pcm_t) As long
snd_pcm_drain= Dylibsymbol(alsa, "snd_pcm_drain")

Dim Shared snd_pcm_hw_free As Function ( _
Byval pcm          As snd_pcm_t) As long
snd_pcm_hw_free= Dylibsymbol(alsa, "snd_pcm_hw_free")

Dim Shared snd_pcm_nonblock As Function ( _
Byval pcm          As snd_pcm_t, _
Byval nonblock     As long) As long
snd_pcm_nonblock= Dylibsymbol(alsa, "snd_pcm_nonblock")

Dim Shared snd_pcm_prepare As Function ( _
Byval pcm          As snd_pcm_t) As long
snd_pcm_prepare= Dylibsymbol(alsa, "snd_pcm_prepare")

Dim Shared snd_pcm_writei As Function ( _
Byval pcm          As snd_pcm_t, _
Byval buffer       As Any Ptr, _
Byval size         As long) As long
snd_pcm_writei= Dylibsymbol(alsa, "snd_pcm_writei")

Dim Shared snd_pcm_recover As Function ( _
Byval pcm          As snd_pcm_t, _
Byval Err          As long, _
Byval silent       As long) As long
snd_pcm_recover= Dylibsymbol(alsa, "snd_pcm_recover")

Dim Shared snd_pcm_avail_update As Function ( _
Byval pcm          As snd_pcm_t) As long
snd_pcm_avail_update= Dylibsymbol(alsa, "snd_pcm_avail_update")

Dim Shared snd_pcm_delay As Function ( _
Byval pcm          As snd_pcm_t, _
Byval delayp       As snd_pcm_t) As long
snd_pcm_delay= Dylibsymbol(alsa, "snd_pcm_delay")

Dim Shared snd_pcm_wait As Function ( _
Byval pcm          As snd_pcm_t, _
Byval msec As long) As long
snd_pcm_wait= Dylibsymbol(alsa, "snd_pcm_wait")

Dim Shared snd_pcm_resume As Function ( _
Byval pcm          As snd_pcm_t) As long
snd_pcm_resume= Dylibsymbol(alsa, "snd_pcm_resume")

'hardware
Dim Shared snd_pcm_hw_params_malloc As Function ( _
Byval hw           As snd_pcm_hw_params_t Ptr) As long
snd_pcm_hw_params_malloc= Dylibsymbol(alsa, "snd_pcm_hw_params_malloc")

Dim Shared snd_pcm_hw_params_any As Function ( _
Byval pcm          As snd_pcm_t, _
Byval hw           As snd_pcm_hw_params_t) As long
snd_pcm_hw_params_any= Dylibsymbol(alsa, "snd_pcm_hw_params_any")

Dim Shared snd_pcm_hw_params_set_access As Function ( _
Byval pcm          As snd_pcm_t, _
Byval hw           As snd_pcm_hw_params_t, _
Byval mode         As long) As long
snd_pcm_hw_params_set_access= Dylibsymbol(alsa, "snd_pcm_hw_params_set_access")

Dim Shared snd_pcm_hw_params_set_format As Function ( _
Byval pcm          As snd_pcm_t, _
Byval hw           As snd_pcm_hw_params_t, _
Byval fmt          As long) As long
snd_pcm_hw_params_set_format= Dylibsymbol(alsa, "snd_pcm_hw_params_set_format")

Dim Shared snd_pcm_hw_params_set_channels As Function ( _
Byval pcm          As snd_pcm_t, _
Byval hw           As snd_pcm_hw_params_t, _
Byval Channels     As long) As long
snd_pcm_hw_params_set_channels= Dylibsymbol(alsa, "snd_pcm_hw_params_set_channels")

Dim Shared snd_pcm_hw_params_get_channels As Function ( _
Byval hw           As snd_pcm_hw_params_t, _
Byval lpChannels   As long Ptr) As long
snd_pcm_hw_params_get_channels= Dylibsymbol(alsa, "snd_pcm_hw_params_get_channels")

Dim Shared snd_pcm_hw_params_set_rate_near As Function ( _
Byval pcm          As snd_pcm_t, _
Byval hw           As snd_pcm_hw_params_t, _
Byval lpRate       As long Ptr, _
Byval lpDir        As long Ptr) As long
snd_pcm_hw_params_set_rate_near= Dylibsymbol(alsa, "snd_pcm_hw_params_set_rate_near")


Dim Shared snd_pcm_hw_params_get_periods As Function ( _
Byval hw           As snd_pcm_hw_params_t, _
Byval lpValue      As long Ptr, _
Byval lpDir        As long Ptr) As long
snd_pcm_hw_params_get_periods= Dylibsymbol(alsa, "snd_pcm_hw_params_get_periods")

Dim Shared snd_pcm_hw_params_set_periods_near As Function ( _
Byval pcm          As snd_pcm_t, _
Byval hw           As snd_pcm_hw_params_t, _
Byval lpValue      As long Ptr, _
Byval lpDir        As long Ptr) As long
snd_pcm_hw_params_set_periods_near= Dylibsymbol(alsa, "snd_pcm_hw_params_set_periods_near")

Dim Shared snd_pcm_hw_params_get_period_size As Function ( _
Byval params       As snd_pcm_hw_params_t, _
Byval lpFrames     As long Ptr, _
Byval lpDir        As long Ptr) As long
snd_pcm_hw_params_get_period_size= Dylibsymbol(alsa, "snd_pcm_hw_params_get_period_size")

Dim Shared snd_pcm_hw_params_set_period_size_near As Function ( _
Byval pcm          As snd_pcm_t Ptr, _
Byval hw           As snd_pcm_hw_params_t, _
Byval lpValue      As long Ptr, _
Byval lpDir        As long Ptr) As long
snd_pcm_hw_params_set_period_size_near= Dylibsymbol(alsa, "snd_pcm_hw_params_set_period_size_near")

Dim Shared snd_pcm_hw_params_set_buffer_size_near As Function ( _
Byval pcm          As snd_pcm_t, _
Byval hw           As snd_pcm_hw_params_t, _
Byval lpFrames     As long Ptr) As long
snd_pcm_hw_params_set_buffer_size_near= Dylibsymbol(alsa, "snd_pcm_hw_params_set_buffer_size_near")

Dim Shared snd_pcm_hw_params_get_buffer_size As Function ( _
Byval hw           As snd_pcm_hw_params_t, _
Byval lpFrames     As long Ptr) As long
snd_pcm_hw_params_get_buffer_size= Dylibsymbol(alsa, "snd_pcm_hw_params_get_buffer_size")

Dim Shared snd_pcm_hw_params As Function ( _
Byval pcm          As snd_pcm_t, _
Byval hw           As snd_pcm_hw_params_t) As long
snd_pcm_hw_params= Dylibsymbol(alsa, "snd_pcm_hw_params")

Dim Shared snd_pcm_hw_params_free As Sub ( _
Byval hw           As snd_pcm_hw_params_t)
snd_pcm_hw_params_free= Dylibsymbol(alsa, "snd_pcm_hw_params_free")

Dim Shared snd_pcm_hw_params_set_period_size as function( _
byval pcm      as snd_pcm_t          , _
byval params   as snd_pcm_hw_params_t, _
byval nFrames  as long            , _
byval pDir     as long ptr) as long
snd_pcm_hw_params_set_period_size = Dylibsymbol(alsa, "snd_pcm_hw_params_set_period_size")

Dim Shared snd_pcm_hw_params_set_buffer_size  as function( _
byval pcm      as snd_pcm_t          , _
byval hw       as snd_pcm_hw_params_t, _
byval Frames   as long) as long
snd_pcm_hw_params_set_buffer_size = Dylibsymbol(alsa, "snd_pcm_hw_params_set_buffer_size")


FBLinuxSoundWav.bas

Code: Select all

#include "alsa.bi"

type FbWAV

   As Short shFtag
   
   as Short shCanal
   
   as Short shBits
   
   As snd_pcm_t Ptr hDevice
   
   As snd_pcm_hw_params_t Ptr hw
   
   as Long iBufferSize
   
   as Long iSampleRate   
   
   As Long iByteRate
   
   as Byte ptr bSoundBuffer
   
   as Long iPause
   
   as Long iPauseSt
   
   as long iStop
   
   as Long iStopWav
   
   as Any ptr Thread
   
   as Any ptr mutexstop
   
   declare function LoadWav(as zstring ptr) as Long
   
   declare function Play(as FbWav ptr) as Long   
   
   declare static function PlayT(as FbWav ptr) as Long   
   
   declare function Stop() as Long
   
   declare function Pause() as Long
   
   declare destructor()
   
 private:
      
       declare function SetParam() as Long

end type

destructor FbWAV

   deallocate (bSoundBuffer)

end destructor

Function GetLengthSeconds(ByRef obj As FbWAV Ptr) As Long
   
   Return obj->iBufferSize\obj->iByteRate
   
End Function

Function StatusPlay(ByRef obj As FbWAV Ptr) As Long

   dim as Long iStatusPl, iStatusPa
   
   MutexLock(obj->mutexstop)
   
      iStatusPl = obj->iStopWav
      
      iStatusPa = obj->iPauseSt
   
   MutexUnlock(obj->mutexstop)

   If iStatusPl = 0 Then    
      
      Return 0
   
   ElseIf iStatusPl = -1 AndAlso iStatusPa = 0  Then
      
      Return 1
      
   ElseIf iStatusPl = -1 AndAlso iStatusPa = -1  Then    
      
      Return 2
   
   EndIf

End Function

function FbWAV.LoadWav(szFile as zstring ptr) as Long

   if lcase(right (*szFile,3))  = "wav" then
   
      Dim idFile As long = Freefile

      Open *szFile For Binary As #idFile

      Get #idFile,21,shFtag
      
      Get #idFile,,shCanal
      
      Get #idFile,,iSampleRate
      
      Get #idFile,29,iByteRate
      
      Get #idFile,35,shBits
      
      Get #idFile,41,iBufferSize
      
      select case shFtag
      
         case 1 , 3
         
            if iBufferSize = 0 then
            
               print "Invalidate data!"
               
               return 0                        
            
            endif
            
         case else
            
            print "Format Unknown!"
            
            return 0               
      
      end select

      bSoundBuffer = Allocate (iBufferSize+1)
      
      if bSoundBuffer then
      
         Get #idFile,45,*bSoundBuffer,iBufferSize
      
      endif

      Close #idFile   
      
      return SetParam()
   
   endif

end function

function FbWAV.SetParam() as Long

   dim as Long iDirection , iRet
   
   If alsa Then

      iRet = snd_pcm_open(@hDevice, "default", SND_PCM_STREAM_PLAYBACK, BLOCK)
      
      if iRet < 0 then
      
         print "Error snd_pcm_open"
         
         return 0
      
      endif

      snd_pcm_hw_params_malloc(@hw)

      iRet = snd_pcm_hw_params_any(hDevice, hw)
      
      if iRet < 0 then
      
         print "Error snd_pcm_hw_params_any"
         
         return 0
      
      endif

      iRet = snd_pcm_hw_params_set_access(hDevice, hw, SND_PCM_ACCESS_RW_INTERLEAVED)
      
      if iRet < 0 then
      
         print "Error snd_pcm_hw_params_set_access"
         
         return 0
      
      endif      

      if shFtag = 1 then

         if shBits = 16 then

            iRet = snd_pcm_hw_params_set_format(hDevice, hw, SND_PCM_FORMAT_S16_LE)
            
            if iRet < 0 then
            
               print "Error snd_pcm_hw_params_set_format s16_LE"
               
               return 0
            
            endif            
            
         elseif shBits = 8 then

            iRet = snd_pcm_hw_params_set_format(hDevice, hw, SND_PCM_FORMAT_S8)
            
            if iRet < 0 then
            
               print "Error snd_pcm_hw_params_set_format s8"
               
               return 0
            
            endif            
            
         endif

      elseif shFtag = 3 then

         iRet = snd_pcm_hw_params_set_format(hDevice, hw, SND_PCM_FORMAT_FLOAT_LE)
         
         if iRet < 0 then
         
            print "Error snd_pcm_hw_params_set_format FLOAT_LE"
            
            return 0
         
         endif         

      else

         Print "Format Unknown!"
         
         return 0

      endif

      iRet = snd_pcm_hw_params_set_channels(hDevice, hw, shCanal)
      
      if iRet < 0 then
      
         print "Error snd_pcm_hw_params_set_channels"
         
         return 0
      
      endif      

      iRet = snd_pcm_hw_params_set_rate_near(hDevice, hw, @iSampleRate, @iDirection)
      
      if iRet < 0 then
      
         print "Error snd_pcm_hw_params_set_rate_near"
         
         return 0
      
      endif      
    
      dim as Long BufferSizeInFrames = 2048
    
      iRet = snd_pcm_hw_params_set_buffer_size(hDevice, hw, BufferSizeInFrames)
    
      dim as Long inFrames = 2048
    
      if iRet < 0 then

         iRet = snd_pcm_hw_params_set_buffer_size_near(hDevice, hw, @BufferSizeInFrames)
         
         if iRet < 0 then
         
            print "Error snd_pcm_hw_params_set_buffer_size_near"
            
            return 0
         
         endif         
         
      endif
      
      iRet = snd_pcm_hw_params_set_period_size(hDevice, hw, inFrames, 0)
      
      if iRet < 0 then
      
         iRet = snd_pcm_hw_params_set_period_size_near( hDevice, hw, @inFrames, 0)
         
         if iRet < 0 then
      
            print "Error snd_pcm_hw_params_set_period_size_near"
            
            return 0
         
         endif
      
      endif      

      iRet = snd_pcm_hw_params(hDevice, hw)
      
      if iRet < 0 then
      
         print "Error snd_pcm_hw_params"
         
         return 0
      
      endif      

      snd_pcm_hw_params_free (hw)

      snd_pcm_prepare(hDevice)
      
      mutexstop = MutexCreate
      
      return -1

   End If   

end function

function FbWAV.Play(obj as FbWAV ptr) as Long
   
   dim as Long iStatusPl
   
   MutexLock(obj->mutexstop)
   
      iStatusPl = obj->iStopWav
   
   MutexUnLock(obj->mutexstop)
   
   if iStatusPl = -1 then obj->Stop()
   
   obj->THREAD = threadcreate(cast(any ptr,@PlayT()), Obj)
      
   MutexLock(obj->mutexstop)
      
      obj->iStopWav = -1
   
   MutexUnLock(obj->mutexstop)   
   
   return -1
   
end function


function FbWAV.PlayT(p as FbWAV ptr) as Long

   dim as long iRet, inErrors , inFrames , iFrameSize
 
   dim as any ptr lpBuffer

   inFrames   = 2048
   
   iFrameSize = (p->shBits shr 3) shl (p->shCanal-1)
   
   lpBuffer  = p->bSoundBuffer

   If alsa Then

      while (inFrames > 0) andalso (inErrors < 4)       
         
         MutexLock(p->mutexstop)
         
            if p->iStop = -1 then
            
               MutexUnlock(p->mutexstop)
            
               exit while
            
            endif
            
            if p->iPause = -1 then
            
               sleep(1)
               
               MutexUnlock(p->mutexstop)
               
               continue while
            
            endif               
         
         MutexUnlock(p->mutexstop)               
      
         iRet = snd_pcm_writei(p->hDevice,lpBuffer,inFrames)
         
         if iRet < 0 then
         
            select case iRet
            
               case EAGAIN
                  
                  sleep 1
               
               case EPIPE
               
                  iRet = snd_pcm_prepare(p->hDevice)

                  if (iRet < 0) then

                     inErrors += 1
                     
                  end if
                  
               case ESTRPIPE
               
                  do
                  
                     iRet = snd_pcm_resume(p->hDevice)
                     
                     if iRet = EAGAIN then sleep 1
                     
                  loop while iRet = EAGAIN
                  
                  if (iRet < 0) then
                  
                     iRet = snd_pcm_prepare(p->hDevice)
                     
                     if (iRet < 0) then
                     
                        inErrors+=1
                      
                     end if
                     
                  end if
                
               case EBADFD , EIO
               
                  inErrors+=1
                
               case else
               
                  inErrors += 1
                  
                  snd_pcm_prepare(p->hDevice)
             
            end select
            
         else

            iRet *= iFrameSize
            
            lpBuffer += iRet

            if (lpBuffer >= p->bSoundBuffer + p->iBufferSize) then
            
               function = -1

               exit while

            elseif (lpBuffer + iRet > p->bSoundBuffer + p->iBufferSize) then

               dim as integer iBytes = cast (integer,p->bSoundBuffer + p->iBufferSize)
               
               iBytes -= cast(integer,lpBuffer)
               
               inFrames = cast(long,iBytes)\iFrameSize
               
               function = -1

            endif
          
         end if
         
      wend
      
      MutexLock(p->mutexstop)
      
         p->iStopWav = 0
      
      MutexUnLock(p->mutexstop)         
   
   EndIf   

end function

function FbWAV.Stop() as Long

   dim as Long iStatusPl
   
   MutexLock(mutexstop)
   
      iStatusPl = iStopWav
   
   MutexUnLock(mutexstop)

   if iStatusPl = -1 then
   
      MutexLock(mutexstop)
      
         iStop = -1
      
      MutexUnlock(mutexstop)
      
      ThreadWait(THREAD)
      
      iStop = 0
      
      iStopWav = 0
      
      iPause  = 0   
      
      iPauseSt = 0
      
      function = -1
   
   endif

end function

function FbWAV.Pause() as Long   
   
   MutexLock(mutexstop)
   
      if iStopWav = -1 then
      
         iPause Xor= -1
         
         iPauseSt = iPause
         
         function = iPause
         
      endif      
   
   MutexUnlock(mutexstop)      

end function

function PauseWAV(obj as FbWAV ptr) as Long
   
   return obj->Pause()

end function

function LoadWav(szFile as Zstring ptr, byref obj as FbWAV ptr) as Long

   obj  = new FbWAV
   
   return obj->LoadWav(szFile)

end function

Function PlayWav(obj as FbWAV ptr) as Long

   return obj->Play (obj)

end Function

sub FreeWav(obj as FbWAV ptr)
   
   dim as Long iStatusPl
   
   MutexLock(obj->mutexstop)
   
      iStatusPl = obj->iStopWav
   
   MutexUnLock(obj->mutexstop)
   
   if iStatusPl = -1 then
   
      obj->Stop()
   
   endif
   
   snd_pcm_close(obj->hDevice)
   
   MutexDestroy(obj->mutexstop)
   
   delete obj

end sub

sub StopWav(obj as FbWAV ptr)

   obj->Stop()

end sub


File for Windows:


FBWindowsSoundWav.bas

Code: Select all

#Include "Windows.bi"

#Include "win/mmsystem.bi"

Type FbWAV

   As Short shFtag

   As Short shCanal

   As Short shBits

   As HWAVEOUT hWaveOut

   As WAVEHDR Ptr hWhdr

   As Long iBufferSize

   As Long iSampleRate
   
   As Long iByteRate

   As Byte Ptr bSoundBuffer

   As Long iPause

   As Long iStopWav
   
   As CRITICAL_SECTION c_s

   Declare Function LoadWav(As ZString Ptr,ByRef obj As FbWAV Ptr) As Long

   Declare Function Play() As Long

   Declare Function Stop() As Long

   Declare Function Pause() As Long
   
   Declare Static Sub SoundCallback (hwo As Any Ptr, uMsg As ULong, dwInstance As Long, dwParam1 As Long, dwParam2 As Long )

   Declare Destructor()

   Private:

   Declare Function SetParam(ByRef obj As FbWAV Ptr) As Long

End Type

Dim Shared As FBWAV Ptr fb_info(100)

Destructor FbWAV

   DeAllocate (bSoundBuffer)

End Destructor

Sub FbWAV.SoundCallback (hwo As Any ptr, uMsg As ULong, dwInstance As Long, dwParam1 As Long, dwParam2 As Long )
   
   If uMsg = WOM_DONE Then
      
      For i As Long  = 0 To 100
         
         If fb_info(i) <> 0 AndAlso fb_info(i)->hWaveOut = hwo Then
            
            EnterCriticalSection(@fb_info(i)->c_s)
            
               fb_info(i)->iStopWav = 0
            
            LeaveCriticalSection(@fb_info(i)->c_s)   
                  
            Exit For         
            
         EndIf
         
      Next

   End If
   
End Sub

Function GetLengthSeconds(ByRef obj As FbWAV Ptr) As Long
   
   Return obj->iBufferSize\obj->iByteRate
   
End Function

Function StatusPlay(ByRef obj As FbWAV Ptr) As Long
   
   Dim As Long s_p
   
   EnterCriticalSection(@obj->c_s)
   
   s_p = obj->iStopWav
   
   LeaveCriticalSection(@obj->c_s)   
   
      If s_p = 0 Then    
         
         Return 0
      
      ElseIf s_p = -1 AndAlso obj->iPause = 0  Then
         
         Return 1
         
      ElseIf s_p = -1 AndAlso obj->iPause = -1  Then    
         
         Return 2
      
      EndIf
   
End Function

Function FbWAV.LoadWav(szFile As ZString Ptr , ByRef obj As FbWAV Ptr) As Long

   If LCase(Right (*szFile,3))  = "wav" Then

      Dim idFile As Long = FreeFile

      Open *szFile For Binary As #idFile

      Get #idFile,21,shFtag

      Get #idFile,,shCanal

      Get #idFile,,iSampleRate
      
      Get #idFile,29,iByteRate

      Get #idFile,35,shBits

      Get #idFile,41,iBufferSize

      Select Case shFtag

         Case 1 , 3

            If iBufferSize = 0 Then

               Print "Invalidate data!"

               Return 0

            EndIf

         Case Else

            Print "Format Unknown!"

            Return 0

      End Select

      bSoundBuffer = Allocate (iBufferSize+1)

      If bSoundBuffer Then

         Get #idFile,45,*bSoundBuffer,iBufferSize

      EndIf

      Close #idFile

      Return SetParam(obj)
      
   Else
      
      Return 0

   EndIf
   
End Function

Function FbWAV.SetParam(ByRef obj As FbWAV Ptr) As Long

   Dim As WAVEFORMATEX wfx

   wfx.wFormatTag = shFtag

   wfx.nChannels = shCanal

   wfx.nSamplesPerSec = iSampleRate

   wfx.wBitsPerSample = shBits

   wfx.nBlockAlign = wfx.nChannels * wfx.wBitsPerSample / 8

   wfx.nAvgBytesPerSec =  wfx.nBlockAlign * wfx.nSamplesPerSec
   
   Dim As Integer scall = Cast(Integer, @SoundCallback)

   If waveOutOpen(@hWaveOut, WAVE_MAPPER, @wfx, scall, 0, CALLBACK_FUNCTION) <> MMSYSERR_NOERROR Then

      Print "Error waveOutOpen"

      Return NULL

   Else

      hWhdr = Allocate(SizeOf(WAVEHDR))

      hWhdr->lpData = bSoundBuffer

      hWhdr->dwBufferLength = iBufferSize
      
      hWhdr->dwFlags = WHDR_PREPARED

      waveOutPrepareHeader(hWaveOut, hWhdr, SizeOf(WAVEHDR))
      
      InitializeCriticalSection(@c_s)
      
      For i As Long  = 0 To 100
         
         If fb_info(i) = 0 Then
            
            fb_info(i) = obj
            
            Exit For
            
         EndIf
         
      Next

      Return -1

   End If

End Function

Function FbWAV.Play() As Long

   EnterCriticalSection(@c_s)   

      If iStopWav = -1 Then
         
         LeaveCriticalSection(@c_s)
         
         Stop()
         
      Else
         
         LeaveCriticalSection(@c_s)
         
      EndIf
   
   If waveOutWrite(hWaveOut, hWhdr, SizeOf(WAVEHDR)) Then

      waveOutUnprepareHeader(hWaveOut, hWhdr, SizeOf(WAVEHDR))

      DeAllocate(hWhdr)

      Print "Error waveOutWrite"

      Return 0

   Else
      
      iStopWav = -1

      Return -1

   EndIf

End Function

Function FbWAV.Pause() As Long
   
   EnterCriticalSection(@c_s)
   
      If iStopWav = 0 Then
         
         LeaveCriticalSection(@c_s)
         
         Exit Function
         
      Else
         
         LeaveCriticalSection(@c_s)
         
      EndIf
   
   iPause Xor= -1

   If iPause = 0 Then

      waveOutRestart(hWaveOut)

   Else

      waveOutPause(hWaveOut)

   EndIf

   Return -1

End Function

Function FbWAV.Stop() As Long

   waveOutReset(hWaveOut)
   
   iPause = 0
   
   Return -1

End Function

Function LoadWav(szFile As ZString Ptr, ByRef obj As FbWAV Ptr) As Long

   obj  = New FbWAV

   Return obj->LoadWav(szFile,obj)

End Function

Function PlayWav(obj As FbWAV Ptr) As Long

   Return obj->Play ()

End Function

Function PauseWAV(obj As FbWAV Ptr) As Long

   Return obj->Pause()

End Function

Sub FreeWav(obj As FbWAV Ptr)

   EnterCriticalSection(@(obj->c_s))   

      if obj->iStopWav = -1 Then
         
         LeaveCriticalSection(@(obj->c_s))

         obj->Stop()
         
      Else
         
         LeaveCriticalSection(@(obj->c_s))
      
      EndIf   
   
   waveOutClose(obj->hWaveOut)
   
   waveOutUnprepareHeader(obj->hWaveOut, obj->hWhdr, SizeOf(WAVEHDR))
   
   For i As Long = 0 To 100
      
      If fb_info(i) = obj Then
         
         fb_info(i) = 0
         
         Exit For
         
      EndIf
      
   Next

   DeAllocate(obj->hWhdr)
   
   DeleteCriticalSection(@(obj->c_s))
   
   Delete obj

End Sub

Sub StopWav(obj As FbWAV Ptr)

   obj->Stop()

End Sub



An example of use for Linux and Windows:

Connect using an operator #include:

file FBLinuxSoundWav.bas in system Linux

OR

file FBWindowsSoundWav.bas in system Windows

Keys in the example:

key "q" - EXIT

key "Space" - PAUSE

key "p" - PLAY

key "s" - STOP

Code: Select all

Dim fb_Wav As FbWAV Ptr

LoadWav("Track.wav", fb_Wav)

PlayWav(fb_Wav)


Do
   
   Var key = Inkey

   Select Case key

      Case " "

         PauseWAV(fb_Wav)

         Sleep(100)

      Case "q"

         Exit Do
         
      Case "s"
         
         StopWav(fb_Wav)
         
      Case "p"
         
         PlayWav(fb_Wav)

   End Select
   
   Var sp = StatusPlay(fb_Wav)
   
   Sleep(100)
   
   Cls
   
   If sp = 1 Then
      
      ? "Play"
      
   ElseIf sp = 0 Then
      
      ? "Stop"
      
   ElseIf sp = 2 Then   
      
      ? "Pause"
      
   EndIf
   
   ? "Length=" & GetLengthSeconds(fb_Wav) & " seconds"

Loop

FreeWav(fb_Wav)
VANYA
Posts: 1245
Joined: Oct 24, 2010 15:16
Location: Ярославль
Contact:

Re: Play Sound WAV (Windows [32-bit], [64-bit], Linux [32-bit], [64-bit])

Postby VANYA » Aug 09, 2017 13:04

1) Added 2 functions:

StatusPlay - returns the playback status (0-not played, 1-played, 2-pause)
GetLengthSeconds - returns the length of the track in seconds.

2) Bug fixes.

Return to “Projects”

Who is online

Users browsing this forum: No registered users and 4 guests