home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / drdobbs / 1990 / 10 / dunteman.asc < prev    next >
INI File  |  1990-09-06  |  18KB  |  465 lines
  1. [LISTING ONE]
  2.  
  3. PROGRAM ZelTest;  { From DDJ 10/90 }
  4.  
  5. CONST
  6.   DayStrings : ARRAY[0..6] OF STRING =
  7.   ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday');
  8.  
  9. VAR
  10.   Month, Day, Year : Integer;
  11.  
  12.  
  13. FUNCTION CalcDayOfWeek(Year,Month,Day : Integer) : Integer;
  14.  
  15. VAR
  16.   Century,Holder : Integer;
  17.  
  18. BEGIN
  19.   { First test for error conditions on input values: }
  20.   IF (Year < 0)  OR
  21.      (Month < 1) OR (Month > 12) OR
  22.      (Day < 1)   OR (Day > 31) THEN
  23.      CalcDayOfWeek := -1  { Return -1 to indicate an error }
  24.   ELSE
  25.     { Do the Zeller's Congruence calculation as Zeller himself }
  26.     { described it in "Acta Mathematica" #7, Stockhold, 1887.  }
  27.     BEGIN
  28.       { First we separate out the year and the century figures: }
  29.       Century := Year DIV 100;
  30.       Year    := Year MOD 100;
  31.       { Next we adjust the month such that March remains month #3, }
  32.       {  but that January and February are months #13 and #14,     }
  33.       {  *but of the previous year*: }
  34.       IF Month < 3 THEN
  35.         BEGIN
  36.           Inc(Month,12);
  37.           IF Year > 0 THEN Dec(Year,1)      { The year before 2000 is }
  38.             ELSE                            { 1999, not 20-1...       }
  39.               BEGIN
  40.                 Year := 99;
  41.                 Dec(Century);
  42.               END
  43.         END;
  44.  
  45.       { Here's Zeller's seminal black magic: }
  46.       Holder := Day;                        { Start with the day of month }
  47.       Holder := Holder + (((Month+1) * 26) DIV 10); { Calc the increment }
  48.       Holder := Holder + Year;              { Add in the year }
  49.       Holder := Holder + (Year DIV 4);      { Correct for leap years  }
  50.       Holder := Holder + (Century DIV 4);   { Correct for century years }
  51.       Holder := Holder - Century - Century; { DON'T KNOW WHY HE DID THIS! }
  52.       WHILE Holder < 0 DO                   { Get negative values up into }
  53.         Inc(Holder,7);                      { positive territory before   }
  54.                                             { taking the MOD...         }
  55.       Holder := Holder MOD 7;               { Divide by 7 but keep the  }
  56.                                             { remainder rather than the }
  57.                                             { quotient }
  58.  
  59.       { Here we "wrap" Saturday around to be the last day: }
  60.       IF Holder  = 0 THEN Holder := 7;
  61.  
  62.       { Zeller kept the Sunday = 1 origin; computer weenies prefer to }
  63.       { start everything with 0, so here's a 20th century kludge:     }
  64.       Dec(Holder);
  65.  
  66.       CalcDayOfWeek := Holder;  { Return the end product! }
  67.     END;
  68. END;
  69.  
  70. BEGIN
  71.   Write('Month (1-12): '); Readln(Month);
  72.   Write('Day   (1-31): '); Readln(Day);
  73.   Write('Year        : '); Readln(Year);
  74.   Writeln('The day of the week is ',
  75.            DayStrings[CalcDayOfWeek(Year,Month,Day)]);
  76.   Readln;
  77. END.
  78.  
  79. [LISTING TWO]
  80.  
  81. (*----------------------------------------------------*)
  82. (*                     TIMEDATE                       *)
  83. (*                                                    *)
  84. (* A Time-and-date stamp object for TopSpeed Modula-2 *)
  85. (*                                                    *)
  86. (*                           Definition module        *)
  87. (*                           TopSpeed Modula-2 V2.0   *)
  88. (*                           by Jeff Duntemann        *)
  89. (*                           Last update 6/1/90       *)
  90. (*                                                    *)
  91. (*----------------------------------------------------*)
  92.  
  93. DEFINITION MODULE TimeDate;
  94.  
  95. TYPE
  96.   String9  = ARRAY[0..9]  OF CHAR;
  97.   String20 = ARRAY[0..20] OF CHAR;
  98.   String50 = ARRAY[0..50] OF CHAR;
  99.  
  100.   WhenUnion =
  101.     RECORD
  102.       CASE  : BOOLEAN OF
  103.         TRUE  : FullStamp : LONGCARD; |
  104.         FALSE : TimePart  : CARDINAL;
  105.                 DatePart  : CARDINAL
  106.       END;
  107.     END;
  108.  
  109.   When =
  110.     CLASS
  111.       WhenStamp      : WhenUnion;       (* Combined time/date stamp *)
  112.       TimeString     : String9;         (* i.e., "12:45a"           *)
  113.       Hours,Minutes,Seconds : CARDINAL; (* Seconds is always even!  *)
  114.       DateString     : String20;        (* i.e., "06/29/89"         *)
  115.       LongDateString : String50;        (* i.e., "Thursday, June 29, 1989" *)
  116.       Year,Month,Day : CARDINAL;
  117.       DayOfWeek      : INTEGER;         (* 0=Sunday, 1=Monday, etc. *)
  118.       PROCEDURE GetTimeStamp() : CARDINAL; (* Returns DOS-format time stamp *)
  119.       PROCEDURE GetDateStamp() : CARDINAL; (* Returns DOS-format date dtamp *)
  120.       PROCEDURE PutNow;
  121.       PROCEDURE PutWhenStamp(NewWhen  : LONGCARD);
  122.       PROCEDURE PutTimeStamp(NewStamp : CARDINAL);
  123.       PROCEDURE PutDateStamp(NewStamp : CARDINAL);
  124.       PROCEDURE PutNewDate(NewYear,NewMonth,NewDay : CARDINAL);
  125.       PROCEDURE PutNewTime(NewHours,NewMinutes,NewSeconds : CARDINAL);
  126.     END;
  127.  
  128.  END TimeDate.
  129.  
  130. [LISTING THREE]
  131.  
  132. (*----------------------------------------------------*)
  133. (*                     TIMEDATE                       *)
  134. (*                                                    *)
  135. (* A Time-and-date stamp object for TopSpeed Modula-2 *)
  136. (*                                                    *)
  137. (*                           Implementation module    *)
  138. (*                           TopSpeed Modula-2 V2.0   *)
  139. (*                           by Jeff Duntemann        *)
  140. (*                           Last update 6/16/90      *)
  141. (*                                                    *)
  142. (*----------------------------------------------------*)
  143.  
  144. IMPLEMENTATION MODULE TimeDate;
  145.  
  146. FROM FIO     IMPORT GetCurrentDate;
  147. FROM Str     IMPORT CardToStr,Concat,IntToStr,Length,Slice;
  148. FROM Bitwise IMPORT And,Or;  (* From DDJ for March 1990 *)
  149.  
  150. TYPE
  151.   TMonthTags = ARRAY [1..12] OF String9;
  152.   TDayTags   = ARRAY [0..6]  OF String9;
  153.  
  154.  
  155. VAR
  156.   Temp1 : String50;
  157.   Dummy : CARDINAL;
  158.   DayTags : TDayTags;
  159.   MonthTags : TMonthTags;
  160.  
  161.  
  162. PROCEDURE CalcTimeStamp(Hours,Minutes,Seconds : CARDINAL) : CARDINAL;
  163.  
  164. BEGIN
  165.   RETURN Or(Or((Hours << 11),(Minutes << 5)),(Seconds >> 1));
  166. END CalcTimeStamp;
  167.  
  168.  
  169. PROCEDURE CalcDateStamp(Year,Month,Day : CARDINAL) : CARDINAL;
  170.  
  171. BEGIN
  172.   RETURN Or(Or(((Year - 1980) << 9),(Month << 5)),Day);
  173. END CalcDateStamp;
  174.  
  175.  
  176. PROCEDURE CalcTimeString(VAR TimeString : String9;
  177.                          Hours,Minutes,Seconds : CARDINAL);
  178.  
  179. VAR
  180.   Temp1,Temp2 : String9;
  181.   AMPM        : CHAR;
  182.   I           : INTEGER;
  183.   OK          : BOOLEAN;
  184.  
  185. BEGIN
  186.   I := Hours;
  187.   IF Hours = 0 THEN I := 12; END;   (* "0" hours = 12am *)
  188.   IF Hours > 12 THEN I := Hours - 12; END;
  189.   IF Hours > 11 THEN AMPM := 'p' ELSE AMPM := 'a'; END;
  190.   IntToStr(LONGINT(I),Temp1,10,OK);
  191.   IntToStr(LONGINT(Minutes),Temp2,10,OK);
  192.   IF Length(Temp2) < 2 THEN Concat(Temp2,'0', Temp2); END;
  193.   Concat(TimeString,Temp1,':');
  194.   Concat(TimeString,TimeString,Temp2);
  195.   Concat(TimeString,TimeString,AMPM);
  196. END CalcTimeString;
  197.  
  198.  
  199. PROCEDURE CalcDateString(VAR DateString : String20;
  200.                          Year,Month,Day : CARDINAL);
  201.  
  202. VAR
  203.   OK : BOOLEAN;
  204.  
  205. BEGIN
  206.   CardToStr(LONGCARD(Month),DateString,10,OK);
  207.   CardToStr(LONGCARD(Day),Temp1,10,OK);
  208.   Concat(DateString,DateString,'/');
  209.   Concat(DateString,DateString,Temp1);
  210.   CardToStr(LONGCARD(Year),Temp1,10,OK);
  211.   Concat(DateString,DateString,'/');
  212.   Slice(Temp1,Temp1,3,2);
  213.   Concat(DateString,DateString,Temp1);
  214. END CalcDateString;
  215.  
  216.  
  217. PROCEDURE CalcLongDateString(VAR LongDateString : String50;
  218.                              Year,Month,Date,DayOfWeek : CARDINAL);
  219. VAR
  220.   Temp1 : String9;
  221.   OK    : BOOLEAN;
  222.  
  223. BEGIN
  224.   Concat(LongDateString,DayTags[DayOfWeek],', ');
  225.   CardToStr(LONGCARD(Date),Temp1,10,OK);
  226.   Concat(LongDateString,LongDateString,MonthTags[Month]);
  227.   Concat(LongDateString,LongDateString,' ');
  228.   Concat(LongDateString,LongDateString,Temp1);
  229.   Concat(LongDateString,LongDateString,', ');
  230.   CardToStr(LONGCARD(Year),Temp1,10,OK);
  231.   Concat(LongDateString,LongDateString,Temp1);
  232. END CalcLongDateString;
  233.  
  234.  
  235. (*---------------------------------------------------------------------*)
  236. (* This calculates a day of the week figure, where 0=Sunday, 1=Monday, *)
  237. (* and so on, given the year, month, and day.  The year must be passed *)
  238. (* in full; that is, "1990" not just "90".  Another century is at hand,*)
  239. (* gang...                                                             *)
  240. (*---------------------------------------------------------------------*)
  241.  
  242. PROCEDURE CalcDayOfWeek(Year,Month,Day : INTEGER) : INTEGER;
  243.  
  244. VAR
  245.   Century,Holder : INTEGER;
  246.  
  247. BEGIN
  248.   (* First test for error conditions on input values: *)
  249.   IF (Year < 0)  OR
  250.      (Month < 1) OR (Month > 12) OR
  251.      (Day < 1)   OR (Day > 31)
  252.   THEN
  253.     RETURN -1  (* Return -1 to indicate an error *)
  254.   ELSE
  255.     (* First we separate out the year and century figures: *)
  256.     Century := Year DIV 100;
  257.     Year    := Year MOD 100;
  258.     (* Next we adjust the month such that March remains #3,   *)
  259.     (*  but that January and February are months #13 and #14, *)
  260.     (*  *but of the previous year.*                           *)
  261.     IF Month < 3 THEN
  262.       INC(Month,12);
  263.       IF Year > 0 THEN DEC(Year,1)   (* 1900/2000 etc. ("year 0")    *)
  264.         ELSE                         (* must be treated specially.   *)
  265.           Year := 99;                (* You can't just decrement the *)
  266.           DEC(Century)               (* year to -1...you must make   *)
  267.         END;                         (* it year 99 of the previous   *)
  268.     END;                             (* century.                     *)
  269.  
  270.     (* Here's Zeller's seminal black magic: *)
  271.     Holder := Day;                             (* Start with the day *)
  272.     Holder := Holder + (((Month+1) * 26) DIV 10);  (* Calc increment *)
  273.     Holder := Holder + Year;                   (* Add in the year    *)
  274.     Holder := Holder + (Year DIV 4);       (* Correct for leap years *)
  275.     Holder := Holder + (Century DIV 4); (* Correct for century years *)
  276.     Holder := Holder - Century - Century;  (* Take out century twice *)
  277.     WHILE Holder < 0 DO     (* Avoid taking MOD of negative quantity *)
  278.       INC(Holder,7);
  279.     END;
  280.  
  281.     Holder := Holder MOD 7;    (* Take Modulo 7 of (positive) result *)
  282.  
  283.     (* Here we "wrap" Saturday around to be the last day: *)
  284.     IF Holder = 0 THEN Holder := 7 END;
  285.  
  286.     (* Zeller kept the Sunday = 1 origin; computer weenies prefer to *)
  287.     (* start everything with 0, so here's a 20th century kludge:     *)
  288.     DEC(Holder);
  289.  
  290.     (* We've got it: Sunday = 0, Monday = 1, etc. Return the value:  *)
  291.     RETURN Holder;
  292.   END;  (* IF *)
  293. END CalcDayOfWeek;
  294.  
  295.  
  296. TYPE
  297.   When =
  298.     CLASS
  299.       WhenStamp      : WhenUnion;       (* Combined time/date stamp *)
  300.       TimeString     : String9;         (* i.e., "12:45a"           *)
  301.       Hours,Minutes,Seconds : CARDINAL; (* Seconds is always even!  *)
  302.       DateString     : String20;        (* i.e., "06/29/89"         *)
  303.       LongDateString : String50;        (* i.e., "Thursday, June 29, 1989" *)
  304.       Year,Month,Day : CARDINAL;
  305.       DayOfWeek      : INTEGER;         (* 0=Sunday, 1=Monday, etc. *)
  306.  
  307.       (*---------------------------------------------------------------------*)
  308.       (* There will be many times when an individual date or time stamp will *)
  309.       (* be much more useful than a combined time/date stamp.  These simple  *)
  310.       (* functions return the appropriate half of the combined long integer  *)
  311.       (* time/date stamp without incurring any calculation overhead.  It's   *)
  312.       (* done with a simple value typecast:                                  *)
  313.       (*---------------------------------------------------------------------*)
  314.  
  315.       PROCEDURE GetTimeStamp() : CARDINAL;
  316.  
  317.       BEGIN
  318.         RETURN WhenStamp.TimePart;
  319.       END GetTimeStamp;
  320.  
  321.  
  322.       PROCEDURE GetDateStamp() : CARDINAL;
  323.  
  324.       BEGIN
  325.         RETURN WhenStamp.DatePart;
  326.       END GetDateStamp;
  327.  
  328.  
  329.       (*---------------------------------------------------------------------*)
  330.       (* To fill a When record with the current time and date as maintained  *)
  331.       (* by the system clock, execute this method:                           *)
  332.       (*---------------------------------------------------------------------*)
  333.  
  334.       PROCEDURE PutNow;
  335.  
  336.       BEGIN
  337.         (* Get current time and date from the system: *)
  338.         WhenStamp.FullStamp := GetCurrentDate();
  339.         (* Calculate a new time stamp and update object fields: *)
  340.         PutTimeStamp(WhenStamp.TimePart);
  341.         (* Calculate a new date stamp and update object fields: *)
  342.         PutDateStamp(WhenStamp.DatePart);
  343.       END PutNow;
  344.  
  345.  
  346.       (*---------------------------------------------------------------------*)
  347.       (* This method allows us to apply a whole long integer time/date stamp *)
  348.       (* to the When object.  The object divides the stamp into time and     *)
  349.       (* date portions and recalculates all other fields in the object.      *)
  350.       (*---------------------------------------------------------------------*)
  351.  
  352.       PROCEDURE PutWhenStamp(NewWhen  : LONGCARD);
  353.  
  354.       BEGIN
  355.         WhenStamp.FullStamp := NewWhen;
  356.         (* We've actually updated the stamp proper, but we use the two *)
  357.         (* "put" routines for time and date to generate the individual *)
  358.         (* field and string representation forms of the time and date. *)
  359.         (* I know that the "put" routines also update the long integer *)
  360.         (* stamp, but while unnecessary it does no harm.               *)
  361.         PutTimeStamp(WhenUnion(WhenStamp).TimePart);
  362.         PutDateStamp(WhenUnion(WhenStamp).DatePart);
  363.       END PutWhenStamp;
  364.  
  365.  
  366.       (*---------------------------------------------------------------------*)
  367.       (* We can choose to update only the time stamp, and the object will    *)
  368.       (* recalculate only its time-related fields.                           *)
  369.       (*---------------------------------------------------------------------*)
  370.  
  371.       PROCEDURE PutTimeStamp(NewStamp : CARDINAL);
  372.  
  373.       BEGIN
  374.         WhenUnion(WhenStamp).TimePart := NewStamp;
  375.         (* The time stamp is actually a bitfield, and all this shifting left *)
  376.         (* and right is just extracting the individual fields from the stamp:*)
  377.         Hours := NewStamp >> 11;
  378.  
  379.         Minutes := And((NewStamp >> 5),3FH);
  380.         Seconds := And((NewStamp << 1),1FH);
  381.         (* Derive a string version of the time: *)
  382.         CalcTimeString(TimeString,Hours,Minutes,Seconds);
  383.       END PutTimeStamp;
  384.  
  385.  
  386.       (*---------------------------------------------------------------------*)
  387.       (* Or, we can choose to update only the date stamp, and the object     *)
  388.       (* will then recalculate only its date-related fields.                 *)
  389.       (*---------------------------------------------------------------------*)
  390.  
  391.       PROCEDURE PutDateStamp(NewStamp : CARDINAL);
  392.  
  393.       BEGIN
  394.         WhenUnion(WhenStamp).DatePart := NewStamp;
  395.         (* Again, the date stamp is a bit field and we shift the values out  *)
  396.         (* of it: *)
  397.         Year  := (NewStamp >> 9) + 1980;
  398.         Month := And((NewStamp >> 5),0FH);
  399.         Day   := And(NewStamp,1FH);
  400.         (* Calculate the day of the week value using Zeller's Congruence:    *)
  401.         DayOfWeek := CalcDayOfWeek(Year,Month,Day);
  402.         (* Calculate the short string version of the date; as in "06/29/89": *)
  403.         CalcDateString(DateString,Year,Month,Day);
  404.         (* Calculate a long version, as in "Thursday, June 29, 1989": *)
  405.         CalcLongDateString(LongDateString,Year,Month,Day,DayOfWeek);
  406.       END PutDateStamp;
  407.  
  408.  
  409.       PROCEDURE PutNewDate(NewYear,NewMonth,NewDay : CARDINAL);
  410.  
  411.       BEGIN
  412.         (* The "boss" field is the date stamp.  Everything else is figured *)
  413.         (* from the stamp, so first generate a new date stamp, and then    *)
  414.         (* (odd as it may seem) regenerate everything else, *including*    *)
  415.         (* the Year, Month, and Day fields: *)
  416.         PutDateStamp(CalcDateStamp(NewYear,NewMonth,NewDay));
  417.         (* Calculate the short string version of the date; as in "06/29/89": *)
  418.         CalcDateString(DateString,Year,Month,Day);
  419.         (* Calculate a long version, as in "Thursday, June 29, 1989": *)
  420.         CalcLongDateString(LongDateString,Year,Month,Day,DayOfWeek);
  421.       END PutNewDate;
  422.  
  423.  
  424.       PROCEDURE PutNewTime(NewHours,NewMinutes,NewSeconds : CARDINAL);
  425.  
  426.       BEGIN
  427.         (* The "boss" field is the time stamp.  Everything else is figured *)
  428.         (* from the stamp, so first generate a new time stamp, and then    *)
  429.         (* (odd as it may seem) regenerate everything else, *including*    *)
  430.         (* the Hours, Minutes, and Seconds fields: *)
  431.         PutTimeStamp(CalcTimeStamp(NewHours,NewMinutes,NewSeconds));
  432.         (* Derive the string version of the time: *)
  433.         CalcTimeString(TimeString,Hours,Minutes,Seconds);
  434.       END PutNewTime;
  435.  
  436.     END;  (* ...of CLASS When implementation *)
  437.  
  438.  
  439.  
  440. BEGIN   (* Initialization code for TimeDate goes here: *)
  441.   MonthTags :=
  442.     TMonthTags('January','February','March','April','May','June','July',
  443.                'August','September','October','November','December');
  444.   DayTags := TDayTags('Sunday','Monday','Tuesday','Wednesday',
  445.                       'Thursday','Friday','Saturday');
  446. END TimeDate.
  447.  
  448. Examplσ 1║ Evaluatinτ thσ expressioε fo≥ thσ Gregoriaε calendar
  449.  
  450.     (m + 1) * 26        K     J
  451. q + ------------ + K + --- + --- - 2*J
  452.         10              4     4
  453.  
  454. Examplσ 2║ Thσ tw∩ end≤ oµ definitioε≤ arσ bracketed 
  455.  
  456. TYPE When = 
  457.        CLASS
  458.          (* All data field defintions *)
  459.          (* are fully re-stated here. *)
  460.          
  461.          (* The full method imple-    *)
  462.          (* mentations, including     *)
  463.          (* bodies, are given here.   *)
  464. è       END;
  465.