Interface PB_MIDI
  GetLastErrorText.s()
  GetLastErrorNr.l()
  
  Kill.l()
  
  OpenOutputDevice.l(DeviceID.l)
  CloseOutputDevice.l()
  OpenInputDevice.l(DeviceID.l)
  CloseInputDevice.l()
  StartInput.l()
  StopInput.l()
  ResetInput.l()
  
  ProgramChange.l(Channel.b, Voice.b)
  NoteOn.l(Channel.b, Note.b, Velocity.b)
  NoteOff.l(Channel.b, Note.b, Velocity.b)
  NoteOffAlternate.l(Channel.b, Note.b)
  AllNotesOff.l(Channel.b)
  ChangeController.l(Channel.b, Controller.b, Value.b)
  ChannelPressure.l(Channel.b, Value.b)
  KeyAftertouch.l(Channe.b, Note.b, Value.b)
  PitchWheel.l(Channel.b, Value.w)
EndInterface
Structure PB_MIDI_Struc
  VTable.l
  
  ;Functions
  fGetLastErrorText.l
  fGetLastErrorNr.l
  fKill.l
  fOpenOutputDevice.l
  fCloseOutputDevice.l
  fOpenInputDevice.l
  fCloseInputDevice.l
  fStartInput.l
  fStopInput.l
  fResetInput.l
  fProgramChange.l
  fNoteOn.l
  fNoteOff.l
  fNoteOffAlternate.l
  fAllNotesOff.l
  fChangeController.l
  fChannelPressure.l
  fKeyAftertouch.l
  fPitchWheel.l
  
  ;Data
  OutDevice.l
  InDevice.l
  InCallback.l
  hOutDevice.l
  hInDevice.l
  LastError.l
  LastErrorFunc.l
EndStructure
Structure PB_MIDI_Msg
  Channel.b
  Note.b
  Velocity.b
  Null.b
EndStructure 

#MIDIERR_BADOPENMODE = #MIDIERR_BASE + 6

Procedure.s PB_MIDI_GetLastErrorText(*PM.PB_MIDI_Struc)
  Protected ErrorText.s
  ErrorText = "Error: "
  Select *PM\LastError
    Case #MMSYSERR_NOERROR : ErrorText + "No Error"
    Case #MIDIERR_NODEVICE : ErrorText + "No MIDI port was found. This error occurs only when the mapper is opened."
    Case #MMSYSERR_ALLOCATED : ErrorText + "The specified resource is already allocated."
    Case #MMSYSERR_BADDEVICEID : ErrorText + "The specified device identifier is out of range."
    Case #MMSYSERR_INVALPARAM : ErrorText + "The specified pointer or structure is invalid."
    Case #MMSYSERR_NOMEM : ErrorText + "The system is unable to allocate or lock memory."
    Case #MMSYSERR_INVALHANDLE : ErrorText + "The specified device handle is invalid."
    Case #MIDIERR_BADOPENMODE : ErrorText + "The application sent a message without a status byte to a stream handle."
    Case #MIDIERR_NOTREADY : ErrorText + "The hardware is busy with other data."
    Case #MIDIERR_STILLPLAYING : ErrorText + "Buffers are still in the queue."
    
    Default : ErrorText + "Code " + Str(*PM\LastError)
  EndSelect
  ErrorText + #CRLF$ + "Function: "
  Select *PM\LastErrorFunc
    Case  0 : ErrorText + "No Function"
    Case  1 : ErrorText + "OpenOutptDevice"
    Case  2 : ErrorText + "OpenInputDevice"
    Case  3 : ErrorText + "StartInput"
    Case  4 : ErrorText + "StopInput"
    Case  5 : ErrorText + "ResetInput"
    Case  6 : ErrorText + "ProgramChange"
    Case  7 : ErrorText + "NoteOn"
    Case  8 : ErrorText + "NoteOff"
    Case  9 : ErrorText + "NoteOffAlternate"
    Case 10 : ErrorText + "AllNotesOff"
    Case 11 : ErrorText + "ChangeController"
    Case 12 : ErrorText + "ChannelPressure"
    Case 13 : ErrorText + "KeyAftertouch"
    Case 14 : ErrorText + "PitchWheel"
    Case 15 : ErrorText + "CloseOutputDevice"
    Case 16 : ErrorText + "CloseInputDevice"
    Default : ErrorText + "Unknown"
  EndSelect
  *PM\LastError = #MMSYSERR_NOERROR
  *PM\LastErrorFunc = 0
  ProcedureReturn ErrorText
EndProcedure
Procedure PB_MIDI_GetLastErrorNr(*PM.PB_MIDI_Struc)
  Protected Error.l
  Error = *PM\LastError
  *PM\LastError = 0
  ProcedureReturn Error
EndProcedure

Procedure PB_MIDI_OpenOutputDevice(*PM.PB_MIDI_Struc, DeviceID.l)
  Protected Error.l
  Error = midiOutOpen_(@*PM\hOutDevice, DeviceID, 0, 0, 0)
  If Error = #MMSYSERR_NOERROR
    *PM\OutDevice = DeviceID
    ProcedureReturn #True
  Else
    *PM\LastErrorFunc = 1
    *PM\LastError = Error
    ProcedureReturn #False
  EndIf
EndProcedure
Procedure PB_MIDI_CloseOutputDevice(*PM.PB_MIDI_Struc)
  Protected Error.l
  Error = midiOutClose_(*PM\hOutDevice)
  If Error = #MMSYSERR_NOERROR
    *PM\OutDevice = 0
    *PM\hOutDevice = 0
    ProcedureReturn #True
  Else
    *PM\LastErrorFunc = 15
    *PM\LastError = Error
    ProcedureReturn #False
  EndIf
EndProcedure

Procedure PB_MIDI_InCallback(hMidiIn.l, wMsg.l, *PM.PB_MIDI_Struc, dwMideMessage.l, dwTimeStamp.l)

EndProcedure
Procedure PB_MIDI_OpenInputDevice(*PM.PB_MIDI_Struc, DeviceID.l, Callback.l)
  Protected Error.l
  
  Error = midiInOpen_(@*PM\hInDevice, DeviceID, @PB_MIDI_InCallback(), *PM, #CALLBACK_FUNCTION)
  If Error = #MMSYSERR_NOERROR
    *PM\InDevice = DeviceID
    *PM\InCallback = Callback
    ProcedureReturn #True
  Else
    *PM\LastErrorFunc = 2
    *PM\LastError = Error
    ProcedureReturn #False
  EndIf 
EndProcedure
Procedure PB_MIDI_CloseInputDevice(*PM.PB_MIDI_Struc)
  Protected Error.l
  Error = midiInClose_(*PM\hInDevice)
  If Error = #MMSYSERR_NOERROR
    *PM\InDevice = 0
    *PM\hInDevice = 0
    *PM\InCallback = 0
    ProcedureReturn #True
  Else
    *PM\LastErrorFunc = 16
    *PM\LastError = Error
    ProcedureReturn #False
  EndIf
EndProcedure
Procedure PB_MIDI_StartInput(*PM.PB_MIDI_Struc)
  Protected Error.l
  
  Error = midiInStart_(*PM\hInDevice)
  If Error = #MMSYSERR_NOERROR
    ProcedureReturn #True
  Else
    *PM\LastErrorFunc = 3
    *PM\LastError = Error
    ProcedureReturn #False
  EndIf
EndProcedure
Procedure PB_MIDI_StopInput(*PM.PB_MIDI_Struc)
  Protected Error.l
  
  Error = midiInStop_(*PM\hInDevice)
  If Error = #MMSYSERR_NOERROR
    ProcedureReturn #True
  Else
    *PM\LastErrorFunc = 4
    *PM\LastError = Error
    ProcedureReturn #False
  EndIf
EndProcedure
Procedure PB_MIDI_ResetInput(*PM.PB_MIDI_Struc)
  Protected Error.l
  
  Error = midiInReset_(*PM\hInDevice)
  If Error = #MMSYSERR_NOERROR
    ProcedureReturn #True
  Else
    *PM\LastErrorFunc = 5
    *PM\LastError = Error
    ProcedureReturn #False
  EndIf
EndProcedure

;Channel: 0-15
;Voice: 0-127
;Note: 0-127
;Controller: 0-127
;Value: 0-127
;Value von PitchWheel: 0-32768 (?)
Procedure PB_MIDI_ProgramChange(*PM.PB_MIDI_Struc, Channel.b, Voice.b)
  Protected Msg.PB_MIDI_Msg, Error.l
  Msg\Channel = $C0 + Channel
  Msg\Note = Voice
  Error = midiOutShortMsg_(*PM\hOutDevice, PeekW(@Msg))
  If Error = #MMSYSERR_NOERROR
    ProcedureReturn #True
  Else
    *PM\LastError = Error
    *PM\LastErrorFunc = 6
    ProcedureReturn #False
  EndIf
EndProcedure
Procedure PB_MIDI_NoteOn(*PM.PB_MIDI_Struc, Channel.b, Note.b, Velocity.b)
  Protected Msg.PB_MIDI_Msg, Error.l
  Msg\Channel = $90 + Channel
  Msg\Note = Note
  Msg\Velocity = Velocity
  Msg\Null = 0
  Error = midiOutShortMsg_(*PM\hOutDevice, PeekL(@Msg))
  If Error = #MMSYSERR_NOERROR
    ProcedureReturn #True
  Else
    *PM\LastError = Error
    *PM\LastErrorFunc = 7
    ProcedureReturn #False
  EndIf
EndProcedure
Procedure PB_MIDI_NoteOff(*PM.PB_MIDI_Struc, Channel.b, Note.b, Velocity.b)
  Protected Msg.PB_MIDI_Msg, Error.l
  Msg\Channel = $80 + Channel
  Msg\Note = Note
  Msg\Velocity = Velocity
  Msg\Null = 0
  Error = midiOutShortMsg_(*PM\hOutDevice, PeekL(@Msg))
  If Error = #MMSYSERR_NOERROR
    ProcedureReturn #True
  Else
    *PM\LastError = Error
    *PM\LastErrorFunc = 8
    ProcedureReturn #False
  EndIf
EndProcedure
Procedure PB_MIDI_NoteOffAlternate(*PM.PB_MIDI_Struc, Channel.b, Note.b)
  Protected Msg.PB_MIDI_Msg, Error.l
  Msg\Channel = $90 + Channel
  Msg\Note = Note
  Msg\Velocity = 0
  Msg\Null = 0
  Error = midiOutShortMsg_(*PM\hOutDevice, PeekL(@Msg))
  If Error = #MMSYSERR_NOERROR
    ProcedureReturn #True
  Else
    *PM\LastError = Error
    *PM\LastErrorFunc = 9
    ProcedureReturn #False
  EndIf
EndProcedure
Procedure PB_MIDI_AllNotesOff(*PM.PB_MIDI_Struc, Channel.b)
  Protected Msg.PB_MIDI_Msg, Error.l
  Msg\Channel = $B0 + Channel
  Msg\Note = $7B
  Msg\Velocity = 0
  Msg\Null = 0
  Error = midiOutShortMsg_(*PM\hOutDevice, PeekL(@Msg))
  If Error = #MMSYSERR_NOERROR
    ProcedureReturn #True
  Else
    *PM\LastError = Error
    *PM\LastErrorFunc = 10
    ProcedureReturn #False
  EndIf
EndProcedure
Procedure PB_MIDI_ChangeController(*PM.PB_MIDI_Struc, Channel.b, Controller.b, Value.b)
  Protected Msg.PB_MIDI_Msg, Error.l
  Msg\Channel = $B0 + Channel
  Msg\Note = Controller
  Msg\Velocity = Value
  Msg\Null = 0
  Error = midiOutShortMsg_(*PM\hOutDevice, PeekL(@Msg))
  If Error = #MMSYSERR_NOERROR
    ProcedureReturn #True
  Else
    *PM\LastError = Error
    *PM\LastErrorFunc = 11
    ProcedureReturn #False
  EndIf
EndProcedure
Procedure PB_MIDI_ChannelPressure(*PM.PB_MIDI_Struc, Channel.b, Value.b)
  Protected Msg.PB_MIDI_Msg, Error.l
  Msg\Channel = $D0 + Channel
  Msg\Note = Value
  Msg\Velocity = 0
  Msg\Null = 0
  Error = midiOutShortMsg_(*PM\hOutDevice, PeekL(@Msg))
  If Error = #MMSYSERR_NOERROR
    ProcedureReturn #True
  Else
    *PM\LastError = Error
    *PM\LastErrorFunc = 12
    ProcedureReturn #False
  EndIf
EndProcedure
Procedure PB_MIDI_KeyAftertouch(*PM.PB_MIDI_Struc, Channel.b, Note.b, Value.b)
  Protected Msg.PB_MIDI_Msg, Error.l
  Msg\Channel = $A0 + Channel
  Msg\Note = Note
  Msg\Velocity = Value
  Msg\Null = 0
  Error = midiOutShortMsg_(*PM\hOutDevice, PeekL(@Msg))
  If Error = #MMSYSERR_NOERROR
    ProcedureReturn #True
  Else
    *PM\LastError = Error
    *PM\LastErrorFunc = 12
    ProcedureReturn #False
  EndIf
EndProcedure
Procedure PB_MIDI_PitchWheel(*PM.PB_MIDI_Struc, Channel.b, Value.w)
  Protected Msg.PB_MIDI_Msg, Error.l
  Msg\Channel = $E0 + Channel
  Msg\Null = 0
  PokeW(@Msg, Value)
  Error = midiOutShortMsg_(*PM\hOutDevice, PeekL(@Msg))
  If Error = #MMSYSERR_NOERROR
    ProcedureReturn #True
  Else
    *PM\LastError = Error
    *PM\LastErrorFunc = 12
    ProcedureReturn #False
  EndIf
EndProcedure

Procedure PB_MIDI_Kill(*PM.PB_MIDI_Struc)
  While midiInClose_(*PM\hInDevice) = #MIDIERR_STILLPLAYING : Wend 
  While midiOutClose_(*PM\hOutDevice) = #MIDIERR_STILLPLAYING : Wend 
  FreeMemory(*PM)
  ProcedureReturn #True
EndProcedure

Procedure PB_MIDI_Create()
  Protected *PM.PB_MIDI_Struc
  
  *PM = AllocateMemory(SizeOf(PB_MIDI_Struc))
  If *PM = 0 : ProcedureReturn #False : EndIf
  *PM\VTable = *PM + 4
  *PM\fGetLastErrorText  = @PB_MIDI_GetLastErrorText()
  *PM\fGetLastErrorNr    = @PB_MIDI_GetLastErrorNr()
  *PM\fKill              = @PB_MIDI_Kill()
  *PM\fOpenOutputDevice  = @PB_MIDI_OpenOutputDevice()
  *PM\fOpenInputDevice   = @PB_MIDI_OpenInputDevice()
  *PM\fStartInput        = @PB_MIDI_StartInput()
  *PM\fStopInput         = @PB_MIDI_StopInput()
  *PM\fResetInput        = @PB_MIDI_ResetInput()
  *PM\fProgramChange     = @PB_MIDI_ProgramChange()
  *PM\fNoteOn            = @PB_MIDI_NoteOn()
  *PM\fNoteOff           = @PB_MIDI_NoteOff()
  *PM\fNoteOffAlternate  = @PB_MIDI_NoteOffAlternate()
  *PM\fAllNotesOff       = @PB_MIDI_AllNotesOff()
  *PM\fChangeController  = @PB_MIDI_ChangeController()
  *PM\fChannelPressure   = @PB_MIDI_ChannelPressure()
  *PM\fKeyAftertouch     = @PB_MIDI_KeyAftertouch()
  *PM\fPitchWheel        = @PB_MIDI_PitchWheel()
  
  ProcedureReturn *PM
EndProcedure

Procedure MIDIRequester(*OutDevice.l, *InDevice.l) 
  Protected WinID.l
  Protected List1.l, List2.l, But1.l, But2.l, Txt1.l, Txt2.l, Txt3.l, Txt4.l
  Protected MaxOutDev.l, InfoOut.MIDIOUTCAPS, InDev.l, OutDev.l, Quit.l, Ok.l, EventID.l, a.l
  Protected Width.l, Column.l, Offset.l
  
  #MOD_WAVETABLE = 6 
  #MOD_SWSYNTH = 7 
  #MIDIRequ_InSet = 2 
  #MIDIRequ_OutSet = 1 

  Width = 400 
  WinID = OpenWindow(#PB_Any, 0, 0, Width, 270, #PB_Window_SystemMenu | #PB_Window_ScreenCentered, "MIDI-Requester") 
  If WinID
    If CreateGadgetList(WindowID(WinID)) 
      Column = (Width - 20) / 2 
      Offset = (Width / 2) + 5 
      
      TextGadget(#PB_Any, 5, 5, Column, 18, "Output-Device:", #PB_Text_Center | #PB_Text_Border) 
      List1 = ListViewGadget(#PB_Any, 5, 23, Column, 100) 
        MaxOutDev = midiOutGetNumDevs_() 
        If MaxOutDev 
          For a = -1 To MaxOutDev - 1 
            midiOutGetDevCaps_(a, InfoOut, SizeOf(MIDIOUTCAPS)) 
            AddGadgetItem(List1, -1, PeekS(@InfoOut\szPname[0], 32)) 
          Next 
        Else 
          AddGadgetItem(List1, -1, "(no output device)") 
          DisableGadget(List1, 1) 
        EndIf 
      If *OutDevice = 0 : DisableGadget(List1, 1) : EndIf
      
      TextGadget(#PB_Any, Offset, 5, Column, 18, "Input-Device:", #PB_Text_Center | #PB_Text_Border) 
      List2 = ListViewGadget(#PB_Any, Offset, 23, Column, 100) 
        MaxInDev.l = midiInGetNumDevs_() 
        InfoIn.MIDIINCAPS 
        If MaxInDev 
          For a = 0 To MaxInDev - 1 
            midiInGetDevCaps_(a, InfoIn, SizeOf(MIDIINCAPS)) 
            AddGadgetItem(List2, -1, PeekS(@InfoIn\szPname[0], 32)) 
          Next 
        Else 
          AddGadgetItem(List2, -1, "(no input device)") 
          DisableGadget(List2, 1) 
        EndIf 
      If *InDevice = 0 : DisableGadget(List2, 1) : EndIf
      
      But1 = ButtonGadget(#PB_Any, 5, 240, Column, 24, "&OK") 
      But2 = ButtonGadget(#PB_Any, Offset, 240, Column, 24, "&Cancel") 
      
      Frame3DGadget(#PB_Any, 5, 130, Width - 10, 100, "Info of Output-Device", 0) 
       Txt1 = TextGadget(#PB_Any, 10, 145, Width - 20, 18, "Version:") 
       Txt2 = TextGadget(#PB_Any, 10, 165, Width - 20, 18, "Technology:") 
       Txt3 = TextGadget(#PB_Any, 10, 185, Width - 20, 18, "Max. Voices:") 
       Txt4 = TextGadget(#PB_Any, 10, 205, Width - 20, 18, "Polyphonie:") 
      
      OutDev = 0 
      InDev = 0 
      Quit = #False 
      Ok = #False 
      Repeat 
        If GetGadgetState(List1) > -1 Or GetGadgetState(List2) > -1 
          DisableGadget(But1, 0) 
        Else 
          DisableGadget(But1, 1) 
        EndIf 
        
        If InDev <> GetGadgetState(List2) 
          InDev = GetGadgetState(List2) 
        EndIf 
        
        If GetGadgetState(List1) <> OutDev 
          OutDev = GetGadgetState(List1) 
          midiOutGetDevCaps_(OutDev - 1, InfoOut, SizeOf(MIDIOUTCAPS)) 
          SetGadgetText(Txt1, "Version: " + Str(InfoOut\vDriverVersion >> 8) + "." + Str(InfoOut\vDriverVersion & FF)) 
          Select InfoOut\wTechnology 
            Case #MOD_MIDIPORT :  TmpS.s = "Hardware Port" 
            Case #MOD_SYNTH :     TmpS.s = "Synthesizer" 
            Case #MOD_SQSYNTH :   TmpS.s = "Square Wave Synthesizer" 
            Case #MOD_FMSYNTH :   TmpS.s = "FM Synthesizer" 
            Case #MOD_MAPPER :    TmpS.s = "Microsoft MIDI Mapper" 
            Case #MOD_WAVETABLE : TmpS.s = "Hardware Wavetable Synthesizer" 
            Case #MOD_SWSYNTH :   TmpS.s = "Software Synthesizer" 
            Default: TmpS.s = "(Error Code " + Str(InfoOut\wTechnology) + ")" 
          EndSelect 
          SetGadgetText(Txt2, "Technology: " + TmpS) 
          If InfoOut\wVoices = 0 : TmpS.s = "inf" : Else : TmpS.s = Str(InfoOut\wVoices) : EndIf 
          SetGadgetText(Txt3, "Max. Voices: " + TmpS) 
          If InfoOut\wNotes = 0 : TmpS.s = "inf" : Else : TmpS.s = Str(InfoOut\wNotes) : EndIf 
          SetGadgetText(Txt4, "Polyphonie: " + TmpS) 
        EndIf 
        
        EventID = WaitWindowEvent() 
        Select EventID 
          Case #PB_EventCloseWindow 
            Quit = #True 
            Ok = #False 
          Case #PB_EventGadget 
            Select EventGadgetID() 
              Case But1 
                If *OutDevice : PokeL(*OutDevice, OutDev - 1) : EndIf
                If *InDevice : PokeL(*InDevice, InDev)  : EndIf
                Quit = #True 
                Ok = 3 
                If (OutDev = -1 Or CountGadgetItems(List1) = 0) And Ok & #MIDIRequ_OutSet : Ok ! #MIDIRequ_OutSet : EndIf 
                If (InDev = -1 Or CountGadgetItems(List2) = 0) And Ok & #MIDIRequ_InSet : Ok ! #MIDIRequ_InSet : EndIf 
              Case But2
                Quit = #True 
                Ok = #False 
            EndSelect 
        EndSelect 
      Until Quit 
      CloseWindow(WinID) 
      ProcedureReturn Ok 
    EndIf 
  EndIf 
  ProcedureReturn #False
EndProcedure 

; jaPBe Version=2.5.2.24
; FoldLines=00000017001800380039003E0042006B006C00710073007E007F008B008D008F
; FoldLines=0090009D009E00AB00AC00B700B800C300C400CF00D700E300E400F200F30101
; FoldLines=010201100111011F0120012E012F013D013E014C014D015A015C01610163017C
; FoldLines=017E01F3
; Build=0
; CompileThis=Inc_Play.pbi
; FirstLine=8
; CursorPosition=382
; ExecutableFormat=Windows
; DontSaveDeclare
; EOF