-------------------------------------------------------------------------------
--
--  <STRONG>Copyright &copy; 2001, 2002 by Thomas Wolf.</STRONG>
--  <BLOCKQUOTE>
--    This piece of software is free software; you can redistribute it and/or
--    modify it under the terms of the  GNU General Public License as published
--    by the Free Software  Foundation; either version 2, or (at your option)
--    any later version. This software is distributed in the hope that it will
--    be useful, but <EM>without any warranty</EM>; without even the implied
--    warranty of <EM>merchantability or fitness for a particular purpose.</EM>
--    See the GNU General Public License for  more details. You should have
--    received a copy of the GNU General Public License with this distribution,
--    see file "<A HREF="GPL.txt">GPL.txt</A>". If not, write to the Free
--    Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
--    USA.
--  </BLOCKQUOTE>
--  <BLOCKQUOTE>
--    As a special exception from the GPL, if other files instantiate generics
--    from this unit, or you link this unit with other files to produce an
--    executable, this unit does not by itself cause the resulting executable
--    to be covered by the GPL. This exception does not however invalidate any
--    other reasons why the executable file might be covered by the GPL.
--  </BLOCKQUOTE>
--
--  <AUTHOR>
--    Thomas Wolf  (TW) <E_MAIL>
--  </AUTHOR>
--
--  <PURPOSE>
--    Routines for converting @Ada.Calendar.Time@ values to strings. Identical
--    in function to the operations in <CODE>
--    <A HREF="util-calendars-western.html">Util.Calendars.Western</A></CODE>
--    and <CODE><A HREF="util-times-io.html">Util.Times.IO</A></CODE>.
--
--    Provided nonetheless because one doesn't always want to drag in all the
--    extended time and calendar support, especially for simple applications.
--  </PURPOSE>
--
--  <TASKING>
--    Fully task-safe; not abortion-safe.
--  </TASKING>
--
--  <NO_STORAGE>
--
--  <HISTORY>
--    13-MAR-2002   TW  Initial version.
--  </HISTORY>
-------------------------------------------------------------------------------

pragma License (Modified_GPL);

with Ada.Strings.Fixed;
with Ada.Text_IO;

package body Util.Calendar.IO is

   use Ada.Calendar;

   ----------------------------------------------------------------------------
   --  Utility functions

   function Pad
     (Source : in String;
      Count  : in Natural   := 2;
      Pad    : in Character := '0')
     return String
     renames Ada.Strings.Fixed.Tail;
   --  'Tail' is such a misleading name: we don't want to get at source's
   --  tail, we want to right-align and pad it with leading zeroes!

   function Trim
     (Source : in String;
      Side   : in Ada.Strings.Trim_End := Ada.Strings.Both)
     return String
     renames Ada.Strings.Fixed.Trim;
   --  Renaming to supply the 'Side' argument.

   ----------------------------------------------------------------------------
   --  Images for type 'Day_Duration'

   function Image
     (Instant      : in Ada.Calendar.Day_Duration;
      With_Seconds : in Boolean := True;
      AM_PM        : in Boolean := False)
     return String
   is
   begin
      if not AM_PM then
         declare
            H : Hours_Type;
            M : Minutes_Type;
            S : Seconds_Type;
            F : Day_Duration;
         begin
            Split (Instant, H, M, S, F);
            if not With_Seconds then
               return Pad (Trim (Hours_Type'Image (H))) & ':' &
                      Pad (Trim (Minutes_Type'Image (M)));
            else
               return Pad (Trim (Hours_Type'Image (H))) & ':' &
                      Pad (Trim (Minutes_Type'Image (M))) & ':' &
                      Pad (Trim (Seconds_Type'Image (S)));
            end if;
         end;
      else
         if Instant = 0.0 then
            return "Midnight";
         elsif Instant = 43_200.0 then
            return "Noon";
         end if;
         if Instant > 43_200.0 then
            if Instant >= 43_200.0 + 3_600.0 then
               return Image (Instant - 43_200.0, With_Seconds) & " pm";
            else
               --  Hmmm... I believe times between noon and 13:00 are usually
               --  given as "12:xx pm"?
               return Image (Instant, With_Seconds) & " pm";
            end if;
         else
            return Image (Instant, With_Seconds) & " am";
         end if;
      end if;
   end Image;

   package DIO is new Ada.Text_IO.Fixed_IO (Day_Duration);

   function Image
     (Instant   : in Ada.Calendar.Day_Duration;
      Precision : in Natural;
      AM_PM     : in Boolean := False)
     return String
   is
   begin
      if not AM_PM then
         declare
            Frac : String (1 .. Day_Duration'Fore + 1 +
                           Natural'Max (Day_Duration'Aft, Precision));
            H    : Hours_Type;
            M    : Minutes_Type;
            S    : Seconds_Type;
            F    : Day_Duration;
            HH   : Natural;
         begin
            Split (Instant, H, M, S, F);
            --  HH is *not* Hours_Type because it may overflow to 24!
            HH := Natural (H);
            --  We nicely delegate the whole rounding business to 'DIO'!
            DIO.Put
              (To => Frac, Item => F, Aft => Precision, Exp => 0);
            declare
               Fraction : constant String := Trim (Frac);
            begin
               --  Since F is always positive, Fraction now has the format
               --  "D.DDDDD".
               if Fraction (Fraction'First) = '1' or else
                  (Precision = 0 and then F >= 0.5)
               then
                  --  Propagate carry:
                  if S = Seconds_Type'Last then
                     if M = Minutes_Type'Last then
                        HH := HH + 1;
                        M  := 0;
                     else
                        M := M + 1;
                     end if;
                     S := 0;
                  else
                     S := S + 1;
                  end if;
               end if;
               if Precision > 0 then
                  return Pad (Trim (Natural'Image (HH))) & ':' &
                         Pad (Trim (Minutes_Type'Image (M))) & ':' &
                         Pad (Trim (Seconds_Type'Image (S))) &
                         Fraction (Fraction'First + 1 .. Fraction'Last);
               else
                  return Pad (Trim (Natural'Image (HH))) & ':' &
                         Pad (Trim (Minutes_Type'Image (M))) & ':' &
                         Pad (Trim (Seconds_Type'Image (S)));
               end if;
            end;
         end;
      else
         --  AM/PM Format
         if Instant = 0.0 then
            return "Midnight";
         elsif Instant = 43_200.0 then
            return "Noon";
         end if;
         if Instant > 43_200.0 then
            --  What about times between 12:00 and 13:00 here? Rounding of
            --  times > 23:59:59.5 may give "12:00:00 pm", but so should
            --  rounding down of times between 12:00:00 and 12:00:00.5. For
            --  the latter case, we return "00:00:00 pm"; client code can
            --  check for that and change it into "12:00:00 pm" if desired.
            return Image (Instant - 43_200.0, Precision) & " pm";
         else
            return Image (Instant, Precision) & " am";
         end if;
      end if;
   end Image;

   function Image
     (Date      : in Ada.Calendar.Time;
      Format    : in Date_Format := YMD;
      Separator : in String      := "-";
      Padding   : in Boolean     := True)
     return String
   is

      function Canonical
        (Source  : in String;
         Padding : in Boolean)
        return String
      is
      begin --  Canonical
         if Padding then
            return Pad (Trim (Source));
         else
            return Trim (Source);
         end if;
      end Canonical;

      Y : Year_Number;
      M : Month_Number;
      D : Day_Number;
      S : Day_Duration;

   begin
      Split (Date, Y, M, D, S);
      declare
         YS : constant String := Trim (Year_Number'Image (Y));
         MS : constant String := Canonical (Month_Number'Image (M), Padding);
         DS : constant String := Canonical (Day_Number'Image (D), Padding);
      begin
         case Format is
            when DMY =>
               return DS & Separator & MS & Separator & YS;
            when MDY =>
               return MS & Separator & DS & Separator & YS;
            when YMD =>
               return YS & Separator & MS & Separator & DS;
         end case;
      end;
   end Image;

end Util.Calendar.IO;

