Programación en Ada/Tareas/Ejemplos
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]
Solución:
Solución propuesta:
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Numerics.Float_Random;
with Semaforos;
procedure Simulador_Trenes is
Num_Estaciones : constant := 5;
Num_Trenes : constant := 3;
type Num_Estación is range 1 .. Num_Estaciones;
type Num_Tren is range 1 .. Num_Trenes;
package Num_Estación_IO is new Ada.Text_IO.Integer_IO (Num_Estación);
use Num_Estación_IO;
package Num_Tren_IO is new Ada.Text_IO.Integer_IO (Num_Tren);
use Num_Tren_IO;
package Semaforos_Inicial_1 is new
Semaforos (Valorinicial => 1);
use Semaforos_Inicial_1;
Semaforos_Estaciones : array (Num_Estación) of TSemaforo;
task type Tren is
entry Comenzar (Tu_Num : in Num_Tren);
end Tren;
Lista_Trenes : array (Num_Tren) of Tren;
task body Tren is
Mi_Num: Num_Tren;
procedure Pon_Nombre is
begin
Put ("Tren nº"); Put (Mi_Num); Put (": ");
end Pon_Nombre;
Espera_En_Estación: constant Duration := 5.0;
Duración_Mínima: constant Duration := 2.0;
Factor_Duración: constant Duration := 10.0;
Azar_Gen: Ada.Numerics.Float_Random.Generator;
Actual, Siguiente: Num_Estación;
begin
Ada.Numerics.Float_Random.Reset (Azar_Gen);
accept Comenzar (Tu_Num : in Num_Tren) do
Mi_Num := Tu_Num;
end Comenzar;
Pon_Nombre;
Put_Line ("Comienzo el trayecto");
Actual := 1;
loop
Pon_Nombre; Put ("En estación "); Put (Actual); New_Line;
delay Espera_En_Estación;
if Actual = Num_Estaciones then
Siguiente := 1;
else
Siguiente := Actual + 1;
end if;
Wait (Semaforos_Estaciones (Siguiente));
Pon_Nombre;
Put ("Trayecto hacia estación ");
Put (Siguiente);
New_Line;
Signal (Semaforos_Estaciones (Actual));
delay Duration (Ada.Numerics.Float_Random.Random (Azar_Gen))
* Factor_Duración + Duración_Mínima;
Actual := Siguiente;
end loop;
end Tren;
begin
for I in Lista_Trenes'Range loop
Lista_Trenes (I).Comenzar (Tu_Num => I);
end loop;
end Simulador_Trenes;
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]
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;