[Back to DATETIME SWAG index] [Back to Main SWAG index] [Original]

    UNIT Clocks;

     {This UNIT provides a CLOCK OBJECT for use in Turbo Pascal 5.5.

      (C) Copyright 1989, Earl F. Glynn, Overland Park, KS.  Compuserve 73257,3527.
      All Rights Reserved.  This Turbo Pascal 5.5 UNIT may be freely distributed
      for non-commerical use.

      Clock objects can be used as individual timers, using either the CMOS
      real-time clock, or the DOS real-time clock.  As shown in the ClkDemo
      PROGRAM, the DOS clock can be shut off when interrupts are disabled.
      The resolution of the CMOS clock is only 1 second, while the DOS clock
      has 0.0549 second resolution (18.203 ticks per second).  In addition
      to real-time clocks, static time stamps can be manipulated and
      formatted.  The range for all clocks and time stamps is Jan 1, 1900
      through Jun 5, 2079.  (Sep 18, 1989 is the midpoint of this range).

      Several REXX-like FUNCTIONs provide Date/Time formatting.  [REXX,
      the Restructured Extended Executor, or sometimes called the System Product
      Interpreter, is IBM's SAA command language (now primarily for VM/CMS).
      That is, REXX EXECs are CMS's equivalent of PC .BAT files but REXX
      provides much more functionality than the PC 'BAT' language.]

      REXX-like FUNCTIONS in Pascal could be considered an oxymoron since
      REXX doesn't have any concept of TYPEd variables and obviously Pascal does.
      The Pascal functions in most cases were written to return STRINGs,
      which is similar to REXX.  In some cases, where a number was returned
      that could be used in calculations, a separate function was used.  For
      example, the REXX TIME('Elapsed') function was implemented as an object
      'Elapsed' method that returns a REAL value to be used in calculations.
      A function 'hhmmss' can be used to format elapsed seconds in a
      character string, if desired.

      See the CLKDEMO.PAS, FLOPS.PAS and TIMER.PAS programs for sample usage
      of clock objects and this UNIT.}

    INTERFACE

      TYPE
        ClockValue    =
          RECORD
            year      :  1900..2079;
            month     :  1..12;
            day       :  1..31;
            hour      :  0..23;
            minute    :  0..59;
            second    :  0..59;
            hundredth :  0..99;
          END;
        ClockType     =  (CMOSClock,DOSClock);
        Clock         =
          OBJECT
            mode      :  ClockType;
            StartValue:  ClockValue;
            FUNCTION  Date(s:  STRING):  STRING;
            FUNCTION  Elapsed:  REAL;   {elapsed timer (seconds)}
            PROCEDURE Start (ct:  ClockType);
            FUNCTION  Time(s:  STRING):  STRING;
          END;

      FUNCTION  DateFormat(s:  STRING; clk:  ClockValue):  STRING;
      FUNCTION  DaysThisCentury(y, m, d:  WORD):  WORD;
      FUNCTION  hhmmss(seconds:  REAL):  STRING;
      FUNCTION  JulianDate(y{1900..}, m{1..12}, d{1..31}:  WORD):  WORD;
      PROCEDURE SetClock (yr,mo,d,h,m,s,hth:  WORD; VAR t:  ClockValue);
      FUNCTION  TimeDiff(t2,t1:  ClockValue):  REAL;  {t2 - t1 seconds}
      FUNCTION  TimeFormat(s:  STRING; clk:  ClockValue):  STRING;
      PROCEDURE UnPackTime (TurboTime:  LongInt; VAR Clk:  ClockValue);

    IMPLEMENTATION

      USES
        DOS; {INTR}

      VAR
        c  :  CHAR;

      FUNCTION L2C(L:  LONGINT):  STRING;  {LONGINT-to-character}
        {L2C and W2C are intended to be similar to the standard D2C
         (decimal-to-character) REXX function.}
        VAR t:  STRING[11];
      BEGIN
        STR (L,t);
        L2C := t
      END {L2C};

      FUNCTION W2C(w:  WORD):  STRING;     {word-to-character}
        VAR t:  STRING[5];
      BEGIN
        STR (w,t);
        W2C := t
      END {W2C};

      FUNCTION TwoDigits (w:  WORD):  STRING;
        CONST Digit:  ARRAY[0..9] OF CHAR = '0123456789';
      BEGIN
        w := w MOD 100;  {just to be safe}
        TwoDigits := Digit[w DIV 10] + Digit[w MOD 10]
      END {TwoDigits};

      FUNCTION DateFormat(s:  STRING; clk:  ClockValue):  STRING;
        CONST
          days  :  ARRAY[0..6] OF STRING[9]
                             =('Sunday','Monday','Tuesday','Wednesday',
                               'Thursday','Friday','Saturday');
          months:  ARRAY[1..12] OF STRING[9]
                             =('January','February','March',
                               'April',  'May',     'June',
                               'July',   'August',  'September',
                               'October','November','December');
      BEGIN
        IF   LENGTH(s) = 0
        THEN c := 'N' {NORMAL}
        ELSE c := UpCase(s[1]);
        CASE c OF
                {Normal (default):  dd Mmm yyyy -- no leading zero or blank}
          'N':  DateFormat := W2C(clk.day) + ' ' + COPY(months[clk.month],1,3)
                                           + ' ' + W2C(clk.year);

                {Century:  ddddd -- no leading zeros or blanks}
          'C':  DateFormat := W2C( DaysThisCentury(clk.year,clk.month,clk.day) );

                {Julian date:  ddd -- no leading 0s or blanks}
          'D':  DateFormat := W2C(JulianDate(clk.year,clk.month,clk.day));

                {European:  dd/mm/yy}
          'E':  DateFormat := TwoDigits(clk.day  )  + '/' +
                  TwoDigits(clk.month)  + '/' + TwoDigits(clk.year MOD 100);

                {Month:  current month name in mixed case}
          'M':  DateFormat := months[clk.month];

                {Ordered:  yy/mm/dd suitable for sorting}
          'O':  DateFormat := TwoDigits(clk.year MOD 100)  + '/' +
                  TwoDigits(clk.month)  + '/' + TwoDigits(clk.day);

                {Standard:  yyyymmdd -- suitable for sorting (ISO/R 2014-1971)}
          'S':  DateFormat := W2C(clk.year) + TwoDigits(clk.month) +
                  TwoDigits(clk.day);

                {USA:  mm/dd/yy}
          'U':  DateFormat := TwoDigits(clk.month)  + '/' +
                  TwoDigits(clk.day  )  + '/' + TwoDigits(clk.year MOD 100);

                {Weekday:  returns day of the week in mixed case}
          'W':  DateFormat :=  {January 1, 1900 was a Monday}
                  days[DaysThisCentury(clk.year,clk.month,clk.day) MOD 7 ]

          ELSE DateFormat := ''
        END
      END {DateFormat};

      FUNCTION DaysThisCentury(y, m, d:  WORD):  WORD;

      {This function was written to be equivalent to the REXX language
       DATE('Century') function.  See DateFormat FUNCTION in this UNIT.

       Jan 1, 1900 = 1, Jan 2, 1900 = 2, ..., Jun 5, 2079 = 65535 (largest word).
       Jan 1, 1989 = 32508, Jan 1, 1990 = 32873, Sep 18, 1989 = 32768.

       "The Astronomical Almanac" defines the astronomical julian date
       to be the numbers of mean solar days since 4713 BC.  In this system
       Jan 1, 1900 = 2415020.5, Jan 1, 2000 = 2451544.5,
       Jan 1, 1989 = 2447527.5, Jan 1, 1990 = 2447892.5,
       Jun 5, 2079 = 2480554.5.  This data was used to validate the function.

       (Note:  DaysThisCentry(y,m,d) MOD 7  returns day-of-week index, i.e.,
       0=Sunday, 1=Monday, etc. since January 1, 1900 was a Monday.)}
      BEGIN
        DaysThisCentury := 365*(y-1900) + INTEGER(y-1901) DIV 4 + JulianDate(y,m,d)
      END {DaysThisCentury};

      FUNCTION  hhmmss(seconds:  REAL):  STRING;
        {Convert elapsed times/time differences to [hh:]mm:ss format}
        VAR
          h,h1,h2:  LONGINT;
          s      :  STRING;
          t      :  LONGINT;
      BEGIN
        IF   seconds < 0.0
        THEN BEGIN
          seconds := ABS(seconds);
          s := '-'
        END
        ELSE s:= '';
        h1 := 0;
        WHILE seconds > 2147483647.0 DO BEGIN  {fixup real-to-LONGINT problem}
          seconds := seconds - 1576800000.0;   {subtract about 50 years}
          h1 := h1 + 438000 {hours}            {add about 50 years}
        END;
        t := TRUNC(seconds);
        h2 := t DIV 3600;  {hours}
        h := h1 + h2;
        IF   h > 0
        THEN s := s + L2C(h) + ':';
        t := t - h2*3600;  {minutes and seconds left}
        hhmmss := s + TwoDigits(t DIV 60) + ':' + TwoDigits(t MOD 60)
      END {hhmmss};

      FUNCTION JulianDate(y{1900..}, m{1..12}, d{1..31}:  WORD):  WORD;
        CONST
          julian:  ARRAY[0..12] OF WORD =
                   (0,31,59,90,120,151,181,212,243,273,304,334,365);
        VAR
          jd:  WORD;
      BEGIN
        jd := julian[m-1] + d;
        IF   (m > 2) AND (y MOD 4 = 0) AND
             (y <> 1900) {AND (y <> 2100)}
        THEN INC (jd);   {1900 and 2100 are not leap years; 2000 is}
        JulianDate := jd
      END {JulianDate};

      PROCEDURE SetClock (yr,mo,d,h,m,s,hth:  WORD; VAR t:  ClockValue);
      BEGIN
        t.year      := yr;
        t.month     := mo;
        t.day       := d;
        t.hour      := h;
        t.minute    := m;
        t.second    := s;
        t.hundredth := hth
      END {SetClock};

      FUNCTION  TimeDiff(t2,t1:  ClockValue):  REAL;
      BEGIN  {REAL arithmetic is used to avoid INTEGER/LONGINT overflows}
        TimeDiff :=   0.01*INTEGER(t2.hundredth - t1.hundredth) +
                           INTEGER(t2.second - t1.second      ) +
                      60.0*INTEGER(t2.minute - t1.minute      ) +
                    3600.0*INTEGER(t2.hour   - t1.hour        ) +
                   86400.0*LONGINT(DaysThisCentury(t2.year,t2.month,t2.day) -
                           LONGINT(DaysThisCentury(t1.year,t1.month,t1.day)))
      END {TimeDiff};

      FUNCTION  TimeFormat(s:  STRING; clk:  ClockValue):  STRING;
        VAR
          meridian:  STRING[2];
      BEGIN
        IF   LENGTH(s) = 0
        THEN c := 'N' {NORMAL}
        ELSE c := UpCase(s[1]);
        CASE c OF

                {Normal (default):  hh:mm:ss}
          'N':  TimeFormat := TwoDigits(clk.hour  )  + ':' +
                  TwoDigits(clk.minute)  + ':' + TwoDigits(clk.second);

                {Civil:  hh:mxx, for example:  11:59pm}
          'C':  BEGIN
                  IF   clk.hour < 12
                  THEN BEGIN
                    meridian := 'am';  {anti meridiem}
                    IF   clk.hour = 0
                    THEN clk.hour := 12;  {12:00am is midnight}
                  END                     {12:00pm is noon}
                  ELSE BEGIN
                    meridian := 'pm';  {post meridiem}
                    IF   clk.hour > 12
                    THEN clk.hour := clk.hour - 12
                  END;
                  TimeFormat := W2C(clk.hour)  + ':' +
                    TwoDigits(clk.minute)  + meridian
                END;

                {Hours:  hh -- number of hours since midnight}
          'H':  TimeFormat := W2C(clk.hour);

                {Long:  hh.mm:ss.xx (real REXX requires microseconds here)}
          'L':  TimeFormat := TwoDigits(clk.hour  )  + ':' +
                  TwoDigits(clk.minute)  + ':' + TwoDigits(clk.second)  + '.' +
                  TwoDigits(clk.hundredth);

                {Minutes:  mmmm -- number of minutes since midnight}
          'M':  TimeFormat := W2C(60*clk.hour + clk.minute);

                {Seconds:  sssss -- number of seconds since midnight}
          'S':  TimeFormat := L2C( 3600*LONGINT(clk.hour)
                   + 60*LONGINT(clk.minute) + LONGINT(clk.second) )

          ELSE TimeFormat := ''
        END
      END {TimeFormat};

      PROCEDURE UnPackTime (TurboTime:  LongInt; VAR Clk:  ClockValue);
        {The DOS.DateTime TYPE does not have hundredths of a second in its
         definition.  Clocks.UnPackTime allows the use of Clocks.DateFormat
         and Clocks.TimeFormat with time stamps, especially with SearchRec
         TYPEed variables defined by FindFirst/FindNext.}
        VAR
          DT:  DateTime;
      BEGIN
        DOS.UnPackTime (TurboTime, DT);
        SetClock (DT.year,DT.month,DT.day,DT.hour,DT.min,DT.sec,0, Clk)
      END {UnPackTime};

      PROCEDURE GetDateTime (VAR c:  ClockValue; ct:  ClockType);
        VAR r1,r2:  Registers;

        FUNCTION BCD (k:  BYTE):  WORD;    {convert binary-coded decimal}
        BEGIN
          BCD := 10*(k DIV 16) + (k MOD 16)
        END {BCD};

      BEGIN
        CASE ct OF
          CMOSClock:
            BEGIN
              r1.AH := $04;
              INTR ($1A,r1);      {BIOS call:  read date from real-time clock}
              r2.AH := $02;
              Intr ($1A,r2);      {BIOS call:  read real-time clock}
              SetClock (100*BCD(r1.CH) + BCD(r1.CL) {yr},
                        BCD(r1.DH) {mo}, BCD(r1.DL) {day},
                        BCD(r2.CH) {h},  BCD(r2.CL) {m}, BCD(r2.DH) {s},
                        0 {.00}, c)
            END;
          DOSClock:
            BEGIN
              r1.AH := $2A;       {could use GetDate and GetTime from DOS UNIT}
              INTR ($21,r1);      {DOS call:  get system date}
              r2.AH := $2C;
              Intr ($21,r2);      {DOS call:  get system time}
              SetClock (r1.CX,r1.DH,r1.DL, r2.CH,r2.CL,r2.DH,r2.DL, c)
            END
        END
      END {GetDateTime};

      FUNCTION Clock.Date(s:  STRING):  STRING;
      BEGIN
        Date := DateFormat(s,StartValue)
      END {Date};

      FUNCTION  Clock.Elapsed:  REAL;
        VAR now:  ClockValue;
      BEGIN
        GetDateTime (now,mode);
        Elapsed := TimeDiff(now,StartValue)
      END {Clock.Elapsed};

      PROCEDURE Clock.Start (ct:  ClockType);
      BEGIN
        mode := ct;
        GetDateTime (StartValue, ct)
      END {Clock.Start};

      FUNCTION Clock.Time(s:  STRING):  STRING;
      BEGIN
        Time := TimeFormat(s,StartValue)
      END {Time};

    END {Clocks}.

    {---------------------------  DEMO --------------------------}

    PROGRAM ClkDemo;

     {This PROGRAM demonstates how to use the CLOCKS UNIT, including a
      clock object, its methods, and related FUNCTIONs and PROCEDUREs.
      Differences between CMOS and DOS clocks are shown.

      (C) Copyright 1989, Earl F. Glynn, Overland Park, KS.  Compuserve 73257,3527.
      All Rights Reserved.  This Turbo Pascal 5.5 PROGRAM may be freely distributed
      for non-commerical use.

      Several of the examples were derived from "The REXX Language" by
      M.F. Cowlishaw, Prentice Hall, 1985.}

      USES
        CRT,
        Clocks,
        DOS;    {FindFirst,FindNext,SearchRec,AnyFile,DOSError}

      VAR
        Clk1,Clk2,Clk3:  Clock;       {clock objects -- real time clocks}
        stamp1,stamp2 :  ClockValue;  {static clocks -- time stamps}
        stamp3,stamp4 :  ClockValue;
        stamp5        :  ClockValue;
        DirInfo       :  SearchRec;

      PROCEDURE ShowClocks;
      BEGIN
        Clk2.Start (CMOSClock);
        Clk3.Start (DOSClock);
        WRITELN ('  CMOS Clock:  ',Clk2.date('u'),' ',Clk2.time('N') );
        WRITELN ('   DOS Clock:  ',Clk3.date('u'),' ',Clk3.time('L') );
        WRITELN ('  Difference:  ',TimeDiff(Clk2.StartValue,Clk3.StartValue):8:2,
                 ' second(s)');
      END {ShowClocks};

      PROCEDURE DisableInterrupts;
        INLINE ($FA);

      PROCEDURE EnableInterrupts;
        INLINE ($FB);

      PROCEDURE KillTime;
        {The following could be used for a 5-second delay, but it re-enables
         interrupts when they are disabled:

            WHILE clk1.elapsed < 5.0 DO (* nothing *);

         So,time will be wasted with a few calculations.}

        VAR
          i:  WORD;
          x:  REAL;
      BEGIN
        WRITELN ('''Kill'' some time ...');
        FOR i := 1 TO 10000 DO
          x := SQRT(i)
      END;

    BEGIN
      Clk1.Start (CMOSClock);
      WRITELN ('CMOS/DOS Clock Differences');
      WRITELN ('--------------------------');
      WRITELN ('Start Clocks');
      ShowClocks;
      KillTime;
      ShowClocks;
      WRITELN ('Disable Interrupts (DOS clock will stop):');
      DisableInterrupts;
      KillTime;
      ShowClocks;
      WRITELN ('Enable Interrupts');
      EnableInterrupts;

      SetClock (1985,8,27, 16,54,22, 12, stamp1);  {These are not real-time clocks.}
      SetClock (1900,1, 1,  0, 0, 0,  0, stamp2);
      SetClock (2079,6, 5, 23,59,59, 99, stamp3);

      WRITELN ('Cowlishaw''s':52);
      WRITELN ('now':39,'REXX Book':13,'First':13,'Last':13);
      WRITELN ('Date/DateFormat Examples');
      WRITELN ('------------------------');
      WRITELN ('day this century - C':26,Clk2.Date('Century'):13,
        DateFormat('C',stamp1):13, DateFormat('C',stamp2):13,
        DateFormat('C',stamp3):13);
      WRITELN ('day this year - D':26,   Clk2.Date('Days'):13,
        DateFormat('D',stamp1):13, DateFormat('D',stamp2):13,
        DateFormat('D',stamp3):13);
      WRITELN ('dd/mm/yy - E':26,        Clk2.Date('European'):13,
        DateFormat('E',stamp1):13, DateFormat('E',stamp2):13,
        DateFormat('E',stamp3):13);
      WRITELN ('month name - M':26,      Clk2.Date('MONTH'):13,
        DateFormat('M',stamp1):13, DateFormat('M',stamp2):13,
        DateFormat('M',stamp3):13);
      WRITELN ('dd Mmm yyyy - N':26,     Clk2.Date('normal'):13,
        DateFormat('N',stamp1):13, DateFormat('N',stamp2):13,
        DateFormat('N',stamp3):13);
      WRITELN ('yy/mm/dd - O':26,        Clk2.Date('Ordered'):13,
         DateFormat('O',stamp1):13,DateFormat('O',stamp2):13,
         DateFormat('O',stamp3):13);
      WRITELN ('yyyymmdd - S':26,        Clk2.Date('standard'):13,
        DateFormat('S',stamp1):13, DateFormat('S',stamp2):13,
        DateFormat('S',stamp3):13);
      WRITELN ('mm/dd/yy - U':26,        Clk2.Date('USA'):13,
        DateFormat('U',stamp1):13, DateFormat('U',stamp2):13,
        DateFormat('U',stamp3):13);
      WRITELN ('day of week - W':26,     Clk2.Date('weekday'):13,
        DateFormat('W',stamp1):13, DateFormat('W',stamp2):13,
        DateFormat('W',stamp3):13);

      WRITELN;
      WRITELN ('Time/TimeFormat Examples');
      WRITELN ('------------------------');
      WRITELN ('hh:mmxm - C':26,             Clk2.Time('Civil'):13,
        TimeFormat('C',stamp1):13, TimeFormat('C',stamp2):13,
        TimeFormat('C',stamp3):13);
      WRITELN ('hours since midnight - H':26,Clk2.Time('Hours'):13,
        TimeFormat('h',stamp1):13, TimeFormat('h',stamp2):13,
        TimeFormat('h',stamp3):13);
      WRITELN ('hh:mm:ss.xx - L':26,         Clk2.Time('long'):13,
        TimeFormat('L',stamp1):13, TimeFormat('L',stamp2):13,
        TimeFormat('L',stamp3):13);
      WRITELN ('minutes since midnight - M', Clk2.Time('minutes'):13,
        TimeFormat('m',stamp1):13, TimeFormat('m',stamp2):13,
        TimeFormat('m',stamp3):13);
      WRITELN ('hh:mm:ss - N':26,            Clk2.Time('normal'):13,
        TimeFormat('n',stamp1):13, TimeFormat('n',stamp2):13,
        TimeFormat('n',stamp3):13);
      WRITELN ('seconds since midnight - S', Clk2.Time('seconds'):13,
        TimeFormat('s',stamp1):13, TimeFormat('s',stamp2):13,
        TimeFormat('s',stamp3):13);

      WRITELN;
      WRITELN ('Time Differences/Elapsed Time');
      WRITELN ('-----------------------------');
      WRITELN (' ':20,'seconds':12,'hh:mm:ss':16);
      WRITELN ('CMOS - DOS Clock:':20,
        TimeDiff(Clk2.StartValue,Clk3.StartValue):12:2,
        hhmmss(TimeDiff(Clk2.StartValue,Clk3.StartValue)):16);
      SetClock (1989,1, 1,  0, 0, 0,  0, stamp4);
      SetClock (1990,1, 1,  0, 0, 0,  0, stamp5);
      WRITELN ('Jan 1-Dec 31 1989:':20,TimeDiff(stamp5,stamp4):12:0,
        hhmmss(TimeDiff(stamp5,stamp4)):16);
      WRITELN ('Dec 31-Jan 1 1989:':20,TimeDiff(stamp4,stamp5):12:0,
        hhmmss(TimeDiff(stamp4,stamp5)):16);
      SetClock (1992,1, 1,  0, 0, 0,  0, stamp4);
      SetClock (1993,1, 1,  0, 0, 0,  0, stamp5);
      WRITELN ('1992 (leap year):':20,TimeDiff(stamp5,stamp4):12:0,
        hhmmss(TimeDiff(stamp5,stamp4)):16);
      SetClock (2000,1, 1,  0, 0, 0,  0, stamp5);
      WRITELN ('20th century:':20,TimeDiff(stamp5,stamp2):12:0,
        hhmmss(TimeDiff(stamp5,stamp2)):16,' (100*365 days + 24 leap days)');
      WRITELN ('Maximum Clock Range:':20,TimeDiff(stamp3,stamp2):12:0,
        hhmmss(TimeDiff(stamp3,stamp2)):16,' (January 1, 1900 midnight -');
      WRITELN ('June 5, 2079 23:59:59.99)':78);
      WRITELN ('Elapsed time:':20,Clk1.Elapsed:12:0,
        hhmmss(Clk1.Elapsed):16);

      Readkey;
      WRITELN;
      WRITELN ('Clocks.UnPackTime');
      WRITELN ('-----------------');
      FindFirst ('*.*',AnyFile,DirInfo);
      WHILE DOSError = 0 DO BEGIN  {Note:  seconds on files are even numbers}
        Clocks.UnPackTime (DirInfo.Time, stamp5);
        WRITELN (DirInfo.Name:12,'  ',DirInfo.size:7,'  ',
          COPY(DateFormat('Weekday',stamp5),1,3),' ',
          DateFormat('USA',stamp5),' ',TimeFormat('Normal',stamp5));
        FindNext (DirInfo)
      END;
      Readkey;
    END {ClkDemo}.

[Back to DATETIME SWAG index] [Back to Main SWAG index] [Original]