home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / adav313.zip / gnat-3_13p-os2-bin-20010916.zip / emx / gnatlib / g-calend.adb < prev    next >
Text File  |  2000-07-19  |  10KB  |  301 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT RUN-TIME COMPONENTS                         --
  4. --                                                                          --
  5. --                         G N A T . C A L E N D A R                        --
  6. --                                                                          --
  7. --                                 B o d y                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.4 $
  10. --                                                                          --
  11. --              Copyright (C) 1999 Ada Core Technologies, Inc.              --
  12. --                                                                          --
  13. -- This specification is derived from the Ada Reference Manual for use with --
  14. -- GNAT. The copyright notice above, and the license provisions that follow --
  15. -- apply solely to the  contents of the part following the private keyword. --
  16. --                                                                          --
  17. -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  18. -- terms of the  GNU General Public License as published  by the Free Soft- --
  19. -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  20. -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  21. -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  22. -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  23. -- for  more details.  You should have  received  a copy of the GNU General --
  24. -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  25. -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  26. -- MA 02111-1307, USA.                                                      --
  27. --                                                                          --
  28. -- As a special exception,  if other files  instantiate  generics from this --
  29. -- unit, or you link  this unit with other files  to produce an executable, --
  30. -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  31. -- covered  by the  GNU  General  Public  License.  This exception does not --
  32. -- however invalidate  any other reasons why  the executable file  might be --
  33. -- covered by the  GNU Public License.                                      --
  34. --                                                                          --
  35. -- GNAT was originally developed  by the GNAT team at  New York University. --
  36. -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  37. --                                                                          --
  38. ------------------------------------------------------------------------------
  39.  
  40. package body GNAT.Calendar is
  41.  
  42.    use Ada.Calendar;
  43.    use Interfaces;
  44.  
  45.    ----------------
  46.    -- Julian_Day --
  47.    ----------------
  48.  
  49.    --  Julian_Day is used to by Day_Of_Week and Day_In_Year. Note
  50.    --  that this implementation is not expensive.
  51.  
  52.    function Julian_Day (Year  : in Year_Number;
  53.                         Month : in Month_Number;
  54.                         Day   : in Day_Number)
  55.      return Integer is
  56.  
  57.       Internal_Year   : Integer;
  58.       Internal_Month  : Integer;
  59.       Internal_Day    : Integer;
  60.       Julian_Date     : Integer;
  61.       C               : Integer;
  62.       Ya              : Integer;
  63.  
  64.    begin
  65.       Internal_Year  := Integer (Year);
  66.       Internal_Month := Integer (Month);
  67.       Internal_Day   := Integer (Day);
  68.  
  69.       if Internal_Month > 2 then
  70.          Internal_Month := Internal_Month - 3;
  71.       else
  72.          Internal_Month := Internal_Month + 9;
  73.          Internal_Year  := Internal_Year - 1;
  74.       end if;
  75.  
  76.       C  := Internal_Year / 100;
  77.       Ya := Internal_Year - (100 * C);
  78.  
  79.       Julian_Date := (146_097 * C) / 4 +
  80.         (1_461 * Ya) / 4 +
  81.         (153 * Internal_Month + 2) / 5 +
  82.         Internal_Day + 1_721_119;
  83.  
  84.       return Julian_Date;
  85.    end Julian_Day;
  86.  
  87.    -----------------
  88.    -- Day_Of_Week --
  89.    -----------------
  90.  
  91.    function Day_Of_Week (Date : Time) return Day_Name is
  92.  
  93.       Year       : Year_Number;
  94.       Month      : Month_Number;
  95.       Day        : Day_Number;
  96.       Dsecs      : Day_Duration;
  97.  
  98.    begin
  99.       Split (Date, Year, Month, Day, Dsecs);
  100.  
  101.       return Day_Name'Val ((Julian_Day (Year, Month, Day)) mod 7);
  102.    end Day_Of_Week;
  103.  
  104.    -----------------
  105.    -- Day_In_Year --
  106.    -----------------
  107.  
  108.    function Day_In_Year (Date : Time) return Day_In_Year_Number is
  109.  
  110.       Year       : Year_Number;
  111.       Month      : Month_Number;
  112.       Day        : Day_Number;
  113.       Dsecs      : Day_Duration;
  114.  
  115.    begin
  116.       Split (Date, Year, Month, Day, Dsecs);
  117.  
  118.       return Julian_Day (Year, Month, Day) - Julian_Day (Year, 1, 1) + 1;
  119.    end Day_In_Year;
  120.  
  121.    ------------------
  122.    -- Week_In_Year --
  123.    ------------------
  124.  
  125.    function Week_In_Year (Date : Ada.Calendar.Time)
  126.      return Week_In_Year_Number
  127.    is
  128.       Year       : Year_Number;
  129.       Month      : Month_Number;
  130.       Day        : Day_Number;
  131.       Hour       : Hour_Number;
  132.       Minute     : Minute_Number;
  133.       Second     : Second_Number;
  134.       Sub_Second : Second_Duration;
  135.  
  136.       Offset     : Natural;
  137.    begin
  138.       Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
  139.  
  140.       --  Day offset number for the first week of the year.
  141.       Offset := Julian_Day (Year, 1, 1) mod 7;
  142.  
  143.       return 1 + ((Day_In_Year (Date) - 1) + Offset) / 7;
  144.    end Week_In_Year;
  145.  
  146.    ----------
  147.    -- Hour --
  148.    ----------
  149.  
  150.    function Hour (Date : Time) return Hour_Number is
  151.       Year       : Year_Number;
  152.       Month      : Month_Number;
  153.       Day        : Day_Number;
  154.       Hour       : Hour_Number;
  155.       Minute     : Minute_Number;
  156.       Second     : Second_Number;
  157.       Sub_Second : Second_Duration;
  158.    begin
  159.       Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
  160.       return Hour;
  161.    end Hour;
  162.  
  163.    ------------
  164.    -- Minute --
  165.    ------------
  166.  
  167.    function Minute (Date : Time) return Minute_Number is
  168.       Year       : Year_Number;
  169.       Month      : Month_Number;
  170.       Day        : Day_Number;
  171.       Hour       : Hour_Number;
  172.       Minute     : Minute_Number;
  173.       Second     : Second_Number;
  174.       Sub_Second : Second_Duration;
  175.    begin
  176.       Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
  177.       return Minute;
  178.    end Minute;
  179.  
  180.    ------------
  181.    -- Second --
  182.    ------------
  183.  
  184.    function Second (Date : Time) return Second_Number is
  185.       Year       : Year_Number;
  186.       Month      : Month_Number;
  187.       Day        : Day_Number;
  188.       Hour       : Hour_Number;
  189.       Minute     : Minute_Number;
  190.       Second     : Second_Number;
  191.       Sub_Second : Second_Duration;
  192.    begin
  193.       Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
  194.       return Second;
  195.    end Second;
  196.  
  197.    ----------------
  198.    -- Sub_Second --
  199.    ----------------
  200.  
  201.    function Sub_Second (Date : Time) return Second_Duration is
  202.       Year       : Year_Number;
  203.       Month      : Month_Number;
  204.       Day        : Day_Number;
  205.       Hour       : Hour_Number;
  206.       Minute     : Minute_Number;
  207.       Second     : Second_Number;
  208.       Sub_Second : Second_Duration;
  209.    begin
  210.       Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
  211.       return Sub_Second;
  212.    end Sub_Second;
  213.  
  214.    -----------
  215.    -- Split --
  216.    -----------
  217.  
  218.    procedure Split
  219.      (Date       : Time;
  220.       Year       : out Year_Number;
  221.       Month      : out Month_Number;
  222.       Day        : out Day_Number;
  223.       Hour       : out Hour_Number;
  224.       Minute     : out Minute_Number;
  225.       Second     : out Second_Number;
  226.       Sub_Second : out Second_Duration)
  227.    is
  228.       Dsecs : Day_Duration;
  229.       Secs  : Natural;
  230.    begin
  231.       Split (Date, Year, Month, Day, Dsecs);
  232.       Secs := Natural (Dsecs - 0.5);
  233.  
  234.       Sub_Second := Second_Duration (Dsecs - Day_Duration (Secs));
  235.       Hour       := Hour_Number (Secs / 3600);
  236.       Secs       := Secs mod 3600;
  237.       Minute     := Minute_Number (Secs / 60);
  238.       Second     := Second_Number (Secs mod 60);
  239.    end Split;
  240.  
  241.    -------------
  242.    -- Time_Of --
  243.    -------------
  244.  
  245.    function Time_Of
  246.      (Year       : Year_Number;
  247.       Month      : Month_Number;
  248.       Day        : Day_Number;
  249.       Hour       : Hour_Number;
  250.       Minute     : Minute_Number;
  251.       Second     : Second_Number;
  252.       Sub_Second : Second_Duration := 0.0)
  253.       return Time
  254.    is
  255.       Dsecs : constant Day_Duration :=
  256.         Day_Duration (Hour * 3600 + Minute * 60 + Second) + Sub_Second;
  257.    begin
  258.       return Time_Of (Year, Month, Day, Dsecs);
  259.    end Time_Of;
  260.  
  261.    -----------------
  262.    -- To_Duration --
  263.    -----------------
  264.  
  265.    function To_Duration (T : access timeval) return Duration is
  266.  
  267.       procedure timeval_to_duration (T         : access timeval;
  268.                                      sec, usec : access C.long);
  269.       pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration");
  270.  
  271.       Micro     : constant := 10**6;
  272.       sec, usec : aliased C.long;
  273.    begin
  274.       timeval_to_duration (T, sec'Access, usec'Access);
  275.       return Duration (sec) + Duration (usec) / Micro;
  276.    end To_Duration;
  277.  
  278.    ----------------
  279.    -- To_Timeval --
  280.    ----------------
  281.  
  282.    function To_Timeval  (D : Duration) return timeval is
  283.  
  284.       procedure duration_to_timeval (Sec, Usec : C.long; T : access timeval);
  285.       pragma Import (C, duration_to_timeval, "__gnat_duration_to_timeval");
  286.  
  287.       Micro     : constant := 10**6;
  288.       Result    : aliased timeval;
  289.       sec, usec : C.long;
  290.  
  291.    begin
  292.       sec  := C.long (D - 0.5);
  293.       usec := C.long ((D - Duration (sec)) * Micro - 0.5);
  294.  
  295.       duration_to_timeval (sec, usec, Result'Access);
  296.  
  297.       return Result;
  298.    end To_Timeval;
  299.  
  300. end GNAT.Calendar;
  301.