|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ B T ┃
Length: 32954 (0x80ba)
Types: TextFile
Names: »B«
└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00
└─ ⟦0c20f784e⟧ »DATA«
└─⟦1abbe589f⟧
└─⟦ada0be243⟧
└─⟦this⟧
with Debug_Tools;
with Scheduler;
with Text_Io;
--/ if TeleGen2 and then Unix then
--// with Process_Control; -- Unix process control
--/ end if;
with Xload_Icon;
use Xload_Icon;
with Xlbt_Arithmetic;
use Xlbt_Arithmetic;
with Xlbt_Basic;
use Xlbt_Basic;
with Xlbt_Cursor_Font;
use Xlbt_Cursor_Font;
with Xlbt_Event;
use Xlbt_Event;
with Xlbt_Font;
use Xlbt_Font;
with Xlbt_Gc;
use Xlbt_Gc;
with Xlbt_Hint;
use Xlbt_Hint;
with Xlbt_Geometry;
use Xlbt_Geometry;
with Xlbt_Graphics;
use Xlbt_Graphics;
with Xlbt_Key;
use Xlbt_Key;
with Xlbt_Misc;
use Xlbt_Misc;
with Xlbt_Pointer;
use Xlbt_Pointer;
with Xlbt_String;
use Xlbt_String;
with Xlbt_Window;
use Xlbt_Window;
with Xlbp_Bitmap;
use Xlbp_Bitmap;
with Xlbp_Cursor;
use Xlbp_Cursor;
with Xlbp_Display;
use Xlbp_Display;
with Xlbp_Event;
use Xlbp_Event;
with Xlbp_Font;
use Xlbp_Font;
with Xlbp_Gc;
use Xlbp_Gc;
with Xlbp_Geometry;
use Xlbp_Geometry;
with Xlbp_Graphics;
use Xlbp_Graphics;
with Xlbp_Hint;
use Xlbp_Hint;
with Xlbp_Keyboard_Control;
use Xlbp_Keyboard_Control;
with Xlbp_Proc_Var;
use Xlbp_Proc_Var;
with Xlbp_Sync;
use Xlbp_Sync;
with Xlbp_Text;
use Xlbp_Text;
with Xlbp_Window;
use Xlbp_Window;
with Xlbmt_Network_Types;
use Xlbmt_Network_Types;
with Xlbmp_Environment;
use Xlbmp_Environment;
with Xlbmp_Network_Interface;
use Xlbmp_Network_Interface;
package body Xload_Main is
------------------------------------------------------------------------------
-- Xload - a version of Mah-Jongg for X Windows
--
-- Author: Gary E. Barnes March 1991
--
-- main.c - The mainline code.
------------------------------------------------------------------------------
-- 03/14/91 GEB - Translate to Ada
------------------------------------------------------------------------------
Notify : Notify_Complete := new Notify_Complete_Task;
History : S_Long_List := new S_Long_Array'(1 .. 1024 => 0);
History_Last : S_Natural := History'Last;
Peak : S_Natural := History'Last; -- Largest value in History.
History_Units : constant := 100; -- level of 1.0 is a value of 100.0
Window_Height : S_Short := 40; -- Actual height/width
Window_Width : S_Short := 40;
Base_Height : S_Short := 40; -- Graphed height/width
Base_Width : S_Natural := 70;
Last_Y_Pixel : S_Short := 40; -- Y coordinate of bottommost pixel.
Last_Histo : S_Short := 70; -- X coordinate of last histogram line
Dash_Flag : Boolean := True; -- Skip the dots next load.
Need_Redraw : Boolean := False; -- Need a partial redraw? (exposure)
Title_Overall : X_Char_Struct; -- Extents for our title string
type Boolean_Array is array (S_Natural range <>) of Boolean;
Levels : S_Natural := 2; -- Number of lines across
Pixels_Per_Level : S_Short_Array (1 .. 20); -- Pixels from line to line
Levels_Height : S_Short_Array (1 .. 20); -- Levels * Pixels_Per_Level
Top_Line : S_Short_Array (1 .. 20); -- Y coordinate of topmost line
Title_Overlap : Boolean_Array (1 .. 20); -- Levels ovelap title
Levels_History : S_Long_Array (0 .. 20); -- Load average for this Levels
-- \f
procedure Redraw_From_History is
------------------------------------------------------------------------------
-- Clear the window and redraw everything.
------------------------------------------------------------------------------
Seg : X_Segment_Array (1 .. Base_Width);
Pnt : X_Point_Array (1 .. Base_Width);
Load : S_Long;
Y : S_Short;
begin
----Clear the window.
X_Clear_Window (Dpy, Xload);
----We wouldn't be here if we didn't need a redraw.
Need_Redraw := False;
----Draw the host name.
X_Draw_Image_String (Dpy, Xload.Drawable,
Gc => Normal_Gc,
X => 4,
Y => 4 + Title_Overall.Ascent,
Text => Xload_Resources.Host.all);
----Compute the histogram. Seg is the histogram. Pnt is the tops of the
-- histogram.
for I in 1 .. Base_Width loop
Seg (I).X1 := S_Short (Base_Width - I);
Seg (I).X2 := S_Short (Base_Width - I);
Seg (I).Y1 := Last_Y_Pixel;
if I > History_Last then
Load := History (History'Last - (I - History_Last));
else
Load := History (History_Last - I + 1);
end if;
Seg (I).Y2 := Last_Y_Pixel -
S_Short ((Load *
S_Long (Pixels_Per_Level (Levels))) /
History_Units);
Pnt (I).X := Seg (I).X2;
Pnt (I).Y := Seg (I).Y2;
end loop;
----Draw the histogram.
X_Draw_Segments (Dpy, Xload.Drawable, Normal_Gc, Seg);
----Draw the load lines across the window.
Dash_Flag := not Xload_Resources.Use_Dashes;
for I in 1 .. Levels loop
Y := Last_Y_Pixel - S_Short (I) * Pixels_Per_Level (Levels);
X_Draw_Line (Dpy, Xload.Drawable,
Gc => Xor_Gc,
X1 => Last_Histo,
Y1 => Y,
X2 => 0,
Y2 => Y);
end loop;
----Redraw the historgram tops just in case the load lines zapped them.
X_Draw_Points (Dpy, Xload.Drawable, Normal_Gc, Pnt, Coord_Mode_Origin);
end Redraw_From_History;
-- \f
procedure Move_Peak (New_Peak : Boolean;
Do_Layout : Boolean) is
Load1 : S_Long;
Load2 : S_Long;
J : S_Natural;
K : S_Short;
begin
----Count the number of samples that we have between "now" and the peak load.
if Peak > History_Last then
J := History'Last - Peak + 1 + History_Last;
else
J := History_Last - Peak + 1;
end if;
----See if the old peak is gone or overridden.
if New_Peak or else
J > Base_Width then
Load1 := History (History_Last);
Peak := History_Last;
for I in 2 .. Base_Width loop
if I > History_Last then
J := History'Last - (I - History_Last);
else
J := History_Last - I + 1;
end if;
Load2 := History (J);
if Load1 < Load2 then
Load1 := Load2;
Peak := J;
end if;
end loop;
else
if History (Peak) < History (History_Last) then
Peak := History_Last;
end if;
end if;
----If we aren't redoing the layout then return now.
if not Do_Layout then
return;
end if;
----See if we need to change the number of levels that we are displaying.
while History (Peak) > Levels_History (Levels) loop
Levels := Levels + 1;
Need_Redraw := True;
end loop;
while History (Peak) <= Levels_History (Levels - 1) and then
Levels > S_Natural (Xload_Resources.Levels) loop
Levels := Levels - 1;
Need_Redraw := True;
end loop;
end Move_Peak;
-- \f
procedure Compute_Layout is
------------------------------------------------------------------------------
-- Called whenever Base_Height, Base_Width, or Levels is changed.
------------------------------------------------------------------------------
Tmp : S_Natural;
begin
----If we are wider than we can physicall handle then adjust our history array.
if Base_Width > History'Length then
declare
Na : S_Long_List :=
new S_Long_Array (1 .. (Base_Width + 255) / 256 * 256);
His1 : S_Natural := History_Last;
His2 : S_Natural := History'Last - History_Last;
Na0 : S_Natural := Na'Last - History'Last;
begin
Na (Na'Last - Na0 + 1 .. Na'Last) := (others => 0);
Na (1 .. His2) := History (History_Last + 1 .. History'Last);
Na (His2 + 1 .. His2 + History_Last) :=
History (1 .. History_Last);
History_Last := History'Last;
History := Na;
Move_Peak (New_Peak => True, Do_Layout => False);
end;
----If we are narrower than before, is our peak now off screen?
else
if Peak > History_Last then
Tmp := History'Last - Peak + History_Last + 1;
else
Tmp := History_Last - Peak + 1;
end if;
if Tmp > Base_Width then
Move_Peak (New_Peak => True, Do_Layout => False);
end if;
end if;
----Recompute the number of pixels we use per level and such.
Levels_History (0) := -1;
for I in Pixels_Per_Level'Range loop
Pixels_Per_Level (I) :=
(Base_Height + S_Short (I) - 1) / S_Short (I);
if Pixels_Per_Level (I) >= 2 then
Title_Overlap (I) := False;
else
Pixels_Per_Level (I) := 2;
Title_Overlap (I) := True;
end if;
Top_Line (I) := Window_Height -
Pixels_Per_Level (I) * S_Short (I) - 1;
Levels_Height (I) := S_Short (I) * Pixels_Per_Level (I) + 1;
Levels_History (I) :=
S_Long (I) * History_Units +
History_Units / S_Long (Pixels_Per_Level (I)) - 1;
end loop;
Last_Y_Pixel := Window_Height - 1;
Last_Histo := Window_Width - 1;
end Compute_Layout;
-- \f
procedure Load_Sample is
------------------------------------------------------------------------------
-- Get the latest load average. If we need to reconfigure the display in
-- order to increase/decrease the number of levels of display then we do that
-- also.
------------------------------------------------------------------------------
use Scheduler;
Last : Load_Factor;
Minute : Load_Factor;
Minute_5 : Load_Factor;
Minute_15 : Load_Factor;
Last_Y : S_Short;
Tmp : S_Long;
begin
----Get the latest load average.
Scheduler.Get_Run_Queue_Load (Last, Minute, Minute_5, Minute_15);
if History_Last = History'Last then
History_Last := 1;
else
History_Last := History_Last + 1;
end if;
if Xload_Resources.Which_Load = 0 then
History (History_Last) := S_Long (Last);
elsif Xload_Resources.Which_Load = 1 then
History (History_Last) := S_Long (Minute);
elsif Xload_Resources.Which_Load = 5 then
History (History_Last) := S_Long (Minute_5);
else
History (History_Last) := S_Long (Minute_15);
end if;
if History (History_Last) >= History_Units *
(Pixels_Per_Level'Last + 1) then
History (History_Last) := History_Units *
(Pixels_Per_Level'Last + 1) - 1;
end if;
----See if the old peak is gone or overridden.
Move_Peak (New_Peak => False, Do_Layout => True);
----Draw the new load average on the screen.
if not Need_Redraw then
X_Copy_Area (Dpy, Xload.Drawable, Xload.Drawable,
Gc => Normal_Gc,
Source_X => 1,
Source_Y => Top_Line (Levels),
Width => U_Short (Window_Width - 1),
Height => U_Short (Levels_Height (Levels)),
Destination_X => 0,
Destination_Y => Top_Line (Levels));
if Title_Overlap (Levels) then
X_Draw_Image_String (Dpy, Xload.Drawable,
Gc => Normal_Gc,
X => 4,
Y => 4 + Title_Overall.Ascent,
Text => Xload_Resources.Host.all);
end if;
X_Clear_Area (Dpy, Xload,
X => Last_Histo,
Y => Top_Line (Levels),
Width => 1,
Height => U_Short (Levels_Height (Levels)),
Exposures => False);
Last_Y := Last_Y_Pixel -
S_Short ((History (History_Last) *
S_Long (Pixels_Per_Level (Levels))) /
History_Units);
X_Draw_Line (Dpy, Xload.Drawable,
Gc => Normal_Gc,
X1 => Last_Histo,
Y1 => Last_Y_Pixel,
X2 => Last_Histo,
Y2 => Last_Y);
if Xload_Resources.Use_Dashes and then
Dash_Flag then
Dash_Flag := False;
else
Dash_Flag := Xload_Resources.Use_Dashes;
for I in 1 .. Levels loop
X_Draw_Point
(Dpy, Xload.Drawable,
Gc => Xor_Gc,
X => Last_Histo,
Y => Last_Y_Pixel -
S_Short (I) * Pixels_Per_Level (Levels));
end loop;
X_Draw_Point (Dpy, Xload.Drawable,
Gc => Normal_Gc,
X => Last_Histo,
Y => Last_Y);
end if;
end if;
end Load_Sample;
-- \f
procedure Reconfigure (Event : X_Event) is
------------------------------------------------------------------------------
-- The window has changed size or something. Rearrange our internal
-- data structures.
------------------------------------------------------------------------------
Height : S_Short;
begin
----Compute the new Base_Height/Width.
Height := S_Short (Event.Configure.Height);
if Height < 1 then
Height := 1;
end if;
Window_Height := Height;
Height := Height - 4 - 2 * (Title_Overall.Ascent +
Title_Overall.Descent) - 4;
if Height < 2 * S_Short (Levels) then
Height := 2 * S_Short (Levels);
Title_Overlap (Levels) := True;
else
Title_Overlap (Levels) := False;
end if;
Base_Height := Height;
Base_Width := S_Natural (Event.Configure.Width);
if Base_Width < 1 then
Base_Width := 1;
end if;
Window_Width := S_Short (Base_Width);
----Refigure the layout and redraw the image.
Compute_Layout;
end Reconfigure;
-- \f
procedure Change_Load_Average is
------------------------------------------------------------------------------
-- We got a Button3 click. Change the load average that we are monitoring.
------------------------------------------------------------------------------
begin
----Change source of the load average.
if Xload_Resources.Which_Load = 0 then
Xload_Resources.Which_Load := 1;
elsif Xload_Resources.Which_Load = 1 then
Xload_Resources.Which_Load := 5;
elsif Xload_Resources.Which_Load = 5 then
Xload_Resources.Which_Load := 15;
else
Xload_Resources.Which_Load := 0;
end if;
----Recompute our title and its size.
Xload_Resources.Host :=
new X_String'(X_Env_Get_Host_Name &
To_X_String (Natural'Image
(Xload_Resources.Which_Load)));
declare
Dir : X_Font_Direction;
Font_Ascent : S_Short;
Font_Descent : S_Short;
begin
X_Text_Extents (Xload_Resources.Font,
Xload_Resources.Host.all,
Dir, Font_Ascent, Font_Descent, Title_Overall);
end;
----Reconfigure our layout, if necessary.
declare
Event : X_Configure_Notify_Event;
begin
Event.Configure.Width := U_Short (Window_Width);
Event.Configure.Height := U_Short (Window_Height);
Reconfigure (Event);
end;
Need_Redraw := True;
end Change_Load_Average;
-- \f
procedure Gc_Setup is
------------------------------------------------------------------------------
-- Set up the GC's that we will be using for drawing.
------------------------------------------------------------------------------
Gcv : X_Gc_Values;
Pix : X_Pixel;
begin
----Xor_GC - fg = black, bg = white, func = xor
Gcv.Funct := Gx_Xor;
Gcv.Foreground := Xload_Resources.Foreground xor
Xload_Resources.Background;
Gcv.Background := Xload_Resources.Background;
Gcv.Font := Xload_Resources.Font.Font_Id;
Gcv.Graphics_Exposures := True;
Gcv.Line_Style := Line_On_Off_Dash;
Gcv.Dash_Offset := 1;
Gcv.Dashes := 1;
if Xload_Resources.Use_Dashes then
Xor_Gc :=
X_Create_Gc
(Dpy, Xload.Drawable,
X_Gc_Components'
(Gc_Function | Gc_Font | Gc_Foreground |
Gc_Background | Gc_Graphics_Exposures |
Gc_Line_Style | Gc_Dash_Offset | Gc_Dash_List => True,
others => False), Gcv);
else
Xor_Gc := X_Create_Gc
(Dpy,
Xload.Drawable,
X_Gc_Components'
(Gc_Function | Gc_Font | Gc_Foreground |
Gc_Background | Gc_Graphics_Exposures => True,
others => False),
Gcv);
end if;
----Normal_GC - fg = black, bg = white, func = copy
Gcv.Funct := Gx_Copy;
Gcv.Foreground := Xload_Resources.Foreground;
Gcv.Background := Xload_Resources.Background;
Gcv.Font := Xload_Resources.Font.Font_Id;
Gcv.Graphics_Exposures := True;
Normal_Gc :=
X_Create_Gc
(Dpy,
Xload.Drawable,
X_Gc_Components'(Gc_Function | Gc_Font | Gc_Foreground |
Gc_Background | Gc_Graphics_Exposures => True,
others => False),
Gcv);
end Gc_Setup;
-- \f
procedure Set_Size_Hints (Hints : in out X_Size_Hints;
Geom : X_String) is
------------------------------------------------------------------------------
-- Hints - Receives the X/Y/Width/Height values from the Geometry string
-- Geom - Specifies the string specified by the user for the geometry
--
-- Parses the geometry string (if any) and takes care of setting the X/Y and
-- the Width/Height fields in the Hints structure.
------------------------------------------------------------------------------
Geom_Result : X_Parse_Geometry_Flags;
begin
Hints.X := 0;
Hints.Y := 0;
Geom_Result := None_X_Parse_Geometry_Flags;
if Geom /= "" then
X_Parse_Geometry (Geom,
S_Short (Hints.X), S_Short (Hints.Y),
U_Short (Hints.Width), U_Short (Hints.Height),
Geom_Result);
if Geom_Result (Width_Value) and then
Geom_Result (Height_Value) then
Hints.Width := Max (Hints.Width, Hints.Min_Width);
Hints.Height := Max (Hints.Height, Hints.Min_Height);
Hints.Flags (U_S_Size) := True;
end if;
if Geom_Result (X_Value) and then
Geom_Result (Y_Value) then
Hints.Flags (U_S_Position) := True;
end if;
end if;
if not Hints.Flags (U_S_Size) then
Hints.Width := Hints.Min_Width;
Hints.Height := Hints.Min_Height;
Hints.Flags (P_Size) := True;
end if;
if not Hints.Flags (U_S_Position) then
Hints.X := 0;
Hints.Y := 0;
Hints.Flags (P_Position) := True;
end if;
if Geom_Result (X_Negative) then
Hints.X := S_Long (X_Display_Width (Dpy, X_Default_Screen (Dpy))) +
Hints.X - S_Long (Hints.Width);
end if;
if Geom_Result (Y_Negative) then
Hints.Y := S_Long (X_Display_Height (Dpy, X_Default_Screen (Dpy))) +
Hints.Y - S_Long (Hints.Height);
end if;
end Set_Size_Hints;
-- \f
procedure Main (Display : X_String;
Geometry : X_String := "70x40";
Which_Load : Natural := 1;
Interval : Positive := 10;
Levels : Positive := 2;
Font : X_String := "*cour*med*r*norm*--10*";
Use_Dashes : Boolean := False) is
------------------------------------------------------------------------------
-- Our Main-Line Code.
------------------------------------------------------------------------------
Error : X_Error_String;
Class_Hint : X_Class_Hint;
Size_Hints : X_Size_Hints;
Wm_Hints : X_Wm_Hints;
Attr : X_Set_Window_Attributes;
Mask : X_New_Window_Attributes := None_X_New_Window_Attributes;
Screen : X_Screen_Number;
Success : X_Status;
Icon_Window : X_Window := None_X_Window;
Env : constant X_String :=
X_Display_Name (Display);
Event : X_Event;
Length : X_Raw_Data_Index;
begin
----Open a display connection.
X_Open_Display (Env, Dpy, Error);
if Dpy = null then
Text_Io.Put_Line ("Unable to open display {" & To_String (Display) &
"}: " & To_String (Err (Error)));
raise Abandon;
end if;
Screen := X_Default_Screen (Dpy);
----Initialize the resources. Do it this way until we have real widgets.
Xload_Resources.Foreground := X_Black_Pixel (Dpy, Screen);
Xload_Resources.Background := X_White_Pixel (Dpy, Screen);
Xload_Resources.Cursor := X_Create_Font_Cursor (Dpy, Xc_Hand2);
Xload_Resources.Debug := False;
Xload_Resources.Geometry := new X_String'(Geometry);
Xload_Resources.Icon_Geometry := new X_String'("32x32");
Xload_Resources.Iconic := False;
Xload_Resources.Icon_Name := null;
Xload_Resources.Reverse_Video := False;
Xload_Resources.Use_Dashes := Use_Dashes;
Xload_Resources.Interval := Interval;
----Which load do we watch?
if Which_Load = 0 then
Xload_Resources.Which_Load := 0;
elsif Which_Load < 5 then
Xload_Resources.Which_Load := 1;
elsif Which_Load < 10 then
Xload_Resources.Which_Load := 5;
else
Xload_Resources.Which_Load := 15;
end if;
----How many levels minimum?
if Levels in 1 .. Positive (S_Short'Last) then
Xload_Resources.Levels := S_Short (Levels);
else
Xload_Resources.Levels := 2;
end if;
----Which font do we use?
Xload_Resources.Font := X_Load_Query_Font (Dpy, Font);
if Xload_Resources.Font = None_X_Font_Struct then
Text_Io.Put_Line ("Unable to load font :{" &
To_String (Font) & "}.");
Xload_Resources.Font := X_Load_Query_Font (Dpy, "fixed");
if Xload_Resources.Font = None_X_Font_Struct then
Text_Io.Put_Line ("Unable to load font :{fixed}; exiting.");
return;
end if;
end if;
----Set the debugging flag? Use Sync?
if Xload_Resources.Debug then
declare
Void : Proc_Var_X_Synchandler.Pv;
begin
Void := X_Synchronize (Dpy, Onoff => True);
end;
end if;
----Set up the non-resources.
Xload_Resources.Host :=
new X_String'(X_Env_Get_Host_Name &
To_X_String (Natural'Image
(Xload_Resources.Which_Load)));
declare
Dir : X_Font_Direction;
Font_Ascent : S_Short;
Font_Descent : S_Short;
begin
X_Text_Extents (Xload_Resources.Font,
Xload_Resources.Host.all,
Dir, Font_Ascent, Font_Descent, Title_Overall);
----Set up the various Hints structures for our main window.
Size_Hints.Min_Width := S_Long (4 + Title_Overall.Width + 4);
Size_Hints.Min_Height :=
4 + S_Long (Title_Overall.Ascent + Title_Overall.Descent) +
4 + S_Long (Xload_Resources.Levels) * 4;
Size_Hints.Base_Width := Size_Hints.Min_Width;
Size_Hints.Base_Height := Size_Hints.Min_Height;
Size_Hints.Width_Inc := S_Long (Levels);
Size_Hints.Height_Inc := S_Long (Levels);
Size_Hints.Flags :=
X_Size_Hints_Flags'
(P_Min_Size | P_Resize_Inc | P_Base_Size => True,
others => False);
Set_Size_Hints (Size_Hints, Xload_Resources.Geometry.all);
end;
Wm_Hints.Input := True;
Wm_Hints.Flags := X_Wm_Hints_Flags'(Input_Hint => True,
others => False);
Class_Hint.Res_Name := new X_String'("xload");
Class_Hint.Res_Class := new X_String'("XLoad");
Attr.Background_Pixel := Xload_Resources.Background;
Attr.Border_Pixel := Xload_Resources.Foreground;
Attr.Cursor := X_Create_Font_Cursor (Dpy, Xc_Hand2);
Mask := X_New_Window_Attributes'
(Cw_Background_Pixel | Cw_Border_Pixel | Cw_Cursor => True,
others => False);
----Set up our icon.
Icon_Setup (Wm_Hints);
----Create our main window.
Xload := X_Create_Window
(Dpy, X_Default_Root_Window (Dpy),
S_Short (Size_Hints.X), S_Short (Size_Hints.Y),
U_Short (Size_Hints.Width), U_Short (Size_Hints.Height),
2, X_Default_Depth (Dpy, Screen),
Input_Output, X_Default_Visual_Of_Screen
(X_Default_Screen_Of_Display (Dpy)),
Mask, Attr);
X_Set_Wm_Properties (Dpy, Xload, "xload", "XLoad",
(1 .. 0 => None_X_String_Pointer),
Size_Hints, Wm_Hints, Class_Hint, Success);
----Select for certain kinds of events.
X_Select_Input
(Dpy, Xload,
X_Event_Mask'
(Structure_Notify_Mask | Exposure_Mask | Button_Press_Mask =>
True,
others => False));
X_Map_Window (Dpy, Xload);
----Set up our GC's.
Gc_Setup;
----Give our controls some kind of default initial values. These will be
-- overridden by the real values almost immediately as RECONFIGURE events
-- come in.
Pixels_Per_Level := (others => 4);
Levels_Height := (others => 0);
Top_Line := (others => 60);
Title_Overlap := (others => False);
----Now do the real thing.
Xload_Main.Levels := S_Natural (Xload_Resources.Levels);
----Loop forever. When we don't have pending events we will queue a read
-- request and wait for it to complete. Every so many seconds we will wake
-- up and take a load sample while we wait.
Notify.Set_Not_Done;
loop
while X_Pending (Dpy) = 0 loop
if Need_Redraw then
Redraw_From_History;
end if;
if Dpy.Network.Fd.State /= Pending_Read_Wait then
Receive_Queue
(Dpy.Network.Fd,
Dpy.Network.Fd_Error,
Dpy.Input.Data
(Dpy.Input.Used + 1 .. Dpy.Input.Data'Last), Length,
Notify);
end if;
if Dpy.Network.Fd.State = Pending_Read_Wait then
select
Notify.Wait_For_Done;
or
delay Duration (Xload_Resources.Interval);
Load_Sample;
X_Flush (Dpy);
end select;
elsif Length > 0 then
Dpy.Input.Used := Dpy.Input.Used + Length;
end if;
end loop;
X_Next_Event (Dpy, Event);
----Handle the event.
if Event.Window = Xload then
case Event.Kind is
----Exposures cause a redraw.
when Expose =>
if Event.Expose.Count = 0 then
Need_Redraw := True;
end if;
when Graphics_Expose =>
if Event.Graphics_Expose.Count = 0 then
Need_Redraw := True;
end if;
----Changes in size cause a reconfiguration and a redraw.
when Configure_Notify =>
Reconfigure (Event);
Need_Redraw := True;
----Button presses.
when Xlbt_Event.Button_Press =>
----Button 1 says do a load sample now.
if Event.Button.Button = Button_1 then
Load_Sample;
----CM_Button 2 says exit.
elsif Event.Button.Button = Button_2 and then
Event.Button.State =
X_Key_Button_Mask'
(Control_Mask | Shift_Mask => True,
others => False) then
exit;
----Button 3 says change the sampled average.
elsif Event.Button.Button = Button_3 then
Change_Load_Average;
----Other buttons just ring the bell.
else
X_Bell (Dpy, 0);
end if;
----Ignore anything else.
when others =>
null;
end case;
----Handle unexpected events for unknown windows.
else
Text_Io.Put ("Event for window ");
S_Long_Io.Put
(Event.Window.Drawable.Id.Number, Base => 16, Width => 0);
Text_Io.Put (" kind: ");
Text_Io.Put (X_Event_Code'Image (Event.Kind));
Text_Io.New_Line;
end if;
end loop;
X_Close_Display (Dpy);
end Main;
-- \f
end Xload_Main;