{
Copyright (C) 1991-99 Free Software Foundation, Inc.

Authors: Frank Heckenbach <frank@pascal.gnu.de>
         Jukka Virtanen <jtv@hut.fi>

Time and date routines

This file is part of GNU Pascal Library. The GNU Pascal Library is free
software; you can redistribute it and/or modify it under the terms of
the GNU Library General Public License as published by the Free Software
Foundation; either version 2 of the License, or (at your option) any
later version.

The GNU Pascal Library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
Library General Public License for more details.

You should have received a copy of the GNU Library General Public
License along with the GNU Pascal Library; see the file COPYING.LIB.  If
not, write to the Free Software Foundation, Inc., 675 Mass Ave,
Cambridge, MA 02139, USA.
}

unit Time;

interface

uses GPC;

function  GetDayOfWeek        (Day, Month, Year : Integer) : Integer;                                          asmname '_p_dayofweek';
procedure UnixTimeToTimeStamp (UnixTime : UnixTimeType; var aTimeStamp : TimeStamp);                           asmname '_p_unix_time_to_time_stamp';
function  TimeStampToUnixTime (protected var aTimeStamp : TimeStamp) : UnixTimeType;                           asmname '_p_time_stamp_to_unix_time';
procedure GPC_GetTimeStamp    (var aTimeStamp : TimeStamp);                                                    asmname '_p_gettimestamp';

{ Is the year a leap year? }
function  IsLeapYear (Year : Integer) : Boolean; asmname '_p_is_leap_year';

procedure GPC_Date (protected var aTimeStamp : TimeStamp; var Result : GPC_Date_String); asmname '_p_date';
procedure GPC_Time (protected var aTimeStamp : TimeStamp; var Result : GPC_Time_String); asmname '_p_time';

implementation

function GetDayOfWeek (Day, Month, Year : Integer) : Integer;
const m : array [1 .. 12] of Integer = (0, 3, 2, 5, 0, 3, 5, 1, 4, 6, 2, 4);
begin
  if Month <= 2 then Dec (Year);
  GetDayOfWeek := (Day + m [Month] + Year + Year div 4 - Year div 100 + Year div 400) mod 7
end;

function IsLeapYear (Year : Integer) : Boolean;
begin
  IsLeapYear := (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0))
end;

procedure GPC_Date (protected var aTimeStamp : TimeStamp; var Result : GPC_Date_String);
begin
  with aTimeStamp do
    if not Datevalid or (Month < 1) or (Month > 12) or (Day < 1) or
      (Day > MonthLength [Month] + Ord ((Month = 2) and IsLeapYear (Year)))
      then RuntimeError (750) { Invalid date supplied to library function `Date' }
      else WriteStr (Result, Day : 2, ' ', Copy (MonthName [Month], 1, 3), ' ', Year : 4)
end;

procedure GPC_Time (protected var aTimeStamp : TimeStamp; var Result : GPC_Time_String);
const Zero : array [Boolean] of String (1) = ('', '0');
begin
  with aTimeStamp do
    if not TimeValid or (Hour < 0) or (Hour > 23) or
      (Minute < 0) or (Minute > 59) or (Second < 0) or (Second > 59)
      then RuntimeError (751) { Invalid time supplied to library function `Time' }
      else WriteStr (Result, Zero [Hour   < 10], Hour,   ':',
                             Zero [Minute < 10], Minute, ':',
                             Zero [Second < 10], Second)
end;

procedure UnixTimeToTimeStamp (UnixTime : UnixTimeType; var aTimeStamp : TimeStamp);
var aYear, aMonth, aDay, aHour, aMinute, aSecond : Integer;
begin
  with aTimeStamp do
    if UnixTime >= 0
      then
        begin
          UnixTimeToTime (UnixTime, aYear, aMonth, aDay, aHour, aMinute, aSecond);
          Year        := aYear;
          Month       := aMonth;
          Day         := aDay;
          DayOfWeek   := GetDayOfWeek (aDay, aMonth, aYear);
          DateValid   := True;
          Hour        := aHour;
          Minute      := aMinute;
          Second      := aSecond;
          MicroSecond := 0;
          TimeValid   := True
        end
      else
        begin
          { The values are specified in the standard, even if the Valid fields are False }
          Year        := 1;
          Month       := 1;
          Day         := 1;
          DayOfWeek   := 0;
          DateValid   := False;
          Hour        := 0;
          Minute      := 0;
          Second      := 0;
          MicroSecond := 0;
          TimeValid   := False
        end
end;

function TimeStampToUnixTime (protected var aTimeStamp : TimeStamp) : UnixTimeType;
begin
  with aTimeStamp do
  if not DateValid or not TimeValid
    then TimeStampToUnixTime := - 1
    else TimeStampToUnixTime := TimeToUnixTime (Year, Month, Day, Hour, Minute, Second)
end;

procedure GPC_GetTimeStamp (var aTimeStamp : TimeStamp);
var MicroSecond : Integer;
begin
  UnixTimeToTimeStamp (GetUnixTime (MicroSecond), aTimeStamp);
  aTimeStamp.MicroSecond := MicroSecond
end;

end.
