entry !1date,!2date,!3date,!4date,!5date,!6date,!7date,!8date,
   !9date,!10date,!11date,!12date,!13date;
begin "dates"
   define library!entry = "true";
   require "std.hdr" source!file;
   require "calli.hdr" source!file;

   internal procedure DecodeDecDate(integer EncodedDate;
              reference integer Year, Month, Day);
   begin "DecodeDecDate"
      Day := (EncodedDate mod 31) + 1;
      Month := ((EncodedDate div 31) mod 12) +1;
      Year := ((EncodedDate div 31) div 12) + 1964;
      return;
   end "DecodeDecDate";

   internal integer procedure DecDate;
   begin "DecDate"
      integer EncodedDate;
 
      EncodedDate := Calli(0,Calli!Date);
      return(EncodedDate);
   end "DecDate";

   internal string procedure DisplayDate
           (integer Year,Month,Day);
   begin "DisplayDate"
      string Result;

  ! note below case indexing begins at 0, thus the dummy entry for
    zero below;
      Result := case Month of (null,"January ", "February ", "March ",
                   "April ", "May ", "June ", "July ", "August ",
                   "September ", "October ", "November ", "December ");
      Result := Result & CVS(Day) & ", ";
      Result := Result & CVS(Year);
      return(Result);
   end "DisplayDate";

   internal string procedure Today;
   begin "Today"
      integer Year, Month, Day;
      DecodeDecDate(DecDate,Year,Month,Day);
      return(DisplayDate(Year,Month,Day));
   end "Today";

   internal boolean procedure FileCreationDate
        (string FileName; reference integer Year,Month,Day);
   begin "FileCreationDate"
      own integer array InfoArray[0:5];
      string Device, FName, Ext, PPN;
      integer EncodedDate;
      integer Channel, Dummy, EofFlag;
     
   ! if any error at all return February 31,1984;
      Year := 1984;
      Month := 2;
      Day := 31;

      if not FileScan(FileName, Device, FName, Ext, PPN) then
         return(false);
      Channel := GetChan;
      Open(Channel,Device,'10,0,0,Dummy,Dummy,EofFlag);
      if EofFlag then
         begin
            Release(Channel);
            return(false);
         end;
      LookUp(Channel,FName&"."&Ext&PPN,Dummy);
      if Dummy then
         begin
            Release (Channel);
            return(false);
         end;
      FileInfo(InfoArray);

! The FileCreation Date is obtained by concatenating bits
  18 - 20 of word one with bits 24-35 of word 2 from the
  LookUp block;
      EncodedDate := (( InfoArray[1] lsh ( - 3) ) land '70000) lor
                      (InfoArray[2] land '7777);
      DecodeDecDate(EncodedDate,Year,Month,Day);
      Release(Channel);
      return(true);
   end "FileCreationDate";

   internal string procedure DisplayFileCreationDate
           (string FileName; reference boolean Flag);
   begin "DisplayFileCreationDate"
      integer Month, Day, Year;
      Flag := FileCreationDate(FileName,Year,Month,Day);
      return(DisplayDate(Year,Month,Day));
   end "DisplayFileCreationDate";


   internal boolean procedure FileAccessDate
        (string FileName; reference integer Year,Month,Day);
   begin "FileAccessDate"
      own integer array InfoArray[0:5];
      string Device, FName, Ext, PPN;
      integer EncodedDate;
      integer Channel, Dummy, EofFlag;
     
   ! if any error at all return February 31,1984;
      Year := 1984;
      Month := 2;
      Day := 31;

      if not FileScan(FileName, Device, FName, Ext, PPN) then
         return(false);
      Channel := GetChan;
      Open(Channel,Device,'10,0,0,Dummy,Dummy,EofFlag);
      if EofFlag then
         begin
            Release(Channel);
            return(false);
         end;
      LookUp(Channel,FName&"."&Ext&PPN,Dummy);
      if Dummy then
         begin
            Release (Channel);
            return(false);
         end;
      FileInfo(InfoArray);

! The FileAccess Date is obtained by extracting the bits
  21-35 from word 1 of the LookUp block;

      EncodedDate := InfoArray[1] land '77777;
      DecodeDecDate(EncodedDate,Year,Month,Day);
      Release(Channel);
      return(true);
   end "FileAccessDate";

   internal string procedure DisplayFileAccessDate
           (string FileName; reference boolean Flag);
   begin "DisplayFileAccessDate"
      integer Month, Day, Year;
      Flag := FileAccessDate(FileName,Year,Month,Day);
      return(DisplayDate(Year,Month,Day));
   end "DisplayFileAccessDate";

   internal string procedure DisplayTime
         (integer Hours, Minutes, Seconds, Milliseconds (0);
          boolean Hour24(false), WantSeconds(false),
                  WantMilliseconds(false));
   begin "DisplayTime"
      string Result;
      integer OldFormatDigits, OldFormatWidth;

      GetFormat(OldFormatWidth, OldFormatDigits); ! save so can 
                                               later restore;
      SetFormat(0,0); ! no leading blanks or zeroes;
      if Hour24 then
         Result := CVS(Hours)
      else
         begin
            if Hours >= 13 then
               Result := CVS(Hours - 12)
            else if Hours = 0 then
               Result := "12"
            else
               Result := CVS(Hours);
         end;
      SetFormat(-2, 0); ! field width 2, leading zeroes;
      Result := Result & ":" & CVS(Minutes);
      if WantSeconds then
         begin
            Result := Result & ":" & CVS(Seconds);
            if WantMilliSeconds then
               begin
                  SetFormat (-3, 0);
                  Result := Result & "." & CVS(MilliSeconds);
               end;
         end;
      if not Hour24 then
         begin
            if (Hours >= 12) and ((Hours > 12) or (Minutes neq 0) or
                                  (Seconds neq 0) or 
                                  (MilliSeconds neq 0)) then
               Result := Result & " pm"
            else if (Hours = 12) then
               Result := Result & " noon"
            else if (Hours = 0) and (Minutes = 0) and (Seconds = 0)
                    and (MilliSeconds = 0) then
               Result := Result & " midnight"
            else
               Result := Result & " am";
         end;
      SetFormat(OldFormatWidth, OldFormatDigits);
      return(Result);
   end "DisplayTime";
   internal procedure TimeOfDay (reference integer Hours, Minutes,
              Seconds, Milliseconds);
   begin "TimeOfDay"
      integer TotalSeconds, TotalMinutes, TotalMilliseconds;

      TotalMilliseconds := Calli(0,Calli!MsTime); ! read clock;
      Milliseconds := TotalMilliseconds mod 1000;
      TotalSeconds := TotalMilliseconds div 1000;
      Seconds := TotalSeconds mod 60;
      TotalMinutes := TotalSeconds div 60;
      Minutes := TotalMinutes mod 60;
      Hours := TotalMinutes div 60;
   end "TimeOfDay";

   internal string procedure DisplayTimeOfDay
             (boolean Hour24(false);
              boolean WantSeconds (false);
              boolean WantMilliSeconds(false));
   begin "DisplayTimeOfDay"
      integer Hours, Minutes, Seconds, Milliseconds;

      TimeOfDay(Hours, Minutes, Seconds, Milliseconds);
      return ( DisplayTime(Hours,Minutes,Seconds,Milliseconds,
                       Hour24, WantSeconds, WantMilliseconds));
   end "DisplayTimeOfDay";
   internal boolean procedure FileCreationTime
        (string FileName; reference integer Hours, Minutes);
   begin "FileCreationTime"
      own integer array InfoArray[0:5];
      string Device, FName, Ext, PPN;
      integer TotalMinutes;
      integer Channel, Dummy, EofFlag;
     
   ! if any error at all return midnight;
      Hours := 0;
      Minutes := 0;

      if not FileScan(FileName, Device, FName, Ext, PPN) then
         return(false);
      Channel := GetChan;
      Open(Channel,Device,'10,0,0,Dummy,Dummy,EofFlag);
      if EofFlag then
         begin
            Release(Channel);
            return(false);
         end;
      LookUp(Channel,FName&"."&Ext&PPN,Dummy);
      if Dummy then
         begin
            Release (Channel);
            return(false);
         end;
      FileInfo(InfoArray);

! The FileCreation Time is obtained by extracting the filed
  of bits 13-23 of word 2 from the lookup block;

      TotalMinutes := (InfoArray[2] lsh (- 12)) land '3777;
      Hours := TotalMinutes div 60;
      Minutes := TotalMinutes mod 60;
      Release(Channel);
      return(true);
   end "FileCreationTime";

   internal string procedure DisplayFileCreationTime
             (string FileName; reference boolean Flag; boolean Hour24(false));
   begin "DisplayFileCreationTime"
      integer Hours, Minutes;
      Flag := FileCreationTime(FileName, Hours, Minutes);
      return ( DisplayTime(Hours,Minutes,
      define ZEROSECONDS = 0;
      define ZEROMILLISECONDS = 0;
                           ZEROSECONDS, ZEROMILLISECONDS, Hour24));
   end "DisplayFileCreationTime";
end "dates"