fb:porticula NoPaste
pintercom.bas
Uploader: | ThePuppetMaster |
Datum/Zeit: | 21.08.2017 23:32:47 |
'(c) By.: Martin Wiemann (freebasic@deltalabs.de)
'###################################################################################################################################################
#include "bass.bi"
#include "bassmix.bi"
'###################################################################################################################################################
Const Const_SoundCardDevName as String = "C-Media USB Audio Device: USB Audio" 'Name of the USB-Soundcards for the Intercom
Const Const_MaxDevices as UByte = 8 'Number of max USB-Soundcards to search for
Const Const_LocalEcho as Integer = 0 'Set to 1 if the Speaker will hear itself
'###################################################################################################################################################
Dim TDeviceT as BASS_DEVICEINFO
Dim X as Integer
Dim Y as Integer
Dim TName as Const ZString Ptr
Type DevInTyp
V_DevID as Integer
V_DevKey as String
V_Chan as HRECORD
V_Spliter as HSTREAM
V_Split(1 to Const_MaxDevices) as HSTREAM
End Type
Dim TDevInD(1 to Const_MaxDevices) as DevInTyp
Dim TDevInC as Integer
'###################################################################################################################################################
Type DevOutTyp
V_DevID as Integer
V_DevKey as String
V_Chan as HRECORD
V_Mixer as HSTREAM
End Type
Dim TDevOutD(1 to Const_MaxDevices) as DevOutTyp
Dim TDevOutC as Integer
'###################################################################################################################################################
Dim TFreq as Integer = 44100
Dim TChans as Integer = 1
'###################################################################################################################################################
Print "SEARCH Outputs..."
X = 0
Do
X += 1
If BASS_GetDeviceInfo(X, @TDeviceT) <> 1 Then Exit Do
Print "Checking:" & X & " (" & *TDeviceT.name & ")(" & *TDeviceT.driver & ")"
If *TDeviceT.name = Const_SoundCardDevName Then
Print "FOUND!"
TDevOutC += 1
With TDevOutD(TDevOutC)
.V_DevID = X
.V_DevKey = *TDeviceT.driver
If BASS_Init(X, 44100, 0, 0, 0) <> 1 Then Print "Can't BASS_Init:" & TDevOutC: Print "ERR:" & BASS_ErrorGetCode(): End -1
If BASS_SetDevice(.V_DevID) <> 1 Then Print "Can't BASS_SetDevice:" & TDevOutC: Print "ERR:" & BASS_ErrorGetCode(): End -1
If BASS_SetConfig(BASS_CONFIG_BUFFER, 50) <> 1 Then Print "Can't BASS_SetConfig(BASS_CONFIG_BUFFER):" & TDevOutC: Print "ERR:" & BASS_ErrorGetCode(): End -1
If BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD, 5) <> 1 Then Print "Can't BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD):" & TDevOutC: Print "ERR:" & BASS_ErrorGetCode(): End -1
If BASS_SetVolume(1) <> 1 Then Print "Can't BASS_SetVolume:" & TDevOutC: Print "ERR:" & BASS_ErrorGetCode(): End -1
.V_Mixer = BASS_Mixer_StreamCreate(TFreq, TChans, BASS_MIXER_NONSTOP)
BASS_ChannelSetDevice(.V_Mixer, .V_DevID)
End With
If TDevOutC >= Const_MaxDevices Then Exit Do
End If
Loop
'---------------------------------------------------------------------------------------------------------------------------------------------------
Print "SEARCH Inputs..."
X = -1
Do
X += 1
If BASS_RecordGetDeviceInfo(X, @TDeviceT) <> 1 Then Exit Do
Print "Checking:" & X & " (" & *TDeviceT.name & ")(" & *TDeviceT.driver & ")"
If *TDeviceT.name = Const_SoundCardDevName Then
Print "FOUND!"
TDevInC += 1
With TDevInD(TDevInC)
.V_DevID = X
.V_DevKey = *TDeviceT.driver
If BASS_RecordInit(X) <> 1 Then Print "Can't BASS_RecordInit:" & TDevInC: Print "ERR:" & BASS_ErrorGetCode(): End -1
If BASS_RecordSetDevice(.V_DevID) <> 1 Then Print "Can't BASS_RecordSetDevice:" & TDevInC: Print "ERR:" & BASS_ErrorGetCode(): End -1
Y = -1
Do
Y += 1
TName = BASS_RecordGetInputName(Y)
If TName = 0 Then Exit Do
Print "IN: " & *TName
If *TName = "Mic" Then
If BASS_RecordSetInput(Y, BASS_INPUT_ON, 1) <> 1 Then Print "Can't BASS_RecordSetInput:" & TDevInC & "-" & Y: Print "ERR:" & BASS_ErrorGetCode(): End -1
Else
If BASS_RecordSetInput(Y, BASS_INPUT_OFF, 0) <> 1 Then Print "Can't BASS_RecordSetInput:" & TDevInC & "-" & Y: Print "ERR:" & BASS_ErrorGetCode(): End -1
End If
Loop
.V_Chan = BASS_RecordStart(TFreq, TChans, 0, 0, 0)
If .V_Chan = 0 Then Print "Can't BASS_RecordStart:" & TDevInC: Print "ERR:" & BASS_ErrorGetCode(): End -1
For Y = 1 to TDevOutC
If (Const_LocalEcho = 1) or (TDevInD(TDevInC).V_DevKey <> TDevOutD(Y).V_DevKey) Then
.V_Split(Y) = BASS_Split_StreamCreate(.V_Chan, BASS_STREAM_DECODE, 0)
If .V_Split(Y) = 0 Then Print "Can't BASS_Split_StreamCreate:" & TDevInC & "-" & Y: Print "ERR:" & BASS_ErrorGetCode(): End -1
Print "SPLIT:" & .V_Split(Y)
End If
Next
End With
If TDevInC >= Const_MaxDevices Then Exit Do
End If
Loop
'---------------------------------------------------------------------------------------------------------------------------------------------------
Print "DEV-Out:" & TDevOutC
Print "DEV-In:" & TDevInC
'---------------------------------------------------------------------------------------------------------------------------------------------------
Print "Linking Inputs to Outputs..."
For X = 1 to TDevOutC
For Y = 1 to TDevInC
If (Const_LocalEcho = 1) or TDevOutD(X).V_DevKey <> TDevInD(Y).V_DevKey Then
If BASS_Mixer_StreamAddChannel(TDevOutD(X).V_Mixer, TDevInD(Y).V_Split(X), BASS_MIXER_NORAMPIN) <> 1 Then Print "Can't BASS_Mixer_StreamAddChannel:" & X & "-" & Y: Print "ERR:" & BASS_ErrorGetCode(): End -1
End If
Next
BASS_ChannelPlay(TDevOutD(X).V_Mixer, 0)
Next
'---------------------------------------------------------------------------------------------------------------------------------------------------
Print "PIntercom ready!"
Do Until InKey() = chr(27)
Sleep 10, 1
Loop
'---------------------------------------------------------------------------------------------------------------------------------------------------
Print "Stopping PIntercom..."
For X = 1 to TDevInC
BASS_StreamFree(TDevInD(X).V_Chan)
BASS_RecordSetDevice(TDevInD(X).V_DevID)
BASS_RecordFree()
Next
For X = 1 to TDevOutC
BASS_SetDevice(TDevOutD(X).V_DevID)
BASS_Free()
Next
'---------------------------------------------------------------------------------------------------------------------------------------------------
End