'#require <api_mmsys.sbp>

Namespace ActiveBasic
Namespace Windows
Namespace MM

'MIDI出力デバイスの種類を表す列挙子
Enum MidiOutDeviceType
	'デバイスはポート
	HardwarePort = 1
	'デバイスはシンセサイザ
	Synthesizer = 2
	'デバイスは方形波シンセサイザ
	SquareWaveSynthesizer = 3
	'デバイスはFMシンセサイザ
	FrequencyModulationSynthesizer = 4
	'デバイスはマッパー
	Mapper = 5
	'デバイスはハードウェアのウェーブテーブルシンセサイザ
	HardwareWavetableSynthesizer = 6
	'デバイスはソフトウェアシンセサイザ
	SoftwareSynthesizer = 7
End Enum


'MIDI出力デバイスの持つ機能を表す列挙子
Enum MidiDeviceFunction
	'デバイスはモノラルの音量調節が可能
	VolumeControl = &H0001
	'デバイスはステレオの音量調節が可能
	LRVolumeControl = &H0002
	'デバイスはキャッシングが可能
	PatchCaching = &H0004
	'デバイスはmidiSteamOut関数を直接サポート
	DirectSupportedMidiStreamOut = &H0008
End Enum

Class MidiOutCaps
	caps As MIDIOUTCAPS

Protected
	Sub _Initialize ( id As DWord )
		midiOutGetDevCaps(id,caps,SizeOf(MIDIOUTCAPS))
	End Sub

Public 'Property
	'製造業者IDの取得
	Function ManufacturerID () As Word
		Return This.caps.wMid
	End Function

	'製品IDの取得
	Function ProductID () As Word
		Return This.caps.wPid
	End Function

	'デバイスドライバのバージョンの取得
	Function DriverVersion () As DWord
		Return This.caps.vDriverVersion
	End Function

	'デバイス名の取得
	Function DeviceName () As String
		Return New System.String(This.caps.szPname As LPTSTR)
	End Function

	'MIDI出力デバイスの種類を取得
	Function DeviceType () As MidiOutDeviceType
		Return This.caps.wTechnology As MidiOutDeviceType
	End Function

	'MIDI出力デバイスがサポートするボイス数を取得
	Function NumberOfVoices () As Word
		Return This.caps.wVoices
	End Function

	'MIDI出力デバイスが同時に演奏することができるノート数
	Function NumberOfNotes () As Word
		Return This.caps.wNotes
	End Function

/*	Function Channel() As Word
		TODO
		This.caps.wChannelMask
	End Function*/

	'デバイスが提供している機能を取得
	Function SupportedFunctions () As MidiDeviceFunction
		Return This.caps.dwSupport As MidiDeviceFunction
	End Function

End Class

'MIDI出力デバイスを扱うためのクラス
Class MidiOutDevice
	id As DWord
	handle As HMIDIOUT

Protected
	Sub _Initialize ( id As DWord )
		This.id = id
	End Sub
	Function Handle () As HMIDIOUT
		Return This.handle
	End Function

Public
	Sub ~MidiOutDevice ()
		This.Close()
	End Sub

Public 'Property
	Function GetCapabilities () As MidiOutCaps
		Return New Detail._System_MidiOutCaps(This.id)
	End Function

Public 'Method
	'デバイスを閉じる
	Sub Close ()
		Dim ret = midiOutClose(InterlockedExchangePointer(ByVal VarPtr(This.handle) As VoidPtr, NULL))
	End Sub

	'デバイスのステレオ音量の左側の値を取得
	Function GetLeftVolume() As Word
		If This.handle=NULL Then Return 0
		Dim volume As DWord
		Dim ret = midiOutGetVolume(This.handle,volume)
		Return LOWORD(volume)
	End Function

	'デバイスのステレオ音量の右側の値を取得
	Function GetRightVolume() As Word
		If This.handle=NULL Then Return 0
		Dim volume As DWord
		Dim ret = midiOutGetVolume(This.handle,volume)
		Return HIWORD(volume)
	End Function

	'デバイスのモノラル音量を取得
	Function GetVolume () As Word
		If This.handle=NULL Then Return 0
		Return This.GetLeftVolume()
	End Function

	'デバイスを開く
	Sub Open ()
		Dim ret = midiOutOpen(This.handle,This.id,0,0,CALLBACK_NULL)
	End Sub

	'コールバックにSystem.Threading.EventWaitHandleを使用してデバイスを開く
	Sub Open ( callback As System.Threading.EventWaitHandle )
		Dim ret = midiOutOpen(This.handle,This.id,callback.Handle() As DWORD_PTR,0,CALLBACK_FUNCTION)
	End Sub

	'コールバックに関数を指定してデバイスを開く
	Sub Open ( callback As MIDICALLBACK )
		Dim ret = midiOutOpen(This.handle,This.id,callback As DWORD_PTR,0,CALLBACK_FUNCTION)
	End Sub

	'コールバックにSystem.Threading.Threadを使用してデバイスを開く
	Sub Open ( callback As System.Threading.Thread )
		Dim ret = midiOutOpen(This.handle,This.id,callback.ThreadId() As DWORD_PTR,0,CALLBACK_THREAD)
	End Sub

	'コールバックにウィンドウハンドルを指定してデバイスを開く
	Sub Open ( callback As HWND )
		Dim ret = midiOutOpen(This.handle,This.id,callback As DWORD_PTR,0,CALLBACK_WINDOW)
	End Sub

	'デバイスの出力を全て停止
	Sub Reset ()
		Dim ret = midiOutReset(This.handle)
	End Sub

	'デバイスにショートメッセージを送信
	Sub SendShortMsg ( msg As DWord )
		If This.handle=NULL Then Exit Sub
		Dim ret = midiOutShortMsg(This.handle,msg)
	End Sub

	'デバイスのステレオ音量の左側の値を設定
	Sub SetLeftVolume ( volume As Word )
		If This.handle=NULL Then Exit Sub
		Dim ret = midiOutSetVolume(This.handle,MAKELONG(volume,This.GetRightVolume()))
	End Sub

	'デバイスのステレオ音量の右側の値を設定
	Sub SetRightVolume ( volume As Word )
		If This.handle=NULL Then Exit Sub
		Dim ret = midiOutSetVolume(This.handle,MAKELONG(This.GetLeftVolume(),volume))
	End Sub

	'デバイスのモノラル音量を設定
	Sub SetVolume ( volume As Word )
		If This.handle=NULL Then Exit Sub
		This.SetLeftVolume(volume)
	End Sub

End Class

Class MidiOut
Public
	'MIDI出力デバイス数を取得
	Static Function NumberOfDevices () As DWord
		Return midiOutGetNumDevs()
	End Function

	'MIDIマッパーを取得
	Static Function GetMIDIMapper () As MidiOutDevice
		Return GetDeviceFromID(MIDI_MAPPER)
	End Function

	'MIDI出力デバイス名を全て取得
	Static Function GetDeviceNames () As System.Collections.Generic.IList<String>
		GetDeviceNames = New System.Collections.Generic.List<String>
		Dim dev = GetDevices()
		Dim d = Nothing As MidiOutDevice
		Foreach d In dev
			GetDeviceNames.Add(d.GetCapabilities().DeviceName())
		Next
	End Function

	'MIDI出力デバイスを全て取得
	Static Function GetDevices () As System.Collections.Generic.IList<MidiOutDevice>
		GetDevices = New System.Collections.Generic.List<MidiOutDevice>
		Dim num = NumberOfDevices
		Dim cnt As DWord
		For cnt=0 To num-1
			GetDevices.Add(GetDeviceFromID(cnt))
		Next
	End Function

	'IDを指定してMIDI出力デバイスを取得
	Static Function GetDeviceFromID ( id As DWord ) As MidiOutDevice
		Return New Detail._System_MidiOutDevice(id)
	End Function
End Class

Namespace Detail
Class _System_MidiOutCaps
	Inherits MidiOutCaps
Public
	Sub _System_MidiOutCaps ( id As DWord )
		This._Initialize(id)
	End Sub

	Override Function ToString () As String
		Return "MidiOutCaps"
	End Function
End Class

Class _System_MidiOutDevice
	Inherits MidiOutDevice
Public
	Sub _System_MidiOutDevice ( id As DWord )
		This._Initialize(id)
	End Sub

	Override Function ToString () As String
		Return "MidiOutDevice"
	End Function
End Class
End Namespace

End Namespace
End Namespace
End Namespace