DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ B T

⟦74b0768ee⟧ TextFile

    Length: 36402 (0x8e32)
    Types: TextFile
    Names: »B«

Derivation

└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00
    └─ ⟦0c20f784e⟧ »DATA« 
        └─⟦1abbe589f⟧ 
            └─⟦059497ac5⟧ 
                └─⟦this⟧ 

TextFile

with Xlbt_Arithmetic;  
use Xlbt_Arithmetic;  
with Xlbt_Basic;  
use Xlbt_Basic;  
with Xlbt_Color;  
use Xlbt_Color;  
with Xlbt_Exceptions;  
use Xlbt_Exceptions;  
with Xlbt_Misc;  
use Xlbt_Misc;  
with Xlbt_Reply;  
use Xlbt_Reply;  
with Xlbt_Request;  
use Xlbt_Request;  
with Xlbt_String;  
use Xlbt_String;  
with Xlbt_Window;  
use Xlbt_Window;  
with Xlbt_Visual;  
use Xlbt_Visual;

with Xlbip_Get_Reply;  
use Xlbip_Get_Reply;  
with Xlbip_Internal;  
use Xlbip_Internal;  
with Xlbip_Put_Request;  
use Xlbip_Put_Request;

with Xlbmt_Network_Types;  
use Xlbmt_Network_Types;

package body Xlbp_Color is
------------------------------------------------------------------------------
-- X Library Colors
--
-- Xlbp_Color - Used to work with colors by name.
------------------------------------------------------------------------------
-- Copyright 1989 - 1991 by Rational, Santa Clara, California.
-- Copyright 1985 - 1989 by the Massachusetts Institute of Technology
--
--                  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 MIT or Rational not be
-- used in advertising or publicity pertaining to distribution of the software
-- without specific, written prior permission.
--
-- MIT and Rational disclaim all warranties with regard to this software,
-- including all implied warranties of merchantability and fitness, in no
-- event shall 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.
------------------------------------------------------------------------------

--\f

    procedure X_Alloc_Color (Display  :        X_Display;  
                             Colormap :        X_Colormap;  
                             Color    : in out X_Color;  
                             Status   : out    X_Status) is  
        Rep  : X_Reply_Contents;  
        Succ : X_Status;  
    begin

----Lock the display.

        Lock_Display (Display);  
        begin

----Send the request.

            Put_X_Alloc_Color_Request  
               (Display, (Kind     => Alloc_Color,  
                          Length   => X_Alloc_Color_Request'Size / 32,  
                          Pad      => 0,  
                          Pad2     => 0,  
                          Colormap => Colormap,  
                          Red      => Color.Red,  
                          Green    => Color.Green,  
                          Blue     => Color.Blue));

----Get the reply.

            Get_Reply (Display => Display,  
                       Code    => Alloc_Color,  
                       Reply   => Rep,  
                       Extra   => 0,  
                       Discard => True,  
                       Status  => Succ);  
            Status := Succ;  
            if Succ /= Failed then  
                Color.Pixel := Rep.Alloc_Color.Pixel;  
                Color.Red   := Rep.Alloc_Color.Red;  
                Color.Green := Rep.Alloc_Color.Green;  
                Color.Blue  := Rep.Alloc_Color.Blue;  
            end if;

----Catch unexpected exceptions.

        exception  
            when others =>  
                Unlock_Display (Display);  
                raise;  
        end;

----Unlock; sync; return.

        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Alloc_Color;

--\f

    procedure X_Alloc_Color_Cells (Display    :     X_Display;  
                                   Colormap   :     X_Colormap;  
                                   Contiguous :     Boolean;  
                                   Planes     : out X_Plane_Mask_Array;  
                                   Pixels     : out X_Pixel_Array;  
                                   Status     : out X_Status) is  
        Succ : X_Status;  
        Rep  : X_Reply_Contents;  
    begin

----Lock the display.

        Lock_Display (Display);  
        begin

----Send the request.

            Put_X_Alloc_Color_Cells_Request  
               (Display, (Kind       => Alloc_Color_Cells,  
                          Length     => X_Alloc_Color_Cells_Request'Size / 32,  
                          Contiguous => From_Boolean (Contiguous),  
                          Colormap   => Colormap,  
                          Colors     => Pixels'Length,  
                          Planes     => Planes'Length));

----Get the reply.

            Get_Reply (Display => Display,  
                       Code    => Alloc_Color_Cells,  
                       Reply   => Rep,  
                       Extra   => X_Pixel'Size / 8 * Pixels'Length +  
                                     X_Plane_Mask'Size / 8 / 8 * Planes'Length,  
                       Discard => False,  
                       Status  => Succ);  
            Status := Succ;

----Return our results.

            if Succ /= Failed then  
                Get_X_Pixel_Array (Display, Pixels);  
                Get_X_Plane_Mask_Array (Display, Planes);  
            else  
                Pixels := (others => None_X_Pixel);  
                Planes := (others => No_Planes);  
            end if;

----Catch unexpected exceptions.

        exception  
            when others =>  
                Unlock_Display (Display);  
                raise;  
        end;

----Unlock; sync; return.

        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Alloc_Color_Cells;

--\f

    procedure X_Alloc_Color_Planes (Display    :     X_Display;  
                                    Colormap   :     X_Colormap;  
                                    Contiguous :     Boolean;  
                                    Pixels     : out X_Pixel_Array;  
                                    N_Reds     :     U_Short;  
                                    N_Greens   :     U_Short;  
                                    N_Blues    :     U_Short;  
                                    R_Mask     : out X_Red_Color_Mask;  
                                    G_Mask     : out X_Green_Color_Mask;  
                                    B_Mask     : out X_Blue_Color_Mask;  
                                    Status     : out X_Status) is  
        Succ : X_Status;  
        Rep  : X_Reply_Contents;  
    begin

----Lock the display.

        Lock_Display (Display);  
        begin

----Send the request.

            Put_X_Alloc_Color_Planes_Request  
               (Display, (Kind       => Alloc_Color_Planes,  
                          Length     => X_Alloc_Color_Planes_Request'Size / 32,  
                          Contiguous => From_Boolean (Contiguous),  
                          Colormap   => Colormap,  
                          Colors     => Pixels'Length,  
                          Red        => N_Reds,  
                          Green      => N_Greens,  
                          Blue       => N_Blues));

----Get the reply and the results.

            Get_Reply (Display => Display,  
                       Code    => Alloc_Color_Planes,  
                       Reply   => Rep,  
                       Extra   => X_Pixel'Size / 8 * Pixels'Length,  
                       Discard => False,  
                       Status  => Succ);  
            Status := Succ;  
            if Succ /= Failed then  
                R_Mask := Rep.Alloc_Color_Planes.Red_Mask;  
                G_Mask := Rep.Alloc_Color_Planes.Green_Mask;  
                B_Mask := Rep.Alloc_Color_Planes.Blue_Mask;  
                Get_X_Pixel_Array (Display, Pixels);  
            else  
                R_Mask := None_X_Color_Mask;  
                G_Mask := None_X_Color_Mask;  
                B_Mask := None_X_Color_Mask;  
            end if;

----Catch unexpected exceptions.

        exception  
            when others =>  
                Unlock_Display (Display);  
                raise;  
        end;

----Unlock; sync; return.

        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Alloc_Color_Planes;

--\f

    procedure X_Alloc_Named_Color (Display      :     X_Display;  
                                   Colormap     :     X_Colormap;  
                                   Colorname    :     X_String;  
                                   Visual_Color : out X_Color;  
                                   Exact_Color  : out X_Color;  
                                   Status       : out X_Status) is  
        N_Bytes : U_Short;  
        Rep     : X_Reply_Contents;  
        Succ    : X_Status;  
    begin

----Lock the display.

        Lock_Display (Display);  
        begin

----Send the request.

            N_Bytes := Colorname'Length;  
            Put_X_Alloc_Named_Color_Request  
               (Display,  
                (Kind     => Alloc_Named_Color,  
                 Length   =>  
                    X_Alloc_Named_Color_Request'Size / 32 + (N_Bytes + 3) / 4,  
                 Pad      => 0,  
                 Pad1     => 0,  
                 Pad2     => 0,  
                 N_Bytes  => N_Bytes,  
                 Colormap => Colormap),  
                S_Natural (N_Bytes));

----Send the extra data.

            Put_X_String (Display, Colorname);

----Get the response.

            Get_Reply (Display => Display,  
                       Code    => Alloc_Named_Color,  
                       Reply   => Rep,  
                       Extra   => 0,  
                       Discard => True,  
                       Status  => Succ);  
            if Succ = Failed then  
                Visual_Color := None_X_Color;  
                Exact_Color  := None_X_Color;  
                Status       := Failed;  
                Unlock_Display (Display);  
                Sync_Handle (Display);  
                return;  
            end if;

            Exact_Color.Red   := Rep.Alloc_Named_Color.Exact_Red;  
            Exact_Color.Green := Rep.Alloc_Named_Color.Exact_Green;  
            Exact_Color.Blue  := Rep.Alloc_Named_Color.Exact_Blue;

            Visual_Color.Red   := Rep.Alloc_Named_Color.Screen_Red;  
            Visual_Color.Green := Rep.Alloc_Named_Color.Screen_Green;  
            Visual_Color.Blue  := Rep.Alloc_Named_Color.Screen_Blue;

            Visual_Color.Pixel := Rep.Alloc_Named_Color.Pixel;  
            Exact_Color.Pixel  := Rep.Alloc_Named_Color.Pixel;

----Catch unexpected exceptions.

        exception  
            when others =>  
                Unlock_Display (Display);  
                raise;  
        end;

----Unlock; sync; return.

        Unlock_Display (Display);  
        Sync_Handle (Display);  
        Status := Successful;

    end X_Alloc_Named_Color;

--\f

    procedure X_Free_Colors (Display  : X_Display;  
                             Colormap : X_Colormap;  
                             Pixels   : X_Pixel_Array;  
                             Planes   : X_Plane_Mask) is  
        N_Pixels : S_Natural := Pixels'Length;  
    begin

----Lock the display.

        Lock_Display (Display);  
        begin

----Send the request.

            Put_X_Free_Colors_Request  
               (Display,  
                (Kind => Free_Colors,  
                 Length => X_Free_Colors_Request'Size / 32 + U_Short (N_Pixels),  
                 Pad => 0,  
                 Colormap => Colormap,  
                 Plane_Mask => Planes),  
                N_Pixels * 4);

----Send the pixels.

            Put_X_Pixel_Array (Display, Pixels);

----Catch unexpected exceptions.

        exception  
            when others =>  
                Unlock_Display (Display);  
                raise;  
        end;

----Unlock; sync; return.

        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Free_Colors;

--\f

    procedure X_Lookup_Color (Display      :     X_Display;  
                              Colormap     :     X_Colormap;  
                              Colorname    :     X_String;  
                              Visual_Color : out X_Color;  
                              Exact_Color  : out X_Color;  
                              Status       : out X_Status) is  
        N     : S_Natural;  
        Reply : X_Reply_Contents;  
        Succ  : X_Status;  
    begin

----Lock the display.

        N := Colorname'Length;  
        Lock_Display (Display);  
        begin

----Send the request.

            Put_X_Lookup_Color_Request  
               (Display,  
                (Kind     => Lookup_Color,  
                 Length   =>  
                    X_Lookup_Color_Request'Size / 32 + U_Short (N + 3) / 4,  
                 Pad      => 0,  
                 Pad1     => 0,  
                 Pad2     => 0,  
                 Colormap => Colormap,  
                 N_Bytes  => U_Short (N)),  
                N);

----Send the extra data.

            Put_X_String (Display, Colorname);

----Read the response.

            Get_Reply (Display => Display,  
                       Code    => Lookup_Color,  
                       Reply   => Reply,  
                       Extra   => 0,  
                       Discard => True,  
                       Status  => Succ);  
            if Succ = Failed then  
                Visual_Color := None_X_Color;  
                Exact_Color  := None_X_Color;  
                Status       := Failed;  
                Unlock_Display (Display);  
                Sync_Handle (Display);  
                return;  
            end if;  
            Visual_Color.Red   := Reply.Lookup_Color.Exact_Red;  
            Visual_Color.Green := Reply.Lookup_Color.Exact_Green;  
            Visual_Color.Blue  := Reply.Lookup_Color.Exact_Blue;

            Exact_Color.Red   := Reply.Lookup_Color.Screen_Red;  
            Exact_Color.Green := Reply.Lookup_Color.Screen_Green;  
            Exact_Color.Blue  := Reply.Lookup_Color.Screen_Blue;

----Catch unexpected exceptions.

        exception  
            when others =>  
                Unlock_Display (Display);  
                raise;  
        end;

----Unlock; sync; return.

        Status := Successful;  
        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Lookup_Color;

--\f

    procedure X_Parse_Color (Display   :     X_Display;  
                             Colormap  :     X_Colormap;  
                             Colorname :     X_String;  
                             Color     : out X_Color;  
                             Status    : out X_Status) is  
        J, N    : S_Natural;  
        R, G, B : U_Short;  
        C       : X_Character;  
    begin

        if Colorname'Length = 0 then  
            Color  := None_X_Color;  
            Status := Failed;  
        end if;  
        N := Colorname'Length;  
        if Colorname (Colorname'First) /= '#' then  
            declare  
                Reply : X_Reply_Contents;  
                Succ  : X_Status;  
            begin

----Lock the display.

                Lock_Display (Display);  
                begin

----Send the request.

                    Put_X_Lookup_Color_Request  
                       (Display, (Kind     => Lookup_Color,  
                                  Length   => X_Lookup_Color_Request'Size / 32 +  
                                                 U_Short (N + 3) / 4,  
                                  Pad      => 0,  
                                  Pad1     => 0,  
                                  Pad2     => 0,  
                                  Colormap => Colormap,  
                                  N_Bytes  => U_Short (N)),  
                        S_Natural (N));

----Send the string.

                    Put_X_String (Display, Colorname);

----Read the reply.

                    Get_Reply (Display => Display,  
                               Code    => Lookup_Color,  
                               Reply   => Reply,  
                               Extra   => 0,  
                               Discard => True,  
                               Status  => Succ);  
                    if Succ = Failed then  
                        Color  := None_X_Color;  
                        Status := Failed;  
                        Unlock_Display (Display);  
                        Sync_Handle (Display);  
                        return;  
                    end if;  
                    Color.Red   := Reply.Lookup_Color.Exact_Red;  
                    Color.Green := Reply.Lookup_Color.Exact_Green;  
                    Color.Blue  := Reply.Lookup_Color.Exact_Blue;  
                    Color.Flags := X_Color_Flags'  
                                      (Do_Red | Do_Green | Do_Blue => True,  
                                       others                      => False);

----Catch unexpected exceptions.

                exception  
                    when others =>  
                        Unlock_Display (Display);  
                        raise;  
                end;

----Unlock; sync; return.

                Unlock_Display (Display);  
                Sync_Handle (Display);  
                Status := Successful;  
                return;  
            end;  
        end if;

----Parse the string.

        N := N - 1;  
        if N /= 3 and then  
           N /= 6 and then  
           N /= 9 and then  
           N /= 12 then  
            Status := Failed;  
            return;  
        end if;  
        N := N / 3;  
        R := 0;  
        G := 0;  
        B := 0;  
        loop  
            R := G;  
            G := B;  
            B := 0;  
            J := Colorname'First + 1;  
            for I in reverse 1 .. N loop  
                C := Colorname (J);  
                J := J + 1;  
                B := B * 2 ** 4;  
                if (C >= '0' and then C <= '9') then  
                    B := B + X_Character'Pos (C) - X_Character'Pos ('0');  
                elsif (C >= 'A' and then C <= 'F') then  
                    B := B + X_Character'Pos (C) - (X_Character'Pos ('A') - 10);  
                elsif (C >= 'a' and then C <= 'f') then  
                    B := B + X_Character'Pos (C) - (X_Character'Pos ('a') - 10);  
                else  
                    Status := Failed;  
                    return;  
                end if;  
            end loop;  
            if Colorname (J) = Nul then  
                exit;  
            end if;  
        end loop;  
        N           := N * 2 ** 2;  
        N           := 16 - N;  
        Color.Red   := R * 2 ** Natural (N);  
        Color.Green := G * 2 ** Natural (N);  
        Color.Blue  := B * 2 ** Natural (N);  
        Color.Flags := X_Color_Flags'(Do_Red | Do_Green | Do_Blue => True,  
                                      others                      => False);  
        Status      := Successful;  
        return;

    end X_Parse_Color;

--\f

    procedure X_Query_Color (Display  :        X_Display;  
                             Colormap :        X_Colormap;  
                             Color    : in out X_Color) is  
        New_Color : X_Rgb;  
        Rep       : X_Reply_Contents;  
        Succ      : X_Status;  
    begin

----Lock the display.

        Lock_Display (Display);  
        begin

----Send the request.

            Put_X_Query_Colors_Request  
               (Display,  
                (Kind     => Query_Colors,  
                 Length   => X_Query_Colors_Request'Size / 32 +  
                                U_Short (X_Pixel'Size / 32),  
                 Pad      => 0,  
                 Colormap => Colormap),  
                X_Pixel'Size / 8);  
            Put_X_Pixel (Display, Color.Pixel);


----Get the reply.

            Get_Reply (Display => Display,  
                       Code    => Query_Colors,  
                       Reply   => Rep,  
                       Extra   => 0,  
                       Discard => False,  
                       Status  => Succ);  
            if Succ /= Failed then  
                Get_X_Rgb (Display, New_Color);

                Color.Red   := New_Color.Red;  
                Color.Blue  := New_Color.Blue;  
                Color.Green := New_Color.Green;  
                Color.Flags := X_Color_Flags'  
                                  (Do_Red | Do_Green | Do_Blue => True,  
                                   others                      => False);  
            end if;

----Catch unexpected exceptions.

        exception  
            when others =>  
                Unlock_Display (Display);  
                raise;  
        end;

----Unlock; sync; return.

        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Query_Color;

--\f

    procedure X_Query_Colors (Display  :        X_Display;  
                              Colormap :        X_Colormap;  
                              Colors   : in out X_Color_Array) is  
        Rep      : X_Reply_Contents;  
        N_Colors : S_Natural := Colors'Length;  
        Succ     : X_Status;  
    begin

----Lock the display.

        Lock_Display (Display);  
        begin

----Send the request.

            Put_X_Query_Colors_Request  
               (Display,  
                (Kind     => Query_Colors,  
                 Length   => X_Query_Colors_Request'Size / 32 +  
                                U_Short (N_Colors * X_Pixel'Size / 32),  
                 Pad      => 0,  
                 Colormap => Colormap),  
                N_Colors * X_Pixel'Size / 8);

----Put out the extra data.

            for I in Colors'Range loop  
                Put_X_Pixel (Display, Colors (I).Pixel);  
            end loop;

----Get the reply.

            Get_Reply (Display => Display,  
                       Code    => Query_Colors,  
                       Reply   => Rep,  
                       Extra   => N_Colors * X_Rgb'Size / 8,  
                       Discard => False,  
                       Status  => Succ);  
            if Succ /= Failed then  
                declare  
                    Color : X_Rgb_Array (1 .. N_Colors);  
                begin  
                    Get_X_Rgb_Array (Display, Color);

                    for I in Color'Range loop  
                        Colors (Colors'First - 1 + I).Red   := Color (I).Red;  
                        Colors (Colors'First - 1 + I).Green := Color (I).Green;  
                        Colors (Colors'First - 1 + I).Blue  := Color (I).Blue;  
                        Colors (Colors'First - 1 + I).Flags :=  
                           X_Color_Flags'(Do_Red | Do_Green | Do_Blue => True,  
                                          others                      => False);  
                    end loop;  
                end;  
            end if;

----Catch unexpected exceptions.

        exception  
            when others =>  
                Unlock_Display (Display);  
                raise;  
        end;

----Unlock; sync; return.

        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Query_Colors;

--\f

    procedure X_Set_Window_Colormap (Display  : X_Display;  
                                     Window   : X_Window;  
                                     Colormap : X_Colormap) is
------------------------------------------------------------------------------
-- X_Set_Window_Colormap
------------------------------------------------------------------------------
    begin


----Lock the display.

        Lock_Display (Display);  
        begin

----Put out the request

            Put_X_Change_Window_Attributes_Request  
               (Display,  
                (Kind       => Change_Window_Attributes,  
                 Length     => X_Change_Window_Attributes_Request'Size / 32 + 1,  
                 Pad        => 0,  
                 Window     => Window,  
                 Value_Mask => (Cw_Colormap => True, others => False)),  
                4);  
            Put_X_Id (Display, Colormap.Id);

----Catch unexpected exceptions.

        exception  
            when others =>  
                Unlock_Display (Display);  
                raise;  
        end;

----Unlock; sync; and return.

        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Set_Window_Colormap;

--\f

    procedure X_Store_Color (Display  : X_Display;  
                             Colormap : X_Colormap;  
                             Color    : X_Color) is  
        Citem : X_Color_Item;  
    begin

----Lock the display.

        Lock_Display (Display);  
        begin

----Send the request.

            Put_X_Store_Colors_Request  
               (Display,  
                (Kind     => Store_Colors,  
                 Length   =>  
                    X_Store_Colors_Request'Size / 32 + X_Color_Item'Size / 32,  
                 Pad      => 0,  
                 Colormap => Colormap),  
                4 * S_Natural (X_Color_Item'Size / 32));

----Send the extra data.

            Citem.Pixel := Color.Pixel;  
            Citem.Red   := Color.Red;  
            Citem.Green := Color.Green;  
            Citem.Blue  := Color.Blue;  
            Citem.Flags := Color.Flags; -- do_red, do_green, do_blue
            Put_X_Color_Item (Display, Citem);

----Catch unexpected exceptions.

        exception  
            when others =>  
                Unlock_Display (Display);  
                raise;  
        end;

----Unlock; sync; return.

        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Store_Color;

--\f

    procedure X_Store_Colors (Display  : X_Display;  
                              Colormap : X_Colormap;  
                              Colors   : X_Color_Array) is  
        N_Colors : S_Natural := Colors'Length;  
        Citem    : X_Color_Item;  
    begin

----Lock the display.

        Lock_Display (Display);  
        begin

----Send the request.

            Put_X_Store_Colors_Request  
               (Display,  
                (Kind     => Store_Colors,  
                 Length   => X_Store_Colors_Request'Size / 32 +  
                                U_Short (N_Colors) * X_Color_Item'Size / 32,  
                 Pad      => 0,  
                 Colormap => Colormap),  
                N_Colors * S_Natural (X_Color_Item'Size / 32) * 4);

----Send the extra data.

            for I in Colors'Range loop  
                Citem.Pixel := Colors (I).Pixel;  
                Citem.Red   := Colors (I).Red;  
                Citem.Green := Colors (I).Green;  
                Citem.Blue  := Colors (I).Blue;  
                Citem.Flags := Colors (I).Flags;

                Put_X_Color_Item (Display, Citem);  
            end loop;

----Catch unexpected exceptions.

        exception  
            when others =>  
                Unlock_Display (Display);  
                raise;  
        end;

----Unlock; sync; return.

        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Store_Colors;

--\f

    procedure X_Store_Named_Color (Display  : X_Display;  
                                   Colormap : X_Colormap;  
                                   Name     : X_String;  
                                   Pixel    : X_Pixel;  
                                   Flags    : X_Color_Flags) is  
        N_Bytes : U_Short := Name'Length;  
    begin

----Lock the display.

        Lock_Display (Display);  
        begin

----Send the request.

            Put_X_Store_Named_Color_Request  
               (Display,  
                (Kind     => Store_Named_Color,  
                 Length   =>  
                    X_Store_Named_Color_Request'Size / 32 + (N_Bytes + 3) / 4,  
                 Pad1     => 0,  
                 Pad2     => 0,  
                 Colormap => Colormap,  
                 Flags    => Flags,  
                 Pixel    => Pixel,  
                 N_Bytes  => N_Bytes),  
                S_Natural (N_Bytes));

----Send the name.

            Put_X_String (Display, Name);

----Catch unexpected exceptions.

        exception  
            when others =>  
                Unlock_Display (Display);  
                raise;  
        end;

----Unlock; sync; return.

        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Store_Named_Color;

--\f

    function X_Copy_Colormap_And_Free  
                (Display         : X_Display;  
                 Source_Colormap : X_Colormap) return X_Colormap is  
        Mid : X_Colormap;  
    begin

----Lock the display.

        Lock_Display (Display);  
        begin

----Allocate a new ID and send the request.

            Mid := (Id => Internal_X_Alloc_Id (Display));  
            Put_X_Copy_Colormap_And_Free_Request  
               (Display, (Kind => Copy_Colormap_And_Free,  
                          Length => X_Copy_Colormap_And_Free_Request'Size / 32,  
                          Pad => 0,  
                          Mid => Mid,  
                          Src_Colormap => Source_Colormap));

----Catch unexpected exceptions.

        exception  
            when others =>  
                Unlock_Display (Display);  
                raise;  
        end;

----Unlock; sync; return new colormap.

        Unlock_Display (Display);  
        Sync_Handle (Display);  
        return Mid;

    end X_Copy_Colormap_And_Free;

--\f

    function X_Create_Colormap  
                (Display  : X_Display;  
                 Window   : X_Window;  
                 Visual   : X_Visual;  
                 Allocate : X_Colormap_Alloc) return X_Colormap is  
        Mid : X_Colormap;  
        Vid : X_Visual_Id := Copy_From_Parent_Visual_Id;  
    begin

----Lock the display.

        Lock_Display (Display);  
        begin

----Allocate a new ID and send the request.

            Mid := (Id => Internal_X_Alloc_Id (Display));  
            if Visual /= None_X_Visual then  
                Vid := Visual.Visual_Id;  
            end if;  
            Put_X_Create_Colormap_Request  
               (Display, (Kind   => Create_Colormap,  
                          Length => X_Create_Colormap_Request'Size / 32,  
                          Window => Window,  
                          Mid    => Mid,  
                          Alloc  => Allocate,  
                          Visual => Vid));

----Catch unexpected exceptions.

        exception  
            when others =>  
                Unlock_Display (Display);  
                raise;  
        end;

----Unlock; sync; return new colormap.

        Unlock_Display (Display);  
        Sync_Handle (Display);  
        return Mid;

    end X_Create_Colormap;

--\f

    procedure X_Free_Colormap (Display  :        X_Display;  
                               Colormap : in out X_Colormap) is  
    begin

----Lock the display.

        Lock_Display (Display);  
        begin

----Send the request.

            Put_X_Free_Colormap_Request  
               (Display, (Kind   => Free_Colormap,  
                          Length => X_Free_Colormap_Request'Size / 32,  
                          Pad    => 0,  
                          Id     => Colormap));  
            Colormap := None_X_Colormap;

----Catch unexpected exceptions.

        exception  
            when others =>  
                Unlock_Display (Display);  
                raise;  
        end;

----Unlock; sync; return new colormap.

        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Free_Colormap;

--\f

    procedure X_Install_Colormap (Display  : X_Display;  
                                  Colormap : X_Colormap) is
------------------------------------------------------------------------------
-- X_Install_Colormap
------------------------------------------------------------------------------
    begin

----Lock the display.

        Lock_Display (Display);  
        begin

----Send the request.

            Put_X_Install_Colormap_Request  
               (Display, (Kind   => Install_Colormap,  
                          Length => X_Install_Colormap_Request'Size / 32,  
                          Pad    => 0,  
                          Id     => Colormap));

----Catch unexpected exceptions.

        exception  
            when others =>  
                Unlock_Display (Display);  
                raise;  
        end;

----Unlock the display; sync up; and return.

        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Install_Colormap;

--\f

    function X_List_Installed_Colormaps  
                (Display : X_Display;  
                 Win     : X_Window) return X_Colormap_List is
------------------------------------------------------------------------------
-- X_List_Installed_Colormaps
------------------------------------------------------------------------------
        Rep  : X_Reply_Contents;  
        Succ : X_Status;  
    begin

----Lock the display.

        Lock_Display (Display);  
        begin

----Send the request.

            Put_X_List_Installed_Colormaps_Request  
               (Display,  
                (Kind   => List_Installed_Colormaps,  
                 Length => X_List_Installed_Colormaps_Request'Size / 32,  
                 Pad    => 0,  
                 Id     => Win));

----Read the reply header.

            Get_Reply (Display => Display,  
                       Code    => List_Installed_Colormaps,  
                       Reply   => Rep,  
                       Extra   => 0,  
                       Discard => False,  
                       Status  => Succ);

----If the request failed then equate that with no-colormaps; return null.

            if Succ = Failed then  
                Unlock_Display (Display);  
                Sync_Handle (Display);  
                return None_X_Colormap_List;  
            end if;

----Read in the Colormap array.  Read in the correct number of bytes and then
--  do the unchecked conversion.  Yes, the dynamically created subtype is
--  crucial.

            declare  
                Colormap : X_Colormap_List;  
                Length   : S_Natural :=  
                   S_Natural (Rep.List_Installed_Colormaps.N_Colormaps);  
            begin  
                begin  
                    Colormap := new X_Colormap_Array (1 .. Length);  
                exception  
                    when others =>  
                        Eat_Raw_Data (Display, Length * (X_Colormap'Size / 8));  
                        raise;  
                end;  
                Get_X_Colormap_Array (Display, Colormap.all);  
                Unlock_Display (Display);  
                Sync_Handle (Display);  
                return Colormap;  
            exception  
                when others =>  
                    Free_X_Colormap_List (Colormap);  
                    raise;  
            end;

----Catch unexpected exceptions.

        exception  
            when others =>  
                Unlock_Display (Display);  
                raise;  
        end;

    end X_List_Installed_Colormaps;

--\f

    procedure X_Uninstall_Colormap (Display  : X_Display;  
                                    Colormap : X_Colormap) is
------------------------------------------------------------------------------
-- X_Uninstall_Colormap
------------------------------------------------------------------------------
    begin

----Lock the display.

        Lock_Display (Display);  
        begin

----Send the request.

            Put_X_Uninstall_Colormap_Request  
               (Display, (Kind   => Uninstall_Colormap,  
                          Length => X_Uninstall_Colormap_Request'Size / 32,  
                          Pad    => 0,  
                          Id     => Colormap));

----Catch unexpected exceptions.

        exception  
            when others =>  
                Unlock_Display (Display);  
                raise;  
        end;

----Unlock the display; sync up; and return.

        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Uninstall_Colormap;

--\f

begin

    if X_Rgb'Size rem 32 /= 0 then  
        raise X_Library_Confusion;  
    end if;

end Xlbp_Color;