#include "unistd.h"
#include "portmidi.h"
#include "porttime.h"
#include "stdio.h"
 
#define INPUT_BUFFER_SIZE 100
#define OUTPUT_BUFFER_SIZE 0
#define DRIVER_INFO NULL
#define TIME_PROC ((long (*)(void *)) Pt_Time)
#define TIME_INFO NULL
#define TIME_START Pt_Start(1, 0, 0) /* timer started w/millisecond accuracy */
 
 
 
long Read_Handler(PortMidiStream *midi) {
  PmError status, length;
  PmEvent buffer[1];
  int i = 0;
  int num = 1;
    /* It is recommended to start timer before Midi; otherwise, PortMidi may
       start the timer with its (default) parameters
     */
  /*TIME_START;*/
 
  /* open input device
    Pm_OpenInput(, 
                 i,
                 DRIVER_INFO, 
                 INPUT_BUFFER_SIZE, 
                 TIME_PROC, 
                 TIME_INFO);*/
         
    /*printf("Midi Input opened. Reading %d Midi messages...\n",num);*/
    Pm_SetFilter(midi, PM_FILT_ACTIVE | PM_FILT_CLOCK);
    /* empty the buffer after setting filter, just in case anything
       got through */
    while (Pm_Poll(midi)) {
        Pm_Read(midi, buffer, 1);
    }
    /* now start paying attention to messages */
    i = 0; /* count messages as they arrive */
    buffer[0].message = 0;
    while (i < num) {
        status = Pm_Poll(midi);
        if (status == TRUE) {
      length = Pm_Read(midi,buffer, 1);
      if (length > 0)
        i++;                                      
    }        
    usleep(50);
    }
 
    /* close device (this not explicitly needed in most implementations) */
    /*printf("ready to close..." );*/
 
    /*Pm_Close(midi);*/
    /*printf("done closing..." );*/
    return buffer[0].message;
}

task type Input_Driver_Type(Addr : Address_Access) is
      entry Send(Message : out C.Long);
   end Input_Driver_Type;
      
   task body Input_Driver_Type is
      
      Pm_Error : PmError;
   begin
      Pm_Error := Pm_SetFilter(Addr.all, PM_FILT_ACTIVE or PM_FILT_CLOCK);
      loop    
     
     
     declare           
        
        Event : access PmEvent := new PmEvent;
     begin                        
        loop
           Pm_Error := Pm_Poll(Addr.all);
           case Pm_Error is
          when PmNoError =>             
             exit;
             
          when others =>
             Pm_Error := Pm_Read(Addr.all, Event, 1);             
 
           end case;
        end loop;
        Pm_Error := Pm_Poll(Addr.all);
        case Pm_Error is
           when PmNoError =>
          
          Text_Io.Put_Line("Reading message :" & C.Long'Image(Event.Message));
          Pm_Error := Pm_Read(Addr.all, 
                      Event,
                      1);                      
          case Pm_Error is
             when PmNoError =>
            accept Send(Message : out C.Long) do
               Message := Event.Message;            
            end Send;
             when others =>
            Text_Io.Put(PmError'Image(Pm_Error));
          end case;
           when others =>
          null;
        end case;       
     end;
      end loop;
      
   end Input_Driver_Type;

- Description : Ada binding to C library "portmidi".
-----------------------------------------------------
 
with Porttime;
with System;
with Interfaces.C;
use Interfaces;
with System.Address_To_Access_Conversions;
package Portmidi is
   
      
   type PmError is (pmNoError,
                    PmHostError,
                    pmInvalidDeviceId,
                    pmInsufficientMemory,
                    pmBufferTooSmall,
                    pmBufferOverflow,
                    pmBadPtr,
                    pmBadData,
                    pmInternalError,
                    PmBufferMaxSize);
   
   function Pm_Initialize return PmError;
   pragma Import (C, Pm_Initialize, "Pm_Initialize" );
 
   function Pm_Terminate return PmError;
   pragma Import (C, Pm_Terminate, "Pm_Terminate" );
   
   function Pm_HasHostError( PortMidiStream : System.address) return Interfaces.C.Int;
   pragma Import (C, Pm_HasHostError, "Pm_HasHostError" );
   
   
   subtype T_ErrorText is Interfaces.C.Char_Array(0..256);   
   function Pm_GetErrorText( Errnum : PmError  ) return T_ErrorText;
   pragma Import (C, Pm_GetErrorText, "Pm_GetErrorText" );
   package ErrorText_Conversion is new System.Address_To_Access_Conversions
     (T_ErrorText);
   use ErrorText_Conversion;
   
      
   type DeviceInfo is
      record
         StructVersion : Integer;
         Interf : System.address;
         Name : System.Address;
         Input : Integer;
         Output : Integer;
         Opened : integer;
      end record;
   
   
   function Pm_CountDevices return Integer;
   pragma Import (C, Pm_CountDevices, "Pm_CountDevices" );
         
   function Pm_GetDefaultInputDeviceID return Interfaces.C.int;
   pragma Import (C, Pm_GetDefaultInputDeviceID, "Pm_GetDefaultInputDeviceID" );
 
   function Pm_GetDefaultOutputDeviceID return Interfaces.C.Int;
   pragma Import (C, Pm_GetDefaultOutputDeviceID, "Pm_GetDefaultOutputDeviceID" );
   
   function Pm_GetDeviceInfo(PmDeviceID : Integer) return System.Address;
   pragma Import (C, Pm_GetDeviceInfo, "Pm_GetDeviceInfo" );
   
   package DeviceInfo_Conversion is new System.Address_To_Access_Conversions(DeviceInfo);
   use DeviceInfo_Conversion;
   
   function Pm_OpenInput(PortMidiStream : access System.address;
                         PmDeviceID : Integer;
                         InputDriverInfo : access DeviceInfo;
                         BufferSize : Long_Integer;
                         PmTimeProcPtr : Porttime.Time_access;
                         time_info : System.address) return PmError;
   pragma Import (C, Pm_OpenInput, "Pm_OpenInput" );
 
 
   function Pm_OpenOutput(PortMidiStream : access System.Address;
                          OutputDevice : Integer;
                          outputDriverInfo : access DeviceInfo;
                          BufferSize : Long_Integer;
                          Time_Proc : Porttime.Time_access;
                          Time_Info : System.address;
                          latency : Long_integer) return PmError;
   pragma Import (C, Pm_OpenOutput, "Pm_OpenOutput" );
   
   
   --   /* Filter bit-mask definitions */
   --/** filter active sensing messages (0xFE): */
   function PM_FILT_ACTIVE return Unsigned_32; --(1 << 0x0E)
                           --/** filter system exclusive messages (0xF0): */
   function PM_FILT_SYSEX return Unsigned_32; --(1 << 0x00)
                          --/** filter MIDI clock message (0xF8) */
   function PM_FILT_CLOCK return Unsigned_32; --(1 << 0x08)
                          --/** filter play messages (start 0xFA, stop 0xFC, continue 0xFB) */
   function PM_FILT_PLAY return Unsigned_32; --((1 << 0x0A) | (1 << 0x0C) | (1 << 0x0B))
                         --/** filter tick messages (0xF9) */
   function PM_FILT_TICK return Unsigned_32; --(1 << 0x09)
                         --/** filter undefined FD messages */
   function PM_FILT_FD return Unsigned_32; --(1 << 0x0D)
                       --/** filter undefined real-time messages */
   function PM_FILT_UNDEFINED return Unsigned_32; --PM_FILT_FD
                          --/** filter reset messages (0xFF) */
   function PM_FILT_RESET return Unsigned_32; --(1 << 0x0F)
                          --/** filter all real-time messages */
   function PM_FILT_REALTIME return Unsigned_32; --(PM_FILT_ACTIVE | PM_FILT_SYSEX | PM_FILT_CLOCK | \
                         --    PM_FILT_PLAY | PM_FILT_UNDEFINED | PM_FILT_RESET | PM_FILT_TICK)
                         --/** filter note-on and note-off (0x90-0x9F and 0x80-0x8F */
   function PM_FILT_NOTE return Unsigned_32; --((1 << 0x19) | (1 << 0x18))
                         --/** filter channel aftertouch (most midi controllers use this) (0xD0-0xDF)*/
   function PM_FILT_CHANNEL_AFTERTOUCH return Unsigned_32; --(1 << 0x1D)
                               --/** per-note aftertouch (0xA0-0xAF) */
   function PM_FILT_POLY_AFTERTOUCH return Unsigned_32; --(1 << 0x1A)
                            --/** filter both channel and poly aftertouch */
   function PM_FILT_AFTERTOUCH return Unsigned_32; --(PM_FILT_CHANNEL_AFTERTOUCH | PM_FILT_POLY_AFTERTOUCH)
                           --/** Program changes (0xC0-0xCF) */
   function PM_FILT_PROGRAM return Unsigned_32; --(1 << 0x1C)
                        --/** Control Changes (CC's) (0xB0-0xBF)*/
   function PM_FILT_CONTROL return Unsigned_32; --(1 << 0x1B)
                        --/** Pitch Bender (0xE0-0xEF*/
   function PM_FILT_PITCHBEND return Unsigned_32; --(1 << 0x1E)
                          --/** MIDI Time Code (0xF1)*/
   function PM_FILT_MTC return Unsigned_32; --(1 << 0x01)
                        --/** Song Position (0xF2) */
   function PM_FILT_SONG_POSITION return Unsigned_32; --(1 << 0x02)
                              --/** Song Select (0xF3)*/
   function PM_FILT_SONG_SELECT return Unsigned_32; --(1 << 0x03)
                            --/** Tuning request (0xF6)*/
   function PM_FILT_TUNE return Unsigned_32; --(1 << 0x06)
                         --/** All System Common messages (mtc, song position, song select, tune request) */
   function PM_FILT_SYSTEMCOMMON return Unsigned_32; --(PM_FILT_MTC | PM_FILT_SONG_POSITION | PM_FILT_SONG_SELECT | PM_FILT_TUNE)
            
   function Pm_SetFilter(PortMidiStream : System.Address;
                         filters : Unsigned_32) return PmError;
   pragma Import (C, Pm_SetFilter, "Pm_SetFilter" );
 
   function Pm_SetChannelMask(PortMidiStream : System.Address;
                              Mask : integer) return PmError;
   pragma Import (C, Pm_SetChannelMask, "Pm_SetChannelMask" );
 
   function Pm_Abort( PortMidiStream : System.Address) return PmError;
   pragma Import (C, Pm_Abort, "Pm_Abort" );
 
   function Pm_Close( PortMidiStream : System.Address) return PmError;
   pragma Import (C, Pm_Close, "Pm_Close" );
 
   
   
   
   
   function Pm_Message(Status, Data1, Data2 : Interfaces.C.Long) return Interfaces.C.Long;
   function Status(Message : Interfaces.C.long) return Interfaces.C.Long;
   function data1(Message : Interfaces.C.long) return Interfaces.C.Long;
   function Channel(Message : Interfaces.C.Long) return Interfaces.C.Long;
   function data2(Message : Interfaces.C.long) return Interfaces.C.Long;
   
   
   
   type PmEvent is
      record
         Message : Interfaces.C.Long := 0;
         PmTimestamp : Interfaces.C.Long := 0;
      end record;
      
   
   Function Pm_Read(PortMidiStream : System.Address;            
            Pm_Event : access PmEvent;
            length : Interfaces.C.Long) return PmError ;
   pragma Import (C, Pm_Read, "Pm_Read" );
   
   function Pm_Poll( PortMidiStream : System.Address) return PmError;
   pragma Import (C, Pm_Poll, "Pm_Poll" );
   
   
   function Pm_Write( PortMidiStream : System.address;
                      Pm_Event : PmEvent;
                      length : Interfaces.C.Long) return PmError ;
   pragma Import (C, Pm_Write, "Pm_Write" );
 
 
   function Pm_WriteShort( PortMidiStream : System.address;
                           PmTimestamp : Interfaces.C.long;
                           Msg : Interfaces.C.long) return PmError;
   pragma Import (C, Pm_WriteShort, "Pm_WriteShort" );
 
   function Pm_WriteSysEx( PortMidiStream : System.Address;
                           PmTimestamp : Float;
                           Msg : integer) return PmError;
   pragma Import (C, Pm_WriteSysEx, "Pm_WriteSysEx" );
 
   
   
end Portmidi;

task type Input_Driver_Type(Addr : Address_Access) is
      entry Send(Message : out C.Long);
   end Input_Driver_Type;
      
   task body Input_Driver_Type is
      
      Pm_Error : PmError;
   begin
      
      Pm_Error := Pm_SetFilter(Addr.all, PM_FILT_ACTIVE or PM_FILT_CLOCK);
      loop              
     declare           
        
        Event : aliased PmEvent;
     begin                        
        
        Pm_Error := Pm_Read(Addr.all, Event'access, 1);
           
        if C."/="(Event.Message,0) then
           select
          accept Send(Message : out C.Long) do
             Text_Io.Put_Line("Reading message :" & C.Long'Image(Event.Message));
             Message := Event.Message;                       
          end Send;           
           or delay 1.0;
           end select;
        else
           delay 0.001;
        end if;
     end;
      end loop;      
   end Input_Driver_Type;