DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400

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

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦886f1641e⟧ Ada Source

    Length: 131072 (0x20000)
    Types: Ada Source
    Notes: 03_class, FILE, Long Ada Source, R1k_Segment, e3_tag, package body Xlbp_Image, seg_004f6f

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦cfc2e13cd⟧ »Space Info Vol 2« 
        └─⟦this⟧ 

E3 Source Code



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_Image;  
use Xlbt_Image;  
with Xlbt_Image2;  
use Xlbt_Image2;  
with Xlbt_Reply;  
use Xlbt_Reply;  
with Xlbt_Request;  
use Xlbt_Request;  
with Xlbt_String;  
use Xlbt_String;  
with Xlbt_Visual;  
use Xlbt_Visual;

with Xlbp_Gc;  
use Xlbp_Gc;  
with Xlbp_Proc_Var;  
use Xlbp_Proc_Var;

with Xlbip_Get_Reply;  
use Xlbip_Get_Reply;  
with Xlbip_Image_Internal;  
use Xlbip_Image_Internal;  
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_Image is
------------------------------------------------------------------------------
-- X Library Images
--
-- Xlbp_Image - Used to create and manipulate images.
------------------------------------------------------------------------------
-- 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
    ------------------------------------------------------------------------------
-- The following table gives the bit ordering within bytes (when accessed
-- sequentially) for a scanline containing 32 bits, with bits numbered 0 to
-- 31, where bit 0 should be leftmost on the display.  For a given byte
-- labeled A-B, A is for the most significant bit of the byte, and B is
-- for the least significant bit.
--
-- legend:
--     1   scanline-unit = 8
--     2   scanline-unit = 16
--     4   scanline-unit = 32
--     M   byte-order = MostSignificant
--     L   byte-order = LeastSignificant
--     m   bit-order = MostSignificant
--     l   bit-order = LeastSignificant
--
--
-- format  ordering
--
-- 1Mm 00-07 08-15 16-23 24-31
-- 2Mm 00-07 08-15 16-23 24-31
-- 4Mm 00-07 08-15 16-23 24-31
-- 1Ml 07-00 15-08 23-16 31-24
-- 2Ml 15-08 07-00 31-24 23-16
-- 4Ml 31-24 23-16 15-08 07-00
-- 1Lm 00-07 08-15 16-23 24-31
-- 2Lm 08-15 00-07 24-31 16-23
-- 4Lm 24-31 16-23 08-15 00-07
-- 1Ll 07-00 15-08 23-16 31-24
-- 2Ll 07-00 15-08 23-16 31-24
-- 4Ll 07-00 15-08 23-16 31-24
--
--
-- The following table gives the required conversion between any two
-- formats.  It is based strictly on the table above.  If you believe one,
-- you should believe the other.
--
-- legend:
--     n   no changes
--     s   reverse 8-bit units within 16-bit units
--     l   reverse 8-bit units within 32-bit units
--     w   reverse 16-bit units within 32-bit units
--     R   reverse bits within 8-bit units
--     S   s+R
--     L   l+R
--     W   w+R
------------------------------------------------------------------------------

    type Swap_Function_Types is  
       (Do_No_Swap, Do_Swap_Two_Bytes, Do_Swap_Four_Bytes,  
        Do_Swap_Words, Do_Swap_Bits, Do_Swap_Bits_And_Two_Bytes,  
        Do_Swap_Bits_And_Four_Bytes, Do_Swap_Bits_And_Words);

    Ln : constant Swap_Function_Types := Do_No_Swap;  
    Ls : constant Swap_Function_Types := Do_Swap_Two_Bytes;  
    Ll : constant Swap_Function_Types := Do_Swap_Four_Bytes;  
    Lw : constant Swap_Function_Types := Do_Swap_Words;  
    Br : constant Swap_Function_Types := Do_Swap_Bits;  
    Bs : constant Swap_Function_Types := Do_Swap_Bits_And_Two_Bytes;  
    Bl : constant Swap_Function_Types := Do_Swap_Bits_And_Four_Bytes;  
    Bw : constant Swap_Function_Types := Do_Swap_Bits_And_Words;

    type Swap_Function_Array is  
       array (S_Natural range 0 .. 11, S_Natural range 0 .. 11) of  
          Swap_Function_Types;

    Swap_Function : constant Swap_Function_Array :=  
       (
--      1Mm 2Mm 4Mm 1Ml 2Ml 4Ml 1Lm 2Lm 4Lm 1Ll 2Ll 4Ll
        (Ln, Ln, Ln, Br, Bs, Bl, Ln, Ls, Ll, Br, Br, Br), -- 1Mm
        (Ln, Ln, Ln, Br, Bs, Bl, Ln, Ls, Ll, Br, Br, Br), -- 2Mm
        (Ln, Ln, Ln, Br, Bs, Bl, Ln, Ls, Ll, Br, Br, Br), -- 4Mm
        (Br, Br, Br, Ln, Ls, Ll, Br, Bs, Bl, Ln, Ln, Ln), -- 1Ml
        (Bs, Bs, Bs, Ls, Ln, Lw, Bs, Br, Bw, Ls, Ll, Ls), -- 2Ml
        (Bl, Bl, Bl, Ll, Lw, Ln, Bl, Bw, Br, Ll, Ll, Ll), -- 4Ml
        (Ln, Ln, Ln, Br, Bs, Bl, Ln, Ls, Ll, Br, Br, Br), -- 1Lm
        (Ls, Ls, Ls, Bs, Br, Bw, Ls, Ln, Lw, Bs, Bs, Bs), -- 2Lm
        (Ll, Ll, Ll, Bl, Bw, Br, Ll, Lw, Ln, Bl, Bl, Bl), -- 4Lm
        (Br, Br, Br, Ln, Ls, Ll, Br, Bs, Bl, Ln, Ln, Ln), -- 1Ll
        (Br, Br, Br, Ln, Ls, Ll, Br, Bs, Bl, Ln, Ln, Ln), -- 2Ll
        (Br, Br, Br, Ln, Ls, Ll, Br, Bs, Bl, Ln, Ln, Ln)  -- 4Ll
        );

-- -- Of course the table above is a lie.  We also need to factor in the
-- -- order of the source data to cope with swapping half of a unit at the
-- -- end of a scanline, since we are trying to avoid de-ref'ing off the
-- -- end of the source.
-- --
-- -- Defines whether the first half of a unit has the first half of the data
-- --
--
--     type X_Byte_Bit_Order_Array is
--        array (S_Natural range 0 .. 11) of X_Byte_Bit_Order;
--
--     Half_Order : constant X_Byte_Bit_Order_Array :=
--        (Lsb_First,    -- 1Mm
--         Lsb_First,    -- 2Mm
--         Lsb_First,    -- 4Mm
--         Lsb_First,    -- 1Ml
--         Msb_First,    -- 2Ml
--         Msb_First,    -- 4Ml
--         Lsb_First,    -- 1Lm
--         Msb_First,    -- 2Lm
--         Msb_First,    -- 4Lm
--         Lsb_First,    -- 1Ll
--         Lsb_First,    -- 2Ll
--         Lsb_First     -- 4Ll
--         );

    Private_Reverse_Nibs : constant U_Char_Array (0 .. 16#FF#) :=  
       (16#00#, 16#10#, 16#20#, 16#30#, 16#40#, 16#50#, 16#60#, 16#70#,  
        16#80#, 16#90#, 16#A0#, 16#B0#, 16#C0#, 16#D0#, 16#E0#, 16#F0#,  
        16#01#, 16#11#, 16#21#, 16#31#, 16#41#, 16#51#, 16#61#, 16#71#,  
        16#81#, 16#91#, 16#A1#, 16#B1#, 16#C1#, 16#D1#, 16#E1#, 16#F1#,  
        16#02#, 16#12#, 16#22#, 16#32#, 16#42#, 16#52#, 16#62#, 16#72#,  
        16#82#, 16#92#, 16#A2#, 16#B2#, 16#C2#, 16#D2#, 16#E2#, 16#F2#,  
        16#03#, 16#13#, 16#23#, 16#33#, 16#43#, 16#53#, 16#63#, 16#73#,  
        16#83#, 16#93#, 16#A3#, 16#B3#, 16#C3#, 16#D3#, 16#E3#, 16#F3#,  
        16#04#, 16#14#, 16#24#, 16#34#, 16#44#, 16#54#, 16#64#, 16#74#,  
        16#84#, 16#94#, 16#A4#, 16#B4#, 16#C4#, 16#D4#, 16#E4#, 16#F4#,  
        16#05#, 16#15#, 16#25#, 16#35#, 16#45#, 16#55#, 16#65#, 16#75#,  
        16#85#, 16#95#, 16#A5#, 16#B5#, 16#C5#, 16#D5#, 16#E5#, 16#F5#,  
        16#06#, 16#16#, 16#26#, 16#36#, 16#46#, 16#56#, 16#66#, 16#76#,  
        16#86#, 16#96#, 16#A6#, 16#B6#, 16#C6#, 16#D6#, 16#E6#, 16#F6#,  
        16#07#, 16#17#, 16#27#, 16#37#, 16#47#, 16#57#, 16#67#, 16#77#,  
        16#87#, 16#97#, 16#A7#, 16#B7#, 16#C7#, 16#D7#, 16#E7#, 16#F7#,  
        16#08#, 16#18#, 16#28#, 16#38#, 16#48#, 16#58#, 16#68#, 16#78#,  
        16#88#, 16#98#, 16#A8#, 16#B8#, 16#C8#, 16#D8#, 16#E8#, 16#F8#,  
        16#09#, 16#19#, 16#29#, 16#39#, 16#49#, 16#59#, 16#69#, 16#79#,  
        16#89#, 16#99#, 16#A9#, 16#B9#, 16#C9#, 16#D9#, 16#E9#, 16#F9#,  
        16#0A#, 16#1A#, 16#2A#, 16#3A#, 16#4A#, 16#5A#, 16#6A#, 16#7A#,  
        16#8A#, 16#9A#, 16#AA#, 16#BA#, 16#CA#, 16#DA#, 16#EA#, 16#FA#,  
        16#0B#, 16#1B#, 16#2B#, 16#3B#, 16#4B#, 16#5B#, 16#6B#, 16#7B#,  
        16#8B#, 16#9B#, 16#AB#, 16#BB#, 16#CB#, 16#DB#, 16#EB#, 16#FB#,  
        16#0C#, 16#1C#, 16#2C#, 16#3C#, 16#4C#, 16#5C#, 16#6C#, 16#7C#,  
        16#8C#, 16#9C#, 16#AC#, 16#BC#, 16#CC#, 16#DC#, 16#EC#, 16#FC#,  
        16#0D#, 16#1D#, 16#2D#, 16#3D#, 16#4D#, 16#5D#, 16#6D#, 16#7D#,  
        16#8D#, 16#9D#, 16#AD#, 16#BD#, 16#CD#, 16#DD#, 16#ED#, 16#FD#,  
        16#0E#, 16#1E#, 16#2E#, 16#3E#, 16#4E#, 16#5E#, 16#6E#, 16#7E#,  
        16#8E#, 16#9E#, 16#AE#, 16#BE#, 16#CE#, 16#DE#, 16#EE#, 16#FE#,  
        16#0F#, 16#1F#, 16#2F#, 16#3F#, 16#4F#, 16#5F#, 16#6F#, 16#7F#,  
        16#8F#, 16#9F#, 16#AF#, 16#BF#, 16#CF#, 16#DF#, 16#EF#, 16#FF#);


--\x0c
    ------------------------------------------------------------------------------

    function Round_Up (N_Bytes : U_Short;  
                       Pad     : U_Short) return S_Natural is  
    begin  
        return ((S_Natural (N_Bytes) + S_Natural (Pad) - 1) / S_Natural (Pad)) *  
                  S_Natural (Pad);  
    end Round_Up;

------------------------------------------------------------------------------

    function Round_Up (N_Bytes : U_Short;  
                       Pad     : U_Char) return S_Natural is  
    begin  
        return ((S_Natural (N_Bytes) + S_Natural (Pad) - 1) / S_Natural (Pad)) *  
                  S_Natural (Pad);  
    end Round_Up;

------------------------------------------------------------------------------

    function Round_Up (N_Bytes : S_Natural;  
                       Pad     : S_Natural) return S_Natural is  
    begin  
        return ((N_Bytes + Pad - 1) / Pad) * Pad;  
    end Round_Up;

------------------------------------------------------------------------------
--\x0c
    ------------------------------------------------------------------------------

    procedure X_Destroy_Image (Image : in out X_Image) is  
        use Proc_Var_X_Destroy_Image;  
    begin

        if Image /= None_X_Image then  
            Call (To_Pv (Image.F.Destroy_Image), Image);  
        end if;

    end X_Destroy_Image;

------------------------------------------------------------------------------

    function X_Get_Pixel (Image : X_Image;  
                          X     : S_Short;  
                          Y     : S_Short) return X_Pixel is  
        use Proc_Var_X_Get_Pixel;  
    begin

        return Call (To_Pv (Image.F.Get_Pixel), Image, X, Y);

    end X_Get_Pixel;

------------------------------------------------------------------------------

    procedure X_Put_Pixel (Image : X_Image;  
                           X     : S_Short;  
                           Y     : S_Short;  
                           Pixel : X_Pixel) is  
        use Proc_Var_X_Put_Pixel;  
    begin

        Call (To_Pv (Image.F.Put_Pixel), Image, X, Y, Pixel);

    end X_Put_Pixel;

------------------------------------------------------------------------------

    function X_Sub_Image (Image  : X_Image;  
                          X      : S_Short;  
                          Y      : S_Short;  
                          Width  : U_Short;  
                          Height : U_Short) return X_Image is  
        use Proc_Var_X_Sub_Image;  
    begin

        return Call (To_Pv (Image.F.Sub_Image), Image, X, Y, Width, Height);

    end X_Sub_Image;

------------------------------------------------------------------------------

    procedure X_Add_Pixel (Image : X_Image;  
                           Value : X_Pixel) is  
        use Proc_Var_X_Add_Pixel;  
    begin

        Call (To_Pv (Image.F.Add_Pixel), Image, Value);

    end X_Add_Pixel;

--\x0c
    ------------------------------------------------------------------------------

    function Ones (Msk : X_Plane_Mask) return U_Char is -- HACK_MEM 169
        -- geb, god knows what this is doing.
        Z : X_Plane_Mask := Msk;  
        Y : X_Plane_Mask;  
    begin

        -- y := (msk >> 1) & 033333333333;
        Y := Shift (Z, -1) and -8#4444444445#;

        -- y := msk - y - ((y >>1) & 033333333333);
        Y := Z - Y - (Shift (Y, -1) and -8#4444444445#);

        -- return (((y + (y >> 3)) & 030707070707) % 077);
        Y := ((Y + Shift (Y, -3)) and -8#7070707071#) rem 8#77#;  
        return U_Char (Y rem X_Plane_Mask (U_Char'Last + 1));

    end Ones;

--\x0c
    ------------------------------------------------------------------------------
-- These two convenience routines return the scan_line_pad and bits_per_pixel
-- associated with a specific depth of Z_Pixmap format image for a
-- display.

    function Private_X_Get_Scanline_Pad (Display : X_Display;  
                                         Depth   : U_Char) return U_Char is  
    begin

        for I in Display.Pixmap_Format'Range loop  
            if Display.Pixmap_Format (I).Depth = Depth then  
                return Display.Pixmap_Format (I).Scan_Line_Pad;  
            end if;  
        end loop;

        return Display.Bitmap_Pad;

    end Private_X_Get_Scanline_Pad;

--\x0c
    function Private_X_Get_Bits_Per_Pixel (Display : X_Display;  
                                           Depth   : U_Char) return U_Char is  
    begin

        for I in Display.Pixmap_Format'Range loop  
            if Display.Pixmap_Format (I).Depth = Depth then  
                return Display.Pixmap_Format (I).Bits_Per_Pixel;  
            end if;  
        end loop;

        return Depth;

    end Private_X_Get_Bits_Per_Pixel;

--\x0c
    ------------------------------------------------------------------------------
-- Set_Image
--
-- Overwrites a section of one image with all of the data from another.
-- If the two images are not of the same format (i.e. X_Y_Pixmap and Z_Pixmap),
-- the image data is converted to the destination format.  The following
-- restrictions apply:
--
--  1. The depths of the source and destination images must be equal.
--
--  2. If the height of the source image is too large to fit between
--     the specified y starting point and the bottom of the image,
--     then scan_lines are truncated on the bottom.
--
--  3. If the width of the source image is too large to fit between
--     the specified x starting point and the end of the scan_line,
--     then pixels are truncated on the right.
--
-- The images need not have the same bitmap_bit_order, byte_order,
-- bitmap_unit, bits_per_pixel, bitmap_pad, or x_offset.
------------------------------------------------------------------------------

    procedure Private_X_Set_Image (Src_Img : X_Image;  
                                   Dst_Img : X_Image;  
                                   X       : S_Short;  
                                   Y       : S_Short) is  
        Pixel     : X_Pixel;  
        Width     : U_Short;  
        Height    : U_Short;  
        Start_Row : S_Short;  
        Start_Col : S_Short;  
        Xx        : S_Short := X;  
        Yy        : S_Short := Y;  
    begin

        if (Src_Img.Depth /= Dst_Img.Depth) then  
            Private_X_Report_Bad_Image  
               ("depth", U_Char'Image (Dst_Img.Depth), "private_X_Set_Image");  
        end if;
        if Xx < 0 then  
            Start_Col := -Xx;  
            Xx        := 0;  
        else  
            Start_Col := 0;  
        end if;  
        if Yy < 0 then  
            Start_Row := -Y;  
            Yy        := 0;  
        else  
            Start_Row := 0;  
        end if;  
        Width := Dst_Img.Width - U_Short (Xx);  
        if Src_Img.Width < Width then  
            Width := Src_Img.Width;  
        end if;  
        Height := Dst_Img.Height - U_Short (Yy);  
        if Src_Img.Height < Height then  
            Height := Src_Img.Height;  
        end if;

        ----This is slow, will do better later.
        for Row in Start_Row .. S_Short (Height - 1) loop  
            for Col in Start_Col .. S_Short (Width - 1) loop  
                Pixel := X_Get_Pixel (Src_Img, Col, Row);  
                X_Put_Pixel (Dst_Img, Xx + Col, Yy + Row, Pixel);  
            end loop;  
        end loop;

    end Private_X_Set_Image;

--\x0c
    procedure No_Swap (Src     :        U_Char_Array;  
                       Dest    : in out U_Char_Array;  
                       Srclen  :        S_Natural;  
                       Srcinc  :        S_Natural;  
                       Destinc :        S_Natural;  
                       Height  :        S_Natural
                       -- Half_Order :        X_Byte_Bit_Order
                       ) is  
        Bound  : S_Natural;  
        Src_I  : S_Natural := Src'First;  
        Dest_I : S_Natural := Dest'First;  
    begin

        if Srcinc = Destinc then  
            Bound := Srcinc * (Height - 1) + Srclen - 1;  
            Dest (Dest_I .. Dest_I + Bound) := Src (Src_I .. Src_I + Bound);  
        else  
            Bound := Srclen - 1;  
            for H in reverse 0 .. Height - 1 loop  
                Dest (Dest_I .. Dest_I + Bound) := Src (Src_I .. Src_I + Bound);  
                Src_I := Src_I + Srcinc;  
                Dest_I := Dest_I + Destinc;  
            end loop;

        end if;  
    end No_Swap;

--\x0c
    procedure Swap_Two_Bytes (Src     :        U_Char_Array;  
                              Dest    : in out U_Char_Array;  
                              Srclen  :        S_Natural;  
                              Srcinc  :        S_Natural;  
                              Destinc :        S_Natural;  
                              Height  :        S_Natural
                              -- Half_Order :        X_Byte_Bit_Order
                              ) is  
        Src_I  : S_Natural := Src'First;  
        Dest_I : S_Natural := Dest'First;  
        Even   : S_Natural := Srclen / 2;  
        Odd    : S_Natural := Srclen rem 2;  
    begin

        for H in reverse 1 .. Height loop  
            for E in 1 .. Even loop  
                Dest (Dest_I)     := Src (Src_I + 1);  
                Dest (Dest_I + 1) := Src (Src_I);  
                Dest_I            := Dest_I + 2;  
                Src_I             := Src_I + 2;  
            end loop;  
            if Odd = 1 then  
                Dest (Dest_I + 1) := Src (Src_I);  
                Dest_I            := Dest_I + 2;  
                Src_I             := Src_I + Odd;  
            end if;  
        end loop;

--        N      : S_Natural;
--        Length : S_Natural := Round_Up (Srclen, 2);
--        Lsrcinc  : S_Long    := Srcinc - Length;
--        Ldestinc : S_Long    := Destinc - Length;
-- begin
--        for H in reverse 0 .. Height - 1 loop
--             if H = 0 and then Srclen /= Length then
--                 Length := Length - 2;
--                 if Half_Order = Msb_First then
--                     Dest (Dest_I + Length) := Src (Src_I + Length + 1);
--                 else
--                     Dest (Dest_I + Length + 1) := Src (Src_I + Length);
--                 end if;
--             end if;
--             N := Length;
--             while N > 0 loop
--                 Dest (Dest_I)     := Src (Src_I + 1);
--                 Dest (Dest_I + 1) := Src (Src_I);
--                 N                 := N - 2;
--                 Src_I             := Src_I + 2;
--                 Dest_I            := Dest_I + 2;
--             end loop;
--             Src_I  := Src_I + Lsrcinc;
--             Dest_I := Dest_I + Ldestinc;
--         end loop;
--
    end Swap_Two_Bytes;

--\x0c
    procedure Swap_Three_Bytes (Src        :        U_Char_Array;  
                                Dest       : in out U_Char_Array;  
                                Srclen     :        S_Natural;  
                                Srcinc     :        S_Natural;  
                                Destinc    :        S_Natural;  
                                Height     :        S_Natural;  
                                Byte_Order :        X_Byte_Bit_Order) is  
        Src_I  : S_Natural := Src'First;  
        Dest_I : S_Natural := Dest'First;  
        Even   : S_Natural := Srclen / 3;  
        Odd    : S_Natural := Srclen rem 3;  
    begin

        for H in reverse 0 .. Height - 1 loop  
            for E in 1 .. Even loop  
                Dest (Dest_I)     := Src (Src_I + 2);  
                Dest (Dest_I + 1) := Src (Src_I + 1);  
                Dest (Dest_I + 2) := Src (Src_I);  
                Src_I             := Src_I + 3;  
                Dest_I            := Dest_I + 3;  
            end loop;  
            if Odd = 1 then  
                Dest (Dest_I + 2) := Src (Src_I);  
                Dest_I            := Dest_I + 3;  
                Src_I             := Src_I + Odd;  
            elsif Odd = 2 then  
                Dest (Dest_I + 2) := Src (Src_I);  
                Dest (Dest_I + 1) := Src (Src_I + 1);  
                Dest_I            := Dest_I + 3;  
                Src_I             := Src_I + Odd;  
            end if;  
        end loop;

--        N      : S_Natural;
--        Length : S_Natural := ((Srclen + 2) / 3) * 3;
--        Lsrcinc  : S_Long    := Srcinc - Length;
--         Ldestinc : S_Long    := Destinc - Length;
--     begin
--
--         for H in reverse 0 .. Height - 1 loop
--             if H = 0 and then Srclen /= Length then
--                 Length := Length - 3;
--                 if Srclen - Length = 2 then
--                     Dest (Dest_I + Length + 1) := Src (Src_I + Length + 1);
--                 end if;
--                 if Byte_Order = Msb_First then
--                     Dest (Dest_I + Length) := Src (Src_I + Length + 2);
--                 else
--                     Dest (Dest_I + Length + 2) := Src (Src_I + Length);
--                 end if;
--             end if;
--             N := Length;
--             while N > 0 loop
--                 Dest (Dest_I)     := Src (Src_I + 2);
--                 Dest (Dest_I + 1) := Src (Src_I + 1);
--                 Dest (Dest_I + 2) := Src (Src_I);
--                 N                 := N - 3;
--                 Src_I             := Src_I + 3;
--                 Dest_I            := Dest_I + 3;
--             end loop;
--             Src_I  := Src_I + Lsrcinc;
--             Dest_I := Dest_I + Ldestinc;
--         end loop;

    end Swap_Three_Bytes;

--\x0c
    procedure Swap_Four_Bytes (Src     :        U_Char_Array;  
                               Dest    : in out U_Char_Array;  
                               Srclen  :        S_Natural;  
                               Srcinc  :        S_Natural;  
                               Destinc :        S_Natural;  
                               Height  :        S_Natural
                               -- Half_Order :        X_Byte_Bit_Order
                               ) is  
        Src_I  : S_Natural := Src'First;  
        Dest_I : S_Natural := Dest'First;  
        Even   : S_Natural := Srclen / 4;  
        Odd    : S_Natural := Srclen rem 4;  
    begin

        for H in reverse 0 .. Height - 1 loop  
            for E in 1 .. Even loop  
                Dest (Dest_I)     := Src (Src_I + 3);  
                Dest (Dest_I + 1) := Src (Src_I + 2);  
                Dest (Dest_I + 2) := Src (Src_I + 1);  
                Dest (Dest_I + 3) := Src (Src_I);  
                Src_I             := Src_I + 4;  
                Dest_I            := Dest_I + 4;  
            end loop;  
            if Odd = 1 then  
                Dest (Dest_I + 3) := Src (Src_I);  
                Dest_I            := Dest_I + 4;  
                Src_I             := Src_I + Odd;  
            elsif Odd = 2 then  
                Dest (Dest_I + 3) := Src (Src_I);  
                Dest (Dest_I + 2) := Src (Src_I + 1);  
                Dest_I            := Dest_I + 4;  
                Src_I             := Src_I + Odd;  
            elsif Odd = 3 then  
                Dest (Dest_I + 3) := Src (Src_I);  
                Dest (Dest_I + 2) := Src (Src_I + 1);  
                Dest (Dest_I + 1) := Src (Src_I + 2);  
                Dest_I            := Dest_I + 4;  
                Src_I             := Src_I + Odd;  
            end if;  
        end loop;

--        N      : S_Natural;
--        Length : S_Natural := Round_Up (Srclen, 4);
--        Lsrcinc  : S_Long    := Srcinc - Length;
--         Ldestinc : S_Long    := Destinc - Length;
--     begin
--
--         for H in reverse 0 .. Height - 1 loop
--             if H = 0 and Srclen /= Length then
--                 Length := Length - 4;
--                 if Half_Order = Msb_First then
--                     Dest (Dest_I + Length) := Src (Src_I + Length + 3);
--                 end if;
--                 if (Half_Order = Lsb_First and then Srclen - Length = 3) or else
--                    (Half_Order = Msb_First and then Srclen rem 4 / 2 = 1) then
--                     Dest (Dest_I + Length + 1) := Src (Src_I + Length + 2);
--                 end if;
--                 if (Half_Order = Msb_First and then Srclen - Length = 3) or else
--                    (Half_Order = Lsb_First and then Srclen rem 4 / 2 = 1) then
--                     Dest (Dest_I + Length + 2) := Src (Src_I + Length + 1);
--                 end if;
--                 if Half_Order = Lsb_First then
--                     Dest (Dest_I + Length + 3) := Src (Src_I + Length);
--                 end if;
--             end if;
--             N := Length;
--             while N > 0 loop
--                 Dest (Dest_I)     := Src (Src_I + 3);
--                 Dest (Dest_I + 1) := Src (Src_I + 2);
--                 Dest (Dest_I + 2) := Src (Src_I + 1);
--                 Dest (Dest_I + 3) := Src (Src_I);
--                 N                 := N - 4;
--                 Src_I             := Src_I + 4;
--                 Dest_I            := Dest_I + 4;
--             end loop;
--             Src_I  := Src_I + Lsrcinc;
--             Dest_I := Dest_I + Ldestinc;
--         end loop;

    end Swap_Four_Bytes;

--\x0c
    procedure Swap_Words (Src     :        U_Char_Array;  
                          Dest    : in out U_Char_Array;  
                          Srclen  :        S_Natural;  
                          Srcinc  :        S_Natural;  
                          Destinc :        S_Natural;  
                          Height  :        S_Natural
                          --Half_Order :        X_Byte_Bit_Order
                          ) is  
        Src_I  : S_Natural := Src'First;  
        Dest_I : S_Natural := Dest'First;  
        Even   : S_Natural := Srclen / 4;  
        Odd    : S_Natural := Srclen rem 4;  
    begin

        for H in reverse 0 .. Height - 1 loop  
            for E in 1 .. Even loop  
                Dest (Dest_I)     := Src (Src_I + 2);  
                Dest (Dest_I + 1) := Src (Src_I + 3);  
                Dest (Dest_I + 2) := Src (Src_I);  
                Dest (Dest_I + 3) := Src (Src_I + 1);  
                Src_I             := Src_I + 4;  
                Dest_I            := Dest_I + 4;  
            end loop;  
            if Odd = 1 then  
                Dest (Dest_I + 2) := Src (Src_I);  
                Dest_I            := Dest_I + 4;  
                Src_I             := Src_I + Odd;  
            elsif Odd = 2 then  
                Dest (Dest_I + 2) := Src (Src_I);  
                Dest (Dest_I + 3) := Src (Src_I + 1);  
                Dest_I            := Dest_I + 4;  
                Src_I             := Src_I + Odd;  
            elsif Odd = 3 then  
                Dest (Dest_I + 2) := Src (Src_I);  
                Dest (Dest_I + 3) := Src (Src_I + 1);  
                Dest (Dest_I)     := Src (Src_I + 2);  
                Dest_I            := Dest_I + 4;  
                Src_I             := Src_I + Odd;  
            end if;  
        end loop;

--        Length   : S_Natural := Round_Up (Srclen, 4);
--         N        : S_Natural;
--         Lsrcinc  : S_Long    := Srcinc - Length;
--         Ldestinc : S_Long    := Destinc - Length;
--     begin
--
--         for H in reverse 0 .. Height - 1 loop
--             if H = 0 and Srclen /= Length then
--                 Length := Length - 4;
--                 if Half_Order = Msb_First then
--                     Dest (Dest_I + Length + 1) := Src (Src_I + Length + 3);
--                 end if;
--                 if (Half_Order = Lsb_First and then Srclen - Length = 3) or else
--                    (Half_Order = Msb_First and then Srclen rem 4 / 2 = 1) then
--                     Dest (Dest_I + Length) := Src (Src_I + Length + 2);
--                 end if;
--                 if (Half_Order = Msb_First and then Srclen - Length = 3) or else
--                    (Half_Order = Lsb_First and then Srclen rem 4 / 2 = 1) then
--                     Dest (Dest_I + Length + 3) := Src (Src_I + Length + 1);
--                 end if;
--                 if Half_Order = Lsb_First then
--                     Dest (Dest_I + Length + 2) := Src (Src_I + Length);
--                 end if;
--             end if;
--             N := Length;
--             while N > 0 loop
--                 Dest (Dest_I)     := Src (Src_I + 2);
--                 Dest (Dest_I + 1) := Src (Src_I + 3);
--                 Dest (Dest_I + 2) := Src (Src_I);
--                 Dest (Dest_I + 3) := Src (Src_I + 1);
--                 N                 := N - 4;
--                 Src_I             := Src_I + 4;
--                 Dest_I            := Dest_I + 4;
--             end loop;
--             Src_I  := Src_I + Lsrcinc;
--             Dest_I := Dest_I + Ldestinc;
--         end loop;
--
    end Swap_Words;

--\x0c
    procedure Swap_Nibbles (Src     :        U_Char_Array;  
                            Dest    : in out U_Char_Array;  
                            Srclen  :        S_Natural;  
                            Srcinc  :        S_Natural;  
                            Destinc :        S_Natural;  
                            Height  :        S_Natural) is  
        Src_I  : S_Natural := Src'First;  
        Dest_I : S_Natural := Dest'First;  
   begin

        for H in reverse 0 .. Height - 1 loop  
            for N in reverse 0 .. Srclen - 1 loop  
                Dest (Dest_I + N) := Private_Reverse_Nibs  
                                        (S_Natural (Src (Src_I + N)));  
            end loop;  
            Src_I  := Src_I + Srcinc + Srclen;  
            Dest_I := Dest_I + Destinc + Srclen;  
        end loop;

    end Swap_Nibbles;

--\x0c
    procedure Shift_Nibbles_Left (Src     :        U_Char_Array;  
                                  Dest    : in out U_Char_Array;  
                                  Srclen  :        S_Natural;  
                                  Srcinc  :        S_Natural;  
                                  Destinc :        S_Natural;  
                                  Height  :        S_Natural) is  
        Src_I    : S_Natural := Src'First;  
        Dest_I   : S_Natural := Dest'First;  
        Lsrcinc  : S_Long    := Srcinc - Srclen;  
        Ldestinc : S_Long    := Destinc - Srclen;  
        C1       : U_Char;  
        C2       : U_Char;  
    begin

        for H in 1 .. Height loop  
            for N in 1 .. Srclen loop  
                C1            := Src (Src_I);  
                Src_I         := Src_I + 1;  
                C2            := Src (Src_I);  
                Dest (Dest_I) := U_Char  
                                    (((S_Natural (C1) rem 2 ** 4) * 2 ** 4) +  
                                     (S_Natural (C2) / 2 ** 4));  
                Dest_I        := Dest_I + 1;  
            end loop;  
            Src_I  := Src_I + Lsrcinc;  
            Dest_I := Dest_I + Ldestinc;  
        end loop;

    end Shift_Nibbles_Left;

--\x0c
    procedure Swap_Bits (Src     :        U_Char_Array;  
                         Dest    : in out U_Char_Array;  
                         Srclen  :        S_Natural;  
                         Srcinc  :        S_Natural;  
                         Destinc :        S_Natural;  
                         Height  :        S_Natural
                         -- Half_Order :        X_Byte_Bit_Order
                         ) is  
        Src_I    : S_Natural := Src'First;  
        Dest_I   : S_Natural := Dest'First;  
        Lsrcinc  : S_Long    := Srcinc - Srclen;  
        Ldestinc : S_Long    := Destinc - Srclen;  
    begin

        for H in reverse 0 .. Height - 1 loop  
            for N in reverse S_Natural range 0 .. Srclen - 1 loop  
                Dest (Dest_I) := Private_Reverse_Byte (S_Natural (Src (Src_I)));  
                Src_I         := Src_I + 1;  
                Dest_I        := Dest_I + 1;  
            end loop;  
            Src_I  := Src_I + Lsrcinc;  
            Dest_I := Dest_I + Ldestinc;  
        end loop;

    end Swap_Bits;

--\x0c
    procedure Swap_Bits_And_Two_Bytes (Src     :        U_Char_Array;  
                                       Dest    : in out U_Char_Array;  
                                       Srclen  :        S_Natural;  
                                       Srcinc  :        S_Natural;  
                                       Destinc :        S_Natural;  
                                       Height  :        S_Natural
                                       -- Half_Order :        X_Byte_Bit_Order
                                       ) is  
        Src_I  : S_Natural := Src'First;  
        Dest_I : S_Natural := Dest'First;  
        Even   : S_Natural := Srclen / 2;  
        Odd    : S_Natural := Srclen rem 2;  
    begin

        for H in reverse 1 .. Height loop  
            for E in 1 .. Even loop  
                Dest (Dest_I)     := Private_Reverse_Byte  
                                        (S_Natural (Src (Src_I + 1)));  
                Dest (Dest_I + 1) := Private_Reverse_Byte  
                                        (S_Natural (Src (Src_I)));  
                Dest_I            := Dest_I + 2;  
                Src_I             := Src_I + 2;  
            end loop;  
            if Odd = 1 then  
                Dest (Dest_I + 1) := Private_Reverse_Byte  
                                        (S_Natural (Src (Src_I)));  
                Dest_I            := Dest_I + 2;  
                Src_I             := Src_I + Odd;  
            end if;  
        end loop;

--        Length   : S_Natural := Round_Up (Srclen, 2);
--         N        : S_Natural;
--         Lsrcinc  : S_Long    := Srcinc - Length;
--         Ldestinc : S_Long    := Destinc - Length;
--     begin
--
--         for H in reverse 0 .. Height - 1 loop
--             if H = 0 and Srclen /= Length then
--                 Length := Length - 2;
--                 if Half_Order = Msb_First then
--                     Dest (Dest_I + Length) :=
--                        Private_Reverse_Byte
--                           (S_Natural (Src (Src_I + Length + 1)));
--                 else
--                     Dest (Dest_I + Length + 1) :=
--                        Private_Reverse_Byte
--                           (S_Natural (Src (Src_I + Length)));
--                 end if;
--             end if;
--             N := Length;
--             while N > 0 loop
--                 Dest (Dest_I)     := Private_Reverse_Byte
--                                         (S_Natural (Src (Src_I + 1)));
--                 Dest (Dest_I + 1) := Private_Reverse_Byte
--                                         (S_Natural (Src (Src_I)));
--                 N                 := N - 2;
--                 Src_I             := Src_I + 2;
--                 Dest_I            := Dest_I + 2;
--             end loop;
--             Src_I  := Src_I + Lsrcinc;
--             Dest_I := Dest_I + Ldestinc;
--         end loop;

    end Swap_Bits_And_Two_Bytes;

--\x0c
    procedure Swap_Bits_And_Four_Bytes (Src     :        U_Char_Array;  
                                        Dest    : in out U_Char_Array;  
                                        Srclen  :        S_Natural;  
                                        Srcinc  :        S_Natural;  
                                        Destinc :        S_Natural;  
                                        Height  :        S_Natural
                                        -- Half_Order :        X_Byte_Bit_Order
                                        ) is  
        Src_I  : S_Natural := Src'First;  
        Dest_I : S_Natural := Dest'First;  
        Even   : S_Natural := Srclen / 4;  
        Odd    : S_Natural := Srclen rem 4;  
    begin

        for H in reverse 0 .. Height - 1 loop  
            for E in 1 .. Even loop  
                Dest (Dest_I)     := Private_Reverse_Byte  
                                        (S_Natural (Src (Src_I + 3)));  
                Dest (Dest_I + 1) := Private_Reverse_Byte  
                                        (S_Natural (Src (Src_I + 2)));  
                Dest (Dest_I + 2) := Private_Reverse_Byte  
                                        (S_Natural (Src (Src_I + 1)));  
                Dest (Dest_I + 3) := Private_Reverse_Byte  
                                        (S_Natural (Src (Src_I)));  
                Src_I             := Src_I + 4;  
                Dest_I            := Dest_I + 4;  
            end loop;  
            if Odd = 1 then  
                Dest (Dest_I + 3) := Private_Reverse_Byte  
                                        (S_Natural (Src (Src_I)));  
                Dest_I            := Dest_I + 4;  
                Src_I             := Src_I + Odd;  
            elsif Odd = 2 then  
                Dest (Dest_I + 3) := Private_Reverse_Byte  
                                        (S_Natural (Src (Src_I)));  
                Dest (Dest_I + 2) := Private_Reverse_Byte  
                                        (S_Natural (Src (Src_I + 1)));  
                Dest_I            := Dest_I + 4;  
                Src_I             := Src_I + Odd;  
            elsif Odd = 3 then  
                Dest (Dest_I + 3) := Private_Reverse_Byte  
                                        (S_Natural (Src (Src_I)));  
                Dest (Dest_I + 2) := Private_Reverse_Byte  
                                        (S_Natural (Src (Src_I + 1)));  
                Dest (Dest_I + 1) := Private_Reverse_Byte  
                                        (S_Natural (Src (Src_I + 2)));  
                Dest_I            := Dest_I + 4;  
                Src_I             := Src_I + Odd;  
            end if;  
        end loop;

--        Length : S_Natural := Round_Up (Srclen, 4);
--         N      : S_Natural;
--     begin
--
--         for H in reverse 0 .. Height - 1 loop
--             if H = 0 and Srclen /= Length then
--                 Length := Length - 4;
--                 if Half_Order = Msb_First then
--                     Dest (Dest_I + Length) :=
--                        Private_Reverse_Byte (S_Natural
--                                                 (Src (Src_I + Length + 3)));
--                 end if;
--                 if (Half_Order = Lsb_First and then Srclen - Length = 3) or else
--                    (Half_Order = Msb_First and then Srclen rem 4 / 2 = 1) then
--                     Dest (Dest_I + Length + 1) :=
--                        Private_Reverse_Byte (S_Natural
--                                                 (Src (Src_I + Length + 2)));
--                 end if;
--                 if (Half_Order = Msb_First and then Srclen - Length = 3) or else
--                    (Half_Order = Lsb_First and then Srclen rem 4 / 2 = 1) then
--                     Dest (Dest_I + Length + 2) :=
--                        Private_Reverse_Byte (S_Natural
--                                                 (Src (Src_I + Length + 1)));
--                 end if;
--                 if Half_Order = Lsb_First then
--                     Dest (Dest_I + Length + 3) :=
--                        Private_Reverse_Byte (S_Natural (Src (Src_I + Length)));
--                 end if;
--             end if;
--             N := Length;
--             while N > 0 loop-                 Dest (Dest_I)     := Private_Reverse_Byte
--                                         (S_Natural (Src (Src_I + 3)));
--                 Dest (Dest_I + 1) := Private_Reverse_Byte
--                                         (S_Natural (Src (Src_I + 2)));
--                 Dest (Dest_I + 2) := Private_Reverse_Byte
--                                         (S_Natural (Src (Src_I + 1)));
--                 Dest (Dest_I + 3) := Private_Reverse_Byte
--                                         (S_Natural (Src (Src_I)));
--                 N                 := N - 4;
--                 Src_I             := Src_I + 4;
--                 Dest_I            := Dest_I + 4;
--             end loop;
--             Src_I  := Src_I + Srcinc;
--             Dest_I := Dest_I + Destinc;
--         end loop;
--
    end Swap_Bits_And_Four_Bytes;

--\x0c
    procedure Swap_Bits_And_Words (Src     :        U_Char_Array;  
                                   Dest    : in out U_Char_Array;  
                                   Srclen  :        S_Natural;  
                                   Srcinc  :        S_Natural;  
                                   Destinc :        S_Natural;  
                                   Height  :        S_Natural
                                   -- Half_Order :        X_Byte_Bit_Order
                                   ) is  
        Src_I  : S_Natural := Src'First;  
        Dest_I : S_Natural := Dest'First;  
        Even   : S_Natural := Srclen / 4;  
        Odd    : S_Natural := Srclen rem 4;  
    begin

        for H in reverse 0 .. Height - 1 loop  
            for E in 1 .. Even loop  
                Dest (Dest_I)     := Private_Reverse_Byte  
                                        (S_Natural (Src (Src_I + 2)));  
                Dest (Dest_I + 1) := Private_Reverse_Byte  
                                        (S_Natural (Src (Src_I + 3)));  
                Dest (Dest_I + 2) := Private_Reverse_Byte  
                                        (S_Natural (Src (Src_I)));  
                Dest (Dest_I + 3) := Private_Reverse_Byte  
                                        (S_Natural (Src (Src_I + 1)));  
                Src_I             := Src_I + 4;  
                Dest_I            := Dest_I + 4;  
            end loop;  
            if Odd = 1 then  
                Dest (Dest_I + 2) := Private_Reverse_Byte  
                                        (S_Natural (Src (Src_I)));  
                Dest_I            := Dest_I + 4;  
                Src_I             := Src_I + Odd;  
            elsif Odd = 2 then  
                Dest (Dest_I + 2) := Private_Reverse_Byte  
                                        (S_Natural (Src (Src_I)));  
                Dest (Dest_I + 3) := Private_Reverse_Byte  
                                        (S_Natural (Src (Src_I + 1)));  
                Dest_I            := Dest_I + 4;  
                Src_I             := Src_I + Odd;  
            elsif Odd = 3 then  
                Dest (Dest_I + 2) := Private_Reverse_Byte  
                                        (S_Natural (Src (Src_I)));  
                Dest (Dest_I + 3) := Private_Reverse_Byte  
                                        (S_Natural (Src (Src_I + 1)));  
                Dest (Dest_I)     := Private_Reverse_Byte  
                                        (S_Natural (Src (Src_I + 2)));  
                Dest_I            := Dest_I + 4;  
                Src_I             := Src_I + Odd;  
            end if;  
        end loop;

--        Length   : S_Natural := Round_Up (Srclen, 4);
--         N        : S_Natural;
--         Lsrcinc  : S_Long    := Srcinc - Length;
--         Ldestinc : S_Long    := Destinc - Length;
--     begin
--
--         for H in reverse 0 .. Height - 1 loop
--             if H = 0 and Srclen /= Length then
--                 Length := Length - 4;
--                 if Half_Order = Msb_First then
--                     Dest (Dest_I + Length + 1) :=
--                        Private_Reverse_Byte (S_Natural
--                                                 (Src (Src_I + Length + 3)));
--                 end if;
--                 if (Half_Order = Lsb_First and then Srclen - Length = 3) or else
--                    (Half_Order = Msb_First and then Srclen rem 4 / 2 = 1) then
--                     Dest (Dest_I + Length) :=
--                        Private_Reverse_Byte (S_Natural
--                                                 (Src (Src_I + Length + 2)));
--                 end if;
--                 if (Half_Order = Msb_First and then Srclen - Length = 3) or else
--                    (Half_Order = Msb_First and then Srclen rem 4 / 2 = 1) then
--                     Dest (Dest_I + Length + 3) :=
--                        Private_Reverse_Byte (S_Natural
--                                                 (Src (Src_I + Length + 1)));
--                 end if;
--                 if Half_Order = Lsb_First then
--                     Dest (Dest_I + Length + 2) :=
--                        Private_Reverse_Byte (S_Natural (Src (Src_I + Length)));
--                 end if;
--             end if;
--             N := Length;
--             while N > 0 loop
--                 Dest (Dest_I)     := Private_Reverse_Byte
--                                         (S_Natural (Src (Src_I + 2)));
--                 Dest (Dest_I + 1) := Private_Reverse_Byte
--                                         (S_Natural (Src (Src_I + 3)));
--                 Dest (Dest_I + 2) := Private_Reverse_Byte
--                                         (S_Natural (Src (Src_I)));
--                 Dest (Dest_I + 3) := Private_Reverse_Byte
--                                         (S_Natural (Src (Src_I + 1)));
--                 N                 := N - 4;
--                 Src_I             := Src_I + 4;
--                 Dest_I            := Dest_I + 4;
--             end loop;
--             Src_I  := Src_I + Lsrcinc;
--             Dest_I := Dest_I + Ldestinc;
--         end loop;

    end Swap_Bits_And_Words;

--\x0c
-- This macro creates a value from 0 to 11 suitable for indexing
-- into the Swap_Functions table above.

    function Compose_Index (Bitmap_Unit : U_Char;  
                            Bitmap_Bit_Order : X_Byte_Bit_Order;  
                            Byte_Order : X_Byte_Bit_Order) return S_Natural is  
        Ret : S_Natural;  
    begin

        if Bitmap_Unit = 32 then  
            Ret := 2;  
        elsif Bitmap_Unit = 16 then  
            Ret := 1;  
        else  
            Ret := 0;  
        end if;  
        if Bitmap_Bit_Order = Msb_First then  
            Ret := Ret + 0;  
        else  
            Ret := Ret + 3;  
        end if;  
        if Byte_Order = Msb_First then  
            Ret := Ret + 0;  
        else  
            Ret := Ret + 6;  
        end if;  
        return Ret;

    end Compose_Index;

--\x0c
    procedure Do_Swap_Func (Func    :        Swap_Function_Types;  
                            Src     :        U_Char_Array;  
                            Dest    : in out U_Char_Array;  
                            Srclen  :        S_Natural;  
                            Srcinc  :        S_Natural;  
                            Destinc :        S_Natural;  
                            Height  :        S_Natural
                            -- Half_Order :        X_Byte_Bit_Order
                            ) is  
    begin

        case Func is  
            when Do_No_Swap =>  
                No_Swap (Src, Dest, Srclen, Srcinc,  
                         Destinc, Height); --, Half_Order);
            when Do_Swap_Two_Bytes =>  
                Swap_Two_Bytes (Src, Dest, Srclen, Srcinc,  
                                Destinc, Height); --, Half_Order);
            when Do_Swap_Four_Bytes =>  
                Swap_Four_Bytes (Src, Dest, Srclen, Srcinc,  
                                 Destinc, Height); --, Half_Order);
            when Do_Swap_Words =>  
                Swap_Words (Src, Dest, Srclen, Srcinc,  
                            Destinc, Height); --, Half_Order);
            when Do_Swap_Bits =>  
                Swap_Bits (Src, Dest, Srclen, Srcinc,  
                           Destinc, Height); --, Half_Order);
            when Do_Swap_Bits_And_Two_Bytes =>  
                Swap_Bits_And_Two_Bytes (Src, Dest, Srclen, Srcinc,  
                                         Destinc, Height); --, Half_Order);
            when Do_Swap_Bits_And_Four_Bytes =>  
                Swap_Bits_And_Four_Bytes (Src, Dest, Srclen, Srcinc,  
                                          Destinc, Height); --, Half_Order);
            when Do_Swap_Bits_And_Words =>  
                Swap_Bits_And_Words (Src, Dest, Srclen, Srcinc,  
                                     Destinc, Height); --, Half_Order);
        end case;

    end Do_Swap_Func;

--\x0c
    procedure Send_X_Y_Image (Display     :        X_Display;  
                              Req         : in out X_Put_Image_Request;  
                              Image       :        X_Image;  
                              Req_Xoffset :        U_Short;  
                              Req_Yoffset :        U_Short) is  
        Total_Xoffset        : U_Short;  
        Bytes_Per_Src        : S_Natural;  
        Bytes_Per_Dest       : S_Natural;  
        Length               : S_Natural;  
        Bytes_Per_Line       : S_Natural;  
        Bytes_Per_Src_Plane  : S_Natural;  
        Bytes_Per_Dest_Plane : S_Natural;  
        Bytes_Per_Temp_Plane : S_Natural;  
        Temp_Length          : S_Natural;  
        Src                  : S_Natural;  
        Dest                 : S_Natural;  
        Swapfunc             : Swap_Function_Types;
--        H_Order              : X_Byte_Bit_Order;
    begin

        Total_Xoffset := U_Short (Image.X_Offset + S_Short (Req_Xoffset));  
        Req.Left_Pad  := U_Char (S_Long (Total_Xoffset) and  
                                 S_Long (Display.Bitmap_Unit - 1));  
        Total_Xoffset := (Total_Xoffset - U_Short (Req.Left_Pad)) / 2 ** 3;
        -- The protocol requires left-pad of zero on all ZPixmap, even
        -- though the 1-bit case is identical to bitmap format.  This is a
        -- bug in the protocol, caused because 1-bit ZPixmap was added late
        -- in the game.  Hairy shifting code compensation isn't worth it,
        -- just use XYPixmap format instead.
        if Req.Left_Pad /= 0 and Req.Format = Z_Pixmap then  
            Req.Format := X_Y_Pixmap;  
        end if;  
        Bytes_Per_Dest       :=  
           Round_Up (Req.Width + U_Short (Req.Left_Pad), Display.Bitmap_Pad) /  
              8;  
        Bytes_Per_Dest_Plane := Bytes_Per_Dest * S_Natural (Req.Height);  
        Length               := Bytes_Per_Dest_Plane * S_Natural (Image.Depth);  
        Req.Length           := Req.Length + U_Short (Length + 3) / 4;

        Swapfunc := Swap_Function (Compose_Index (Image.Bitmap_Unit,  
                                                  Image.Bitmap_Bit_Order,  
                                                  Image.Byte_Order),  
                                   Compose_Index (Display.Bitmap_Unit,  
                                                  Display.Bitmap_Bit_Order,  
                                                  Display.Byte_Order));

--        H_Order := Half_Order (Compose_Index (Image.Bitmap_Unit,
--                                              Image.Bitmap_Bit_Order,
--                                              Image.Byte_Order));

        Src := Image.Data'First +  
                  S_Natural (Image.Bytes_Per_Line * Req_Yoffset +  
                             Total_Xoffset);

        -- when total_xoffset > 0, we have to worry about stepping off the
        -- end of image.data.
        --/
        if Swapfunc = Do_No_Swap and then  
           S_Natural (Image.Bytes_Per_Line) = Bytes_Per_Dest and then  
           ((Total_Xoffset = 0 and then (Image.Depth = 1 or else  
                                         Image.Height = Req.Height)) or else  
            (Image.Depth = 1 and then  
             Req_Yoffset + Req.Height < Image.Height)) then  
            Put_X_Put_Image_Request (Display, Req, Length);  
            Put_U_Char_Array (Display, Image.Data (Src .. Src - 1 + Length));  
            return;  
        end if;

        declare  
            Buf : U_Char_Array (1 .. Length);  
        begin  
            Length := Round_Up (Length, 4);  
            Bytes_Per_Src := S_Natural  
                                (Req.Width + U_Short (Req.Left_Pad) + 7) / 8;  
            Bytes_Per_Line := S_Natural (Image.Bytes_Per_Line);  
            Bytes_Per_Src_Plane := Bytes_Per_Line * S_Natural (Image.Height);  
            Total_Xoffset := U_Short (S_Long (Total_Xoffset) and  
                                      S_Long ((Image.Bitmap_Unit - 1) / 8));

            if Total_Xoffset > 0 and then  
               Image.Byte_Order /= Image.Bitmap_Bit_Order then  
                Bytes_Per_Line := Bytes_Per_Src + S_Natural (Total_Xoffset);  
                Src := Src - S_Natural (Total_Xoffset);  
                Bytes_Per_Temp_Plane := Bytes_Per_Line * S_Natural (Req.Height);  
                Temp_Length := Round_Up (Bytes_Per_Temp_Plane *  
                                         S_Natural (Image.Depth), 4);  
                declare  
                    Temp : U_Char_Array (1 .. Temp_Length);  
                begin  
                    Swapfunc := Swap_Function  
                                   (Compose_Index (Image.Bitmap_Unit,  
                                                   Image.Bitmap_Bit_Order,  
                                                   Image.Byte_Order),  
                                    Compose_Index (Image.Bitmap_Unit,  
                                                   Display.Byte_Order,  
                                                   Display.Byte_Order));  
                    Dest     := Temp'First;  
                    for J in reverse 0 .. Image.Depth - 1 loop  
                        Do_Swap_Func (Swapfunc,  
                                      Image.Data (Src .. Image.Data'Last),  
                                      Temp (Dest .. Temp'Last),  
                                      Bytes_Per_Line,  
                                      S_Natural (Image.Bytes_Per_Line),  
                                      Bytes_Per_Line,  
                                      S_Natural (Req.Height)); --, H_Order);
                        Src  := Src + Bytes_Per_Src_Plane;  
                        Dest := Dest + Bytes_Per_Temp_Plane;  
                    end loop;  
                    Swapfunc := Swap_Function  
                                   (Compose_Index (Image.Bitmap_Unit,  
                                                   Display.Byte_Order,  
                                                   Display.Byte_Order),  
                                    Compose_Index (Display.Bitmap_Unit,  
                                                   Display.Bitmap_Bit_Order,  
                                                   Display.Byte_Order));
--                    H_Order := Half_Order (Compose_Index (Image.Bitmap_Unit,
--                                                          Display.Byte_Order,
--                                                          Display.Byte_Order));
                    Src := Temp'First + S_Natural (Total_Xoffset);  
                    Bytes_Per_Src_Plane := Bytes_Per_Temp_Plane;  
                    Dest := Buf'First;  
                    for J in reverse 0 .. Image.Depth - 1 loop  
                        Do_Swap_Func (Swapfunc,  
                                      Temp (Src .. Image.Data'Last),  
                                      Buf (Dest .. Buf'Last),  
                                      S_Natural (Bytes_Per_Src),  
                                      S_Natural (Bytes_Per_Line),  
                                      S_Natural (Bytes_Per_Dest),  
                                      S_Natural (Req.Height));--, H_Order);
                        Src  := Src + Bytes_Per_Src_Plane;  
                        Dest := Dest + Bytes_Per_Dest_Plane;  
                    end loop;  
                end;

            else  
                Dest := Buf'First;  
                for J in reverse 0 .. Image.Depth - 1 loop  
                    Do_Swap_Func (Swapfunc,  
                                  Image.Data (Src .. Image.Data'Last),  
                                  Buf (Dest .. Buf'Last),  
                                  S_Natural (Bytes_Per_Src),  
                                  S_Natural (Bytes_Per_Line),  
                                  S_Natural (Bytes_Per_Dest),  
                                  S_Natural (Req.Height));--, H_Order);
                    Src  := Src + Bytes_Per_Src_Plane;  
                    Dest := Dest + Bytes_Per_Dest_Plane;  
                end loop;  
            end if;  
            Put_X_Put_Image_Request (Display, Req, Length);  
            Put_U_Char_Array (Display,  
                              Buf (Buf'First .. Buf'First - 1 + Length));  
        end;

    end Send_X_Y_Image;

--\x0c
    -- XXX assumes image->bits_per_pixel == dest_bits_per_pixel

    procedure Send_Z_Image (Display             :        X_Display;  
                            Req                 : in out X_Put_Image_Request;  
                            Image               :        X_Image;  
                            Req_Xoffset         :        U_Short;  
                            Req_Yoffset         :        U_Short;  
                            Dest_Bits_Per_Pixel :        U_Char;  
                            Dest_Scanline_Pad   :        U_Char) is  
        Bytes_Pr_Src  : S_Natural;  
        Bytes_Per_Dest : S_Natural;  
        Length         : S_Natural;  
        Shifted_Src    : U_Char_List := Image.Data;  
        Src            : S_Natural;  
        Dest           : S_Natural;  
    begin

        Req.Left_Pad   := 0;  
        Bytes_Per_Src  :=  
           Round_Up (Req.Width * U_Short (Image.Bits_Per_Pixel), U_Short (8)) /  
              8;  
        Bytes_Per_Dest :=  
           Round_Up  
              (Req.Width * U_Short (Dest_Bits_Per_Pixel), Dest_Scanline_Pad) /  
           8;  
        Length         := Bytes_Per_Dest * S_Natural (Req.Height);  
        Req.Length     := Req.Length + U_Short (Length + 3) / 4;

        Src := Image.Data'First +  
                  S_Natural (Req_Yoffset * Image.Bytes_Per_Line +  
                             Req_Xoffset * U_Short (Image.Bits_Per_Pixel) / 8);

        if (Image.Bits_Per_Pixel = 4 and then  
            Req_Xoffset mod 2 = 1) then  
            Shifted_Src :=  
               new U_Char_Array  
                      (0 .. S_Natural (Req.Height * Image.Bytes_Per_Line));  
            Shift_Nibbles_Left (Image.Data (Src .. Src - 1 + Length),  
                                Shifted_Src.all, Bytes_Per_Src,  
                                S_Natural (Image.Bytes_Per_Line),  
                                S_Natural (Image.Bytes_Per_Line),  
                                S_Natural (Req.Height));  
            Src := Src - Image.Data'First;  
        end if;

        -- when req_xoffset > 0, we have to worry about stepping off the
        -- end of image.data.

        if ((Image.Byte_Order = Display.Byte_Order or else  
             Image.Bits_Per_Pixel = 8) and then  
            S_Natural (Image.Bytes_Per_Line) = Bytes_Per_Dest and then  
            (Req_Xoffset = 0 or else  
             Req_Yoffset + Req.Height < Image.Height)) then  
            Put_X_Put_Image_Request (Display, Req, Length);  
            Put_U_Char_Array (Display, Shifted_Src (Src .. Src - 1 + Length));  
            if Shifted_Src /= Image.Data then  
                Free_U_Char_List (Shifted_Src);  
            end if;  
            return;  
        end if;

        Length := Round_Up (Length, 4);  
        declare  
            Temp : U_Char_Array (1 .. Length);  
        begin  
            Dest := Temp'First;

            if Image.Byte_Order = Display.Byte_Order or else  
               Image.Bits_Per_Pixel = 8 then  
                No_Swap (Shifted_Src (Src .. Shifted_Src'Last),  
                         Temp, Bytes_Per_Src,  
                         S_Natural (Image.Bytes_Per_Line), Bytes_Per_Dest,  
                         S_Natural (Req.Height)); --, Image.Byte_Order);
            elsif Image.Bits_Per_Pixel = 32 then  
                Swap_Four_Bytes (Shifted_Src (Src .. Shifted_Src'Last),  
                                 Temp, Bytes_Per_Src,  
                                 S_Natural (Image.Bytes_Per_Line),  
                                 Bytes_Per_Dest, S_Natural (Req.Height)); --,
                -- Image.Byte_Order);
            elsif Image.Bits_Per_Pixel = 24 then  
                Swap_Three_Bytes (Shifted_Src (Src .. Shifted_Src'Last),  
                                  Temp, Bytes_Per_Src,  
                                  S_Natural (Image.Bytes_Per_Line),  
                                  Bytes_Per_Dest, S_Natural (Req.Height),  
                                  Image.Byte_Order);  
            elsif Image.Bits_Per_Pixel = 16 then  
                Swap_Two_Bytes (Shifted_Src (Src .. Shifted_Src'Last), Temp,  
                                Bytes_Per_Src, S_Natural (Image.Bytes_Per_Line),  
                                Bytes_Per_Dest, S_Natural (Req.Height));--,
                --Image.Byte_Order);
            else  
                Swap_Nibbles (Shifted_Src (Src .. Shifted_Src'Last), Temp,  
                              Bytes_Per_Src, S_Natural (Image.Bytes_Per_Line),  
                              Bytes_Per_Dest, S_Natural (Req.Height));  
            end if;  
            Put_X_Put_Image_Request (Display, Req, Length);  
            Put_U_Char_Array (Display,  
                              Temp (Temp'First .. Temp'First - 1 + Length));  
        end;  
        if Shifted_Src /= Image.Data then  
            Free_U_Char_List (Shifted_Src);  
        end if;

    end Send_Z_Image;

--\x0c
    procedure Put_Image_Request  
                 (Display             : X_Display;  
                  D                   : X_Drawable;  
                  Gc                  : X_Gc;  
                  Image               : X_Image;  
                  Req_Xoffset         : U_Short;  
                  Req_Yoffset         : U_Short;  
                  X                   : S_Short;  
                  Y                   : S_Short;  
                  Req_Width           : U_Short;  
                  Req_Height          : U_Short;  
                  Dest_Bits_Per_Pixel : U_Char;  
                  Dest_Scan_Line_Pad  : U_Char) is  
        Req : X_Put_Image_Request;  
    begin

----Begin preparing the request.

        Req := (Kind     => Put_Image,  
                Length   => X_Put_Image_Request'Size / 32,  
                Pad      => 0,  
                Left_Pad => 0,  
                Drawable => D,  
                Gc       => Gc.Gid,  
                Dst_X    => X,  
                Dst_Y    => Y,  
                Width    => Req_Width,  
                Height   => Req_Height,  
                Format   => Image.Format,  
                Depth    => Image.Depth);

----Send the request the correct way.

        if Image.Depth = 1 or else Image.Format /= Z_Pixmap then  
            Send_X_Y_Image (Display, Req, Image, Req_Xoffset, Req_Yoffset);  
        else  
            Send_Z_Image (Display, Req, Image, Req_Xoffset, Req_Yoffset,  
                          Dest_Bits_Per_Pixel, Dest_Scan_Line_Pad);  
        end if;

    end Put_Image_Request;

--\x0c
    procedure Put_Sub_Image  
                 (Display             : X_Display;  
                  D                   : X_Drawable;  
                  Gc                  : X_Gc;  
                  Image               : X_Image;  
                  Req_Xoffset         : U_Short;  
                  Req_Yoffset         : U_Short;  
                  X                   : S_Short;  
                  Y                   : S_Short;  
                  Req_Width           : U_Short;  
                  Req_Height          : U_Short;  
                  Dest_Bits_Per_Pixel : U_Char;  
                  Dest_Scanline_Pad   : U_Char) is  
        Left_Pad      : S_Natural;  
        Bytes_Per_Row : S_Natural;  
        Available     : S_Natural;  
    begin

        if Req_Width = 0 or else Req_Height = 0 then  
            return;  
        end if;

        if 65536 < Display.Max_Request_Size then  
            Available := 65536 / 4;  
        else  
            Available := S_Natural (Display.Max_Request_Size / 4);  
        end if;  
        Available := Available - S_Natural (X_Put_Image_Request'Size / 32);

        if Image.Depth = 1 or else Image.Format /= Z_Pixmap then  
            Left_Pad := S_Natural  
                           (S_Long (Image.X_Offset + S_Short (Req_Xoffset)) and  
                            S_Long (Display.Bitmap_Unit - 1));  
            Bytes_Per_Row := (Round_Up (S_Natural (Req_Width) + Left_Pad,  
                                        S_Natural (Display.Bitmap_Pad)) / 8) *  
                             S_Natural (Image.Depth);  
        else  
            Left_Pad      := 0;  
            Bytes_Per_Row := Round_Up  
                                (Req_Width * U_Short (Dest_Bits_Per_Pixel),  
                                 Dest_Scanline_Pad) / 8;  
        end if;
       if Bytes_Per_Row * S_Natural (Req_Height) <= Available then  
            Put_Image_Request (Display, D, Gc, Image, Req_Xoffset,  
                               Req_Yoffset, X, Y, Req_Width, Req_Height,  
                               Dest_Bits_Per_Pixel, Dest_Scanline_Pad);  
        elsif Req_Height > 1 then  
            declare  
                Sub_Image_Height : U_Short :=  
                   U_Short (Available / Bytes_Per_Row);  
            begin

                if Sub_Image_Height = 0 then  
                    Sub_Image_Height := 1;  
                end if;

                Put_Sub_Image (Display, D, Gc, Image, Req_Xoffset,  
                               Req_Yoffset, X, Y, Req_Width, Sub_Image_Height,  
                               Dest_Bits_Per_Pixel, Dest_Scanline_Pad);

                Put_Sub_Image (Display, D, Gc, Image, Req_Xoffset,  
                               Req_Yoffset + Sub_Image_Height, X,  
                               Y + S_Short (Sub_Image_Height),  
                               Req_Width, Req_Height - Sub_Image_Height,  
                               Dest_Bits_Per_Pixel, Dest_Scanline_Pad);  
            end;  
        else  
            declare  
                Sub_Image_Width : U_Short :=  
                   U_Short (((Available * 8) / S_Natural (Dest_Scanline_Pad)) *  
                            S_Natural (Dest_Scanline_Pad) - Left_Pad);  
            begin

                Put_Sub_Image (Display, D, Gc, Image, Req_Xoffset,  
                               Req_Yoffset, X, Y, Sub_Image_Width, 1,  
                               Dest_Bits_Per_Pixel, Dest_Scanline_Pad);

                Put_Sub_Image (Display, D, Gc, Image,  
                               Req_Xoffset + Sub_Image_Width, Req_Yoffset,  
                               X + S_Short (Sub_Image_Width), Y,  
                               Req_Width - Sub_Image_Width, 1,  
                               Dest_Bits_Per_Pixel, Dest_Scanline_Pad);  
            end;  
        end if;

    end Put_Sub_Image;

--\x0c
    function X_Create_Image (Display              : X_Display;  
                             Visual               : X_Visual;  
                             Depth                : U_Char;  
                             Format               : X_Image_Format;  
                             Offset               : U_Short;  
                             Data                 : U_Char_Array;  
                             Width                : U_Short;  
                             Height               : U_Short;  
                             Bitmap_Pad           : U_Char;  
                             Image_Bytes_Per_Line : U_Short) return X_Image is  
        Datap : U_Char_List := new U_Char_Array (1 .. Data'Length);  
    begin

        Datap.all := Data;  
        return X_Create_Image (Display              => Display,  
                               Visual               => Visual,  
                               Depth                => Depth,  
                               Format               => Format,  
                               Offset               => Offset,  
                               Data                 => Datap,  
                               Data_Is_Shared       => False,  
                               Width                => Width,  
                               Height               => Height,  
                               Bitmap_Pad           => Bitmap_Pad,  
                               Image_Bytes_Per_Line => Image_Bytes_Per_Line);

    exception  
        when others =>  
            Free_U_Char_List (Datap);  
            raise;  
    end X_Create_Image;

--\x0c
    ------------------------------------------------------------------------------
-- Create_Image
--
-- Allocates the memory necessary for an X_Image data structure.
-- Initializes the structure with "default" values and returns X_Image.
------------------------------------------------------------------------------

    function X_Create_Image (Display              : X_Display;  
                             Visual               : X_Visual;  
                             Depth                : U_Char;  
                             Format               : X_Image_Format;  
                             Offset               : U_Short;  
                             Data                 : U_Char_List;  
                             Data_Is_Shared       : Boolean;  
                             Width                : U_Short;  
                             Height               : U_Short;  
                             Bitmap_Pad           : U_Char;  
                             Image_Bytes_Per_Line : U_Short) return X_Image is  
        Image          : X_Image;  
        Imagei         : X_Image;  
        Bits_Per_Pixel : U_Char := 1;  
    begin

        Imagei                  := new X_Image_Rec;  
        Image                   := Imagei;  
        Imagei.Width            := Width;  
        Imagei.Height           := Height;  
        Imagei.Format           := Format;  
        Imagei.Byte_Order       := Display.Byte_Order;  
        Imagei.Bitmap_Unit      := Display.Bitmap_Unit;  
        Imagei.Bitmap_Bit_Order := Display.Bitmap_Bit_Order;  
        if Visual /= None_X_Visual then  
            Imagei.Red_Mask   := Visual.Red_Mask;  
            Imagei.Green_Mask := Visual.Green_Mask;  
            Imagei.Blue_Mask  := Visual.Blue_Mask;  
        else  
            Imagei.Red_Mask   := None_X_Color_Mask;  
            Imagei.Green_Mask := None_X_Color_Mask;  
            Imagei.Blue_Mask  := None_X_Color_Mask;  
        end if;  
        if Format = Z_Pixmap then  
            Bits_Per_Pixel := Private_X_Get_Bits_Per_Pixel (Display, Depth);  
        end if;

        Imagei.X_Offset       := S_Short (Offset);  
        Imagei.Bitmap_Pad     := Bitmap_Pad;  
        Imagei.Depth          := Depth;  
        Imagei.Data           := Data;  
        Imagei.Data_Is_Shared := Data_Is_Shared;
        --
        -- compute per line accelerator.
        --
        if Image_Bytes_Per_Line = 0 then  
            if Format = Z_Pixmap then  
                Imagei.Bytes_Per_Line :=  
                   U_Short  
                      (Round_Up (S_Natural (Bits_Per_Pixel) * S_Natural (Width),  
                                 S_Natural (Imagei.Bitmap_Pad)) /  
                       8);  
            else  
                Imagei.Bytes_Per_Line :=  
                   U_Short (Round_Up (Width + Offset, Imagei.Bitmap_Pad) / 8);  
            end if;  
        else  
            Imagei.Bytes_Per_Line := Image_Bytes_Per_Line;  
        end if;

        Imagei.Bits_Per_Pixel := Bits_Per_Pixel;  
        Imagei.Obdata         := null;  
        Private_X_Init_Image_Func_Ptrs (Image);

        return Image;

    exception

        when others =>  
            if Imagei /= None_X_Image then  
                Imagei.Data := None_U_Char_List;    -- Not ours to free.
                Free_X_Image (Imagei);  
            end if;  
            raise;

    end X_Create_Image;


--\x0c
    function X_Get_Image (Display    : X_Display;  
                          Drawable   : X_Drawable;  
                          X          : S_Short;  
                          Y          : S_Short;  
                          Width      : U_Short;  
                          Height     : U_Short;  
                          Plane_Mask : X_Plane_Mask;  
                          Format     : X_Image_Format) return X_Image is  
        Rep   : X_Reply_Contents;  
        Image : X_Image;  
        Succ  : X_Status;  
    begin

----Lock the display.

        Lock_Display (Display);  
        begin

----Send the request.

            Put_X_Get_Image_Request  
               (Display, (Kind       => Get_Image,  
                          Length     => X_Get_Image_Request'Size / 32,  
                          Drawable   => Drawable,  
                          X          => X,  
                          Y          => Y,  
                          Width      => Width,  
                          Height     => Height,  
                          Plane_Mask => Plane_Mask,  
                          Format     => Format));

----Get the reply header.

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

----If we failed then return null.

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

----Read the data that came with the reply.

            declare  
                Data : U_Char_List;  
                Vis  : X_Visual;  
                Void : X_Status;  
            begin  
                begin  
                    Data := new U_Char_Array  
                                   (1 .. S_Natural (Rep.Get_Image.Length) * 4);  
                exception  
                    when others =>  
                        Eat_Raw_Data  
                           (Display,  
                            S_Natural (Rep.Get_Image.Length) * (32 / 8));  
                        raise;  
                end;  
                Get_U_Char_Array (Display, Data.all);  
                Internal_X_Vid_To_Visual  
                   (Display, Rep.Get_Image.Visual, Vis, Void);  
                if (Format = X_Y_Pixmap) then  
                    Image :=  
                       X_Create_Image  
                          (Display              => Display,  
                           Visual               => Vis,  
                           Depth                =>                              Ones (Plane_Mask and  
                                    (Shift (1, Integer (Rep.Get_Image.Depth)) -  
                                     1)),  
                           Format               => Format,  
                           Offset               => 0,  
                           Data                 => Data,  
                           Data_Is_Shared       => False,  
                           Width                => Width,  
                           Height               => Height,  
                           Bitmap_Pad           => Display.Bitmap_Pad,  
                           Image_Bytes_Per_Line => 0);  
                else -- format = Z_Pixmap
                    Image :=  
                       X_Create_Image  
                          (Display              => Display,  
                           Visual               => Vis,  
                           Depth                => Rep.Get_Image.Depth,  
                           Format               => Z_Pixmap,  
                           Offset               => 0,  
                           Data                 => Data,  
                           Data_Is_Shared       => False,  
                           Width                => Width,  
                           Height               => Height,  
                           Bitmap_Pad           =>  
                              Private_X_Get_Scanline_Pad  
                                 (Display, Rep.Get_Image.Depth),  
                           Image_Bytes_Per_Line => 0);  
                end if;  
            exception  
                when others =>  
                    Free_U_Char_List (Data);  
                    raise;  
            end;

----Catch exceptions.

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

----Unlock; sync; and return the image.

        Unlock_Display (Display);  
        Sync_Handle (Display);  
        return Image;

    end X_Get_Image;

--\x0c
    procedure X_Get_Sub_Image (Display    : X_Display;  
                               Drawable   : X_Drawable;  
                               X          : S_Short;  
                               Y          : S_Short;  
                               Width      : U_Short;  
                               Height     : U_Short;  
                               Plane_Mask : X_Plane_Mask;  
                               Format     : X_Image_Format;  
                               Image      : X_Image;  
                               Image_X    : S_Short;  
                               Image_Y    : S_Short) is  
        Temp_Image : X_Image;  
    begin

        Temp_Image := X_Get_Image (Display, Drawable, X, Y, Width,  
                                   Height, Plane_Mask, Format);  
        if Temp_Image /= None_X_Image then  
            Private_X_Set_Image (Temp_Image, Image, Image_X, Image_Y);  
            Free_X_Image (Temp_Image);  
        end if;

    end X_Get_Sub_Image;

--\x0c
    procedure X_Put_Image (Display  : X_Display;  
                           Drawable : X_Drawable;  
                           Gc       : X_Gc;  
                           Image    : X_Image;  
                           Image_X  : U_Short;  
                           Image_Y  : U_Short;  
                           X        : S_Short;  
                           Y        : S_Short;  
                           Width    : U_Short;  
                           Height   : U_Short) is  
        Lwidth              : S_Short := S_Short (Width);  
        Lheight             : S_Short := S_Short (Height);  
        Limage_X            : S_Short := S_Short (Image_X);  
        Limage_Y            : S_Short := S_Short (Image_Y);  
        Dest_Bits_Per_Pixel : U_Char;  
        Dest_Scanline_Pad   : U_Char;  
    begin

        if Limage_X < 0 then             Lwidth   := Lwidth + Limage_X;  
            Limage_X := 0;  
        end if;  
        if Limage_Y < 0 then  
            Lheight  := Lheight + Limage_Y;  
            Limage_Y := 0;  
        end if;

        if Limage_X + Lwidth > S_Short (Image.Width) then  
            Lwidth := S_Short (Image.Width) - Limage_X;  
        end if;  
        if Limage_Y + Lheight > S_Short (Image.Height) then  
            Lheight := S_Short (Image.Height) - Limage_Y;  
        end if;  
        if Lwidth <= 0 or else Lheight <= 0 then  
            return;  
        end if;

        if Image.Depth = 1 or else Image.Format /= Z_Pixmap then  
            Dest_Bits_Per_Pixel := 1;  
            Dest_Scanline_Pad   := Display.Bitmap_Pad;  
        else  
            declare  
                Format : X_Screen_Format_List;  
            begin

                Dest_Bits_Per_Pixel := Image.Bits_Per_Pixel;  
                Dest_Scanline_Pad   := Image.Bitmap_Pad;  
                Format              := Display.Pixmap_Format;  
                for N in Format'Range loop  
                    if Format (N).Depth = Image.Depth then  
                        Dest_Bits_Per_Pixel := Format (N).Bits_Per_Pixel;  
                        Dest_Scanline_Pad   := Format (N).Scan_Line_Pad;  
                    end if;  
                end loop;  
                if Dest_Bits_Per_Pixel /= Image.Bits_Per_Pixel then  
                    declare  
                        Img : X_Image := new X_Image_Rec;  
                    begin
                        -- XXX slow, but works
                        Img.Width          := U_Short (Lwidth);  
                        Img.Height         := U_Short (Lheight);  
                        Img.X_Offset       := 0;  
                        Img.Format         := Z_Pixmap;  
                        Img.Byte_Order     := Display.Byte_Order;  
                        Img.Bitmap_Pad     := Dest_Scanline_Pad;  
                        Img.Depth          := Image.Depth;  
                        Img.Bits_Per_Pixel := Dest_Bits_Per_Pixel;  
                        Img.Bytes_Per_Line :=  
                           U_Short (Round_Up (U_Short (Dest_Bits_Per_Pixel) *  
                                              U_Short (Lwidth),  
                                              Dest_Scanline_Pad) / 8);  
                        Img.Data           :=  
                           new U_Char_Array  
                                  (0 .. S_Natural  
                                           (S_Short (Img.Bytes_Per_Line) *  
                                            Lheight - 1));  
                        Private_X_Init_Image_Func_Ptrs (Img);  
                        for J in reverse S_Short range 0 .. Lheight - 1 loop  
                            for I in reverse S_Short range 0 .. Lwidth - 1 loop  
                                X_Put_Pixel (Img, I, J,  
                                             X_Get_Pixel (Image, Limage_X + I,  
                                                          Limage_Y + J));  
                            end loop;  
                        end loop;  
                        Lock_Display (Display);  
                        Private_X_Flush_Gc (Display, Gc);  
                        Put_Sub_Image (Display, Drawable, Gc, Img, 0, 0, X, Y,  
                                       U_Short (Lwidth), U_Short (Lheight),  
                                       Dest_Bits_Per_Pixel, Dest_Scanline_Pad);  
                        Unlock_Display (Display);  
                        Sync_Handle (Display);  
                        Free_U_Char_List (Img.Data);  
                        return;  
                    exception  
                        when others =>  
                            Free_X_Image (Img);  
                            raise;  
                    end;  
                end if;  
            end;  
        end if;

        Lock_Display (Display);  
        begin  
            Private_X_Flush_Gc (Display, Gc);

            Put_Sub_Image (Display, Drawable, Gc, Image, Image_X, Image_Y,  
                           X, Y, U_Short (Lwidth), U_Short (Lheight),  
                           Dest_Bits_Per_Pixel, Dest_Scanline_Pad);

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

    end X_Put_Image;

--\x0c
end Xlbp_Image;  

E3 Meta Data

    nblk1=7f
    nid=7f
    hdr6=fc
        [0x00] rec0=2d rec1=00 rec2=01 rec3=030
        [0x01] rec0=11 rec1=00 rec2=02 rec3=060
        [0x02] rec0=14 rec1=00 rec2=03 rec3=012
        [0x03] rec0=1f rec1=00 rec2=04 rec3=03c
        [0x04] rec0=16 rec1=00 rec2=05 rec3=006
        [0x05] rec0=13 rec1=00 rec2=06 rec3=04e
        [0x06] rec0=1b rec1=00 rec2=07 rec3=04a
        [0x07] rec0=0d rec1=00 rec2=08 rec3=084
        [0x08] rec0=0e rec1=00 rec2=09 rec3=026
        [0x09] rec0=16 rec1=00 rec2=0a rec3=096
        [0x0a] rec0=1e rec1=00 rec2=0b rec3=038
        [0x0b] rec0=1f rec1=00 rec2=0c rec3=01c
        [0x0c] rec0=1f rec1=00 rec2=0d rec3=038
        [0x0d] rec0=1c rec1=00 rec2=0e rec3=004
        [0x0e] rec0=1b rec1=00 rec2=0f rec3=068
        [0x0f] rec0=17 rec1=00 rec2=10 rec3=098
        [0x10] rec0=02 rec1=00 rec2=7e rec3=000
        [0x11] rec0=1e rec1=00 rec2=11 rec3=02e
        [0x12] rec0=02 rec1=00 rec2=7d rec3=006
        [0x13] rec0=16 rec1=00 rec2=12 rec3=040
        [0x14] rec0=00 rec1=00 rec2=7c rec3=004
        [0x15] rec0=19 rec1=00 rec2=13 rec3=058
        [0x16] rec0=01 rec1=00 rec2=7b rec3=018
        [0x17] rec0=19 rec1=00 rec2=14 rec3=00a
        [0x18] rec0=00 rec1=00 rec2=7a rec3=046
        [0x19] rec0=16 rec1=00 rec2=15 rec3=03e
        [0x1a] rec0=00 rec1=00 rec2=79 rec3=006
        [0x1b] rec0=19 rec1=00 rec2=16 rec3=032
        [0x1c] rec0=01 rec1=00 rec2=78 rec3=056
        [0x1d] rec0=16 rec1=00 rec2=17 rec3=064
        [0x1e] rec0=19 rec1=00 rec2=18 rec3=04a
        [0x1f] rec0=01 rec1=00 rec2=77 rec3=00a
        [0x20] rec0=14 rec1=00 rec2=19 rec3=016
        [0x21] rec0=01 rec1=00 rec2=76 rec3=066
        [0x22] rec0=15 rec1=00 rec2=1a rec3=0a2
        [0x23] rec0=19 rec1=00 rec2=1b rec3=040
        [0x24] rec0=16 rec1=00 rec2=1c rec3=010
        [0x25] rec0=01 rec1=00 rec2=75 rec3=012
        [0x26] rec0=17 rec1=00 rec2=1d rec3=03c
        [0x27] rec0=01 rec1=00 rec2=74 rec3=062
        [0x28] rec0=13 rec1=00 rec2=1e rec3=012
        [0x29] rec0=17 rec1=00 rec2=1f rec3=004
        [0x2a] rec0=00 rec1=00 rec2=73 rec3=002
        [0x2b] rec0=17 rec1=00 rec2=20 rec3=032
        [0x2c] rec0=00 rec1=00 rec2=72 rec3=01a
        [0x2d] rec0=1a rec1=00 rec2=21 rec3=054
        [0x2e] rec0=01 rec1=00 rec2=71 rec3=046
        [0x2f] rec0=18 rec1=00 rec2=22 rec3=07e
        [0x30] rec0=01 rec1=00 rec2=70 rec3=028
        [0x31] rec0=14 rec1=00 rec2=23 rec3=016
        [0x32] rec0=01 rec1=00 rec2=6f rec3=020
        [0x33] rec0=17 rec1=00 rec2=24 rec3=032
        [0x34] rec0=00 rec1=00 rec2=6e rec3=02e
        [0x35] rec0=17 rec1=00 rec2=25 rec3=052
        [0x36] rec0=13 rec1=00 rec2=26 rec3=01a
        [0x37] rec0=00 rec1=00 rec2=6d rec3=01c
        [0x38] rec0=12 rec1=00 rec2=27 rec3=076
        [0x39] rec0=01 rec1=00 rec2=6c rec3=088
        [0x3a] rec0=16 rec1=00 rec2=28 rec3=078
        [0x3b] rec0=00 rec1=00 rec2=6b rec3=02e
        [0x3c] rec0=13 rec1=00 rec2=29 rec3=002
        [0x3d] rec0=14 rec1=00 rec2=2a rec3=068
        [0x3e] rec0=13 rec1=00 rec2=2b rec3=062
        [0x3f] rec0=01 rec1=00 rec2=6a rec3=002
        [0x40] rec0=11 rec1=00 rec2=2c rec3=062
        [0x41] rec0=02 rec1=00 rec2=69 rec3=03a
        [0x42] rec0=16 rec1=00 rec2=2d rec3=014
        [0x43] rec0=00 rec1=00 rec2=68 rec3=03e
        [0x44] rec0=10 rec1=00 rec2=2e rec3=05e
        [0x45] rec0=13 rec1=00 rec2=2f rec3=036
        [0x46] rec0=25 rec1=00 rec2=30 rec3=032
        [0x47] rec0=14 rec1=00 rec2=31 rec3=038
        [0x48] rec0=15 rec1=00 rec2=32 rec3=008
        [0x49] rec0=14 rec1=00 rec2=33 rec3=074
        [0x4a] rec0=02 rec1=00 rec2=67 rec3=018
        [0x4b] rec0=11 rec1=00 rec2=34 rec3=032
        [0x4c] rec0=00 rec1=00 rec2=66 rec3=03c
        [0x4d] rec0=13 rec1=00 rec2=35 rec3=08e
        [0x4e] rec0=15 rec1=00 rec2=36 rec3=010
        [0x4f] rec0=0f rec1=00 rec2=37 rec3=090
        [0x50] rec0=10 rec1=00 rec2=38 rec3=08a
        [0x51] rec0=00 rec1=00 rec2=65 rec3=006
        [0x52] rec0=0f rec1=00 rec2=39 rec3=02a
        [0x53] rec0=12 rec1=00 rec2=3a rec3=074
        [0x54] rec0=00 rec1=00 rec2=64 rec3=002
        [0x55] rec0=16 rec1=00 rec2=3b rec3=01e
        [0x56] rec0=00 rec1=00 rec2=63 rec3=002
        [0x57] rec0=19 rec1=00 rec2=3c rec3=016
        [0x58] rec0=01 rec1=00 rec2=62 rec3=038
        [0x59] rec0=13 rec1=00 rec2=3d rec3=062
        [0x5a] rec0=16 rec1=00 rec2=3e rec3=088
        [0x5b] rec0=10 rec1=00 rec2=3f rec3=082
        [0x5c] rec0=18 rec1=00 rec2=40 rec3=040
        [0x5d] rec0=1b rec1=00 rec2=41 rec3=014
        [0x5e] rec0=1a rec1=00 rec2=42 rec3=018
        [0x5f] rec0=01 rec1=00 rec2=61 rec3=000
        [0x60] rec0=16 rec1=00 rec2=43 rec3=002
        [0x61] rec0=00 rec1=00 rec2=60 rec3=00a
        [0x62] rec0=14 rec1=00 rec2=44 rec3=046
        [0x63] rec0=13 rec1=00 rec2=45 rec3=058
    tail 0x217006d40819782b0717a 0x42a00088462063203
Free Block Chain:
  0x7f: 0000  00 00 0b 00 23 05 41 60 04 70 d4 26 00 90 11 00  ┆    # A` p &    ┆