Dr. Dobb's is part of the Informa Tech Division of Informa PLC

This site is operated by a business or businesses owned by Informa PLC and all copyright resides with them. Informa PLC's registered office is 5 Howick Place, London SW1P 1WG. Registered in England and Wales. Number 8860726.


Channels ▼
RSS

.NET

Structured Programming


OCT90: STRUCTURED PROGRAMMING

Sex and Algorithms

Regardless of obvious empirical evidence as close as any mirror, the fact that our parents had sex often astonishes us. Sex is something we invented, after all -- nothing so dangerous, messy, or purely delightful could be more than a few years old.

(And the circle is unbroken. All over America, balding and crow-footed exhippies are trying earnestly to explain human reproduction to their nearly-pubescent children, who then can only exclaim, "You mean you and Daddy did that?!?! Eeeeee-yukkh!")

I realized recently that I had been guilty of a similar sort of chauvinism when I made use of a day-of-the-week function someone had given me in Pascal/MT+ for CP/M-80 almost ten years back. The algorithm involved was called "Zeller's Congruence," and was as totally opaque to me as the window of a Congressman's limo. Regular readers of this column might remember a note tucked into the comments of my "when stamp" object presented in the April 1990 installment:

"Note that this particular algorithm turns into a pumpkin in 2000. BTW, don't ask me to explain how this crazy thing works. I haven't the foggiest notion. If I ever meet Mr. Zeller, I'll ask him."

I was not being facetious. I pictured Zeller as a distinguished grey-bearded researcher in the CS department at MIT, Yale, or some other exalted institution of higher learning, with a Unix terminal on his desk, and lifetime tenure. I figured I might in fact meet him at a conference or seminar, and I really did intend to ask him how his crazy software gizmo pulled dates out of the air.

Sadly, I won't get the chance. Herr Zeller has been dead for almost a hundred years. On learning that, my first thought was, "Cripes! He didn't even have a computer! How could he possibly have come up with an algorithm?"

You mean people were doing algorithms in 1887? Eeeee-yukkh!

Back to the Source

They were indeed. And just as we used to make numbers in the pre-calculator era by rubbing two sticks together, people managed some amazing mathematical feats in times past with nothing more than pencil, paper, and persistence. Zeller was one, and at least one of his numerical recipes has come to dominate its niche in the software ecosphere.

There are some problems. Several mutant versions of Zeller's Congruence are kicking around. All are utterly opaque, and some of them work better than others. This bothered me, since my own copy ceased to work correctly as of January 1, 2000. Because I didn't know how it worked, I couldn't even begin to try to fix it.

I would have left it at that, but for the help of my friend Hugh Kenner, who did what any good researcher would do and went right to the source. The source was a paper published in German by Zeller in "Acta Mathematica" #7, Stockholm, 1887. Hugh translated the essence of the very brief paper for me, and I implemented it in both Pascal and Modula-2.

The Expression from Hell

I find it a little strange that the current versions of Zeller that I have seen differ so thoroughly from the original recipe. Most versions you see today revolve around a very strange expression ripe with floating-point values:

  Trunc(Int(2.6 * Month - 0.2))

Not only does this seem utterly arbitrary, I don't trust it. I distrust integer-output algorithms that use floating-point constants like this internally, because differences in the way compilers and computers handle floating-point values can easily cause the output to be off by one.

And most remarkably, Zeller used no such floating-point constants in his paper. As simply as I can put it, Zeller laid out the algorithm like this:

Given: J = Century (e.g. 19) K = Year (e.g. 90) q = Day of the month m = Month, but with a twist: March is still month #3, but January and February are considered months #13 and #14, but of the previous year. In other words, if you're going to calculate a day of the week value for a date in January of 1990, you must call the month #13 and the year 89.

Assuming the Gregorian calendar, we evaluate the expression in Example 1. We then divide the value of the expression by 7 and use the remainder as the index of the day of the week, with 1 = Sunday and 2 = Monday, and so on.

Example 1: Evaluating the expression for the Gregorian calendar.

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

No floating-point constants. Now while it's true that division introduces remainders into the calculation such that it's not truly an integer operation, Zeller himself (in the example he used to illustrate his algorithm) simply took the dividend in each term and ignored the remainder. This is the equivalent of using the DIV operator in Pascal and Modula-2. Look, Ma, no real numbers!

Almost Comprehensible

What I've shown you is how it's done. Zeller says very little in his paper about how it works. In broad terms, the algorithm describes how the day of the week advances. Most people realize that for every year, the day of the week for a given day generally advances by 1; that is, June 29 is on a Friday in 1990, but it will be on a Saturday in 1991. Other things, however, can alter this advance of the day of the week. In 1992, June 29 will be on a Monday rather than the expected Sunday -- because 1992 is a leap year, and the extra day in February pushes things ahead by one additional day.

So it's easy to understand the K term, since for every year the day of the week advances by one. Ditto the K/4 term, which tosses in an extra day every four years, and the J/4 term, which tosses in an extra day every four hundred years, when the "century year" leap year that is ordinarily skipped is instead observed. (1700, 1800, and 1900 were not leap years; however, 1600 and 2000 are.) The day of the month term q advances the value from the start of the month.

The peculiar term (m+1)*26/10 advances the count to the start of the given month. The term (which is in fact the single most right-brainedly brilliant part of the whole shebang) compensates for the fact that the months have different numbers of days in them. The twist in the month numbering (that part about making January and February months 13 and 14 instead of 1 and 2) serves the Expression from Hell by putting the most pathological month of all (February) at the end of everything. This allows the oscillations of the leap years to be accounted for elsewhere in the expression, since the (m+1)*26/10 term only takes you to the beginning of a given month. Variations in the length of February thus stay out of the (m+1)*26/10 term.

The one part of the calculation that I truly don't understand is the subtraction of the 2*J term. It's there. The algorithm doesn't work without it. So be it.

Pumpkin Problems

My own from-the-source implementation of Zeller is contained in the function CalcDayOfWeek in Listing One (page 149, which is little more than a frame allowing you to enter different dates to try it out. I encourage you to try to break it, and let me know if it breaks. So far it has worked for every date I've tried (comparing the produced day-of-the-week value against that shown in the Sidekick calendar).

Notice that I have implemented the calculation in a leisurely fashion, accumulating the sum in the intermediate variable Holder rather than rolling it all up again into something big and mathematical-looking. My purpose is to make the workings clearer, and because you wouldn't ever need to call this thing from inside a tight loop, the lack of performance shouldn't get in the way. Feel free to pass it through your own code-compactors if you like.

There was one infuriating detail left unmentioned by Zeller in his paper. For certain dates (mostly in March early in a given century) the result of the full expression comes out negative, because the 2*J term is greater than everything else taken together. For every date in which the expression went negative, the day of the week value was off by one. This was actually the reason my inherited implementation of Zeller turns into a pumpkin in the year 2000.

This sounded oddly familiar. I went back to my files and found a nice letter from Carl E. Ohlen of Corvallis, Oregon, pointing this out in the wake of my April column. Carl suggested that when the expression went negative I should add 7 to the expression until it became positive, and only then use the MOD 7 operation on it. I tried it. It works.

Zeller says nothing about such cases, but he was a mathematician and must have been aware of them. If anyone can explain this lapse, I'd like to hear it.

TopSpeed Modula-2 Objects

The Modula-2 implementation of Zeller's Congruence is embedded in Listing Three, page 149, which is my when stamp object implemented in Version 2.0 of TopSpeed Modula-2.

Objects are a natural in Modula-2. They are a natural refinement of the inherent modularity of the language, which has always bundled code and data together at the logistical level by placing them together in modules. A Modula-2 object is rather like a module turned into a data structure, with the addition of inheritance and late binding. At least that's a good place to start thinking of it if you have been on the sidelines watching Turbo Pascal give birth to objects in the structured programming world.

JPI has done an extremely good job implementing objects in Modula-2. What they have done is very close to the Turbo Pascal 5.5 object extensions in many ways. A good place to start is with Listing Two, page 149, which is the definition module for the module implementing the when stamp. The definition of type When is nearly identical to the definition of When in Turbo Pascal. The main difference is the use of the CLASS reserved word rather than the OBJECT reserved word. TopSpeed Modula-2 calls object types classes rather than object types, falling into line with Smalltalk, Actor, and C++. While I thought that the "object type" coinage was a good idea at first, I've reversed myself. Object types are classes. We should probably call them classes across the board. Calling an object type a class reduces the inevitable confusion between an object type and an object instance.

Where TopSpeed differs most from Turbo Pascal is in the implementation syntax. Turbo Pascal 5.5 uses a qualifier in the method header to indicate connection with a particular object definition:

  PROCEDURE When.PutNow;

TopSpeed Modula-2 simply enlarges the headers-only class definition given in the definition module to include the bodies of the methods. Everything is bracketed between the two ends of the definition (see Example 2). There is no qualifier on the method header. Because the method is fully implemented between When = CLASS and END, the compiler always knows to which class a method implementation belongs.

Example 2: The two ends of definitions are bracketed.

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

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

         END;

In a reflection of Modula-2's module structure, class definitions minus method bodies are usually placed in definition modules, whereas full class implementations are placed in implementation modules.

Inheritance and Virtual Methods

Most of the other details of TopSpeed Modula-2 objects follow Turbo Pascal nearly to the letter. There is a hidden SELF parameter passed implicitly to every method call, providing a connection within a method definition to the particular object instance from which the method call was made.

Inheritance is handled identically to Turbo Pascal, in that the name of the parent class is given in parentheses at the top of the child class definition:

TYPE
       KidGadget =
            CLASS(ParentGadget);

Late binding is handled through a new reserved word, VIRTUAL. Again, just as in Turbo Pascal, a method is made virtual by following the definition of its procedure header with VIRTUAL:

  PROCEDURE Edit( ); VIRTUAL;

Calls to virtual methods are handled through a virtual method table, which is a table of code addresses for all virtual methods belonging to an object class. There is one virtual method table for each class definition. Each object instance contains a pointer to the virtual method table belonging to its class. This pointer is not ordinarily visible, and in general it never needs to be referenced. However, a new standard function MTA( ) returns the address of the virtual method table if you ever need to find it.

In one important departure from the Turbo Pascal scheme, TopSpeed Modula-2 does not implement constructors or destructors.

No Privacy

As with Turbo Pascal, there is no ability to implement a "private" data field or method in the implementation of the class, if that field or method was not originally defined in the definition of the class.

This is unfortunate. Every object should be allowed to have some machinery that it keeps to itself, and that machinery should nonetheless be able to access all other fields and methods belonging to that class. C++ offers classes that ability, and sooner or later such things will have to be added to Pascal and Modula-2 to keep pace.

Nor does TopSpeed Modula-2 implement the multiple inheritance feature that TopSpeed Pascal will contain when released. JPI is hinting that multiple inheritance will be migrated to their Modula-2 in a future release, once their new Pascal compiler proves out the technology.

Listings Two and Three will provide you with a detailed look at the syntactic conventions surrounding object definition and encapsulation. The code is a straight-line translation of the Turbo Pascal when stamp. The only procedure that has been seriously reworked is CalcDayOfWeek, which I rewrote from scratch in Modula-2 as well as in Pascal, according to Zeller's original published algorithm.

I haven't had time to really probe the limits of TopSpeed's OOP extensions just yet; in particular, I have some questions involving the creation and deallocation of objects on the heap. You'll get the full report as I figure things out.

In general, I strongly recommend upgrading to TopSpeed Modula-2 V2.0 if you are already a user. Just about all aspects of the product have been greatly improved. The documentation is much improved, with the lone exception of the section on the OOP extensions, which should have been much larger and more detailed. On the other hand, if you've experimented with Turbo Pascal objects, the JPI system will feel pretty familiar and won't take a great deal of additional study.

Products Mentioned

Actor V3.0 Bellevue, WA 98004 The Whitewater Group 206-462-0501 1800 Ridge Avenue Price: $395 Evanston, IL 60201-3621 708-328-3800 TopSpeed Modula-2 V2.0 Price: $695 Jensen & Partners International

1101 San Antonio Rd., Suite 301 ToolBook V1.0 Mountain View, CA 94043 Asymetrix Corp. 415-967-3200 110 110th Ave. N.E., Suite 717 Price: $199

Jumping through Windows, Take 3

Since last column a pallet load of new software has made its way to Cactus Country, some of it remarkable indeed. Certainly the most important for the long haul is Windows 3.0. I've been a Windows user since well before Windows 1.0 was shipping, back during my tenure at PC Tech Journal. Between the product's own gradual improvement and the relentless RAMcharging of our own machines, Windows has become a viable operating platform, far quicker than any Mac system of comparable price, and better-looking too.

The roach in the Riesling has always been that development for Windows is hideously and needlessly difficult if you're using Microsoft's SDK. I've stated before that Actor is the only reasonable way to develop for Windows, but that's becoming less and less the case.

One promising alternative is Asymetrix's ToolBook, a new development system featuring a brand-new language and a potent suite of resource editing tools. The language reminds me a little of a fully structured and object-oriented Cobol (don't sneer ... 10 billion lines of code can't all be wrong ...) and a little bit of the database language Clarion, and that may turn out to be a fine thing indeed.

As with Clarion, you can approach ToolBook development from two directions: From the high end, by using the platform's prototyping tools to build screens and menu structures interactively, while writing as little code as possible, or from the low end, by eschewing the tools and going for the throat with the programming language from the very start.

One thing is for sure: You can build a simple app in ToolBook in almost no time at all, once you've spent an evening getting familiar with the environment. The system makes excellent use of Windows, and (in fact) all copies of Windows 3.0 are being shipped with DayBook, an app written in ToolBook. A look at DayBook will give you an excellent feel for what ToolBook can do.

The downside is that (for now, at least) ToolBook is agonizingly slow. It thrashes the disk constantly for reasons unclear; perhaps loading DLLs, perhaps virtualizing something that I might be able to keep in memory if I had more than my current 4 Mbytes. I don't know just yet, but if you've landed a copy of ToolBook be prepared to grit your teeth a little, and for heaven's sake have a fast 386 with as much RAM as you can afford.

Actor 3.0 showed up a few days ago, with full support for Windows 3.0. A description will have to wait until a future column, but it looks a little faster and has some interesting new features. Sadly, it's significantly more expensive now, and no low-end version is in sight. Still, for my money, Actor remains the way to go for Windows 3.0 development.

Other Windows 3.0 tools have shown up, but most are C-specific and will have to wait on Al Stevens. (Then there's Turbo C++ from Borland -- fine piece of work!) Announced but not yet shipping are a Windows 3.0 version of Smalltalk-80 from ParcPlace Systems, and Knowledge Pro Windows, which is difficult to describe and could be the guldurndest thing to turn up this year, judging from the promotional literature Knowledge Pro honcho John Slade sent me recently. More on both when I get my hands on them -- but it looks very much like the developer community has decided that for Windows, the third time is the charm.

A Hundred and WHAT?

No, you don't want to know. Summer has come to Phoenix. Whereas out in Chicago every June they run pictures in the paper of reporters frying eggs on the sidewalk, out here they don't do that because the eggs catch fire and the neighbors complain about the stink. And as I write it is -- I would not kid you about this -- 122 degrees.

Now just wait, people say, until July!

[LISTING ONE]

<a name="020c_0011">

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.



<a name="020c_0012"><a name="020c_0012">
<a name="020c_0013">
[LISTING TWO]
<a name="020c_0013">

(*----------------------------------------------------*)
(*                     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.



<a name="020c_0014"><a name="020c_0014">
<a name="020c_0015">
[LISTING THREE]
<a name="020c_0015">

(*----------------------------------------------------*)
(*                     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.







Related Reading


More Insights






Currently we allow the following HTML tags in comments:

Single tags

These tags can be used alone and don't need an ending tag.

<br> Defines a single line break

<hr> Defines a horizontal line

Matching tags

These require an ending tag - e.g. <i>italic text</i>

<a> Defines an anchor

<b> Defines bold text

<big> Defines big text

<blockquote> Defines a long quotation

<caption> Defines a table caption

<cite> Defines a citation

<code> Defines computer code text

<em> Defines emphasized text

<fieldset> Defines a border around elements in a form

<h1> This is heading 1

<h2> This is heading 2

<h3> This is heading 3

<h4> This is heading 4

<h5> This is heading 5

<h6> This is heading 6

<i> Defines italic text

<p> Defines a paragraph

<pre> Defines preformatted text

<q> Defines a short quotation

<samp> Defines sample computer code text

<small> Defines small text

<span> Defines a section in a document

<s> Defines strikethrough text

<strike> Defines strikethrough text

<strong> Defines strong text

<sub> Defines subscripted text

<sup> Defines superscripted text

<u> Defines underlined text

Dr. Dobb's encourages readers to engage in spirited, healthy debate, including taking us to task. However, Dr. Dobb's moderates all comments posted to our site, and reserves the right to modify or remove any content that it determines to be derogatory, offensive, inflammatory, vulgar, irrelevant/off-topic, racist or obvious marketing or spam. Dr. Dobb's further reserves the right to disable the profile of any commenter participating in said activities.

 
Disqus Tips To upload an avatar photo, first complete your Disqus profile. | View the list of supported HTML tags you can use to style comments. | Please read our commenting policy.