with Ada.Text_Io; use Ada.Text_Io;
with Unchecked_Deallocation;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;

package body Tas_Gen is
   
   --procedure Free_Noeud IS NEW Unchecked_Deallocation(Un_Tas, Tab_Elements);
   
   function ">"(C1, C2 : in Key) return Boolean is begin
      return C2 < C1; end ">";
   
   -- Vider le tas
   procedure Liberer(T : in out Un_Tas) is 
   begin
      for I in T.Les_Elements'Range loop
	 Liberer_Element(T.Les_Elements(I));
      end loop;
      T.Cardinal := 0;
   end Liberer;

   -- Retourne le nb courant d'éléments du tas
   function Cardinal(T : in Un_Tas) return Natural is 
   begin
      return T.Cardinal;
   end Cardinal;
   
   -- Fonction interne, place correctement un element en descendant
   procedure Move_Down(E : in Natural; T : in out Un_Tas) is
      P, Fils_Max : Natural := E;
      N : Natural := T.Cardinal;
      Fini : Boolean := False;
      Aux : Element;
   begin
      while not Fini and (2*P <= N) loop
	 
	 -- Recherche du fils max
	 Fils_Max := 2*P;
	 if (2*P + 1 <= N) and then Cle_De(T.Les_Elements(2*P+1)) > Cle_De(T.Les_Elements(2*P)) then
	    Fils_Max := 2*P+1;
	 end if;
	 
	 -- S'il est mal placé...
	 if Cle_De(T.Les_Elements(Fils_Max)) > Cle_De(T.Les_Elements(P)) then
	    Aux := T.Les_Elements(P);
	    T.Les_Elements(P) := T.Les_Elements(Fils_max);
	    T.Les_Elements(Fils_max) := Aux;
	    
	    
	    P := Fils_Max;
	 else -- ...ou s'il est bien placé
	    Fini := True;
	 end if;
      end loop;
   end Move_Down;
   
   -- Fonction interne, place correctement un element en montant
   procedure Move_Up(E : in Natural; T : in out Un_Tas) is
      I : Natural := E;
      P : Natural := I/2;
      Aux : Element;
   begin
      --Put_Line(Integer'Image(I) & " " & Integer'Image(P) & " DEBUG");
      while I > 1 and then Cle_De(T.Les_Elements(P)) < Cle_De(T.Les_Elements(I)) loop
	 Aux := T.Les_Elements(P);
	 T.Les_Elements(P) := T.Les_Elements(I);
	 T.Les_Elements(I) := Aux;
	 
	 I := P;
	 P := I / 2;
      end loop;
   end Move_Up;
   
   
   -- Retirer la racine du tas et la retourne
   procedure Enlever_Racine(T : in out Un_Tas; E : out Element) is 
   begin
      if T.Cardinal = 0 then raise Tas_Vide;
      else
	 E := T.Les_Elements(1);
	 T.Les_Elements(1) := T.Les_Elements(T.Cardinal);
	 T.Cardinal := T.Cardinal - 1;
	 
	 -- On a mis le dernier élément en premiere position, mais il
	 -- est probablement mal placé. On le replace.
	 if T.Cardinal > 1 then 
	    Move_Down(1, T);
	 end if;
      end if;
   end Enlever_Racine;

   -- Ajouter un nouvel élément dans le tas
   procedure Ajouter(E : in Element; T : in out Un_Tas) is 
   begin
      if T.Cardinal = T.Les_Elements'Last then raise Tas_Plein; end if;
      
      T.Les_Elements(T.Cardinal + 1) := E;
      T.Cardinal := T.Cardinal + 1;
      
      if T.Cardinal > 1 then
	 Move_Up(T.Cardinal ,T);
      end if;
   end Ajouter;
   
   -- Fonction interne de tas vers string
   function Tab_To_String(T : in Tab_Elements; Card : in Natural) return String is
      P, N : Natural := 1;
      Str : Unbounded_string;
   begin
      if T'Length = 0 then return "";
      else
	 while N <= Card + N - P loop
	    if N > Card then N := Card; end if;
	    for I in P..N loop
	       Str := (Str & To_Unbounded_String(Element_To_String(T(I)) & " "));
	    end loop;
	    Str := (Str & ASCII.LF);
	    P := N + 1;
	    N := P + N;
	 end loop;
	 return To_String(Str);
      end if;
   end Tab_To_String; 
   
   -- Fonction to_string
   function Tas_To_String(T : in Un_Tas) return String is 
   begin
      return Tab_To_String(T.Les_Elements, T.Cardinal);
   end Tas_To_String;
   
end Tas_Gen;
