Programación en Ada/Tareas/Ejemplos

← Tareas/Dependencia Ejemplos completos de tareas GLADE →


Ejemplos completos de tareas

editar

Semáforos

editar

Una posible implementación del tipo abstracto semáforo es con tareas Ada. Pero este ejemplo no se ha de tomar muy en serio, puesto que es un típico caso de inversión de la abstracción, es decir, se hace uso de un mecanismo de alto nivel, las tareas, para implementar uno de bajo nivel, los semáforos. En Ada 95 la mejor manera de implementar un semáforo es un objeto protegido. Sin embargo a efectos didácticos es un buen ejemplo.

generic
  ValorInicial: Natural := 1;  -- Parám. genérico con valor por defecto.
 package Semaforos is
  type TSemaforo is limited private;
  procedure Wait (Sem: in out TSemaforo);
  procedure Signal (Sem: in out TSemaforo);
private
  task type TSemaforo is
    entry Wait;
    entry Signal;
  end TSemaforo;
end Semaforos;
package body Semaforos is
  procedure Wait (Sem: in out TSemaforo) is
    begin
      Sem.Wait;  -- Llamada a punto de entrada de la tarea.
     end Wait;
  procedure Signal (Sem: in out TSemaforo) is
    begin
      Sem.Signal;  -- Llamada a punto de entrada de la tarea.
     end Signal;
  task body TSemaforo is
    S: Natural := ValorInicial;  -- Es el contador del semáforo.
   begin
    loop
      select
        when S > 0 =>
          accept Wait;
          S := S - 1;
      or
        accept Signal;
        S := S + 1;
      or
        terminate;
      end select;
    end loop;
  end TSemaforo;
end Semaforos;
with Semaforos;

procedure Prueba_Semaforos is
  package Paquete_Semaforos is new Semaforos;
  use Paquete_Semaforos;
  Semaforo: TSemaforo;
begin  -- Aquí se inicia la tarea de tipo TSemaforo (objeto Semaforo).
   -- ...
   Wait (Semaforo);
   -- ...
   Signal (Semaforo);
   -- ...
end Prueba_Semaforos;

Simulación de trenes

editar
 
ejercicio
Problema: Escribe un programa que realice una simulación de trenes circulando por estaciones. Cada tren espera a que la estación siguiente esté libre para avanzar, es decir, hasta que un tren no ha abandonado una estación, el tren de la estación anterior no puede avanzar. Para ello puedes usar los semáforos definidos en el ejemplo anterior.


Buffer circular

editar

Otro ejemplo, una posible implementación de un buffer circular:

generic
   type TElemento is private;
   Tamaño: Positive := 32;
package Buffer_servidor is
   type TBuffer is limited private;
   procedure EscribirBuf (B: in out TBuffer; E: TElemento);
   procedure LeerBuf (B: in out TBuffer; E: out TElemento);
private
   task type TBuffer is
      entry Escribir (E: TElemento);
      entry Leer (E: out TElemento);
   end TBuffer;
end Buffer_servidor;
package body Buffer_servidor is
   task body TBuffer is
      subtype TCardinalBuffer is Natural range 0 .. Tamaño;
      subtype TRangoBuffer is TCardinalBuffer range 0 .. Tamaño - 1;
      Buf: array (TRangoBuffer) of TElemento;
      Cima, Base: TRangoBuffer := 0;
      NumElementos: TCardinalBuffer := 0;
   begin
      loop
         select
            when NumElementos < Tamaño =>
               accept Escribir (E: TElemento) do
                  Buf(Cima) := E;
               end Escribir;
               Cima := TRangoBuffer(Integer(Cima + 1) mod Tamaño);
               NumElementos := NumElementos + 1;
         or
            when NumElementos > 0 =>
               accept Leer (E: out TElemento) do
                  E := Buf(Base);
               end Leer;
               Base := TRangoBuffer(Integer(Base + 1) mod Tamaño);
               NumElementos := NumElementos - 1;
         or
            terminate;
         end select;
      end loop;
   end TBuffer;

   procedure EscribirBuf (B: in out TBuffer; E: TElemento) is
   begin
      B.Escribir (E);
   end EscribirBuf;

   procedure LeerBuf (B: in out TBuffer; E: out TElemento) is
   begin
      B.Leer (E);
   end LeerBuf;
end Buffer_servidor;
with Text_IO, Buffer_servidor;
use Text_IO;
procedure Buffer is
  Clave_Salida : constant String := "Salir";
  type TMensaje is
    record
      NumOrden: Positive;
      Contenido: String (1..20);
    end record;
  package Cola_mensajes is new Buffer_servidor (TElemento => TMensaje);
  use Cola_mensajes;
  Cola: TBuffer;
  task Emisor;
  task Receptor;
  task body Emisor is
    M: TMensaje := (NumOrden => 1, Contenido => (others => ' '));
    Último: Natural;
  begin
    loop
      Put ("[Emisor] Mensaje: ");
      Get_Line (M.Contenido, Último);
      M.Contenido (Último + 1 .. M.Contenido'Last) := (others => ' ');
      EscribirBuf (Cola, M);
      M.NumOrden := M.NumOrden + 1;
      exit when M.Contenido(Clave_Salida'range) = Clave_Salida;
    end loop;
  end Emisor;
  task body Receptor is
    package Ent_IO is new Text_IO.Integer_IO(Integer);
    use Ent_IO;
    M: TMensaje;
  begin
    loop
      LeerBuf (Cola, M);
      exit when M.Contenido(Clave_Salida'range) = Clave_Salida;
      Put ("[Receptor] Mensaje número ");
      Put (M.NumOrden);
      Put (": ");
      Put (M.Contenido);
      New_Line;
    end loop;
  end Receptor;

begin
  null;
end Buffer;

Problema del barbero durmiente

editar

Esta es una solución al problema del barbero durmiente.

with Ada.Text_IO; use Ada.Text_IO;

with Ada.Numerics.Discrete_Random;

procedure Barberia is

   type Rango_Demora is range 1 .. 30;
   type Duracion_Afeitado is range 5 .. 10;
   type Nombre_Cliente is (Jose, Juan, Iñaki, Antonio, Camilo);

   package Demora_Al_Azar is new Ada.Numerics.Discrete_Random
     (Rango_Demora);
   package Afeitado_Al_Azar is new Ada.Numerics.Discrete_Random
     (Duracion_Afeitado);

   task Barbero is
      entry Afeitar (Cliente : in Nombre_Cliente);
   end Barbero;

   task type Cliente is
      entry Comenzar (Nombre : in Nombre_Cliente);
   end Cliente;

   Lista_Clientes : array (Nombre_Cliente) of Cliente;

   task body Barbero is
      Generador : Afeitado_Al_Azar.Generator;
      Espera_Máxima_Por_Cliente : constant Duration := 30.0;
   begin
      Afeitado_Al_Azar.Reset (Generador);
      Put_Line ("Barbero: Abro la barbería.");
      loop
         Put_Line ("Barbero: Miro si hay cliente.");
         select
            accept Afeitar (Cliente : in Nombre_Cliente) do
               Put_Line ("Barbero: Afeitando a " & Nombre_Cliente'Image
                         (Cliente));
               delay Duration (Afeitado_Al_Azar.Random (Generador));
               Put_Line ("Barbero: Termino con " & Nombre_Cliente'Image
                         (Cliente));
            end Afeitar;
         or
            delay Espera_Máxima_Por_Cliente;
            Put_Line ("Barbero: Parece que ya no viene nadie,"
                      & " cierro la barbería.");
            exit;
         end select;
      end loop;
   end Barbero;

   task body Cliente is
      Generador : Demora_Al_Azar.Generator;
      Mi_Nombre : Nombre_Cliente;
   begin
      accept Comenzar (Nombre : in Nombre_Cliente) do
         Mi_Nombre := Nombre;
      end Comenzar;

      Demora_Al_Azar.Reset (Gen       => Generador,
                            Initiator => Nombre_Cliente'Pos (Mi_Nombre));

      delay Duration (Demora_Al_Azar.Random (Generador));

      Put_Line (Nombre_Cliente'Image (Mi_Nombre) &
                ": Entro en la barbería.");
      Barbero.Afeitar (Cliente => Mi_Nombre);
      Put_Line (Nombre_Cliente'Image (Mi_Nombre) &
                ": Estoy afeitado, me marcho.");
   end Cliente;

begin
   for I in Lista_Clientes'Range loop
      Lista_Clientes (I).Comenzar (Nombre => I);
   end loop;
end Barberia;

Problema de los filósofos cenando

editar
 
Ilustración del problema de los filósofos cenando

Una solución con tareas y objetos protegidos del conocido problema de los filósofos cenando.

    package Cubiertos is

       type Cubierto is limited private;
       
       procedure Coger(C: in out Cubierto);
       procedure Soltar(C: in out Cubierto);

    private
       
       type Status is (LIBRE, OCUPADO);
       
       protected type Cubierto(Estado_Cubierto: Status := LIBRE) is
          entry Coger;
          entry Soltar;
       private
          Estado: Status := Estado_Cubierto;
       end Cubierto;
       
    end Cubiertos;
    package body Cubiertos is

       procedure Coger (C: in out Cubierto) is
       begin
          C.Coger;
       end Coger;

       procedure Soltar (C: in out Cubierto) is
       begin
          C.Soltar;
       end Soltar;

       protected body Cubierto is

          entry Coger when Estado = LIBRE is
          begin
             Estado := OCUPADO;
          end Coger;


          entry Soltar when Estado = OCUPADO is
          begin
             Estado := LIBRE;
          end Soltar;

       end Cubierto;

    end Cubiertos;
    with Ada.Text_IO; use Ada.Text_IO;
    with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
    with Cubiertos; use Cubiertos;

    procedure Problema_Filosofos is
       
       type PCubierto is access Cubierto;
       
       task type TFilosofo(Id: Character; Cubierto1: PCubierto; Cubierto2: PCubierto);
       
       task body TFilosofo is
         
          procedure Comer is
          begin
             Coger(Cubierto1.all);
             Coger(Cubierto2.all);
             for i in 1..10 loop
                Put(Id & "c ");
                delay 1.0;
             end loop;
             Soltar(Cubierto2.all);
             Soltar(Cubierto1.all);
          end Comer;
         
          Procedure Pensar is
          begin
             for i in 1..10 loop
                Put(Id & "p ");
                delay 1.0;
             end loop;
          end Pensar;
         
       begin
          loop
             Comer;
             Pensar;
          end loop;
       end TFilosofo;
         
       Num_Cubiertos: Positive;
       
    begin

       Put("Introduce el numero de cubiertos: "); Get(Num_Cubiertos); New_line;
       
       declare
          type PTFilosofo is access TFilosofo;
          P: PTFilosofo;
          C: Character := 'A';
          Cuberteria: array (1..Num_Cubiertos) of PCubierto;
       begin
          for i in 1..Num_Cubiertos loop
             Cuberteria(i) := new Cubierto;
          end loop;
         
          for i in 1..Num_Cubiertos-1 loop
            P := new TFilosofo(C, Cuberteria(i), Cuberteria(i+1));
            C := Character'Succ(C);
          end loop;
          P := new TFilosofo(C, Cuberteria(1), Cuberteria(Num_Cubiertos));
       end;
    end Problema_Filosofos;

Para evitar el bloqueo mutuo es totalmente imprescindible que al último filósofo se le asignen los cubiertos en ese orden. Sí se hiciese al contrario, el bloqueo no tardaría en aparecer (sobre todo si se eliminan las instrucciones delay):

          P := new TFilosofo(C, Cuberteria(Num_Cubiertos), Cuberteria(1));

Chinos: una implementación concurrente en Ada

editar
-- Chinos2: Otra implementación concurrente en Ada
-- Tomás Javier Robles Prado
-- tjavier@usuarios.retecal.es


-- Uso: ./chinos <numero_jugadores>

-- El juego consiste en jugar sucesivas partidas a los chinos. Si un
--  jugador acierta, no paga y queda excluido de las siguientes
--  rondas. El último que quede paga los vinos


--   Copyright (C) 2003 T. Javier Robles Prado
--
--   This program is free software; you can redistribute it and/or modify
--   it under the terms of the GNU General Public License as published by
--   the Free Software Foundation; either version 2 of the License, or
--   (at your option) any later version.
--
--   This program is distributed in the hope that it will be useful,
--   but WITHOUT ANY WARRANTY; without even the implied warranty of
--   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
--   GNU General Public License for more details.
--
--   You should have received a copy of the GNU General Public License
--   along with this program; if not, write to the Free Software
--   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA


with Ada.Text_IO; use Ada.Text_IO;

with Ada.Numerics.Discrete_Random;
with Ada.Command_Line;
with Ada.Strings.Unbounded;
with Ada.Exceptions;

procedure Chinos is

   -- Número Máximo Jugadores que pueden participar (aforo máximo del bar)
   MAX   : constant Natural := 20;

   -- Posibles mensajes que recibe un jugador tras una partida
   type Estados is (NO_SIGUES_JUGANDO, SIGUES_JUGANDO, HAS_PERDIDO);

   -- Subtipo que modela el número de jugadores posibles

   subtype NumMaxJugadores is Natural range 0..MAX;

   -- Modela la máxima apuesta que puede darse
   subtype MAX_APUESTA is Natural range 0..3*MAX;

   -- Nombres posibles para los jugadores. El 0 se utilizará para

   --  controlar el caso de que no haya ganador en una partida
   subtype TNombre is Integer range -1..MAX;

   -- Paquete para Numeros aleatorios:
   package Integer_Random is new Ada.Numerics.Discrete_Random(MAX_APUESTA);

   -- Apuesta de cada Jugador

   Subtype TApuesta is  Integer range -1..3*MAX;

   -- Mano de cada jugador
   subtype TMano is Natural range 0..3;


   -- Ficha de cada jugador que guardara el arbitro

   type TFicha is record
      Nombre       : TNombre;
      Apuesta      : TApuesta := -1;
      Mano         : TMano;
      SigueJugando : Boolean;
   end record;

   -- Array de Fichas
   type TTablon is array(1..MAX) of TFicha;


   -- Se define el tipo jugador

   task type Jugador;

   task  Arbitro is
      -- El árbitro controla las partidas y sincroniza a los jugadores

      entry FijaNumeroJugadores (Num : in NumMaxJugadores);
      -- Recoge el argumento de la línea de comandos para saber

      --  cuántos jugadores van a participar

      entry AsignaNombre (Nombre: out TNombre; NumJug: out NumMaxJugadores);
      -- Asigna Nombres (de 1 a NumerosJugadores) a los jugadores que

      --  van a participar. A los que no, les asigna un -1 como
      --  indicación de que finalicen.

      entry SiguesJugando
        (Nombre: in TNombre;
         JugadorSigueJugando : out Estados;
         HuboGanador : out boolean);
      -- Mensaje que envía el árbitro a cada jugador tras una

      --  partida, comunicándole si ha ganado y deja de jugar, si
      --  sigue jugando o si ha perdido y tiene que pagar

      entry EnviaApuesta (Nombre: in TNombre ; Apuesta: in TApuesta);
      -- El árbitro recibe la apuesta de un jugador


      entry ConfirmaApuesta (Confirmada : out Boolean);
      -- Respuesta del árbitro sobre si la apuesta es válida (no la
      --  ha hecho otro antes)


      entry ReEnviaApuesta (Apuesta: in TApuesta);
      -- Si la apuesta no es válida se reenvia hasta que lo sea

      entry EnviaMano (Nombre: in TNombre ; Mano: in TMano);
      -- El jugador envía el número de manos que saca al árbitro


   end Arbitro;




   task body Arbitro is

      -- Funciones y Procedimientos

      function NumeroJugadores return NumMaxJugadores is

         -- Devuelve el número de jugadores
      begin
         return 5;
      end NumeroJugadores;

      function EsApuestaValida (Apuesta: in TApuesta; Tablon: in TTablon)
                               return Boolean is

         -- Devuelve verdadero si la apuesta no ha sido realizada
         --  antes por algún otro jugador

         Valida : Boolean := True ;
         I      : TNombre := 1;
      begin

         for I in 1..MAX loop

            if Tablon(I).SigueJugando then
               if Tablon(I).Apuesta = Apuesta  then
                  -- Ya está dicha, la apuesta NO es válida

                  Valida := False ;
               end if;
            end if;
         end loop;

         return Valida;
      end EsApuestaValida;

      function ResultadoGanador (Tablon: in TTablon) return TApuesta is

         -- Devuelve el número de monedas que sacaron los jugadores
         Suma : TApuesta := 0 ;
      begin
         for I in 1..MAX loop

            if Tablon(I).SigueJugando then
               Suma := Suma + Tablon(I).Mano ;
            end if;
         end loop;
         return Suma;
      end ResultadoGanador;

      procedure ImprimeGanador (Tablon: in TTablon) is

         -- Imprimer el nombre del ganador
         I         : TNombre := 1 ;
         Resultado : TApuesta ;
         Terminar  : Boolean := False;
      begin
         Resultado := ResultadoGanador(Tablon);
         while not Terminar loop

            if Tablon(I).Apuesta = Resultado and Tablon(I).SigueJugando then

               Put_Line("Ha Ganado el Jugador " & I'Img);
               Terminar := True ;
            else
               if I = MAX then
                  Put_Line("No ha habido Ganador");
                  Terminar := True;
               else

                  I :=  I + 1;
               end if;
            end if;

         end loop;
      end ImprimeGanador;



      function JugadorEliminado (Tablon: in TTablon) return NumMaxJugadores is

         -- Devuelve el jugador que cuya apuesta sea la correcta

         Resultado : TApuesta;


         Ganador   : NumMaxJugadores := 0;
      begin
         Resultado := ResultadoGanador(Tablon);

         for I in 1..MAX loop

            if Tablon(I).SigueJugando then

               if Resultado =  Tablon(I).Apuesta then
                  Ganador := I ;
               end if;
            end if;
         end loop;

         return Ganador;
      end JugadorEliminado;



      procedure ImprimeTablon(Tablon: in TTablon) is

         -- Imprime las apuestas y monedas de los jugadores
      begin

         for I in 1..MAX loop
            if Tablon(I).SigueJugando then

               Put_Line("Nombre =" & Tablon(I).Nombre'Img &
                                " | Apuesta =" & Tablon(I).Apuesta'Img &
                                " | Mano =" &Tablon(I).Mano'Img );
            end if;
         end loop;
         Put_Line
           ("Resultado ganador: " & ResultadoGanador(Tablon)'Img);

      end ImprimeTablon;


      procedure SeparaPartidas (NumPar :in Natural)  is

         -- Un simple separador para aumentar la claridad
      begin
         New_Line;
         Put_Line("******************************************");
         Put_Line("Partida número " & NumPar'Img);
         Put_Line("******************************************");
      end SeparaPartidas;



      -- Variables


      -- Número de jugadores de la partida
      N : NumMaxJugadores;
      Permitidos : NumMaxJugadores;

      -- Partida Actual
      PartidaActual : NumMaxJugadores;

      -- Tablón
      Tablon : TTablon;

      NombreActual : NumMaxJugadores;
      ApuestaValida : Boolean;
      Ganador : NumMaxJugadores;

      NumeroPartida :  Natural;

   begin

      -- Averigua número de jugadores

      accept FijaNumeroJugadores (Num : in NumMaxJugadores) do
         N := Num;
      end FijaNumeroJugadores;

      -- Nombra solo a aquellos que vayan a jugar, a los que no, los

      --  nombra como -1
      Permitidos := N;


      for I in 1..MAX loop
         accept AsignaNombre

           (Nombre: out TNombre ; NumJug: out NumMaxJugadores) do
            if Permitidos > 0 then

               Nombre := I;
               NumJug := N;
               Tablon(I).Nombre  := I ;
               Tablon(I).SigueJugando  := True;
               Permitidos := Permitidos - 1;
            else
               Nombre := -1;
               Tablon(I).Nombre := -1;
               Tablon(I).SigueJugando := False;


            end if;
         end AsignaNombre;
      end loop;

      NumeroPartida := 1;

      while N /= 1 loop

         -- Para separar las diferentes partidas
         SeparaPartidas(NumeroPartida);


         -- Recibe las apuestas de cada jugador
         for I in 1..N loop
            accept EnviaApuesta (Nombre: in TNombre; Apuesta: in TApuesta) do

               NombreActual := Nombre;
               ApuestaValida := EsApuestaValida(Apuesta,Tablon);
               if ApuestaValida then
                  Tablon(Nombre).Apuesta := Apuesta ;
               end if;
            end EnviaApuesta;

            -- La Apuesta es Válida, se confirma y a otra cosa

            if ApuestaValida then
               accept ConfirmaApuesta(Confirmada: out Boolean) do

                  Confirmada := True;
               end ConfirmaApuesta;

            else
               -- La apuesta no es válida. Se comunica esto al jugador para
               -- que envíe una nueva apuesta
               accept ConfirmaApuesta(Confirmada: out Boolean) do

                  Confirmada := False;
               end ConfirmaApuesta;
               while not ApuestaValida loop
                  -- Aceptará diferentes apuestas hasta q sea válida.

                  accept ReEnviaApuesta (Apuesta: in TApuesta) do
                     if EsApuestaValida(Apuesta,Tablon) then

                        ApuestaValida := True;
                        Tablon(NombreActual).Apuesta := Apuesta ;
                     end if;
                  end ReEnviaApuesta;
                  accept ConfirmaApuesta(Confirmada: out Boolean) do

                     Confirmada := ApuestaValida;
                  end ConfirmaApuesta;
               end loop;

            end if;
         end loop;

         -- Recibe lo q saca cada jugador

         for I in 1..N loop
            accept EnviaMano(Nombre: in TNombre; Mano: in TMano) do

               Tablon(Nombre).Mano := Mano ;
            end EnviaMano;
         end loop;

         -- ImprimeResultados de la partida
         ImprimeTablon(Tablon);
         ImprimeGanador(Tablon);


         -- Envía a cada jugador su nuevo estado
         Ganador  := JugadorEliminado (Tablon);
         if Ganador = 0 then

            -- Nadie acertó
            for I in 1..N loop
               accept SiguesJugando

                 (Nombre: in TNombre;
                  JugadorSigueJugando : out Estados;
                  HuboGanador : out boolean) do

                  JugadorSigueJugando := SIGUES_JUGANDO;
                  Tablon(Nombre).SigueJugando := True;
                  HuboGanador := false ;
               end SiguesJugando;
            end loop;

         else
            -- Hay ganador
            for I in 1..N loop

               accept SiguesJugando
                 (Nombre: in TNombre;
                  JugadorSigueJugando : out Estados;
                  HuboGanador : out boolean) do

                  HuboGanador := true;
                  if Nombre = Ganador then
                     JugadorSigueJugando := NO_SIGUES_JUGANDO;
                     Tablon(Nombre).SigueJugando := False;
                  else
                     if N /= 2 then

                        JugadorSigueJugando := SIGUES_JUGANDO;
                        Tablon(Nombre).SigueJugando := True;
                     else
                        JugadorSigueJugando := HAS_PERDIDO;
                        Tablon(Nombre).SigueJugando := False;
                     end if;
                  end if;
               end SiguesJugando;
            end loop;
         end if;


         NumeroPartida := NumeroPartida + 1;
         if Ganador /= 0 then

            N := N - 1;
         end if;


      end loop;

   end Arbitro;


   task body Jugador is

      MiNombre : TNombre;
      NumJug   : NumMaxJugadores;
      Apuesta : TApuesta;
      ApuestaValidada : Boolean;
      Mano    : Tmano;
      G : Integer_Random.Generator;
      YoSigo : Estados;
      Terminar : Boolean := False;
      HuboGanador : boolean;

   begin
      Arbitro.AsignaNombre(MiNombre, NumJug);


      -- Si MiNombre es -1, entonces termina su ejecución. Se sigue
      --  este método para ceñirnos a los jugadores que quiere el
      --  usuario
      if MiNombre /= -1 then

         -- Semillas aleatorias
         Integer_Random.Reset(G);

         while not Terminar loop

            -- Envia Apuesta
            for I in 1..MiNombre loop

               Apuesta := Integer_Random.Random(G) mod (NumJug * 3);
            end loop;
            Arbitro.EnviaApuesta(MiNombre, Apuesta);

            -- Proceso de confirmación de apuesta
            ApuestaValidada := False ;
            while not ApuestaValidada loop

               Arbitro.ConfirmaApuesta(ApuestaValidada);
               if not ApuestaValidada then
                  -- Genera Nueva apuesta
                  for I in 1..MiNombre loop

                     Apuesta := Integer_Random.Random(G) mod (NumJug * 3) ;
                  end loop;
                  Arbitro.ReEnviaApuesta(Apuesta);
               end if;

            end loop;



            -- Envía Mano

            for I in 1..MiNombre loop
               Mano := Integer_Random.Random(G) mod 4;
            end loop;
            Arbitro.EnviaMano(MiNombre, Mano);

            -- Comprueba su estado, si sigue jugando, si ha perdido o

            --  si ha ganado y deja de jugar
            Arbitro.SiguesJugando(MiNombre, YoSigo, HuboGanador);
            if YoSigo = SIGUES_JUGANDO then
               Terminar := False;
            else
               if YoSigo = NO_SIGUES_JUGANDO then

                  Terminar := True;
               else
                  -- Ha perdido
                  Put_Line("Jugador " & MiNombre'Img &
                                   ": He perdido, tengo que pagar :_(");
               end if;

            end if;
            if HuboGanador then

               NumJug := NumJug - 1;
            end if;
         end loop;


      end if;

   end Jugador;


   Jugadores : array (1..MAX) of Jugador;
   NumJug : Natural;


begin
   if Ada.Command_Line.Argument_Count /= 1 then
      -- Número incorrecto de parámetros
      Put_Line("Uso: ./chinos <num_jugadores>");
      NumJug := 1;

   else

      NumJug := Integer'Value(Ada.Command_Line.Argument(1));

      if NumJug < 2 then
         -- Número mínimo de jugadores
         Put_Line("El número de jugadores ha de ser mayor que 1." &

                          NumJug'Img & " no es mayor que 1");
         Put_Line("Seleccione un valor mayor o igual que 2");
         NumJug := 1;
      end if;

      if NumJug > MAX then

         -- Número máximo de jugadores
         Put_Line(NumJug'Img & " es mayor que " & MAX'Img);
         Put_Line("Seleccione un valor menor o igual que " &
                              MAX'Img);
         NumJug := 1;
      end if;


   end if;


   Arbitro.FijaNumeroJugadores(NumJug);

   -- Por si nos intentan colar algún valor no válido

exception
   when Constraint_Error =>
      NumJug := 1;
      Arbitro.FijaNumeroJugadores(NumJug);
      Put_Line("El Valor Introducido no es correcto.");
      Put_Line("Uso: ./chinos <num_jugadores>");

end Chinos;

Manual de referencia de Ada

editar