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;



  3 Responses to “Category : Modula II Source Code
Archive   : ZELLER.ZIP
Filename : ZELTEST.ASC

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/