---------------------------------------------------------------------- -- Title : TimeAK -- Version : 1.0 -- Author : David Wallace Croft, CompuServe [76600,102] -- Compiler : Ada -- Unit Type : package body -- Copyright : 1994 David Wallace Croft. All rights reserved. -- Description : Calendar and Time package ---------------------------------------------------------------------- with ConsAK; with StriAK; use StriAK; with Text_IO; use Text_IO; package body TimeAK is ---------------------------------------------------------------------- ---------------------------------------------------------------------- function Convert_Format ( Date_Time_Str : in string ) return Date_Time_Str_Type is ---------------------------------------------------------------------- -- Takes in Date_Time_Str of any known format -- and converts it to format YYYY/MM/DD HH:MM:SS.CC ---------------------------------------------------------------------- Temp : Date_Time_Str_Type := "YYYY/MM/DD HH:MM:SS.CC"; Format : Date_Time_Format_Type; begin Format := Determine_Date_Time_Format ( Date_Time_Str ); case Format is when Unknown => null; when YYYY_MM_DD_HH_MM_SS_CC => Temp ( 01..04 ) := Date_Time_Str ( 01..04 ); Temp ( 06..07 ) := Date_Time_Str ( 06..07 ); Temp ( 09..10 ) := Date_Time_Str ( 09..10 ); Temp ( 12..13 ) := Date_Time_Str ( 12..13 ); Temp ( 15..16 ) := Date_Time_Str ( 15..16 ); Temp ( 18..19 ) := Date_Time_Str ( 18..19 ); Temp ( 21..22 ) := Date_Time_Str ( 21..22 ); when YYYY_MM_DD_HH_MM_SS => Temp ( 01..04 ) := Date_Time_Str ( 01..04 ); Temp ( 06..07 ) := Date_Time_Str ( 06..07 ); Temp ( 09..10 ) := Date_Time_Str ( 09..10 ); Temp ( 12..13 ) := Date_Time_Str ( 12..13 ); Temp ( 15..16 ) := Date_Time_Str ( 15..16 ); Temp ( 18..19 ) := Date_Time_Str ( 18..19 ); when YYYY_MM_DD => Temp ( 01..04 ) := Date_Time_Str ( 01..04 ); Temp ( 06..07 ) := Date_Time_Str ( 06..07 ); Temp ( 09..10 ) := Date_Time_Str ( 09..10 ); when YY_MM_DD_HH_MM_SS_CC => Temp ( 03..04 ) := Date_Time_Str ( 01..02 ); Temp ( 06..07 ) := Date_Time_Str ( 04..05 ); Temp ( 09..10 ) := Date_Time_Str ( 07..08 ); Temp ( 12..13 ) := Date_Time_Str ( 10..11 ); Temp ( 15..16 ) := Date_Time_Str ( 13..14 ); Temp ( 18..19 ) := Date_Time_Str ( 16..17 ); Temp ( 21..22 ) := Date_Time_Str ( 19..20 ); when YY_MM_DD_HH_MM_SS => Temp ( 03..04 ) := Date_Time_Str ( 01..02 ); Temp ( 06..07 ) := Date_Time_Str ( 04..05 ); Temp ( 09..10 ) := Date_Time_Str ( 07..08 ); Temp ( 12..13 ) := Date_Time_Str ( 10..11 ); Temp ( 15..16 ) := Date_Time_Str ( 13..14 ); Temp ( 18..19 ) := Date_Time_Str ( 16..17 ); when YY_MM_DD => Temp ( 03..04 ) := Date_Time_Str ( 01..02 ); Temp ( 06..07 ) := Date_Time_Str ( 04..05 ); Temp ( 09..10 ) := Date_Time_Str ( 07..08 ); when MM_DD_YY_HH_MM_SS_CC => Temp ( 03..04 ) := Date_Time_Str ( 07..08 ); Temp ( 06..07 ) := Date_Time_Str ( 01..02 ); Temp ( 09..10 ) := Date_Time_Str ( 04..05 ); Temp ( 12..13 ) := Date_Time_Str ( 10..11 ); Temp ( 15..16 ) := Date_Time_Str ( 13..14 ); Temp ( 18..19 ) := Date_Time_Str ( 16..17 ); Temp ( 21..22 ) := Date_Time_Str ( 19..20 ); when MM_DD_YY_HH_MM_SS => Temp ( 03..04 ) := Date_Time_Str ( 07..08 ); Temp ( 06..07 ) := Date_Time_Str ( 01..02 ); Temp ( 09..10 ) := Date_Time_Str ( 04..05 ); Temp ( 12..13 ) := Date_Time_Str ( 10..11 ); Temp ( 15..16 ) := Date_Time_Str ( 13..14 ); Temp ( 18..19 ) := Date_Time_Str ( 16..17 ); when MM_DD_YY => Temp ( 03..04 ) := Date_Time_Str ( 07..08 ); Temp ( 06..07 ) := Date_Time_Str ( 01..02 ); Temp ( 09..10 ) := Date_Time_Str ( 04..05 ); end case; return Temp; end Convert_Format; procedure Demo is ---------------------------------------------------------------------- Date_Time_Str : string ( 1..22 ); begin Put_Line ( Copyright ); New_Line; Put_Line ( "Calendar and time package." ); New_Line; Put_Line ( Image ( Clock ) ); New_Line; ConsAK.Ask ( Date_Time_Str, "Please enter a date, time, or date and time: " ); Put_Line ( Trim_White_Space ( Date_Time_Str ) ); Put_Line ( Date_Time_Format_Type'image ( Determine_Date_Time_Format ( Trim_White_Space ( Date_Time_Str ) ) ) ); Put_Line ( Convert_Format ( Trim_White_Space ( Date_Time_Str ) ) ); ConsAK.Pause; end Demo; function Determine_Date_Time_Format ( Date_Time_Str : in string ) return Date_Time_Format_Type is ---------------------------------------------------------------------- Temp : Date_Time_Format_Type := Unknown; begin if ( Date_Time_Str'last >= 10 and Is_Long_Integer ( Date_Time_Str ( 01..04 ), 0000, 9999 ) ) and ( Is_Long_Integer ( Date_Time_Str ( 06..07 ), 01, 12 ) and Is_Long_Integer ( Date_Time_Str ( 09..10 ), 01, 31 ) ) then Temp := YYYY_MM_DD; if ( Date_Time_Str'last >= 19 and Is_Long_Integer ( Date_Time_Str ( 12..13 ), 00, 23 ) ) and ( Is_Long_Integer ( Date_Time_Str ( 15..16 ), 00, 59 ) and Is_Long_Integer ( Date_Time_Str ( 18..19 ), 00, 59 ) ) then Temp := YYYY_MM_DD_HH_MM_SS; if ( Date_Time_Str'last >= 22 ) and Is_Long_Integer ( Date_Time_Str ( 21..22 ), 00, 99 ) then Temp := YYYY_MM_DD_HH_MM_SS_CC; end if; end if; end if; if Temp /= Unknown then return Temp; end if; if ( Date_Time_Str'last >= 8 and Is_Long_Integer ( Date_Time_Str ( 01..02 ), 00, 99 ) ) and ( Is_Long_Integer ( Date_Time_Str ( 04..05 ), 01, 12 ) and Is_Long_Integer ( Date_Time_Str ( 07..08 ), 01, 31 ) ) then Temp := YY_MM_DD; if ( Date_Time_Str'last >= 17 and Is_Long_Integer ( Date_Time_Str ( 10..11 ), 00, 23 ) ) and ( Is_Long_Integer ( Date_Time_Str ( 13..14 ), 00, 59 ) and Is_Long_Integer ( Date_Time_Str ( 16..17 ), 00, 59 ) ) then Temp := YY_MM_DD_HH_MM_SS; if ( Date_Time_Str'last >= 20 ) and Is_Long_Integer ( Date_Time_Str ( 19..20 ), 00, 99 ) then Temp := YY_MM_DD_HH_MM_SS_CC; end if; end if; end if; if Temp /= Unknown then return Temp; end if; if ( Date_Time_Str'last >= 8 and Is_Long_Integer ( Date_Time_Str ( 01..02 ), 01, 12 ) ) and ( Is_Long_Integer ( Date_Time_Str ( 04..05 ), 01, 31 ) and Is_Long_Integer ( Date_Time_Str ( 07..08 ), 00, 99 ) ) then Temp := MM_DD_YY; if ( Date_Time_Str'last >= 17 and Is_Long_Integer ( Date_Time_Str ( 10..11 ), 00, 23 ) ) and ( Is_Long_Integer ( Date_Time_Str ( 13..14 ), 00, 59 ) and Is_Long_Integer ( Date_Time_Str ( 16..17 ), 00, 59 ) ) then Temp := MM_DD_YY_HH_MM_SS; if ( Date_Time_Str'last >= 20 ) and Is_Long_Integer ( Date_Time_Str ( 19..20 ), 00, 99 ) then Temp := MM_DD_YY_HH_MM_SS_CC; end if; end if; end if; if Temp /= Unknown then return Temp; end if; return Temp; end Determine_Date_Time_Format; function Image ( T : in Time ) return string is ---------------------------------------------------------------------- Year : Year_Number; Month : Month_Number; Day : Day_Number; Hour : Hour_Type; Minute : Minute_Type; Second : Second_Type; Centi : Centi_Type; Date_Time_Str : Date_Time_Str_Type := "YYYY/MM/DD HH:MM:SS.CC"; begin Split ( T, Year, Month, Day, Hour, Minute, Second, Centi ); Date_Time_Str ( 01..04 ) := Image ( Year , 4, Signed => false, Zeroed => true ); Date_Time_Str ( 06..07 ) := Image ( Month , 2, Signed => false, Zeroed => true ); Date_Time_Str ( 09..10 ) := Image ( Day , 2, Signed => false, Zeroed => true ); Date_Time_Str ( 12..13 ) := Image ( Hour , 2, Signed => false, Zeroed => true ); Date_Time_Str ( 15..16 ) := Image ( Minute, 2, Signed => false, Zeroed => true ); Date_Time_Str ( 18..19 ) := Image ( Second, 2, Signed => false, Zeroed => true ); Date_Time_Str ( 21..22 ) := Image ( Centi , 2, Signed => false, Zeroed => true ); return Date_Time_Str; end Image; function Join ( Year : in Year_Number; Month : in Month_Number; Day : in Day_Number; Hour : in Hour_Type; Minute : in Minute_Type; Second : in Second_Type; Centi : in Centi_Type ) return Time is ---------------------------------------------------------------------- Seconds : Day_Duration; begin Seconds := Day_Duration ( float ( Hour ) * 3600.0 + float ( Minute ) * 60.0 + float ( Second ) * 1.0 + float ( Centi ) / 100.0 ); return Time_Of ( Year, Month, Day, Seconds ); end Join; procedure Split ( T : in Time; Year : out Year_Number; Month : out Month_Number; Day : out Day_Number; Hour : out Hour_Type; Minute : out Minute_Type; Second : out Second_Type; Centi : out Centi_Type ) is ---------------------------------------------------------------------- Hour_Temp : Hour_Type; Minute_Temp : Minute_Type; Second_Temp : Second_Type; Centi_Temp : Centi_Type; Seconds : Day_Duration; begin Split ( T, Year, Month, Day, Seconds ); Hour_Temp := Hour_Type ( float ( Seconds ) / 3600.0 - 0.5 ); Hour := Hour_Temp; Minute_Temp := Minute_Type ( ( float ( Seconds ) - float ( Hour_Temp ) * 3600.0 ) / 60.0 - 0.5 ); Minute := Minute_Temp; Second_Temp := Second_Type ( ( float ( Seconds ) - float ( Hour_Temp ) * 3600.0 - float ( Minute_Temp ) * 60.0 ) - 0.5 ); Second := Second_Temp; Centi_Temp := Centi_Type ( ( float ( Seconds ) - float ( Hour_Temp ) * 3600.0 - float ( Minute_Temp ) * 60.0 - float ( Second_Temp ) ) * 100.0 - 0.5 ); Centi := Centi_Temp; end Split; function Value ( Date_Time_Str : in Date_Time_Str_Type ) return Time is ---------------------------------------------------------------------- Year : Year_Number := Year_Number'value ( Date_Time_Str ( 01..04 ) ); Month : Month_Number := Month_Number'value ( Date_Time_Str ( 06..07 ) ); Day : Day_Number := Day_Number'value ( Date_Time_Str ( 09..10 ) ); Hour : Hour_Type := Hour_Type'value ( Date_Time_Str ( 12..13 ) ); Minute: Minute_Type := Minute_Type'value ( Date_Time_Str ( 15..16 ) ); Second: Second_Type := Second_Type'value ( Date_Time_Str ( 18..19 ) ); Centi : Centi_Type := Centi_Type'value ( Date_Time_Str ( 21..22 ) ); begin return Join ( Year, Month, Day, Hour, Minute, Second, Centi ); end Value; ---------------------------------------------------------------------- ---------------------------------------------------------------------- end TimeAK;