-------------------------------------------------------------------------------
--
-- Copyright © 2001, 2002 by Thomas Wolf.
--
-- 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 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 with this distribution,
-- see file "GPL.txt". If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
-- USA.
--
--
-- 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.
--
--
--
-- Thomas Wolf (TW)
--
--
--
-- Routines for converting @Ada.Calendar.Time@ values to strings. Identical
-- in function to the operations in
-- Util.Calendars.Western
-- and Util.Times.IO.
--
-- Provided nonetheless because one doesn't always want to drag in all the
-- extended time and calendar support, especially for simple applications.
--
--
--
-- Fully task-safe; not abortion-safe.
--
--
--
--
--
-- 13-MAR-2002 TW Initial version.
--
-------------------------------------------------------------------------------
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;