{ Time and Data Unit

  File:	     TAD_UNIT.TEXT
  Date:	     30-Aug-82
  Version:   1
  
  COPYRIGHT (c) 1982 SAGE Computer Technology
  
  
  Requirements:
  
     Uses SIO_UNIT.CODE from SAGE Tool Kit.
  
  
  Development History:
  
  1	30-Aug-82  Initial Release
  
}

UNIT TAD_Unit;

INTERFACE

TYPE
  TAD_Style = SET OF (TAD_Short,TAD_Long);
  TAD_Ptime = PACKED ARRAY[0..3] OF 0..255;

PROCEDURE TAD_TimO(Hours,Minutes,Seconds:INTEGER; Method:TAD_Style;
		   VAR Result:STRING);
PROCEDURE TAD_DatO(Day,Month,Year:INTEGER; Method:TAD_Style; VAR Result:STRING);
PROCEDURE TAD_DOWO(DayOfWeek:INTEGER; Method:TAD_Style; VAR Result:STRING);

FUNCTION TAD_TimI(VAR Cursor:INTEGER; VAR Source:STRING; Method:TAD_Style;
		  VAR Hours,Minutes,Seconds:INTEGER):BOOLEAN;
FUNCTION TAD_DatI(VAR Cursor:INTEGER; VAR Source:STRING; Method:TAD_Style;
		  VAR Day,Month,Year:INTEGER):BOOLEAN;

PROCEDURE TAD_Pack(Day,Month,Year,Hours,Minutes,Seconds:INTEGER;
		   VAR Result:TAD_Ptime);
PROCEDURE TAD_Unpack(Source:TAD_Ptime; VAR Day,Month,Year,
		     Hours,Minutes,Seconds,DayofWeek,Julian:INTEGER);

PROCEDURE TAD_Fetch(VAR Result:STRING);
PROCEDURE TAD_Set(Day,Month,Year,Hours,Minutes,Seconds:INTEGER);

IMPLEMENTATION

{$U SIO_UNIT.CODE}
USES SIO_Unit;

CONST
  BaseYear = 1970;

VAR
  MN:ARRAY[1..13] OF INTEGER;

PROCEDURE TAD_TimO;
VAR
  PostScript:STRING[4];

PROCEDURE Mistake;
BEGIN
  Result:=CONCAT(Result,'??');
END;

BEGIN
  PostScript:='';
  IF (Hours < 24) AND (Hours >=0) THEN
    BEGIN
      IF TAD_Short IN Method THEN
	BEGIN
	  IF Hours >= 12 THEN PostScript:=' PM' ELSE PostScript:=' AM';
	  IF Hours >= 13 THEN Hours:=Hours-12;
	  IF Hours =   0 THEN Hours:=12;
	END;
      IF Hours < 10 THEN SIO_CharWt(' ',Result);
      SIO_IntWt(Hours,Result)
    END
  ELSE
    Mistake;
  SIO_CharWt(':',Result);
  IF (Minutes < 60) AND (Minutes >=0) THEN
    BEGIN
      IF Minutes < 10 THEN SIO_CharWt('0',Result);
      SIO_IntWt(Minutes,Result)
    END
  ELSE
    Mistake;
  IF TAD_Long IN Method THEN
    BEGIN
      SIO_CharWt(':',Result);
      IF (Seconds < 60) AND (Seconds >=0) THEN
	BEGIN
	  IF Seconds < 10 THEN SIO_CharWt('0',Result);
	  SIO_IntWt(Seconds,Result)
	END
      ELSE
	Mistake;
    END;
  IF LENGTH(PostScript) > 0 THEN Result:=CONCAT(Result,PostScript);
END;

PROCEDURE TAD_DatO;
VAR
  Temp:STRING;

PROCEDURE Mistake;
BEGIN
  Result:=CONCAT(Result,'??');
END;

BEGIN
  IF NOT( TAD_Short IN Method ) THEN
    BEGIN
      Temp:='???';
      CASE Month OF
	1:Temp:='January';
	2:Temp:='February';
	3:Temp:='March';
	4:Temp:='April';
	5:Temp:='May';
	6:Temp:='June';
	7:Temp:='July';
	8:Temp:='August';
	9:Temp:='September';
	10:Temp:='October';
	11:Temp:='November';
	12:Temp:='December';
      END;
      IF NOT( TAD_Long IN Method ) THEN
	{$R-}
	Temp[0]:=CHR(3);
	{$R+}
    END;
  IF TAD_Short IN Method THEN
    BEGIN
      IF (Month < 13) AND (Month > 0) THEN
	BEGIN
	  IF Month < 10 THEN SIO_CharWt(' ',Result);
	  SIO_IntWt(Month,Result);
	END
      ELSE
	Mistake;
      SIO_CharWt('/',Result);
      IF (Day < 32) AND (Day > 0) THEN
	BEGIN
	  IF Day < 10 THEN SIO_CharWt('0',Result);
	  SIO_IntWt(Day,Result);
	END
      ELSE
	Mistake;
      SIO_CharWt('/',Result);
      IF (Year < 100) AND (Year >= 0) THEN
	BEGIN
	  IF Year < 10 THEN SIO_CharWt('0',Result);
	  SIO_IntWt(Year,Result);
	END
      ELSE
	Mistake;
    END
  ELSE
    IF TAD_Long IN Method THEN
      BEGIN
	Result:=CONCAT(Result,Temp,' ');
	IF (Day < 32) AND (Day > 0) THEN
	  BEGIN
	    IF Day < 10 THEN SIO_CharWt(' ',Result);
	    SIO_IntWt(Day,Result);
	  END
	ELSE
	  Mistake;
	Result:=CONCAT(Result,', ');
	IF (Year < 100) AND (Year >= 0) THEN
	  BEGIN
	    IF Year > (BaseYear MOD 100) THEN
	      Year:=Year+1900 ELSE Year:=Year+2000;
	    SIO_IntWt(Year,Result);
	  END
	ELSE
	  BEGIN
	    Mistake;
	    Mistake;
	  END;
      END
    ELSE
      BEGIN
	IF (Day < 32) AND (Day > 0) THEN
	  BEGIN
	    IF Day < 10 THEN SIO_CharWt(' ',Result);
	    SIO_IntWt(Day,Result);
	  END
	ELSE
	  Mistake;
	Result:=CONCAT(Result,'-',Temp,'-');
	IF (Year < 100) AND (Year >= 0) THEN
	  BEGIN
	    IF Year < 10 THEN SIO_CharWt('0',Result);
	    SIO_IntWt(Year,Result);
	  END
	ELSE
	  Mistake;
      END;
END;

PROCEDURE TAD_DOWO;
VAR
  Temp:STRING[9];

BEGIN
  Temp:='???';
  CASE DayOfWeek OF
    0:Temp:='Sunday';
    1:Temp:='Monday';
    2:Temp:='Tuesday';
    3:Temp:='Wednesday';
    4:Temp:='Thursday';
    5:Temp:='Friday';
    6:Temp:='Saturday';
  END;
  IF TAD_Short IN Method THEN
    {$R-}
    Temp[0]:=CHR(3);
    {$R+}
  Result:=CONCAT(Result,Temp);
END;

FUNCTION TAD_TimI;
VAR
  TempHours,TempMinutes,TempSeconds:INTEGER;
  StartCursor:INTEGER;
  Found,Dummy:BOOLEAN;
  TempString:STRING;
BEGIN
  TempSeconds:=0;
  Found:=FALSE;
  StartCursor:=Cursor;
  Dummy:=SIO_ByDlim(Cursor,Source,' ');
  IF SIO_IntRd(Cursor,Source,TempHours) THEN
    IF (TempHours >= 0) AND (TempHours < 24) THEN
      IF SIO_CharRd(Cursor,Source,':') THEN
	IF SIO_IntRd(Cursor,Source,TempMinutes) THEN
	  IF (TempMinutes >= 0) AND (TempMinutes < 60) THEN
	    BEGIN
	      IF SIO_CharRd(Cursor,Source,':') THEN
		BEGIN
		  IF SIO_IntRd(Cursor,Source,TempSeconds) THEN
		    IF (TempSeconds >= 0) AND (TempSeconds < 60) THEN
		      Found:=TRUE;
		END
	      ELSE
		Found:=TRUE;
	    END;
  IF Found THEN
    IF TAD_Short IN Method THEN
      BEGIN
	Found:=FALSE;
	Dummy:=SIO_ByDlim(Cursor,Source,' ');
	TempString:='';
	IF (TempHours > 0) AND (TempHours < 13) THEN
	  IF SIO_AlphRd(Cursor,Source,TempString) THEN
	    BEGIN
	      SIO_Upper(TempString);
	      IF TempString = 'AM' THEN
		BEGIN
		  Found:=TRUE;
		  IF TempHours = 12 THEN TempHours:=0;
		END
	      ELSE
		IF TempString = 'PM' THEN
		  BEGIN
		    Found:=TRUE;
		    IF TempHours <> 12 THEN TempHours:=TempHours+12;
		  END;
	    END;
      END;
  IF Found THEN
    BEGIN
      Hours:=TempHours;
      Minutes:=TempMinutes;
      Seconds:=TempSeconds;
      TAD_TimI:=TRUE;
    END
  ELSE
    BEGIN
      Cursor:=StartCursor;
      TAD_TimI:=FALSE;
    END;
END;

FUNCTION TAD_DatI;
VAR
  TempDay,TempMonth,TempYear:INTEGER;
  StartCursor:INTEGER;
  Found,Dummy:BOOLEAN;
  TestString:STRING;
  MonthString:STRING;

PROCEDURE BySpaces;
BEGIN
  Dummy:=SIO_ByDlim(Cursor,Source,' ');
END;

FUNCTION GetDay:BOOLEAN;
BEGIN
  GetDay:=FALSE;
  BySpaces;
  IF SIO_IntRd(Cursor,Source,TempDay) THEN
    IF (TempDay > 0) AND (TempDay < 32) THEN GetDay:=TRUE;
END;

FUNCTION GetMonth:BOOLEAN;
BEGIN
  GetMonth:=FALSE;
  TestString:='';
  BySpaces;
  IF SIO_AlphRd(Cursor,Source,TestString) THEN
    IF LENGTH(TestString) >= 3 THEN
      BEGIN
	{$R-}
	TestString[0]:=CHR(3);
	{$R+}
	SIO_Upper(TestString);
	TempMonth:=POS(TestString,MonthString);
	IF (TempMonth MOD 3) = 1 THEN
	  BEGIN
	    TempMonth:=(TempMonth DIV 3) + 1;
	    GetMonth:=TRUE;
	  END;
      END;
END;

FUNCTION GetYear:BOOLEAN;
BEGIN
  GetYear:=FALSE;
  Dummy:=SIO_ByDlim(Cursor,Source,' ,');
  IF SIO_IntRd(Cursor,Source,TempYear) THEN
    IF (TempYear >= 0) THEN
      BEGIN
	IF (TempYear < 100) THEN GetYear:=TRUE
	ELSE
	  IF (TempYear >= BaseYear) AND (TempYear < (BaseYear+100)) THEN
	    BEGIN
	      TempYear:=TempYear MOD 100;
	      GetYear:=TRUE;
	    END;
      END;
END;

PROCEDURE Update(Number:INTEGER);
BEGIN
  IF Number <> 3 THEN
    BEGIN
      IF TAD_Short IN Method THEN
	BEGIN
	  Found:=TRUE;
	  Day:=TempDay;
	  IF Number > 1 THEN Month:=TempMonth;
	END;
    END
  ELSE
    BEGIN
      Found:=TRUE;
      Day:=TempDay;
      Month:=TempMonth;
      Year:=TempYear;
    END;
END;

BEGIN { TAD_DatI }
  Found:=FALSE;
  StartCursor:=Cursor;
  MonthString:='JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
  IF GetDay THEN
    BEGIN
      BySpaces;
      IF SIO_CharRd(Cursor,Source,'-') THEN
	BEGIN
	  IF GetMonth THEN
	    BEGIN
	      BySpaces;
	      IF SIO_CharRd(Cursor,Source,'-') THEN
		BEGIN
		  IF GetYear THEN Update(3);
		END
	      ELSE
		Update(2); {Day & Month}
	    END;
	END
      ELSE
	BEGIN
	  BySpaces;
	  IF SIO_CharRd(Cursor,Source,'/') THEN
	    BEGIN
	      TempMonth:=TempDay;
	      IF (TempMonth > 0) AND (TempMonth<13) THEN
		IF GetDay THEN
		  BEGIN
		    BySpaces;
		    IF SIO_CharRd(Cursor,Source,'/') THEN
		      BEGIN
			IF GetYear THEN Update(3);
		      END
		    ELSE
		      Update(2);
		  END;
	    END
	  ELSE
	    Update(1); {Just days}
	END;
    END
  ELSE
    IF GetMonth THEN
      IF GetDay THEN
	BEGIN
	  IF GetYear THEN Update(3) ELSE Update(2);
	END;
  
  IF Found THEN
    BEGIN
      IF Day > 29 THEN
	IF Month = 2 THEN Found:=FALSE
	ELSE
	  IF Day = 31 THEN
	    IF Month IN [4,6,9,11] THEN Found:=FALSE;
    END;
  
  IF Found THEN
    TAD_DatI:=TRUE
  ELSE
    BEGIN
      TAD_DatI:=FALSE;
      Cursor:=StartCursor;
    END;
END;

PROCEDURE TAD_Pack;
VAR
  N1,N2,N3,N4:INTEGER;
  I,J,K,DayCount,Terms:INTEGER;
BEGIN
  Year:=Year+1900;
  IF Year < BaseYear THEN Year:=Year+100;
  DayCount:=Day+MN[Month]-1;
  IF (Month>2) AND (Year MOD 4 <> 0) THEN DayCount:=DayCount-1;
  J:=BaseYear-1;
  K:=4*(J DIV 4);
  Year:=Year-1-K;
  Terms:=Year DIV 4;
  Year:=(Year MOD 4) + K - J;
  I:=DayCount+Year+Terms;
  J:=I DIV 2;
  N1:=128*(I MOD 2) + (16*Hours) + (60*Minutes) + Seconds;
  N2:=(N1 DIV 256) + J + (14*Hours) + (81*DayCount) + (51*Year) + (31*Terms);
  N3:=(N2 DIV 256) + DayCount + (225*Year) + (134*Terms);
  N4:=(N3 DIV 256) + Year + (7*Terms);
  Result[3]:=ORD(ODD(N1) AND ODD(255));
  Result[2]:=ORD(ODD(N2) AND ODD(255));
  Result[1]:=ORD(ODD(N3) AND ODD(255));
  Result[0]:=ORD(ODD(N4) AND ODD(255));
END;

PROCEDURE TAD_Unpack;
VAR
  N1,N2,N3,N4:INTEGER;
  I,J,K,DayCount:INTEGER;
BEGIN
  N1:=Source[3];
  N2:=Source[2];
  N3:=Source[1];
  N4:=Source[0];
  Seconds:= (N4 + N3 + N2) * 16 + N1;
  Minutes:= 20*N4 + 12*N3 + 4*N2 + (Seconds DIV 60);
  Hours:=    4*N4 + 18*N3 + (Minutes DIV 60);
  DayCount:=194*N4 + (Hours DIV 24);
  
  Seconds:= Seconds MOD 60;
  Minutes:= Minutes MOD 60;
  Hours:=   Hours   MOD 24;
  
  I:=DayCount DIV 1461; { Four year terms in day count }
  J:=BaseYear-1;	{ Calendar years to Base Year  }
  K:=J DIV 4;		{ Four year terms to end of leap year before
			  Base Year}
  Day:=(DayCount MOD 1461) + 365*(J-4*K); {Days from end of last leap year }
  DayOfWeek:=(5*(I+K)+Day) MOD 7;
  J:=(4*Day+3) DIV 1461;		{More years in revised day count}
  Year:=(4*(I+K)+J+1) MOD 100;		{Current year}
  Day:=1+Day-((1461*J) DIV 4);		{Julian date}
  Julian:=Day;
  IF (Day>59) AND ((Year MOD 4) <> 0) THEN Day:=Day+1;
  Month:=(Day DIV 30)+1;		{Trial value}
  IF Day<=MN[Month] THEN Month:=Month-1;
  Day:=Day-MN[Month];
END;

PROCEDURE TAD_Fetch;
VAR
  Day,Month,Year,Hours,Minutes,Seconds:INTEGER;
  DayofWeek,Julian:INTEGER;
  TimeValue:TAD_Ptime;
BEGIN
  UNITREAD(129,TimeValue,0,0,2);
  IF (TimeValue[0] <> 0) OR (TimeValue[1] <> 0) OR
     (TimeValue[2] <> 0) OR (TimeValue[3] <> 0) THEN
    BEGIN
      UNITREAD(129,TimeValue,0,0,1);
      TAD_Unpack(TimeValue,Day,Month,Year,Hours,Minutes,Seconds,
		 DayofWeek,Julian);
      TAD_DatO(Day,Month,Year,[],Result);
      SIO_Fill(2,Result);
      TAD_TimO(Hours,Minutes,Seconds,[TAD_Long],Result);
    END
  ELSE
    Result:=CONCAT(Result,' No time was set.  ');
END;

PROCEDURE TAD_Set;
VAR
  TimeValue:TAD_Ptime;
BEGIN
  IF (Day>0) AND (Day<32) AND (Month>0) AND (Month<13) AND
     (Year>=0) AND (Year<100) AND (Hours>=0) AND (Hours<24) AND
     (Minutes>=0) AND (Minutes<60) AND (Seconds>=0) AND (Seconds<60) THEN
       BEGIN
	 TAD_Pack(Day,Month,Year,Hours,Minutes,Seconds,TimeValue);
	 UNITWRITE(129,TimeValue,0,0,0);
       END;
END;

BEGIN
  { Initialize with elapsed days at
    beginning of each month in a leap
    year. }
  MN[ 1]:=  0; MN[ 2]:= 31; MN[ 3]:= 60;
  MN[ 4]:= 91; MN[ 5]:=121; MN[ 6]:=152;
  MN[ 7]:=182; MN[ 8]:=213; MN[ 9]:=244;
  MN[10]:=274; MN[11]:=305; MN[12]:=335;
  MN[13]:=366;
END.

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  