-------------------------------------------------------------------------------
-- (C) Altran Praxis Limited
-------------------------------------------------------------------------------
--
-- The SPARK toolset is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
-- Software Foundation; either version 3, or (at your option) any later
-- version. The SPARK toolset 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 General
-- Public License for more details. You should have received a copy of the GNU
-- General Public License distributed with the SPARK toolset; see file
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy of
-- the license.
--
--=============================================================================

--------------------------------------------------------------------------------
--Synopsis:                                                                   --
--                                                                            --
--Format the current date and time in the form:                               --
--24-DEC-1988 12:00:00.00                                                     --
--                                                                            --
--Separate of Banner package                                                  --
--------------------------------------------------------------------------------
with Calendar;
separate (Banner)
procedure DateTime (DateString : out TypDateTime) is
   --# hide DateTime;

   --
   -- FUNCTION :
   --
   -- Returns a string indicating the current date and time as a 23 character
   -- string in the format 24-DEC-1988 12:00:00.00
   --
   -- OPERATION :
   --
   -- Uses the standard package CALENDAR.
   --

   MonthsInYear       : constant := 12;
   DaysInMonth        : constant := 31;
   HoursInDay         : constant := 24;
   MinutesInHour      : constant := 60;
   SecondsInMinute    : constant := 60;
   HundredthsInSecond : constant := 100;

   type YearsType is range 1991 .. 2099;
   --# assert YearsType'Base is Short_Integer;
   type MonthsType is range 1 .. MonthsInYear;
   --# assert MonthsType'Base is Short_Short_Integer;
   type DaysType is range 1 .. DaysInMonth;
   --# assert DaysType'Base is Short_Short_Integer;
   type HoursType is range 0 .. HoursInDay - 1;
   --# assert HoursType'Base is Short_Short_Integer;
   type MinutesType is range 0 .. MinutesInHour - 1;
   --# assert MinutesType'Base is Short_Short_Integer;
   type SecondsType is range 0 .. SecondsInMinute - 1;
   --# assert SecondsType'Base is Short_Short_Integer;
   type HundredthsType is range 0 .. HundredthsInSecond - 1;
   --# assert HundredthsType'Base is Short_Short_Integer;

   subtype Digit is Natural range 0 .. 9;

   Year       : YearsType;
   Month      : MonthsType;
   Day        : DaysType;
   Hours      : HoursType;
   Minutes    : MinutesType;
   Seconds    : SecondsType;
   Hundredths : HundredthsType;

   procedure DecodeTime
     (Time       : in     Calendar.Time;
      Year       :    out YearsType;
      Month      :    out MonthsType;
      Day        :    out DaysType;
      Hours      :    out HoursType;
      Minutes    :    out MinutesType;
      Seconds    :    out SecondsType;
      Hundredths :    out HundredthsType)
   is

      SystemTime : Duration;

      procedure DecodeDuration
        (Time       : in     Duration;
         Hours      :    out HoursType;
         Minutes    :    out MinutesType;
         Seconds    :    out SecondsType;
         Hundredths :    out HundredthsType)
      is
         type TimeOfDay is range 0 .. HoursInDay * MinutesInHour * SecondsInMinute * HundredthsInSecond - 1;
         --# assert Type'Base is Integer;
         SystemTime : TimeOfDay;
      begin

         SystemTime := TimeOfDay (Time * Duration'(100.0));

         Hours      := HoursType (SystemTime / (MinutesInHour * SecondsInMinute * HundredthsInSecond));
         Minutes    := MinutesType (SystemTime / (SecondsInMinute * HundredthsInSecond) mod MinutesInHour);
         Seconds    := SecondsType (SystemTime / HundredthsInSecond mod SecondsInMinute);
         Hundredths := HundredthsType (SystemTime mod HundredthsInSecond);

      end DecodeDuration;

   begin

      Calendar.Split
        (Date    => Time,
         Year    => Calendar.Year_Number (Year),
         Month   => Calendar.Month_Number (Month),
         Day     => Calendar.Day_Number (Day),
         Seconds => SystemTime);

      DecodeDuration (SystemTime, Hours, Minutes, Seconds, Hundredths);

   end DecodeTime;

   function DigitImage (Value : Digit) return Character is
      type DigitImages is array (Digit) of Character;

      Image : constant DigitImages := DigitImages'('0', '1', '2', '3', '4', '5', '6', '7', '8', '9');

   begin
      return Image (Value);
   end DigitImage;

   function DateImage
     (Day   : DaysType;
      Month : MonthsType;
      Year  : YearsType)
     return  String
   is
      function YearImage (Year : YearsType) return String is
         DigitsInYear : constant := 4;

         subtype DigitInYear is Positive range 1 .. DigitsInYear;
         subtype ResultType is String (DigitInYear);

         Result : ResultType;

         function GetYearDigit (Year : YearsType;
                                Pos  : DigitInYear) return Digit is
         begin
            return Digit (Year / 10 ** (DigitInYear'Last - Pos) mod 10);
         end GetYearDigit;

      begin

         for I in DigitInYear loop
            Result (I) := DigitImage (GetYearDigit (Year, I));
         end loop;

         return Result;

      end YearImage;

      function MonthImage (Month : MonthsType) return String is
         CharactersInMonth : constant := 3;

         subtype CharacterInMonth is Positive range 1 .. CharactersInMonth;
         subtype MonthNames is String (CharacterInMonth);
         type NamesOfMonths is array (MonthsType) of MonthNames;

         Image : constant NamesOfMonths :=
           NamesOfMonths'("JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC");

      begin
         return Image (Month);
      end MonthImage;

      function DayImage (Day : DaysType) return String is
         DigitsInDay : constant := 2;

         subtype DigitInDay is Positive range 1 .. DigitsInDay;
         subtype ResultType is String (DigitInDay);

         Result : ResultType;

         function GetDayDigit (Day : DaysType;
                               Pos : DigitInDay) return Digit is
         begin
            return Digit (Day / 10 ** (DigitInDay'Last - Pos) mod 10);
         end GetDayDigit;

      begin

         for I in DigitInDay loop
            Result (I) := DigitImage (GetDayDigit (Day, I));
         end loop;

         return Result;

      end DayImage;

   begin
      return DayImage (Day) & '-' & MonthImage (Month) & '-' & YearImage (Year);
   end DateImage;

   function TimeImage
     (Hours      : HoursType;
      Minutes    : MinutesType;
      Seconds    : SecondsType;
      Hundredths : HundredthsType)
     return       String
   is
      function HourImage (Hour : HoursType) return String is
         DigitsInHour : constant := 2;

         subtype DigitInHour is Positive range 1 .. DigitsInHour;
         subtype ResultType is String (DigitInHour);

         Result : ResultType;

         function GetHourDigit (Hour : HoursType;
                                Pos  : DigitInHour) return Digit is
         begin
            return Digit (Hour / 10 ** (DigitInHour'Last - Pos) mod 10);
         end GetHourDigit;

      begin

         for I in DigitInHour loop
            Result (I) := DigitImage (GetHourDigit (Hour, I));
         end loop;

         return Result;

      end HourImage;

      function MinuteImage (Minute : MinutesType) return String is
         DigitsInMinute : constant := 2;

         subtype DigitInMinute is Positive range 1 .. DigitsInMinute;
         subtype ResultType is String (DigitInMinute);

         Result : ResultType;

         function GetMinuteDigit (Minute : MinutesType;
                                  Pos    : DigitInMinute) return Digit is
         begin
            return Digit (Minute / 10 ** (DigitInMinute'Last - Pos) mod 10);
         end GetMinuteDigit;

      begin

         for I in DigitInMinute loop
            Result (I) := DigitImage (GetMinuteDigit (Minute, I));
         end loop;

         return Result;

      end MinuteImage;

      function SecondImage (Second : SecondsType) return String is
         DigitsInSecond : constant := 2;

         subtype DigitInSecond is Positive range 1 .. DigitsInSecond;
         subtype ResultType is String (DigitInSecond);

         Result : ResultType;

         function GetSecondDigit (Second : SecondsType;
                                  Pos    : DigitInSecond) return Digit is
         begin
            return Digit (Second / 10 ** (DigitInSecond'Last - Pos) mod 10);
         end GetSecondDigit;

      begin

         for I in DigitInSecond loop
            Result (I) := DigitImage (GetSecondDigit (Second, I));
         end loop;

         return Result;

      end SecondImage;

      function HundredthImage (Hundredth : HundredthsType) return String is
         DigitsInHundredth : constant := 2;

         subtype DigitInHundredth is Positive range 1 .. DigitsInHundredth;
         subtype ResultType is String (DigitInHundredth);

         Result : ResultType;

         function GetHundredthDigit (Hundredth : HundredthsType;
                                     Pos       : DigitInHundredth) return Digit is
         begin
            return Digit (Hundredth / 10 ** (DigitInHundredth'Last - Pos) mod 10);
         end GetHundredthDigit;

      begin

         for I in DigitInHundredth loop
            Result (I) := DigitImage (GetHundredthDigit (Hundredth, I));
         end loop;

         return Result;

      end HundredthImage;

   begin
      return HourImage (Hours) & ':' & MinuteImage (Minutes) & ':' & SecondImage (Seconds) & '.' & HundredthImage (Hundredths);
   end TimeImage;

begin

   DecodeTime (Calendar.Clock, Year, Month, Day, Hours, Minutes, Seconds, Hundredths);

   DateString := DateImage (Day, Month, Year) & ' ' & TimeImage (Hours, Minutes, Seconds, Hundredths);

end DateTime;
