Fresh Fish 5/FreshFish_July-August1994.bin/bbs/dev/date-33.087.lha/Date-33.087/Amiga/M2/txt/Date.mod

Modula Implementation | 1994-04-13 | 101.6 KB | 4,403 lines

 IMPLEMENTATION MODULE Date; (* Copyright 1994 Kai Hofmann *)

(*
******* Date/--history-- ****************************************************
*
*   NAME
*    history -- This is the development history of the Date module
*
*   VERSION
*    $VER: Date 33.087 (10.04.1994)
*
*   HISTORY
*    16.01.1994 -    Procedures: JulianLeapYear, GregorianLeapYear &
*            HeisLeapYear initiated.
*    22.01.1994 -    Procedures: JulianMonthDays, GregorianMonthDays,
*            HeisMonthDays, JulianYearDays, GregorianYearDays,
*            HeisYearDays, JulianDayDiff, GregorianDayDiff,
*            HeisDayDiff, JulianDaySmaller, GregorianDaySmaller,
*            HeisDaySmaller, JulianWeekday, GregorianWeekday,
*            HeisWeekday, JulianDaysBeforeWeekday,
*            GregorianDaysBeforeWeekday, HeisDaysBeforeWeekday,
*            JulianDaysAfterWeekday, GregorianDaysAfterWeekday,
*            HeisDaysAfterWeekday JulianDiffDate, FreeDate
*            initiated.
*            Types: Weekdays, Date, DatePtr initiated.
*            Vars of Gregorian reform initiated
*            (for changing to different countries)
*    23.01.1994 -    Procedures: JulianDiffDate finished,
*            GregorianDiffDate, HeisDiffDate, JYearToScaliger,
*            GYearToScaliger, HYearToScaliger, ScaligerYearToJ,
*            ScaligerYearToG, ScaligerYearToH, JSYearToJD,
*            GSYearToJD, HSYearToJD, JDtoMJD, MJDtoJD, JulianToJD,
*            GregorianToJD, HeisToJD, TimeToJD, JDToTime, FreeTime
*            initiated.
*            Types: Time, TimePtr initiated.
*    28.01.1994 -    Procedures: GregorianMoonAge, MoonMonthAge,
*            GregorianEaster initiated.
*    30.01.1994 -    Procedures: JulianDiffDate, GregorianDiffDate,
*            HeisDiffDate, JDtoTime, GregorianEaster edited
*            (changing return value from ptr to VAL variables).
*            Procedures: FreeDate, FreeTime deleted.
*            Types: Date, DatePtr, Time, TimePtr deleted (not
*            longer needed, because of the procedure changes).
*            Procedures: GregorianMoonAge, GregorianEaster changed
*            year parameter from CARDINAL to INTEGER (this is more
*            consistent to the rest of the library).
*            Bugs removed: GregorianWeekday, HeisWeekday
*            (before removing, the weekday for leapyears was
*            wrong)
*            Procedure: GregorianEaster finished.
*    30.01.1994 -    Ported to Oberon-2
*    31.01.1994 -    Compiled with Oberon-2 V3.11
*    12.02.1994 -    Procedures: TimeZoneFactor, LMT, TimeToSec, SecToTime
*            initiated.
*            Version-String installed :)
*    12.02.1994 -    Starting translation to SAS C 6.51
*            Date.h translated
*    13.02.1994 -    Continuation of C translation
*    17.02.1994 -    New Oberon-2 Port, because yesterday Daniel Armor
*            gives me a little hint about the SHORT command
*            (i was not knowing about this!)
*    17.02.1994 -    Little bug in Autodocs removed
*            making this text as Date/--history-- autodoc
*    17.02.1994 -    Continuation of C translation
*    18.02.1994 -    Finished with C translation
*    19.02.1994 -    C bugs removed (thanx to SAS for helping a C-Lamer
*            like me!), some optimizations done too.
*    19.02.1994 -    Oberon-2 version compiled with V40.17 includes
*    21.02.1994 -    Starting to write Modula-II testmodule
*            Vars for the begining of Heis calculation initiated.
*            Fixed little bugs in GregorianWeekday, HeisWeekday,
*            TimeToSec, SecToTime
*            Return-value of LMT changed to LONGINT!
*            Converting testmodule to Oberon-2
*    22.02.1994 -    Converting testmodule to C
*    23.02.1994 -    I noticed, that i forgot the 3 funktions
*            JulianWeek, GregorianWeek, HeisWeek
*    24.02.1994 -    Initiated the 3 forgotten funktions
*    26.02.1994 -    Initiating new GregorianEastern with Gauß-algorithms
*            but ONLY for 1900-2099!
*    27.02.1994 -    Bug fixed in JulianWeekday
*            Bugs fixed in JulianDayDiff, GregorianDayDiff,
*            HeisDayDiff
*            JulianDayGreater, GregorianDayGreater,
*            HeisDayGreater Initiated.
*    02.03.1994 -    Little bug fixed in HeisdayDiff
*            Bugs from 27.02. fixed in Modula-II and Oberon-2
*            versions
*            I found the way to extend Gregorian Easter!
*            Little bug fixed in JulianWeek, GregorianWeek,
*            HeisWeek (~(M2) is not !(C))
*    05.03.1994 -    Some internal bugs removed
*            New internal procedures GregorianSB,
*            GregorianJHSB, GregorianJHStartSB!
*            Extending GregorianEaster :)
*    11.03.1994 -    Things from 05.03. done in Modula-II and Oberon
*    12.03.1994 -    If __SASC is defined autoinitalization instead of
*            _DateInit will be used!
*    13.03.1994 -    After studying the SAS C Manual again i decided to
*            check for __SASC_650 instead of __SASC because of
*            the available of priorities!
*            Setting the priority of _DateInit for
*            autoinitalization to 600!
*    15.03.1994 -    Making Date as library
*    16.03.1994 -    Some work on the Autodocs was done
*            Eleminating OldGregorianEaster by comments
*            (ANSI: STOP bad standards like that there are NO
*             nestedcomments possible in C!!!)
*    19.03.1994 -    Some work on the Autodocs was done in the M2 Code
*    20.03.1994 -    Some work on the Autodocs was done in the Oberon Code
*    22.03.1994 -    In JDtoMJD, MJD to JD an L was added to the constant
*            In GregorianWeekday(), HeisWeekday(),
*            JulianDiffDate(), GregorianDiffDate(),
*            HeisDiffDate(), JDToTime() i have inserted
*            conversions (found with Borland C++ 4.0)
*    24.03.1994 -    Making SunOS4.1.3, SunOS5.3(Solaris2.3) &
*            RS6000 AIX3.2.? binaries with gcc
*            Eliminating nested commends by inserting a space
*            between / and * (i hate this ANSI C standard
*            feature for commends :(
*    27.03.1994 -    Adding library register assignments to the autodocs
*    03.04.1994 -    Little fixes for the SAS C++ Compiler
*            Little bug fixed in the M2 version of GregorianEaster
*    10.04.1994 -    Changing from Shareware to Gift Ware ;-)
*
*****************************************************************************
*
*
*)

(*
******* Date/--background-- *************************************************
*
*   NAME
*    Date -- This module was designed to help calc. calendar dates (V33)
*
*   FUNCTION
*    I now about the date routines in the Amiga-OS(TM), but i decided
*    not to use them, because of their limited functionality and of
*    the portability of this Module!
*
*   NOTES
*    A tropical year is 365.2422 days! / 365d, 5h, 48min, 46sec
*    A moon month is 29.53059 days! / 29d, 12h, 44min, 2.9 sec
*    A moon phase is 7.38265 days!
*
*    (german) Books who helped me creating this:
*        Kleine Naturwissenschaftliche Bibliothek, Band 23
*        Ewige Kalender
*        A.W. Butkewitsch & M.S. Selikson
*        5. Auflage
*        Teubner, Leipzig 1974
*        ISBN 3-322-00393-0
*
*        Tag und Woche, Monat und Jahr: eine Kulturgeschichte des
*        Kalenders
*        Rudolf Wendorff
*        Westdeutscher, Opladen 1993
*        ISBN 3-531-12417-X
*
*        Kalender und Chronologie: Bekanntes & Unbekanntes aus der
*        Kalenderwissenschaft
*        Heinz Zemanek
*        4. Auflage
*        Oldenbourg, München 1987
*        ISBN 3-486-20447-5
*
*        Meyers Handbuch
*        über das Weltall
*        Karl Schaifers & Gerhard Traving
*        5. Auflage
*        Bibliographisches Institut Mannheim 1973
*        ISBN 3-411-00940-3
*
*        Meyers Handbuch
*        über das Weltall
*        Karl Schaifers & Gerhard Traving
*        5. Auflage
*        Bibliographisches Institut Mannheim 1973
*        ISBN 3-411-00940-3
*
*    (english) Books who helped me creating this:
*        Mathematical Astronomy with a Pocket Calculator
*        Aubrey Jones Fras
*        unknown(first) Edition
*        David & Charles Newton Abbot, London 1978
*        ISBN 0-7153-7675-6
*
*   COPYRIGHT
*    This module is Copyright 1994 by Kai Hofmann - all rights reserved!
*    For private use, Public Domain, Gift Ware, Freeware and Shareware
*    you could use this module under following conditions:
*    - You send me a little gift (money is very welcome :)
*        For Bank Accocunt see below - but *ONLY* send in DM
*        to this Bank Account!!!
*      Other nice gifts: all Amiga hardware, and i am searching for a
*      good old 1541 (C64 floppy)
*    - You include a notice in your product, that you use this library
*      and that it is Copyright by Kai Hofmann!
*    If you want to redistribute this library read the following points:
*    - Redistribution warranty is given to:
*        Fred Fish for his great Amiga-Software-Library
*        The german SAAR AG PD-Library
*        The german AMOK PD-Library
*        All public accessible INTERNET servers and PHONE boxes!
*        All other who NOT take more than DM 5.- for one disk
*        ALL other who NOT take more than DM 50.- for one CD
*    For commercial use send me DM 200.-
*    But if you are Apple or Microsoft you have to send (20000.- US$)
*
*   DISCLAIMER
*
*      THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
*   APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
*   HOLDER AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
*   OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
*   THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
*   PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
*   PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE
*   COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
*
*      IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
*   WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY REDISTRIBUTE THE
*   PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
*   GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
*   USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS
*   OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR
*   THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
*   PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
*   POSSIBILITY OF SUCH DAMAGES.
*
*   ADDITIONAL INFORMATIONS
*    I have tried to make portable/usefull and i hope bugfree software
*    for eternity - but this seems to be impossible (sorry!) :)
*    So i hope YOU will pay a fee for this.
*
*   AUTHOR
*    Kai Hofmann
*    Arberger Heerstraße 92
*    28307 Bremen
*    Germany
*    EMail: [e-mail]
*    (no phone - i hate it!)
*
*    Bank account : 1203 7503
*    Account owner: Kai Hofmann
*    Bank code    : 290 501 01
*    Bank name    : Sparkasse in Bremen
*    Bank address : 28307 Bremen / Germany
*
*****************************************************************************
*
*
*)
 (*
 (*$ StackChk       := FALSE *)
 (*$ RangeChk       := FALSE *)
 (*$ OverflowChk    := FALSE *)
 (*$ NilChk         := FALSE *)
 (*$ CaseChk        := FALSE *)
 (*$ ReturnChk      := FALSE *)
 (*$ LargeVars      := FALSE *)
 (*$ EntryClear     := TRUE  *)
 (*$ Volatile       := TRUE  *)
 (*$ StackParms     := TRUE  *)
 (*$ CStrings       := TRUE  *)
 *)


 VAR
    BeforeGregorianDay, BeforeGregorianMonth,
    AfterGregorianDay, AfterGregorianMonth,
    StartHeisDay, StartHeisMonth            : SHORTCARD;
    BeforeGregorianYear, AfterGregorianYear,
    StartHeisYear                    : INTEGER;

 (* ----------------------------------------------------------------------- *)

 PROCEDURE JulianLeapYear(year : INTEGER) : BOOLEAN;

(*
******* Date/JulianLeapYear *************************************************
*
*   NAME
*    JulianLeapYear -- Checks if a year is a leap year for jj. (V33)
*
*   SYNOPSIS
*    leapyear := JulianLeapYear(year);
*
*    PROCEDURE JulianLeapYear(year : INTEGER) : BOOLEAN;
*
*   FUNCTION
*    JulianLeapYear checks if a year is a leap year in the julian calendar
*    For years after Chr. it checks if the year is dividable by 4.
*    For years before Chr. a leap year must have a modulo 4 value of 1
*
*   INPUTS
*    year - The year which should be checked (from -32768 to 32767)
*        I think only values from -7 to 1582 are valid, because of
*        the variant that was done on -8 by Augustus!
*
*   RESULT
*    leapyear - TRUE if the year is a leap year, otherwise false.
*
*   EXAMPLE
*    ...
*    IF JulianLeapYear(1994) THEN
*      WriteString("leap year!");
*    ELSE
*      WriteString("no leap year!");
*    END;
*    WriteLn;
*    ...
*
*   NOTES
*    A year is 365.25 days long!
*    Use this function only for values from -7 to 1582!
*
*   BUGS
*    No known bugs.
*
*   SEE ALSO
*    GregorianLeapYear(),HeisLeapYear()
*
*****************************************************************************
*
*
*)

 BEGIN
   IF year <= 0 THEN
     RETURN(ABS(year) MOD 4 = 1);
   ELSE    (* year > 0 *)
     RETURN(year MOD 4 = 0);
   END;
 END JulianLeapYear;


 PROCEDURE GregorianLeapYear(year : INTEGER) : BOOLEAN;

(*
******* Date/GregorianLeapYear **********************************************
*
*   NAME
*    GregorianLeapYear -- Checks if a year is a leap year. (V33)
*
*   SYNOPSIS
*    leapyear := GregorianLeapYear(year);
*
*    PROCEDURE GregorianLeapYear(year : INTEGER) : BOOLEAN;
*
*   FUNCTION
*    GregorianLeapYear checks if a year is a leap year.
*    For years after 1582 all years dividable by 4 are leap years,
*    without years dividable by 100, but years dividable by 400
*    are leap years again!
*    For years before 1582 see JulianLeapYear().
*
*   INPUTS
*    year - The year which should be checked (from -32768 to 32767)
*        I think only values from -7 to 3200 are valid, because of
*        the variant that was done on -8 by Augustus!
*
*   RESULT
*    leapyear - TRUE if the year is a leap year, otherwise false.
*
*   EXAMPLE
*    ...
*    IF GregorianLeapYear(1994) THEN
*      WriteString("leap year!");
*    ELSE
*      WriteString("no leap year!");
*    END;
*    WriteLn;
*    ...
*
*   NOTES
*    A year is 365.2425 days long!
*    Use this function only for values from -7 to 3200!
*
*   BUGS
*    No known bugs.
*
*   SEE ALSO
*    JulianLeapYear(),HeisLeapYear()
*
*****************************************************************************
*
*
*)

 BEGIN
   IF year < BeforeGregorianYear THEN    (* Year of the Gregorian reform *)
     RETURN(JulianLeapYear(year));
   ELSE    (* AfterGregorianYear reform *)
     RETURN((year MOD 4 = 0) AND ((year MOD 100 > 0) OR (year MOD 400 = 0)));
   END;
 END GregorianLeapYear;


 PROCEDURE HeisLeapYear(year : INTEGER) : BOOLEAN;

(*
******* Date/HeisLeapYear ***************************************************
*
*   NAME
*    HeisLeapYear -- Checks if a year is a leap year. (V33)
*
*   SYNOPSIS
*    leapyear := HeisLeapYear(year);
*
*    PROCEDURE HeisLeapYear(year : INTEGER) : BOOLEAN;
*
*   FUNCTION
*    HeisLeapYear checks if a year is a leap year.
*    For years after 1582 see GregorianLeapYear(),
*    The correction from N. Heis says, that all years dividable by
*    3200 are no longer leap years!
*    For years before 1582 see JulianLeapYear
*
*   INPUTS
*    year - The year which should be checked (from -32768 to 32767)
*        I think only values from -7 to 8000 are valid, because of
*        the variant that was done on -8 by Augustus!
*
*   RESULT
*    leapyear - TRUE if the year is a leap year, otherwise false.
*
*   EXAMPLE
*    ...
*    IF HeisLeapYear(1994) THEN
*      WriteString("leap year!");
*    ELSE
*      WriteString("no leap year!");
*    END;
*    WriteLn;
*    ...
*
*   NOTES
*    A year is now 365.2421875 days!
*    Use this function only for values from -7 to 8000!
*
*   BUGS
*    No known bugs.
*
*   SEE ALSO
*    JulianLeapYear(),GregorianLeapYear()
*
*****************************************************************************
*
*
*)

 BEGIN
   IF year < BeforeGregorianYear THEN    (* Year of the Gregorian reform *)
     RETURN(JulianLeapYear(year));
   ELSE (* year >= AfterGregorianYear *)
     IF year MOD 3200 = 0 THEN    (* Correction from N. Heis *)
       RETURN(FALSE);        (* (no leap year all 3200 years) *)
     ELSE
       RETURN(GregorianLeapYear(year));
     END;
   END;
 END HeisLeapYear;

 (* ----------------------------------------------------------------------- *)

 PROCEDURE JulianMonthDays(month : SHORTCARD; year : INTEGER) : SHORTCARD;

(*
******* Date/JulianMonthDays ************************************************
*
*   NAME
*    JulianMonthDays -- Gives back the number of days of a month. (V33)
*
*   SYNOPSIS
*    days := JulianMonthDays(month,year);
*
*    PROCEDURE JulianMonthDays(month : SHORTCARD;
*        year : INTEGER) : SHORTCARD;
*
*   FUNCTION
*    JulianMonthDays gives you back the number of days a month in
*    a specified year have.
*
*   INPUTS
*    month - The month from wich you want to get the number of days.
*    year  - The year in which the month is.
*
*   RESULT
*    days - The number of days the month uses, or 0 if you use
*        a wrong month.
*
*   EXAMPLE
*    ...
*    days := JulianMonthDays(1,1994);
*    WriteString("Days of January 1994 : ");
*    WriteCard(days,2); WriteLn;
*    ...
*
*   NOTES
*    Its is better only to use this function for years from -7 to 1582!
*
*   BUGS
*    No known bugs.
*
*   SEE ALSO
*    JulianLeapYear(),GregorianMonthDays(),HeisMonthDays()
*
*****************************************************************************
*
*
*)

 BEGIN
   IF month IN {1,3,5,7,8,10,12} THEN
     RETURN(31);
   ELSIF month IN {4,6,9,11} THEN
     RETURN(30);
   ELSIF (month = 2) AND JulianLeapYear(year) THEN
     RETURN(29);
   ELSIF (month = 2) AND (NOT JulianLeapYear(year)) THEN
     RETURN(28);
   ELSE (* Error - wrong month *)
     RETURN(0);
   END;
 END JulianMonthDays;


 PROCEDURE GregorianMonthDays(month : SHORTCARD; year : INTEGER) : SHORTCARD;

(*
******* Date/GregorianMonthDays *********************************************
*
*   NAME
*    GregorianMonthDays -- Gives back the number of days of a month. (V33)
*
*   SYNOPSIS
*    days := GregorianMonthDays(month,year);
*
*    PROCEDURE GregorianMonthDays(month : SHORTCARD;
*        year : INTEGER) : SHORTCARD;
*
*   FUNCTION
*    GregorianMonthDays gives you back the number of days a month in
*    a specified year have.
*    For the year 1582 and the month 10 there are only 21 days,
*    because of the Gregorian-reform 10 days are delete from
*    the month (for more look out for books about this!)
*
*   INPUTS
*    month - The month from wich you want to get the number of days.
*    year  - The year in which the month is.
*
*   RESULT
*    days - The number of days the month uses, or 0 if you use
*        a wrong month.
*
*   EXAMPLE
*    ...
*    days := GregorianMonthDays(1,1994);
*    WriteString("Days of January 1994 : ");
*    WriteCard(days,2); WriteLn;
*    ...
*
*   NOTES
*    Use this function only for years from -7 to 3200!
*
*   BUGS
*    If the reform in a country is not in the same month an error will
*    occur!
*
*   SEE ALSO
*    GregorianLeapYear(),JulianMonthDays(),HeisMonthDays()
*
*****************************************************************************
*
*
*)

 BEGIN
   IF (year = AfterGregorianYear) AND (month = AfterGregorianMonth) THEN
     (* 10 days canceled by Gregor XIII
        in countries who chnaged later are more days *)
     RETURN(31-((AfterGregorianDay-BeforeGregorianDay)-1));
   ELSIF (month = 2) AND GregorianLeapYear(year) THEN
     RETURN(29);
   ELSIF (month = 2) AND (NOT GregorianLeapYear(year)) THEN
     RETURN(28);
   ELSE (* use Julian fkt for other calcs. *)
     RETURN(JulianMonthDays(month,year));
   END;
 END GregorianMonthDays;


 PROCEDURE HeisMonthDays(month : SHORTCARD; year : INTEGER) : SHORTCARD;

(*
******* Date/HeisMonthDays **************************************************
*
*   NAME
*    HeisMonthDays -- Gives back the number of days of a month. (V33)
*
*   SYNOPSIS
*    days := HeisMonthDays(month,year);
*
*    PROCEDURE HeisMonthDays(month : SHORTCARD;
*        year : INTEGER) : SHORTCARD;
*
*   FUNCTION
*    HeisMonthDays gives you back the number of days a month in
*    a specified year have.
*    For the year 1582 and the month 10 there are only 21 days,
*    because of the Gregorian-reform 10 days are delete from
*    the month (for more look out for books about this!)
*
*   INPUTS
*    month - The month from wich you want to get the number of days.
*    year  - The year in which the month is.
*
*   RESULT
*    days - The number of days the month uses, or 0 if you use
*        a wrong month.
*
*   EXAMPLE
*    ...
*    days := HeisMonthDays(1,1994);
*    WriteString("Days of January 1994 : ");
*    WriteCard(days,2); WriteLn;
*    ...
*
*   NOTES
*    Use this function only for years from -7 to 8000!
*
*   BUGS
*    See GregorianMonthDays!
*
*   SEE ALSO
*    HeisLeapYear(),JulianMonthDays(),GregorianMonthDays()
*
*****************************************************************************
*
*
*)

 BEGIN
   IF (month = 2) AND HeisLeapYear(year) THEN
     RETURN(29);
   ELSIF (month = 2) AND (NOT HeisLeapYear(year)) THEN
     RETURN(28);
   ELSE (* use Gregorian fkt for other calcs *)
     RETURN(GregorianMonthDays(month,year));
   END;
 END HeisMonthDays;

 (* ----------------------------------------------------------------------- *)

 PROCEDURE JulianYearDays(year : INTEGER) : CARDINAL;

(*
******* Date/JulianYearDays *************************************************
*
*   NAME
*    JulianYearDays -- Gives back the number of days in a year. (V33)
*
*   SYNOPSIS
*    days := JulianYearDays(year);
*
*    PROCEDURE JulianYearDays(year : INTEGER) : CARDINAL;
*
*   FUNCTION
*    JulianYearDays gives you back the number of days in
*    a specified year.
*
*   INPUTS
*    year  - The year in which to count the days.
*
*   RESULT
*    days - The number of days the year uses.
*
*   EXAMPLE
*    ...
*    days := JulianYearDays(1994);
*    WriteString("Days of 1994 : ");
*    WriteCard(days,3); WriteLn;
*    ...
*
*   NOTES
*    Its is better only to use this function for years from -7 to 1582!
*
*   BUGS
*    No known bugs.
*
*   SEE ALSO
*    JulianMonthDays(),GregorianYearDays(),HeisYearDays()
*
*****************************************************************************
*
*
*)

 VAR
    month    : SHORTCARD;
    days    : CARDINAL;

 BEGIN
   days := 0;
   FOR month := 1 TO 12 DO (* add the days of all 12 month *)
     days := days + JulianMonthDays(month,year);
   END;
   RETURN(days);
 END JulianYearDays;


 PROCEDURE GregorianYearDays(year : INTEGER) : CARDINAL;

(*
******* Date/GregorianYearDays **********************************************
*
*   NAME
*    GregorianYearDays -- Gives back the number of days in a year. (V33)
*
*   SYNOPSIS
*    days := GregorianYearDays(year);
*
*    PROCEDURE GregorianYearDays(year : INTEGER) : CARDINAL;
*
*   FUNCTION
*    GregorianYearDays gives you back the number of days in
*    a specified year.
*
*   INPUTS
*    year  - The year in which to count the days.
*
*   RESULT
*    days - The number of days the year uses.
*
*   EXAMPLE
*    ...
*    days := GregorianYearDays(1994);
*    WriteString("Days of 1994 : ");
*    WriteCard(days,3); WriteLn;
*    ...
*
*   NOTES
*    Its is better only to use this function for years from -7 to 3200!
*
*   BUGS
*    No known bugs.
*
*   SEE ALSO
*    GregorianMonthDays(),JulianYearDays(),HeisYearDays()
*
*****************************************************************************
*
*
*)

 VAR
    month    : SHORTCARD;
    days    : CARDINAL;

 BEGIN
   days := 0;
   FOR month := 1 TO 12 DO (* add the days of all 12 month *)
     days := days + GregorianMonthDays(month,year);
   END;
   RETURN(days);
 END GregorianYearDays;


 PROCEDURE HeisYearDays(year : INTEGER) : CARDINAL;

(*
******* Date/HeisYearDays ***************************************************
*
*   NAME
*    HeisYearDays -- Gives back the number of days in a year. (V33)
*
*   SYNOPSIS
*    days := HeisYearDays(year);
*
*    PROCEDURE HeisYearDays(year : INTEGER) : CARDINAL;
*
*   FUNCTION
*    HeisYearDays gives you back the number of days in
*    a specified year.
*
*   INPUTS
*    year  - The year in which to count the days.
*
*   RESULT
*    days - The number of days the year uses.
*
*   EXAMPLE
*    ...
*    days := HeisYearDays(1994);
*    WriteString("Days of 1994 : ");
*    WriteCard(days,3); WriteLn;
*    ...
*
*   NOTES
*    Its is better only to use this function for years from -7 to 8000!
*
*   BUGS
*    No known bugs.
*
*   SEE ALSO
*    HeisMonthDays(),JulianYearDays(),GregorianYearDays()
*
*****************************************************************************
*
*
*)

 VAR
    month    : SHORTCARD;
    days    : CARDINAL;

 BEGIN
   days := 0;
   FOR month := 1 TO 12 DO (* add the days of all 12 month *)
     days := days + HeisMonthDays(month,year);
   END;
   RETURN(days);
 END HeisYearDays;

 (* ----------------------------------------------------------------------- *)

 PROCEDURE JulianDaySmaller(day1,month1 : SHORTCARD; year1 : INTEGER;
            day2,month2 : SHORTCARD; year2 : INTEGER) : BOOLEAN;

(*
******* Date/JulianDaySmaller ***********************************************
*
*   NAME
*    JulianDaySmaller -- Checks if date1 is smaller than date2. (V33)
*
*   SYNOPSIS
*    smaller := JulianDaySmaller(day1,month1,year1,day2,month2,year2);
*
*    PROCEDURE JulianDaySmaller(day1,month1 : SHORTCARD; year1 : INTEGER;
*        day2,month2 : SHORTCARD; year2 : INTEGER) : BOOLEAN;
*
*   FUNCTION
*    JulianDaySmaller test if date1 is smaller than date2.
*
*   INPUTS
*    day1   - day of the first date
*    month1 - month of the first date
*    year1  - year of the first date
*    day2   - day of the second date
*    month2 - month of the second month
*    year2  - year of the second date
*
*   RESULT
*    smaller - This is TRUE is date1 < date2 otherwise it's FALSE.
*
*   EXAMPLE
*    ...
*    IF JulianDaySmaller(18,9,1970,22,1,1994) THEN
*      WriteString("<"); WriteLn;
*    ELSE
*      WriteString(">="); WriteLn;
*    END;
*    ...
*
*   NOTES
*    Its is better only to use this function for years from -7 to 1582!
*
*   BUGS
*    No known bugs.
*
*   SEE ALSO
*    GregorianDaySmaller(),HeisDaySmaller()
*
*****************************************************************************
*
*
*)

 BEGIN
   IF year1 = year2 THEN
     IF month1 = month2 THEN
       RETURN(day1 < day2);
     ELSE
       RETURN(month1 < month2);
     END;
   ELSE
     RETURN(year1 < year2);
   END;
 END JulianDaySmaller;


 PROCEDURE GregorianDaySmaller(day1,month1 : SHORTCARD; year1 : INTEGER;
            day2,month2 : SHORTCARD; year2 : INTEGER) : BOOLEAN;

(*
******* Date/GregorianDaySmaller ********************************************
*
*   NAME
*    GregorianDaySmaller -- Checks if date1 is smaller than date2. (V33)
*
*   SYNOPSIS
*    smaller := GregorianDaySmaller(day1,month1,year1,day2,month2,year2);
*
*    PROCEDURE GregorianDaySmaller(day1,month1 : SHORTCARD;
*        year1 : INTEGER; day2,month2 : SHORTCARD;
*        year2 : INTEGER) : BOOLEAN;
*
*   FUNCTION
*    GregorianDaySmaller test if date1 is smaller than date2.
*
*   INPUTS
*    day1   - day of the first date
*    month1 - month of the first date
*    year1  - year of the first date
*    day2   - day of the second date
*    month2 - month of the second month
*    year2  - year of the second date
*
*   RESULT
*    smaller - This is TRUE is date1 < date2 otherwise it's FALSE.
*
*   EXAMPLE
*    ...
*    IF GregorianDaySmaller(18,9,1970,22,1,1994) THEN
*      WriteString("<"); WriteLn;
*    ELSE
*      WriteString(">="); WriteLn;
*    END;
*    ...
*
*   NOTES
*    Its is better only to use this function for years from -7 to 3200!
*
*   BUGS
*    No known bugs.
*
*   SEE ALSO
*    JulianDaySmaller(),HeisDaySmaller()
*
*****************************************************************************
*
*
*)

 BEGIN
   RETURN(JulianDaySmaller(day1,month1,year1,day2,month2,year2));
 END GregorianDaySmaller;


 PROCEDURE HeisDaySmaller(day1,month1 : SHORTCARD; year1 : INTEGER;
            day2,month2 : SHORTCARD; year2 : INTEGER) : BOOLEAN;

(*
******* Date/HeisDaySmaller *************************************************
*
*   NAME
*    HeisDaySmaller -- Checks if date1 is smaller than date2. (V33)
*
*   SYNOPSIS
*    smaller := HeisDaySmaller(day1,month1,year1,day2,month2,year2);
*
*    PROCEDURE HeisDaySmaller(day1,month1 : SHORTCARD; year1 : INTEGER;
*        day2,month2 : SHORTCARD; year2 : INTEGER) : BOOLEAN;
*
*   FUNCTION
*    HeisDaySmaller test if date1 is smaller than date2.
*
*   INPUTS
*    day1   - day of the first date
*    month1 - month of the first date
*    year1  - year of the first date
*    day2   - day of the second date
*    month2 - month of the second month
*    year2  - year of the second date
*
*   RESULT
*    smaller - This is TRUE is date1 < date2 otherwise it's FALSE.
*
*   EXAMPLE
*    ...
*    IF HeisDaySmaller(18,9,1970,22,1,1994) THEN
*      WriteString("<"); WriteLn;
*    ELSE
*      WriteString(">="); WriteLn;
*    END;
*    ...
*
*   NOTES
*    Its is better only to use this function for years from -7 to 8000!
*
*   BUGS
*    No known bugs.
*
*   SEE ALSO
*    JulianDaySmaller(),GregorianDaySmaller()
*
*****************************************************************************
*
*
*)

 BEGIN
   (* To avoid bugs if differences to JulianDaySmaller was found! *)
   RETURN(GregorianDaySmaller(day1,month1,year1,day2,month2,year2));
 END HeisDaySmaller;

 (* ----------------------------------------------------------------------- *)

 PROCEDURE JulianDayGreater(day1,month1 : SHORTCARD; year1 : INTEGER;
            day2,month2 : SHORTCARD; year2 : INTEGER) : BOOLEAN;

(*
******* Date/JulianDayGreater ***********************************************
*
*   NAME
*    JulianDayGreater -- Checks if date1 is greater than date2. (V33)
*
*   SYNOPSIS
*    greater := JulianDayGreater(day1,month1,year1,day2,month2,year2);
*
*    PROCEDURE JulianDayGreater(day1,month1 : SHORTCARD; year1 : INTEGER;
*        day2,month2 : SHORTCARD; year2 : INTEGER) : BOOLEAN;
*
*   FUNCTION
*    JulianDayGreater test if date1 is greater than date2.
*
*   INPUTS
*    day1   - day of the first date
*    month1 - month of the first date
*    year1  - year of the first date
*    day2   - day of the second date
*    month2 - month of the second month
*    year2  - year of the second date
*
*   RESULT
*    greater - This is TRUE is date1 > date2 otherwise it's FALSE.
*
*   EXAMPLE
*    ...
*    IF JulianDayGreater(18,9,1970,22,1,1994) THEN
*      WriteString(">"); WriteLn;
*    ELSE
*      WriteString("<="); WriteLn;
*    END;
*    ...
*
*   NOTES
*    Its is better only to use this function for years from -7 to 1582!
*
*   BUGS
*    No known bugs.
*
*   SEE ALSO
*    GregorianDayGreater(),HeisDayGreater()
*
*****************************************************************************
*
*
*)

 BEGIN
   IF year1 = year2 THEN
     IF month1 = month2 THEN
       RETURN(day1 > day2);
     ELSE
       RETURN(month1 > month2);
     END;
   ELSE
     RETURN(year1 > year2);
   END;
 END JulianDayGreater;


 PROCEDURE GregorianDayGreater(day1,month1 : SHORTCARD; year1 : INTEGER;
            day2,month2 : SHORTCARD; year2 : INTEGER) : BOOLEAN;

(*
******* Date/GregorianDayGreater ********************************************
*
*   NAME
*    GregorianDayGreater -- Checks if date1 is greater than date2. (V33)
*
*   SYNOPSIS
*    greater := GregorianDayGreater(day1,month1,year1,day2,month2,year2);
*
*    PROCEDURE GregorianDayGreater(day1,month1 : SHORTCARD;
*        year1 : INTEGER; day2,month2 : SHORTCARD;
*        year2 : INTEGER) : BOOLEAN;
*
*   FUNCTION
*    GregorianDayGreater test if date1 is greater than date2.
*
*   INPUTS
*    day1   - day of the first date
*    month1 - month of the first date
*    year1  - year of the first date
*    day2   - day of the second date
*    month2 - month of the second month
*    year2  - year of the second date
*
*   RESULT
*    greater - This is TRUE is date1 > date2 otherwise it's FALSE.
*
*   EXAMPLE
*    ...
*    IF GregorianDayGreater(18,9,1970,22,1,1994) THEN
*      WriteString(">"); WriteLn;
*    ELSE
*      WriteString("<="); WriteLn;
*    END;
*    ...
*
*   NOTES
*    Its is better only to use this function for years from -7 to 3200!
*
*   BUGS
*    No known bugs.
*
*   SEE ALSO
*    JuliandayGreater(),HeisDayGreater()
*
*****************************************************************************
*
*
*)

 BEGIN
   RETURN(JulianDayGreater(day1,month1,year1,day2,month2,year2));
 END GregorianDayGreater;


 PROCEDURE HeisDayGreater(day1,month1 : SHORTCARD; year1 : INTEGER;
            day2,month2 : SHORTCARD; year2 : INTEGER) : BOOLEAN;

(*
******* Date/HeisDayGreater *************************************************
*
*   NAME
*    HeisDayGreater -- Checks if date1 is greater than date2. (V33)
*
*   SYNOPSIS
*    greater := HeisDayGreater(day1,month1,year1,day2,month2,year2);
*
*    PROCEDURE HeisDayGreater(day1,month1 : SHORTCARD; year1 : INTEGER;
*        day2,month2 : SHORTCARD; year2 : INTEGER) : BOOLEAN;
*
*   FUNCTION
*    HeisDayGreater test if date1 is greater than date2.
*
*   INPUTS
*    day1   - day of the first date
*    month1 - month of the first date
*    year1  - year of the first date
*    day2   - day of the second date
*    month2 - month of the second month
*    year2  - year of the second date
*
*   RESULT
*    greater - This is TRUE is date1 > date2 otherwise it's FALSE.
*
*   EXAMPLE
*    ...
*    IF HeisDayGreater(18,9,1970,22,1,1994) THEN
*      WriteString(">"); WriteLn;
*    ELSE
*      WriteString("<="); WriteLn;
*    END;
*    ...
*
*   NOTES
*    Its is better only to use this function for years from -7 to 8000!
*
*   BUGS
*    No known bugs.
*
*   SEE ALSO
*    JulianDayGreater(),GregorianDayGreater()
*
*****************************************************************************
*
*
*)

 BEGIN
   (* To avoid bugs if differences to JulianDayGreater was found! *)
   RETURN(GregorianDayGreater(day1,month1,year1,day2,month2,year2));
 END HeisDayGreater;

 (* ----------------------------------------------------------------------- *)

 PROCEDURE JulianDayDiff(day1,month1 : SHORTCARD; year1 : INTEGER;
            day2,month2 : SHORTCARD; year2 : INTEGER) : LONGINT;

(*
******* Date/JulianDayDiff **************************************************
*
*   NAME
*    JulianDayDiff -- Calculates the days between 2 dates. (V33)
*
*   SYNOPSIS
*    days := JulianDayDiff(day1,month1,year1,day2,month2,year2);
*
*    PROCEDURE JulianDayDiff(day1,month1 : SHORTCARD; year1 : INTEGER;
*        day2,month2 : SHORTCARD; year2 : INTEGER) : LONGINT;
*
*   FUNCTION
*    JulianDayDiff gives you back the number of days between
*    two specified dates.
*
*   INPUTS
*    day1   - day of the first date
*    month1 - month of the first date
*    year1  - year of the first date
*    day2   - day of the second date
*    month2 - month of the second month
*    year2  - year of the second date
*
*   RESULT
*    days - The number of days between the two dates
*        (positive if date1 <= date2).
*
*   EXAMPLE
*    ...
*    days := JulianDayDiff(18,9,1970,22,1,1994);
*    WriteString("Age of Kai Hofmann in days : ");
*    WriteInt(days,10); WriteLn;
*    ...
*
*   NOTES
*    Its is better only to use this function for years from -7 to 1582!
*
*   BUGS
*    No known bugs.
*
*   SEE ALSO
*    GregorianDayDiff(),HeisDayDiff(),JulianMonthDays(),JulianYearDays()
*
*****************************************************************************
*
*
*)

 VAR
    t1,t2 : LONGCARD;

 BEGIN
   t1 := day1; (* set days left in the actual month *)
   t2 := day2;

   WHILE month1 > 1 DO (* calc days left by the gone month of the year1 *)
     DEC(month1);
     t1 := t1 + JulianMonthDays(month1,year1);
   END;

   WHILE month2 > 1 DO (* calc days left by the gone month of the year2 *)
     DEC(month2);
     t2 := t2 + JulianMonthDays(month2,year2);
   END;

   WHILE year1 > year2 DO (* calc days of diff years *)
     DEC(year1);
     t1 := t1 + JulianYearDays(year1);
   END;

   WHILE year1 < year2 DO (* calc days of diff years *)
     DEC(year2);
     t2 := t2 + JulianYearDays(year2);
   END;

   RETURN(LONGINT(t2)-LONGINT(t1));
 END JulianDayDiff;


 PROCEDURE GregorianDayDiff(day1,month1 : SHORTCARD; year1 : INTEGER;
            day2,month2 : SHORTCARD; year2 : INTEGER) : LONGINT;

(*
******* Date/GregorianDayDiff ***********************************************
*
*   NAME
*    GregorianDayDiff -- Calculates the days between 2 dates. (V33)
*
*   SYNOPSIS
*    days := GregorianDayDiff(day1,month1,year1,day2,month2,year2);
*
*    PROCEDURE GregorianDayDiff(day1,month1 : SHORTCARD; year1 : INTEGER;
*        day2,month2 : SHORTCARD; year2 : INTEGER) : LONGINT;
*
*   FUNCTION
*    GregorianDayDiff gives you back the number of days between
*    two specified dates.
*
*   INPUTS
*    day1   - day of the first date
*    month1 - month of the first date
*    year1  - year of the first date
*    day2   - day of the second date
*    month2 - month of the second month
*    year2  - year of the second date
*
*   RESULT
*    days - The number of days between the two dates
*        (positive if date1 <= date2).
*
*   EXAMPLE
*    ...
*    days := GregorianDayDiff(18,9,1970,22,1,1994);
*    WriteString("Age of Kai Hofmann in days : ");
*    WriteInt(days,10); WriteLn;
*    ...
*
*   NOTES
*    Its is better only to use this function for years from -7 to 3200!
*
*   BUGS
*    If you use on of the dates 5.10.1582 to 14.10.1582 you will become
*    wrong output, because this days don't exist!
*
*   SEE ALSO
*    JulianDayDiff(),HeisDayDiff(),GregorianDaySmaller(),
*    GregorianDayGreater(),GregorianMonthDays(),GregorianYearDays()
*
*****************************************************************************
*
*
*)

 VAR
    t1,t2 : LONGCARD;

 BEGIN
   t1 := day1; (* set days left in the actual month *)
   t2 := day2;

   IF (year1 = 1582) AND (month1 = 10) THEN
     IF (day1 < 5) AND GregorianDaySmaller(day1,month1,year1,day2,month2,year2) AND GregorianDaySmaller(day2,month2,year2,1,11,1582) AND GregorianDayGreater(day2,month2,year2,14,10,1582) THEN
       t2 := t2 - 10;
     END;
     IF day1 > 14 THEN
       IF GregorianDaySmaller(day1,month1,year1,day2,month2,year2) AND GregorianDayGreater(day2,month2,year2,31,10,1582) THEN
         t2 := t2 +10;
       END;
       IF GregorianDayGreater(day1,month1,year1,day2,month2,year2) AND GregorianDaySmaller(day2,month2,year2,5,10,1582) THEN
         t1 := t1 -10;
       END;
     END;
   END;

   IF (year2 = 1582) AND (month2 = 10) AND (day2 > 14) THEN
     IF GregorianDaySmaller(day2,month2,year2,day1,month1,year1) AND GregorianDayGreater(day1,month1,year1,31,10,1582) THEN
       t1 := t1 +10;
     END;
     IF GregorianDayGreater(day2,month2,year2,day1,month1,year1) AND GregorianDaySmaller(day1,month1,year1,1,10,1582) THEN
       t2 := t2 -10;
     END;
   END;

   WHILE month1 > 1 DO (* calc days left by the gone month of the year1 *)
     DEC(month1);
     t1 := t1 + GregorianMonthDays(month1,year1);
   END;

   WHILE month2 > 1 DO (* calc days left by the gone month of the year2 *)
     DEC(month2);
     t2 := t2 + GregorianMonthDays(month2,year2);
   END;

   WHILE year1 > year2 DO (* calc days of diff years *)
     DEC(year1);
     t1 := t1 + GregorianYearDays(year1);
   END;

   WHILE year1 < year2 DO (* calc days of diff years *)
     DEC(year2);
     t2 := t2 + GregorianYearDays(year2);
   END;

   RETURN(LONGINT(t2)-LONGINT(t1));
 END GregorianDayDiff;


 PROCEDURE HeisDayDiff(day1,month1 : SHORTCARD; year1 : INTEGER;
            day2,month2 : SHORTCARD; year2 : INTEGER) : LONGINT;

(*
******* Date/HeisDayDiff ****************************************************
*
*   NAME
*    HeisDayDiff -- Calculates the days between 2 dates. (V33)
*
*   SYNOPSIS
*    days := HeisDayDiff(day1,month1,year1,day2,month2,year2);
*
*    PROCEDURE HeisDayDiff(day1,month1 : SHORTCARD; year1 : INTEGER;
*        day2,month2 : SHORTCARD; year2 : INTEGER) : LONGINT;
*
*   FUNCTION
*    HeisDayDiff gives you back the number of days between
*    two specified dates.
*
*   INPUTS
*    day1   - day of the first date
*    month1 - month of the first date
*    year1  - year of the first date
*    day2   - day of the second date
*    month2 - month of the second month
*    year2  - year of the second date
*
*   RESULT
*    days - The number of days between the two dates
*        (positive if date1 <= date2).
*
*   EXAMPLE
*    ...
*    days := HeisDayDiff(18,9,1970,22,1,1994);
*    WriteString("Age of Kai Hofmann in days : ");
*    WriteInt(days,10); WriteLn;
*    ...
*
*   NOTES
*    Its is better only to use this function for years from -7 to 8000!
*
*   BUGS
*    If you use on of the dates 5.10.1582 to 14.10.1582 you will become
*    wrong output, because this days don't exist!
*
*   SEE ALSO
*    JulianDayDiff(),GregorianDayDiff(),HeisDaySmaller(),HeisDayGreater(),
*    HeisMonthDays(),HeisYearDays()
*
*****************************************************************************
*
*
*)

 VAR
    t1,t2 : LONGCARD;

 BEGIN
   t1 := day1; (* set days left in the actual month *)
   t2 := day2;

   IF (year1 = 1582) AND (month1 = 10) THEN
     IF (day1 < 5) AND HeisDaySmaller(day1,month1,year1,day2,month2,year2) AND HeisDaySmaller(day2,month2,year2,1,11,1582) AND HeisDayGreater(day2,month2,year2,14,10,1582) THEN
       t2 := t2 - 10;
     END;
     IF day1 > 14 THEN
       IF HeisDaySmaller(day1,month1,year1,day2,month2,year2) AND HeisDayGreater(day2,month2,year2,31,10,1582) THEN
         t2 := t2 +10;
       END;
       IF HeisDayGreater(day1,month1,year1,day2,month2,year2) AND HeisDaySmaller(day2,month2,year2,5,10,1582) THEN
         t1 := t1 -10;
       END;
     END;
   END;

   IF (year2 = 1582) AND (month2 = 10) AND (day2 > 14) THEN
     IF HeisDaySmaller(day2,month2,year2,day1,month1,year1) AND HeisDayGreater(day1,month1,year1,31,10,1582) THEN
       t1 := t1 +10;
     END;
     IF HeisDayGreater(day2,month2,year2,day1,month1,year1) AND HeisDaySmaller(day1,month1,year1,1,10,1582) THEN
       t2 := t2 -10;
     END;
   END;

   WHILE month1 > 1 DO (* calc days left by the gone month of the year1 *)
     DEC(month1);
     t1 := t1 + HeisMonthDays(month1,year1);
   END;

   WHILE month2 > 1 DO (* calc days left by the gone month of the year2 *)
     DEC(month2);
     t2 := t2 + HeisMonthDays(month2,year2);
   END;

   WHILE year1 > year2 DO (* calc days of diff years *)
     DEC(year1);
     t1 := t1 + HeisYearDays(year1);
   END;

   WHILE year1 < year2 DO (* calc days of diff years *)
     DEC(year2);
     t2 := t2 + HeisYearDays(year2);
   END;

   RETURN(LONGINT(t2)-LONGINT(t1));
 END HeisDayDiff;

 (* ----------------------------------------------------------------------- *)

 PROCEDURE JulianWeekday(day,month : SHORTCARD; year : INTEGER) : Weekdays;

(*
******* Date/JulianWeekday **************************************************
*
*   NAME
*    JulianWeekday -- Gets the weekday of a specified date. (V33)
*
*   SYNOPSIS
*    weekday := JulianWeekday(day,month,year);
*
*    PROCEDURE JulianWeekday(day,month : SHORTCARD;
*        year : INTEGER) : Weekday;
*
*   FUNCTION
*    JulianWeekday gets the weekday for a specified date.
*
*   INPUTS
*    day   - day of the date
*    month - month of the date
*    year  - year of the date
*
*   RESULT
*    weekday - This result is of type:
*        Weekdays := (dayerr,monday,tuesday,wednesday,thursday,freiday,
*        saturday,sunday);
*        dayerr will show you, that an error occurs!
*
*   EXAMPLE
*    ...
*    weekday := JulianWeekday(4,10,1582);
*    IF weekday = dayerr THEN
*    ...
*    END;
*    ...
*
*   NOTES
*    Its is better only to use this function for years from 0 to 1582!
*    In this version no dayerr will occur!
*
*   BUGS
*    For years < 0 errors could occur, or systemcrashs(?).
*
*   SEE ALSO
*    GregorianWeekday(),HeisWeekday()
*
*****************************************************************************
*
*
*)

 VAR
    decade,wday    : SHORTCARD;

 BEGIN
   (* January and february dates must be 13 and 14 of the year before! *)
   IF month IN {1,2} THEN
     month := 12 + month;
     DEC(year);
   END;
   decade := year - ((year DIV 100) * 100);
   (* Formula from Ch. Zeller in 1877 *)
   wday := (day + (((month+1) * 26) DIV 10) + decade + (decade DIV 4)
                    + 5 - SHORTCARD(year DIV 100)) MOD 7;
   (* Convert (1-su 2-mo 3-tu 4-we 5-th 6-fr 7/0-sa) to normal days *)
   IF wday = 0 THEN
     wday := 6;
   ELSE
     DEC(wday);
     IF wday = 0 THEN
       wday := 7;
     END;
   END;
   RETURN(Weekdays(wday));
 END JulianWeekday;


 PROCEDURE GregorianWeekday(day,month : SHORTCARD; year : INTEGER) : Weekdays;

(*
******* Date/GregorianWeekday ***********************************************
*
*   NAME
*    GregorianWeekday -- Gets the weekday of a specified date. (V33)
*
*   SYNOPSIS
*    weekday := GregorianWeekday(day,month,year);
*
*    PROCEDURE GregorianWeekday(day,month : SHORTCARD;
*        year : INTEGER) : Weekday;
*
*   FUNCTION
*    GregorianWeekday gets the weekday for a specified date.
*
*   INPUTS
*    day   - day of the date
*    month - month of the date
*    year  - year of the date
*
*   RESULT
*    weekday - This result is of type:
*        Weekdays = (dayerr,monday,tuesday,wednesday,thursday,freiday,
*        saturday,sunday);
*        dayerr will show you, that an error occurs!
*
*   EXAMPLE
*    ...
*    weekday := GregorianWeekday(22,1,1994);
*    IF weekday = dayerr THEN
*    ...
*    END;
*    ...
*
*   NOTES
*    Its is better only to use this function for years from -7 to 3200!
*    In this version dayerr will only occur for the 10 lost days :)
*
*   BUGS
*    It's not possible to use years < 0 (for more see JulianWeekday()).
*
*   SEE ALSO
*    JulianWeekday(),HeisWeekday(),GregorianDaySmaller(),
*    GregorianLeapYear()
*
*****************************************************************************
*
*
*)

 VAR
    weekday    : Weekdays;
    wd    : CARDINAL;

 BEGIN
   IF GregorianDaySmaller(day,month,year,BeforeGregorianDay+1,
                BeforeGregorianMonth,BeforeGregorianYear) THEN
     RETURN(JulianWeekday(day,month,year));
   ELSIF GregorianDaySmaller(day,month,year,AfterGregorianDay,
                AfterGregorianMonth,AfterGregorianYear) THEN
     RETURN(dayerr);
   ELSE
     (* Formula from J. I. Perelman 1909 *)
     wd := year + (year DIV 4) - (year DIV 100) + (year DIV 400)
                + GregorianDayDiff(1,1,year,day,month,year);
     IF GregorianLeapYear(year) THEN
       DEC(wd);
     END;
     weekday := Weekdays(wd MOD 7);
     IF weekday = dayerr THEN
       weekday := sunday;
     END;
     RETURN(weekday);
   END;
 END GregorianWeekday;


 PROCEDURE HeisWeekday(day,month : SHORTCARD; year : INTEGER) : Weekdays;

(*
******* Date/HeisWeekday ****************************************************
*
*   NAME
*    HeisWeekday -- Gets the weekday of a specified date. (V33)
*
*   SYNOPSIS
*    weekday := HeisWeekday(day,month,year);
*
*    PROCEDURE HeisWeekday(day,month : SHORTCARD;
*        year : INTEGER) : Weekday;
*
*   FUNCTION
*    HeisWeekday gets the weekday for a specified date.
*
*   INPUTS
*    day   - day of the date
*    month - month of the date
*    year  - year of the date
*
*   RESULT
*    weekday - This result is of type:
*        Weekdays = (dayerr,monday,tuesday,wednesday,thursday,freiday,
*        saturday,sunday);
*        dayerr will show you, that an error occurs!
*
*   EXAMPLE
*    ...
*    weekday := HeisWeekday(22,1,1994);
*    IF weekday = dayerr THEN
*    ...
*    END;
*    ...
*
*   NOTES
*    Its is better only to use this function for years from -7 to 8000!
*    In this version dayerr will only occur for the 10 lost days :)
*
*   BUGS
*    Its not possible to use year < 0 (see JulianWeekday() for more).
*
*   SEE ALSO
*    JulianWeekday(),GregorianWeekday(),HeisDaySmaller(),HeisLeapYear(),
*    HeisDayDiff()
*
*****************************************************************************
*
*
*)

 VAR
    weekday    : Weekdays;
    wd    : CARDINAL;

 BEGIN
   IF HeisDaySmaller(day,month,year,StartHeisDay,
                StartHeisMonth,StartHeisYear) THEN
     RETURN(GregorianWeekday(day,month,year));
   ELSE
     (* Formula from J. I. Perelman 1909 - extended for N.Heis in 01.1994
    by Kai Hofmann *)
     wd := year + (year DIV 4) - (year DIV 100) + (year DIV 400)
        - (year DIV 3200) + HeisDayDiff(1,1,year,day,month,year);
     IF HeisLeapYear(year) THEN
       DEC(wd);
     END;
     weekday := Weekdays(wd MOD 7);
     IF weekday = dayerr THEN
       weekday := sunday;
     END;
     RETURN(weekday);
   END;
 END HeisWeekday;

 (* ----------------------------------------------------------------------- *)

 PROCEDURE JulianDaysBeforeWeekday(day,month : SHORTCARD;
            year : INTEGER; weekday : Weekdays) : SHORTCARD;

(*
******* Date/JulianDaysBeforeWeekday ****************************************
*
*   NAME
*    JulianDaysBeforeWeekday -- Returns the diff to the wday before. (V33)
*
*   SYNOPSIS
*    days := JulianDaysBeforeWeekday(day,month,year,weekday);
*
*    PROCEDURE JulianDaysBeforeWeekday(day,month : SHORTCARD;
*        year : INTEGER; weekday : Weekdays) : SHORTCARD;
*
*   FUNCTION
*    Returns the days to the weekday before the specified date.
*    So if you specifie the 22.1.1994 (saturday) and thursday
*    you get back 2!
*    If you specifie the 22.1.1994 and saturday you became back 0
*    (the same day)!
*
*   INPUTS
*    day     - day of the date
*    month   - month of the date
*    year    - year of the date
*    weekday - weekday to search for building difference
*
*   RESULT
*    days - The days back to the searched weekday (0-6)
*        If you get back 8 an error occurs!
*
*   EXAMPLE
*    ...
*    days := JulianDaysBeforeWeekday(22,1,1994,thursday);
*    ...
*
*   NOTES
*    Its better to use this fkt only from -7 to 1582!
*
*   BUGS
*    See JulianWeekday()!
*
*   SEE ALSO
*    GregorianDaysBeforeWeekday(),HeisDaysBeforeWeekday(),JulianWeekday()
*
*****************************************************************************
*
*
*)

 VAR
    wday    : Weekdays;

 BEGIN
   IF weekday = dayerr THEN
     RETURN(8);
   ELSE
     wday := JulianWeekday(day,month,year);
     IF wday >= weekday THEN
       RETURN(SHORTCARD(wday)-SHORTCARD(weekday));
     ELSE (* wday < weekday *)
       RETURN(7-SHORTCARD(weekday)+SHORTCARD(wday));
     END;
   END;
 END JulianDaysBeforeWeekday;


 PROCEDURE GregorianDaysBeforeWeekday(day,month : SHORTCARD;
            year : INTEGER; weekday : Weekdays) : SHORTCARD;

(*
******* Date/GregorianDaysBeforeWeekday *************************************
*
*   NAME
*    GregorianDaysBeforeWeekday -- Returns the diff to wday before. (V33)
*
*   SYNOPSIS
*    days := GregorianDaysBeforeWeekday(day,month,year,weekday);
*
*    PROCEDURE GregorianDaysBeforeWeekday(day,month : SHORTCARD;
*        year : INTEGER; weekday : Weekdays) : SHORTCARD;
*
*   FUNCTION
*    Returns the days to the weekday before the specified date.
*    So if you specifie the 22.1.1994 (saturday) and thursday
*    you get back 2!
*    If you specifie the 22.1.1994 and saturday you became back 0
*    (the same day)!
*
*   INPUTS
*    day     - day of the date
*    month   - month of the date
*    year    - year of the date
*    weekday - weekday to search for building difference
*
*   RESULT
*    days - The days back to the searched weekday (1-7)
*        If you get back 8 an error occurs!
*
*   EXAMPLE
*    ...
*    days := GregorianDaysBeforeWeekday(22,1,1994,thursday);
*    ...
*
*   NOTES
*    Its better to use this fkt only from -7 to 3200!
*
*   BUGS
*    See GregorianWeekday()!
*
*   SEE ALSO
*    JulianDaysBeforeWeekday(),HeisDaysBeforeWeekday(),GregorianWeekday()
*
*****************************************************************************
*
*
*)

 VAR
    wday    : Weekdays;

 BEGIN
   IF weekday = dayerr THEN
     RETURN(8);
   ELSE
     wday := GregorianWeekday(day,month,year);
     IF wday >= weekday THEN
       RETURN(SHORTCARD(wday)-SHORTCARD(weekday));
     ELSE (* wday < weekday *)
       RETURN(7-SHORTCARD(weekday)+SHORTCARD(wday));
     END;
   END;
 END GregorianDaysBeforeWeekday;


 PROCEDURE HeisDaysBeforeWeekday(day,month : SHORTCARD;
            year : INTEGER; weekday : Weekdays) : SHORTCARD;

(*
******* Date/HeisDaysBeforeWeekday ******************************************
*
*   NAME
*    HeisDaysBeforeWeekday -- Returns the diff to wday before. (V33)
*
*   SYNOPSIS
*    days := HeisDaysBeforeWeekday(day,month,year,weekday);
*
*    PROCEDURE HeisDaysBeforeWeekday(day,month : SHORTCARD;
*        year : INTEGER; weekday : Weekdays) : SHORTCARD;
*
*   FUNCTION
*    Returns the days to the weekday before the specified date.
*    So if you specifie the 22.1.1994 (saturday) and thursday
*    you get back 2!
*    If you specifie the 22.1.1994 and saturday you became back 0
*    (the same day)!
*
*   INPUTS
*    day     - day of the date
*    month   - month of the date
*    year    - year of the date
*    weekday - weekday to search for building difference
*
*   RESULT
*    days - The days back to the searched weekday (1-7)
*        If you get back 8 an error occurs!
*
*   EXAMPLE
*    ...
*    days := HeisDaysBeforeWeekday(22,1,1994,thursday);
*    ...
*
*   NOTES
*    Its better to use this fkt only from -7 to 8000!
*
*   BUGS
*    See HeisWeekday()!
*
*   SEE ALSO
*    JulianDaysBeforeWeekday(),GregorianDaysBeforeWeekday(),HeisWeekday()
*
*****************************************************************************
*
*
*)

 VAR
    wday    : Weekdays;

 BEGIN
   IF weekday = dayerr THEN
     RETURN(8);
   ELSE
     wday := HeisWeekday(day,month,year);
     IF wday >= weekday THEN
       RETURN(SHORTCARD(wday)-SHORTCARD(weekday));
     ELSE (* wday < weekday *)
       RETURN(7-SHORTCARD(weekday)+SHORTCARD(wday));
     END;
   END;
 END HeisDaysBeforeWeekday;

 (* ----------------------------------------------------------------------- *)

 PROCEDURE JulianDaysAfterWeekday(day,month : SHORTCARD;
            year : INTEGER; weekday : Weekdays) : SHORTCARD;

(*
******* Date/JulianDaysAfterWeekday *****************************************
*
*   NAME
*    JulianDaysAfterWeekday -- Returns the diff to the wday after. (V33)
*
*   SYNOPSIS
*    days := JulianDaysAfterWeekday(day,month,year,weekday);
*
*    PROCEDURE JulianDaysAfterWeekday(day,month : SHORTCARD;
*        year : INTEGER; weekday : Weekdays) : SHORTCARD;
*
*   FUNCTION
*    Returns the days to the weekday after the specified date.
*    So if you specifie the 22.1.1994 (saturday) and thursday
*    you get back 5!
*    If you specifie the 22.1.1994 and saturday you became back 0
*    (the same day)!
*
*   INPUTS
*    day     - day of the date
*    month   - month of the date
*    year    - year of the date
*    weekday - weekday to search for building difference
*
*   RESULT
*    days - The days after to the searched weekday.
*
*   EXAMPLE
*    ...
*    days := JulianDaysAfterWeekday(22,1,1994,thursday);
*    ...
*
*   NOTES
*    Its better to use this fkt only from -7 to 1582!
*
*   BUGS
*    See JulianWeekday()!
*
*   SEE ALSO
*    GregorianDaysAfterWeekday(),HeisDaysAfterWeekday(),JulianWeekday()
*
*****************************************************************************
*
*
*)

 VAR
    wday    : Weekdays;

 BEGIN
   IF weekday = dayerr THEN
     RETURN(8);
   ELSE
     wday := JulianWeekday(day,month,year);
     IF wday <= weekday THEN
       RETURN(SHORTCARD(weekday)-SHORTCARD(wday));
     ELSE (* wday > weekday *)
       RETURN(7-SHORTCARD(wday)+SHORTCARD(weekday));
     END;
   END;
 END JulianDaysAfterWeekday;


 PROCEDURE GregorianDaysAfterWeekday(day,month : SHORTCARD;
            year : INTEGER; weekday : Weekdays) : SHORTCARD;

(*
******* Date/GregorianDaysAfterWeekday **************************************
*
*   NAME
*    GregorianDaysAfterWeekday -- Returns the diff to wday after. (V33)
*
*   SYNOPSIS
*    days := GregorianDaysAfterWeekday(day,month,year,weekday);
*
*    PROCEDURE GregorianDaysAfterWeekday(day,month : SHORTCARD;
*        year : INTEGER; weekday : Weekdays) : SHORTCARD;
*
*   FUNCTION
*    Returns the days to the weekday after the specified date.
*    So if you specifie the 22.1.1994 (saturday) and thursday
*    you get back 5!
*    If you specifie the 22.1.1994 and saturday you became back 0
*    (the same day)!
*
*   INPUTS
*    day     - day of the date
*    month   - month of the date
*    year    - year of the date
*    weekday - weekday to search for building difference
*
*   RESULT
*    days - The days after to the searched weekday.
*
*   EXAMPLE
*    ...
*    days := GregorianDaysAfterWeekday(22,1,1994,thursday);
*    ...
*
*   NOTES
*    Its better to use this fkt only from -7 to 3200!
*
*   BUGS
*    See GregorianWeekday()!
*
*   SEE ALSO
*    JulianDaysAfterWeekday(),HeisDaysAfterWeekday(),GregorianWeekday()
*
*****************************************************************************
*
*
*)

 VAR
    wday    : Weekdays;

 BEGIN
   IF weekday = dayerr THEN
     RETURN(8);
   ELSE
     wday := GregorianWeekday(day,month,year);
     IF wday <= weekday THEN
       RETURN(SHORTCARD(weekday)-SHORTCARD(wday));
     ELSE (* wday > weekday *)
       RETURN(7-SHORTCARD(wday)+SHORTCARD(weekday));
     END;
   END;
 END GregorianDaysAfterWeekday;


 PROCEDURE HeisDaysAfterWeekday(day,month : SHORTCARD;
            year : INTEGER; weekday : Weekdays) : SHORTCARD;

(*
******* Date/HeisDaysAfterWeekday *******************************************
*
*   NAME
*    HeisDaysAfterWeekday -- Returns the diff to the wday after. (V33)
*
*   SYNOPSIS
*    days := HeisDaysAfterWeekday(day,month,year,weekday);
*
*    PROCEDURE HeisDaysAfterWeekday(day,month : SHORTCARD;
*        year : INTEGER; weekday : Weekdays) : SHORTCARD;
*
*   FUNCTION
*    Returns the days to the weekday after the specified date.
*    So if you specifie the 22.1.1994 (saturday) and thursday
*    you get back 5!
*    If you specifie the 22.1.1994 and saturday you became back 0
*    (the same day)!
*
*   INPUTS
*    day     - day of the date
*    month   - month of the date
*    year    - year of the date
*    weekday - weekday to search for building difference
*
*   RESULT
*    days - The days after to the searched weekday.
*
*   EXAMPLE
*    ...
*    days := HeisDaysAfterWeekday(22,1,1994,thursday);
*    ...
*
*   NOTES
*    Its better to use this fkt only from -7 to 8000!
*
*   BUGS
*    See HeisWeekday()!
*
*   SEE ALSO
*    JulianDaysAfterWeekday(),GregorianDaysAfterWeekday(),HeisWeekday()
*
*****************************************************************************
*
*
*)

 VAR
    wday    : Weekdays;

 BEGIN
   IF weekday = dayerr THEN
     RETURN(8);
   ELSE
     wday := HeisWeekday(day,month,year);
     IF wday <= weekday THEN
       RETURN(SHORTCARD(weekday)-SHORTCARD(wday));
     ELSE (* wday > weekday *)
       RETURN(7-SHORTCARD(wday)+SHORTCARD(weekday));
     END;
   END;
 END HeisDaysAfterWeekday;

 (* ----------------------------------------------------------------------- *)

 PROCEDURE JulianDiffDate(day,month : SHORTCARD;
    year,days : INTEGER; VAR dday,dmonth : SHORTCARD; VAR dyear : INTEGER);

(*
******* Date/JulianDiffDate *************************************************
*
*   NAME
*    JulianDiffDate -- Returns the date for a diff to another date. (V33)
*
*   SYNOPSIS
*    JulianDiffDate(day,month,year,diffdays,dday,dmonth,dyear);
*
*    PROCEDURE JulianDiffDate(day,month : SHORTCARD; year,days : INTEGER;
*        VAR dday,dmonth : SHORTCARD; VAR dyear : INTEGER);
*
*   FUNCTION
*    Returns the date wich lies diffdays before/after the specified date.
*
*   INPUTS
*    day      - day of the date
*    month    - month of the date
*    year     - year of the date
*    diffdays - difference to the date in days
*
*   RESULT
*    dday   - Destination day
*    dmonth - Destination month
*    dyear  - Destination year
*
*   EXAMPLE
*    ...
*    JulianDiffDate(23,1,1994,7,dday,dmonth,dyear);
*    ...
*
*   NOTES
*    Its better to use this fkt only from -7 to 1582!
*
*   BUGS
*    unknown.
*
*   SEE ALSO
*    GregorianDiffDate(),HeisDiffDate(),JulianDayDiff()
*
*****************************************************************************
*
*
*)

 VAR
    ddays    : INTEGER;

 BEGIN
   dday := day;
   dmonth := month;
   dyear := year;
   IF days >= 0 THEN (* add *)
     ddays := JulianDayDiff(dday,dmonth,dyear,1,1,dyear+1);
     WHILE days >= ddays DO (* years *)
       dday := 1;
       dmonth := 1;
       INC(dyear);
       days := days - ddays;
       ddays := JulianDayDiff(dday,dmonth,dyear,1,1,dyear+1);
     END;
     ddays := JulianDayDiff(dday,dmonth,dyear,1,dmonth+1,dyear);
     WHILE days >= ddays DO (* months *)
       dday := 1;
       INC(dmonth);
       days := days - ddays;
       ddays := JulianDayDiff(dday,dmonth,dyear,1,dmonth+1,dyear);
     END;
     IF days > 0 THEN (* days *)
       dday := dday + SHORTCARD(days);
     END;
   ELSE (* sub *)
     ddays := JulianDayDiff(dday,dmonth,dyear,31,12,dyear-1);
     WHILE days <= ddays DO (* years *)
       dday := 31;
       dmonth := 12;
       DEC(dyear);
       days := days - ddays;
       ddays := JulianDayDiff(dday,dmonth,dyear,31,12,dyear-1);
     END;
     ddays := JulianDayDiff(dday,dmonth,dyear,JulianMonthDays(dmonth-1,dyear),dmonth-1,dyear);
     WHILE days <= ddays DO (* months *)
       dday := JulianMonthDays(dmonth-1,dyear);
       DEC(dmonth);
       days := days - ddays;
       ddays := JulianDayDiff(dday,dmonth,dyear,JulianMonthDays(dmonth-1,dyear),dmonth-1,dyear);
     END;
     IF days < 0 THEN
       dday := dday - SHORTCARD(ABS(days));
     END;
   END;
 END JulianDiffDate;


 PROCEDURE GregorianDiffDate(day,month : SHORTCARD;
    year,days : INTEGER; VAR dday,dmonth : SHORTCARD; VAR dyear : INTEGER);

(*
******* Date/GregorianDiffDate **********************************************
*
*   NAME
*    GregorianDiffDate -- Returns the diff date to another date. (V33)
*
*   SYNOPSIS
*    GregorianDiffDate(day,month,year,diffdays,dday,dmonth,dyear);
*
*    PROCEDURE GregorianDiffDate(day,month : SHORTCARD;
*        year,days : INTEGER; VAR dday,dmonth : SHORTCARD;
*        VAR dyear : INTEGER);
*
*   FUNCTION
*    Returns the date wich lies diffdays before/after the specified date.
*
*   INPUTS
*    day      - day of the date
*    month    - month of the date
*    year     - year of the date
*    diffdays - difference to the date in days
*
*   RESULT
*    dday   - Destination day
*    dmonth - Destination month
*    dyear  - Destination year
*
*   EXAMPLE
*    ...
*    GregorianDiffDate(23,1,1994,7,dday,dmonth,dyear);
*    ...
*
*   NOTES
*    Its better to use this fkt only from -7 to 3200!
*
*   BUGS
*    unknown.
*
*   SEE ALSO
*    GregorianDayDiff(),JulianDiffDate(),HeisDiffDate()
*
*****************************************************************************
*
*
*)

 VAR
    ddays    : INTEGER;

 BEGIN
   dday := day;
   dmonth := month;
   dyear := year;
   IF days >= 0 THEN (* add *)
     ddays := GregorianDayDiff(dday,dmonth,dyear,1,1,dyear+1);
     WHILE days >= ddays DO (* years *)
       dday := 1;
       dmonth := 1;
       INC(dyear);
       days := days - ddays;
       ddays := GregorianDayDiff(dday,dmonth,dyear,1,1,dyear+1);
     END;
     ddays := GregorianDayDiff(dday,dmonth,dyear,1,dmonth+1,dyear);
     WHILE days >= ddays DO (* months *)
       dday := 1;
       INC(dmonth);
       days := days - ddays;
       ddays := GregorianDayDiff(dday,dmonth,dyear,1,dmonth+1,dyear);
     END;
     IF days > 0 THEN (* days *)
       dday := dday + SHORTCARD(days);
     END;
   ELSE (* sub *)
     ddays := GregorianDayDiff(dday,dmonth,dyear,31,12,dyear-1);
     WHILE days <= ddays DO (* years *)
       dday := 31;
       dmonth := 12;
       DEC(dyear);
       days := days - ddays;
       ddays := GregorianDayDiff(dday,dmonth,dyear,31,12,dyear-1);
     END;
     ddays := GregorianDayDiff(dday,dmonth,dyear,GregorianMonthDays(dmonth-1,dyear),dmonth-1,dyear);
     WHILE days <= ddays DO (* months *)
       dday := GregorianMonthDays(dmonth-1,dyear);
       DEC(dmonth);
       days := days - ddays;
       ddays := GregorianDayDiff(dday,dmonth,dyear,GregorianMonthDays(dmonth-1,dyear),dmonth-1,dyear);
     END;
     IF days < 0 THEN
       dday := dday - SHORTCARD(ABS(days));
     END;
   END;
 END GregorianDiffDate;


 PROCEDURE HeisDiffDate(day,month : SHORTCARD; year,days : INTEGER;
            VAR dday,dmonth : SHORTCARD; VAR dyear : INTEGER);

(*
******* Date/HeisDiffDate ***************************************************
*
*   NAME
*    HeisDiffDate -- Returns the date for a diff to another date. (V33)
*
*   SYNOPSIS
*    HeisDiffDate(day,month,year,diffdays,dday,dmonth,dyear);
*
*    PROCEDURE HeisDiffDate(day,month : SHORTCARD; year,days : INTEGER;
*         VAR dday,dmonth : SHORTCARD; VAR dyear : INTEGER);
*
*   FUNCTION
*    Returns the date wich lies diffdays before/after the specified date.
*
*   INPUTS
*    day      - day of the date
*    month    - month of the date
*    year     - year of the date
*    diffdays - difference to the date in days
*
*   RESULT
*    dday   - Destination day
*    dmonth - Destination month
*    dyear  - Destination year
*
*   EXAMPLE
*    ...
*    HeisDiffDate(23,1,1994,7,dday,dmonth,dyear);
*    ...
*
*   NOTES
*    Its better to use this fkt only from -7 to 8000!
*
*   BUGS
*    unknown.
*
*   SEE ALSO
*    HeisDayDiff(),JulianDiffDate(),GregorianDiffDate()
*
*****************************************************************************
*
*
*)

 VAR
    ddays    : INTEGER;

 BEGIN
   dday := day;
   dmonth := month;
   dyear := year;
   IF days >= 0 THEN (* add *)
     ddays := HeisDayDiff(dday,dmonth,dyear,1,1,dyear+1);
     WHILE days >= ddays DO (* years *)
       dday := 1;
       dmonth := 1;
       INC(dyear);
       days := days - ddays;
       ddays := HeisDayDiff(dday,dmonth,dyear,1,1,dyear+1);
     END;
     ddays := HeisDayDiff(dday,dmonth,dyear,1,dmonth+1,dyear);
     WHILE days >= ddays DO (* months *)
       dday := 1;
       INC(dmonth);
       days := days - ddays;
       ddays := HeisDayDiff(dday,dmonth,dyear,1,dmonth+1,dyear);
     END;
     IF days > 0 THEN (* days *)
       dday := dday + SHORTCARD(days);
     END;
   ELSE (* sub *)
     ddays := HeisDayDiff(dday,dmonth,dyear,31,12,dyear-1);
     WHILE days <= ddays DO (* years *)
       dday := 31;
       dmonth := 12;
       DEC(dyear);
       days := days - ddays;
       ddays := HeisDayDiff(dday,dmonth,dyear,31,12,dyear-1);
     END;
     ddays := HeisDayDiff(dday,dmonth,dyear,HeisMonthDays(dmonth-1,dyear),dmonth-1,dyear);
     WHILE days <= ddays DO (* months *)
       dday := HeisMonthDays(dmonth-1,dyear);
       DEC(dmonth);
       days := days - ddays;
       ddays := HeisDayDiff(dday,dmonth,dyear,HeisMonthDays(dmonth-1,dyear),dmonth-1,dyear);
     END;
     IF days < 0 THEN
       dday := dday - SHORTCARD(ABS(days));
     END;
   END;
 END HeisDiffDate;

 (* ----------------------------------------------------------------------- *)

 PROCEDURE JYearToScaliger(year : INTEGER) : CARDINAL;

(*
******* Date/JYearToScaliger ************************************************
*
*   NAME
*    JYearToScaliger -- Returns the year as Scaliger year. (V33)
*
*   SYNOPSIS
*    syear := JYearToScaliger(year);
*
*    PROCEDURE JYearToScaliger(year : INTEGER) : CARDINAL;
*
*   FUNCTION
*    Returns the Scaliger year.
*
*   INPUTS
*    year     - Julian year
*
*   RESULT
*    syear - The Scaliger year
*
*   EXAMPLE
*    ...
*    syear := JYearToScaliger(1582);
*    ...
*
*   NOTES
*    Its better to use this fkt only from -7 to 1582!
*
*   BUGS
*    unknown.
*
*   SEE ALSO
*    GYearToScaliger(),HYearToScaliger()
*
*****************************************************************************
*
*
*)

 BEGIN
   IF (year < 0) AND (year > -4714) THEN
     RETURN(4714+year);
   ELSIF (year > 0) AND (year < 3268) THEN
     RETURN(4713+year);
   ELSE
     RETURN(0);
   END;
 END JYearToScaliger;


 PROCEDURE GYearToScaliger(year : INTEGER) : CARDINAL;

(*
******* Date/GYearToScaliger ************************************************
*
*   NAME
*    GYearToScaliger -- Returns the year as Scaliger year. (V33)
*
*   SYNOPSIS
*    syear := GYearToScaliger(year);
*
*    PROCEDURE GYearToScaliger(year : INTEGER) : CARDINAL;
*
*   FUNCTION
*    Returns the Scaliger year.
*
*   INPUTS
*    year     - Gregorian year
*
*   RESULT
*    syear - The Scaliger year
*
*   EXAMPLE
*    ...
*    syear := GYearToScaliger(1994);
*    ...
*
*   NOTES
*    Its better to use this fkt only from -7 to 3200!
*
*   BUGS
*    unknown.
*
*   SEE ALSO
*    JYearToScaliger(),HYearToScaliger()
*
*****************************************************************************
*
*
*)

 BEGIN
   (* if other calcs are better use here! *)
   RETURN(JYearToScaliger(year));
 END GYearToScaliger;


 PROCEDURE HYearToScaliger(year : INTEGER) : CARDINAL;

(*
******* Date/HYearToScaliger ************************************************
*
*   NAME
*    HYearToScaliger -- Returns the year as Scaliger year. (V33)
*
*   SYNOPSIS
*    syear := HYearToScaliger(year);
*
*    PROCEDURE HYearToScaliger(year : INTEGER) : CARDINAL;
*
*   FUNCTION
*    Returns the Scaliger year.
*
*   INPUTS
*    year     - Heis year
*
*   RESULT
*    syear - The Scaliger year
*
*   EXAMPLE
*    ...
*    syear := HYearToScaliger(1994);
*    ...
*
*   NOTES
*    Its better to use this fkt only from -7 to 8000!
*
*   BUGS
*    The Scaliger period is defined to 3268!!!.
*
*   SEE ALSO
*    JYearToScaliger(),GYearToScliger()
*
*****************************************************************************
*
*
*)

 BEGIN
   (* for compatiblities if GYearToScaliger will be changed *)
   RETURN(GYearToScaliger(year));
 END HYearToScaliger;

 (* ----------------------------------------------------------------------- *)

 PROCEDURE ScaligerYearToJ(syear : CARDINAL) : INTEGER;

(*
******* Date/ScaligerYearToJ ************************************************
*
*   NAME
*    ScaligerYearToJ -- Returns the Scaliger year as Julian year. (V33)
*
*   SYNOPSIS
*    year := ScaligerYearToJ(syear);
*
*    PROCEDURE ScaligerYearToJ(syear : CARDINAL) : INTEGER;
*
*   FUNCTION
*    Returns the Julian year of a Scaliger year.
*
*   INPUTS
*    syear     - Scaliger year
*
*   RESULT
*    year - The Julian year
*
*   EXAMPLE
*    ...
*    year := ScaligerYearToJ(4800);
*    ...
*
*   NOTES
*    Its better to use this fkt only from 4707 to 6295!
*
*   BUGS
*    unknown.
*
*   SEE ALSO
*    ScaligerYearToG(),ScaligerYearToH()
*
*****************************************************************************
*
*
*)

 BEGIN
   IF (syear < 4714) THEN
     RETURN(4714+syear);
   ELSE
     RETURN(syear-4713);
   END;
 END ScaligerYearToJ;


 PROCEDURE ScaligerYearToG(syear : CARDINAL) : INTEGER;

(*
******* Date/ScaligerYearToG ************************************************
*
*   NAME
*    ScaligerYearToG -- Returns the Scaliger year as Gregorian year. (V33)
*
*   SYNOPSIS
*    year := ScaligerYearToG(syear);
*
*    PROCEDURE ScaligerYearToG(syear : CARDINAL) : INTEGER;
*
*   FUNCTION
*    Returns the Gregorian year of a Scaliger year.
*
*   INPUTS
*    syear     - Scaliger year
*
*   RESULT
*    year - The Gregorian year
*
*   EXAMPLE
*    ...
*    year := ScaligerYearToG(6400);
*    ...
*
*   NOTES
*    Its better to use this fkt only from 4707 to 7981!
*
*   BUGS
*    unknown.
*
*   SEE ALSO
*    ScaligerYearToJ(),ScaligerYearToH()
*
*****************************************************************************
*
*
*)

 BEGIN
   RETURN(ScaligerYearToJ(syear));
 END ScaligerYearToG;


 PROCEDURE ScaligerYearToH(syear : CARDINAL) : INTEGER;

(*
******* Date/ScaligerYearToH ************************************************
*
*   NAME
*    ScaligerYearToH -- Returns the Scaliger year as Heis year. (V33)
*
*   SYNOPSIS
*    year := ScaligerYearToH(syear);
*
*    PROCEDURE ScaligerYearToH(syear : CARDINAL) : INTEGER;
*
*   FUNCTION
*    Returns the Heis year of a Scaliger year.
*
*   INPUTS
*    syear     - Scaliger year
*
*   RESULT
*    year - The Heis year
*
*   EXAMPLE
*    ...
*    year := ScaligerYearToH(7000);
*    ...
*
*   NOTES
*    Its better to use this fkt only from 4707 to 7981!
*
*   BUGS
*    unknown.
*
*   SEE ALSO
*    ScaligerYearToJ(),ScaligerYearToG()
*
*****************************************************************************
*
*
*)

 VAR
    year    : INTEGER;

 BEGIN (* for compatibilitie if ScaligerYearToG is changed! *)
   RETURN(ScaligerYearToG(syear));
 END ScaligerYearToH;

 (* ----------------------------------------------------------------------- *)

 PROCEDURE JSYearToJD(syear : CARDINAL) : LONGCARD;

(*
******* Date/JSYearToJD *****************************************************
*
*   NAME
*    JSYearToJD -- Calcs the JD from a Scaliger year. (V33)
*
*   SYNOPSIS
*    jd := JSYearToJD(syear);
*
*    PROCEDURE JSYearToJD(syear : CARDINAL) : LONGCARD;
*
*   FUNCTION
*    Returns the Julianday of a Scaliger year.
*
*   INPUTS
*    syear     - Scaliger year
*
*   RESULT
*    jd - The Julianday
*
*   EXAMPLE
*    ...
*    jd := JSYearToJD(4800);
*    ...
*
*   NOTES
*    Its better to use this fkt only from 4707 to 6295!
*
*   BUGS
*    unknown.
*
*   SEE ALSO
*    GSYearToJD(),HSYearToJD()
*
*****************************************************************************
*
*
*)

 BEGIN
   RETURN((LONGCARD(syear)-1)*365+(LONGCARD(syear)+2) DIV 4);
 END JSYearToJD;


 PROCEDURE GSYearToJD(syear : CARDINAL) : LONGCARD;

(*
******* Date/GSYearToJD *****************************************************
*
*   NAME
*    GSYearToJD -- Calcs the JD from a Scaliger year. (V33)
*
*   SYNOPSIS
*    jd := GSYearToJD(syear);
*
*    PROCEDURE GSYearToJD(syear : CARDINAL) : LONGCARD;
*
*   FUNCTION
*    Returns the Julianday of a Scaliger year.
*
*   INPUTS
*    syear     - Scaliger year
*
*   RESULT
*    jd - The Julianday
*
*   EXAMPLE
*    ...
*    jd := GSYearToJD(4800);
*    ...
*
*   NOTES
*    Its better to use this fkt only from 4707 to 7981!
*
*   BUGS
*    unknown.
*
*   SEE ALSO
*    JSYearToJD(),HSYearToJD(),GregorianDayDiff(),ScaligerYearToG()
*
*****************************************************************************
*
*
*)

 BEGIN
   IF syear < 6296 THEN (* 1583 *)
     RETURN(JSYearToJD(syear));
   ELSE
     RETURN(JSYearToJD(6296)-10+LONGCARD(GregorianDayDiff(1,1,1583,1,1,ScaligerYearToG(syear))));
   END;
 END GSYearToJD;


 PROCEDURE HSYearToJD(syear : CARDINAL) : LONGCARD;

(*
******* Date/HSYearToJD *****************************************************
*
*   NAME
*    HSYearToJD -- Calcs the JD from a Scaliger year. (V33)
*
*   SYNOPSIS
*    jd := HSYearToJD(syear);
*
*    PROCEDURE HSYearToJD(syear : CARDINAL) : LONGCARD;
*
*   FUNCTION
*    Returns the Julianday of a Scaliger year.
*
*   INPUTS
*    syear     - Scaliger year
*
*   RESULT
*    jd - The Julianday
*
*   EXAMPLE
*    ...
*    jd := HSYearToJD(6700);
*    ...
*
*   NOTES
*    Its better to use this fkt only from 4707 to 7981!
*    In this version only GSYearToJD() is called, because the
*    Scaliger period is only valid to 3268
*
*   BUGS
*    unknown.
*
*   SEE ALSO
*    JSYearToJD(),GSYearToJD()
*
*****************************************************************************
*
*
*)

 BEGIN
   RETURN(GSYearToJD(syear));
 END HSYearToJD;

 (* ----------------------------------------------------------------------- *)

 PROCEDURE JDtoMJD(jd : LONGCARD) : LONGCARD;

(*
******* Date/JDtoMJD ********************************************************
*
*   NAME
*    JDtoMJD -- Switches from JD to MJD. (V33)
*
*   SYNOPSIS
*    mjd := JDtoMJD(jd);
*
*    PROCEDURE JDtoMJD(jd : LONGCARD) : LONGCARD;
*
*   FUNCTION
*    Returns the Modified Julianday of a Julianday.
*
*   INPUTS
*    jd - Julianday
*
*   RESULT
*    mjd - The Modified Julianday
*
*   EXAMPLE
*    ...
*    mjd := JDtoMJD(2449354);
*    ...
*
*   NOTES
*    none
*
*   BUGS
*    Only use this funktion for jd > 2400001, because mjd is only
*    defined for this, otherwise system will crash!
*
*   SEE ALSO
*    MJDtoJD()
*
*****************************************************************************
*
*
*)

 BEGIN
   RETURN(jd-2400001);
 END JDtoMJD;


 PROCEDURE MJDtoJD(mjd : LONGCARD) : LONGCARD;

(*
******* Date/MJDtoJD ********************************************************
*
*   NAME
*    MJDtoJD -- Switches from MJD to JD. (V33)
*
*   SYNOPSIS
*    jd := MJDtoJD(mjd);
*
*    PROCEDURE MJDtoJD(mjd : LONGCARD) : LONGCARD;
*
*   FUNCTION
*    Returns the Julianday of a Modified Julianday.
*
*   INPUTS
*    mjd - Modified Julianday
*
*   RESULT
*    jd - The Julianday
*
*   EXAMPLE
*    ...
*    jd := JDtoMJD(49353);
*    ...
*
*   NOTES
*    none
*
*   BUGS
*    unknown.
*
*   SEE ALSO
*    MJDtoJD()
*
*****************************************************************************
*
*
*)

 BEGIN
   RETURN(mjd+2400001);
 END MJDtoJD;

 (* ----------------------------------------------------------------------- *)

 PROCEDURE JulianToJD(day,month : SHORTCARD; year : INTEGER) : LONGCARD;

(*
******* Date/JulianToJD *****************************************************
*
*   NAME
*    JulianToJD -- Returns the JD for a date. (V33)
*
*   SYNOPSIS
*    jd := JulianToJD(day,month,year);
*
*    PROCEDURE JulianToJD(day,month : SHORTCARD;
*        year : INTEGER) : LONGCARD;
*
*   FUNCTION
*    Returns the JD for a Julian date.
*
*   INPUTS
*    day      - day of the date to convert
*    month    - month of the date to convert
*    year     - year of the date to convert
*
*   RESULT
*    jd - This is the JD
*
*   EXAMPLE
*    ...
*    jd := JulianToJD(23,1,1994);
*    ...
*
*   NOTES
*    Its better to use this fkt only from -7 to 1582!
*
*   BUGS
*    unknown.
*
*   SEE ALSO
*    GregorianToJD(),HeisToJD(),JSYearToJD(),JYearToScaliger(),
*    JulianDayDiff()
*
*****************************************************************************
*
*
*)

 BEGIN
   RETURN(JSYearToJD(JYearToScaliger(year))+LONGCARD(JulianDayDiff(1,1,year,day,month,year)));
 END JulianToJD;


 PROCEDURE GregorianToJD(day,month : SHORTCARD; year : INTEGER) : LONGCARD;

(*
******* Date/GregorianToJD **************************************************
*
*   NAME
*    GregorianToJD -- Returns the JD for a date. (V33)
*
*   SYNOPSIS
*    jd := GregorianToJD(day,month,year);
*
*    PROCEDURE GregorianToJD(day,month : SHORTCARD;
*        year : INTEGER) : LONGCARD;
*
*   FUNCTION
*    Returns the JD for a Gregorian date.
*
*   INPUTS
*    day      - day of the date to convert
*    month    - month of the date to convert
*    year     - year of the date to convert
*
*   RESULT
*    jd - This is the JD
*
*   EXAMPLE
*    ...
*    jd := GregorianToJD(23,1,1994);
*    ...
*
*   NOTES
*    Its better to use this fkt only from -7 to 3200!
*
*   BUGS
*    unknown.
*
*   SEE ALSO
*    JulianToJD(),HeisToJD(),GSYearToJD(),GYearToScaliger(),
*    GregorianDayDiff()
*
*****************************************************************************
*
*
*)

 BEGIN
   RETURN(GSYearToJD(GYearToScaliger(year))+LONGCARD(GregorianDayDiff(1,1,year,day,month,year)));
 END GregorianToJD;


 PROCEDURE HeisToJD(day,month : SHORTCARD; year : INTEGER) : LONGCARD;

(*
******* Date/HeisToJD *******************************************************
*
*   NAME
*    HeisToJD -- Returns the JD for a date. (V33)
*
*   SYNOPSIS
*    jd := HeisToJD(day,month,year);
*
*    PROCEDURE HeisToJD(day,month : SHORTCARD;
*        year : INTEGER) : LONGCARD;
*
*   FUNCTION
*    Returns the JD for a Heis date.
*
*   INPUTS
*    day      - day of the date to convert
*    month    - month of the date to convert
*    year     - year of the date to convert
*
*   RESULT
*    jd - This is the JD
*
*   EXAMPLE
*    ...
*    jd := HeisToJD(23,1,1994);
*    ...
*
*   NOTES
*    Its better to use this fkt only from -7 to 3268!
*
*   BUGS
*    unknown.
*
*   SEE ALSO
*    JulianToJD(),GregorianToJD(),HSYearToJD(),HYearToScaliger(),
*    HeisDayDiff()
*
*****************************************************************************
*
*
*)

 BEGIN
   RETURN(HSYearToJD(HYearToScaliger(year))+LONGCARD(HeisDayDiff(1,1,year,day,month,year)));
 END HeisToJD;

 (* ----------------------------------------------------------------------- *)

 PROCEDURE TimeToJD(hour,min,sec : SHORTCARD) : REAL;

(*
******* Date/TimeToJD *******************************************************
*
*   NAME
*    TimeToJD -- Returns the JD for a time. (V33)
*
*   SYNOPSIS
*    jd := TimeToJD(hour,min,sec);
*
*    PROCEDURE TimeToJD(hour,min,sec : SHORTCARD) : REAL;
*
*   FUNCTION
*    Returns the JD for a specified time.
*
*   INPUTS
*    hour - hour of the time to convert
*    min  - minute of the time to convert
*    sec  - sec. of the time to convert
*
*   RESULT
*    jd - This is the JD time
*
*   EXAMPLE
*    ...
*    jd := TimeToJD(16,33,0);
*    ...
*
*   NOTES
*    none
*
*   BUGS
*    There is no check, if the specified time is a valid time!
*
*   SEE ALSO
*    JDToTime()
*
*****************************************************************************
*
*
*)

 BEGIN
   RETURN(REAL(LONGCARD(hour)*3600+CARDINAL(min)*60+sec) / 86400.0);
 END TimeToJD;


 PROCEDURE JDToTime(jd : REAL; VAR rhour,rmin,rsec : SHORTCARD);

(*
******* Date/JDToTime *******************************************************
*
*   NAME
*    JDToTime -- Returns the real time for a JD time. (V33)
*
*   SYNOPSIS
*    JDToTime(jd,rhour,rmin,rsec);
*
*    PROCEDURE JDToTime(jd : REAL; VAR rhour,rmin,rsec : SHORTCARD);
*
*   FUNCTION
*    Returns the real time for a JD time.
*
*   INPUTS
*    jd - JD time
*
*   RESULT
*    rhour - 24 hour real time
*    rmin  - real minutes
*    rsec  - real seconds
*
*   EXAMPLE
*    ...
*    JDToTime(0.76543,rhour,rmin,rsec);
*    ...
*
*   NOTES
*    none.
*
*   BUGS
*    If jd is > 0 (including days) there will be occur arithmetic bugs!
*
*   SEE ALSO
*    TimeToJD()
*
*****************************************************************************
*
*
*)

 VAR
    sec    : LONGCARD;

 BEGIN
     IF jd > 0.0 THEN
       jd := jd - REAL(LONGCARD(jd));
     END;
     sec := LONGCARD(jd * 86400.0);
     rhour := sec DIV 3600;
     sec := sec - (sec DIV 3600) * 3600;
     rmin := sec DIV 60;
     sec := sec - (sec DIV 60) * 60;
     rsec := sec;
 END JDToTime;

 (* ----internal----------------------------------------------------------- *)

 PROCEDURE GregorianSZ(year : CARDINAL) : SHORTCARD;

(*
*****i* Date/GregorianSZ ****************************************************
*
*   NAME
*    GregorianSZ -- Returns the 'Sonnenzirkel' (V33)
*
*   SYNOPSIS
*    sz := GregorianSZ(year);
*
*    PROCEDURE GregorianSZ(year : CARDINAL) : SHORTCARD;
*
*   FUNCTION
*    Returns the 'Sonnenzirkel' of a year.
*
*   INPUTS
*    year     - For this year the 'Sonnenzirkel' is calculatet.
*
*   RESULT
*    sz - The 'Sonnenzirkel' for the speified year.
*
*   EXAMPLE
*    ...
*    sz := GregorianSZ(1994);
*    ...
*
*   NOTES
*    Use this only for 1582 to 4100!
*
*   BUGS
*    unknown.
*
*   SEE ALSO
*    GYearToScaliger()
*
*****************************************************************************
*
*
*)

 VAR
    gz    : SHORTCARD;

 BEGIN
   gz := GYearToScaliger(year) MOD 28;
   IF gz = 0 THEN
     gz := 28;
   END;
   RETURN(gz);
 END GregorianSZ;


 PROCEDURE GregorianGZ(year : CARDINAL) : SHORTCARD;

(*
*****i* Date/GregorianGZ ****************************************************
*
*   NAME
*    GregorianGZ -- Returns the 'Goldene Zahl' (golden number) (V33)
*
*   SYNOPSIS
*    gz := GregorianGZ(year);
*
*    PROCEDURE GregorianGZ(year : CARDINAL) : SHORTCARD;
*
*   FUNCTION
*    Returns the 'Goldene Zahl' of a year.
*
*   INPUTS
*    year     - For this year the 'Goldene Zahl' is calculatet.
*
*   RESULT
*    gz - The 'Goldene Zahl' for the speified year.
*
*   EXAMPLE
*    ...
*    gz := GregorianGZ(1994);
*    ...
*
*   NOTES
*    Use this only for 1582 to 4100!
*
*   BUGS
*    unknown.
*
*   SEE ALSO
*    GYearToScaliger()
*
*****************************************************************************
*
*
*)

 VAR
    syear    : CARDINAL;

 BEGIN
   syear := GYearToScaliger(year) MOD 19;
   IF syear = 0 THEN
     syear := 19;
   END;
   RETURN(syear);
 END GregorianGZ;


   PROCEDURE GEP(year : CARDINAL) : SHORTCARD;

(*
*****i* Date/GEP ************************************************************
*
*   NAME
*    GEP -- Internal function to help calculating the 'EP' (V33)
*
*   SYNOPSIS
*    hep := GEP(year);
*
*    PROCEDURE GEP(year : CARDINAL) : SHORTCARD;
*
*   FUNCTION
*    Internal function to help calculating the 'EP'
*
*   INPUTS
*    year - This is the year for which the help EP is to be
*        calculatetd
*
*   RESULT
*    hep - The help value for the EP calculation.
*
*   EXAMPLE
*    ...
*    hep := GEP(1994);
*    ...
*
*   NOTES
*    Use this only for 1582 to 4100!
*
*   BUGS
*    unknown.
*
*   SEE ALSO
*
*
*****************************************************************************
*
*
*)

   VAR
    century,decade    : SHORTCARD;
    ep        : INTEGER;

   BEGIN
     ep := 1; (* 1582 *)
     century := year DIV 100;
     decade := year - century * 100;
     IF year < 1701 THEN
       RETURN(1);
     ELSIF year < 1800 THEN
       RETURN(0);
     ELSE
       ep := ep - INTEGER(((century) MOD 4) + (((century-16) DIV 4) * 3));
       IF (decade = 0) AND ((century MOD 4) > 0) THEN
         INC(ep);
       END;
       ep := ep + INTEGER((century-18) DIV 3);
       IF (((century-18) MOD 3) > 0) OR (decade > 0) THEN
         INC(ep);
       END;
       IF ep > 29 THEN
         ep := ep MOD 30;
       END;
       IF ep < 0 THEN
         ep := ep + 30;
       END;
       RETURN(SHORTCARD(ep));
     END;
   END GEP;


 PROCEDURE GregorianEP(year : CARDINAL) : SHORTCARD;

(*
*****i* Date/GregorianEP ****************************************************
*
*   NAME
*    GregorianEP -- Returns the 'Epakte' (V33)
*
*   SYNOPSIS
*    ep := GregorianEP(year);
*
*    PROCEDURE GregorianEP(year : CARDINAL) : SHORTCARD;
*
*   FUNCTION
*    Returns the 'Epakte' of a year.
*
*   INPUTS
*    year     - For this year the 'Epakte' is calculatet.
*
*   RESULT
*    ep - The 'Epakte' for the speified year.
*
*   EXAMPLE
*    ...
*    ep := GregorianEP(1994);
*    ...
*
*   NOTES
*    Use this only for 1582 to 4100!
*
*   BUGS
*    unknown.
*
*   SEE ALSO
*    GregorianGZ(),GEP()
*
*****************************************************************************
*
*
*)

 VAR
    ep    : SHORTCARD;

 BEGIN
   IF year >= 1582 THEN
     ep := ((GregorianGZ(year)-1)*11 + GEP(year)) MOD 30;
     IF ep = 0 THEN
       ep := 30;
     END;
     RETURN(ep);
   ELSE
     RETURN(31);
   END;
 END GregorianEP;


 PROCEDURE GregorianJHStartSB(century : SHORTCARD) : SHORTCARD;

(*
*****i* Date/GregorianJHStartSB *********************************************
*
*   NAME
*    GregorianJHStartSB -- Returns the 'Sonntagsbuchstabe' (V33)
*
*   SYNOPSIS
*    csb := GregorianJHStartSB(century);
*
*    PROCEDURE GregorianJHStartSB(century : SHORTCARD) : SHORTCARD;
*
*   FUNCTION
*    Returns start 'SB' for a century.
*
*   INPUTS
*    century - For this century the start 'SB' is calculatet.
*
*   RESULT
*    csb - The start 'SB' for the speified century.
*
*   EXAMPLE
*    ...
*    csb := GregorianJHStartSB(19);
*    ...
*
*   NOTES
*    Use this only for 15 to 31!
*
*   BUGS
*    unknown.
*
*   SEE ALSO
*
*
*****************************************************************************
*
*
*)

 VAR
    sb    : SHORTCARD;

 BEGIN
  IF century = 15 THEN
    RETURN(4);
  ELSE
    sb := GregorianJHStartSB(century-1);
    IF (century MOD 4) > 0 THEN
      INC(sb);
    END;
    sb := sb MOD 7;
    IF sb = 0 THEN
      sb := 7;
    END;
    RETURN(sb);
  END;
 END GregorianJHStartSB;


 PROCEDURE GregorianJHSB(year : CARDINAL) : SHORTCARD;

(*
*****i* Date/GregorianSB ****************************************************
*
*   NAME
*    GregorianJHSB -- Returns the 'Sonntagsbuchstabe' (V33)
*
*   SYNOPSIS
*    sb := GregorianJHSB(year);
*
*    PROCEDURE GregorianJHSB(year : CARDINAL) : SHORTCARD;
*
*   FUNCTION
*    Returns the start 'SB' for a century year.
*
*   INPUTS
*    year - For this century year the start 'SB' is calculatet.
*
*   RESULT
*    sb - The start 'SB' for the specified year.
*
*   EXAMPLE
*    ...
*    sb := GregorianJHSB(1994);
*    ...
*
*   NOTES
*    Use this only for 1583 to 3199!
*
*   BUGS
*    unknown.
*
*   SEE ALSO
*    GregorianLeapYear(),GregorianJHStartSB()
*
*****************************************************************************
*
*
*)

 BEGIN
  IF ((year MOD 100) = 0) AND (~GregorianLeapYear(INTEGER(year))) THEN
    RETURN(SHORTCARD(((year DIV 100) MOD 4) *2 +1));
  ELSE
    RETURN(GregorianJHStartSB(year DIV 100));
  END;
 END GregorianJHSB;


 PROCEDURE GregorianSB(year : CARDINAL) : SHORTCARD;

(*
*****i* Date/GregorianSB ****************************************************
*
*   NAME
*    GregorianSB -- Returns the 'Sonntagsbuchstabe' (V33)
*
*   SYNOPSIS
*    sb := GregorianSB(year);
*
*    PROCEDURE GregorianSB(year : CARDINAL) : SHORTCARD;
*
*   FUNCTION
*    Returns the 'SB' for a year.
*
*   INPUTS
*    year - For this year the 'SB' is calculatet.
*
*   RESULT
*    sb - The 'SB' for the speified year.
*        This means the day the first sunday lies on :)
*
*   EXAMPLE
*    ...
*    sb := GregorianSB(1994);
*    ...
*
*   NOTES
*    Use this only for 1583 to 3199!
*
*   BUGS
*    unknown.
*
*   SEE ALSO
*    GregorianLeapYear(),GregorianSZ(),GregorianJHStartSB()
*
*****************************************************************************
*
*
*)

 VAR
    sz,csb,i    : SHORTCARD;

 BEGIN
   IF ((year MOD 100) = 0) AND (~GregorianLeapYear(INTEGER(year))) THEN
     RETURN(SHORTCARD(((year DIV 100) MOD 4) *2 +1));
   ELSE
     sz := GregorianSZ(year);
     csb := GregorianJHStartSB(year DIV 100);
     IF sz = 28 THEN
       RETURN(csb);
     ELSE
       FOR i := 27 TO sz BY -1 DO
         INC(csb);
         IF csb = 8 THEN
           csb := 1;
         END;
         IF ((i-1) MOD 4) = 0 THEN
           INC(csb);
           IF csb = 8 THEN
             csb := 1;
           END;
         END;
       END;
       RETURN(csb);
     END;
   END;
 END GregorianSB;

 (* ----------------------------------------------------------------------- *)

 PROCEDURE GregorianMoonAge(day,month : SHORTCARD; year : INTEGER) : SHORTCARD;

(*
******* Date/GregorianMoonAge ***********************************************
*
*   NAME
*    GregorianMoonAge -- Returns the age of the moon (V33)
*
*   SYNOPSIS
*    ep := GregorianMoonAge(day,month,year);
*
*    PROCEDURE GregorianMoonAge(day,month : SHORTCARD;
*        year : CARDINAL) : SHORTCARD;
*
*   FUNCTION
*    Returns the age of the moon on a specified date.
*
*   INPUTS
*    day   - For this day the age is calculated.
*    month - For this month the age is calculated.
*    year  - For this year the age is calculated.
*
*   RESULT
*    ep - The age of the moon on the specified date.
*
*   EXAMPLE
*    ...
*    ep := GregorianMoonAge(18,9,1994);
*    ...
*
*   NOTES
*    Use this only for 1582 to 4100!
*    This is only a experimental version!
*
*   BUGS
*    unknown.
*
*   SEE ALSO
*    MoonMonthAge(),GregorianEP()
*
*****************************************************************************
*
*
*)

   PROCEDURE MoonMonthAge(month,ep : SHORTCARD) : SHORTCARD;

(*
*****i* Date/MoonMonthAge ***************************************************
*
*   NAME
*    MoonMonthAge -- Calculates the age of the moon on month start (V33)
*
*   SYNOPSIS
*    ep := MoonMonthAge(month,ep);
*
*    PROCEDURE MoonMonthAge(month,ep : SHORTCARD) : SHORTCARD;
*
*   FUNCTION
*    Returns the age of the moon on the start of a month.
*
*   INPUTS
*    month - Month for which the moonage is needed.
*    ep    - 'Epakte' of the newyears-day.
*
*   RESULT
*    ep - The moonage on the 1. of the specified month.
*
*   EXAMPLE
*    ...
*    ep := MoonMonthAge(2,17); (* 17 is for 1994 *)
*    ...
*
*   NOTES
*    This is only a experimental version!
*
*   BUGS
*    unknown.
*
*   SEE ALSO
*    GregorianMonthDays()
*
*****************************************************************************
*
*
*)

   BEGIN
     IF month = 1 THEN
       RETURN(ep);
     ELSE
       IF month MOD 2 = 0 THEN
         ep := (MoonMonthAge(month-1,ep) + GregorianMonthDays(month-1,year)) MOD 29;
       ELSE
         ep := (MoonMonthAge(month-1,ep) + GregorianMonthDays(month-1,year)) MOD 30;
       END;
       RETURN(ep);
     END;
   END MoonMonthAge;

 VAR
    ep    : SHORTCARD;

 BEGIN
   ep := GregorianEP(year);
   ep := MoonMonthAge(month,ep);
   ep := ep + day -1;
   IF month > 1 THEN
     IF month MOD 2 = 0 THEN
       ep := ep MOD 30;
       IF ep = 0 THEN
         ep := 30;
       END;
     ELSE
       ep := ep MOD 29;
       IF ep = 0 THEN
         ep := 29;
       END;
     END;
   ELSE
     IF ep > 29 THEN
       ep := ep MOD 29;
     END;
   END;
   RETURN(ep);
 END GregorianMoonAge;

 (* ----------------------------------------------------------------------- *)
(*
 PROCEDURE GregorianEasterOld(year : INTEGER; VAR dday,dmonth : SHORTCARD);

(*
*****i* Date/GregorianEaster ************************************************
*
*   NAME
*    GregorianEaster -- Returns the date of eastern in a year (V33)
*
*   SYNOPSIS
*    GregorianEaster(year,dday,dmonth);
*
*    PROCEDURE GregorianEaster(year : INTEGER;
*        VAR dday,dmonth : SHORTCARD);
*
*   FUNCTION
*    Returns the date of eastern for a specified year.
*
*   INPUTS
*    year  - eastern is calculated for this year
*
*   RESULT
*    dday   - day of easter-sunday
*    dmonth - month of easter-sunday
*
*   EXAMPLE
*    ...
*    GregorianEaster(1994,dday,dmonth);
*    ...
*
*   NOTES
*    Use this only for 1582 to 4100!
*    This is only a experimental version!
*
*   BUGS
*    In some years eastern lies one week behind!
*
*   SEE ALSO
*    GregorianMoonAge(),GregorianDaysAfterWeekday()
*
*****************************************************************************
*
*
*)

 VAR
    ep    : SHORTCARD;

 BEGIN
   dday := 21;
   dmonth := 3;
   ep := GregorianMoonAge(21,3,year);
   IF ep < 14 THEN
     dday := dday + (14-ep);
   ELSE
     dday := dday + (29-ep) + 13;
   END;
   IF dday > 31 THEN
     dday := dday - 31;
     INC(dmonth);
   END;
   dday := dday + GregorianDaysAfterWeekday(dday,dmonth,year,sunday);
   IF dday > 31 THEN
     dday := dday - 31;
     INC(dmonth);
   END;
 END GregorianEasterOld;
*)

 PROCEDURE GregorianEaster(year : INTEGER; VAR dday,dmonth : SHORTCARD);

(*
******* Date/GregorianEaster ************************************************
*
*   NAME
*    GregorianEaster -- Returns the date of eastern in a year (V33)
*
*   SYNOPSIS
*    GregorianEaster(year,dday,dmonth);
*
*    PROCEDURE GregorianEaster(year : INTEGER;
*        VAR dday,dmonth : SHORTCARD);
*
*   FUNCTION
*    Returns the date of eastern for a specified year.
*
*   INPUTS
*    year  - eastern is calculated for this year
*
*   RESULT
*    dday   - day of easter-sunday
*    dmonth - month of easter-sunday
*
*   EXAMPLE
*    ...
*    GregorianEaster(1994,dday,dmonth);
*    ...
*
*   NOTES
*    Use this only for 1900 to 2099!
*    Tested for 1977-1994! But this formula is from Gauß - so it must be
*    correct :)
*
*   BUGS
*    None.
*
*   SEE ALSO
*    GEP(),GregorianJHSB()
*
*****************************************************************************
*
*
*)

 VAR
     a,d,e,f    : SHORTCARD;
     M,N    : SHORTINT;

 BEGIN
   M := SHORTINT(30 - GEP(year)) - 7;
   IF M < 0 THEN
     M := M + 30;
   END;
   N := GregorianJHSB(year)-2;
   IF N < 1 THEN
     N := N + 7;
   END;
   a := SHORTCARD(year MOD 19);
   d := SHORTCARD((19*CARDINAL(a)+SHORTCARD(M)) MOD 30);
   e := SHORTCARD((2*CARDINAL(year MOD 4)+4*CARDINAL(year MOD 7)+6*CARDINAL(d)+SHORTCARD(N)) MOD 7);
   f := d+e;
   IF f < 10 THEN (* märz *)
     dmonth := 3;
     dday := 22+f;
   ELSE (* april *)
     dmonth := 4;
     dday := f-9;
     IF dday=26 THEN
       dday := 19;
     ELSIF (dday=25) AND (d=28) AND (a>10) THEN
       dday := 18;
     END;
   END;
 END GregorianEaster;

 (* ----------------------------------------------------------------------- *)

 PROCEDURE TimeZoneFactor(degree : SHORTINT) : SHORTINT;

(*
******* Date/TimeZoneFactor *************************************************
*
*   NAME
*    TimeZoneFactor -- Returns the value you have to add to GMT time (V33)
*
*   SYNOPSIS
*    addhours := TimeZoneFactor(degrees);
*
*    PROCEDURE TimeZoneFactor(degree : SHORTINT) : SHORTINT;
*
*   FUNCTION
*    This gives you the hours you have to add to GMT time,
*    specified on the fact, that a timezone is 15 degrees
*    and that GMT is centered on 0 degrees!
*
*   INPUTS
*    degrees - Position of timezone you live in (from -180 to +180)
*
*   RESULT
*    addhours - Time to add to GMT time to get your locale zone time
*        (-12 to +12)
*
*   EXAMPLE
*    ...
*    addhours := TimeZoneFactor(-8);
*    ...
*
*   NOTES
*    none
*
*   BUGS
*    No errorcheck, if you put in valid degrees (-180 to +180)
*    Only full degrees are supportet, keep sure that you
*    round in the right way for 0.x degree places
*    I am not sure about the correct +/- behaviour!!!
*
*   SEE ALSO
*
*
*****************************************************************************
*
*
*)

 BEGIN
   IF degree >= 0 THEN
     RETURN(SHORTINT(REAL(degree) / 15.0 + 0.5));
   ELSE
     RETURN(SHORTINT(REAL(degree) / 15.0 - 0.5));
   END;
 END TimeZoneFactor;


 PROCEDURE LMT(secs : LONGCARD; meridiandegree, posdegree : REAL) : LONGINT;

(*
******* Date/LMT ************************************************************
*
*   NAME
*    LMT -- Calculates your local time in your timezone (V33)
*
*   SYNOPSIS
*    secs := LMT(secs,meridian,pos);
*
*    PROCEDURE LMT(secs : LONGCARD; meridiandegree,
*        posdegree : REAL) : LONGINT;
*
*   FUNCTION
*    Calculates your Local Mean Time of you place!
*
*   INPUTS
*    secs     - Seconds of the running day (hours*3600+min*60+sec)
*    meridian - Degrees of your timezone-meridian
*    pos      - Degrees of your place
*
*   RESULT
*    secs - Local seconds of the running day
*
*   EXAMPLE
*    ...
*    secs := LMT(76080,15.0,8.923055556);
*    ...
*
*   NOTES
*    none
*
*   BUGS
*    No errorcheck, if you put in valid degrees (-180 to +180)
*
*   SEE ALSO
*
*
*****************************************************************************
*
*
*)

 BEGIN
   RETURN(LONGINT(secs) + LONGINT((meridiandegree / 15.0 - posdegree / 15.0)*3600.0));
 END LMT;


 PROCEDURE TimeToSec(hour,min,sec : SHORTCARD) : LONGCARD;

(*
******* Date/TimeToSec ******************************************************
*
*   NAME
*    TimeToSec -- Returns the time in seconds (V33)
*
*   SYNOPSIS
*    secs := TimeToSec(hour,min,sec);
*
*    PROCEDURE TimeToSec(hour,min,sec : SHORTCARD) : LONGCARD;
*
*   FUNCTION
*    Gives you back the time in seconds
*
*   INPUTS
*    hour - hours you want (0-23)
*    min  - minutes you want (0-59)
*    sec  - seconds you want (0-59)
*
*   RESULT
*    secs - Time in seconds
*
*   EXAMPLE
*    ...
*    secs := TimeToSec(21,15,00);
*    ...
*
*   NOTES
*    Don't forget to convert AM/PM time to 24h time!
*
*   BUGS
*    No errorcheck, if you use a valid time
*
*   SEE ALSO
*    SecToTime()
*
*****************************************************************************
*
*
*)

 BEGIN
   RETURN(LONGCARD(hour)*3600+LONGCARD(min)*60+sec);
 END TimeToSec;


 PROCEDURE SecToTime(secs : LONGCARD; VAR hour,min,sec : SHORTCARD);

(*
******* Date/SecToTime ******************************************************
*
*   NAME
*    SecToTime -- Returns the time from seconds (V33)
*
*   SYNOPSIS
*    SecToTime(secs,hour,min,sec);
*
*    PROCEDURE SecToTime(secs : LONGCARD; VAR hour,min,sec : SHORTCARD);
*
*   FUNCTION
*    Gives you back the time from the specified seconds
*
*   INPUTS
*    secs - Time in seconds
*
*   RESULT
*    hour - hours (0-23)
*    min  - minutes (0-59)
*    sec  - seconds (0-59)
*
*   EXAMPLE
*    ...
*    SecToTime(76860,hour,min,sec);
*    ...
*
*   NOTES
*    Don't forget to convert 24h time to AM/PM time if needed!
*
*   BUGS
*    No errorcheck, if you use a valid time
*
*   SEE ALSO
*    TimeToSec()
*
*****************************************************************************
*
*
*)

 BEGIN
   hour := SHORTCARD(secs DIV 3600);
   secs := secs - LONGCARD(hour) * 3600;
   min := SHORTCARD(secs DIV 60);
   sec := SHORTCARD(secs - min * 60);
 END SecToTime;

 (* ----------------------------------------------------------------------- *)

 PROCEDURE JulianWeek(day,month : SHORTCARD; year : INTEGER) : SHORTCARD;

(*
******* Date/JulianWeek *****************************************************
*
*   NAME
*    JulianWeek -- Gets the weeknumber of a specified date. (V33)
*
*   SYNOPSIS
*    weeknr := JulianWeek(day,month,year);
*
*    PROCEDURE JulianWeek(day,month : SHORTCARD;
*        year : INTEGER) : SHORTCARD;
*
*   FUNCTION
*    JulianWeek gets the weeknumber for a specified date.
*
*   INPUTS
*    day   - day of the date
*    month - month of the date
*    year  - year of the date
*
*   RESULT
*    week - This is the number of the week the specified date lies in.
*        If the first day in a new year is a freiday, saturday or
*        sunday, this would be the last week of the last year!
*        If the 29.12. is a monday, the 30.12. is a monday or a tuesday,
*        the 31.12. is a monday, tuesday or a wednesday this is the
*        first week of the next year!
*
*   EXAMPLE
*    ...
*    weeknr := JulianWeek(4,10,1582);
*    ...
*
*   NOTES
*    Its is better only to use this function for years from 0 to 1582!
*
*   BUGS
*    For years < 0 errors could occur.
*
*   SEE ALSO
*    GregorianWeek(),HeisWeek(),JulianWeekday(),JulianDaySmaller(),
*    JulianDayDiff()
*
*****************************************************************************
*
*
*)

 TYPE
    Wds    = SET OF Weekdays;

 VAR
    days        : LONGINT;
    firstweekday    : Weekdays;

 BEGIN
   firstweekday := JulianWeekday(1,1,year);
   days := (JulianDayDiff(1,1,year,day,month,year) + LONGINT(firstweekday) -1) DIV 7;
   IF firstweekday > thursday THEN
     IF days = 0 THEN
       days := JulianWeek(31,12,year-1);
     END;
     RETURN(SHORTCARD(days));
   ELSE
     IF ~JulianDaySmaller(day,month,year,29,12,year) THEN
       firstweekday := JulianWeekday(day,12,year);
       CASE day OF
         29 : IF firstweekday = monday THEN
                days := 0;
              END;|
         30 : IF firstweekday IN Wds{monday,tuesday} THEN
                days := 0;
              END;|
         31 : IF firstweekday IN Wds{monday,tuesday,wednesday} THEN
                days := 0;
              END;
       ELSE
       END;
     END;
     RETURN(SHORTCARD(days +1));
   END;
 END JulianWeek;


 PROCEDURE GregorianWeek(day,month : SHORTCARD; year : INTEGER) : SHORTCARD;

(*
******* Date/GregorianWeek **************************************************
*
*   NAME
*    GregorianWeek -- Gets the weeknumber of a specified date. (V33)
*
*   SYNOPSIS
*    weeknr := GregorianWeek(day,month,year);
*
*    PROCEDURE GregorianWeek(day,month : SHORTCARD;
*        year : INTEGER) : SHORTCARD;
*
*   FUNCTION
*    GregorianWeek gets the weeknumber for a specified date.
*
*   INPUTS
*    day   - day of the date
*    month - month of the date
*    year  - year of the date
*
*   RESULT
*    week - This is the number of the week the specified date lies in.
*        If the first day in a new year is a freiday, saturday or
*        sunday, this would be the last week of the last year!
*        If the 29.12. is a monday, the 30.12. is a monday or a tuesday,
*        the 31.12. is a monday, tuesday or a wednesday this is the
*        first week of the next year!
*
*   EXAMPLE
*    ...
*    weeknr := GregorianWeek(4,10,1582);
*    ...
*
*   NOTES
*    Its is better only to use this function for years from 0 to 3000!
*
*   BUGS
*    For years < 0 errors could occur.
*
*   SEE ALSO
*    JulianWeek(),HeisWeek(),GregorianDaySmaller(),GregorianWeekday(),
*    GregorianDayDiff()
*
*****************************************************************************
*
*
*)

 TYPE
    Wds    = SET OF Weekdays;

 VAR
    days        : LONGINT;
    firstweekday    : Weekdays;

 BEGIN
   firstweekday := GregorianWeekday(1,1,year);
   days := (GregorianDayDiff(1,1,year,day,month,year) + LONGINT(firstweekday) -1) DIV 7;
   IF firstweekday > thursday THEN
     IF days = 0 THEN
       days := GregorianWeek(31,12,year-1);
     END;
     RETURN(SHORTCARD(days));
   ELSE
     IF ~GregorianDaySmaller(day,month,year,29,12,year) THEN
       firstweekday := GregorianWeekday(day,12,year);
       CASE day OF
         29 : IF firstweekday = monday THEN
                days := 0;
              END;|
         30 : IF firstweekday IN Wds{monday,tuesday} THEN
                days := 0;
              END;|
         31 : IF firstweekday IN Wds{monday,tuesday,wednesday} THEN
                days := 0;
              END;
       ELSE
       END;
     END;
     RETURN(SHORTCARD(days +1));
   END;
 END GregorianWeek;


 PROCEDURE HeisWeek(day,month : SHORTCARD; year : INTEGER) : SHORTCARD;

(*
******* Date/HeisWeek *******************************************************
*
*   NAME
*    HeisWeek -- Gets the weeknumber of a specified date. (V33)
*
*   SYNOPSIS
*    weeknr := HeisWeek(day,month,year);
*
*    PROCEDURE HeisWeek(day,month : SHORTCARD;
*        year : INTEGER) : SHORTCARD;
*
*   FUNCTION
*    HeisWeek gets the weeknumber for a specified date.
*
*   INPUTS
*    day   - day of the date
*    month - month of the date
*    year  - year of the date
*
*   RESULT
*    week - This is the number of the week the specified date lies in.
*        If the first day in a new year is a freiday, saturday or
*        sunday, this would be the last week of the last year!
*        If the 29.12. is a monday, the 30.12. is a monday or a tuesday,
*        the 31.12. is a monday, tuesday or a wednesday this is the
*        first week of the next year!
*
*   EXAMPLE
*    ...
*    weeknr := HeisWeek(4,10,1582);
*    ...
*
*   NOTES
*    Its is better only to use this function for years from 0 to 8000!
*
*   BUGS
*    For years < 0 errors could occur.
*
*   SEE ALSO
*    JulianWeek(),GregorianWeek(),HeisDayDiff(),HeisDaySmaller(),
*    HeisWeekday()
*
*****************************************************************************
*
*
*)

 TYPE
    Wds    = SET OF Weekdays;

 VAR
    days        : LONGINT;
    firstweekday    : Weekdays;

 BEGIN
   firstweekday := HeisWeekday(1,1,year);
   days := (HeisDayDiff(1,1,year,day,month,year) + LONGINT(firstweekday) -1) DIV 7;
   IF firstweekday > thursday THEN
     IF days = 0 THEN
       days := HeisWeek(31,12,year-1);
     END;
     RETURN(SHORTCARD(days));
   ELSE
     IF ~HeisDaySmaller(day,month,year,29,12,year) THEN
       firstweekday := HeisWeekday(day,12,year);
       CASE day OF
         29 : IF firstweekday = monday THEN
                days := 0;
              END;|
         30 : IF firstweekday IN Wds{monday,tuesday} THEN
                days := 0;
              END;|
         31 : IF firstweekday IN Wds{monday,tuesday,wednesday} THEN
                days := 0;
              END;
       ELSE
       END;
     END;
     RETURN(SHORTCARD(days +1));
   END;
 END HeisWeek;

 (* ----------------------------------------------------------------------- *)

 BEGIN
   (* Gregorian reform in Rom *)
   BeforeGregorianDay := 4;
   BeforeGregorianMonth := 10;
   BeforeGregorianYear := 1582;
   AfterGregorianDay := 15;
   AfterGregorianMonth := 10;
   AfterGregorianYear := 1582;
   StartHeisDay := 1;
   StartHeisMonth := 1;
   StartHeisYear := 3200;
   (* Dates of Gregorian reform in
      Deutschland, Niederlande, Schweiz, Dänemark:
        18.02.1700-01.03.1700
      Großbritannien
        02.09.1752-14.09.1752
      Schweden
        17.02.1753-01.03.1753
      Rußland
    ? (oktober Revolution)
      Griechenland
        ??.??.1923-??.??.1923 *)
   (* Bremen/Arbergen = 8° 55' 23" East, 53° 4' 8" North *)
 END Date.