kalendar [Programování]

 
const nazvy: array[1..12] of string = ('Leden', 'Unor', 'Brezen',
                                       'Duben', 'Kveten', 'Cerven',
                                       'Cervenec', 'Srpen', 'Zari',
                                       'Rijen', 'Listopad', 'Prosinec');
const pocty: array[1..12] of integer = (31, 28, 31, 30, 31, 30, 31,
                                        31, 30, 31, 30, 31);
var charmap: array[1..36, 1..75] of char;
 
procedure pridejMesic (nazev: string;
                       polohaX, polohaY: integer;
                       dni, zacatek: integer);
var i, x, y: integer;
begin
     for i := 1 to length (nazev) do
         charmap[polohaY, polohaX + i] := nazev[i];
     polohaY := polohaY + 2;
     for i := 1 to dni do begin
         x := polohaX + 3*((i + zacatek - 2) mod 7);
         y := polohaY + (zacatek + i - 2) div 7;
         if i < 10 then
            charmap[y, x + 2] := char (ord ('0') + i)
         else begin
            charMap[y, x + 2] := char (ord ('0') + i mod 10);
            charMap[y, x + 1] := char (ord ('0') + i div 10);
         end;
     end; {of for i}
end; {of pridejMesic}
 
 
procedure vypis (var vystup:text);
var i, j: integer;
begin
     for i := 1 to 36 do begin
         for j := 1 to 75 do write (vystup, charmap[i, j]);
         writeln (vystup);
     end;
end;
 
 
procedure vypisrok (zacatek: integer; leap: boolean);
var i: integer;
begin
     if leap then pocty[2] := 29;
     for i := 1 to 12 do begin
         pridejMesic (nazvy[i],
                      2 + ((i - 1) mod 3)*23,
                      2 + ((i - 1) div 3)*9,
                      pocty[i],
                      zacatek);
         zacatek := (zacatek + pocty[i] - 1) mod 7 + 1;
     end; {of for i}
end;
 
 
function zacatek (rok: integer):integer;
begin
     zacatek := ((rok-1) div 4 - (rok-1) div 100 + (rok-1) div 400 + rok + 6) mod 7 + 1;
end;
 
 
var rok: integer;
var vystupjm: string;
var vystup: text;
begin
     write ('zadejte rok: ');
     readln (rok);
     write ('Zadejte vystupni soubor: ');
     readln (vystupjm);
     assign (vystup, vystupjm);
     rewrite (vystup);
     vypisrok (zacatek (rok), (((rok mod 4 = 0) and (rok mod 100 <> 0)) or (rok mod 400 = 0)));
     vypis (vystup);
     close (vystup);
end.