http://www.adaconcept.com/programs/gyerekcsomagos/szamrendszerek-vegyes_alapu_szamrendszer.adb
-- with Ada.Text_IO;                                                                                                                                           -- teszteleshez
with Szamrendszerek.Szamabrazolas;

package body Szamrendszerek.Vegyes_Alapu_Szamrendszer is


   function Letrehoz(Alapok : Alap_Tomb_Tipus) return Vegyes_Alapu_Szam_Tipus is
      Vissza : Vegyes_Alapu_Szam_Tipus;
   begin

      -- Ada.Text_IO.Put_Line("Letrehoz indul");                                                                                                               -- szandekosan a kodban hagyott kommnet
      Vissza.Abrazolas.Szamrendszerek := new Implementacios_Reszletek.Szamrendszerek_Tomb_Tipus'(Implementacios_Reszletek.Szamrendszerek_Tomb_Tipus(Alapok));  --| a ket letrehozott tomb index tartomanya azonos kell legyen!
      Vissza.Abrazolas.Szamjegyek := new Implementacios_Reszletek.Szamjegyek_Tomb_Tipus'(Alapok'Range => 0);                                                   --|
      -- Ada.Text_IO.Put_Line("Letrehoz vege");                                                                                                                -- szandekosan a kodban hagyott komment

      return Vissza;

      -- limited Vegyes_Alapu_Szam_Tipus eseten Ada 2005 -tol : kiterjesztett return utasitas

--        return Vissza : Vegyes_Alapu_Szam_Tipus do
--            Vissza.Abrazolas.Szamrendszerek := new Implementacios_Reszletek.Szamrendszerek_Tomb_Tipus'(Implementacios_Reszletek.Szamrendszerek_Tomb_Tipus(Alapok));
--            Vissza.Abrazolas.Szamjegyek := new Implementacios_Reszletek.Szamjegyek_Tomb_Tipus'(Alapok'Range => 0);
--        end return;
   end Letrehoz;


   procedure Letrehoz(Szam : in out Vegyes_Alapu_Szam_Tipus; Alapok : Alap_Tomb_Tipus) is
   begin
      Szam := Letrehoz(Alapok);
   end Letrehoz;


   procedure Beallit(Szam : in out Vegyes_Alapu_Szam_Tipus; Ertek : Szamjegyek_Tomb_Tipus) is                                                                  -- FONTOS! Warning -ot kaphatunk a Szam -ra (a kesobbiekben visszaterunk erre)
      use type Implementacios_Reszletek.Szamjegyek_Tomb_Mutato_Tipus;

      function Ertekul_Adhato(Szam : in Vegyes_Alapu_Szam_Tipus; Ertek : Szamjegyek_Tomb_Tipus) return Boolean is
         Vissza : Boolean := True;
      begin

         for i in Szam.Abrazolas.Szamjegyek'Range loop
            if Ertek(i) not in 0 .. Szam.Abrazolas.Szamrendszerek(i) - 1 then
               Vissza := False;
            end if;
         end loop;


         return Vissza;
      end Ertekul_Adhato;

   begin
      if Szam.Abrazolas.Szamjegyek /= null and then (Szam.Abrazolas.Szamjegyek.all'First = Ertek'First and Szam.Abrazolas.Szamjegyek.all'Last = Ertek'Last) then
         if Ertekul_Adhato(Szam, Ertek) then
            Szam.Abrazolas.Szamjegyek.all := Implementacios_Reszletek.Szamjegyek_Tomb_Tipus(Ertek);
         else
            raise Ertekadas_Hiba;
         end if;
      else
         raise Ertekadas_Hiba;
      end if;
   end Beallit;


   procedure Egyet_Hozzaad(Szam : in out Vegyes_Alapu_Szam_Tipus; Hanyadik_Indexu_Helyierteken : in out Natural) is
         h : Natural;                                                                                                  -- az aktualis helyierteket mutatja
         Jegyek : Implementacios_Reszletek.Szamjegyek_Tomb_Tipus renames Szam.Abrazolas.Szamjegyek.all;                -- az aktualis szamjegy
         Alapok : Implementacios_Reszletek.Szamrendszerek_Tomb_Tipus renames Szam.Abrazolas.Szamrendszerek.all;
         Van_Atvitel : Boolean;
      begin

         -- Csak abban az esetben tortenjen meg a noveles, ha a Szam valtozo nem csordult tul
         if not Szam.Abrazolas.Tulcsordult then

            -- egy hasznos technika egy adott indexre allashoz...
            h := Jegyek'First;
            for i in 1 .. Hanyadik_Indexu_Helyierteken loop
               if Natural'Succ(h) in Jegyek'Range then
                  h := Natural'Succ(h);  -- altalanos megoldas...
               end if;
            end loop;


            Van_Atvitel := False;
            loop

               if Jegyek(h) < Alapok(h) - 1 then
                  Van_Atvitel := False;
                  Jegyek(h) := Jegyek(h) + 1;
               else
                  Van_Atvitel := True;
                  Jegyek(h) := 0;
                  h := h + 1;
               end if;

               exit when not Van_Atvitel or h > Jegyek'Last;
            end loop;

            if h > Jegyek'Last then
               Szam.Abrazolas.Tulcsordult := True;
               -- Ada.Text_IO.Put_Line("TULCSORDULAS");                                                                                                        -- tesztelest segito komment
            end if;


         else
            raise Tulcsordult_Szam_Novelese_Hiba;
         end if;

       Hanyadik_Indexu_Helyierteken := h;
   end Egyet_Hozzaad;


   procedure Hozzaad(Szam : in out Vegyes_Alapu_Szam_Tipus; Mennyit : Natural := 1;  Hanyadik_Indexu_Helyierteken : Natural := 0) is
      h : Natural;
   begin
      for i in 1..Mennyit loop
         h := Hanyadik_Indexu_Helyierteken;
         Egyet_Hozzaad(Szam, h);
      end loop;
   end Hozzaad;


   procedure Novel(Szam : in out Vegyes_Alapu_Szam_Tipus; Hanyadik_Indexu_Helyierteken : in out Natural; Mennyivel : Natural := 1) is
   begin
      for i in 1..Mennyivel loop
         Egyet_Hozzaad(Szam, Hanyadik_Indexu_Helyierteken);
      end loop;
   end Novel;


   function Legmagasabb_Helyiertek_Indexe(Szam : Vegyes_Alapu_Szam_Tipus) return Natural is
   begin
      return Szam.Abrazolas.Szamjegyek'Last;
   end Legmagasabb_Helyiertek_Indexe;


   function Tulcsordulas(Szam : Vegyes_Alapu_Szam_Tipus) return Boolean is
   begin
      return Szam.Abrazolas.Tulcsordult;
   end Tulcsordulas;


   function Image(Szam : Vegyes_Alapu_Szam_Tipus) return String is                                                                                                  -- nem hasznalunk Unbounded_String -et
      Jegyek : Szamjegyek_Tomb_Tipus := Szamjegyek(Szam);


      -- Rekurziv
      function Rekurzivan_Stringge_Alakitva_Hozzafuz(Mihez : String; Mit : Szamjegyek_Tomb_Tipus) return string is
      begin
         if Mit'Length > 0 then
            return Rekurzivan_Stringge_Alakitva_Hozzafuz(Mihez => Mihez & "(" & Natural 'Image(Mit(Mit'Last))(2..Natural 'Image(Mit(Mit'Last))'Last) & ")",
                                                         Mit   => Mit(Mit'First .. Natural'Pred(Mit'Last)));
         else
            -- rekurzio vege
            return Mihez;
         end if;
      end Rekurzivan_Stringge_Alakitva_Hozzafuz;


   begin

      -- trukk
      declare
            Vissza : String := Rekurzivan_Stringge_Alakitva_Hozzafuz(Mihez => "",
                                                                     Mit   => Vegyes_Alapu_Szamrendszer.Szamjegyek_Tomb_Tipus (Szam.Abrazolas.Szamjegyek.all ) );   -- a stringunk 1 -tol lesz indexelve
      begin
         return Vissza;
      end;

   end Image;


   function Szamjegyek(Szam : Vegyes_Alapu_Szam_Tipus) return Szamjegyek_Tomb_Tipus is
   begin
      return Vegyes_Alapu_Szamrendszer.Szamjegyek_Tomb_Tipus( Szam.Abrazolas.Szamjegyek.all );
   end Szamjegyek;


end Szamrendszerek.Vegyes_Alapu_Szamrendszer;