-- Program name : harmonie ; -- Description : Ordonnanceur.    -- Copyright © 2009 Manuel De Girardi
 
    -- Ce programme est un logiciel libre ; vous pouvez le redistribuer et/ou le modifier au titre
    -- des clauses de la Licence Publique Générale GNU, telle que publiée par la Free
    --Software Foundation ; soit la version 2 de la Licence, ou (à  votre discrétion) une version
    --ultérieure quelconque. Ce programme est distribué dans l'espoir qu'il sera utile, mais
    --SANS AUCUNE GARANTIE ; sans même une garantie implicite de COMMERCIABILITE
    --ou DE CONFORMITE A UNE UTILISATION PARTICULIERE. Voir la Licence Publique
    --Générale GNU pour plus de détails. Vous devriez avoir reçu un exemplaire de la Licence
    --Publique Générale GNU avec ce programme ; si ce n'est pas le cas, écrivez à  la Free
    --Software Foundation Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 
 
 
-------------------------------------------------------------------------------
-- Author      : Manuel De Girardi
-- Date        : 2009/08/09
-- Version     : 0.0.0-0a
-- Description : Compositeur-intepreteur de musique automatique.
-------------------------------------------------------------------------------
 
 
with Text_Io;
with Ada.Characters.Handling;
with Ada.Characters.Latin_1;
with Ada.Strings, Ada.Strings.Fixed;
with Pragmarc.Ansi_Tty_Control;
with Calendar, Time_To_Date;
with Ada.Integer_Text_Io;
with System;
with System.Address_To_Access_Conversions;
with Interfaces.C;
with Portmidi, Porttime;
use Ada.Integer_Text_Io;
use Text_Io;
use Ada.Characters;
use Ada.Characters.Handling;
use Ada.Strings, Ada.Strings.Fixed;
use Pragmarc.Ansi_Tty_Control;
use Calendar, Time_To_Date;
use System;
use Interfaces.C;
use Portmidi, Porttime;
 
with Harmonia;
 
procedure Main is
 
 
 
 
   Clear_Screen : constant String := Latin_1.Esc & "ÿ;H" & Latin_1.Esc & "ÿ2J";
 
   task Harmonie is
      entry Start;
      entry Receive(Char : in Character);
      entry Halt;
   end Harmonie;
 
   task body Harmonie is
      Date   : String(1..80) := (others => ' ');
      Banner : String(1..80) := (others => ' ');
      Help   : String(1..80) := (others => ' ');
 
      End_Of_Task : Boolean := False;
      Line : String(1..256) :=  (others => ' ');
      Last : Natural := 0;
 
 
      type T_Command is (Null_Item, Start, Halt);
 
      function Value(Command : String) return T_Command is
         Result : T_Command := Null_Item;
      begin
         if Ada.Strings.Fixed.Index(Command , " ",  Ada.Strings.Fixed.Index_Non_Blank(command)) /= 0 then
            return T_Command'Value(Command(Ada.Strings.Fixed.Index_Non_Blank(Command)..Ada.Strings.Fixed.Index(Command, " ", Ada.St
rings.Fixed.Index_Non_Blank(Command)) - 1));
         else
            return T_Command'Value(Command(Index_Non_Blank(Command)..Command'last));
         end if;
      exception
            when Constraint_Error =>
            Return Result;
      end Value;
 
      command : T_Command;
 
 
   begin
      accept Start;
      Move("Commands : HALT, START ; 'Esc' to quit.", Help, Error, Center);
      Move("""Welcome to Harmonie.""", Banner, Error, Center);
 
      while not End_Of_Task loop
         Move((80 * ' '), Date, Error, Center);
         Move(Full_Datify_String(Clock), Date, Error, Center);
         select
            accept Receive(Char : in Character) do
               if Is_Control(Char) then
                  case Char is
                     when Character'Val(10) =>
                        Command := Value(Line(1..Last));
                        Last := 0;
                        case Command is
                           when Halt =>
                              Harmonia.Conductor.halt;
                           when Start =>
                              Harmonia.Conductor.start;
                             delay 10.0;
                           when others =>
                              null;
                        end case;
                     when Character'Val(127) =>
                        if Last /= 0 then
                           Line(Last) := ' ';
                           Last := Last - 1;
                        end if;
                     when others =>
                        null;
                  end case;
               elsif Is_Special(Char) then
                  null;
               else
                  if Last < Line'Length then
                     Line(Last+1) := Char;
                     Last := Last + 1;
                  end if;
               end if;
            end Receive;
         or
            accept Halt do
               Harmonia.Conductor.Stop;
               End_Of_Task := True;
            end Halt;
         or
            delay 0.05;
            Put(Clear_Screen);
            Put_line(Banner);
            Put_Line(Date);
            Put_line(help);
            if Last /= 0 then
               Put(Position((30 - Last/80),1));
               put(Line(1..Last));
            end if;
         end select;
      end loop;
   end Harmonie;
 
 
 
 
   subtype subString is Char_array(1..64);
 
   package String_Address_Conversion is new System.Address_To_Access_Conversions(substring);
   use String_Address_conversion;
 
 
   Pm_Error : PmError;
 
   PortMidiStream_Ptr,
   OutputDriverInfo_Ptr,
   Time_Info_Ptr  : System.Address;
  Current_DeviceInfo : DeviceInfo;
 
   Device : Natural;
 
   Pt_Error : PtError;
   Resolution : Integer;
   PtCallback,
   UserData : System.Address;
 
   Pm_Event : PmEvent;
 
 
   Char : Character;
 
   Errno : Interfaces.C.Int;
 
 
begin
   Pt_Error := Pt_Start(Resolution, PtCallback, UserData);
   Pm_Error := Pm_Initialize;
   New_Line;
   for I in 0..Pm_CountDevices-1 loop
      Current_DeviceInfo := DeviceInfo_Conversion.To_Pointer(Pm_GetDeviceInfo(I)).all;
      if Current_DeviceInfo.Output /= 0 then
         Put(I);
         Put_Line(" : " & To_Ada(To_Pointer(Current_DeviceInfo.Name).all));
      end if;
   end loop;
   New_Line;
   Put("Choose device : " );
   Get(Device);
   Pm_Error := Pm_OpenOutput( PortMidiStream => PortMidiStream_Ptr,
                              OutputDevice => device,
                              outputDriverInfo => OutputDriverInfo_ptr,
                              BufferSize => 10,
                              Time_Proc => Pt_Time'access,
                              Time_Info => Time_Info_ptr,
                              latency => 2);
 
   Put("Pm_OpenOutput... Ok !" );
   if Pm_HasHostError(PortMidiStream_Ptr) /= 0 then
      Put_line(To_Ada(Pm_GetErrorText(Pm_Error)));
   end if;
   Pm_Event.Message := 16£90£+ 60+ 100;
   Pm_Error := Pm_Write(PortMidiStream_Ptr, Pm_Event , 1);
   Put("Pm_Write... Ok !" );
   delay 5.0;
 
   Harmonie.Start;
 
   loop
      Get_Immediate(Char);
      case Char is
         when Character'Val(27) =>
            Harmonie.Halt;
            exit;
         when others =>
            Harmonie.Receive(Char);
      end case;
   end loop;
 
   Pm_Error := Pm_Close(PortMidiStream => PortMidiStream_ptr);
   Put_line(To_Ada(Pm_GetErrorText(Pm_Error)));
   Pm_Error := Pm_Terminate;
 
   New_Line;
 
end Main;

with Porttime;
with System;
with Interfaces.C;
with System.Address_To_Access_Conversions;
package Portmidi is
 
 
 
 
 
 
   type PmError is (pmNoErro,
                    PmHostError,
                    pmInvalidDeviceId,
                    pmInsufficientMemory,
                    pmBufferTooSmall,
                    pmBufferOverflow,
                    pmBadPtr,
                    pmBadData,
                    pmInternalError,
                    PmBufferMaxSize);
 
 
   function Pm_GetErrorText( Errnum : PmError  ) return Interfaces.C.Char_Array;
   Pragma Import (C, Pm_GetErrorText, "Pm_GetErrorText" );
 
   type DeviceInfo is
      record
         StructVersion : Integer;
         Interf : System.address;
         Name : System.Address;
         Input : Integer;
         Output : Integer;
         Opened : integer;
      end record;
 
 
   function Pm_HasHostError( PortMidiStream : System.Address ) return Interfaces.C.Int;
   pragma Import (C, Pm_HasHostError, "Pm_HasHostError" );
 
 
   package DeviceInfo_Conversion is new System.Address_To_Access_Conversions(DeviceInfo);
   use DeviceInfo_Conversion;
 
   function Pm_CountDevices return Integer;
   pragma Import (C, Pm_CountDevices, "Pm_CountDevices" );
 
   function Pm_GetDeviceInfo(PmDeviceID : Integer) return System.address;
   pragma Import (C, Pm_GetDeviceInfo, "Pm_GetDeviceInfo" );
 
 
   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_Initialize return PmError;
   pragma Import (C, Pm_Initialize, "Pm_Initialize" );
 
   function Pm_Terminate return PmError;
   pragma Import (C, Pm_Terminate, "Pm_Terminate" );
 
 
 
   function Pm_OpenInput(PortMidiStream : System.address;
                         PmDeviceID : Integer;
                         InputDriverInfo : Integer;
                         BufferSize : Long_Integer;
                         PmTimeProcPtr : Porttime.Time_Access;
                         time_info : integer) return PmError;
   pragma Import (C, Pm_OpenInput, "Pm_OpenInput" );
 
 
   function Pm_OpenOutput( PortMidiStream :System.address;
                           OutputDevice : Integer;
                           outputDriverInfo : System.address;
                           BufferSize : Long_Integer;
                           Time_Proc : Porttime.Time_Access;
                           Time_Info : System.address;
                           latency : Long_integer) return PmError;
   pragma Import (C, Pm_OpenOutput, "Pm_OpenOutput" );
 
   function Pm_SetFilter(PortMidiStream : System.address;
                         filters : Long_Integer) 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" );
 
   type PmEvent is
      record
         Message : Interfaces.C.Long;
         PmTimestamp : Interfaces.C.Long;
      end record;
 
   function Pm_Read( PortMidiStream : System.address;
                     Pm_Event : PmEvent;
                     Length :Long_integer) 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 : Long_integer) return PmError ;
   pragma Import (C, Pm_Write, "Pm_Write" );
 
 
   function Pm_WriteShort( PortMidiStream :System.address;
                           PmTimestamp : Float;
                           Msg : Long_integer) 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;