|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 10240 (0x2800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Xload_Icon, seg_0052fb
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Text_Io;
with Xload_Main;
use Xload_Main;
with Xlbt_Arithmetic;
use Xlbt_Arithmetic;
with Xlbt_Basic;
use Xlbt_Basic;
with Xlbt_Event;
use Xlbt_Event;
with Xlbt_Gc;
use Xlbt_Gc;
with Xlbt_Geometry;
use Xlbt_Geometry;
with Xlbt_Hint;
use Xlbt_Hint;
with Xlbt_Image;
use Xlbt_Image;
with Xlbt_Image3;
with Xlbt_String;
use Xlbt_String;
with Xlbt_Window;
use Xlbt_Window;
with Xlbt_Visual;
use Xlbt_Visual;
with Xlbp_Bitmap;
use Xlbp_Bitmap;
with Xlbp_Display;
use Xlbp_Display;
with Xlbp_Event;
use Xlbp_Event;
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_Image;
use Xlbp_Image;
with Xlbp_Window;
use Xlbp_Window;
with Xlbp_Window_Information;
use Xlbp_Window_Information;
package body Xload_Icon is
------------------------------------------------------------------------------
-- Xload - a version of Mah-Jongg for X Windows
--
-- Author: Gary E. Barnes March 1989
--
-- icon.c - Deals with our icon. Setup and execution.
------------------------------------------------------------------------------
-- 05/30/90 GEB - Translate to Ada
------------------------------------------------------------------------------
Xload_Width : constant := 32;
Xload_Height : constant := 32;
Xload_Bits : constant U_Char_Array :=
(16#00#, 16#00#, 16#C0#, 16#03#, 16#1E#, 16#00#, 16#F0#, 16#03#, 16#00#,
16#00#, 16#F8#, 16#03#, 16#FF#, 16#FF#, 16#FF#, 16#FF#, 16#00#, 16#00#,
16#FC#, 16#03#, 16#00#, 16#00#, 16#FE#, 16#03#, 16#FF#, 16#FF#, 16#FF#,
16#FF#, 16#00#, 16#80#, 16#FF#, 16#03#, 16#00#, 16#C0#, 16#FF#, 16#03#,
16#FF#, 16#FF#, 16#FF#, 16#FF#, 16#00#, 16#E0#, 16#FF#, 16#03#, 16#00#,
16#F0#, 16#FF#, 16#03#, 16#FF#, 16#FF#, 16#FF, 16#FF#, 16#00#, 16#F8#,
16#FF#, 16#03#, 16#00#, 16#F8#, 16#FF#, 16#03#, 16#FF#, 16#FF#, 16#FF#,
16#FF#, 16#00#, 16#FC#, 16#FF#, 16#03#, 16#00#, 16#FC#, 16#FF#, 16#03#,
16#FF#, 16#FF#, 16#FF#, 16#FF#, 16#00#, 16#FE#, 16#FF#, 16#03#,
16#00#, 16#FE#, 16#FF#, 16#03#, 16#FF#, 16#FF#, 16#FF#, 16#FF#,
16#00#, 16#FF#, 16#FF#, 16#03#, 16#00#, 16#FF#, 16#FF#, 16#03#,
16#FF#, 16#FF#, 16#FF#, 16#FF#, 16#80#, 16#FF#, 16#FF#, 16#03#,
16#C0#, 16#FF#, 16#FF#, 16#03#, 16#FF#, 16#FF#, 16#FF#, 16#FF#,
16#F8#, 16#FF#, 16#FF#, 16#03#, 16#FF#, 16#FF#, 16#FF#, 16#03#,
16#FF#, 16#FF#, 16#FF#, 16#FF#, 16#FF#, 16#FF#, 16#FF#, 16#03#);
-- \x0c
procedure Icon_Setup (Wm_Hints : in out X_Wm_Hints) is
------------------------------------------------------------------------------
-- Wm_Hints - Specifies an X_Wm_Hints structure to modify, it receives
-- an Icon_Pixmap.
--
-- Called to handle all of the Icon setup for our main shell.
------------------------------------------------------------------------------
Ic : X_Icon_Size_List;
Success : X_Status;
I : S_Long;
Size : S_Long;
Accepted : S_Long;
Icon_Pixmap : X_Pixmap := None_X_Pixmap;
W, H : U_Short := 0;
X, Y : S_Short := 0;
Flags : X_Parse_Geometry_Flags;
begin
----If we've been asked to set up the Icon geometry then do that.
-- Debug_Call ("Icon_Setup");
X_Parse_Geometry (Xload_Resources.Icon_Geometry.all, X, Y, W, H, Flags);
if Flags (X_Value) then
Wm_Hints.Icon_X := S_Long (X);
Wm_Hints.Flags (Icon_Position_Hint) := True;
end if;
if Flags (Y_Value) then
Wm_Hints.Icon_Y := S_Long (Y);
Wm_Hints.Flags (Icon_Position_Hint) := True;
end if;
----Set up the Icon pixmap or window. We try to use a pixmap instead of a
-- window because it is simply less overhead. If there are supported Icon
-- pixmap sizes then maybe we can use an icon pixmap.
X_Get_Icon_Sizes (Dpy,
X_Default_Root_Window (Dpy),
Ic,
Success);
if Success /= Failed then
----Run over all of the sizes. We try to get a 32x32 pixmap.
-- We grab the first size that allows us to create a pixmap of 32x32 or
-- larger.
Size := 0;
for I in Ic'Range loop
if Ic (I).Width_Inc = 0 or else
Ic (I).Height_Inc = 0 then
if Ic (I).Min_Width = 32 and then
Ic (I).Min_Height = 32 then
Size := 32;
exit;
elsif Ic (I).Min_Width >= 32 and then
Ic (I).Min_Height >= 32 then
Size := 32;
else
Size := 32;
end if;
elsif Size = 0 and then
32 in Ic (I).Min_Width .. Ic (I).Max_Width and then
32 in Ic (I).Min_Height .. Ic (I).Max_Height and then
(32 - Ic (I).Min_Width) rem Ic (I).Width_Inc = 0 and then
(32 - Ic (I).Min_Height) rem Ic (I).Height_Inc = 0 then
Size := 32;
exit;
elsif Size = 0 and then
Ic (I).Max_Width >= 32 and then
Ic (I).Max_Height >= 32 then
Size := 32;
end if;
end loop;
Icon_Pixmap := -- Size is perfect
X_Create_Pixmap_From_Bitmap_Data
(Dpy, X_Default_Root_Window (Dpy).Drawable,
Xload_Bits, Xload_Width, Xload_Height,
Xload_Resources.Foreground, Xload_Resources.Background,
X_Default_Depth_Of_Screen
(X_Default_Screen_Of_Display (Dpy)));
end if;
----If we managed to create a pixmap then use that. Otherwise we don't use
-- anything.
if Icon_Pixmap /= None_X_Pixmap then
-- Debug_Other ("Icon_Setup", "Icon X_Pixmap");
Wm_Hints.Icon_Pixmap := Icon_Pixmap;
Wm_Hints.Flags (Icon_Pixmap_Hint) := True;
end if;
-- Debug_Return ("Icon_Setup");
end Icon_Setup;
-- \x0c
end Xload_Icon;
nblk1=9
nid=0
hdr6=12
[0x00] rec0=33 rec1=00 rec2=01 rec3=038
[0x01] rec0=13 rec1=00 rec2=02 rec3=06a
[0x02] rec0=00 rec1=00 rec2=09 rec3=002
[0x03] rec0=11 rec1=00 rec2=03 rec3=01e
[0x04] rec0=17 rec1=00 rec2=04 rec3=02c
[0x05] rec0=03 rec1=00 rec2=08 rec3=046
[0x06] rec0=17 rec1=00 rec2=05 rec3=070
[0x07] rec0=15 rec1=00 rec2=06 rec3=020
[0x08] rec0=14 rec1=00 rec2=07 rec3=000
tail 0x2150097ea819786f47dd8 0x42a00088462063203