int Pm_Read( PortMidiStream *stream, PmEvent *buffer, int32_t length );

type PmEvent is
      record
         Message : Interfaces.C.Long := 0;
         PmTimestamp : Interfaces.C.Long := 0;
      end record;
      
   
   type Pmevent_Access is access all Pmevent;
   
   Function Pm_Read(PortMidiStream : System.Address;            
            Pm_Event : PmEvent_access;
            length : Interfaces.C.Long) return PmError ;
   pragma Import (C, Pm_Read, "Pm_Read" );

with Text_Io;
use Text_Io;
 
with Np.Midi.Devices, Np.Midi.Drivers, Np.Midi.Scheduler;
use Np.Midi;
procedure Main is
   
   Master_device : aliased Devices.Device_Type;
   Synth_in_Device : aliased Devices.Device_Type;
   Synth_Out_Device : aliased Devices.Device_Type;
begin
   Text_Io.Put_line("Enter device ID of Synth Out :" );
   Devices.Initialize(Synth_Out_Device, Devices.MIDI_Out);
   New_Line;
   Text_Io.Put_line("Enter device ID of Master Keyboard :" );
   Devices.Initialize(Master_Device, Devices.MIDI_In);
   New_Line;
   Text_Io.Put_line("Enter device ID of Synth In :" );
   Devices.Initialize(Synth_In_Device, Devices.MIDI_In);
   New_Line;
   Text_Io.Put("Open all devices..." );
   Devices.Open(Synth_Out_Device);
   Devices.Open(Master_Device);
   Devices.Open(Synth_In_Device);
   Text_Io.Put_line(" Done." );
   
   declare
      
      Master_Driver : access Drivers.InputDriver_Type := new Drivers.InputDriver_Type(Master_Device'Access);      
      Synth_In_Driver : access Drivers.InputDriver_Type := new Drivers.InputDriver_Type(Synth_In_Device'Access);
      Synth_Out_Driver : access Drivers.OutputDriver_Type := new Drivers.OutputDriver_Type(Synth_Out_Device'Access);
      
   begin
      
      declare
     The_Sched : Scheduler.Scheduler_Type(Master_Driver, Synth_In_Driver, Synth_Out_Driver);
      begin
     null;
      end;            
   end;
   New_Line;
   Text_Io.Put("Close all devices..." );
   Devices.Close(Synth_Out_Device);            
   Devices.Close(Master_Device);
   Devices.Close(Synth_In_Device);
   Text_Io.Put_line(" Done." );
end Main;

with Portmidi, Porttime;
use Portmidi, Porttime;
with System;
 
package Np.Midi.Devices is
   
   pragma Elaborate_Body(Np.Midi.Devices);
   
   
   type Device_Type is private;
   type Mode_Type is (MIDI_In, MIDI_Out);
   procedure Initialize (Device : in out Device_Type; Mode : in Mode_Type);
   function  Initialized(Device : in     Device_Type) return Boolean;
   procedure Open       (Device : in out Device_Type);
   procedure Write      (Device : in     Device_Type; Message : in C.Long);
   procedure Read       (Device : in     Device_Type; Message : out C.Long);
   procedure Close      (Device : in out Device_Type);
   function Name(Device : in Device_Type) return String;
   Mode_Error      : exception;
   Status_Error    : exception;
   Not_Initialized : exception;      
private
   
   type Device_Type is
      record
     Initialized    : Boolean := False;
     Mode           : Mode_Type;
     Id             : Integer;
     Addr           : access System.Address;
     The_Deviceinfo : access Portmidi.DeviceInfo;
      end record;
   
   
   
end Np.Midi.Devices;

with Ada.Integer_Text_Io;
with Ada.Text_Io;
use Ada;
package body Np.Midi.Devices is
   
   use ErrorText_Conversion, DeviceInfo_Conversion;
   procedure Initialize (Device : in out Device_Type; Mode : in Mode_type) is
      
   begin
      case Mode is
     when MIDI_Out =>
        Device.The_DeviceInfo := new Portmidi.DeviceInfo;
        Device.Addr := new System.Address;
        loop
           begin        
          Text_Io.Put_Line("Select output device :" );
          Text_Io.Put_Line("ID, Name" );
          for I in 0..Portmidi.Pm_CountDevices-1 loop
             declare
            Name : Portmidi.T_ErrorText;
             begin
            Device.The_DeviceInfo.all :=
              To_pointer(Portmidi.Pm_GetDeviceInfo(I)).all;
            if Device.The_Deviceinfo.Output = 1 then
               Name := To_Pointer(Device.The_Deviceinfo.name).all;
               Text_Io.Put_Line(Integer'Image(I) & ", " & Interfaces.C.To_Ada(Name));
            end if;
             end;
          end loop;
          Text_Io.Put("Entre device ID : " );
          Integer_Text_Io.Get(Device.Id);
          Device.The_DeviceInfo.all :=
            To_pointer(Portmidi.Pm_GetDeviceInfo(Device.id)).all;
          if Device.The_Deviceinfo.Output = 1 Then
             declare
            Name : Portmidi.T_ErrorText;
             begin
            Device.Initialized := True;
            
            Device.Mode := MIDI_Out;
            Name := To_Pointer(Device.The_Deviceinfo.name).all;
            Text_Io.Put_Line("Your selected device :" );
            Text_Io.Put(Interfaces.C.To_Ada(Name));        
             end;
             exit;
          else
             Text_Io.Put_Line("!! ********************** !!" );
             Text_Io.Put_Line("!! Device not initialized !!" );
             Text_Io.Put_Line("!! ********************** !!" );
          end if;
          
           exception
          when Text_Io.End_Error =>
             return;
           end;
        end loop;            
     when MIDI_In =>
        Device.The_DeviceInfo := new Portmidi.DeviceInfo;
        Device.Addr := new System.Address;
 
        loop
           begin        
          Text_Io.Put_Line("Select input device :" );
          Text_Io.Put_Line("ID, Name" );
          for I in 0..Portmidi.Pm_CountDevices-1 loop
             declare
            Name : Portmidi.T_ErrorText;
             begin
            Device.The_DeviceInfo.all :=
              To_pointer(Portmidi.Pm_GetDeviceInfo(I)).all;
            if Device.The_Deviceinfo.Input = 1 then
               Name := To_Pointer(Device.The_Deviceinfo.name).all;
               Text_Io.Put_Line(Integer'Image(I) & ", " & Interfaces.C.To_Ada(Name));
            end if;
             end;
          end loop;
          Text_Io.Put("Entre device ID : " );
          Integer_Text_Io.Get(Device.Id);
          Device.The_DeviceInfo.all :=
            To_pointer(Portmidi.Pm_GetDeviceInfo(Device.id)).all;
          if Device.The_Deviceinfo.Input = 1 Then
             declare
            Name : Portmidi.T_ErrorText;
             begin            
            Device.Initialized := True;
            Device.Mode := MIDI_In;
            Name := To_Pointer(Device.The_Deviceinfo.name).all;
            Text_Io.Put_Line("Your selected device :" );
            Text_Io.Put(Interfaces.C.To_Ada(Name));        
             end;
             exit;
          else
             Text_Io.Put_Line("!! ********************** !!" );
             Text_Io.Put_Line("!! Device not initialized !!" );
             Text_Io.Put_Line("!! ********************** !!" );
          end if;
          
           exception
          when Text_Io.End_Error =>
             return;
           end;
        end loop;            
      end case;
   end Initialize;
      
   function  Initialized(Device : in     Device_Type) return Boolean is
   begin
      return Device.Initialized;
   end Initialized;
 
   procedure Open       (Device : in out Device_Type) is
      
      Pm_Error   : PmError;
      Time_Proc  : Porttime.Time_Access := Pt_Time'Access;
      Time_Info  : System.Address;
      latency    : Long_Integer := 0;      
   begin
      case Device.Mode is
     
     when MIDI_In =>
        Pm_Error := Pm_OpenInput(Device.Addr, Device.Id, Device.The_DeviceInfo,
                     128, Time_Proc, Time_Info);
     when MIDI_Out =>
        
        Pm_Error := Pm_OpenOutput(Device.Addr, Device.Id, Device.The_DeviceInfo,
                      0, Time_Proc, Time_Info, Latency);
      end case;
   end Open;
   
   
   procedure Write      (Device : in     Device_Type; Message : in C.Long) is
      
      Pm_Error : PmError;
      Pm_Event : PmEvent := (Message, 0);
   begin
      if not Device.Initialized then
     raise Not_Initialized;
      end if;
      if Device.Mode /= MIDI_Out then
     raise Mode_Error;
      end if;      
      Pm_Error := Pm_Write(Device.Addr.all, Pm_Event, 1);
   end Write;
   
   procedure Read       (Device : in     Device_Type; Message : out C.Long) is
      Pm_Error : PmError := PmNoError;
      Pm_Event : PmEvent_Access := new PmEvent;
   begin
      if not Device.Initialized then
     raise Not_Initialized;
      end if;
      if Device.Mode /= MIDI_In then
     raise MODE_Error;
      end if;
      Pm_Error := Pm_SetFilter(Device.Addr.all, Pm_Filt_Active or Pm_Filt_Clock);
      Pm_Error := Pm_Read(Device.Addr.All, Pm_Event, 1);            
      case Pm_Error is
     when PmNoError =>        
        Message := Pm_Event.Message;                        
     when others =>
        Text_Io.Put(PmError'Image(Pm_Error));
        raise Constraint_Error;
      end case;     
   end Read;
   
   
   procedure Close      (Device : in out Device_Type) is
      Pm_Error : PmError;
   begin      
      Pm_Error := Pm_Close(Device.Addr.all);      
   end Close;
   
   function Name(Device : in Device_Type) return String is
   begin
      return C.To_Ada(To_Pointer(Device.The_Deviceinfo.name).all);
   end Name;
   Pm_Error : PmError;
begin      
   Pm_Error := Pm_Initialize;
end Np.Midi.Devices;

with Np.Midi.Devices;
use Np.Midi.Devices;
package Np.Midi.Drivers is
   task type InputDriver_Type(Device : access Device_Type) is
      entry Send(Message : out C.Long);
   end InputDriver_Type;   
   
   protected type OutputDriver_Type(Device : access Device_Type) is
      entry Receive(Message : in C.Long);
   end OutputDriver_Type;
   
end Np.Midi.Drivers;

ackage body Np.Midi.Drivers is   
   
   task body InputDriver_Type is            
      
 
   begin
      
      loop
     declare
        The_Message : C.Long;
 
     begin
             Read(Device.all, The_Message);
        select
           when C."/=" (The_Message, 0) =>
          accept Send(Message : out C.Long) do
             Message := The_Message;
          end Send;    
        else
           delay 0.001;
        end select;
 
     exception
        when Constraint_Error =>
           null;
     end;
      end loop;      
   end InputDriver_Type;
   
   
   protected body OutputDriver_Type is
      
      entry Receive(Message : in C.Long) when True is
      begin
     
     Write(Device.all, Message);
      end Receive;
   end OutputDriver_Type;
end Np.Midi.Drivers;

with Np.Midi.Drivers;
use Np.Midi.Drivers;
   
package Np.Midi.Scheduler is
   
   
   task type Scheduler_Type(Master_Keyboard : access InputDriver_Type;
                Synth_Input     : access InputDriver_Type;
                Synth_Output    : access outputDriver_Type) is
      entry Start;
      entry Stop;
   private
      entry Receive(Message : in C.Long);
   end Scheduler_Type;
   
   
   
   
   
end Np.Midi.Scheduler;

with Text_Io;
use Text_Io;
package body Np.Midi.Scheduler is
   
   
   task body Scheduler_Type is
                  
      task Synth_Input_Deamon is     
      end Synth_Input_Deamon;
      
      task body Synth_Input_Deamon is
     Message : C.Long;
      begin
     loop
        Synth_Input.Send(Message);
        Receive(Message);
     end loop;
      end Synth_Input_Deamon;
      
      task Master_Keyboard_Deamon is     
      end Master_Keyboard_Deamon;
      
      task body Master_Keyboard_Deamon is
     Message : C.Long;
      begin
     loop
        Master_Keyboard.Send(Message);
        Receive(Message);
     end loop;
      end Master_Keyboard_Deamon;                                                                           
      
   begin  
      
      loop     
     
     select
        
        accept Start;
     or
        
        accept Stop;              
     or
        accept Receive(Message : in C.Long) do
           Text_Io.Put_line(C.Long'Image(Message));
        end Receive;
     end select;
      end loop;
   end Scheduler_Type;      
end Np.Midi.Scheduler;

procedure Read       (Device : in     Device_Type; Message : out C.Long) is
         Pm_Error : PmError := PmNoError;
         Pm_Event : PmEvent_Access := new PmEvent;
      begin
         if not Device.Initialized then
         raise Not_Initialized;
         end if;
         if Device.Mode /= MIDI_In then
         raise MODE_Error;
         end if;
         loop 
            Pm_Error := Pm_Poll(Device.Addr.all);
            case  Pm_Error is
               when Pmnoerror =>
                  exit;
               when others => 
                  Pm_Error := Pm_Read(Device.Addr.All, Pm_Event, 1);                                      
            end case;
            delay 0.00001;           
         end loop;
            
         loop
            Pm_Error := Pm_Poll(Device.Addr.all);
            case Pm_Error is                           
               when Pmnoerror =>
                  null;
               when others =>
                  Pm_Error := Pm_Read(Device.Addr.All, Pm_Event, 1);           
                  case Pm_Error is                             
                     when Pmnoerror =>
                        null;
                     when others =>
                        Message := Pm_Event.Message;                        
                        exit;
                  end case;
            end case;
            delay 0.00001;           
         end loop;               
         
      end Read;

procedure Read       (Device : in     Device_Type; Message : out C.Long) is
      Pm_Error : PmError := PmNoError;
      Pm_Event : PmEvent_Access := new PmEvent;
      
   begin     
      if not Device.Initialized then
         raise Not_Initialized;
      end if;
      if Device.Mode /= MIDI_In then
         raise MODE_Error;
      end if;
      Message := 0;
      delay 0.01;
      loop
         Pm_Error := Pm_Poll(Device.Addr.all);           
         if Pm_Error /= PmNoError then
            Pm_Error := Pm_Read(Device.Addr.All, Pm_Event, 1);                                                            
       
         else
            exit;
         end if;
      end loop;    
      loop
         Pm_Error := Pm_Poll(Device.Addr.all);                  
         if Pm_Error /= Pmnoerror  then                     
            Pm_Error := Pm_Read(Device.Addr.All, Pm_Event, 1);           
            if Pm_Error /= Pmnoerror then
               Message := Pm_Event.Message;                              
               return;
            end if;      
         end if;      
         delay 0.005;
      end loop;
      end Read;