-------------------------------------------------------------------------------
--                                                                           --
--  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:
--  April, 3 1998: H.-F. Vogt: added Xm_N_Allow_Shell_Resize so that the label
--                             needn't be resized manually once the time is
--                             shown
--
-------------------------------------------------------------------------------

-- ----------------------------------------------------------------------------
--
--  simple example for the Ada bindings to Motif/X
--
--  shows a digital clock, possesses an icon
--
-- ----------------------------------------------------------------------------
with Xm_Widgets.Primitive.Label,
     Xm_Widgets.Shell,
     X_Toolkit,
     X_Lib,
     X_Lib.Tasking,
     Xpm_Lib,
     Text_Io;
use  Xm_Widgets.Primitive.Label,
     Xm_Widgets,
     X_Toolkit,
     X_Lib,
     Xpm_Lib;
with Dig_Clock_Global, Ladyada_Xpm;
use  Dig_Clock_Global;

procedure Dig_Clock is

   Argl : Arg_List;

begin

   X_Lib.Tasking.Resource.Seize;

   Append_Set (Argl, Xm_Widgets.Shell.Xm_N_Allow_Shell_Resize, True);
   Xt_App_Initialize (Appshell, App_Con, "Dig_Clock", Args => Argl);

   declare
      Display     : Display_Pointer;
      Screen      : Screen_Pointer;
      Window      : Window_ID;
      Pixm        : Pixmap_ID;
      Pixsh       : Pixmap_ID;
      Xpm_Attr    : Xpm_Attributes;
   begin
      Display := Xt_Display (Appshell);
      Screen  := Xt_Screen (Appshell);
      Window  := X_Root_Window_Of_Screen (Screen);

      Xpm_Attr.Value_Mask := (others => False);
      Xpm_Create_Pixmap_From_Data (Display, Window, Ladyada_Xpm.Pix, Pixm, Pixsh, Xpm_Attr);

      Argl := Null_Arg_List;
      Append_Set (Argl, Xm_Widgets.Shell.Xm_N_Icon_Pixmap, XID (Pixm));
      Xt_Set_Values (Appshell, Argl);

   exception
      when Xpm_Error_Color_Error =>
         Text_IO.Put_Line ("ERROR: XpmColorError");
      when Xpm_Error_Open_Failed =>
         Text_Io.Put_Line ("ERROR: XpmOpenFailed");
      when Xpm_Error_File_Invalid =>
         Text_Io.Put_Line ("ERROR: XpmFileInvalid");
      when Xpm_Error_No_Memory =>
         Text_Io.Put_Line ("ERROR: XpmNoMemory");
      when Xpm_Error_Color_Failed =>
         Text_Io.Put_Line ("ERROR: XpmColorFailed");
      when Xpm_Error_Unknown =>
         Text_Io.Put_Line ("ERROR: Xpm???");
      when others =>
         Text_Io.Put_Line ("ERROR: ???");
   end;


   The_Label := Xm_Create_Label (Appshell, "TheLabel");

   Xt_Manage_Child (The_Label);

   Xt_Realize_Widget (Appshell);

   -- every second rewrite the label
   Timer_ID := Xt_App_Add_Time_Out (App_Con, 500, Timeout_CB'Access, To_Xt_Pointer (The_Label));

   Xt_App_Main_Loop (App_Con);

end Dig_Clock;