Problème avec une entrée de tache.

Problème avec une entrée de tache. - Ada - Programmation

Marsh Posté le 14-06-2010 à 12:11:41    

Bonjour,
J'ai un problème avec une entrée de tache.
Je fais de la musique.
Dans le paquetage suivant, la procedure start ne peut atteindre le l'entrée start des taches de type T_Radias_Driver(Radias : t_radias_access)... Pourquoi ?
J'ai vérifier que le pointeur sur le type T_radias_driver étéait bien initilisé et que la tache demare correctement.
Donc, j'affiche "Start instrument $n°" dans la procedure Start mais pas "Starting All timbre..." dans la tache Radias_Driver.
Merci pour votre lecture.
La specification ::=  
 

Code :
  1. with System;                            use System;
  2. with Interfaces.C;                      use Interfaces;
  3. with Gnat.Os_Lib;                       use Gnat.Os_Lib;
  4.  
  5. generic
  6.   Max : Positive := 1;
  7. package Generic_Orchester is
  8.   type T_Orchester is private;
  9.   procedure Start(Orchester : in T_Orchester);
  10.   procedure Stop(Orchester : in T_Orchester);
  11.   procedure Configure(Orchester : in out T_Orchester);
  12.   procedure Destroy(Orchester : in out T_Orchester);
  13.   procedure Afficher(Orchester : in T_Orchester);
  14.   Timbre_Error : exception;
  15. private
  16.  
  17.   type T_Model is (Unknow, Radias);
  18.   type Address_Access is access System.Address;
  19.   type T_Channel is new Natural range 0..15;
  20.  
  21.   subtype T_Value is Natural range 0..127;
  22.  
  23.   type T_Note is
  24.      record
  25.         Key  : T_Value;
  26.         Sens : T_Value;
  27.      end record;
  28.  
  29.   type T_Chord is array (Positive range <> ) of T_Note;
  30.  
  31.  
  32.   type T_Eq is limited
  33.      record
  34.  
  35.         Hi : T_Value;
  36.         Lo : T_Value;
  37.  
  38.      end record;
  39.  
  40.   type T_Fx_Name is (Compressor, Limiter, Gate, Filter,
  41.                      Wah, Eq, Distortion, Cabinet,
  42.                      Tube, Decimator, Reverb, Reflect,
  43.                      LCR_Delay, ST_Delay, A_Pan_Delay, St_A_Pan_Delay,
  44.                      Mod_Delay, St_Mod_Delay, Echo, Chorus,
  45.                      Ensemble, Flanger, Phaser, Tremolo,
  46.                      Ring, Pitch, Grain, Vibrato,
  47.                      Rotary, Talking);
  48.  
  49.   type T_Fx(Name : T_Fx_Name) is
  50.      record
  51.         Status : Boolean := False;
  52.         case Name is
  53.            when others =>
  54.               null;
  55.         end case;
  56.      end record;
  57.  
  58.  
  59.   type Fx_Access is access T_Fx;
  60.  
  61.  
  62.   subtype T_Drums_Kit_Number is Natural range 0..31;
  63.  
  64.   type T_Wave1 is (Saw, Square, Tri, Sin, Formant,
  65.                    Noise, Synth_Pcm, Drum_Pcm, Audio_In);
  66.  
  67.   type T_Osc_Mod1 is (Wave, Cross, Unison, Vpm);
  68.  
  69.   type T_Radias_Osc1 is
  70.      record
  71.         Wave        : T_Wave1;
  72.         Osc_Mod     : T_Osc_Mod1;
  73.         Controler_1 : T_Value := 0;
  74.         Controler_2 : T_Value := 0;
  75.      end record;
  76.  
  77.  
  78.   subtype T_Wave2 is T_Wave1 range Saw .. Sin;
  79.  
  80.   type T_Osc_Mod2 is
  81.      record
  82.         Ring : Boolean := False;
  83.         Sync : Boolean := False;
  84.      end record;
  85.  
  86.   type T_Radias_Osc2 is
  87.      record
  88.         Wave        : T_Wave2;
  89.         Osc_Mod     : T_Osc_Mod2;
  90.         Controler_1 : T_Value := 0;
  91.         Controler_2 : T_Value := 0;
  92.      end record;
  93.  
  94.  
  95.   type T_Filter_Routing is (Single, Serial, Parallel, Individual);
  96.   type T_Filter_Parameters is
  97.      record
  98.         Cutoff    : T_Value := 127;
  99.         Resonance : T_Value := 0;
  100.         Eg1_Int   : T_Value := 64;
  101.         Key_Track : T_Value := 64;
  102.      end record;
  103.  
  104.   type T_Filter2_Type is (Lpf, Hpf, Bpf, Comb);
  105.  
  106.   type T_Filters is
  107.      record
  108.         Routing            : T_Filter_Routing := Single;
  109.         Filter1_Type       : T_Value := 127;
  110.         Filter1_Parameters : T_Filter_Parameters;
  111.         Filter2_Type       : T_Filter2_Type := Lpf;
  112.         Filter2_Parameters : T_Filter_Parameters;
  113.      end record;
  114.  
  115.  
  116.   type T_Depth_Type is (Off, Drive, Ws);
  117.  
  118.   type T_Depth is
  119.      record
  120.         Depth_Type    : T_Depth_Type := Off;
  121.         Depth_Control : T_Value := 0;
  122.      end record;
  123.  
  124.  
  125.   task type T_Drums_Driver(Output : Address_access) is
  126.      entry Start;
  127.      entry Stop;
  128.      entry Halt;
  129.      entry Receive(Chord : T_Chord);
  130.   end T_Drums_Driver;
  131.  
  132.   task type T_Timbre_Driver(Output : Address_access) is
  133.      entry Start;
  134.      entry Stop;
  135.      entry Halt;
  136.      entry Receive(Chord : T_Chord);
  137.   end T_Timbre_Driver;
  138.  
  139.   type T_Timbre(Drums : Boolean;
  140.                 Output : Address_access) is limited
  141.      record
  142.         Channel      : T_Channel;
  143.         Level        : T_Value := 100;
  144.         Pan          : T_Value := 64;
  145.         Eq           : T_Eq;
  146.         InsFx_1      : Fx_access;
  147.         InsFx_2      : Fx_access;
  148.         MstFx        : Fx_access;
  149.         case Drums is
  150.            when True =>
  151.               Drums_Kit_Number : T_Drums_Kit_Number := 0;
  152.               Drums_Driver : T_Drums_Driver(Output);
  153.            when False =>
  154.               Osc1 : T_Radias_Osc1;
  155.               Osc2 : T_Radias_Osc2;
  156.               Unison : Boolean := False;
  157.               Filters : T_Filters;
  158.               Depth   : T_Depth;
  159.               Timbre_Driver : T_Timbre_Driver(Output);
  160.         end case;
  161.      end record;
  162.  
  163.   type Timbre_Access is access T_Timbre;
  164.   type T_Timbres_Table is array (Positive range <> ) of Timbre_Access;
  165.   type Timbres_Table_Access is access T_Timbres_Table;
  166.   type T_Radias;
  167.   task type T_Radias_Driver(Radias : access T_Radias) is
  168.      entry Start;
  169.      entry Stop;
  170.      entry Halt;
  171.      entry Receive(Message : in C.Long);
  172.      entry Receive(Chord : in T_Chord);
  173.   end T_Radias_Driver;
  174.   type Radias_Driver_Access is access T_Radias_Driver;
  175.   type T_Radias(With_Input : Boolean) is
  176.      record
  177.         Input : Address_Access;
  178.         Output : Address_Access;
  179.         Model  : T_Model := Unknow;
  180.         Name   : String_Access;
  181.         Configured : Boolean := False;
  182.         Global_Channel : T_Channel;
  183.         Timbres : Timbres_Table_access;
  184.         Radias_Driver : Radias_Driver_Access;
  185.      end record;
  186.   type Radias_Access is access T_Radias;
  187.   type T_Orchester is array (1..Max) of Radias_Access;
  188.   procedure Radias_Configuration(Radias : in Radias_access);
  189. end Generic_Orchester;


 
Le corps du paquetage ::=  

Code :
  1. with Text_Io;                           use Text_Io;
  2. with PragmARC.Ansi_Tty_Control;         use PragmARC.Ansi_Tty_Control;
  3. with PragmARC.Menu_Handler;
  4. with Portmidi, Porttime;                use Portmidi, Porttime;
  5. with Ada.Strings, Ada.Strings.Fixed;    use Ada.Strings;
  6. with Calendar;                          use Calendar;
  7. package body Generic_Orchester is
  8.  
  9.   procedure Start(Orchester : in T_Orchester) is
  10.   begin
  11.      for I in Orchester'Range loop
  12.         if Orchester(I) /= null and then
  13.           Orchester(I).Configured then
  14.            Put_Line("Start instrument " & Integer'Image(I));
  15.            Orchester(I).Radias_Driver.Start;
  16.         end if;
  17.      end loop;
  18.   end Start;
  19.  
  20.   procedure Stop(Orchester : in T_Orchester) is
  21.   begin
  22.      for I in Orchester'Range loop
  23.         if Orchester(I) /= null and then
  24.           Orchester(I).Configured then
  25.            Orchester(I).Radias_Driver.stop;
  26.         end if;
  27.      end loop;
  28.   end Stop;
  29.  
  30.   package Menuconfig is new PragmARC.Menu_Handler(80,30);
  31.   use Menuconfig, Menuconfig.V_String;
  32.  
  33.  
  34.   procedure Destroy(Orchester : in out T_Orchester) is
  35.   begin
  36.      for I in Orchester'Range loop
  37.         Orchester(I).Radias_Driver.halt;
  38.         Orchester(I) := null;
  39.      end loop;
  40.   end Destroy;
  41.  
  42.   procedure Afficher(Orchester : in T_Orchester) is
  43.   begin
  44.      Put_Line("N° , Model     , Name     , Statut" );
  45.      for I in Orchester'Range loop
  46.         if Orchester(I) /= null then
  47.            Put(Integer'Image(I) & ", " );
  48.            Put(T_Model'Image(Orchester(I).Model) & ", " );
  49.            Put(Orchester(I).Name.all & ", " );
  50.            if Orchester(I).Configured then
  51.               Put("Configured" );
  52.            else
  53.               Put("Not configured" );
  54.            end if;
  55.            New_Line;
  56.         end if;
  57.      end loop;
  58.   end Afficher;
  59.  
  60.   procedure Create(Instrument : out Radias_access);
  61.  
  62.   procedure Configure(Orchester : in out T_Orchester) is
  63.      Empty : Boolean := True;
  64.      Main_Choice : Positive range 1..6;
  65.      line : String(1..256);
  66.      Last,
  67.      Instrument_Choice : Natural := 0;
  68.   begin
  69.      loop
  70.         case Empty is
  71.            when False =>
  72.               declare
  73.  
  74.                  Main_Menu : Menu_Info :=
  75.  
  76.                    (6, True,
  77.                     To_Bounded_String("Configuration" ),
  78.                     (To_Bounded_String("Charger un fichier de configuration" ),
  79.                      To_Bounded_String("Ajouter un instrument" ),
  80.                      To_Bounded_String("Supprimer un instrument" ),
  81.                      To_Bounded_String("Configurer un instrument" ),
  82.                      To_Bounded_String("Sauvegarder la configuration" ),
  83.                      To_Bounded_String("Retour a l'ecran principal" )),
  84.                     4);
  85.               begin
  86.  
  87.                  Main_Choice := Process(Main_Menu);
  88.  
  89.               end;
  90.  
  91.            when True =>
  92.               declare
  93.                  Main_Menu : Menu_Info :=
  94.                    (3, True,
  95.                     To_Bounded_String("Configuration" ),
  96.                     (To_Bounded_String("Charger un fichier de configuration" ),
  97.                      To_Bounded_String("Ajouter un instrument" ),
  98.                      To_Bounded_String("Retour a l'ecran principal" )),
  99.                     2);
  100.               begin
  101.                  Main_Choice := Process(Main_Menu);
  102.               end;
  103.         end case;
  104.         case Empty is
  105.            when False =>
  106.               case Main_Choice is
  107.                  when 1 =>
  108.                     null;
  109.                  when 2 =>
  110.                     null;
  111.                  when 3 =>
  112.                     null;
  113.                  when 4 =>
  114.                     loop
  115.                        begin
  116.                           Put(Clear_Screen);
  117.                           Afficher(Orchester);
  118.  
  119.                           Put("Entrez le N° de l'instrument : " );
  120.                           Get_line(line, Last);
  121.                           if Last /= 0 then
  122.                              Instrument_Choice :=
  123.                                Natural'Value(Line(1..Last));
  124.                           else
  125.                              raise Program_Error;
  126.                           end if;
  127.                           if Orchester(Instrument_choice) /= null then
  128.                              case Orchester(Instrument_choice).Model is
  129.                                 when Unknow =>
  130.                                    null;
  131.                                 when Radias =>
  132.                                    Radias_Configuration
  133.                                      (Orchester(Instrument_Choice));
  134.                              end case;
  135.                           end if;
  136.                           exit;
  137.                        exception
  138.                           when Program_Error =>
  139.                              null;
  140.                        end;
  141.                     end loop;
  142.                  when 5 =>
  143.                     null;
  144.                  when 6 =>
  145.                     exit;
  146.               end case;
  147.            when True =>
  148.               case Main_Choice is
  149.                  when 1 =>
  150.                     null;
  151.                  when 2 =>
  152.                     if Orchester(1) /= null then
  153.                        raise Program_Error;
  154.                     else
  155.                        Create(Orchester(1));
  156.                        Empty := False;
  157.                     end if;
  158.                  when 3 =>
  159.                     exit;
  160.                  when others =>
  161.                     null;
  162.               end case;
  163.         end case;
  164.      end loop;
  165.  
  166.   end Configure;
  167.  
  168.  
  169.   use DeviceInfo_Conversion;
  170.   use ErrorText_Conversion;
  171.  
  172.  
  173.  
  174.   function Model(Name : in string) return T_Model is
  175.      Value : T_Model := Unknow;
  176.   begin
  177.      Value := T_Model'Value
  178.        (Name(Name'First..Fixed.Index(Name, " ", forward)));
  179.      return Value;
  180.   exception
  181.      when Constraint_Error =>
  182.         return Unknow;
  183.   end Model;
  184.  
  185.  
  186.  
  187.   type T_Status is (Null_Item, Noteon, Noteoff, Eq, Fx1, Fx2, MstFx);
  188.   function Status(Message : Interfaces.C.long) return T_Status;
  189.   function data1(Message : Interfaces.C.long) return String;
  190.   function data2(Message : Interfaces.C.long) return String;
  191.  
  192.   task body T_Radias_Driver is
  193.  
  194.  
  195.      task type T_Input_Driver is
  196.         entry Halt;
  197.      end T_Input_Driver;
  198.  
  199.      task body T_Input_Driver is
  200.  
  201.         task type T_Input is
  202.            entry Initialize;
  203.            entry Send(Message : out C.Long);
  204.         end T_Input;
  205.         task body T_Input is
  206.            Pm_Event : PmEvent;
  207.         begin
  208.            accept Initialize;
  209.            loop
  210.               Pm_Event.Message := Read_handler(Radias.Input.All);
  211.               accept Send(Message : out C.Long) do
  212.                  Message := Pm_Event.Message;
  213.               end Send;
  214.            end loop;
  215.         end T_Input;
  216.  
  217.         The_Chord :  T_Chord(1..24);
  218.         The_Status : T_Status;
  219.         Step_Time : Time := clock;
  220.         Step_Length : Duration := 0.1;
  221.         Index : Natural := 0;
  222.         Message : C.Long;
  223.         Input : T_Input;
  224.         End_Of_Task : Boolean := False;
  225.      begin
  226.         Input.Initialize;
  227.  
  228.         while not End_Of_Task loop
  229.            select
  230.               accept Halt do
  231.                  End_Of_Task := True;
  232.               end Halt;
  233.            or
  234.               delay 0.0;
  235.            end select;
  236.            select
  237.               Input.Send(Message);
  238.               The_Status := Status(Message);
  239.               case The_Status is
  240.                  when Noteon =>
  241.                     if Clock < Step_Time then
  242.                        if Index < 5 then
  243.                           Index := Index + 1;
  244.                           The_Chord(Index) := (T_value'Value("16#" & data1(Message) & '#')    ,T_value'Value("16#" & data2(Message) & '#' ));
  245.                        end if;
  246.                     else
  247.                        if Index /= 0 then
  248.                           Receive(The_Chord(1..Index));
  249.                           Index := 0;
  250.                        end if;
  251.                        Index := 1;
  252.                        The_Chord(Index) := (T_value'Value("16#" & data1(Message) & '#')    ,T_value'Value("16#" & data2(Message) & '#' ));
  253.                        Step_Time := Clock + 0.125;
  254.                     end if;
  255.                  when Noteoff =>
  256.                     null;
  257.                  when others =>
  258.                     Receive(Message);
  259.               end case;
  260.            or
  261.               delay 0.1;
  262.               if Index /= 0 then
  263.                  Receive(The_Chord(1..Index));
  264.                  Index := 0;
  265.               end if;
  266.            end select;
  267.         end loop;
  268.         abort Input;
  269.      end T_Input_Driver;
  270.      type Input_Driver_Access is access T_Input_Driver;
  271.  
  272.      Input_driver : Input_Driver_Access;
  273.      The_Status : T_Status;
  274.      Suspended, End_Of_Task : Boolean := False;
  275.   begin
  276.  
  277.      if Radias.With_Input then
  278.         Input_driver := new T_Input_Driver;
  279.      end if;
  280.  
  281.      while not End_Of_Task loop
  282.         select
  283.            accept Start do
  284.               Put_Line("Starting All timbre..." );
  285.               for I in Radias.Timbres'Range loop
  286.                  Put_Line("Starting timbre N°" & Integer'Image(I));
  287.                  if Radias.Timbres(I) /= null and then
  288.                    Radias.Timbres(I).Drums then
  289.                     Radias.Timbres(I).Drums_Driver.Start;
  290.                  elsif Radias.Timbres(I) /= null then
  291.                     Radias.Timbres(I).Timbre_Driver.Start;
  292.                  end if;
  293.                  Put_Line("Timbre N°" & Integer'Image(I) & "Started." );
  294.               end loop;
  295.               Suspended := False;
  296.            end Start;
  297.         or
  298.            accept Halt do
  299.               Input_Driver.Halt;
  300.               for I in Radias.Timbres'Range loop
  301.                  if Radias.Timbres(I) /= null and then
  302.                    Radias.Timbres(I).Drums then
  303.                     Radias.Timbres(I).Drums_Driver.Halt;
  304.                  elsif Radias.Timbres(I) /= null then
  305.                     Radias.Timbres(I).Timbre_Driver.Halt;
  306.                  end if;
  307.               end loop;
  308.               Suspended := True;
  309.               End_Of_Task := True;
  310.            end Halt;
  311.         end select;
  312.  
  313.         while not Suspended loop
  314.            select
  315.               accept Stop do
  316.                  for I in Radias.Timbres'Range loop
  317.                     if Radias.Timbres(I) /= null and then
  318.                       Radias.Timbres(I).Drums then
  319.                        Radias.Timbres(I).Drums_Driver.Stop;
  320.                     elsif Radias.Timbres(I) /= null then
  321.                        Radias.Timbres(I).Timbre_Driver.Stop;
  322.                     end if;
  323.                  end loop;
  324.                  Suspended := True;
  325.               end Stop;
  326.            or
  327.               accept Halt do
  328.                  Input_Driver.Halt;
  329.                  for I in Radias.Timbres'Range loop
  330.                     if Radias.Timbres(I) /= null and then
  331.                       Radias.Timbres(I).Drums then
  332.                        Radias.Timbres(I).Drums_Driver.Halt;
  333.                     elsif Radias.Timbres(I) /= null then
  334.                        Radias.Timbres(I).Timbre_Driver.Halt;
  335.                     end if;
  336.                  end loop;
  337.                  Suspended := True;
  338.                  End_Of_Task := True;
  339.               end Halt;
  340.            or
  341.               accept Receive(Message : in C.Long) do
  342.                  The_Status := Status(Message);
  343.                  case The_Status is
  344.                     when Eq =>
  345.                        null;
  346.                     when Fx1 =>
  347.                        null;
  348.                     when Fx2 =>
  349.                        null;
  350.                     when MstFx =>
  351.                        null;
  352.                     when others =>
  353.                        null;
  354.                  end case;
  355.               end Receive;
  356.            or
  357.               accept Receive(Chord : in T_Chord) do
  358.                  null;
  359.               end Receive;
  360.            end select;
  361.         end loop;
  362.      end loop;
  363.   end T_Radias_Driver;
  364.  
  365.   procedure Create(Instrument : out Radias_Access) is
  366.      line : String(1..256);
  367.      Last,
  368.      Choice : Natural := 0;
  369.      The_Deviceinfo : DeviceInfo;
  370.      Name : T_ErrorText;
  371.      With_Input : Boolean;
  372.      Current_Model : T_Model := Unknow;
  373.   begin
  374.      loop
  375.         Put("Souhaitez vous connecter un controleur ? (O/N)" );
  376.         Get_Immediate(Line(1));
  377.         case Line(1) is
  378.            when 'n' | 'N' =>
  379.               With_Input := False;
  380.               exit;
  381.            when 'o' | 'O' =>
  382.               With_Input := True;
  383.               exit;
  384.            when others =>
  385.               null;
  386.         end case;
  387.      end loop;
  388.      New_Line;
  389.      case With_Input is
  390.         when False =>
  391.            put_Line("Connexion d'un instrument MIDI sans controler..." );
  392.         when True =>
  393.            Put_Line("Connexion d'un instrument MIDI avec controler..." );
  394.      end case;
  395.  
  396.      loop
  397.         Put_Line("Choisissez un peripherique de sortie..." );
  398.         begin
  399.            Put_line("ID, Peripherique" );
  400.            for I in 0..Pm_CountDevices-1 loop
  401.               The_DeviceInfo :=
  402.                 DeviceInfo_Conversion.To_pointer(Pm_GetDeviceInfo(I)).all;
  403.               if The_Deviceinfo.Output = 1 then
  404.                  Name := To_Pointer(The_Deviceinfo.name).all;
  405.                  Put(Integer'Image(I));
  406.                  Put_line(", " & C.To_Ada(Name));
  407.               end if;
  408.            end loop;
  409.  
  410.            Put("Entrez l'ID de l'instrument et 'Entree' pour terminer : " );
  411.            Get_line(line, Last);
  412.            if Last /= 0 then
  413.               Choice := Natural'Value(Line(1..Last));
  414.            else
  415.               raise Program_Error;
  416.            end if;
  417.            case Choice is
  418.               when 0..255 =>
  419.                  The_DeviceInfo :=
  420.                    DeviceInfo_Conversion.To_pointer(Pm_GetDeviceInfo(choice)).all;
  421.                  if The_Deviceinfo.Output = 1 then
  422.                     Name := To_Pointer(The_Deviceinfo.name).all;
  423.                  end if;
  424.                  Current_Model := Model(C.To_Ada(Name));
  425.                  case Current_Model is
  426.                     when Unknow =>
  427.                        raise Program_Error;
  428.                     when Radias =>
  429.                        Instrument := new T_Radias(With_Input);
  430.                        Instrument.Model := Radias;
  431.                        Instrument.Name := new String '(C.To_Ada(Name));
  432.                        Instrument.output := new System.Address ' (output_Open_Handler(Choice));
  433.                  end case;
  434.                  exit;
  435.               when others =>
  436.                  New_Line;
  437.            end case;
  438.         exception
  439.            when others =>
  440.               Last := 0;
  441.               Put("Appuyez sur entree pour poursuivre" );
  442.               Skip_Line;
  443.               New_Line;
  444.         end;
  445.      end loop;
  446.      case With_Input is
  447.         when False =>
  448.            null;
  449.         when True =>
  450.            loop
  451.               Put_Line("Choisissez un peripherique d'entree..." );
  452.               begin
  453.                  Put_line("ID, Peripherique" );
  454.                  for I in 0..Pm_CountDevices-1 loop
  455.                     The_DeviceInfo :=
  456.                       DeviceInfo_Conversion.To_pointer
  457.                       (Pm_GetDeviceInfo(I)).all;
  458.                     if The_Deviceinfo.input = 1 then
  459.                        Name := To_Pointer(The_Deviceinfo.name).all;
  460.                        Put(Integer'Image(I));
  461.                        Put_line(", " & Interfaces.C.To_Ada(Name));
  462.                     end if;
  463.                  end loop;
  464.                  Put("Entrez l'ID du controleur et 'Entree' pour terminer : " );
  465.                  Get_line(line, Last);
  466.                  if Last /= 0 then
  467.                     Choice := Natural'Value(Line(1..Last));
  468.                  else
  469.                     return;
  470.                  end if;
  471.                  case Choice is
  472.                     when 0..255 =>
  473.                        Instrument.Input := new System.Address ' (Input_Open_Handler(Choice));
  474.                        exit;
  475.                     when others =>
  476.                        New_Line;
  477.                  end case;
  478.               exception
  479.                  when others =>
  480.                     Last := 0;
  481.                     Put("Press any key to continue" );
  482.                     Skip_Line;
  483.                     New_Line;
  484.               end;
  485.            end loop;
  486.      end case;
  487.   end Create;
  488.  
  489.   procedure Configure(Timbre : in Timbre_Access;  Num : in Positive);
  490.  
  491.  
  492.   procedure Radias_Configuration(Radias : in Radias_access) is
  493.      Channel : Integer;
  494.      line : String(1..256);
  495.      Last,
  496.      Choice : Natural := 0;
  497.      With_Drums : Boolean;
  498.      Max_Timbres : Positive;
  499.   begin
  500.      loop
  501.         begin
  502.            Put("Entrez le N° de canal pour l'acheminement global : " );
  503.            Get_line(line, Last);
  504.            if Last /= 0 then
  505.               Channel := Natural'Value(Line(1..Last));
  506.            else
  507.               raise Program_Error;
  508.            end if;
  509.            case Channel is
  510.               when 1..16 =>
  511.                  Radias.Global_Channel := T_Channel(Channel - 1);
  512.  
  513.                  exit;
  514.               when others =>
  515.                  New_Line;
  516.            end case;
  517.         exception
  518.            when others =>
  519.               Last := 0;
  520.               Put("Appuyez sur entree pour poursuivre" );
  521.               Skip_Line;
  522.               New_Line;
  523.         end;
  524.      end loop;
  525.      loop
  526.         begin
  527.            Put("Combien de timbre souhaitez vous initialiser : " );
  528.            Get_line(line, Last);
  529.            if Last /= 0 then
  530.               Choice := Natural'Value(Line(1..Last));
  531.            else
  532.               raise Program_Error;
  533.            end if;
  534.            case choice is
  535.               when 1..4 =>
  536.                  Radias.timbres := new T_Timbres_Table(1..Choice);
  537.                  Max_Timbres := Choice;
  538.                  exit;
  539.               when others =>
  540.                  New_Line;
  541.            end case;
  542.         exception
  543.            when others =>
  544.               Last := 0;
  545.               Put("Appuyez sur entree pour poursuivre" );
  546.               Skip_Line;
  547.               New_Line;
  548.         end;
  549.      end loop;
  550.      loop
  551.         Put("Souhaitez vous configurer un timbre pour les drums ? (O/N)" );
  552.         Get_Immediate(Line(1));
  553.         case Line(1) is
  554.            when 'n' | 'N' =>
  555.               With_Drums := False;
  556.               exit;
  557.            when 'o' | 'O' =>
  558.               With_Drums := True;
  559.               exit;
  560.            when others =>
  561.               null;
  562.         end case;
  563.         New_Line;
  564.      end loop;
  565.      New_Line;
  566.      if With_Drums then
  567.         loop
  568.            begin
  569.               Put("Entrez le N° du timbre pour les drums : " );
  570.               Get_line(line, Last);
  571.               if Last /= 0 then
  572.                  Choice := Natural'Value(Line(1..Last));
  573.               else
  574.                  raise Program_Error;
  575.               end if;
  576.  
  577.               if Choice <= Max_Timbres then
  578.                  Radias.Timbres(Choice) := new T_Timbre(True, Radias.Output);
  579.                  exit;
  580.               end if;
  581.            exception
  582.               when others =>
  583.                  Last := 0;
  584.                  Put("Appuyez sur entree pour poursuivre" );
  585.                  Skip_Line;
  586.                  New_Line;
  587.            end;
  588.         end loop;
  589.      end if;
  590.      for I in 1..Radias.Timbres'Length loop
  591.         if Radias.Timbres(I) = null then
  592.            Radias.Timbres(I) := new T_Timbre(False, Radias.output);
  593.         end if;
  594.      end loop;
  595.  
  596.      for I in 1..Radias.Timbres'Length loop
  597.         Configure(Radias.Timbres(I), I);
  598.      end loop;
  599.  
  600.      Radias.Radias_Driver := new T_Radias_Driver(Radias);
  601.      Radias.Configured := True;
  602.   end Radias_Configuration;
  603.  
  604.  
  605.   procedure Configure(Timbre : in Timbre_Access; Num : in Positive) is
  606.      Channel : Integer;
  607.      line : String(1..256);
  608.      Last,
  609.      Choice : Natural := 0;
  610.   begin
  611.      if Timbre = null then
  612.         raise Timbre_error;
  613.      end if;
  614.      loop
  615.         begin
  616.            Put("Entrez le N° de canal pour le timbre N°" &
  617.                Integer'Image(Num) & " : " );
  618.            Get_line(line, Last);
  619.            if Last /= 0 then
  620.  
  621.               Channel := integer'Value(Line(1..Last));
  622.            else
  623.               raise Program_Error;
  624.            end if;
  625.            case Channel is
  626.               when 1..16 =>
  627.                  timbre.Channel := T_Channel(Channel - 1);
  628.                  exit;
  629.               when others =>
  630.                  New_Line;
  631.            end case;
  632.         exception
  633.            when Program_error =>
  634.               Last := 0;
  635.               Put("Appuyez sur entree pour poursuivre" );
  636.               Skip_Line;
  637.               New_Line;
  638.         end;
  639.      end loop;
  640.   end Configure;
  641.  
  642.   function Status(Message : Interfaces.C.long) return T_Status is
  643.   begin
  644.      if Hex_Image(Interfaces.C.Long(Message))' Length > 3 then
  645.         if Hex_Image(Interfaces.C.Long(Message))
  646.           (Hex_Image(Interfaces.C.Long(Message))' Length-1) =
  647.           '9' then
  648.            Put("others ::= " & Hex_Image(Interfaces.C.Long(Message)));
  649.            return Noteon;
  650.         elsif Hex_Image(Interfaces.C.Long(Message))
  651.           (Hex_Image(Interfaces.C.Long(Message))' Length-1) =
  652.           '8' then
  653.            Put("others ::= " & Hex_Image(Interfaces.C.Long(Message)));
  654.            return Noteoff;
  655.         else
  656.            Put("others ::= " & Hex_Image(Interfaces.C.Long(Message)));
  657.            return Null_Item;
  658.         end if;
  659.      else
  660.         Put("others ::= " & Hex_Image(Interfaces.C.Long(Message)));
  661.         return Null_Item;
  662.      end if;
  663.   end Status;
  664.  
  665.  
  666.   function data1(Message : Interfaces.C.long) return string is
  667.   begin
  668.      return Hex_Image(Interfaces.C.Long(Message))
  669.        (Hex_Image(Interfaces.C.Long(Message))' Length-3..
  670.         Hex_Image(Interfaces.C.Long(Message)) 'Length-2);
  671.  
  672.   end data1;
  673.  
  674.   function data2(Message : Interfaces.C.long) return string is
  675.   begin
  676.      return Hex_Image(Interfaces.C.Long(Message))
  677.        (Hex_Image(Interfaces.C.Long(Message))' Length-5..
  678.         Hex_Image(Interfaces.C.Long(Message)) 'Length-4);
  679.  
  680.   end data2;
  681.  
  682.  
  683.   task body T_Drums_Driver is
  684.      Suspended, End_Of_Task : Boolean := False;
  685.   begin
  686.      while not End_Of_Task loop
  687.         select
  688.            accept Start do
  689.               Suspended := False;
  690.            end Start;
  691.         or
  692.            accept Halt do
  693.               Suspended := True;
  694.               End_Of_Task := True;
  695.            end Halt;
  696.         end select;
  697.  
  698.         while not Suspended loop
  699.            select
  700.               accept Stop do
  701.                  Suspended := True;
  702.               end Stop;
  703.            or
  704.               accept Halt do
  705.  
  706.                  Suspended := True;
  707.                  End_Of_Task := True;
  708.               end Halt;
  709.            or
  710.               accept Receive(Chord : in T_Chord) do
  711.                  null;
  712.               end Receive;
  713.            end select;
  714.         end loop;
  715.      end loop;
  716.  
  717.   end T_Drums_Driver;
  718.  
  719.  
  720.   task body T_Timbre_Driver is
  721.      Suspended, End_Of_Task : Boolean := False;
  722.   begin
  723.      while not End_Of_Task loop
  724.         select
  725.            accept Start do
  726.  
  727.               Suspended := False;
  728.            end Start;
  729.         or
  730.            accept Halt do
  731.               Suspended := True;
  732.               End_Of_Task := True;
  733.            end Halt;
  734.         end select;
  735.  
  736.         while not Suspended loop
  737.            select
  738.               accept Stop do
  739.                  Suspended := True;
  740.               end Stop;
  741.            or
  742.               accept Halt do
  743.  
  744.                  Suspended := True;
  745.                  End_Of_Task := True;
  746.               end Halt;
  747.            or
  748.               accept Receive(Chord : in T_Chord) do
  749.                  null;
  750.               end Receive;
  751.            end select;
  752.         end loop;
  753.      end loop;
  754.  
  755.   end T_Timbre_Driver;
  756.  
  757. end Generic_Orchester;


Message édité par Profil supprimé le 14-06-2010 à 12:13:30
Reply

Marsh Posté le 14-06-2010 à 12:11:41   

Reply

Marsh Posté le 14-06-2010 à 14:05:21    

Bien, merci de votre attention...
 
J'ai poursuivie l'implémentation, je ne sais pas trop ou ça foirait, mais ceci étant qu'a présent, ça fonctionne.
 
Merci encore.

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed