Advertisement
hpolzer

Church Holidays

Mar 29th, 2016
232
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 13.72 KB | None | 0 0
  1. {
  2.         "kirchliche_feiertage.pas" (Free Pascal/ GNU Pascal) computes the dates
  3.         of church holidays, to compile run "fpc kirchliche_feiertage.pas" or
  4.         "gpc -o kirchliche_feiertage kirchliche_feiertage.pas".
  5.         Copyright (C) <December 3rd, 2015> Henning Polzer,
  6.         send comments and error reports to: h underscore polzer at gmx dot de.
  7.  
  8.         This program is free software; you can redistribute it and/or
  9.         modify it under the terms of the GNU General Public License
  10.         as published by the Free Software Foundation; either version 2
  11.         of the License, or (at your option) any later version.
  12.  
  13.         This program is distributed in the hope that it will be useful,
  14.         but WITHOUT ANY WARRANTY; without even the implied warranty of
  15.         MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16.         GNU General Public License for more details.
  17.  
  18.         You should have received a copy of the GNU General Public License
  19.         along with this program; if not, write to the Free Software
  20.         Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  21. }
  22.  
  23. PROGRAM kirchliche_feiertage;
  24. CONST obergrenze = 5000; { Berechnungen nur bis zu diesem Jahr }
  25.  
  26. TYPE Tdatum = RECORD
  27.                 t, m, j: integer { tag, monat, jahr }
  28.               END;
  29.  
  30. VAR     fehlercode, { fuer Umwandlung der Kommandozeilenparameter }
  31.         ks, ug, og: integer;    { ks = kalenderstil }
  32.  
  33.  
  34. FUNCTION schaltjahr (stil, jahr: integer): integer;
  35. { Rueckgabewerte: 0 fuer Gemein-, 1 fuer Schaltjahr. }
  36. VAR ks, s: integer;
  37.  
  38. BEGIN
  39.   schaltjahr := 0;
  40.   s := 0;
  41.   ks := stil;
  42.   IF ks = 1 THEN { jul. Kal. anwenden }
  43.     IF jahr MOD 4 = 0 THEN s := 1;
  44.   IF ks = 2 THEN { greg. Kal. anwenden }
  45.   BEGIN
  46.     IF jahr MOD   4 = 0 THEN s := 1;
  47.     IF jahr MOD 100 = 0 THEN s := 0;
  48.     IF jahr MOD 400 = 0 THEN s := 1
  49.   END; { stil = 2 }
  50.   schaltjahr := s
  51. END; { schaltjahr }
  52.  
  53.  
  54. FUNCTION datum_in_nummer (stil: integer; tagesdatum: Tdatum): integer;
  55. { verwandelt Tagesdatum in eine laufende Nummer }
  56. VAR dat: Tdatum;
  57.     ks, schalttag, summe: integer;
  58.  
  59. BEGIN
  60.   datum_in_nummer := 0;
  61.   dat := tagesdatum;
  62.   summe := 0;
  63.   ks := stil;
  64.   { Ggf. Schalttag zur Addition bereithalten: }
  65.   schalttag := schaltjahr (ks, dat.j);
  66.   WITH dat DO
  67.     CASE m OF
  68.        1: summe :=       t; { Schalttag fuer Januar ohne Bedeutung }
  69.        2: summe :=  31 + t; { Schalttag beeinflusst Tagesnr. erst ab Maerz }
  70.        3: summe :=  59 + t + schalttag;
  71.        4: summe :=  90 + t + schalttag;
  72.        5: summe := 120 + t + schalttag;
  73.        6: summe := 151 + t + schalttag;
  74.        7: summe := 181 + t + schalttag;
  75.        8: summe := 212 + t + schalttag;
  76.        9: summe := 243 + t + schalttag;
  77.       10: summe := 273 + t + schalttag;
  78.       11: summe := 304 + t + schalttag;
  79.       12: summe := 334 + t + schalttag
  80.     END; { case }
  81.   datum_in_nummer := summe
  82. END; { datum_in_nummer }
  83.  
  84.  
  85. FUNCTION nummer_in_datum (stil, tagesnummer, jahreszahl: integer): Tdatum;
  86. { verwandelt laufende Nummer eines Tages in Datum }
  87. VAR ks, nr, tag, monat, jahr, schalttag: integer;
  88.     tempdatum: Tdatum;
  89.  
  90. BEGIN
  91.   ks := stil;
  92.   nr := tagesnummer;
  93.   tag := 0;
  94.   monat := 0;
  95.   jahr := jahreszahl;
  96.  
  97.   tempdatum.j := jahreszahl; { Jahr bereits hier zuweisen }
  98.   schalttag := schaltjahr (ks, jahr);
  99.  
  100.   IF schalttag = 0 THEN { Gemeinjahr }
  101.     CASE nr OF
  102.          1.. 31: BEGIN tag := nr      ; monat :=  1 END;
  103.         32.. 59: BEGIN tag := nr -  31; monat :=  2 END;
  104.         60.. 90: BEGIN tag := nr -  59; monat :=  3 END;
  105.         91..120: BEGIN tag := nr -  90; monat :=  4 END;
  106.        121..151: BEGIN tag := nr - 120; monat :=  5 END;
  107.        152..181: BEGIN tag := nr - 151; monat :=  6 END;
  108.        182..212: BEGIN tag := nr - 181; monat :=  7 END;
  109.        213..243: BEGIN tag := nr - 212; monat :=  8 END;
  110.        244..273: BEGIN tag := nr - 243; monat :=  9 END;
  111.        274..304: BEGIN tag := nr - 273; monat := 10 END;
  112.        305..334: BEGIN tag := nr - 304; monat := 11 END;
  113.        335..365: BEGIN tag := nr - 334; monat := 12 END
  114.     END { case } ELSE
  115.       IF schalttag = 1 THEN { Schaltjahr }
  116.         CASE nr OF
  117.            1.. 31: BEGIN tag := nr      ; monat :=  1 END;
  118.           32.. 60: BEGIN tag := nr -  31; monat :=  2 END;
  119.           61.. 91: BEGIN tag := nr -  60; monat :=  3 END;
  120.           92..121: BEGIN tag := nr -  91; monat :=  4 END;
  121.          122..152: BEGIN tag := nr - 121; monat :=  5 END;
  122.          153..182: BEGIN tag := nr - 152; monat :=  6 END;
  123.          183..213: BEGIN tag := nr - 182; monat :=  7 END;
  124.          214..244: BEGIN tag := nr - 213; monat :=  8 END;
  125.          245..274: BEGIN tag := nr - 244; monat :=  9 END;
  126.          275..305: BEGIN tag := nr - 274; monat := 10 END;
  127.          306..335: BEGIN tag := nr - 305; monat := 11 END;
  128.          336..366: BEGIN tag := nr - 335; monat := 12 END
  129.         END; { case }
  130.  
  131.   tempdatum.t := tag;
  132.   tempdatum.m := monat;
  133.   nummer_in_datum := tempdatum
  134. END; { nummer_in_datum }
  135.  
  136.  
  137. FUNCTION konv_in_greg (julian_datum: Tdatum): Tdatum;
  138. {       Verwandelt ein Datum im julian. Kalender in ein Datum im greg. Kalender.
  139.         Nach: J. Bach, Die Zeit- und Festrechnung der Juden unter besonderer
  140.         Beruecksichtigung der gaussschen Osterformel nebst einem immerwährenden
  141.         Kalender, Freiburg i. B. 1908, 26.
  142.         Vgl. auch Chr. Zeller, Kalender-Formeln, Acta Mathematica 9, 135.
  143. }
  144.  
  145. VAR h, nr, neue_nr: integer;
  146.     dat: Tdatum;
  147.  
  148. BEGIN
  149.   dat := julian_datum;
  150.   h := trunc (dat.j / 100);
  151.   { 1, weil Datum des jul. Kal. uebergeben, auch unten: }
  152.   nr := datum_in_nummer (1, dat);
  153.   neue_nr := nr + (h - trunc (h / 4) - 2);
  154.   konv_in_greg := nummer_in_datum (1, neue_nr, dat.j)
  155. END; { konv_in_greg }
  156.  
  157.  
  158. FUNCTION wtnr (stil: integer; tagesdatum: Tdatum): integer;
  159. {       Wochentag(snummer) bestimmen nach:
  160.         Chr. Zeller, Kalender-Formeln, Acta Mathematica, Band 9 (1887), 131f.
  161.         So. = 1, Mo. = 2, Di. = 3, Mi. = 4,
  162.         Do. = 5, Fr. = 6, Sa. = 0
  163. }
  164. VAR h, j, k, ks, m, q: integer;
  165.     dat: Tdatum;
  166.  
  167. BEGIN
  168.   dat := tagesdatum;
  169.   ks := stil;
  170.  
  171.   q := dat.t;
  172.   m := dat.m;
  173.   j := trunc (dat.j / 100);
  174.   k := dat.j - j * 100;
  175.  
  176.   IF m = 1 THEN { Januar als 13. Monat des VORjahres }
  177.   BEGIN
  178.     m := 13;
  179.     k := k - 1
  180.   END;
  181.  
  182.   IF m = 2 THEN { Februar als 14. Monat des VORjahres }
  183.   BEGIN
  184.     m := 14;
  185.     k := k - 1
  186.   END;
  187.  
  188.   IF ks = 1 THEN h := (q+trunc(26*(m+1)/10)+k+trunc(k/4)+5-j) ELSE
  189.     IF ks = 2 THEN h := (q+trunc(26*(m+1)/10)+k+trunc(k/4)+trunc(j/4)-2*j);
  190.  
  191.   IF h < 0 THEN
  192.   REPEAT
  193.     h := h + 7
  194.   UNTIL h >= 0;
  195.  
  196.   wtnr := h MOD 7
  197. END; { wtnr }
  198.  
  199.  
  200. PROCEDURE wochentag_ausgeben (nummer: integer);
  201. VAR n: integer;
  202.  
  203. BEGIN
  204.   n := nummer;
  205.   CASE n OF
  206.     0: write ('Sa'); { Nummern wie bei Chr. Zeller, Kalender-Formeln, }
  207.     1: write ('So'); { Acta Mathematica, Band 9 (1887), 131f. gegeben }
  208.     2: write ('Mo');
  209.     3: write ('Di');
  210.     4: write ('Mi');
  211.     5: write ('Do');
  212.     6: write ('Fr')
  213.   END;
  214.   write ('.')
  215. END; { wochentag_ausgeben }
  216.  
  217.  
  218. PROCEDURE kirchliche_feiertage_ausgeben (untergr, obergr: integer);
  219. VAR jahr, u, o: integer;
  220.     dat, neu: Tdatum;
  221.  
  222. FUNCTION ostersonntag (stil: integer; jahr: integer): Tdatum;
  223. {       Ostersonntag bestimmen nach:
  224.         Chr. Zeller, Kalender-Formeln, Acta Mathematica, Band 9 (1887), 133 - 136.
  225. }
  226. VAR n, a, b, d, tag, monat, ks: integer;
  227.     ostern: Tdatum;
  228.  
  229. BEGIN
  230.   ks := stil;
  231.   n := jahr;
  232.   monat := 4;
  233.  
  234.   IF ks = 1 THEN { julian. Kalender }
  235.   BEGIN
  236.     a := n MOD 19;
  237.     b := (19*n-trunc (n/19)+15) MOD 30;
  238.     d := (b+n+trunc (n/4)) MOD 7
  239.   END;
  240.   IF ks = 2 THEN
  241.   BEGIN { gregian. Kalender }
  242.     a := n MOD 19;
  243.     b := (19*n-trunc(n/19)+15+(trunc(n/100)-trunc(n/300)-trunc(n/400))) MOD 30;
  244.     d := (b + n + trunc (n/4) - (trunc (n/100) - trunc (n/400) - 2)) MOD 7
  245.   END;
  246.  
  247.   IF (d = 0) AND (b = 29) THEN d := 7 ELSE
  248.    IF (d = 0) AND (b = 28) AND (a > 10) THEN d := 7;
  249.  
  250.   tag := 21 + b + 7 - d;
  251.   IF tag > 31 THEN tag := tag - 31 ELSE monat := 3;
  252.  
  253.   ostern.t := tag;
  254.   ostern.m := monat;
  255.   ostern.j := n;
  256.   ostersonntag := ostern
  257. END; { ostersonntag }
  258.  
  259.  
  260. FUNCTION erster_advent (stil, jahr: integer): Tdatum;
  261. VAR basis, j, ks, tag: integer;
  262.     dat: Tdatum;
  263.  
  264. BEGIN
  265.   j := jahr;
  266.   ks := stil;
  267.   { Advent 1582 schon nach der greg. Kalenderreform, deshalb: }
  268.   IF j = 1582 THEN ks := 2;
  269.  
  270.   { 27.11. ist 331. Tag im Jahr + ggf. Schalttag: }
  271.   basis := 331 + schaltjahr (ks, j);
  272.  
  273.   dat := nummer_in_datum (ks, basis, j);
  274.   {     Das folgende koennte in einer Formel zwar kuerzer
  275.         ausgedrueckt werden, waere dann aber unuebersichtlicher: }
  276.   CASE wtnr (ks, dat) OF
  277.     0: tag := basis + 1;
  278.     1: tag := basis; { Sonntag }
  279.     2: tag := basis + 6;
  280.     3: tag := basis + 5;
  281.     4: tag := basis + 4;
  282.     5: tag := basis + 3;
  283.     6: tag := basis + 2
  284.   END; { case }
  285.   erster_advent := nummer_in_datum (ks, tag, j)
  286. END; { erster_advent }
  287.  
  288. FUNCTION konv_orth_weihnachten (julian_datum: Tdatum): Tdatum;
  289. {       Datum des Weihnachtsfestes im julian. Kalender in entspr. Datum des
  290.         greg. Kalender verwandeln, analog zu "konv_in_greg"; separate
  291.         Funktion, weil Kalenderstil fuer Schaltjahresberechnung
  292.         jahresunabhaengig julianisch sein muss.
  293.         Wieder nach: Bach, Festrechnung, 26.
  294. }
  295.  
  296. VAR h, nr, neue_nr: integer;
  297.     dat: Tdatum;
  298.  
  299. BEGIN
  300.   dat := julian_datum;
  301.   h := trunc (dat.j / 100);
  302.   { 1, weil Datum des jul. Kal. uebergeben, auch unten: }
  303.   nr := datum_in_nummer (1, dat);
  304.   neue_nr := nr + (h - trunc (h / 4) - 2);
  305.   IF neue_nr > 365 + schaltjahr (1, dat.j) THEN { immer jul. Kalender }
  306.   BEGIN
  307.     neue_nr := neue_nr - (365 + schaltjahr (1, dat.j));
  308.     dat.j := dat.j + 1 { Jahresgrenze ueberschritten }
  309.   END; { if }
  310.   konv_orth_weihnachten := nummer_in_datum (1, neue_nr, dat.j)
  311. END; { konv_orth_weihnachten }
  312.  
  313.  
  314. BEGIN { kirchliche_feiertage_ausgeben }
  315.   u := untergr;
  316.   o := obergr;
  317.  
  318.   IF o > obergrenze THEN o := obergrenze;
  319.   FOR jahr := u TO o DO
  320.   BEGIN
  321.     IF jahr < 1583 THEN ks := 1         { 1 fuer julianischen Stil }
  322.       ELSE ks := 2;                             { 2 fuer gregorianischen Stil }
  323.     dat := ostersonntag (ks, jahr); { Westkirche }
  324.     neu := nummer_in_datum (ks, datum_in_nummer (ks, dat) - 46, jahr);
  325.     write ('Aschermittw.: ', neu.t:2, '.', neu.m:2, '.', neu.j, '; ');
  326.     neu := nummer_in_datum (ks, datum_in_nummer (ks, dat) -  2, jahr);
  327.     write ('Karfreitag   : ', neu.t:2, '.', neu.m:2, '.', neu.j, '; ');
  328.     write ('Ostern: ', dat.t:2, '.', dat.m:2, '.', dat.j, '; ');
  329.     neu := nummer_in_datum (ks, datum_in_nummer (ks, dat) + 39, jahr);
  330.     write ('Chr. Himmelfahrt: ', neu.t:2, '.', neu.m:2, '.', neu.j, '; ');
  331.     neu := nummer_in_datum (ks, datum_in_nummer (ks, dat) + 49, jahr);
  332.     writeln ('Pfingsten: ', neu.t:2, '.', neu.m:2, '.', neu.j, '; ');
  333.     neu := nummer_in_datum (ks, datum_in_nummer (ks, dat) + 60, jahr);
  334.     write ('Fronleichnam: ', neu.t:2, '.', neu.m:2, '.', neu.j, '; ');
  335.     neu := nummer_in_datum (ks, datum_in_nummer (ks, dat) + 68, jahr);
  336.     write ('Herz-Jesu-Fr.: ', neu.t:2, '.', neu.m:2, '.', neu.j, '; ');
  337.  
  338.     write ('Mariae Himmelfahrt: ');             { Wochentag ausgeben }
  339.     WITH neu DO
  340.     BEGIN
  341.       t :=   15;
  342.       m :=    8;
  343.       j := jahr
  344.     END; { with }
  345.     wochentag_ausgeben (wtnr (ks, neu));
  346.  
  347.     dat := erster_advent (ks, jahr);
  348.          { Buss-/Bettag: }
  349.     neu := nummer_in_datum (ks, datum_in_nummer (ks, dat) - 11, jahr);
  350.     write ('; Buss/Bettag: ', neu.t:2, '.', neu.m:2, '.', neu.j, '; ');
  351.     { 1. Advent: }
  352.     write ('1. Advent: ', dat.t:2, '.', dat.m:2, '.', dat.j, '; ');
  353.  
  354.     writeln;
  355.     IF jahr >= 1582 THEN { Orthodoxie behaelt jul. Kalender bei }
  356.     BEGIN
  357.       IF jahr > 1582 THEN { Ostern noch vor greg. Reform }
  358.       BEGIN
  359.         write ('Orthodoxes Osterfest  : ');
  360.         dat := ostersonntag (1, jahr); { 1 fuer Formel des jul. Kalenders }
  361.         write (dat.t:2, '.', dat.m:2, '.', dat.j, ' [julian.], ');
  362.         neu := konv_in_greg (dat);
  363.         write ('entspr. ', neu.t:2, '.', neu.m:2, '.', neu.j, ' im ');
  364.         writeln ('greg. Kalender. ')
  365.       END; { if }
  366.       { Weihnachten 1582 nach Kalenderreform: }
  367.       write ('Orthodoxes Weihnachten: 25.12.', jahr, ' [julian.], ');
  368.       WITH dat DO
  369.       BEGIN
  370.         t :=   25;
  371.         m :=   12;
  372.         j := jahr
  373.       END;
  374.       neu := konv_orth_weihnachten (dat);
  375.       write ('entspr. ', neu.t:2, '.', neu.m:2, '.', neu.j, ' im ');
  376.       writeln ('greg. Kalender. ')
  377.     END; { if [orth. Ostern] }
  378.     writeln
  379.   END { for }
  380. END; { kirchliche_feiertage_ausgeben }
  381.  
  382.  
  383. BEGIN { Hauptprogramm }
  384.   val (paramstr (1), ug, fehlercode); { Ggf. Fehlerbehandlung einfuegen }
  385.   val (paramstr (2), og, fehlercode);
  386.  
  387. {
  388.         Sample output:
  389.         ./kirchliche_feiertage 2015 2016
  390.         Aschermittw.: 18. 2.2015; Karfreitag   :  3. 4.2015; Ostern:  5. 4.2015; Chr. Himmelfahrt: 14. 5.2015; Pfingsten: 24. 5.2015;
  391.         Fronleichnam:  4. 6.2015; Herz-Jesu-Fr.: 12. 6.2015; Mariae Himmelfahrt: Sa.; Buss/Bettag: 18.11.2015; 1. Advent: 29.11.2015;
  392.         Orthodoxes Osterfest  : 30. 3.2015 [julian.], entspr. 12. 4.2015 im greg. Kalender.
  393.         Orthodoxes Weihnachten: 25.12.2015 [julian.], entspr.  7. 1.2016 im greg. Kalender.
  394.  
  395.         Aschermittw.: 10. 2.2016; Karfreitag   : 25. 3.2016; Ostern: 27. 3.2016; Chr. Himmelfahrt:  5. 5.2016; Pfingsten: 15. 5.2016;
  396.         Fronleichnam: 26. 5.2016; Herz-Jesu-Fr.:  3. 6.2016; Mariae Himmelfahrt: Mo.; Buss/Bettag: 16.11.2016; 1. Advent: 27.11.2016;
  397.         Orthodoxes Osterfest  : 18. 4.2016 [julian.], entspr.  1. 5.2016 im greg. Kalender.
  398.         Orthodoxes Weihnachten: 25.12.2016 [julian.], entspr.  7. 1.2017 im greg. Kalender.
  399. }
  400.  
  401.   kirchliche_feiertage_ausgeben (ug, og)
  402. END.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement