[LISTING ONE]

PROGRAM ZelTest;  { From DDJ 10/90 }

CONST
  DayStrings : ARRAY[0..6] OF STRING =
  ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday');

VAR
  Month, Day, Year : Integer;


FUNCTION CalcDayOfWeek(Year,Month,Day : Integer) : Integer;

VAR
  Century,Holder : Integer;

BEGIN
  { First test for error conditions on input values: }
  IF (Year < 0)  OR
     (Month < 1) OR (Month > 12) OR
     (Day < 1)   OR (Day > 31) THEN
     CalcDayOfWeek := -1  { Return -1 to indicate an error }
  ELSE
    { Do the Zeller's Congruence calculation as Zeller himself }
    { described it in "Acta Mathematica" #7, Stockhold, 1887.  }
    BEGIN
      { First we separate out the year and the century figures: }
      Century := Year DIV 100;
      Year    := Year MOD 100;
      { Next we adjust the month such that March remains month #3, }
      {  but that January and February are months #13 and #14,     }
      {  *but of the previous year*: }
      IF Month < 3 THEN
        BEGIN
          Inc(Month,12);
          IF Year > 0 THEN Dec(Year,1)      { The year before 2000 is }
            ELSE                            { 1999, not 20-1...       }
              BEGIN
                Year := 99;
                Dec(Century);
              END
        END;

      { Here's Zeller's seminal black magic: }
      Holder := Day;                        { Start with the day of month }
      Holder := Holder + (((Month+1) * 26) DIV 10); { Calc the increment }
      Holder := Holder + Year;              { Add in the year }
      Holder := Holder + (Year DIV 4);      { Correct for leap years  }
      Holder := Holder + (Century DIV 4);   { Correct for century years }
      Holder := Holder - Century - Century; { DON'T KNOW WHY HE DID THIS! }
      WHILE Holder < 0 DO                   { Get negative values up into }
        Inc(Holder,7);                      { positive territory before   }
                                            { taking the MOD...         }
      Holder := Holder MOD 7;               { Divide by 7 but keep the  }
                                            { remainder rather than the }
                                            { quotient }

      { Here we "wrap" Saturday around to be the last day: }
      IF Holder  = 0 THEN Holder := 7;

      { Zeller kept the Sunday = 1 origin; computer weenies prefer to }
      { start everything with 0, so here's a 20th century kludge:     }
      Dec(Holder);

      CalcDayOfWeek := Holder;  { Return the end product! }
    END;
END;

BEGIN
  Write('Month (1-12): '); Readln(Month);
  Write('Day   (1-31): '); Readln(Day);
  Write('Year        : '); Readln(Year);
  Writeln('The day of the week is ',
           DayStrings[CalcDayOfWeek(Year,Month,Day)]);
  Readln;
END.

[LISTING TWO]

(*----------------------------------------------------*)
(*                     TIMEDATE                       *)
(*                                                    *)
(* A Time-and-date stamp object for TopSpeed Modula-2 *)
(*                                                    *)
(*                           Definition module        *)
(*                           TopSpeed Modula-2 V2.0   *)
(*                           by Jeff Duntemann        *)
(*                           Last update 6/1/90       *)
(*                                                    *)
(*----------------------------------------------------*)

DEFINITION MODULE TimeDate;

TYPE
  String9  = ARRAY[0..9]  OF CHAR;
  String20 = ARRAY[0..20] OF CHAR;
  String50 = ARRAY[0..50] OF CHAR;

  WhenUnion =
    RECORD
      CASE  : BOOLEAN OF
        TRUE  : FullStamp : LONGCARD; |
        FALSE : TimePart  : CARDINAL;
                DatePart  : CARDINAL
      END;
    END;

  When =
    CLASS
      WhenStamp      : WhenUnion;       (* Combined time/date stamp *)
      TimeString     : String9;         (* i.e., "12:45a"           *)
      Hours,Minutes,Seconds : CARDINAL; (* Seconds is always even!  *)
      DateString     : String20;        (* i.e., "06/29/89"         *)
      LongDateString : String50;        (* i.e., "Thursday, June 29, 1989" *)
      Year,Month,Day : CARDINAL;
      DayOfWeek      : INTEGER;         (* 0=Sunday, 1=Monday, etc. *)
      PROCEDURE GetTimeStamp() : CARDINAL; (* Returns DOS-format time stamp *)
      PROCEDURE GetDateStamp() : CARDINAL; (* Returns DOS-format date dtamp *)
      PROCEDURE PutNow;
      PROCEDURE PutWhenStamp(NewWhen  : LONGCARD);
      PROCEDURE PutTimeStamp(NewStamp : CARDINAL);
      PROCEDURE PutDateStamp(NewStamp : CARDINAL);
      PROCEDURE PutNewDate(NewYear,NewMonth,NewDay : CARDINAL);
      PROCEDURE PutNewTime(NewHours,NewMinutes,NewSeconds : CARDINAL);
    END;

 END TimeDate.

[LISTING THREE]

(*----------------------------------------------------*)
(*                     TIMEDATE                       *)
(*                                                    *)
(* A Time-and-date stamp object for TopSpeed Modula-2 *)
(*                                                    *)
(*                           Implementation module    *)
(*                           TopSpeed Modula-2 V2.0   *)
(*                           by Jeff Duntemann        *)
(*                           Last update 6/16/90      *)
(*                                                    *)
(*----------------------------------------------------*)

IMPLEMENTATION MODULE TimeDate;

FROM FIO     IMPORT GetCurrentDate;
FROM Str     IMPORT CardToStr,Concat,IntToStr,Length,Slice;
FROM Bitwise IMPORT And,Or;  (* From DDJ for March 1990 *)

TYPE
  TMonthTags = ARRAY [1..12] OF String9;
  TDayTags   = ARRAY [0..6]  OF String9;


VAR
  Temp1 : String50;
  Dummy : CARDINAL;
  DayTags : TDayTags;
  MonthTags : TMonthTags;


PROCEDURE CalcTimeStamp(Hours,Minutes,Seconds : CARDINAL) : CARDINAL;

BEGIN
  RETURN Or(Or((Hours << 11),(Minutes << 5)),(Seconds >> 1));
END CalcTimeStamp;


PROCEDURE CalcDateStamp(Year,Month,Day : CARDINAL) : CARDINAL;

BEGIN
  RETURN Or(Or(((Year - 1980) << 9),(Month << 5)),Day);
END CalcDateStamp;


PROCEDURE CalcTimeString(VAR TimeString : String9;
                         Hours,Minutes,Seconds : CARDINAL);

VAR
  Temp1,Temp2 : String9;
  AMPM        : CHAR;
  I           : INTEGER;
  OK          : BOOLEAN;

BEGIN
  I := Hours;
  IF Hours = 0 THEN I := 12; END;   (* "0" hours = 12am *)
  IF Hours > 12 THEN I := Hours - 12; END;
  IF Hours > 11 THEN AMPM := 'p' ELSE AMPM := 'a'; END;
  IntToStr(LONGINT(I),Temp1,10,OK);
  IntToStr(LONGINT(Minutes),Temp2,10,OK);
  IF Length(Temp2) < 2 THEN Concat(Temp2,'0', Temp2); END;
  Concat(TimeString,Temp1,':');
  Concat(TimeString,TimeString,Temp2);
  Concat(TimeString,TimeString,AMPM);
END CalcTimeString;


PROCEDURE CalcDateString(VAR DateString : String20;
                         Year,Month,Day : CARDINAL);

VAR
  OK : BOOLEAN;

BEGIN
  CardToStr(LONGCARD(Month),DateString,10,OK);
  CardToStr(LONGCARD(Day),Temp1,10,OK);
  Concat(DateString,DateString,'/');
  Concat(DateString,DateString,Temp1);
  CardToStr(LONGCARD(Year),Temp1,10,OK);
  Concat(DateString,DateString,'/');
  Slice(Temp1,Temp1,3,2);
  Concat(DateString,DateString,Temp1);
END CalcDateString;


PROCEDURE CalcLongDateString(VAR LongDateString : String50;
                             Year,Month,Date,DayOfWeek : CARDINAL);
VAR
  Temp1 : String9;
  OK    : BOOLEAN;

BEGIN
  Concat(LongDateString,DayTags[DayOfWeek],', ');
  CardToStr(LONGCARD(Date),Temp1,10,OK);
  Concat(LongDateString,LongDateString,MonthTags[Month]);
  Concat(LongDateString,LongDateString,' ');
  Concat(LongDateString,LongDateString,Temp1);
  Concat(LongDateString,LongDateString,', ');
  CardToStr(LONGCARD(Year),Temp1,10,OK);
  Concat(LongDateString,LongDateString,Temp1);
END CalcLongDateString;


(*---------------------------------------------------------------------*)
(* This calculates a day of the week figure, where 0=Sunday, 1=Monday, *)
(* and so on, given the year, month, and day.  The year must be passed *)
(* in full; that is, "1990" not just "90".  Another century is at hand,*)
(* gang...                                                             *)
(*---------------------------------------------------------------------*)

PROCEDURE CalcDayOfWeek(Year,Month,Day : INTEGER) : INTEGER;

VAR
  Century,Holder : INTEGER;

BEGIN
  (* First test for error conditions on input values: *)
  IF (Year < 0)  OR
     (Month < 1) OR (Month > 12) OR
     (Day < 1)   OR (Day > 31)
  THEN
    RETURN -1  (* Return -1 to indicate an error *)
  ELSE
    (* First we separate out the year and century figures: *)
    Century := Year DIV 100;
    Year    := Year MOD 100;
    (* Next we adjust the month such that March remains #3,   *)
    (*  but that January and February are months #13 and #14, *)
    (*  *but of the previous year.*                           *)
    IF Month < 3 THEN
      INC(Month,12);
      IF Year > 0 THEN DEC(Year,1)   (* 1900/2000 etc. ("year 0")    *)
        ELSE                         (* must be treated specially.   *)
          Year := 99;                (* You can't just decrement the *)
          DEC(Century)               (* year to -1...you must make   *)
        END;                         (* it year 99 of the previous   *)
    END;                             (* century.                     *)

    (* Here's Zeller's seminal black magic: *)
    Holder := Day;                             (* Start with the day *)
    Holder := Holder + (((Month+1) * 26) DIV 10);  (* Calc increment *)
    Holder := Holder + Year;                   (* Add in the year    *)
    Holder := Holder + (Year DIV 4);       (* Correct for leap years *)
    Holder := Holder + (Century DIV 4); (* Correct for century years *)
    Holder := Holder - Century - Century;  (* Take out century twice *)
    WHILE Holder < 0 DO     (* Avoid taking MOD of negative quantity *)
      INC(Holder,7);
    END;

    Holder := Holder MOD 7;    (* Take Modulo 7 of (positive) result *)

    (* Here we "wrap" Saturday around to be the last day: *)
    IF Holder = 0 THEN Holder := 7 END;

    (* Zeller kept the Sunday = 1 origin; computer weenies prefer to *)
    (* start everything with 0, so here's a 20th century kludge:     *)
    DEC(Holder);

    (* We've got it: Sunday = 0, Monday = 1, etc. Return the value:  *)
    RETURN Holder;
  END;  (* IF *)
END CalcDayOfWeek;


TYPE
  When =
    CLASS
      WhenStamp      : WhenUnion;       (* Combined time/date stamp *)
      TimeString     : String9;         (* i.e., "12:45a"           *)
      Hours,Minutes,Seconds : CARDINAL; (* Seconds is always even!  *)
      DateString     : String20;        (* i.e., "06/29/89"         *)
      LongDateString : String50;        (* i.e., "Thursday, June 29, 1989" *)
      Year,Month,Day : CARDINAL;
      DayOfWeek      : INTEGER;         (* 0=Sunday, 1=Monday, etc. *)

      (*---------------------------------------------------------------------*)
      (* There will be many times when an individual date or time stamp will *)
      (* be much more useful than a combined time/date stamp.  These simple  *)
      (* functions return the appropriate half of the combined long integer  *)
      (* time/date stamp without incurring any calculation overhead.  It's   *)
      (* done with a simple value typecast:                                  *)
      (*---------------------------------------------------------------------*)

      PROCEDURE GetTimeStamp() : CARDINAL;

      BEGIN
        RETURN WhenStamp.TimePart;
      END GetTimeStamp;


      PROCEDURE GetDateStamp() : CARDINAL;

      BEGIN
        RETURN WhenStamp.DatePart;
      END GetDateStamp;


      (*---------------------------------------------------------------------*)
      (* To fill a When record with the current time and date as maintained  *)
      (* by the system clock, execute this method:                           *)
      (*---------------------------------------------------------------------*)

      PROCEDURE PutNow;

      BEGIN
        (* Get current time and date from the system: *)
        WhenStamp.FullStamp := GetCurrentDate();
        (* Calculate a new time stamp and update object fields: *)
        PutTimeStamp(WhenStamp.TimePart);
        (* Calculate a new date stamp and update object fields: *)
        PutDateStamp(WhenStamp.DatePart);
      END PutNow;


      (*---------------------------------------------------------------------*)
      (* This method allows us to apply a whole long integer time/date stamp *)
      (* to the When object.  The object divides the stamp into time and     *)
      (* date portions and recalculates all other fields in the object.      *)
      (*---------------------------------------------------------------------*)

      PROCEDURE PutWhenStamp(NewWhen  : LONGCARD);

      BEGIN
        WhenStamp.FullStamp := NewWhen;
        (* We've actually updated the stamp proper, but we use the two *)
        (* "put" routines for time and date to generate the individual *)
        (* field and string representation forms of the time and date. *)
        (* I know that the "put" routines also update the long integer *)
        (* stamp, but while unnecessary it does no harm.               *)
        PutTimeStamp(WhenUnion(WhenStamp).TimePart);
        PutDateStamp(WhenUnion(WhenStamp).DatePart);
      END PutWhenStamp;


      (*---------------------------------------------------------------------*)
      (* We can choose to update only the time stamp, and the object will    *)
      (* recalculate only its time-related fields.                           *)
      (*---------------------------------------------------------------------*)

      PROCEDURE PutTimeStamp(NewStamp : CARDINAL);

      BEGIN
        WhenUnion(WhenStamp).TimePart := NewStamp;
        (* The time stamp is actually a bitfield, and all this shifting left *)
        (* and right is just extracting the individual fields from the stamp:*)
        Hours := NewStamp >> 11;

        Minutes := And((NewStamp >> 5),3FH);
        Seconds := And((NewStamp << 1),1FH);
        (* Derive a string version of the time: *)
        CalcTimeString(TimeString,Hours,Minutes,Seconds);
      END PutTimeStamp;


      (*---------------------------------------------------------------------*)
      (* Or, we can choose to update only the date stamp, and the object     *)
      (* will then recalculate only its date-related fields.                 *)
      (*---------------------------------------------------------------------*)

      PROCEDURE PutDateStamp(NewStamp : CARDINAL);

      BEGIN
        WhenUnion(WhenStamp).DatePart := NewStamp;
        (* Again, the date stamp is a bit field and we shift the values out  *)
        (* of it: *)
        Year  := (NewStamp >> 9) + 1980;
        Month := And((NewStamp >> 5),0FH);
        Day   := And(NewStamp,1FH);
        (* Calculate the day of the week value using Zeller's Congruence:    *)
        DayOfWeek := CalcDayOfWeek(Year,Month,Day);
        (* Calculate the short string version of the date; as in "06/29/89": *)
        CalcDateString(DateString,Year,Month,Day);
        (* Calculate a long version, as in "Thursday, June 29, 1989": *)
        CalcLongDateString(LongDateString,Year,Month,Day,DayOfWeek);
      END PutDateStamp;


      PROCEDURE PutNewDate(NewYear,NewMonth,NewDay : CARDINAL);

      BEGIN
        (* The "boss" field is the date stamp.  Everything else is figured *)
        (* from the stamp, so first generate a new date stamp, and then    *)
        (* (odd as it may seem) regenerate everything else, *including*    *)
        (* the Year, Month, and Day fields: *)
        PutDateStamp(CalcDateStamp(NewYear,NewMonth,NewDay));
        (* Calculate the short string version of the date; as in "06/29/89": *)
        CalcDateString(DateString,Year,Month,Day);
        (* Calculate a long version, as in "Thursday, June 29, 1989": *)
        CalcLongDateString(LongDateString,Year,Month,Day,DayOfWeek);
      END PutNewDate;


      PROCEDURE PutNewTime(NewHours,NewMinutes,NewSeconds : CARDINAL);

      BEGIN
        (* The "boss" field is the time stamp.  Everything else is figured *)
        (* from the stamp, so first generate a new time stamp, and then    *)
        (* (odd as it may seem) regenerate everything else, *including*    *)
        (* the Hours, Minutes, and Seconds fields: *)
        PutTimeStamp(CalcTimeStamp(NewHours,NewMinutes,NewSeconds));
        (* Derive the string version of the time: *)
        CalcTimeString(TimeString,Hours,Minutes,Seconds);
      END PutNewTime;

    END;  (* ...of CLASS When implementation *)



BEGIN   (* Initialization code for TimeDate goes here: *)
  MonthTags :=
    TMonthTags('January','February','March','April','May','June','July',
               'August','September','October','November','December');
  DayTags := TDayTags('Sunday','Monday','Tuesday','Wednesday',
                      'Thursday','Friday','Saturday');
END TimeDate.

Examplå 1º Evaluatinç thå expressioî foò thå Gregoriaî calendar

    (m + 1) * 26        K     J
q + ------------ + K + --- + --- - 2*J
        10              4     4

Examplå 2º Thå twï endó oæ definitioîó arå bracketed 

TYPE When = 
       CLASS
         (* All data field defintions *)
         (* are fully re-stated here. *)
         
         (* The full method imple-    *)
         (* mentations, including     *)
         (* bodies, are given here.   *)

Š       END;