Forum |  HardWare.fr | News | Articles | PC | Prix | S'identifier | S'inscrire | Aide | Shop Recherche
1766 connectés 

  FORUM HardWare.fr
  Programmation
  Ada

  Problème avec une entrée de tache.

 



 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

Problème avec une entrée de tache.

n°2001440
Profil sup​primé
Posté le 14-06-2010 à 12:11:41  answer
 

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
mood
Publicité
Posté le 14-06-2010 à 12:11:41  profilanswer
 

n°2001462
Profil sup​primé
Posté le 14-06-2010 à 14:05:21  answer
 

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.


Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  Ada

  Problème avec une entrée de tache.

 

Sujets relatifs
Problème d'accentProblème accéder l'élement DOM (parsing html)
Problème code PHP insertion données form dans DBProblème d'utilisation de DSN avec socket (PHP &PEAR)
problème javascriptASM Gros problème :"(
Problème rechercher et remplacer sous Access[Résolu] Petit problème "for" déjà dans une boucle ...
Problème de variable de sessionProblème copie d'une table dans une autre
Plus de sujets relatifs à : Problème avec une entrée de tache.


Copyright © 1997-2018 Hardware.fr SARL (Signaler un contenu illicite) / Groupe LDLC / Shop HFR