Pascal

unit CalendrierGregorien;

// Cette unité calcule les jours dans le calendrier grégorien

// La réforme de 1582 prévoyant des exceptions jusqu'en 1900, tous les calculs
// qui pourraient être fait avec des dates avant 1901 seront approximatifs

////////////////////////////////////////////////////////////////////////////////
interface
////////////////////////////////////////////////////////////////////////////////

type jour=record
          j,m,a:integer;
          end;

procedure Initialiser(var jma:jour); // au 01-01-1901

procedure ReadlnJour(var jma:jour);  // format jj/mm/aaaa

procedure WriteJour(var jma:jour);   // ex: "Mardi 01/01/1901"

procedure WritelnJour(var jma:jour);

function EstBissextile(a:integer):boolean;

function IndiceJour(jma:jour):integer;  // le 01/01/0000 donne 1

function JourSemaine(n:integer):string; // ex: "Vendredi"

function RechercheJour(n:integer):jour; // recherche la date telle que
                                        // IndiceJour(jj/mm/aaaa)=n

function EcartJours(jma1,jma2:jour):integer;// nombre de jours entre deux dates

function JourPlus(jma:jour;n:integer):jour; // rajoute n jours à la date jma

////////////////////////////////////////////////////////////////////////////////
implementation
////////////////////////////////////////////////////////////////////////////////

procedure Initialiser(var jma:jour);
begin
jma.j:=1; jma.m:=1; jma.a:=1901;
end;

procedure ReadlnJour(var jma:jour);
begin
writeln;
writeln('Entrez le jour, le mois, et l''annee');
write('Jour  : '); readln(jma.j);
write('Mois  : '); readln(jma.m);
write('Annee : '); readln(jma.a);
if jma.a<1901 // voir la note sur le calendrier grégorien (au début du code)
   then writeln('Attention les calculs avec cette date seront approximatifs');
writeln;
end;

function EstBissextile(a:integer):boolean;
begin
result:=false;
if a mod 004=0 then result:=true;
if a mod 100=0 then result:=false;
if a mod 400=0 then result:=true;
end;

function IndiceJour(jma:jour):integer;
var b,r,t:integer;
begin
b:=1 // b est le nombre de 29 février dans les années précédentes
   +(jma.a-1) div 4
   -(jma.a-1) div 100
   +(jma.a-1) div 400;

if EstBissextile(jma.a) // t est le nombre de 29 février dans l'année en cours
   then t:=1
   else t:=0;

jma.m:=((jma.m-1) mod 12)+1; // évite une erreur si jma.m<1 ou jma.m>12

case jma.m of // r est le nombre de jours écoulés dans l'année courante
              // on compte le 29 février des années bissextiles à partir de mars
     01: r:=000+jma.j;
     02: r:=031+jma.j;
     03: r:=059+jma.j+t;
     04: r:=090+jma.j+t;
     05: r:=120+jma.j+t;
     06: r:=151+jma.j+t;
     07: r:=181+jma.j+t;
     08: r:=212+jma.j+t;
     09: r:=243+jma.j+t;
     10: r:=273+jma.j+t;
     11: r:=304+jma.j+t;
     12: r:=334+jma.j+t;
     end;

result:=365*jma.a+b+r;
end;

function JourSemaine(n:integer):string;
begin
// pour le vendredi 01-01-1999 on a IndiceJour=730121 multiple de 7
case (n mod 7) of
     0:result:='Vendredi';
     1:result:='Samedi';
     2:result:='Dimanche';
     3:result:='Lundi';
     4:result:='Mardi';
     5:result:='Mercredi';
     6:result:='Jeudi';
     end;
end;

function RechercheJour(n:integer):jour;
var a,m,j,x:integer;
begin
x:=trunc(real(n)/365.2425);
// x est une approximation de l'année à 1 an près, on fait une recherche
// sur l'année d'avant et l'année d'après pour avoir un résultat correct
// de plus on cherche à l'envers pour éviter des absurdités
// par exemple on trouve "01 mai" avant de trouver "31 avril"

for a:=(x+1) downto (x-1) do
    begin
    result.a:=a;
    for m:=12 downto 1 do
        begin
        result.m:=m;
        for j:=31 downto 1 do
            begin
            result.j:=j;
            if IndiceJour(result)=n then exit;
            end;
        end;
    end;

writeln('Erreur avec RechercheJour(',n,')'); // résultat par défaut : 01/01/x-1
end;

procedure WriteJour(var jma:jour);
begin
write(JourSemaine(IndiceJour(jma)):8,' ');
if jma.j<10 then write('0');
write(jma.j,'/');
if jma.m<10 then write('0');
write(jma.m,'/',jma.a);
end;

procedure WritelnJour(var jma:jour);
begin
WriteJour(jma);
writeln;
end;

function EcartJours(jma1,jma2:jour):integer;
begin
result:=abs(IndiceJour(jma1)-IndiceJour(jma2));
end;

function JourPlus(jma:jour;n:integer):jour;
begin
result:=RechercheJour(IndiceJour(jma)+n)
end;

begin
end.

program date; // un seul m à program

var c,y,jour,mois,annee:integer; // il faut déclarer c et y
begin
writeln('donne une date : '); // le : à l'intérieur des guillemets

// il faut faire la lecture des paramètres
write('le jour : '); readln(jour);
write('le mois : '); readln(mois);
write('l''annee : '); readln(annee);

if mois>2 then
              mois:=mois-2 // jamais de ; avant else
          else
              mois:=mois+10;
annee:=annee-1;
y:=annee mod 100;
c:=annee div 100;

jour:=(jour+(13*mois-1) div 5 +y+y div 4+c div 4+5*c)mod 7; // il manque un ;

writeln(jour); // Remarque : ici l'affichage est un entier, on pourrait faire :
case jour of
     1:writeln('lundi');
     2:writeln('mardi');
     3:writeln('mercredi');
     4:writeln('jeudi');
     5:writeln('vendredi');
     6:writeln('samedi');
     7:writeln('dimanche');
     end;

// le programme doit attendre que l'utilisateur ait fini de lire le résultat
writeln; write('Fin du programme. Appuyer sur Entree'); readln;
end.