Category : Modula II Source Code
Archive   : ZELLER.ZIP
Filename : ZELTEST.ASC

 
Output of file : ZELTEST.ASC contained in archive : ZELLER.ZIP

[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.

Example 1: Evaluating the expression for the Gregorian calendar

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

Example 2: The two ends of definitions are bracketed

TYPE When =
CLASS
(* All data field defintions *)
(* are fully re-stated here. *)

(* The full method imple- *)
(* mentations, including *)
(* bodies, are given here. *)

END;