Program til undersøgelse
af den særlige kalenderopgave:
program gennemloeb_af_skudaarscyklen;
(* Simpelt (Borland) Pascal-program til
undersøgelse af et
særligt anliggende omkring genbrug af månedskalendere *)
uses dos;
(* unit "dos" bruges hér kun ifm. function program_name *)
const start_yyyy = 2015; (* ... som sammenholdes med året sidst
i skudårscyklen
*)
cyklus =
400; (* længden af skudårscyklen i
år *)
maaned_navn : array(. 1..12 .) of string
= ('januar', 'februar',
'marts', 'april',
'maj', 'juni', 'juli',
'august',
'september', 'oktober',
'november', 'december');
var yyyy
: word;
outputfile : text;
function program_name : string;
var
dir : dirstr;
name : namestr;
ext : extstr;
begin
fsplit(paramstr(0), dir,
name, ext);
program_name:=
name
end;
function ugedag(dato,
md, aar : word) : word;
(* Returnerer ugedag for den
aktuelle dato : 1=mandag, 2=tirsdag,
3=onsdag, 4=torsdag, 5=fredag, 6=lørdag og 7=søndag *)
var
faktor, temp : longint;
begin
(*
For at få Borland Pascal til at regne i longint's (hvilket er
nødvendigt pga. størrelsen af "faktor"), må vi gøre det
på følgende
ikke fuldstændig elegante måde: *)
temp:= 365;
temp:= temp * aar
+ dato + 31 * (md - 1);
if md <= 2 then
faktor:= temp
+ (aar
- 1) div 4
- ((aar - 1) div 100 + 1) * 3 div 4
else
faktor:= temp
- trunc(0.4 * md +
2.3)
+ aar div 4
- (aar div 100 + 1) * 3 div 4;
ugedag:= ((faktor + 5) mod 7) + 1
end;
function skudaar(aar : word) : boolean;
(* Returnerer TRUE, hvis året
er skudår; ellers FALSE *)
(* Vi
ser bort fra, at år 4000 muligvis bliver ikke-skudår for at
gøre den gregorianske kalender mere præcis i forhold til Jordens
omløbstid om Solen - dén tid, dén sag... *)
begin
skudaar:= ((aar mod 4) = 0) and
(((aar mod 100) > 0) or
((aar mod 400) = 0))
end;
procedure behandl_aar;
var maaned,
maaned2,
yyyy_sammenlign : word;
nyt_aar,
finished,
finished2 : boolean;
skudaar_str : string;
begin
nyt_aar := TRUE;
finished:= FALSE;
maaned := 1;
maaned2 := 1;
if yyyy = start_yyyy then
yyyy_sammenlign:= yyyy + cyklus - 1
else
yyyy_sammenlign:= yyyy - 1;
repeat
finished2:= FALSE;
repeat
if ugedag(1, maaned2, yyyy_sammenlign) =
ugedag(1, maaned, yyyy) then begin
if nyt_aar and skudaar(yyyy) then
skudaar_str:=
'(skudår)'
else
skudaar_str:= ' ';
if nyt_aar then begin
nyt_aar:=
FALSE;
if not(yyyy = start_yyyy) then writeln(outputfile)
end;
writeln(outputfile, yyyy,
' ', skudaar_str, ': ',
maaned_navn(. maaned2 .),
' sidste år -> ',
maaned_navn(. maaned .));
inc(maaned2);
finished2:= TRUE
end else
if maaned2 =
12 then
finished2:= TRUE
else
inc(maaned2)
until finished2;
if (maaned = 12) or (maaned2 = 12) then
finished:=
TRUE
else
inc(maaned)
until finished
end;
begin
assign (outputfile, program_name +
'.TXT');
rewrite(outputfile);
for yyyy:= start_yyyy to start_yyyy + cyklus - 1 do behandl_aar;
close(outputfile)
end.
Til outputfilen fra dette program