-------------------------------------------------------------------------------
--                                                                           --
--  Ada Interface to the X Window System and Motif(tm)/Lesstif               --
--  Copyright (c) 1996-2000 Hans-Frieder Vogt                                --
--                                                                           --
--  This program 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 of the License, or        --
--  (at your option) any later version.                                      --
--                                                                           --
--  This program 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        --
--  along with this program; if not, write to the                            --
--  Free Software Foundation, Inc.,                                          --
--  59 Temple Place - Suite 330,                                             --
--  Boston, MA 02111-1307, USA.                                              --
--                                                                           --
--                                                                           --
--  X Window System is copyrighted by the X Consortium                       --
--  Motif(tm)       is copyrighted by the Open Software Foundation, Inc.     --
--                                                                           --
--                                                                           --
-------------------------------------------------------------------------------

-------------------------------------------------------------------------------
--
-- HISTORY:
--          June 20, 1998 begin of history
--          29 Feb 2000 I didn't think it was possible, but there was a Y2K
--                      bug in this example!!!
--
-------------------------------------------------------------------------------

with System, X_Toolkit, Xm_Widgets.Primitive.Label, Text_Io;
package body Dig_Clock_Global is

   use X_Toolkit, Xm_Widgets;

   type Time_T is new Long_Integer;
   type Time_T_Ptr is access all Time_T;
   Null_Time_T_Ptr : constant Time_T_Ptr := null;

   type Tm is record
      Tm_SEC   : Integer;
      Tm_MIN   : Integer;
      Tm_HOUR  : Integer;
      Tm_MDAY  : Integer;
      Tm_MON   : Integer;
      Tm_YEAR  : Integer;
      Tm_WDAY  : Integer;
      Tm_YDAY  : Integer;
      Tm_ISDST : Integer;
      Tm_GMT_Off : Long_Integer;    --  needed by glibc 2.1.3
      Tm_Zone    : System.Address;  --  needed by glibc 2.1.3
   end record;
   pragma Convention (C, Tm);

   type Tm_Ptr is access Tm;

   function Time (TP : in Time_T_Ptr := Null_Time_T_Ptr) return Time_T;
   pragma Import (C, Time, External_Name => "time");

   function Localtime (TP : in Time_T_Ptr) return Tm_Ptr;
   pragma Import (C, Localtime, External_Name => "localtime");

   
   package Int_IO is new Text_IO.Integer_IO (Integer);

   subtype String5 is String (1 .. 5);
   Month_Array : constant array (1 .. 12) of String5
               := (" Jan ", " Feb ", " Mar ", " Apr ", " May ", " Jun ",
	           " Jul ", " Aug ", " Sep ", " Oct ", " Nov ", " Dec ");

   procedure Timeout_CB (Client_Data : in  Xt_Pointer;
                         ID          : in out Interval_ID) is
      Clock    : aliased Time_T;
      The_Time : Tm_Ptr;
      STR_H, STR_M, STR_S, STR_DA : String (1 .. 2);
      Str_D, STR_DST  : String (1 .. 3);
      Str_Y           : String (1 .. 4);
      XMS      : Xm_String;
      Args     : Arg_List;
   begin

      if ID /= Null_Interval_ID or else Timer_ID = Null_Interval_ID then
         Timer_ID := Xt_App_Add_Time_Out (App_Con, 500, Timeout_CB'Access, Client_Data);
      end if;

      Clock := Time;
      
      The_Time := Localtime (Clock'Unchecked_Access);

      Int_Io.Put (Str_H, The_Time.Tm_Hour);
      if (The_Time.Tm_Hour < 10) then
         Str_H (1) := '0';
      end if;
      Int_Io.Put (Str_M, The_Time.Tm_Min);
      if (The_Time.Tm_Min < 10) then
         Str_M (1) := '0';
      end if;
      Int_Io.Put (Str_S, The_Time.Tm_Sec);
      if (The_Time.Tm_SEC < 10) then
         Str_S (1) := '0';
      end if;
      case The_Time.Tm_Wday is
         when 0 =>
            Str_D := "Sun";
         when 1 =>
            Str_D := "Mon";
         when 2 =>
            Str_D := "Tue";
         when 3 =>
            Str_D := "Wed";
         when 4 =>
            Str_D := "Thu";
         when 5 =>
            Str_D := "Fri";
         when 6 =>
            Str_D := "Sat";
         when others =>
            Str_D := "???";
      end case;
      Int_Io.Put (Str_Da, The_Time.Tm_Mday);
      if (The_Time.Tm_Mday < 10) then
         Str_Da (1) := '0';
      end if;
      Int_Io.Put (Str_Y, The_Time.Tm_Year + 1900);
      if (The_Time.Tm_ISDST > 0) then
         STR_DST := "DST";
      else
         STR_DST := "   ";
      end if;

      Xms := Xm_String_Create_L_To_R (STR_D & ", "  &
                STR_DA & Month_Array (The_Time.Tm_Mon+1) & STR_Y & "  " 
                              & STR_H & ":" & STR_M & ":" & STR_S & " " & STR_DST);

      Args := Null_Arg_List;
      Append_Set (Args, Xm_Widgets.Primitive.Label.Xm_N_Label_String, Xms);
      Xt_Set_Values (To_Widget (Client_Data), Args);

      Xm_String_Free (Xms);

   end Timeout_CB;


end Dig_Clock_Global;