mission5.adb

with Calendrier ;
with Gada.Text_IO ;

procedure Mission5 is
   
   package Cal renames Calendrier ;
   package Txt renames GAda.Text_IO ;
   
   -- Compte le nombre total de jours
   function Compter(An : Cal.T_Annee) return Integer is
      Count : Integer := 0 ;
   begin
      -- Pour chaque mois, additionner le nombre de jours
      for No_Mois in An'Range loop
	 Count := Count + An(No_Mois).Nombre_Jours ;
      end loop ;
      
      return Count ;
   end Compter ;
   
   -- Renvoie vrai si dur1 > dur2
   function Duree_Plus_Grande (Dur1, Dur2 : Cal.T_Duree) return Boolean is
   begin
      return (Dur1.Heures > Dur2.Heures) or (Dur1.Heures = Dur2.Heures and Dur1.Minutes > Dur2.Minutes) ;
   end Duree_Plus_Grande ;
   
   type T_Date is record
      Le_Jour : Integer ;
      Le_Mois : Integer ;
   end record ;
   
   procedure Afficher_Date (Intitule : String ; Date : T_Date) is
   begin
      Txt.Put_Line(Intitule & " : " & Integer'Image(Date.Le_Jour) & " / " & Integer'Image(Date.Le_Mois)) ;
   end Afficher_Date ;
   
   function Plus_Long (An : Cal.T_Annee) return T_Date is
      
      -- Durée du jour le plus long vu jusqu'à présent
      Duree_Max : Cal.T_Duree := (Heures => 0, Minutes => 0) ;
      
      -- Jour le plus long vu jusqu'à présent
      Jour_Long : T_Date := (Le_Jour => 0, Le_Mois => 0) ;
      
      -- Mois courant
      Mois : Cal.T_Mois ;
   begin
      -- Pour chaque mois,
      for No_Mois in An'Range loop 
	 
	 Mois := An(No_Mois) ;
	 
	 -- Regarder chaque jour
	 for No_Jour in 1..Mois.Nombre_Jours loop
	    if Duree_Plus_Grande(Mois.Jours(No_Jour).Duree_Jour, Duree_Max) then
	       Duree_Max := Mois.Jours(No_Jour).Duree_Jour ;
	       Jour_Long := (Le_Mois => No_Mois, Le_Jour => No_Jour) ;
	    end if ;
	 end loop ;
      end loop ;
	
      return Jour_Long ;
   end Plus_Long ;
   
   --
   --  Différentes procédures d'affichage
   --
   procedure Afficher_Nom_Jour(Nom : Cal.T_Nom_Jour) is
   begin
      case Nom is
	 when Cal.Lun => Txt.Put("Lundi") ;
	 when Cal.Mar => Txt.Put("Mardi") ;
	 when Cal.Mer => Txt.Put("Mercredi") ;
	 when Cal.Jeu => Txt.Put("Jeudi") ;
	 when Cal.Ven => Txt.Put("Vendredi") ;
	 when Cal.Sam => Txt.Put("Samedi") ;
	 when Cal.Dim => Txt.Put("Dimanche") ;
      end case ;
   end Afficher_Nom_Jour ;

   procedure Afficher_Phase_Lune(Phase : Cal.T_Lune) is
   begin
      case Phase is
	 when Cal.Nouvelle_Lune => Txt.Put("nouvelle lune") ;
	 when Cal.Pleine_Lune => Txt.Put("pleine lune") ;
	 when Cal.Premier_Quartier => Txt.Put("premier quartier") ;
	 when Cal.Dernier_Quartier => Txt.Put("dernier quartier") ;
	 when Cal.Intermediaire => null ;
      end case ;
   end Afficher_Phase_Lune ;

   
   procedure Afficher_Jour( Jour : Cal.T_Jour) is
   begin
      Afficher_Nom_Jour(Jour.Nom_Jour) ;
      Txt.Put(" " & Integer'Image(Jour.Duree_Jour.Heures) & "H" & Integer'Image(Jour.Duree_Jour.Minutes) & " ") ;
      Afficher_Phase_Lune(Jour.Phase_Lune) ;
   end Afficher_Jour ;
   
   procedure Afficher_Mois( Mois : Cal.T_Mois) is
   begin
      -- En-tête : le nom du mois
      Txt.New_Line ;
      Txt.Put_Line("--------  " & Mois.Nom_Mois & "  -------") ;
      Txt.New_Line ;
      
      -- Puis tous les jours
      for No_Jour in 1..Mois.Nombre_Jours loop
	 Txt.Put(" No " & Integer'Image(No_Jour) & "  ") ;
	 Afficher_Jour(Mois.Jours(No_Jour)) ;
	 Txt.New_Line ;
      end loop ;
      
      Txt.New_Line ;
   end Afficher_Mois ;
   
   procedure Afficher_Annee( An : Cal.T_Annee) is
   begin
      for No_Mois in An'Range loop
	 Afficher_Mois(An(No_Mois)) ;
      end loop ;
   end Afficher_Annee ;
   
   -- Algorithme de recherche
   function Chercher_Lune ( An : Cal.T_Annee ; Depart : T_Date ; Phase : Cal.T_Lune) return T_Date is
      
      -- Date renvoyée si rien ne convient.
      Resultat : T_Date := (0,0) ;
      Trouve : Boolean ;
      
      -- Position courante
      Actuel : T_Date ;
      
      -- Dernier mois de l'année
      Dernier_Mois : constant Integer := 12 ;
      
      -- On est obligé de mettre un use à cause du if sur la phase de la lune (bizarrerie Ada...)
      use Cal ;
      
   begin
      Trouve := False ;
      Actuel := Depart ;
      
      -- Lorsqu'on aura parcouru tous les jours jusqu'à la fin de l'année, la date passera au mois numéro 13.
      while (not Trouve) and Actuel.Le_Mois <= Dernier_Mois loop
	 
	 -- Bonne lune ?
	 if An(Actuel.Le_Mois).Jours(Actuel.Le_Jour).Phase_Lune = Phase then
	    -- Trouvé !
	    Trouve := True ;
	    Resultat := Actuel ;
	    
	 else
	    -- Ce n'est pas ce qu'on cherche, il faut passer au suivant.
	    -- D'habitude, il suffit de faire Index := Index +1, ici c'est un peu plus subtil.
	    
	    -- Est-on au dernier jour du mois ?
	    if Actuel.Le_Jour = An(Actuel.Le_Mois).Nombre_Jours then
	       -- Si oui, il faut changer de mois
	       Actuel.Le_Jour := 1 ;
	       Actuel.Le_Mois := Actuel.Le_Mois + 1 ;
	    else
	       -- Sinon, on passe au jour suivant du même mois
	       Actuel.Le_Jour := Actuel.Le_Jour + 1 ;
	    end if ;
	 end if ;
	 
      end loop ;
      
      return Resultat ;
   end Chercher_Lune ;
   
begin
   
   -- Test de compter
   Txt.Put_Line(Integer'Image(Compter(Cal.Cal2042)) & " jours dans l'année 2042.") ;
   
   -- Jour le plus long (il affiche le 16 juin, dont la durée est sensiblement la même que le 21 juin, à 1 minute près).
   Afficher_Date("Jour le plus long", Plus_Long(Cal.Cal2042)) ;
   
   Afficher_Annee( Cal.Cal2042) ;
   
   Afficher_Date("Date de la première pleine lune après le 14 juillet", Chercher_Lune( Cal.Cal2042, (14,07), Cal.Pleine_Lune )) ;
   
end Mission5 ;