|
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: 20017 (0x4e31)
Types: TextFile
Names: »B«
└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00
└─ ⟦0c20f784e⟧ »DATA«
└─⟦1abbe589f⟧
└─⟦306851c02⟧
└─⟦this⟧
with Text_Io;
with Main;
use 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 Icon is
------------------------------------------------------------------------------
-- Dragon - 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
------------------------------------------------------------------------------
Dragon_Icon32_Width : constant := 32;
Dragon_Icon32_Height : constant := 32;
Dragon_Icon32_X_Hot : constant := -1;
Dragon_Icon32_Y_Hot : constant := -1;
Dragon_Icon32_Bits : constant U_Char_Array :=
(16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#,
16#00#, 16#00#, 16#00#, 16#00#, 16#F0#, 16#FF#, 16#FF#, 16#0F#,
16#50#, 16#B7#, 16#6D#, 16#0B#, 16#F0#, 16#FF#, 16#FF#, 16#0F#,
16#00#, 16#FC#, 16#3D#, 16#00#, 16#00#, 16#AC#, 16#2F#, 16#00#,
16#00#, 16#FC#, 16#3F#, 16#00#, 16#80#, 16#DF#, 16#F7#, 16#01#,
16#80#, 16#75#, 16#7D#, 16#01#, 16#80#, 16#FF#, 16#EF#, 16#01#,
16#F0#, 16#77#, 16#FF#, 16#3F#, 16#D0#, 16#DE#, 16#6B#, 16#2B#,
16#F0#, 16#FF#, 16#FE#, 16#3F#, 16#80#, 16#BF#, 16#EF#, 16#01#,
16#80#, 16#F6#, 16#7D#, 16#01#, 16#80#, 16#BF#, 16#FF#, 16#01#,
16#00#, 16#FC#, 16#3B#, 16#00#, 16#00#, 16#AC#, 16#2F#, 16#00#,
16#00#, 16#FC#, 16#3D#, 16#00#, 16#F0#, 16#BF#, 16#FF#, 16#0F#,
16#D0#, 16#F6#, 16#6D#, 16#0B#, 16#F0#, 16#FF#, 16#FF#, 16#0F#,
16#00#, 16#00#, 16#00#, 16#00#, 16#9C#, 16#63#, 16#8C#, 16#49#,
16#A4#, 16#94#, 16#42#, 16#5A#, 16#A4#, 16#F3#, 16#52#, 16#6A#,
16#9C#, 16#94#, 16#8C#, 16#49#, 16#00#, 16#00#, 16#00#, 16#00#,
16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#);
Dragon_Icon64_Width : constant := 64;
Dragon_Icon64_Height : constant := 64;
Dragon_Icon64_X_Hot : constant := -1;
Dragon_Icon64_Y_Hot : constant := -1;
Dragon_Icon64_Bits : constant U_Char_Array :=
(16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#,
16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#,
16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#,
16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#,
16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#,
16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#,
16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#,
16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#,
16#C0#, 16#F7#, 16#7D#, 16#DF#, 16#F7#, 16#7D#, 16#1F#, 16#00#,
16#C0#, 16#54#, 16#65#, 16#55#, 16#36#, 16#5D#, 16#1D#, 16#00#,
16#40#, 16#95#, 16#4D#, 16#53#, 16#95#, 16#6D#, 16#1B#, 16#00#,
16#C0#, 16#F7#, 16#7D#, 16#DF#, 16#F7#, 16#7D#, 16#1F#, 16#00#,
16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#,
16#00#, 16#00#, 16#7C#, 16#DF#, 16#F7#, 16#01#, 16#00#, 16#00#,
16#00#, 16#00#, 16#7C#, 16#D1#, 16#94#, 16#01#, 16#00#, 16#00#,
16#00#, 16#00#, 16#44#, 16#DF#, 16#95#, 16#01#, 16#00#, 16#00#,
16#00#, 16#00#, 16#7C#, 16#DF#, 16#F7#, 16#01#, 16#00#, 16#00#,
16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#,
16#00#, 16#F0#, 16#7D#, 16#DF#, 16#F7#, 16#7D#, 16#00#, 16#00#,
16#00#, 16#70#, 16#75#, 16#53#, 16#15#, 16#55#, 16#00#, 16#00#,
16#00#, 16#D0#, 16#55#, 16#53#, 16#15#, 16#45#, 16#00#, 16#00#,
16#00#, 16#F0#, 16#7D#, 16#DF#, 16#F7#, 16#7D#, 16#00#, 16#00#,
16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#,
16#C0#, 16#F7#, 16#7D#, 16#DF#, 16#F7#, 16#7D#, 16#1F#, 16#00#,
16#40#, 16#57#, 16#65#, 16#D9#, 16#B6#, 16#55#, 16#17#, 16#00#,
16#5E#, 16#54#, 16#65#, 16#F5#, 16#54#, 16#65#, 16#D1#, 16#7B#,
16#DE#, 16#F7#, 16#7D#, 16#FF#, 16#F7#, 16#7D#, 16#DF#, 16#6B#,
16#12#, 16#00#, 16#00#, 16#90#, 16#00#, 16#00#, 16#40#, 16#4A#,
16#D6#, 16#F7#, 16#7D#, 16#FF#, 16#F7#, 16#7D#, 16#DF#, 16#7B#,
16#DE#, 16#54#, 16#55#, 16#F5#, 16#96#, 16#7D#, 16#D5#, 16#7B#,
16#40#, 16#36#, 16#45#, 16#57#, 16#57#, 16#45#, 16#15#, 16#00#,
16#C0#, 16#F7#, 16#7D#, 16#DF#, 16#F7#, 16#7D#, 16#1F#, 16#00#,
16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#,
16#00#, 16#F0#, 16#7D#, 16#DF#, 16#F7#, 16#7D#, 16#00#, 16#00#,
16#00#, 16#D0#, 16#5D#, 16#51#, 16#35#, 16#45#, 16#00#, 16#00#,
16#00#, 16#50#, 16#55#, 16#51#, 16#17#, 16#7D#, 16#00#, 16#00#,
16#00#, 16#F0#, 16#7D#, 16#DF#, 16#F7#, 16#7D#, 16#00#, 16#00#,
16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#,
16#00#, 16#00#, 16#7C#, 16#DF#, 16#F7#, 16#01#, 16#00#, 16#00#,
16#00#, 16#00#, 16#4C#, 16#5D#, 16#57#, 16#01#, 16#00#, 16#00#,
16#00#, 16#00#, 16#5C#, 16#59#, 16#55#, 16#01#, 16#00#, 16#00#,
16#00#, 16#00#, 16#7C#, 16#DF#, 16#F7#, 16#01#, 16#00#, 16#00#,
16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#,
16#C0#, 16#F7#, 16#7D#, 16#DF#, 16#F7#, 16#7D#, 16#1F#, 16#00#,
16#40#, 16#56#, 16#45#, 16#57#, 16#36#, 16#75#, 16#15#, 16#00#,
16#40#, 16#15#, 16#55#, 16#51#, 16#56#, 16#45#, 16#15#, 16#00#,
16#C0#, 16#F7#, 16#7D#, 16#DF#, 16#F7#, 16#7D#, 16#1F#, 16#00#,
16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#,
16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#,
16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#,
16#00#, 16#1C#, 16#1E#, 16#04#, 16#87#, 16#23#, 16#02#, 16#00#,
16#00#, 16#24#, 16#22#, 16#8E#, 16#48#, 16#64#, 16#02#, 16#00#,
16#00#, 16#44#, 16#22#, 16#91#, 16#48#, 16#64#, 16#02#, 16#00#,
16#00#, 16#44#, 16#22#, 16#91#, 16#40#, 16#A4#, 16#02#, 16#00#,
16#00#, 16#44#, 16#1E#, 16#9F#, 16#4C#, 16#24#, 16#03#, 16#00#,
16#00#, 16#24#, 16#12#, 16#91#, 16#48#, 16#24#, 16#03#, 16#00#,
16#00#, 16#1C#, 16#22#, 16#11#, 16#87#, 16#23#, 16#02#, 16#00#,
16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#,
16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#,
16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#,
16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#,
16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#,
16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#,
16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#, 16#00#);
Icon_Gc : X_Gc := None_X_Gc; -- GC used for Icon window.
--\f
procedure Icon_Expose (Window : X_Window; Event : X_Event) is
------------------------------------------------------------------------------
-- Window - Specifies the window that got the event
-- Event - Specifies the event that was received
--
-- Called when our Icon window receives an Expose event. This is only called
-- when we are using an Icon window. If we managed to use an Icon pixmap then
-- this routine is not called at all.
------------------------------------------------------------------------------
Ximage : X_Image;
Gcv : X_Gc_Values;
Wid : U_Short := 64;
Hei : U_Short := 64;
Bw : U_Short := 0;
Depth : U_Char;
X, Y : S_Short;
Root : X_Window;
Size : U_Short;
Success : X_Status;
begin
----Figure out how big our window is.
X_Get_Geometry (Dpy, Window.Drawable, Root, X, Y,
Wid, Hei, Bw, Depth, Success);
if Success = Failed then
Text_Io.Put_Line ("Cannot get geometry of the icon window?");
return;
end if;
if Wid < 64 or else Hei < 64 then
Size := 32;
else
Size := 64;
end if;
----Get a GC and create an image of an appropriate size using one of our
-- reexisting Icon images.
if Icon_Gc = None_X_Gc then
Gcv.Foreground := Dragon_Resources.Foreground;
Gcv.Background := Dragon_Resources.Background;
Icon_Gc :=
X_Create_Gc
(Dpy, Window.Drawable,
X_Gc_Components'(Gc_Foreground | Gc_Background => True,
others => False),
Gcv);
end if;
if Size = 64 then
Ximage := X_Create_Image
(Display => Dpy,
Visual => None_X_Visual,
Depth => 1,
Format => X_Y_Bitmap,
Offset => 0,
Data => Dragon_Icon64_Bits,
Width => Dragon_Icon64_Width,
Height => Dragon_Icon64_Height,
Bitmap_Pad => 8,
Image_Bytes_Per_Line =>
(Dragon_Icon64_Width + 7) / 8);
else
Ximage := X_Create_Image
(Display => Dpy,
Visual => None_X_Visual,
Depth => 1,
Format => X_Y_Bitmap,
Offset => 0,
Data => Dragon_Icon32_Bits,
Width => Dragon_Icon32_Width,
Height => Dragon_Icon32_Height,
Bitmap_Pad => 8,
Image_Bytes_Per_Line =>
(Dragon_Icon32_Width + 7) / 8);
end if;
Ximage.Byte_Order := Xlbt_Image3.Lsb_First;
Ximage.Bitmap_Bit_Order := Xlbt_Image3.Lsb_First;
----Draw the bitmap on the window.
X_Clear_Window (Dpy, Window);
X_Put_Image (Dpy, Window.Drawable, Icon_Gc, Ximage,
0, 0, S_Short (Wid - Size) / 2,
S_Short (Hei - Size) / 2, Size, Size);
-- Debug_Return ("Icon_Expose");
end Icon_Expose;
--\f
procedure Icon_Setup (Wm_Hints : in out X_Wm_Hints) is
------------------------------------------------------------------------------
-- Wm_Hints - Specifies an X_Wm_Hints structure to modify, it receives
-- either an Icon_Pixmap or an Icon_Window as appropriate.
--
-- 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 (Dragon_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 64x64 pixmap but we are willing
-- to settle for a 32x32. We grab the first size that allows us to create
-- a pixmap of exactly one of these sizes. If we cannot find an exact match
-- then "accepted" is set to point to an acceptable size.
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 = 64 and then
Ic (I).Min_Height = 64 then
Size := 64;
exit;
elsif Ic (I).Min_Width >= 64 and then
Ic (I).Min_Height >= 64 then
Size := 64;
elsif 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 64 in Ic (I).Min_Width .. Ic (I).Max_Width and then
64 in Ic (I).Min_Height .. Ic (I).Max_Height and then
(64 - Ic (I).Min_Width) rem Ic (I).Width_Inc = 0 and then
(64 - Ic (I).Min_Height) rem Ic (I).Height_Inc = 0 then
Size := 64;
exit;
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;
if Size = 64 then
Icon_Pixmap := -- Size is perfect
X_Create_Pixmap_From_Bitmap_Data
(Dpy, X_Default_Root_Window (Dpy).Drawable,
Dragon_Icon64_Bits, Dragon_Icon64_Width,
Dragon_Icon64_Height, Dragon_Resources.Foreground,
Dragon_Resources.Background,
X_Default_Depth_Of_Screen
(X_Default_Screen_Of_Display (Dpy)));
else
Icon_Pixmap := -- Size is perfect
X_Create_Pixmap_From_Bitmap_Data
(Dpy, X_Default_Root_Window (Dpy).Drawable,
Dragon_Icon32_Bits, Dragon_Icon32_Width,
Dragon_Icon32_Height, Dragon_Resources.Foreground,
Dragon_Resources.Background,
X_Default_Depth_Of_Screen
(X_Default_Screen_Of_Display (Dpy)));
end if;
end if;
----If we managed to create a pixmap then use that. Otherwise we need a window
-- for our icon.
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;
else
----No Pixmap found (or possibly none supported). Try an Icon
-- window instead.
declare
Icon_Window : X_Window;
Size_Hints : X_Size_Hints;
Mask : X_New_Window_Attributes;
Attr : X_Set_Window_Attributes;
Success : X_Status;
begin
----Create a shell to contain the Icon window.
-- Debug_Other ("Icon_Setup", "Icon X_Window");
Size_Hints.Min_Width := 32;
Size_Hints.Min_Height := 32;
Size_Hints.Base_Width := 32;
Size_Hints.Base_Height := 32;
Size_Hints.Width_Inc := 32;
Size_Hints.Height_Inc := 32;
Size_Hints.Min_Aspect.X := 100;
Size_Hints.Min_Aspect.Y := 100;
Size_Hints.Max_Aspect.X := 100;
Size_Hints.Max_Aspect.Y := 100;
Size_Hints.Flags :=
X_Size_Hints_Flags'
(P_Min_Size | P_Aspect | P_Resize_Inc | P_Base_Size =>
True,
others => False);
Set_Size_Hints (Size_Hints, Dragon_Resources.Icon_Geometry.all);
Attr.Background_Pixel := Dragon_Resources.Background;
Attr.Border_Pixel := Dragon_Resources.Foreground;
Mask := X_New_Window_Attributes'
(Cw_Back_Pixel | Cw_Border_Pixel => True,
others => False);
Icon_Window :=
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),
1, X_Default_Depth_Of_Screen
(X_Default_Screen_Of_Display (Dpy)),
Input_Output, X_Default_Visual_Of_Screen
(X_Default_Screen_Of_Display (Dpy)),
Mask, Attr);
X_Set_Wm_Properties (Dpy, Icon_Window,
"Dragon-Icon", "Dragon-Icon",
(1 .. 0 => None_X_String_Pointer),
Size_Hints, Wm_Hints,
None_X_Class_Hint, Success);
X_Select_Input (Dpy, Icon_Window,
X_Event_Mask'(Exposure_Mask => True,
others => False));
----Use the Icon window.
Wm_Hints.Icon_Window := Icon_Window;
Wm_Hints.Flags (Icon_Window_Hint) := True;
end;
end if;
-- Debug_Return ("Icon_Setup");
end Icon_Setup;
--\f
end Icon;