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

⟦708490252⟧ TextFile

    Length: 47632 (0xba10)
    Types: TextFile
    Names: »B«

Derivation

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

TextFile

with Unchecked_Deallocation;

with Xlbt_Arithmetic;  
use Xlbt_Arithmetic;  
with Xlbt_Extension;  
use Xlbt_Extension;  
with Xlbt_Gc2;  
use Xlbt_Gc2;  
with Xlbt_Graphics;  
use Xlbt_Graphics;  
with Xlbt_Proc_Var;  
use Xlbt_Proc_Var;  
with Xlbt_Reply;  
use Xlbt_Reply;  
with Xlbt_Request;  
use Xlbt_Request;

with Xlbp_Extension;  
use Xlbp_Extension;  
with Xlbp_Proc_Var;  
use Xlbp_Proc_Var;

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

package body Xlbp_Gc is
------------------------------------------------------------------------------
-- X Library Graphic Context
--
-- Xlbp_Gc - Create and maintain Graphic Contexts
------------------------------------------------------------------------------
-- 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

    Initial_Gc : constant X_Gc_Values :=  
       (Funct              => Gx_Copy,  
        Plane_Mask         => All_Planes,  
        Foreground         => 0,  
        Background         => 1,  
        Line_Width         => 0,  
        Line_Style         => Line_Solid,  
        Cap_Style          => Cap_Butt,  
        Join_Style         => Join_Miter,  
        Fill_Style         => Fill_Solid,  
        Fill_Rule          => Even_Odd_Rule,  
        Arc_Mode           => Arc_Pie_Slice,  
        Tile               => (Drawable => (Id => (Number => -1))),  
        Stipple            => (Drawable => (Id => (Number => -1))),  
        Ts_X_Origin        => 0,  
        Ts_Y_Origin        => 0,  
        Font               => (Id => (Number => -1)),  
        Subwindow_Mode     => Clip_By_Children,  
        Graphics_Exposures => True,  
        Clip_X_Origin      => 0,  
        Clip_Y_Origin      => 0,  
        Clip_Mask          => None_X_Pixmap,  
        Dash_Offset        => 0,  
        Dashes             => 4                         -- dashes (list [4,4])
        );


    Valid_Gc_Values_Bits : constant X_Gc_Components :=  
       X_Gc_Components'  
          (Gc_Function | Gc_Plane_Mask | Gc_Foreground | Gc_Background |  
           Gc_Line_Width | Gc_Line_Style | Gc_Cap_Style | Gc_Join_Style |  
           Gc_Fill_Style | Gc_Fill_Rule | Gc_Tile | Gc_Stipple |  
           Gc_Tile_Stip_X_Origin | Gc_Tile_Stip_Y_Origin | Gc_Font |  
           Gc_Subwindow_Mode | Gc_Graphics_Exposures | Gc_Clip_X_Origin |  
           Gc_Clip_Y_Origin | Gc_Dash_Offset | Gc_Arc_Mode => True,  
           others => False);


    procedure Free_X_Gc is  
       new Unchecked_Deallocation (X_Gc_Rec,  
                                   X_Gc);

--\f

    procedure Private_X_Update_Gc_Cache (Gc   : X_Gc;  
                                         Mask : X_Gc_Components;  
                                         Att  : X_Gc_Values) is  
        Gv : X_Gc_Values renames Gc.Values;  
    begin  
        if Mask (Gc_Function) then  
            if Gv.Funct /= Att.Funct then  
                Gv.Funct               := Att.Funct;  
                Gc.Dirty (Gc_Function) := True;  
            end if;  
        end if;

        if Mask (Gc_Plane_Mask) then  
            if Gv.Plane_Mask /= Att.Plane_Mask then  
                Gv.Plane_Mask            := Att.Plane_Mask;  
                Gc.Dirty (Gc_Plane_Mask) := True;  
            end if;  
        end if;

        if Mask (Gc_Foreground) then  
            if Gv.Foreground /= Att.Foreground then  
                Gv.Foreground            := Att.Foreground;  
                Gc.Dirty (Gc_Foreground) := True;  
            end if;  
        end if;

        if Mask (Gc_Background) then  
            if Gv.Background /= Att.Background then  
                Gv.Background            := Att.Background;  
                Gc.Dirty (Gc_Background) := True;  
            end if;  
        end if;

        if Mask (Gc_Line_Width) then  
            if (Gv.Line_Width /= Att.Line_Width) then  
                Gv.Line_Width            := Att.Line_Width;  
                Gc.Dirty (Gc_Line_Width) := True;  
            end if;  
        end if;

        if Mask (Gc_Line_Style) then  
            if Gv.Line_Style /= Att.Line_Style then  
                Gv.Line_Style            := Att.Line_Style;  
                Gc.Dirty (Gc_Line_Style) := True;  
            end if;  
        end if;

        if Mask (Gc_Cap_Style) then  
            if Gv.Cap_Style /= Att.Cap_Style then  
                Gv.Cap_Style            := Att.Cap_Style;  
                Gc.Dirty (Gc_Cap_Style) := True;  
            end if;  
        end if;

        if Mask (Gc_Join_Style) then  
            if Gv.Join_Style /= Att.Join_Style then  
                Gv.Join_Style            := Att.Join_Style;  
                Gc.Dirty (Gc_Join_Style) := True;  
            end if;  
        end if;

        if Mask (Gc_Fill_Style) then  
            if Gv.Fill_Style /= Att.Fill_Style then  
                Gv.Fill_Style            := Att.Fill_Style;  
                Gc.Dirty (Gc_Fill_Style) := True;  
            end if;  
        end if;

        if Mask (Gc_Fill_Rule) then  
            if Gv.Fill_Rule /= Att.Fill_Rule then  
                Gv.Fill_Rule            := Att.Fill_Rule;  
                Gc.Dirty (Gc_Fill_Rule) := True;  
            end if;  
        end if;

        if Mask (Gc_Arc_Mode) then  
            if Gv.Arc_Mode /= Att.Arc_Mode then  
                Gv.Arc_Mode            := Att.Arc_Mode;  
                Gc.Dirty (Gc_Arc_Mode) := True;  
            end if;  
        end if;

        -- always write through tile change; client may have changed the pixmap
        -- and the server may have copied it the last time
        if Mask (Gc_Tile) then  
            Gv.Tile            := Att.Tile;  
            Gc.Dirty (Gc_Tile) := True;  
        end if;

        -- always write through stipple change; client may have changed the
        -- pixmap and the server may have copied it the last time
        if Mask (Gc_Stipple) then  
            Gv.Stipple            := Att.Stipple;  
            Gc.Dirty (Gc_Stipple) := True;  
        end if;

        if Mask (Gc_Tile_Stip_X_Origin) then  
            if (Gv.Ts_X_Origin /= Att.Ts_X_Origin) then  
                Gv.Ts_X_Origin                   := Att.Ts_X_Origin;  
                Gc.Dirty (Gc_Tile_Stip_X_Origin) := True;  
            end if;  
        end if;

        if Mask (Gc_Tile_Stip_Y_Origin) then  
            if (Gv.Ts_Y_Origin /= Att.Ts_Y_Origin) then  
                Gv.Ts_Y_Origin                   := Att.Ts_Y_Origin;  
                Gc.Dirty (Gc_Tile_Stip_Y_Origin) := True;  
            end if;  
        end if;

        if Mask (Gc_Font) and then  
           Gv.Font /= Att.Font then  
            Gv.Font            := Att.Font;  
            Gc.Dirty (Gc_Font) := True;  
        end if;

        if Mask (Gc_Subwindow_Mode) then  
            if Gv.Subwindow_Mode /= Att.Subwindow_Mode then  
                Gv.Subwindow_Mode            := Att.Subwindow_Mode;  
                Gc.Dirty (Gc_Subwindow_Mode) := True;  
            end if;  
        end if;

        if Mask (Gc_Graphics_Exposures) then  
            if (Gv.Graphics_Exposures /= Att.Graphics_Exposures) then  
                Gv.Graphics_Exposures            := Att.Graphics_Exposures;  
                Gc.Dirty (Gc_Graphics_Exposures) := True;  
            end if;  
        end if;

        if Mask (Gc_Clip_X_Origin) then  
            if (Gv.Clip_X_Origin /= Att.Clip_X_Origin) then  
                Gv.Clip_X_Origin            := Att.Clip_X_Origin;  
                Gc.Dirty (Gc_Clip_X_Origin) := True;  
            end if;  
        end if;

        if Mask (Gc_Clip_Y_Origin) then  
            if (Gv.Clip_Y_Origin /= Att.Clip_Y_Origin) then  
                Gv.Clip_Y_Origin            := Att.Clip_Y_Origin;  
                Gc.Dirty (Gc_Clip_Y_Origin) := True;  
            end if;  
        end if;

        -- always write through mask change; somebody may have changed the
        -- pixmap contents and the server may have made a copy of old one
        if Mask (Gc_Clip_Mask) then  
            Gv.Clip_Mask            := Att.Clip_Mask;  
            Gc.Dirty (Gc_Clip_Mask) := True;  
            Gc.Rects                := False;  
        end if;

        if Mask (Gc_Dash_Offset) then  
            if (Gv.Dash_Offset /= Att.Dash_Offset) then  
                Gv.Dash_Offset            := Att.Dash_Offset;  
                Gc.Dirty (Gc_Dash_Offset) := True;  
            end if;  
        end if;

        if Mask (Gc_Dash_List) then  
            if ((Gv.Dashes /= Att.Dashes) or else  
                (Gc.Dashes = True)) then  
                Gv.Dashes               := Att.Dashes;  
                Gc.Dirty (Gc_Dash_List) := True;  
                Gc.Dashes               := False;  
            end if;  
        end if;  
        return;

    end Private_X_Update_Gc_Cache;

--\f

    procedure X_Change_Gc (Display     : X_Display;  
                           Gc          : X_Gc;  
                           Values_Mask : X_Gc_Components;  
                           Values      : X_Gc_Values) is  
        Lvalues_Mask : X_Gc_Components := Values_Mask and All_Gc_Components;  
    begin

        if Lvalues_Mask /= None_X_Gc_Components then  
            Lock_Display (Display);  
            begin

                Private_X_Update_Gc_Cache (Gc, Lvalues_Mask, Values);

                -- if any Resource ID changed, must flush
                if (Gc.Dirty and X_Gc_Components'  
                                    (Gc_Font | Gc_Tile | Gc_Stipple => True,  
                                     others => False)) /=  
                   None_X_Gc_Components then  
                    Private_X_Flush_Gc_Cache (Display, Gc);  
                end if;  
                Unlock_Display (Display);  
                Sync_Handle (Display);  
            exception  
                when others =>  
                    Unlock_Display (Display);  
                    raise;  
            end;  
        end if;

    end X_Change_Gc;

--\f

    procedure X_Copy_Gc (Display        : X_Display;  
                         Source_Gc      : X_Gc;  
                         Values_Mask    : X_Gc_Components;  
                         Destination_Gc : X_Gc) is  
        Dest_Gv : X_Gc_Values renames Destination_Gc.Values;  
        Src_Gv  : X_Gc_Values renames Source_Gc.Values;  
        Ext     : X_Extension;  
        Lmask   : X_Gc_Components := Values_Mask and All_Gc_Components;  
    begin

        Lock_Display (Display);  
        begin

----If some of the source values to be copied are "dirty" then flush them out
--  before sending the CopyGC request.

            if (Source_Gc.Dirty and Lmask) /= None_X_Gc_Components then  
                Private_X_Flush_Gc_Cache (Display, Source_Gc);  
            end if;

----Mark the copied values "not dirty" in the destination.

            Destination_Gc.Dirty := Destination_Gc.Dirty and not Lmask;

            Put_X_Copy_Gc_Request  
               (Display, (Kind   => Copy_Gc,  
                          Length => X_Copy_Gc_Request'Size / 32,  
                          Pad    => 0,  
                          Src_Gc => Source_Gc.Gid,  
                          Dst_Gc => Destination_Gc.Gid,  
                          Mask   => Lmask));

            if Lmask (Gc_Function) then  
                Dest_Gv.Funct := Src_Gv.Funct;  
            end if;

            if Lmask (Gc_Plane_Mask) then  
                Dest_Gv.Plane_Mask := Src_Gv.Plane_Mask;  
            end if;

            if Lmask (Gc_Foreground) then  
                Dest_Gv.Foreground := Src_Gv.Foreground;  
            end if;

            if Lmask (Gc_Background) then  
                Dest_Gv.Background := Src_Gv.Background;  
            end if;

            if Lmask (Gc_Line_Width) then  
                Dest_Gv.Line_Width := Src_Gv.Line_Width;  
            end if;

            if Lmask (Gc_Line_Style) then  
                Dest_Gv.Line_Style := Src_Gv.Line_Style;  
            end if;

            if Lmask (Gc_Cap_Style) then  
                Dest_Gv.Cap_Style := Src_Gv.Cap_Style;  
            end if;

            if Lmask (Gc_Join_Style) then  
                Dest_Gv.Join_Style := Src_Gv.Join_Style;  
            end if;

            if Lmask (Gc_Fill_Style) then  
                Dest_Gv.Fill_Style := Src_Gv.Fill_Style;  
            end if;

            if Lmask (Gc_Fill_Rule) then  
                Dest_Gv.Fill_Rule := Src_Gv.Fill_Rule;  
            end if;

            if Lmask (Gc_Arc_Mode) then  
                Dest_Gv.Arc_Mode := Src_Gv.Arc_Mode;  
            end if;

            if Lmask (Gc_Tile) then  
                Dest_Gv.Tile := Src_Gv.Tile;  
            end if;

            if Lmask (Gc_Stipple) then  
                Dest_Gv.Stipple := Src_Gv.Stipple;  
            end if;

            if Lmask (Gc_Tile_Stip_X_Origin) then  
                Dest_Gv.Ts_X_Origin := Src_Gv.Ts_X_Origin;  
            end if;

            if Lmask (Gc_Tile_Stip_Y_Origin) then  
                Dest_Gv.Ts_Y_Origin := Src_Gv.Ts_Y_Origin;  
            end if;

            if Lmask (Gc_Font) then  
                Dest_Gv.Font := Src_Gv.Font;  
            end if;

            if Lmask (Gc_Subwindow_Mode) then  
                Dest_Gv.Subwindow_Mode := Src_Gv.Subwindow_Mode;  
            end if;

            if Lmask (Gc_Graphics_Exposures) then  
                Dest_Gv.Graphics_Exposures := Src_Gv.Graphics_Exposures;  
            end if;

            if Lmask (Gc_Clip_X_Origin) then  
                Dest_Gv.Clip_X_Origin := Src_Gv.Clip_X_Origin;  
            end if;

            if Lmask (Gc_Clip_Y_Origin) then  
                Dest_Gv.Clip_Y_Origin := Src_Gv.Clip_Y_Origin;  
            end if;

            if Lmask (Gc_Clip_Mask) then  
                Destination_Gc.Rects := Source_Gc.Rects;  
                Dest_Gv.Clip_Mask    := Src_Gv.Clip_Mask;  
            end if;

            if Lmask (Gc_Dash_Offset) then  
                Dest_Gv.Dash_Offset := Src_Gv.Dash_Offset;  
            end if;

            if Lmask (Gc_Dash_List) then  
                Destination_Gc.Dashes := Source_Gc.Dashes;  
                Dest_Gv.Dashes        := Src_Gv.Dashes;  
            end if;

            Ext := Display.Ext_Procs;  
            while Ext /= null loop  
                if Ext.Copy_Gc /= None_X_Procedure_Variable then  
                    Proc_Var_X_Display_Gc_Extension.Call  
                       (Proc_Var_X_Display_Gc_Extension.To_Pv (Ext.Copy_Gc),  
                        Display, Destination_Gc, Ext.Codes);  
                end if;  
                Ext := Ext.Next;  
            end loop;

            Unlock_Display (Display);  
            Sync_Handle (Display);

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

    end X_Copy_Gc;

--\f

    procedure Process_X_Gc_Components (Display : X_Display;  
                                       Dirty   : X_Gc_Components;  
                                       Gv      : X_Gc_Values) is
------------------------------------------------------------------------------
-- Append the various "dirty" fields in a GC's cache to a request that is
-- creating or updating a GC.
------------------------------------------------------------------------------
    begin

----Note: The order of these tests are critical; the order must be the same as
--  the GC mask bits in the word.

        if Dirty (Gc_Function) then  
            Put_S_Long (Display,  
                        S_Long (X_Graphic_Function'Pos (Gv.Funct)));  
        end if;  
        if Dirty (Gc_Plane_Mask) then  
            Put_X_Plane_Mask (Display,  
                              Gv.Plane_Mask);  
        end if;  
        if Dirty (Gc_Foreground) then  
            Put_X_Pixel (Display,  
                         Gv.Foreground);  
        end if;  
        if Dirty (Gc_Background) then  
            Put_X_Pixel (Display,  
                         Gv.Background);  
        end if;  
        if Dirty (Gc_Line_Width) then  
            Put_S_Long (Display,  
                        S_Long (Gv.Line_Width));  
        end if;  
        if Dirty (Gc_Line_Style) then  
            Put_S_Long (Display,  
                        S_Long (X_Line_Style'Pos (Gv.Line_Style)));  
        end if;  
        if Dirty (Gc_Cap_Style) then  
            Put_S_Long (Display,  
                        S_Long (X_Cap_Style'Pos (Gv.Cap_Style)));  
        end if;  
        if Dirty (Gc_Join_Style) then  
            Put_S_Long (Display,  
                        S_Long (X_Join_Style'Pos (Gv.Join_Style)));  
        end if;  
        if Dirty (Gc_Fill_Style) then  
            Put_S_Long (Display,  
                        S_Long (X_Fill_Style'Pos (Gv.Fill_Style)));  
        end if;  
        if Dirty (Gc_Fill_Rule) then  
            Put_S_Long (Display,  
                        S_Long (X_Fill_Rule'Pos (Gv.Fill_Rule)));  
        end if;  
        if Dirty (Gc_Tile) then  
            Put_X_Id (Display,  
                      Gv.Tile.Drawable.Id);  
        end if;  
        if Dirty (Gc_Stipple) then  
            Put_X_Id (Display,  
                      Gv.Stipple.Drawable.Id);  
        end if;  
        if Dirty (Gc_Tile_Stip_X_Origin) then  
            Put_S_Long (Display,  
                        S_Long (Gv.Ts_X_Origin));  
        end if;  
        if Dirty (Gc_Tile_Stip_Y_Origin) then  
            Put_S_Long (Display,  
                        S_Long (Gv.Ts_Y_Origin));  
        end if;  
        if Dirty (Gc_Font) then  
            Put_X_Id (Display,  
                      Gv.Font.Id);  
        end if;  
        if Dirty (Gc_Subwindow_Mode) then  
            Put_S_Long (Display, S_Long  
                                    (X_Subwindow_Mode'Pos (Gv.Subwindow_Mode)));  
        end if;  
        if Dirty (Gc_Graphics_Exposures) then  
            Put_S_Long (Display,  
                        S_Long (Boolean'Pos (Gv.Graphics_Exposures)));  
        end if;  
        if Dirty (Gc_Clip_X_Origin) then  
            Put_S_Long (Display,  
                        S_Long (Gv.Clip_X_Origin));  
        end if;  
        if Dirty (Gc_Clip_Y_Origin) then  
            Put_S_Long (Display,  
                        S_Long (Gv.Clip_Y_Origin));  
        end if;  
        if Dirty (Gc_Clip_Mask) then  
            Put_X_Id (Display,  
                      Gv.Clip_Mask.Drawable.Id);  
        end if;  
        if Dirty (Gc_Dash_Offset) then  
            Put_S_Long (Display,  
                        S_Long (Gv.Dash_Offset));  
        end if;  
        if Dirty (Gc_Dash_List) then  
            Put_S_Long (Display,  
                        S_Long (Gv.Dashes));  
        end if;  
        if Dirty (Gc_Arc_Mode) then  
            Put_S_Long (Display,  
                        S_Long (X_Arc_Mode'Pos (Gv.Arc_Mode)));  
        end if;

    end Process_X_Gc_Components;

--\f

    function X_Create_Gc  
                (Display     : X_Display;  
                 Drawable    : X_Drawable;  
                 Values_Mask : X_Gc_Components;  
                 Values      : X_Gc_Values) return X_Gc is  
        Gc           : X_Gc;  
        Ext          : X_Extension;  
        Extra_Words  : S_Natural;  
        Lvalues_Mask : X_Gc_Components := Values_Mask and All_Gc_Components;  
    begin

        Lock_Display (Display);  
        begin  
            Gc := new X_Gc_Rec;

            Gc.Rects    := False;  
            Gc.Dashes   := False;  
            Gc.Ext_Data := null;  
            Gc.Values   := Initial_Gc;  
            Gc.Dirty    := (others => False);


            if Lvalues_Mask /= None_X_Gc_Components then  
                Private_X_Update_Gc_Cache (Gc, Lvalues_Mask, Values);  
            end if;

            Gc.Gid      := (Id => Xlbp_Extension.X_Alloc_Id (Display));  
            Extra_Words := 0;  
            for I in Gc.Dirty'Range loop  
                if Gc.Dirty (I) then  
                    Extra_Words := Extra_Words + 1;  
                end if;  
            end loop;  
            Put_X_Create_Gc_Request  
               (Display, (Kind        => Create_Gc,  
                          Length      => X_Create_Gc_Request'Size / 32  
                                             + U_Short (Extra_Words),  
                          Pad         => 0,  
                          Drawable    => Drawable.Id,  
                          Gc          => Gc.Gid,  
                          Create_Mask => Gc.Dirty),  
                Extra_Words * 4);

            if Extra_Words > 0 then  
                Process_X_Gc_Components (Display, Gc.Dirty, Gc.Values);  
                Gc.Dirty := None_X_Gc_Components;  
            end if;

            Ext := Display.Ext_Procs;  
            while Ext /=  
                     null loop       -- call out to any extensions interested
                if Ext.Create_Gc /= None_X_Procedure_Variable then  
                    Proc_Var_X_Display_Gc_Extension.Call  
                       (Proc_Var_X_Display_Gc_Extension.To_Pv (Ext.Create_Gc),  
                        Display, Gc, Ext.Codes);  
                end if;  
                Ext := Ext.Next;  
            end loop;

            Unlock_Display (Display);  
            Sync_Handle (Display);  
            return Gc;

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

    end X_Create_Gc;

--\f

    procedure X_Free_Gc (Display :        X_Display;  
                         Gc      : in out X_Gc) is  
        Ext : X_Extension;  
    begin

        if Gc = None_X_Gc then  
            return;  
        end if;

        Lock_Display (Display);  
        begin

            Put_X_Free_Gc_Request  
               (Display, (Kind   => Free_Gc,  
                          Length => X_Free_Gc_Request'Size / 32,  
                          Pad    => 0,  
                          Id     => Gc.Gid));  
            Free_X_Ext_Data (Gc.Ext_Data);  
            Free_X_Gc (Gc);  
            Gc  := None_X_Gc;  
            Ext := Display.Ext_Procs;  
            while Ext /=  
                     null loop       -- call out to any extensions interested
                if Ext.Free_Gc /= None_X_Procedure_Variable then  
                    Proc_Var_X_Display_Gc_Extension.Call  
                       (Proc_Var_X_Display_Gc_Extension.To_Pv (Ext.Free_Gc),  
                        Display, Gc, Ext.Codes);  
                end if;  
                Ext := Ext.Next;  
            end loop;  
            Unlock_Display (Display);  
            Sync_Handle (Display);

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

    end X_Free_Gc;

--\f

    function X_G_Context_From_Gc (Gc : X_Gc) return X_G_Context is  
    begin  
        return Gc.Gid;  
    end X_G_Context_From_Gc;

--\f

    procedure X_Get_Gc_Values (Display     :     X_Display;  
                               Gc          :     X_Gc;  
                               Values_Mask :     X_Gc_Components;  
                               Values      : out X_Gc_Values;  
                               Status      : out X_Status) is
------------------------------------------------------------------------------
--  Display     - Specifies the display to use.
--  Gc          - Specifies the graphics context to use.
--  Values_Mask   - Specifies what values to return
--  Values      - Receives the values returned
--  Status      - Receives Successful if all values were returned, Failed if
--                  some values were not returned
--
-- Called to obtain some values from those that make up a GC.  Can return all
-- GC fields except Gc_Clip_Mask and Gc_Dash_List.
------------------------------------------------------------------------------
    begin  
        if (Values_Mask and Valid_Gc_Values_Bits) /= Values_Mask then  
            Status := Failed;  
        end if;

        if Values_Mask (Gc_Function) then  
            Values.Funct := Gc.Values.Funct;  
        end if;

        if Values_Mask (Gc_Plane_Mask) then  
            Values.Plane_Mask := Gc.Values.Plane_Mask;  
        end if;

        if Values_Mask (Gc_Foreground) then  
            Values.Foreground := Gc.Values.Foreground;  
        end if;

        if Values_Mask (Gc_Background) then  
            Values.Background := Gc.Values.Background;  
        end if;

        if Values_Mask (Gc_Line_Width) then  
            Values.Line_Width := Gc.Values.Line_Width;  
        end if;

        if Values_Mask (Gc_Line_Style) then  
            Values.Line_Style := Gc.Values.Line_Style;  
        end if;

        if Values_Mask (Gc_Cap_Style) then  
            Values.Cap_Style := Gc.Values.Cap_Style;  
        end if;

        if Values_Mask (Gc_Join_Style) then  
            Values.Join_Style := Gc.Values.Join_Style;  
        end if;

        if Values_Mask (Gc_Fill_Style) then  
            Values.Fill_Style := Gc.Values.Fill_Style;  
        end if;

        if Values_Mask (Gc_Fill_Rule) then  
            Values.Fill_Rule := Gc.Values.Fill_Rule;  
        end if;

        if Values_Mask (Gc_Tile) then  
            Values.Tile := Gc.Values.Tile;  
        end if;

        if Values_Mask (Gc_Stipple) then  
            Values.Stipple := Gc.Values.Stipple;  
        end if;

        if Values_Mask (Gc_Tile_Stip_X_Origin) then  
            Values.Ts_X_Origin := Gc.Values.Ts_X_Origin;  
        end if;

        if Values_Mask (Gc_Tile_Stip_Y_Origin) then  
            Values.Ts_Y_Origin := Gc.Values.Ts_Y_Origin;  
        end if;

        if Values_Mask (Gc_Font) then  
            Values.Font := Gc.Values.Font;  
        end if;

        if Values_Mask (Gc_Subwindow_Mode) then  
            Values.Subwindow_Mode := Gc.Values.Subwindow_Mode;  
        end if;

        if Values_Mask (Gc_Graphics_Exposures) then  
            Values.Graphics_Exposures := Gc.Values.Graphics_Exposures;  
        end if;

        if Values_Mask (Gc_Clip_X_Origin) then  
            Values.Clip_X_Origin := Gc.Values.Clip_X_Origin;  
        end if;

        if Values_Mask (Gc_Clip_Y_Origin) then  
            Values.Clip_Y_Origin := Gc.Values.Clip_Y_Origin;  
        end if;

        if Values_Mask (Gc_Dash_Offset) then  
            Values.Dash_Offset := Gc.Values.Dash_Offset;  
        end if;

        if Values_Mask (Gc_Arc_Mode) then  
            Values.Arc_Mode := Gc.Values.Arc_Mode;  
        end if;

        Status := Successful;

    end X_Get_Gc_Values;

--\f

    procedure X_Query_Best_Size (Display     :     X_Display;  
                                 Class       :     X_Best_Size_Class;  
                                 Drawable    :     X_Drawable;  
                                 Width       :     U_Short;  
                                 Height      :     U_Short;  
                                 Best_Width  : out U_Short;  
                                 Best_Height : out U_Short;  
                                 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_Query_Best_Size_Request  
               (Display, (Kind     => Query_Best_Size,  
                          Length   => X_Query_Best_Size_Request'Size / 32,  
                          Class    => Class,  
                          Drawable => Drawable,  
                          Width    => Width,  
                          Height   => Height));

----Read the reply.

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

----If we failed then return that.

            if Succ = Failed then  
                Best_Width  := 0;  
                Best_Height := 0;  
                Status      := Failed;  
                Unlock_Display (Display);  
                Sync_Handle (Display);  
                return;  
            end if;

----Return our results.

            Best_Width  := Rep.Query_Best_Size.Width;  
            Best_Height := Rep.Query_Best_Size.Height;

----Catch unexpected exceptions.

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

----Unlock; sync; and return.

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

    end X_Query_Best_Size;

--\f

    procedure X_Query_Best_Stipple (Display     :     X_Display;  
                                    Drawable    :     X_Drawable;  
                                    Width       :     U_Short;  
                                    Height      :     U_Short;  
                                    Best_Width  : out U_Short;  
                                    Best_Height : out U_Short;  
                                    Status      : out X_Status) is  
    begin

        X_Query_Best_Size (Display, Stipple_Shape, Drawable, Width,  
                           Height, Best_Width, Best_Height, Status);

    end X_Query_Best_Stipple;

--\f

    procedure X_Query_Best_Tile (Display     :     X_Display;  
                                 Drawable    :     X_Drawable;  
                                 Width       :     U_Short;  
                                 Height      :     U_Short;  
                                 Best_Width  : out U_Short;  
                                 Best_Height : out U_Short;  
                                 Status      : out X_Status) is  
    begin

        X_Query_Best_Size (Display, Tile_Shape, Drawable, Width,  
                           Height, Best_Width, Best_Height, Status);

    end X_Query_Best_Tile;

--\f

    procedure X_Set_Arc_Mode (Display  : X_Display;  
                              Gc       : X_Gc;  
                              Arc_Mode : X_Arc_Mode) is  
    begin  
        Lock_Display (Display);  
        if Gc.Values.Arc_Mode /= Arc_Mode then  
            Gc.Values.Arc_Mode     := Arc_Mode;  
            Gc.Dirty (Gc_Arc_Mode) := True;  
        end if;  
        Unlock_Display (Display);  
        Sync_Handle (Display);  
    end X_Set_Arc_Mode;


--\f

    procedure X_Set_Background (Display    : X_Display;  
                                Gc         : X_Gc;  
                                Background : X_Pixel) is  
    begin

        Lock_Display (Display);  
        if Gc.Values.Background /= Background then  
            Gc.Values.Background     := Background;  
            Gc.Dirty (Gc_Background) := True;  
        end if;  
        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Set_Background;

--\f

    procedure X_Set_Clip_Mask (Display : X_Display;  
                               Gc      : X_Gc;  
                               Mask    : X_Pixmap) is  
    begin

        Lock_Display (Display);
        ----Always update the Mask in the GC, even if it is the same mask as
        --  last time we did this; since the server *may* copy the pixmap
        --  and since the application *may* have changed the pixmap since the
        --  last time, we have no way of detecting whether this 'change' is
        --  in fact a no-op or not; so just do it.
        Gc.Values.Clip_Mask     := Mask;  
        Gc.Dirty (Gc_Clip_Mask) := True;  
        Gc.Rects                := False;  
        Private_X_Flush_Gc_Cache (Display, Gc);  
        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Set_Clip_Mask;

--\f

    procedure X_Set_Clip_Origin (Display : X_Display;  
                                 Gc      : X_Gc;  
                                 X       : S_Short;  
                                 Y       : S_Short) is  
        Gv : X_Gc_Values renames Gc.Values;  
    begin

        Lock_Display (Display);  
        if X /= Gv.Clip_X_Origin then  
            Gv.Clip_X_Origin            := X;  
            Gc.Dirty (Gc_Clip_X_Origin) := True;  
        end if;  
        if Y /= Gv.Clip_Y_Origin then  
            Gv.Clip_Y_Origin            := Y;  
            Gc.Dirty (Gc_Clip_Y_Origin) := True;  
        end if;  
        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Set_Clip_Origin;

--\f

    procedure X_Set_Clip_Rectangles (Display    : X_Display;  
                                     Gc         : X_Gc;  
                                     X          : S_Short;  
                                     Y          : S_Short;  
                                     Rectangles : X_Rectangle_Array;  
                                     Ordering   : X_Clip_Ordering) is  
    begin

        Lock_Display (Display);  
        begin

            Put_X_Set_Clip_Rectangles_Request  
               (Display, (Kind     => Set_Clip_Rectangles,  
                          Length   => X_Set_Clip_Rectangles_Request'Size / 32 +  
                                         Rectangles'Length *  
                                            X_Rectangle'Size / 32,  
                          Gc       => Gc.Gid,  
                          X_Origin => X,  
                          Y_Origin => Y,  
                          Ordering => Ordering));  
            Gc.Values.Clip_X_Origin := X;  
            Gc.Values.Clip_Y_Origin := Y;  
            Gc.Rects                := True;  
            Put_X_Rectangle_Array (Display, Rectangles);  
            Gc.Dirty := Gc.Dirty and  
                           not X_Gc_Components'(Gc_Clip_Mask |  
                                                Gc_Clip_X_Origin |  
                                                Gc_Clip_Y_Origin => True,  
                                                others           => False);

            Unlock_Display (Display);  
            Sync_Handle (Display);

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

    end X_Set_Clip_Rectangles;

--\f

    procedure X_Set_Dashes (Display     : X_Display;  
                            Gc          : X_Gc;  
                            Dash_Offset : U_Short;  
                            Dash_List   : U_Char_Array) is  
    begin

        Lock_Display (Display);  
        begin

            Put_X_Set_Dashes_Request  
               (Display,  
                (Kind        => Set_Dashes,  
                 Length      =>  
                    X_Set_Dashes_Request'Size / 32 + (Dash_List'Length + 3) / 4,  
                 Pad         => 0,  
                 Gc          => Gc.Gid,  
                 Dash_Offset => Dash_Offset,  
                 N_Dashes    => Dash_List'Length),  
                Dash_List'Length);  
            Gc.Values.Dash_Offset := Dash_Offset;  
            Gc.Dashes := True;  
            Gc.Dirty := Gc.Dirty and not X_Gc_Components'  
                                         (Gc_Dash_List | Gc_Dash_Offset => True,  
                                          others => False);  
            Put_U_Char_Array (Display, Dash_List);  
            Unlock_Display (Display);  
            Sync_Handle (Display);

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

    end X_Set_Dashes;

--\f

    procedure X_Set_Fill_Rule (Display   : X_Display;  
                               Gc        : X_Gc;  
                               Fill_Rule : X_Fill_Rule) is  
    begin  
        Lock_Display (Display);  
        if Gc.Values.Fill_Rule /= Fill_Rule then  
            Gc.Values.Fill_Rule     := Fill_Rule;  
            Gc.Dirty (Gc_Fill_Rule) := True;  
        end if;  
        Unlock_Display (Display);  
        Sync_Handle (Display);  
    end X_Set_Fill_Rule;


--\f

    procedure X_Set_Fill_Style (Display    : X_Display;  
                                Gc         : X_Gc;  
                                Fill_Style : X_Fill_Style) is  
    begin  
        Lock_Display (Display);  
        if Gc.Values.Fill_Style /= Fill_Style then  
            Gc.Values.Fill_Style     := Fill_Style;  
            Gc.Dirty (Gc_Fill_Style) := True;  
        end if;  
        Unlock_Display (Display);  
        Sync_Handle (Display);  
    end X_Set_Fill_Style;

--\f

    procedure X_Set_Font (Display : X_Display;  
                          Gc      : X_Gc;  
                          Font    : X_Font) is  
    begin

        Lock_Display (Display);  
        if Gc.Values.Font /= Font then  
            Gc.Values.Font     := Font;  
            Gc.Dirty (Gc_Font) := True;  
            Private_X_Flush_Gc_Cache (Display, Gc);  
        end if;  
        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Set_Font;

--\f

    procedure X_Set_Foreground (Display    : X_Display;  
                                Gc         : X_Gc;  
                                Foreground : X_Pixel) is  
    begin

        Lock_Display (Display);  
        if Gc.Values.Foreground /= Foreground then  
            Gc.Values.Foreground     := Foreground;  
            Gc.Dirty (Gc_Foreground) := True;  
        end if;  
        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Set_Foreground;

--\f

    procedure X_Set_Function (Display : X_Display;  
                              Gc      : X_Gc;  
                              Funct   : X_Graphic_Function) is  
    begin

        Lock_Display (Display);  
        if Gc.Values.Funct /= Funct then  
            Gc.Values.Funct        := Funct;  
            Gc.Dirty (Gc_Function) := True;  
        end if;  
        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Set_Function;

--\f

    procedure X_Set_Graphics_Exposures  
                 (Display            : X_Display;  
                  Gc                 : X_Gc;  
                  Graphics_Exposures : Boolean) is  
    begin  
        Lock_Display (Display);  
        if Gc.Values.Graphics_Exposures /= Graphics_Exposures then  
            Gc.Values.Graphics_Exposures     := Graphics_Exposures;  
            Gc.Dirty (Gc_Graphics_Exposures) := True;  
        end if;  
        Unlock_Display (Display);  
        Sync_Handle (Display);  
    end X_Set_Graphics_Exposures;

--\f

    procedure X_Set_Line_Attributes (Display    : X_Display;  
                                     Gc         : X_Gc;  
                                     Line_Width : U_Short;  
                                     Line_Style : X_Line_Style;  
                                     Cap_Style  : X_Cap_Style;  
                                     Join_Style : X_Join_Style) is  
        Gv : X_Gc_Values renames Gc.Values;  
    begin

        Lock_Display (Display);

        if Line_Width /= Gv.Line_Width then  
            Gv.Line_Width            := Line_Width;  
            Gc.Dirty (Gc_Line_Width) := True;  
        end if;  
        if Line_Style /= Gv.Line_Style then  
            Gv.Line_Style            := Line_Style;  
            Gc.Dirty (Gc_Line_Style) := True;  
        end if;  
        if Cap_Style /= Gv.Cap_Style then  
            Gv.Cap_Style            := Cap_Style;  
            Gc.Dirty (Gc_Cap_Style) := True;  
        end if;  
        if Join_Style /= Gv.Join_Style then  
            Gv.Join_Style            := Join_Style;  
            Gc.Dirty (Gc_Join_Style) := True;  
        end if;  
        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Set_Line_Attributes;

--\f

    procedure X_Set_Plane_Mask (Display    : X_Display;  
                                Gc         : X_Gc;  
                                Plane_Mask : X_Plane_Mask) is  
    begin

        Lock_Display (Display);  
        if Gc.Values.Plane_Mask /= Plane_Mask then  
            Gc.Values.Plane_Mask     := Plane_Mask;  
            Gc.Dirty (Gc_Plane_Mask) := True;  
        end if;  
        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Set_Plane_Mask;

--\f

    procedure X_Set_State (Display    : X_Display;  
                           Gc         : X_Gc;  
                           Foreground : X_Pixel;  
                           Background : X_Pixel;  
                           Funct      : X_Graphic_Function;  
                           Plane_Mask : X_Plane_Mask) is  
        Gv : X_Gc_Values renames Gc.Values;  
    begin

        Lock_Display (Display);

        if Funct /= Gv.Funct then  
            Gv.Funct               := Funct;  
            Gc.Dirty (Gc_Function) := True;  
        end if;  
        if Plane_Mask /= Gv.Plane_Mask then  
            Gv.Plane_Mask            := Plane_Mask;  
            Gc.Dirty (Gc_Plane_Mask) := True;  
        end if;  
        if Foreground /= Gv.Foreground then  
            Gv.Foreground            := Foreground;  
            Gc.Dirty (Gc_Foreground) := True;  
        end if;  
        if Background /= Gv.Background then  
            Gv.Background            := Background;  
            Gc.Dirty (Gc_Background) := True;  
        end if;  
        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Set_State;

--\f

    procedure X_Set_Stipple (Display : X_Display;  
                             Gc      : X_Gc;  
                             Stipple : X_Pixmap) is  
    begin

        Lock_Display (Display);  
        begin

            ----Always update the Stipple in the GC, even if it is the same stipple
            --  as last time we did this; since the server *may* copy the pixmap
            --  and since the application *may* have changed the pixmap since the
            --  last time, we have no way of detecting whether this 'change' is
            --  in fact a no-op or not; so just do it.
            Gc.Values.Stipple     := Stipple;  
            Gc.Dirty (Gc_Stipple) := True;  
            Private_X_Flush_Gc_Cache (Display, Gc);  
            Unlock_Display (Display);  
            Sync_Handle (Display);

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

    end X_Set_Stipple;

--\f

    procedure X_Set_Subwindow_Mode (Display        : X_Display;  
                                    Gc             : X_Gc;  
                                    Subwindow_Mode : X_Subwindow_Mode) is  
    begin  
        Lock_Display (Display);  
        if Gc.Values.Subwindow_Mode /= Subwindow_Mode then  
            Gc.Values.Subwindow_Mode     := Subwindow_Mode;  
            Gc.Dirty (Gc_Subwindow_Mode) := True;  
        end if;  
        Unlock_Display (Display);  
        Sync_Handle (Display);  
    end X_Set_Subwindow_Mode;

--\f

    procedure X_Set_Tile (Display : X_Display;  
                          Gc      : X_Gc;  
                          Tile    : X_Pixmap) is  
    begin

        Lock_Display (Display);
        ----Always update the Tile in the GC, even if it is the same tile as
        --  last time we did this; since the server *may* copy the pixmap
        --  and since the application *may* have changed the pixmap since the
        --  last time, we have no way of detecting whether this 'change' is
        --  in fact a no-op or not; so just do it.
        Gc.Values.Tile     := Tile;  
        Gc.Dirty (Gc_Tile) := True;  
        Private_X_Flush_Gc_Cache (Display, Gc);

        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Set_Tile;

--\f

    procedure X_Set_Ts_Origin (Display : X_Display;  
                               Gc      : X_Gc;  
                               X       : S_Short;  
                               Y       : S_Short) is  
        Gv : X_Gc_Values renames Gc.Values;  
    begin

        Lock_Display (Display);  
        if X /= Gv.Ts_X_Origin then  
            Gv.Ts_X_Origin                   := X;  
            Gc.Dirty (Gc_Tile_Stip_X_Origin) := True;  
        end if;  
        if Y /= Gv.Ts_Y_Origin then  
            Gv.Ts_Y_Origin                   := Y;  
            Gc.Dirty (Gc_Tile_Stip_Y_Origin) := True;  
        end if;  
        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Set_Ts_Origin;

--\f

    procedure Private_X_Flush_Gc (Display : X_Display;  
                                  Gc      : X_Gc) is
        ----May only call this when the display is already locked.
        A_Gc        : X_Gc            := Gc;  
        Ext         : X_Extension;  
        Extra_Words : S_Natural       := 0;  
        Dirty       : X_Gc_Components := A_Gc.Dirty;  
    begin

----Do nothing if there is nothing to flush.

        if Dirty = None_X_Gc_Components then  
            return;  
        end if;  
        A_Gc.Dirty := None_X_Gc_Components;

----Count the number of extra words that must go into the request

        for I in Dirty'Range loop  
            if Dirty (I) then  
                Extra_Words := Extra_Words + 1;  
            end if;  
        end loop;

----We assume that our caller is taking care of locking and unlocking the
--  display.

        Put_X_Change_Gc_Request  
           (Display, (Kind        => Change_Gc,  
                      Length      => X_Change_Gc_Request'Size / 32  
                                         + U_Short (Extra_Words),  
                      Pad         => 0,  
                      Gc          => A_Gc.Gid,  
                      Change_Mask => Dirty),  
            Extra_Words * 4);

----Now put out all of the affected fields.

        Process_X_Gc_Components (Display, Dirty, A_Gc.Values);

----Our change to the GC is done.  Call out to any extensions that might be
--  interested in flushing GC extension data.

        Ext := Display.Ext_Procs;  
        while Ext /= null loop  
            if Ext.Flush_Gc /= None_X_Procedure_Variable then  
                Proc_Var_X_Display_Gc_Extension.Call  
                   (Proc_Var_X_Display_Gc_Extension.To_Pv (Ext.Flush_Gc),  
                    Display, A_Gc, Ext.Codes);  
            end if;  
            Ext := Ext.Next;  
        end loop;

    end Private_X_Flush_Gc;

--\f

end Xlbp_Gc;