{ **************************************
  **************************************
  ***            STARDATE            ***
  ***                                ***
  ***           Written by           ***
  ***                                ***
  ***         David Trimboli         ***
  ***                                ***
  ***             D.A.T.             ***
  ***                                ***
  ***        Stardate 95186.8        ***
  ***         (9 March 1995)         ***
  ***                                ***
  ***   Modified Stardate 95258.3    ***
  ***         (4 April 1995)         ***
  ***                                ***
  *** Also Modified Stardate 96090.1 ***
  ***       (2 February 1996)        ***
  ***                                ***
  **************************************
  **************************************}

program Stardate;

uses Dos;

   const
      Days_In_Year = 365.25;
      Days_In_Century = 36525;
      Time_Zone = 5; { Eastern Standard Time }

   var
      StDt, Days: real;
      Year, Month, Day, DayOfWeek, L_LY: word;

   function Last_LY (CurYr: word): word;
      {--------------------------------------------------------------}
      { Determines the last leap year to occur before the current    }
      { year (or the current year itself, if it is a leap year), and }
      { outputs the last two digits of this year.                    }
      {--------------------------------------------------------------}

      begin {Last_LY}
	 while (CurYr mod 4) <> 0 do
	    Dec (CurYr);
	 Last_LY := (CurYr mod 100)
      end; {Last_LY}

   function Days_UpTo_LY (LY: word): real;
      {---------------------------------------------------------------}
      { Determines the number of days that have passed since the      }
      { beginning of the century up to, but not including, the last   }
      { leap year.                                                    }
      {---------------------------------------------------------------}

      begin
	 Days_UpTo_LY := LY * Days_In_Year
      end;

   function Days_Since_LY (CurYr, LY: word): integer;
      {---------------------------------------------------------------}
      { Finds the number of days that have passed since the beginning }
      { of the last leap year and the beginning of the current year.  }
      {---------------------------------------------------------------}

      var
	 TempYr: word;
	 NumDays: integer;

      begin
	 TempYr := LY;
	 NumDays := 0;
	 while TempYr <> (CurYr mod 100) do
	    begin
	       NumDays := NumDays + 365;
	       if TempYr = LY then
		  NumDays := NumDays + 1;
	       Inc (TempYr)
	    end;
	 Days_Since_LY := NumDays
      end;

   function Prev_Months (CurYr, Month: word): integer;
      {----------------------------------------------------------------}
      { Determines the number of days that have passed since 1 January }
      { of the current year to the beginning of this month.                                           }
      {----------------------------------------------------------------}

      var
	 MonthIndex: word;
	 NumDays: integer;

      begin
	 MonthIndex := 1;
	 NumDays := 0;
	 while MonthIndex < Month do
	    begin
	       case MonthIndex of
		  1, 3, 5, 7, 8, 10:   NumDays := NumDays + 31;
		  4, 6, 9, 11:         NumDays := NumDays + 30;
		  2:   if (CurYr mod 4) = 0 then NumDays := NumDays + 29
		       else NumDays := NumDays + 28
		  end; {case}
	       Inc (MonthIndex)
	    end;
	 Prev_Months := NumDays
      end;

   function Num_Days_In_Month (Day: word): word;
      {------------------------------------------------------------------}
      { Returns the number of full days that have been completed in the  }
      { current month.                                                   }
      {------------------------------------------------------------------}

      begin
	 Num_Days_In_Month := Day - 1
      end;

   function Fraction_Of_Day (Month, Day, DayOfWeek: word): real;

	var
	 Hour, Min, Sec, Sec100: word;
	 Frac: real;

       function DST_Detected (Month, Day, DayOfWeek: word): boolean;
	{Determines whether the computer is running on Eastern Standard Time
		or Eastern Daylight Time.}

	 var DST: boolean;
		DayCounter, DayOfWeekCounter: integer;
	    begin
	    DayCounter := Day;
	    DayOfWeekCounter := DayOfWeek;
	    DST := false;
	    if (Month >= 4) and (Month <= 10) then
		begin
		if (Month = 4) and (Day <= 7) then
			while DayCounter <> 0 do
				begin
				if DayOfWeekCounter = 0 then
					DST := true;
				Dec (DayCounter);
				Dec (DayOfWeekCounter)
				end;
		if (Month = 4) and (Day > 7) then
			DST := true;
		if (Month = 10) and (Day >= 25) then
			while DayCounter <> 24 do
				begin
				DST := true;
				if (DayOfWeekCounter = 0) then
					DST := false;
				Dec (DayCounter);
				if DayOfWeekCounter <> 0 then
					Dec (DayOfWeekCounter)
				end;
		if (Month = 10) and (Day < 25) then
			DST := true;
		if (Month > 4) and (Month < 10) then
			DST := true
		end;
		if DST then DST_Detected := true
		else DST_Detected := false
	    
	    end; {DST_Detected}
			
      
      begin
	 Frac := 0.0;
	 GetTime (Hour, Min, Sec, Sec100);
	 if DST_Detected (Month, Day, DayOfWeek) then
	    Hour := Hour - 1;
		{ The previous line subtracts one hour from the current time
			if the computer's clock is currently reading Daylight
			Saving Time. (U.S. definition: begins the first
			Sunday in April and ends the last Sunday in October)}
	 Hour := Hour + Time_Zone;
		{ Adds the time zone correction to resemble the time theoretically set for
		  Greenwich.  Time_Zone is a constant defined at the
		  beginning of the program and must be changed manually to
		  alter the setting. }

	 Frac := Hour / 24;
	 Frac := Frac + (Min/60)/24;
	 Frac := Frac + (Sec/3600)/24;
	 Fraction_Of_Day := Frac
      end;

   function SD (Days: real): real;

      begin
	 SD := (Days / Days_In_Century) * 100000
      end;

   procedure Display_SD (StDt: real);

      begin
	 StDt := (Trunc (StDt * 10) /10);
	 writeln ('Stardate: ', StDt:10:1)
      end;

   begin {main}
      GetDate (Year, Month, Day, DayOfWeek);
      L_LY := Last_LY (Year);
      Days := Days_UpTo_LY (L_LY) + Days_Since_LY (Year, L_LY)
	      + Prev_Months (Year, Month) + Num_Days_In_Month (Day)
	      + Fraction_Of_Day (Month, Day, DayOfWeek);
      StDt := SD (Days);
      Display_SD (StDt)
   end.


	</PRE>