------------------------------------------------------------------------------- -- -- -- Ada Interface to the X Window System and Motif(tm)/Lesstif -- -- Copyright (c) 1996-2002 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 -- 20 Jan 2002 H.-F. Vogt: add popup menu as an alternative to the -- menu bar -- comment out X_Lib.Tasking, because it seems -- not to be necessary -- ------------------------------------------------------------------------------- with Ada.Characters.Latin_1, Ada.Calendar, Ada.Text_Io, Interfaces.C, -- X_Lib.Tasking, Xm_Widgets.Primitive.Label.Push_Button, Xm_Widgets.Primitive.Label.Toggle_Button, Xm_Widgets.Manager.Row_Column, Xm_Widgets.Manager.Drawing_Area, Xm_Widgets.Manager.Bulletin_Board.Message_Box; use Ada.Characters.Latin_1, Ada.Text_Io, Interfaces.C, Xm_Widgets.Primitive.Label, Xm_Widgets.Manager.Bulletin_Board.Message_Box; package body Clock_Global is use Real_Functions; Menu_Btn : Widget := Null_Widget; procedure Redraw_Clock is Division : constant Real := Ada.Numerics.Pi / 6.0; Angle, S_Ang, C_Ang : Real; Mark_Midpoint_X, Mark_Midpoint_Y : Real; Min_Finger : Point_Array (1 .. 3); Hour_Finger : Point_Array (1 .. 3); Mark_Inner_Radius : constant Real := 0.7*Radius; Hour_Radius : constant Real := 0.5*Radius; Min_Radius : constant Real := 0.9*Radius; Sec_Radius : constant Real := 0.9*Radius; Back_Radius : constant Real := 0.1*Radius; Back_Width : constant Real := 0.2*Radius; Shadow_Offset_X : constant Real := 0.05*Radius; Shadow_Offset_Y : constant Real := 0.075*Radius; begin X_Clear_Window (Display, Xt_Window (The_Draw)); -- draw clock marks for I in 0 .. 11 loop Angle := Real (I) * Division; -- X_Draw_Line (Display, Xt_Window (The_Draw), GC_Marks, -- X_Lib.Position (Mid_X + Mark_Inner_Radius*Cos(Angle)), -- X_Lib.Position (Mid_Y + Mark_Inner_Radius*Sin(Angle)), -- X_Lib.Position (Mid_X + Radius*Cos(Angle)), -- X_Lib.Position (Mid_Y + Radius*Sin(Angle))); Mark_Midpoint_X := Mid_X + 0.5*(Mark_Inner_Radius+Radius)*Cos(Angle); Mark_Midpoint_Y := Mid_Y + 0.5*(Mark_Inner_Radius+Radius)*Sin(Angle); X_Fill_Arc (Display, Xt_Window (The_Draw), GC_Marks, X_Lib.Position (Mark_Midpoint_X - 0.075*Radius), X_Lib.Position (Mark_Midpoint_Y - 0.075*Radius), X_Lib.Dimension (0.15*Radius), X_Lib.Dimension (0.15*Radius), 0.0, 360.0); end loop; -- calculate minute finger Angle := -0.5*Ada.Numerics.Pi + Real (Second mod 3600) * Ada.Numerics.Pi/1800.0; S_Ang := Sin (Angle); C_Ang := Cos (Angle); Min_Finger (1).X := X_Lib.Position (Mid_X + Min_Radius*C_Ang); Min_Finger (1).Y := X_Lib.Position (Mid_Y + Min_Radius*S_Ang); Min_Finger (2).X := X_Lib.Position (-(Min_Radius+Back_Radius)*C_Ang - 0.5*Back_Width*S_Ang); Min_Finger (2).Y := X_Lib.Position (-(Min_Radius+Back_Radius)*S_Ang + 0.5*Back_Width*C_Ang); Min_Finger (3).X := X_Lib.Position (Back_Width*S_Ang); Min_Finger (3).Y := X_Lib.Position (-Back_Width*C_Ang); -- calculate hour finger Angle := -0.5*Ada.Numerics.Pi + Real (Second) * Ada.Numerics.Pi/21600.0; S_Ang := Sin (Angle); C_Ang := Cos (Angle); Hour_Finger (1).X := X_Lib.Position (Mid_X + Hour_Radius*C_Ang); Hour_Finger (1).Y := X_Lib.Position (Mid_Y + Hour_Radius*S_Ang); Hour_Finger (2).X := X_Lib.Position (- (Hour_Radius+Back_Radius)*C_Ang - 0.5*Back_Width*S_Ang); Hour_Finger (2).Y := X_Lib.Position (- (Hour_Radius+Back_Radius)*S_Ang + 0.5*Back_Width*C_Ang); Hour_Finger (3).X := X_Lib.Position ( Back_Width*S_Ang); Hour_Finger (3).Y := X_Lib.Position (-Back_Width*C_Ang); -- calculate second finger Angle := -0.5*Ada.Numerics.Pi + Real (Second mod 60)*Ada.Numerics.Pi / 30.0; -- draw shadow of second finger X_Draw_Line (Display, Xt_Window (The_Draw), GC_Shadow, X_Lib.Position (Mid_X+Shadow_Offset_X), X_Lib.Position (Mid_Y+Shadow_Offset_Y), X_Lib.Position (Mid_X + Sec_Radius*Cos (Angle)+Shadow_Offset_X), X_Lib.Position (Mid_Y + Sec_Radius*Sin (Angle)+Shadow_Offset_Y)); -- draw shadow of minute finger Min_Finger (1).X := Min_Finger (1).X + X_Lib.Position (Shadow_Offset_X); Min_Finger (1).Y := Min_Finger (1).Y + X_Lib.Position (Shadow_Offset_Y); X_Fill_Polygon (Display, Xt_Window (The_Draw), GC_Shadow, Min_Finger, Convex, Previous); Min_Finger (1).X := Min_Finger (1).X - X_Lib.Position (Shadow_Offset_X); Min_Finger (1).Y := Min_Finger (1).Y - X_Lib.Position (Shadow_Offset_Y); -- draw shadow of hour finger Hour_Finger (1).X := Hour_Finger (1).X + X_Lib.Position (Shadow_Offset_X); Hour_Finger (1).Y := Hour_Finger (1).Y + X_Lib.Position (Shadow_Offset_Y); X_Fill_Polygon (Display, Xt_Window (The_Draw), GC_Shadow, Hour_Finger, Convex, Previous); Hour_Finger (1).X := Hour_Finger (1).X - X_Lib.Position (Shadow_Offset_X); Hour_Finger (1).Y := Hour_Finger (1).Y - X_Lib.Position (Shadow_Offset_Y); -- draw minute finger X_Fill_Polygon (Display, Xt_Window (The_Draw), GC_Min, Min_Finger, Convex, Previous); -- draw hour finger X_Fill_Polygon (Display, Xt_Window (The_Draw), GC_Hour, Hour_Finger, Convex, Previous); -- draw shadow of second finger X_Draw_Line (Display, Xt_Window (The_Draw), GC_Sec, X_Lib.Position (Mid_X), X_Lib.Position (Mid_Y), X_Lib.Position (Mid_X + Sec_Radius*Cos (Angle)), X_Lib.Position (Mid_Y + Sec_Radius*Sin (Angle))); end Redraw_Clock; procedure Resize_Clock is begin Argl := Null_Arg_List; Append_Get (Argl, Xm_N_Width, Width); Append_Get (Argl, Xm_N_Height, Height); Xt_Get_Values (The_Draw, Argl); Mid_X := 0.5 * Real (Width); Mid_Y := 0.5 * Real (Height); if Width > Height then Radius := 0.475*Real (Height); else Radius := 0.475*Real (Width); end if; end Resize_Clock; procedure About_CB (W : in Widget; Closure : in Xt_Pointer; Call_Data : in Xt_Pointer) is Button : Widget; About_Text : constant String := "AdaClock -- a Motif(tm) version of xclock" & LF & "(c)1996-2002 Hans-Frieder Vogt" & LF & "(example program for Ada interface to Motif(tm))"; About_String : Xm_String; begin if About_Dialog = Null_Widget then About_Dialog := Xm_Create_Information_Dialog (Appshell, "about_dialog"); About_String := Xm_String_Create_L_To_R (About_Text, Xm_String_ISO8859_1); Argl := Null_Arg_List; Append_Set (Argl, Xm_N_Message_String, About_String); Xt_Set_Values (About_Dialog, Argl); Xm_String_Free (About_String); Button := Xt_Name_To_Widget (About_Dialog, Cancel_Button_Name); Xt_Unmanage_Child (Button); Button := Xt_Name_To_Widget (About_Dialog, Help_Button_Name); Xt_Unmanage_Child (Button); Xt_Manage_Child (About_Dialog); else if not Xt_Is_Managed (About_Dialog) then Xt_Manage_Child (About_Dialog); end if; end if; end About_CB; procedure Quit_CB (W : in Widget; Closure : in Xt_Pointer; Call_Data : in Xt_Pointer) is begin -- raise Leave_Program; Xt_App_Set_Exit_Flag (App_Con); end Quit_CB; procedure Expose_Clock_CB (W : in Widget; Closure : in Xt_Pointer; Call_Data : in Xt_Pointer) is begin Redraw_Clock; end Expose_Clock_CB; procedure Resize_Clock_CB (W : in Widget; Closure : in Xt_Pointer; Call_Data : in Xt_Pointer) is begin Resize_Clock; end Resize_Clock_CB; procedure Input_CB (W : in Widget; Closure : in Xt_Pointer; Call_Data : in Xt_Pointer) is use Xm_Widgets.Manager.Drawing_Area, Xm_Widgets.Primitive.Label.Push_Button, Xm_Widgets.Primitive.Label.Toggle_Button, X_Lib; CB_Struct : Xm_Drawing_Area_Callback_Struct_Access; Event : X_Event_Pointer; Exit_Btn, About_Btn : Widget; begin CB_Struct := To_Callback_Struct (Call_Data); Event := CB_Struct.Event; case Event.Ev_Type is when Button_Press => -- if popup menu wasn't created, create it now -- if Popup_Menu = Null_Widget then Popup_Menu := Xm_Widgets.Manager.Row_Column.Xm_Create_Popup_Menu (The_Draw, "popup"); Menu_Btn := Xm_Create_Toggle_Button (Popup_Menu, "menu_show"); Xt_Manage_Child (Menu_Btn); Exit_Btn := Xm_Create_Push_Button (Popup_Menu, "file_exit"); Xt_Manage_Child (Exit_Btn); About_Btn := Xm_Create_Push_Button (Popup_Menu, "help_about"); Xt_Manage_Child (About_Btn); Xt_Add_Callback (Menu_Btn, Xm_Widgets.Primitive.Label.Toggle_Button.Xm_N_Value_Changed_Callback, Menu_CB'Access); Xt_Add_Callback (Exit_Btn, Xm_Widgets.Primitive.Label.Push_Button.Xm_N_Activate_Callback, Quit_CB'Access); Xt_Add_Callback (About_Btn, Xm_Widgets.Primitive.Label.Push_Button.Xm_N_Activate_Callback, About_CB'Access); end if; -- place the popup menu at the position where the event occured -- Xm_Widgets.Manager.Row_Column.Xm_Menu_Position (Popup_Menu, Event); Xm_Toggle_Button_Set_State (Menu_Btn, Xt_Is_Managed (The_Menu_Bar), False); -- make the popup menu visible -- if not Xt_Is_Managed (Popup_Menu) then Xt_Manage_Child (Popup_Menu); end if; when others => null; end case; end Input_CB; procedure Menu_CB (W : in Widget; Closure : in Xt_Pointer; Call_Data : in Xt_Pointer) is begin if Xt_Is_Managed (The_Menu_Bar) then Xt_Unmanage_Child (The_Menu_Bar); else Xt_Manage_Child (The_Menu_Bar); end if; end Menu_CB; procedure Timeout_CB (Client_Data : in Xt_Pointer; ID : in out Interval_ID) is use Ada.Calendar; begin if ID /= Null_Interval_ID or else Timer_ID = Null_Interval_ID then Timer_ID := Xt_App_Add_Time_Out (App_Con, 1000, Timeout_CB'Access, Client_Data); end if; -- X_Lib.Tasking.Resource.Release; Second := Integer (Seconds (Clock)); -- X_Lib.Tasking.Resource.Seize; Redraw_Clock; end Timeout_CB; end Clock_Global;