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

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

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

Post by VANYA »

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: 1834
Joined: Oct 24, 2010 15:16
Location: Ярославль
Contact:

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

Post by VANYA »

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