|
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: 14336 (0x3800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Xlbp_Visual, seg_004f91
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Xlbt_Arithmetic;
use Xlbt_Arithmetic;
with Xlbt_Basic;
use Xlbt_Basic;
with Xlbt_Color;
use Xlbt_Color;
with Xlbt_Display2;
use Xlbt_Display2;
with Xlbt_Visual;
use Xlbt_Visual;
with Xlbt_Visual2;
use Xlbt_Visual2;
with Xlbip_Internal;
use Xlbip_Internal;
package body Xlbp_Visual is
------------------------------------------------------------------------------
-- X Library Visual Information
--
-- Xlbp_Visual - Used to obtain information upon the various visual
-- display types possible with a particular server
------------------------------------------------------------------------------
-- Copyright 1989 - 1991 by Rational, Santa Clara, California.
-- Copyright 1987 - 1989 by Digital Equipment Corporation, Maynard, Mass.
-- Copyright 1987 - 1989 by Massachusetts Institute of Technology,
-- Cambridge, Massachusetts.
--
-- All Rights Reserved.
--
-- Permission to use, copy, modify, and distribute this software and its
-- documentation for any purpose and without fee is hereby granted,
-- provided that the above copyright notice(s) appear in all copies and that
-- both that copyright notice(s) and this permission notice appear in
-- supporting documentation, and that the names of Digital, MIT, or Rational
-- not be used in advertising or publicity pertaining to distribution of
-- the software without specific, written prior permission.
--
-- Digital, MIT, and Rational disclaim all warranties with regard to this
-- software, including all implied warranties of merchantability and fitness,
-- in no event shall Digital, MIT, or Rational be liable for any special,
-- indirect or consequential damages or any damages whatsoever resulting from
-- loss of use, data or profits, whether in an action of contract, negligence
-- or other tortious action, arising out of or in connection with the use or
-- performance of this software.
------------------------------------------------------------------------------
--\x0c
function X_Get_Visual_Info (Display : X_Display;
Values_Mask : X_Visual_Info_Flags;
Values : X_Visual_Info)
return X_Visual_Info_List is
------------------------------------------------------------------------------
--
-- This procedure returns a list of vis information structures
-- that match the specified attributes given in the vis information
-- template.
--
-- If no visuals exist that match the specified attributes, a NULL is
-- returned.
--
-- The choices for values_mask are:
--
-- Visual_No_Mask
-- Visual_ID_Mask
-- Visual_Screen_Mask
-- Visual_Depth_Mask
-- Visual_Class_Mask
-- Visual_Red_Mask_Mask
-- Visual_Green_Mask_Mask
-- Visual_Blue_Mask_Mask
-- Visual_Colormap_Size_Mask
-- Visual_Bits_Per_RGB_Mask
-- Visual_All_Mask
------------------------------------------------------------------------------
Dp : X_Depth;
Screen_S : X_Screen_Number;
Screen_E : X_Screen_Number;
Count : S_Natural := 0;
Vip_Base : X_Visual_Info_Array (1 .. Display.Total_Visuals);
begin
Lock_Display (Display);
begin
----Determine if we do all screens or only one.
Screen_S := Display.Screens'First;
Screen_E := Display.Screens'Last;
if Values_Mask (Visual_Screen_Mask) then
Screen_S := Values.Screen;
Screen_E := Screen_S;
end if;
----Loop through screens/depths/visuals.
declare
procedure Do_Visual (Vp : X_Visual; Ii : X_Screen_Number) is
----For each visual; see if we want to do it.
begin
if (Values_Mask (Visual_Id_Mask) and then
Vp.Visual_Id /= Values.Visual_Id)
or else
(Values_Mask (Visual_Class_Mask) and then
Vp.Class /= Values.Class)
or else
(Values_Mask (Visual_Red_Mask_Mask) and then
Vp.Red_Mask /= Values.Red_Mask)
or else
(Values_Mask (Visual_Green_Mask_Mask) and then
Vp.Green_Mask /= Values.Green_Mask)
or else
(Values_Mask (Visual_Blue_Mask_Mask) and then
Vp.Blue_Mask /= Values.Blue_Mask)
or else
(Values_Mask (Visual_Colormap_Size_Mask) and then
Vp.Map_Entries /= Values.Colormap_Size)
or else
(Values_Mask (Visual_Bits_Per_Rgb_Mask) and then
Vp.Bits_Per_Rgb /= Values.Bits_Per_Rgb) then
return;
end if;
-- YEA!!! WE FOUND A GOOD ONE
Count := Count + 1;
Vip_Base (Count) :=
X_Visual_Info'(Visual => Vp,
Visual_Id => Vp.Visual_Id,
Screen => Ii,
Depth => Dp.Depth,
Class => Vp.Class,
Red_Mask => Vp.Red_Mask,
Green_Mask => Vp.Green_Mask,
Blue_Mask => Vp.Blue_Mask,
Colormap_Size => Vp.Map_Entries,
Bits_Per_Rgb => Vp.Bits_Per_Rgb);
end Do_Visual;
procedure Do_Depth (Dp : X_Depth_Rec; Ii : X_Screen_Number) is
----For each Depth; see if it has visuals we want.
begin
if Values_Mask (Visual_Depth_Mask) and then
Dp.Depth /= Values.Depth then
return;
end if;
for Kk in Dp.Visuals'Range loop
Do_Visual (Dp.Visuals (Kk), Ii);
end loop;
end Do_Depth;
procedure Do_Screen (Sp : X_Screen; Ii : X_Screen_Number) is
----For each Screen; check out it's depths.
begin
for Jj in Sp.Depths'Range loop
Do_Depth (Sp.Depths (Jj), Ii);
end loop;
end Do_Screen;
begin
----Loop through the visuals in the depths in the screens and find
-- any visuals that we care about.
for Ii in Screen_S .. Screen_E loop
Do_Screen (Display.Screens (Ii), Ii);
end loop;
end;
----Catch unexpected exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; prepare results; return.
Unlock_Display (Display);
if Count = 0 then
return None_X_Visual_Info_List;
else
return new X_Visual_Info_Array'(Vip_Base (1 .. Count));
end if;
end X_Get_Visual_Info;
--\x0c
procedure X_Match_Visual_Info (Display : X_Display;
Screen : X_Screen_Number;
Depth : U_Char;
Class : X_Display_Class;
Values : out X_Visual_Info;
Status : out X_Status) is
------------------------------------------------------------------------------
-- This procedure will return the vis information for a vis
-- that matches the specified depth and class for a scr. Since
-- multiple visuals may exist that match the specified depth and
-- class, which vis chosen is undefined.
--
-- If a vis is found, True is returned as the funct value,
-- otherwise False is returned.
------------------------------------------------------------------------------
Sp : X_Screen renames Display.Screens (Screen);
begin
Lock_Display (Display);
begin
----Look through depths for the wanted depth.
for Ii in Sp.Depths'Range loop
if Sp.Depths (Ii).Depth = Depth then
----Look through visuals for the wanted class.
for Jj in Sp.Depths (Ii).Visuals'Range loop
declare
Vp : X_Visual renames Sp.Depths (Ii).Visuals (Jj);
begin
if Vp.Class = Class then
Values := (Visual => Vp,
Visual_Id => Vp.Visual_Id,
Screen => Screen,
Depth => Depth,
Class => Vp.Class,
Red_Mask => Vp.Red_Mask,
Green_Mask => Vp.Green_Mask,
Blue_Mask => Vp.Blue_Mask,
Colormap_Size => Vp.Map_Entries,
Bits_Per_Rgb => Vp.Bits_Per_Rgb);
Unlock_Display (Display);
Status := Successful;
return;
end if;
end;
end loop;
end if;
end loop;
----Catch exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; set our OUT parameter to anything; return failed.
Unlock_Display (Display);
Values := None_X_Visual_Info;
Status := Failed;
end X_Match_Visual_Info;
--\x0c
end Xlbp_Visual;
nblk1=d
nid=0
hdr6=1a
[0x00] rec0=20 rec1=00 rec2=01 rec3=02c
[0x01] rec0=0f rec1=00 rec2=02 rec3=020
[0x02] rec0=1b rec1=00 rec2=03 rec3=040
[0x03] rec0=1d rec1=00 rec2=04 rec3=05e
[0x04] rec0=00 rec1=00 rec2=0d rec3=012
[0x05] rec0=12 rec1=00 rec2=05 rec3=070
[0x06] rec0=12 rec1=00 rec2=06 rec3=08c
[0x07] rec0=02 rec1=00 rec2=0c rec3=006
[0x08] rec0=18 rec1=00 rec2=07 rec3=05e
[0x09] rec0=22 rec1=00 rec2=08 rec3=03a
[0x0a] rec0=19 rec1=00 rec2=09 rec3=082
[0x0b] rec0=10 rec1=00 rec2=0a rec3=05e
[0x0c] rec0=1d rec1=00 rec2=0b rec3=000
tail 0x21700700e819783895166 0x42a00088462063203