Differenze tra le versioni di "Intercettare ed inviare dati Midi grezzi con le funzioni esterne del API di PortMidi"

Da Gambas-it.org - Wikipedia.
 
(2 versioni intermedie di uno stesso utente non sono mostrate)
Riga 3: Riga 3:
 
E' possibile con alcune funzioni esterne della libreria ''PortMidi'' intercettare i dati Midi grezzi, provenienti da un dispositivo Midi, ed inviarli ad altri dispositivi Midi.
 
E' possibile con alcune funzioni esterne della libreria ''PortMidi'' intercettare i dati Midi grezzi, provenienti da un dispositivo Midi, ed inviarli ad altri dispositivi Midi.
  
Sarà necessario avere installata nel proprio sistema e richiamare nel programma Gambas la libreria condivisa: ''''libportmidi.so.0.0.0''
+
Sarà necessario avere installata nel proprio sistema e richiamare nel programma Gambas la libreria condivisa: "''libportmidi.so.2.0.3'' ".
  
 +
Mostriamo di seguito due semplici esempi.
 +
===Inviare Messaggi Midi ad un dispositivo Midi===
 +
In questo esempio si invieranno al ''softsynth'' tramite il sistema Alsa i messaggi Midi di "''Program Change''", "''Note On''" e dopo un secondo un messaggio di "''Note Off''" :
 +
Private Const NOTEOFF As Integer = &80
 +
Private Const NOTEON As Integer = &90
 +
Private Const PROGRAM_CHANGE As Integer = &C0
 +
 +
 +
Library "libportmidi:2.0.3"
 +
 +
Public Struct PmDeviceInfo
 +
  structVersion As Integer
 +
  interf As Pointer
 +
  name As Pointer
 +
  inputI As Integer
 +
  outputI As Integer
 +
  opened As Integer
 +
End Struct
 +
 +
<FONT color=gray>' ''PmError Pm_Initialize(void)''
 +
' ''Library initialisation function.''</font>
 +
Private Extern Pm_Initialize()
 +
 +
<FONT color=gray>' ''int Pm_CountDevices (void)''
 +
' ''Get devices count, ids range from 0 to Pm_CountDevices()-1.''</font>
 +
Private Extern Pm_CountDevices() As Integer
 +
 +
<FONT color=gray>' ''const char *Pm_GetErrorText( PmError errnum )''
 +
' ''Translate portmidi error number into human readable message.''</font>
 +
Private Extern Pm_GetErrorText(errnum As Integer) As String
 +
 +
<FONT color=gray>' ''const PmDeviceInfo* Pm_GetDeviceInfo( PmDeviceID id )''
 +
' ''Returns a pointer to a PmDeviceInfo structure referring to the device specified by id.''</font>
 +
Private Extern Pm_GetDeviceInfo(id As Integer) As PmDeviceInfo
 +
 +
<FONT color=gray>' ''PmError Pm_OpenOutput (PortMidiStream **stream, PmDeviceID outputDevice, void *outputDriverInfo, long bufferSize, PmTimeProcPtr time_proc, void *time_info, long latency)''
 +
' ''Open Output device.''</font>
 +
Private Extern Pm_OpenOutput(pstream As Pointer, outputDevice As Integer, outputDriverInfo As Pointer, bufferSize As Integer, time_proc As Pointer, latency As Long) As Integer
 +
 +
<FONT color=gray>' ''PmError Pm_WriteShort( PortMidiStream *stream, PmTimestamp when, int32_t msg)''
 +
' ''Writes a timestamped non-system-exclusive midi message.''</font>
 +
Private Extern Pm_WriteShort(_stream As Pointer, when As Integer, msg As Integer) As Integer
 +
 +
<FONT color=gray>' ''PmError Pm_Close( PortMidiStream* stream )''
 +
' ''Closes a midi stream, flushing any pending buffers.''</font>
 +
Private Extern Pm_Close(pstream As Pointer) As Integer
 +
 +
<FONT color=gray>' ''PmError Pm_Terminate( void )''
 +
' ''Library termination function.''</font>
 +
Private Extern Pm_Terminate() As Integer
 +
 +
 +
Library "libporttime:0.0.0"
 +
 +
<FONT color=gray>' ''PtError Pt_Start(int resolution, PtCallback *callback, void *userData)''
 +
' ''Starts a real-time service.''</font>
 +
Private Extern Pt_Start(resolution As Integer, callback As Pointer, userData As Pointer)
 +
 +
<FONT color=gray>' ''PtTimestamp Pt_Time()''
 +
' ''Returns the current time in ms.''</font>
 +
Private Extern Pt_Time() As Integer
 +
 +
 
 +
Public Sub Main()
 +
 
 +
  Dim cd, i, err As Integer
 +
  Dim info As PmDeviceInfo
 +
  Dim s As String
 +
  Dim midi_out As Pointer
 +
 
 +
  Pm_Initialize()
 +
 
 +
<FONT color=gray>' ''Print "Dispositivi Midi e loro porte disponibili:\n"''</font>
 +
  cd = Pm_CountDevices()
 +
  If cd Then
 +
    For i = 0 To cd - 1
 +
      info = Pm_GetDeviceInfo(i)
 +
      If info.outputI Then Print i; " : "; String@(info.name)
 +
    Next
 +
    Pt_Start(1, 0, 0)
 +
<FONT color=gray>' ''Attende che sia inserito il numero del dispositivo Midi, al quale si invieranno i dati Midi:''</font>
 +
    Print "\nAssicurarsi di aver connesso le porte dei dispositivi Midi coinvolti !"
 +
    Print "\nInserire il numero del dispositivo Midi, al quale si invieranno i dati Midi..."
 +
    Input s
 +
    Print "Dispositivo Midi scelto numero:  "; s
 +
    err = Pm_OpenOutput(VarPtr(midi_out), Val(s), 0, 256, 0, 0)
 +
    If err Then
 +
      Print Pm_GetErrorText(err)
 +
      Chiude()
 +
    Endif
 +
    Invia_Messaggi(midi_out)
 +
<FONT color=gray>' ''Va in chiusura:''</font>
 +
    Pm_Close(midi_out)
 +
    Chiude()
 +
  Else
 +
    Chiude()
 +
    Error.Raise("Nessun dispositivo Midi di Uscita disponibile  !")
 +
  Endif
 +
 +
End
 +
 
 +
 
 +
Private Procedure Invia_Messaggi(midexitus As Pointer)
 +
 
 +
  Dim can, prg, tempus As Integer
 +
 
 +
<FONT color=gray>' ''Imposta i valori del Canale e del messaggio Midi del "Program Change":''</font>
 +
  can = 0
 +
  prg = 24
 +
 
 +
<FONT color=gray>' ''Invia il messaggio del "Program Change":''</font>
 +
  Pm_WriteShort(midexitus, 0, Pm_Message(PROGRAM_CHANGE Or can, prg, 0))
 +
 
 +
  tempus = Pt_Time()
 +
 
 +
<FONT color=gray>' ''Invia il messaggio del "Note On":''</font>
 +
  Pm_WriteShort(midexitus, 0, Pm_Message(NOTEON Or can, 60, 100))
 +
 
 +
  While (Pt_Time() - tempus) < 1000
 +
    wait 0.01
 +
  Wend
 +
 
 +
<FONT color=gray>' ''Invia il messaggio del "Note Off":''</font>
 +
  Pm_WriteShort(midexitus, 0, Pm_Message(NOTEOFF Or can, 60, 0))
 +
  Wait 0.01
 +
   
 +
End
 +
 +
 +
Private Function Pm_Message(status As Integer, data1 As Integer, data2 As Integer) As Integer
 +
 
 +
  Return (((data2 * CInt(2 ^ 16)) And &FF0000) Or ((data1 * CInt(2 ^ 8)) And &FF00) Or ((status) And &FF))
 +
 
 +
End
 +
 +
 +
Private Procedure Chiude()
 +
 
 +
  Pm_Terminate()
 +
 
 +
End
  
Mostriamo di seguito un possibile codice che intercetta i dati Midi grezzi provenienti da un dispositivo esterno e li invia ad altro dispositivo Midi:
+
 
 +
===Intercettare dati Midi grezzi provenienti da un dispositivo esterno e inviarli ad altro dispositivo Midi===
 
  Private s As String
 
  Private s As String
 
   
 
   
 
   
 
   
  Library "libportmidi:0.0.0"
+
  Library "libportmidi:2.0.3"
 
   
 
   
 
  Public Struct PmDeviceInfo
 
  Public Struct PmDeviceInfo
Riga 41: Riga 183:
 
  ' ''Returns a pointer to a PmDeviceInfo structure referring to the device specified by id.''</font>
 
  ' ''Returns a pointer to a PmDeviceInfo structure referring to the device specified by id.''</font>
 
  Private Extern Pm_GetDeviceInfo(id As Integer) As PmDeviceInfo
 
  Private Extern Pm_GetDeviceInfo(id As Integer) As PmDeviceInfo
 +
 +
<FONT color=gray>' ''PmDeviceID Pm_GetDefaultInputDeviceID( void )''
 +
' ''Return the default device ID or pmNoDevice if there are no devices.''</font>
 +
Private Extern Pm_GetDefaultInputDeviceID() As Integer
 +
 +
<FONT color=gray>' ''PmDeviceID Pm_GetDefaultOutputDeviceID( void )''
 +
' ''Return the default device ID or pmNoDevice if there are no devices.''</font>
 +
Private Extern Pm_GetDefaultOutputDeviceID() As Integer
 
    
 
    
 
  <FONT color=gray>' ''PmError Pm_OpenInput( PortMidiStream** stream, PmDeviceID inputDevice, void *inputDriverInfo, int32_t bufferSize, PmTimeProcPtr time_proc, void *time_info )''
 
  <FONT color=gray>' ''PmError Pm_OpenInput( PortMidiStream** stream, PmDeviceID inputDevice, void *inputDriverInfo, int32_t bufferSize, PmTimeProcPtr time_proc, void *time_info )''
Riga 74: Riga 224:
 
  Private Extern Pm_Terminate() As Integer
 
  Private Extern Pm_Terminate() As Integer
 
   
 
   
 
+
  '''Public''' Sub Main()
+
  Public Sub Main()
 
   
 
   
 
   Dim def_in, def_out, err, i As Integer
 
   Dim def_in, def_out, err, i As Integer
Riga 82: Riga 232:
 
   Dim midi_in, midi_out As Pointer
 
   Dim midi_in, midi_out As Pointer
 
   
 
   
  Print "Dispositivi Midi e loro porte disponibili:\n"
+
  Print "Dispositivi Midi e loro porte disponibili:\n"
  def_in = Pm_GetDefaultInputDeviceID()
+
  def_in = Pm_GetDefaultInputDeviceID()
  def_out = Pm_GetDefaultOutputDeviceID()
+
  def_out = Pm_GetDefaultOutputDeviceID()
  For i = 0 To Pm_CountDevices() - 1
+
  For i = 0 To Pm_CountDevices() - 1
    info = Pm_GetDeviceInfo(i)
+
    info = Pm_GetDeviceInfo(i)
    If info.inputI > 0 Then
+
    If info.inputI > 0 Then
      def = IIf(i = def_in, "default ", Null)
+
      def = IIf(i = def_in, "default ", Null)
      Print i; ": "; String@(info.interf); "  "; String@(info.name); " ("; def; "input)"
+
      Print i; ": "; String@(info.interf); "  "; String@(info.name); " ("; def; "input)"
      def = Null
+
      def = Null
    Endif
+
    Endif
    If info.outputI > 0 Then
+
    If info.outputI > 0 Then
      def = IIf(i = def_out, "default ", Null)
+
      def = IIf(i = def_out, "default ", Null)
      Print i; ": "; String@(info.interf); "  "; String@(info.name); " ("; def; "output)"
+
      Print i; ": "; String@(info.interf); "  "; String@(info.name); " ("; def; "output)"
    Endif
+
    Endif
  Next
+
  Next
 
    
 
    
 
  <FONT color=gray>' ''Attende che sia inserito il numero del dispositivo Midi, da cui si riceverranno i dati Midi.''</font>
 
  <FONT color=gray>' ''Attende che sia inserito il numero del dispositivo Midi, da cui si riceverranno i dati Midi.''</font>
  Print "\nInserire il numero del dispositivo Midi, dal quale si riceveranno i dati Midi..."
+
  Print "\nInserire il numero del dispositivo Midi, dal quale si riceveranno i dati Midi..."
  Input s
+
  Input s
  Print "Porta del dispositivo Midi scelta:  "; s
+
  Print "Porta del dispositivo Midi scelta:  "; s
  err = Pm_OpenInput(VarPtr(midi_in), Val(s), 0, 128, 0, 0)
+
  err = Pm_OpenInput(VarPtr(midi_in), Val(s), 0, 128, 0, 0)
  If err Then
+
  If err Then
    Print Pm_GetErrorText(err)
+
    Print Pm_GetErrorText(err)
    Chiude()
+
    Chiude()
  Endif
+
  Endif
 
        
 
        
 
  <FONT color=gray>' ''Attende che sia inserito il numero del dispositivo Midi, al quale si invieranno i dati Midi.''</font>
 
  <FONT color=gray>' ''Attende che sia inserito il numero del dispositivo Midi, al quale si invieranno i dati Midi.''</font>
  Print "\nInserire il numero del dispositivo Midi, al quale si invieranno i dati Midi..."
+
  Print "\nInserire il numero del dispositivo Midi, al quale si invieranno i dati Midi..."
  Input s
+
  Input s
  Print "Porta del dispositivo Midi scelta:  "; s
+
  Print "Porta del dispositivo Midi scelta:  "; s
  err = Pm_OpenOutput(VarPtr(midi_out), Val(s), 0, 512, 0, 0)
+
  err = Pm_OpenOutput(VarPtr(midi_out), Val(s), 0, 128, 0, 0)
  If err Then
+
  If err Then
    Print Pm_GetErrorText(err)
+
    Print Pm_GetErrorText(err)
    Chiude()
+
    Chiude()
  Endif
+
  Endif
  s = Null
+
  s = Null
 
    
 
    
 
  <FONT color=gray>' ''Filtriamo i dati Midi ricevuti che non ci interessano:''</font>
 
  <FONT color=gray>' ''Filtriamo i dati Midi ricevuti che non ci interessano:''</font>
  Pm_SetFilter(midi_in, PM_FILT_ACTIVE Or PM_FILT_CLOCK Or PM_FILT_SYSEX)
+
  Pm_SetFilter(midi_in, PM_FILT_ACTIVE Or PM_FILT_CLOCK Or PM_FILT_SYSEX)
 
      
 
      
  Print "\nMidi Monitor pronto...\n"
+
  Print "\nMidi Monitor pronto...\n"
  Print "Assicurarsi di aver connesso le porte dei dispositivi Midi coinvolti !"
+
  Print "Assicurarsi di aver connesso le porte dei dispositivi Midi coinvolti !"
 
    
 
    
  Intercetta_Messaggi(midi_in, midi_out)
+
  Intercetta_Messaggi(midi_in, midi_out)
 
    
 
    
 
  <FONT color=gray>' ''Va in chiusura:''</font>
 
  <FONT color=gray>' ''Va in chiusura:''</font>
  Chiude(midi_out)
+
  Chiude(midi_out)
 
        
 
        
  '''End'''
+
  End
 
   
 
   
 
   
 
   
  '''Private''' Procedure Intercetta_Messaggi(midIn As Pointer, midEx As Pointer)
+
  Private Procedure Intercetta_Messaggi(midIn As Pointer, midEx As Pointer)
 
   
 
   
 
   Dim pe As New PmEvent
 
   Dim pe As New PmEvent
 
   Dim status, count As Integer
 
   Dim status, count As Integer
    
+
  Print "\n\nMidi Monitor pronto...\n\nStatus", "nota", "velocità"
+
   Print "\n\nMidi Monitor pronto...\n\nStatus", "nota", "velocità"
 
   
 
   
 
  <FONT color=gray>' ''Riceve i dati Midi dal dispositivo Midi, leggendoli dalla sua porta in Uscita:''</font>
 
  <FONT color=gray>' ''Riceve i dati Midi dal dispositivo Midi, leggendoli dalla sua porta in Uscita:''</font>
  While True
+
  Do
 
+
    status = Pm_Poll(midIn)
    status = Pm_Poll(midIn)
+
    If status = True Then
    If status = True Then
+
      count = Pm_Read(midIn, pe, 1)
      count = Pm_Read(midIn, pe, 1)
+
      If count > 0 Then
      If count > 0 Then
 
 
  <FONT color=gray>' ''Volendo, possiamo stampare nella console i dati Midi ricevuti:''</font>
 
  <FONT color=gray>' ''Volendo, possiamo stampare nella console i dati Midi ricevuti:''</font>
        Print (pe.message And &FF) And &f, (pe.message \ CInt(2 ^ 8)) And 255, (pe.message \ CInt(2 ^ 16)) And 255
+
        Print (pe.message And &FF) And &f, (pe.message \ CInt(2 ^ 8)) And 255, (pe.message \ CInt(2 ^ 16)) And 255
 
  <FONT color=gray>' ''Invia i dati al dispositivo Midi, scrivendoli sulla sua porta in Entrata:''</font>
 
  <FONT color=gray>' ''Invia i dati al dispositivo Midi, scrivendoli sulla sua porta in Entrata:''</font>
        Pm_Write(midEx, pe, 1)
+
        Pm_Write(midEx, pe, 1)
      Else
+
      Else
 
  <FONT color=gray>' ''Va in chiusura:''</font>
 
  <FONT color=gray>' ''Va in chiusura:''</font>
        Chiude(midEx)
+
        Chiude(midEx)
        Error.Raise("Errore nella ricezione dei Messaggi Midi:" & Pm_GetErrorText(count))
+
        Error.Raise("Errore nella ricezione dei Messaggi Midi:" & Pm_GetErrorText(count))
      Endif
+
      Endif
    Endif
+
    Endif
 
+
  Loop
  Wend
 
 
    
 
    
  '''End'''
+
  End
 
   
 
   
 
   
 
   
  '''Private''' Procedure Chiude(midi As Pointer)
+
  Private Procedure Chiude(midi As Pointer)
 
    
 
    
  Pt_Close(midi)
+
  Pm_Close(midi)
  Pm_Terminate()
+
  Pm_Terminate()
  Quit
+
  Quit
 
    
 
    
  '''End'''
+
  End
 
 
  
  

Versione attuale delle 19:12, 13 gen 2024

La libreria PortMidi è una libreria per la gestione in tempo reale dei dati Midi in entrata ed in uscita. Essa fa parte di un assortimento di API e librerie create per la musica e per altri media.

E' possibile con alcune funzioni esterne della libreria PortMidi intercettare i dati Midi grezzi, provenienti da un dispositivo Midi, ed inviarli ad altri dispositivi Midi.

Sarà necessario avere installata nel proprio sistema e richiamare nel programma Gambas la libreria condivisa: "libportmidi.so.2.0.3 ".

Mostriamo di seguito due semplici esempi.

Inviare Messaggi Midi ad un dispositivo Midi

In questo esempio si invieranno al softsynth tramite il sistema Alsa i messaggi Midi di "Program Change", "Note On" e dopo un secondo un messaggio di "Note Off" :

Private Const NOTEOFF As Integer = &80
Private Const NOTEON As Integer = &90
Private Const PROGRAM_CHANGE As Integer = &C0


Library "libportmidi:2.0.3"

Public Struct PmDeviceInfo
  structVersion As Integer
  interf As Pointer
  name As Pointer
  inputI As Integer
  outputI As Integer
  opened As Integer
End Struct

' PmError Pm_Initialize(void)
' Library initialisation function.
Private Extern Pm_Initialize()

' int Pm_CountDevices (void)
' Get devices count, ids range from 0 to Pm_CountDevices()-1.
Private Extern Pm_CountDevices() As Integer

' const char *Pm_GetErrorText( PmError errnum )
' Translate portmidi error number into human readable message.
Private Extern Pm_GetErrorText(errnum As Integer) As String

' const PmDeviceInfo* Pm_GetDeviceInfo( PmDeviceID id )
' Returns a pointer to a PmDeviceInfo structure referring to the device specified by id.
Private Extern Pm_GetDeviceInfo(id As Integer) As PmDeviceInfo

' PmError Pm_OpenOutput (PortMidiStream **stream, PmDeviceID outputDevice, void *outputDriverInfo, long bufferSize, PmTimeProcPtr time_proc, void *time_info, long latency)
' Open Output device.
Private Extern Pm_OpenOutput(pstream As Pointer, outputDevice As Integer, outputDriverInfo As Pointer, bufferSize As Integer, time_proc As Pointer, latency As Long) As Integer

' PmError Pm_WriteShort( PortMidiStream *stream, PmTimestamp when, int32_t msg)
' Writes a timestamped non-system-exclusive midi message.
Private Extern Pm_WriteShort(_stream As Pointer, when As Integer, msg As Integer) As Integer

' PmError Pm_Close( PortMidiStream* stream )
' Closes a midi stream, flushing any pending buffers.
Private Extern Pm_Close(pstream As Pointer) As Integer

' PmError Pm_Terminate( void )
' Library termination function.
Private Extern Pm_Terminate() As Integer


Library "libporttime:0.0.0"

' PtError Pt_Start(int resolution, PtCallback *callback, void *userData)
' Starts a real-time service.
Private Extern Pt_Start(resolution As Integer, callback As Pointer, userData As Pointer)

' PtTimestamp Pt_Time()
' Returns the current time in ms.
Private Extern Pt_Time() As Integer

 
Public Sub Main()
 
 Dim cd, i, err As Integer
 Dim info As PmDeviceInfo
 Dim s As String
 Dim midi_out As Pointer
  
 Pm_Initialize()
  
' Print "Dispositivi Midi e loro porte disponibili:\n"
 cd = Pm_CountDevices()
 If cd Then
   For i = 0 To cd - 1
     info = Pm_GetDeviceInfo(i)
     If info.outputI Then Print i; " : "; String@(info.name)
   Next
   Pt_Start(1, 0, 0)
' Attende che sia inserito il numero del dispositivo Midi, al quale si invieranno i dati Midi:
   Print "\nAssicurarsi di aver connesso le porte dei dispositivi Midi coinvolti !"
   Print "\nInserire il numero del dispositivo Midi, al quale si invieranno i dati Midi..."
   Input s
   Print "Dispositivo Midi scelto numero:  "; s
   err = Pm_OpenOutput(VarPtr(midi_out), Val(s), 0, 256, 0, 0)
   If err Then
     Print Pm_GetErrorText(err)
     Chiude()
   Endif
   Invia_Messaggi(midi_out)
' Va in chiusura:
   Pm_Close(midi_out)
   Chiude()
 Else
   Chiude()
   Error.Raise("Nessun dispositivo Midi di Uscita disponibile  !")
 Endif

End
 
 
Private Procedure Invia_Messaggi(midexitus As Pointer)
 
 Dim can, prg, tempus As Integer
 
' Imposta i valori del Canale e del messaggio Midi del "Program Change":
 can = 0
 prg = 24
  
' Invia il messaggio del "Program Change":
 Pm_WriteShort(midexitus, 0, Pm_Message(PROGRAM_CHANGE Or can, prg, 0))
  
 tempus = Pt_Time()
  
' Invia il messaggio del "Note On":
 Pm_WriteShort(midexitus, 0, Pm_Message(NOTEON Or can, 60, 100))
  
 While (Pt_Time() - tempus) < 1000
   wait 0.01
 Wend
  
' Invia il messaggio del "Note Off":
  Pm_WriteShort(midexitus, 0, Pm_Message(NOTEOFF Or can, 60, 0))
  Wait 0.01
    
End


Private Function Pm_Message(status As Integer, data1 As Integer, data2 As Integer) As Integer
 
 Return (((data2 * CInt(2 ^ 16)) And &FF0000) Or ((data1 * CInt(2 ^ 8)) And &FF00) Or ((status) And &FF))
 
End


Private Procedure Chiude()
 
 Pm_Terminate()
 
End


Intercettare dati Midi grezzi provenienti da un dispositivo esterno e inviarli ad altro dispositivo Midi

Private s As String


Library "libportmidi:2.0.3"

Public Struct PmDeviceInfo
  structVersion As Integer
  interf As Pointer
  name As Pointer
  inputI As Integer
  outputI As Integer
  opened As Integer
End Struct

Public Struct PmEvent
  message As Integer
  timestamp As Integer
End Struct

Private Const PM_FILT_ACTIVE As Integer = 16384
Private Const PM_FILT_CLOCK As Integer = 256
Private Const PM_FILT_SYSEX As Integer = 1

' int Pm_CountDevices (void)
' Get devices count, ids range from 0 to Pm_CountDevices()-1.
Private Extern Pm_CountDevices() As Integer

' const char *Pm_GetErrorText( PmError errnum )
' Translate portmidi error number into human readable message.
Private Extern Pm_GetErrorText(errnum As Integer) As String

' const PmDeviceInfo* Pm_GetDeviceInfo( PmDeviceID id )
' Returns a pointer to a PmDeviceInfo structure referring to the device specified by id.
Private Extern Pm_GetDeviceInfo(id As Integer) As PmDeviceInfo

' PmDeviceID Pm_GetDefaultInputDeviceID( void )
' Return the default device ID or pmNoDevice if there are no devices.
Private Extern Pm_GetDefaultInputDeviceID() As Integer

' PmDeviceID Pm_GetDefaultOutputDeviceID( void )
' Return the default device ID or pmNoDevice if there are no devices.
Private Extern Pm_GetDefaultOutputDeviceID() As Integer
 
' PmError Pm_OpenInput( PortMidiStream** stream, PmDeviceID inputDevice, void *inputDriverInfo, int32_t bufferSize, PmTimeProcPtr time_proc, void *time_info )
' Open Input device.
Private Extern Pm_OpenInput(pstream As Pointer, inputDevice As Integer, inputDriverInfo As Pointer, bufferSize As Integer, time_proc As Pointer, time_info As Pointer) As Integer

' PmError Pm_OpenOutput (PortMidiStream **stream, PmDeviceID outputDevice, void *outputDriverInfo, long bufferSize, PmTimeProcPtr time_proc, void *time_info, long latency)
' Open Output device.
Private Extern Pm_OpenOutput(pstream As Pointer, outputDevice As Integer, outputDriverInfo As Pointer, bufferSize As Integer, time_proc As Pointer, latency As Long) As Integer
 
' PmError Pm_SetFilter( PortMidiStream* stream, int32_t filters )
' Sets filters on an open input stream to drop selected input types.
Private Extern Pm_SetFilter(pstream As Pointer, filters As Integer) As Integer

' PmError Pm_Poll( PortMidiStream *stream)
' Tests whether input is available.
Private Extern Pm_Poll(pstream As Pointer) As Boolean

' int Pm_Read( PortMidiStream *stream, PmEvent *buffer, int32_t length )
' Retrieves midi data into a buffer, and returns the number of events read.
Private Extern Pm_Read(pstream As Pointer, buffer As PmEvent, lenght As Integer) As Integer

' PmError Pm_Write( PortMidiStream *stream, PmEvent *buffer, int32_t length )
' Writes midi data from a buffer.
Private Extern Pm_Write(pstream As Pointer, buffer As PmEvent, lenght As Integer) As Integer

' PmError Pm_Close( PortMidiStream* stream )
' Closes a midi stream, flushing any pending buffers.
Private Extern Pm_Close(pstream As Pointer) As Integer

' PmError Pm_Terminate( void )
' Library termination function.
Private Extern Pm_Terminate() As Integer


Public Sub Main()

 Dim def_in, def_out, err, i As Integer
 Dim info As PmDeviceInfo
 Dim def As String
 Dim midi_in, midi_out As Pointer

 Print "Dispositivi Midi e loro porte disponibili:\n"
 def_in = Pm_GetDefaultInputDeviceID()
 def_out = Pm_GetDefaultOutputDeviceID()
 For i = 0 To Pm_CountDevices() - 1
   info = Pm_GetDeviceInfo(i)
   If info.inputI > 0 Then
     def = IIf(i = def_in, "default ", Null)
     Print i; ": "; String@(info.interf); "  "; String@(info.name); " ("; def; "input)"
     def = Null
   Endif
   If info.outputI > 0 Then
     def = IIf(i = def_out, "default ", Null)
     Print i; ": "; String@(info.interf); "  "; String@(info.name); " ("; def; "output)"
   Endif
 Next
 
' Attende che sia inserito il numero del dispositivo Midi, da cui si riceverranno i dati Midi.
 Print "\nInserire il numero del dispositivo Midi, dal quale si riceveranno i dati Midi..."
 Input s
 Print "Porta del dispositivo Midi scelta:  "; s
 err = Pm_OpenInput(VarPtr(midi_in), Val(s), 0, 128, 0, 0)
 If err Then
   Print Pm_GetErrorText(err)
   Chiude()
 Endif
     
' Attende che sia inserito il numero del dispositivo Midi, al quale si invieranno i dati Midi.
 Print "\nInserire il numero del dispositivo Midi, al quale si invieranno i dati Midi..."
 Input s
 Print "Porta del dispositivo Midi scelta:  "; s
 err = Pm_OpenOutput(VarPtr(midi_out), Val(s), 0, 128, 0, 0)
 If err Then
   Print Pm_GetErrorText(err)
   Chiude()
 Endif
 s = Null
  
' Filtriamo i dati Midi ricevuti che non ci interessano:
 Pm_SetFilter(midi_in, PM_FILT_ACTIVE Or PM_FILT_CLOCK Or PM_FILT_SYSEX)
   
 Print "\nMidi Monitor pronto...\n"
 Print "Assicurarsi di aver connesso le porte dei dispositivi Midi coinvolti !"
  
 Intercetta_Messaggi(midi_in, midi_out)
  
' Va in chiusura:
 Chiude(midi_out)
      
End


Private Procedure Intercetta_Messaggi(midIn As Pointer, midEx As Pointer)

 Dim pe As New PmEvent
 Dim status, count As Integer

 Print "\n\nMidi Monitor pronto...\n\nStatus", "nota", "velocità"

' Riceve i dati Midi dal dispositivo Midi, leggendoli dalla sua porta in Uscita:
 Do
   status = Pm_Poll(midIn)
   If status = True Then
     count = Pm_Read(midIn, pe, 1)
     If count > 0 Then
' Volendo, possiamo stampare nella console i dati Midi ricevuti:
       Print (pe.message And &FF) And &f, (pe.message \ CInt(2 ^ 8)) And 255, (pe.message \ CInt(2 ^ 16)) And 255
' Invia i dati al dispositivo Midi, scrivendoli sulla sua porta in Entrata:
       Pm_Write(midEx, pe, 1)
     Else
' Va in chiusura:
       Chiude(midEx)
       Error.Raise("Errore nella ricezione dei Messaggi Midi:" & Pm_GetErrorText(count))
     Endif
   Endif
 Loop
 
End


Private Procedure Chiude(midi As Pointer)
 
 Pm_Close(midi)
 Pm_Terminate()
 Quit
 
End


Riferimenti