With Ada.Text_IO; SELECT `desciption` FROM `db_blogs` WHERE `author` = 'SkG';

Ejercicio del Dominó

Bueno, como veo que tanta gente hizo el ejercicio creo que no es necesario ponerlo por aquí (*re-lee la ultima linea*). Oh wait... me he liado con las palabras... permitirme rectificar... como veo que tan poca gente hizo el ejercicio creo que es necesario ponerlo por aquí.

Bueno el enunciado de ejercicio era algo así como: "Tenemos una partida de dominó en la que hay una ficha en la mesa y cuatro jugadores con X fichas en la mano. Recorrer todos los jugadores hasta encontrar una ficha que se pueda poner y mostrar cual es. Hacer la búsqueda y obtención con procedures"

Pues bueno como siempre aquí va el código fuente comentadito (lo mejor que puedo explicarme, a si que si no os gusta os jodeis xD)

----------------------------------------------------------------
-- Nombre: Domino
-- Fecha: 19/04/2009
-- Descripcion: Esta en el post
----------------------------------------------------------------
-- Autor: [SkG] - http://skg.eien-no-ai.net/
----------------------------------------------------------------
with Ada.Text_IO, Ada.Integer_Text_IO;
use Ada.Text_IO, Ada.Integer_Text_IO;

procedure domino is
   -- Aqui especificamos dos constantes para indicar
   -- cuantas fichas tiene cada jugador y el numero
   -- de jugadores
   FichasJugador: constant Integer := 2;
   NumeroJugadores: constant Integer := 4;
   ------------------------------
   -- Tipos y paquetes
   ------------------------------
   -- Hace falta explicar esta parte?...
   subtype ValFichas is Integer range 0..6;

   type TFicha is record
      N,M: ValFichas;
   end record;

   -- El array de las fichas de cada jugador
   type TFichas is array (Integer range 1..FichasJugador) of TFicha;

   -- Aqui especificamos el jugador que tiene sus
   -- fichas, que se podria hacer sin el record.
   -- Lo hacemos asi por que ibamos a añadir
   -- puntuacion y dinero...
   type TJugador is record
      Fichas: TFichas;
   end record;

   -- Aqui definimos un array que es la partida
   -- con el numero de jugadores
   type TPartida is array (Integer range 1..NumeroJugadores) of TJugador;

   ------------------------------
   -- Funciones y procedimientos
   ------------------------------

   -- Para mostrar una ficha, sencillo, no?
   procedure ImprimirFicha(F: in TFicha) is
   begin
      Put("("); Put(F.N,0); Put(","); Put(F.M,0); Put(")");
   end ImprimirFicha;

   -- Imprimimos todas las fichas de un jugador
   procedure ImprimirFichas(J: in TJugador) is
   begin
      Put("(");
      for I in J.Fichas'Range loop
         ImprimirFicha(J.Fichas(I));
         if I /= J.Fichas'Last then
            Put(",");
         end if;
      end loop;
      Put(")");
   end ImprimirFichas;

   -- Imprimimos todos los jugadores con sus
   -- fichas y la que hay en juego
   procedure ImprimirPartida(P: in TPartida; M: in TFicha) is
   begin
      for I in P'Range loop
        Put("Jugador "); Put(I,0); Put(": "); ImprimirFichas(P(I)); New_Line;
      end loop;
      Put("Ficha en la mesa: "); ImprimirFicha(); New_Line;
   end ImprimirPartida;

   -- Bueno todo lo anterior fueron caprichos
   -- mios para que quedase bonito y todo esta
   -- practica xD

   -- Esta funcion nos devuelve TRUE o FALSE
   -- segun si una ficha puede ponerse junto
   -- a la otra o no
   function FichaCoincide(F1,F2:TFicha) return Boolean is
   begin
      return (F1.N = F2.N) or else (F1.N = F2.M) or else (F1.M = F2.N)
 or else (F1.M = F2.M);
   end FichaCoincide;

   -- Esta funcion mediante un while se encarga
   -- de buscar SI SE PUEDE poner alguna ficha
   -- del array de fichas que le enviamos.
   --
   -- Devuelve TRUE o FALSE segun proceda.
   function BuscarFichaValida(FichaMesa: in TFicha; Fichas: in TFichas)
 return boolean is
      I: Integer := TFichas'First;
      Encon: Boolean := False;
   begin
      while not Encon and then I < = TFichas'Last loop
         Encon := FichaCoincide(Fichas(I),FichaMesa);
         I := I + 1;
      end loop;
      return Encon;
   end BuscarFichaValida;

   -- Esta funcion mediante un while se encarga
   -- de buscar UNA FICHA que se puede poner del
   -- array de fichas que le enviamos. Esta pensada
   -- para llamarla despues de que con la funcion
   -- anterior obtengamos TRUE.
   --
   -- Devuelve LA FICHA.
   function ObtenerFichaValida(FichaMesa: in TFicha; Fichas: in TFichas)
 return TFicha is
      I: Integer := TFichas'First;
      Encon: Boolean := False;
      Ficha: TFicha;
   begin
      while not Encon and then I <= TFichas'Last loop
         Ficha := Fichas(I);
         Encon := FichaCoincide(Ficha,FichaMesa);
         I := I + 1;
      end loop;
      return Ficha;
   end ObtenerFichaValida;

   -- Este procedimiento mediente un while se
   -- encarga de ir mandando a la primera funcion
   -- los arrays de fichas de cada jugador hasta
   -- obtener un TRUE y mostrar dicha ficha con
   -- la segunda funcion, si en un jugador no se
   -- encuentra una ficha valida se suma a I uno
   -- para seguir con el siguiente jugador.
   --
   -- IMPRIME en pantalla la ficha que se puede
   -- poner y a que jugador pertenece.
   procedure BuscarFicha(FichaMesa: in TFicha; P: in TPartida) is
      I: Integer := TPartida'First;
      Encon: Boolean := False;
      Ficha: TFicha;
   begin
      while not Encon and then I <= TPartida'Last loop
         Encon := BuscarFichaValida(FichaMesa, P(I).Fichas);
         if Encon then
            Ficha := ObtenerFichaValida(FichaMesa, P(I).Fichas);
         else
            I := I + 1;
         end if;
      end loop;
      if Encon then
         Put("La ficha "); ImprimirFicha(Ficha); Put(" del jugador ");
         Put(I,0); Put(" se puede poner");
      else
         Put("No se ha encontrado ninguna ficha que coincida");
      end if;
   end BuscarFicha;

   -- Procedimiento sencillo para Obtener
   -- una unica Ficha
   procedure ObtenerFicha(Ficha: out TFicha) is
   begin
      Put("Introduce una ficha: "); New_Line;
      Put("Primer Valor: "); Get(Ficha.N);
      Put("Segundo Valor: "); Get(Ficha.M);
   end ObtenerFicha;

   -- Procedimiento con un For para ir
   -- obteniendo las fichas de un jugador
   procedure ObtenerJugador(J: out TJugador;I: in Integer) is
   begin
      for I in J.Fichas'Range loop
         ObtenerFicha(J.Fichas(I));
         New_Line;
      end loop;
   end ObtenerJugador;

  -- Procedimiento con un for para obtener
  -- las fichas de todos los jugadores
   procedure ObtenerFichas(P: out TPartida) is
   begin
      for I in P'Range loop
         Put("Jugador "); Put(I,0); New_Line;
         ObtenerJugador(P(I),I);
      end loop;
   end ObtenerFichas;

   -- Para obtener las fichas quedaria asi:
   --    ObtenerFichas llama a ObtenerJugador tantas veces
   --    como jugadores tengamos para obtener sus fichas.
   --    ObtenerJugador llama a ObtenerFicha tantas veces
   --    como fichas tenga el jugador.
   --    ObtenerFicha que obtiene una unica ficha.

   ------------------------------
   -- Variables
   ------------------------------
   -- Un par de variables para la partida
   -- y la ficha en juego
   Partida: TPartida;
   Mesa: TFicha;
begin
   -- Obtenemos la ficha que hay en la mesa
   Put("Introduce la ficha de la mesa: "); New_Line;
   ObtenerFicha(Mesa); New_Line;
   -- Obtenemos las fichas de todos los jugadores
   ObtenerFichas(Partida); New_Line;
   -- Imprimimos la partida (capricho mio)
   ImprimirPartida(Partida,Mesa); New_Line;
   -- Buscamos la primera ficha que se pueda poner
   BuscarFicha(Mesa,Partida);
end domino;