MIDI test

Miscellaneous Forums/Win32 Discussion/MIDI test

Ziltch
 #1
Got it!

It still has some problems to iron out, but I thought you may want to have a look.

' Alpha MIDI In Test

Type MIDIINCAPS 
	Field wMid:Short
	Field wPid:Short
	Field vDriverVersion:Short'MMVERSION 
	Field szPname_0,szPname_1,szPname_2,szPname_3
	Field szPname_4,szPname_5,szPname_6,szPname_7
	Field dwSupport:Int
EndType

Type MidiHdr 
	Field lpData:byte ptr  '  tbank ptr 'LPSTR ptr
	Field dwBufferLength:Int
	Field dwBytesRecorded:Int
	Field dwUser:Int
	Field dwFlags:Int
	Field lpNext:Int 'midihdr_tag ptr
	Field reserved:Int
	Field dwOffset:Int
	Field dwReserved1:Int
	Field dwReserved2:Int
	Field dwReserved3:Int
	Field dwReserved4:Int
	Field dwReserved5:Int
	Field dwReserved6:Int
	Field dwReserved7:Int
	Field dwReserved8:Int
EndType


Extern "Win32"

	Function midiInOpen(lphMidiIn:int var, uDeviceID:Int, dwCallback:int , dwInstance:Int, dwFlags:Int)
	Function midiInPrepareHeader(hMidiIn:Int, lpMidiInHdr:byte ptr , uSize:Int)
	Function midiInAddBuffer(hMidiIn:Int, lpMidiInHdr:byte ptr, uSize:Int)
	Function midiInClose(hMidiIn:Int)
	Function midiInMessage(hMidiIn:Int, msg:Int, dw1:Int, dw2:Int)
	Function midiInGetNumDevs()
	Function midiInStart(hMidiIn:Int)
	Function midiInStop(hMidiIn:Int)

End Extern

Const CF = $30000

global MM_MIM_OPEN      =$3C1  
global MM_MIM_CLOSE     =$3C2
global MM_MIM_DATA      =$3C3
global MM_MIM_LONGDATA  =$3C4
global MM_MIM_ERROR     =$3C5
global MM_MIM_LONGERROR =$3C6 

global ControllerType$[128]

ControllerType$(0)  = "Bank Select (coarse)"
ControllerType$(1)   = "Modulation Wheel (coarse)"
ControllerType$(2)   = "Breath controller (coarse)"
ControllerType$(4)   = "Foot Pedal (coarse)"
ControllerType$(5)   = "Portamento Time (coarse)"
ControllerType$(6)   = "Data Entry (coarse)"
ControllerType$(7)   = "Volume (coarse)"
ControllerType$(8)   = "Balance (coarse)"
ControllerType$(10)  = "Pan position (coarse)"
ControllerType$(11)  = "Expression (coarse)"
ControllerType$(12)  = "Effect Control 1 (coarse)"
ControllerType$(13)  = "Effect Control 2 (coarse)"
ControllerType$(16)  = "General Purpose Slider 1"
ControllerType$(17)  = "General Purpose Slider 2"
ControllerType$(18)  = "General Purpose Slider 3"
ControllerType$(19)  = "General Purpose Slider 4"
ControllerType$(32)  = "Bank Select (fine)"
ControllerType$(33)  = "Modulation Wheel (fine)"
ControllerType$(34)  = "Breath controller (fine)"
ControllerType$(36)  = "Foot Pedal (fine)"
ControllerType$(37)  = "Portamento Time (fine)"
ControllerType$(38)  = "Data Entry (fine)"
ControllerType$(39)  = "Volume (fine)"
ControllerType$(40)  = "Balance (fine)"
ControllerType$(42)  = "Pan position (fine)"
ControllerType$(43  )  = "Expression (fine)"
ControllerType$(44  )  = "Effect Control 1 (fine)"
ControllerType$(45  )  = "Effect Control 2 (fine)"
ControllerType$(64  )  = "Hold Pedal (on/off)"
ControllerType$(65  )  = "Portamento (on/off)"
ControllerType$(66 )  = "Sustenuto Pedal (on/off)"
ControllerType$(67 )  = "Soft Pedal (on/off)"
ControllerType$(68 )  = "Legato Pedal (on/off)"
ControllerType$(69 )  = "Hold 2 Pedal (on/off)"
ControllerType$(70 )  = "Sound Variation"
ControllerType$(71 )  = "Sound Timbre"
ControllerType$(72 )  = "Sound Release Time"
ControllerType$(73 )  = "Sound Attack Time"
ControllerType$(74 )  = "Sound Brightness"
ControllerType$(75 )  = "Sound Control 6"
ControllerType$(76 )  = "Sound Control 7"
ControllerType$(77 )  = "Sound Control 8"
ControllerType$(78 )  = "Sound Control 9"
ControllerType$(79 )  = "Sound Control 10"
ControllerType$(80 )  = "General Purpose Button 1 (on/off)"
ControllerType$(81 )  = "General Purpose Button 2 (on/off)"
ControllerType$(82 )  = "General Purpose Button 3 (on/off)"
ControllerType$(83 )  = "General Purpose Button 4 (on/off)"
ControllerType$(91 )  = "Effects Level"
ControllerType$(92 )  = "Tremulo Level"
ControllerType$(93 )  = "Chorus Level"
ControllerType$(94 )  = "Celeste Level"
ControllerType$(95 )  = "Phaser Level"
ControllerType$(96 )  = "Data Button increment"
ControllerType$(97 )  = "Data Button decrement"
ControllerType$(98 )  = "Non-registered Parameter (fine)"
ControllerType$(99 )  = "Non-registered Parameter (coarse)"
ControllerType$(100)  = "Registered Parameter (fine)"
ControllerType$(101)  = "Registered Parameter (coarse)"
ControllerType$(120)  = "All Sound Off"
ControllerType$(121)  = "All Controllers Off"
ControllerType$(122)  = "Local Keyboard (on/off)"
ControllerType$(123)  = "All Notes Off"
ControllerType$(124)  = "Omni Mode Off"
ControllerType$(125)  = "Omni Mode On"
ControllerType$(126)  = "Mono Operation"
ControllerType(127)  = "Poly Operation"

global StatusType$[16]
StatusType(8) = "(Note Off)"
StatusType(9) = "(Note On)"
StatusType(10) = "(AfterTouch / key pressure)"
StatusType(11) = "(Control Change)"
StatusType(12) = "(Program (Patch) change)"
StatusType(13) = "(Channel Pressure)"
StatusType(14) = "(Pitch Wheel)"

global LinePos

Function MidiCallBackBM:int(hmIN:Int, wMsg:Int, dwInstance:Int, dwParam1:Int, dwParam2:Int)"Win32"

	if hmIN > 0 then 
		seperator$ = ","
		time=dwParam2/1000
		hours = int(time/360) 
		time   =time-(hours*360)
		mins   =  int(time/60) 
		secs      =time-(hours*60)
		partsec = dwParam2 - (( (hours*360)+(mins*60)+secs) *1000)
		MidiTimeStamp$ = (hours) +":"+(mins) +":"+(secs) +"."+right("0"+(partsec),3) 
		MidiNote$ = ""
		MidiVel$    = "" 
		MidiChannel$ = ""  
   
		Select wMsg
			Case MM_MIM_OPEN
			Midifunct$ = "Open Midi"
    
			Case MM_MIM_CLOSE
			Midifunct$ = "Close Midi"
			Case MM_MIM_DATA 
		'	MessageRequester("","MIDI data",0)
			Midifunct$ = hex$((dwParam1 & $000000F0) shr 4)
			MidiStatus$ = StatusType$((dwParam1 & $000000F0) shr 4 )
			MidiChannel$ =  hex$(dwParam1 & $0000000F)
			MidiNote$ =hex$( (dwParam1 shr 8) & $000000FF)
			If Midifunct$ ="B" 
				ct$ = ControllerType((dwParam1 shr 8) & $000000FF) 
				If ct > "" 
					MidiController$ = " ("+ct$+")"
				EndIf 
			EndIf
			MidiVel$    = hex$((dwParam1 shr 16) & $000000FF)

			Case MM_MIM_ERROR
			Midifunct$ = "Midi Error"
			Case MM_MIM_LONGERROR
			Midifunct$ = "Long Midi Error"
		End Select
	output$=MidiTimeStamp$ + "  "+Midifunct$+" "+MidiStatus$+ "  "+MidiChannel$+ "  "+MidiNote$+MidiController$+ "  "+MidiVel$
	DebugLog output$
	
	LinePos:+1
	if LinePos > 30 then 
		LinePos = 0
		cls
	endif
    DrawText(output$,20,LinePos*18)
    flip
	EndIf
EndFunction

global MidiIn:Int ,Callback :int , MidiDevice
global MidiInHandle:int ' 

' MidiInHandle = Varptr MidiIn
Global midiHeader:MidiHdr = new MidiHdr
'Global MidiINhandle

Global BufferSize
BufferSize = 4096 ' 1024
'global SysXBuffer:byte(BufferSize)
SysXBuffer:Tbank = CreateBank(BufferSize)

CallBack = int(byte ptr(MidiCallBackBM))

DebugLog " Callback  = "+int(Callback)

Print "Select Input Device: 1 - " + midiInGetNumDevs() ' + " Byte Ptr(MyCallBack) = "+int(Byte Ptr(MyCallBack))

MidiDevice = int(Input( ">"))

Graphics 800,600,0

ok = MidiInOpen(MidiInHandle,MidiDevice-1,CallBack,2778,CF)  

print ok + " MidiInHandle = " + MidiInHandle
if ok=0 then
	midiHeader.lpData =  BankBuf(SysXBuffer)

	'  Store its size in the MIDIHDR
	midiHeader.dwBufferLength =  BufferSize
	
	'  Flags must be set to 0
	midiHeader.dwFlags = 0
	
	'  Prepare the buffer and MIDIHDR
	err = midiInPrepareHeader(MidiInHandle,varptr(midiHeader.lpData), BufferSize)
	
		If (err=0) then
	'  ; Queue MIDI input buffer
			err = midiInAddBuffer(MidiInHandle,varptr(midiHeader.lpData), BufferSize)
	'  ;	debug( midiHeader\lpData)
			If (err=0)
	'    ; Start recording Midi
				err = midiInStart(MidiInHandle)
	print "Midi in " + err + "   Opened"
	Else
	print "Midi buffer " + err + "  NOT Opened"
	EndIf
	else
	print "Midi PrepareHeader " + err + "  Failed" + "   varptr(midiHeader) "+int(varptr(midiHeader))
		EndIf
	
	While Not KeyDown(KEY_ESCAPE)
	Wend
	
	midiInStop(MIDI)
	MidiInClose(MidiInHandle)
	Print "Midi in " + MIDI + " Closed"
EndIf
End


This makes me very Happy !!!!!