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

⟦527f3d50e⟧ Ada Source

    Length: 173056 (0x2a400)
    Types: Ada Source
    Notes: 03_class, FILE, Long Ada Source, R1k_Segment, e3_tag, generic, package body Xlbp_Region, seg_004f7f

Derivation

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

E3 Source Code



with Unchecked_Deallocation;

with Xlbt_Arithmetic;  
use Xlbt_Arithmetic;  
with Xlbt_Basic;  
use Xlbt_Basic;  
with Xlbt_Exceptions;  
use Xlbt_Exceptions;  
with Xlbt_Gc;  
use Xlbt_Gc;  
with Xlbt_Graphics;  
use Xlbt_Graphics;  
with Xlbt_Region;  
use Xlbt_Region;  
with Xlbt_Region2;  
use Xlbt_Region2;

with Xlbp_Gc;  
use Xlbp_Gc;

package body Xlbp_Region is
------------------------------------------------------------------------------
-- X Library Regions
--
-- Xlbp_Region - Create and manipulate regions.
------------------------------------------------------------------------------
-- 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
    ------------------------------------------------------------------------------
--     This file contains a few routines to help track
--     the edge of a filled object.  The object is assumed
--     to be filled in scan_line order, and thus the
--     algorithm used is an extension of Bresenham's line
--     drawing algorithm which assumes that y is always the
--     major axis.
--     Since these pieces of code are the same for any filled shape,
--     it is more convenient to gather the library in one
--     place, but since these pieces of code are also in
--     the inner loops of output primitives, procedure call
--     overhead is out of the question.
--     See the author for a derivation if needed.
------------------------------------------------------------------------------

------------------------------------------------------------------------------
--     This structure contains all of the information needed
--     to run the Bresenham algorithm.
--     The variables may be hardcoded into the declarations
--     instead of using this structure to make use of
--     register declarations.
------------------------------------------------------------------------------

    type Bres_Info is  
        record  
            Minor_Axis : S_Long := 0;   -- minor axis
            D          : S_Long := 0;   -- decision variable
            M          : S_Long := 0;   -- slope
            M1         : S_Long := 0;   -- slope+1
            Incr1      : S_Long := 0;   -- error increment
            Incr2      : S_Long := 0;   -- error increment
        end record;


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

    type X_Winding_Number_Rule is (Clockwise,  
                                   Counterclockwise);

    None_X_Winding_Rule : constant X_Winding_Number_Rule :=  
       X_Winding_Number_Rule'Val (0);

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

    type X_Edge_Table_Entry_Rec;  
    type X_Edge_Table_Entry is access X_Edge_Table_Entry_Rec;

    type X_Edge_Table_Entry_Rec is  
        record  
            Y_Max : S_Long := 0;        -- y_coord at which we exit this edge.
            Bres : Bres_Info;           -- Bresenham info to run the edge
            Next : X_Edge_Table_Entry;  -- next in the list
            Back : X_Edge_Table_Entry;  -- for insertion sort
            Next_Wete :                 -- for winding num rule
               X_Edge_Table_Entry;  
            Clock_Wise :                -- flag for winding number rule
               X_Winding_Number_Rule := None_X_Winding_Rule;  
        end record;

--/ if Enable_Deallocation then
    pragma Enable_Deallocation (X_Edge_Table_Entry);
--/ end if;

--    procedure Free_X_Edge_Table_Entry is
--       new Unchecked_Deallocation (X_Edge_Table_Entry_Rec,
--                                   X_Edge_Table_Entry);

    type X_Edge_Table_Entry_Array is  
       array (S_Natural range <>) of X_Edge_Table_Entry;

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

    type X_Scan_Line_List_Rec;

    type X_Scan_Line_List is access X_Scan_Line_List_Rec;

    type X_Scan_Line_List_Rec is  
        record  
            Scan_Line : S_Long := 0;    -- the scan_line represented
            Edgelist  :                  -- header node
               X_Edge_Table_Entry;  
            Next      : X_Scan_Line_List;    -- next in the list
        end record;

--/ if Enable_Deallocation then
    pragma Enable_Deallocation (X_Scan_Line_List);
--/ end if;

--    procedure Free_X_Scan_Line_List is
--       new Unchecked_Deallocation (X_Scan_Line_List_Rec,
--                                   X_Scan_Line_List);

------------------------------------------------------------------------------
-- Here is a struct to help with storage allocation
-- so we can allocate a big chunk at a time, and then take
-- pieces from this heap when we need to.
------------------------------------------------------------------------------

    Slls_Per_Block : constant := 25;

    type X_Scan_Line_List_Block_Rec;

    type X_Scan_Line_List_Block is access X_Scan_Line_List_Block_Rec;

    type X_Scan_Line_List_Rec_Array is  
       array (S_Natural range <>) of X_Scan_Line_List;

    type X_Scan_Line_List_Block_Rec is  
        record  
            Slls : X_Scan_Line_List_Rec_Array (0 .. Slls_Per_Block);  
            Next : X_Scan_Line_List_Block;  
        end record;

--/ if Enable_Deallocation then
    pragma Enable_Deallocation (X_Scan_Line_List_Block);
--/ end if;

    procedure Real_Free_X_Scan_Line_List_Block is  
       new Unchecked_Deallocation (X_Scan_Line_List_Block_Rec,  
                                   X_Scan_Line_List_Block);

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

    type X_Edge_Table is  
        record  
            Y_Max      : S_Long := 0;        -- y_max for the polygon
            Y_Min      : S_Long := 0;        -- y_min for the polygon
            Scan_Lines :                -- header node
               X_Scan_Line_List;  
        end record;

------------------------------------------------------------------------------
-- number of points to buffer before sending them off
-- to scan_lines() :  Must be an even number
------------------------------------------------------------------------------

    X_Num_Pts_To_Buffer : constant := 200;

------------------------------------------------------------------------------
-- X_Point_Block_Rec - used to allocate buffers for points and link the
--                     buffers together
------------------------------------------------------------------------------

    type X_Point_Block_Rec;  
    type X_Point_Block is access X_Point_Block_Rec;

    type X_Point_Block_Rec is  
        record  
            Pts  : X_Point_Array (0 .. X_Num_Pts_To_Buffer - 1);  
            Next : X_Point_Block := null;  
        end record;

--/ if Enable_Deallocation then
    pragma Enable_Deallocation (X_Point_Block);
--/ end if;

    procedure Free_X_Point_Block is  
       new Unchecked_Deallocation (X_Point_Block_Rec, X_Point_Block);

------------------------------------------------------------------------------
--     These are the data structures needed to scan
--     convert regions.  Two different scan conversion
--     methods are available -- the even-odd method, and
--     the winding number method.
--     The eve-odd rule states that a point is inside
--     the polygon if a ray drawn from that point in any
--     direction will pass through an odd number of
--     path segments.
--     By the winding number rule, a point is decided
--     to be inside the polygon if a ray drawn from that
--     point in any direction passes through a different
--     number of clockwise and counter-clockwise path
--     segments.
--
--     These data structures are adapted somewhat from
--     the algorithm in (Foley/Van D_am) for scan converting
--     polygons.
--     The basic algorithm is to start at the top (smallest y)
--     of the polygon, stepping down to the bottom of
--     the polygon by incrementing the y coordinate.  We
--     keep a list of edges which the current scan_line crosses,
--     sorted by x.  This list is called the Active Edge Table (AET)
--     As we change the y-coordinate, we update each entry in
--     in the active edge table to reflect the edges new x_coord.
--     This list must be sorted at each scan_line in case
--     two edges intersect.
--     We also keep a data structure known as the Edge Table (ET),
--     which keeps track of all the edges which the current
--     scan_line has not yet reached.  The ET is basically a
--     list of Scan_Line_List structures containing a list of
--     edges which are entered at a given scan_line.  There is one
--     Scan_Line_List per scan_line at which an edge is entered.
--     When we enter a new edge, we move it from the ET to the AET.
--
--     From the AET, we can implement the even-odd rule as in
--     (Foley/Van D_am).
--     The winding number rule is a little trickier.  We also
--     keep the Edge_Table_Entries in the AET linked by the
--     next_WETE (winding Edge_Table_Entry) link.  This allows
--     the edges to be linked just as before for updating
--     purposes, but only uses the edges linked by the next_WETE
--     link as edges representing spans of the polygon to
--     drawn (as with the even-odd rule).
------------------------------------------------------------------------------

------------------------------------------------------------------------------
--  In scan converting polygons, we want to choose those pixels
--  which are inside the polygon.  Thus, we add .5 to the starting
--  x coordinate for both left and right edges.  Now we choose the
--  first pixel which is inside the polygon for the left edge and the
--  first pixel which is outside the polygon for the right edge.
--  Draw the left pixel, but not the right.
--
--  How to add .5 to the starting x coordinate:
--      If the edge is moving to the right, then subtract dy from the
--  error term from the general form of the algorithm.
--      If the edge is moving to the left, then add dy to the error term.
--
--  The reason for the difference between edges moving to the left
--  and edges moving to the right is simple:  If an edge is moving
--  to the right, then we want the algorithm to flip immediately.
--  If it is moving to the left, then we don't want it to flip until
--  we traverse an entire pixel.
------------------------------------------------------------------------------

    Max_Short : constant := 32767;  
    Min_Short : constant := -Max_Short;

    Large_Coordinate : constant := 1000000;  
    Small_Coordinate : constant := -Large_Coordinate;

--\x0c
    function Extent_Check (R1 : X_Box_Rec;  
                           R2 : X_Box_Rec) return Boolean is  
    begin  
        return not ((R1.X2 <= R2.X1) or else  
                    (R1.X1 >= R2.X2) or else  
                    (R1.Y2 <= R2.Y1) or else  
                    (R1.Y1 >= R2.Y2));  
    end Extent_Check;

--\x0c
    -- procedure Extents (R : X_Box_Rec; Id_Rect : X_Region) is
    -- begin
    --     if R.X1 < Id_Rect.Extents.X1 then
    --         Id_Rect.Extents.X1 := R.X1;
    --     end if;
    --     if R.Y1 < Id_Rect.Extents.Y1 then
    --         Id_Rect.Extents.Y1 := R.Y1;
    --     end if;
    --     if R.X2 > Id_Rect.Extents.X2 then
    --         Id_Rect.Extents.X2 := R.X2;
    --     end if;
    --     if R.Y2 > Id_Rect.Extents.Y2 then
    --         Id_Rect.Extents.Y2 := R.Y2;
    --     end if;
    -- end Extents;

--\x0c
    -- procedure Mem_Check (Reg : X_Region) is
    --     New_Rect : X_Box_List;
    -- begin
    --
    --     if Reg.Num_Rects >= Reg.Size - 1 then
    --         New_Rect := new X_Box_Array (1 .. 2 * s_natural (Reg.Size));
    --         New_Rect (Reg.Rects'Range) := Reg.Rects.all;
    --         Free_X_Box_List (Reg.Rects);
    --         Reg.Rects := New_Rect;
    --         Reg.Size  := Reg.Size * 2;
    --     end if;
    --
    -- end Mem_Check;

--\x0c
    procedure Empty_Region (P_Reg : X_Region) is  
    begin  
        P_Reg.Num_Rects := 0;  
    end Empty_Region;

--\x0c
    function Region_Not_Empty (P_Reg : X_Region) return Boolean is  
    begin  
        return P_Reg.Num_Rects /= 0;  
    end Region_Not_Empty;

--\x0c
    function In_Box (R : X_Box_Rec;  
                     X : S_Short;  
                     Y : S_Short) return Boolean is  
    begin  
        return (R.X2 >= X) and then  
                  (R.X1 <= X) and then  
                  (R.Y2 >= Y) and then  
                  (R.Y1 <= Y);  
    end In_Box;

--\x0c
    ------------------------------------------------------------------------------
--     Clean up our act.
------------------------------------------------------------------------------

    procedure Free_X_Scan_Line_List_Block  
                 (P_Sll_Block : in out X_Scan_Line_List_Block) is  
        Tmp_Sll_Block : X_Scan_Line_List_Block;  
    begin

        while P_Sll_Block /= null loop  
            Tmp_Sll_Block := P_Sll_Block.Next;  
            Real_Free_X_Scan_Line_List_Block (P_Sll_Block);  
            P_Sll_Block := Tmp_Sll_Block;  
        end loop;

    end Free_X_Scan_Line_List_Block;

--\x0c
    procedure B_Res_Init_Pgon (Dy      :     S_Long;  
                               X1      :     S_Long;  
                               X2      :     S_Long;  
                               X_Start : out S_Long;  
                               D       : out S_Long;  
                               M       : out S_Long;  
                               M1      : out S_Long;  
                               Incr1   : out S_Long;  
                               Incr2   : out S_Long) is  
        Dx : S_Long;      -- local storage
        Q  : S_Long;  
        Q1 : S_Long;  
    begin

        --  if the edge is horizontal, then it is ignored
        --  and assumed not to be processed.  Otherwise, do this stuff.

        if Dy /= 0 then  
            X_Start := X1;  
            Dx      := X2 - X1;  
            if Dx < 0 then  
                Q     := Dx / Dy;  
                M     := Q;  
                Q1    := Q - 1;  
                M1    := Q1;  
                Incr1 := -2 * Dx + 2 * Dy * Q1;  
                Incr2 := -2 * Dx + 2 * Dy * Q;  
                D     := 2 * Q * Dy - 2 * Dx - 2 * Dy;  
            else  
                Q     := Dx / Dy;  
                M     := Q;  
                Q1    := Q + 1;  
                M1    := Q1;  
                Incr1 := 2 * Dx - 2 * Dy * Q1;  
                Incr2 := 2 * Dx - 2 * Dy * Q;  
                D     := (-2) * Q * Dy + 2 * Dx;  
            end if;  
        end if;  
    end B_Res_Init_Pgon;

--\x0c
    procedure B_Res_Incr_Pgon (D      : in out S_Long;  
                               Minval : in out S_Long;  
                               M      :        S_Long;  
                               M1     :        S_Long;  
                               Incr1  :        S_Long;  
                               Incr2  :        S_Long) is  
    begin  
        if M1 > 0 then  
            if D > 0 then  
                Minval := Minval + M1;  
                D      := D + Incr1;  
            else  
                Minval := Minval + M;  
                D      := D + Incr2;  
            end if;  
        else  
            if D >= 0 then  
                Minval := Minval + M1;  
                D      := D + Incr1;  
            else  
                Minval := Minval + M;  
                D      := D + Incr2;  
            end if;  
        end if;  
    end B_Res_Incr_Pgon;

--\x0c
    procedure B_Res_Init_Pgon_Struct (Dmaj :     S_Long;  
                                      Min1 :     S_Long;  
                                      Min2 :     S_Long;  
                                      Bres : out Bres_Info) is  
    begin  
        B_Res_Init_Pgon (Dmaj, Min1, Min2, Bres.Minor_Axis, Bres.D,  
                         Bres.M, Bres.M1, Bres.Incr1, Bres.Incr2);  
    end B_Res_Init_Pgon_Struct;

--\x0c
    procedure B_Res_Incr_Pgon_Struct (Bres : in out Bres_Info) is  
    begin  
        B_Res_Incr_Pgon (Bres.D, Bres.Minor_Axis, Bres.M,  
                         Bres.M1, Bres.Incr1, Bres.Incr2);  
    end B_Res_Incr_Pgon_Struct;

--\x0c
    ------------------------------------------------------------------------------
--     a few macros for the inner loops of the fill code where
--     performance considerations don't allow a procedure call.
--
--     Evaluate the given edge at the given scan_line.
--     If the edge has expired, then we leave it and fix up
--     the active edge table; otherwise, we increment the
--     x value to be ready for the next scan_line.
--     The winding number rule is in effect, so we must notify
--     the caller when the edge has been removed so he
--     can reorder the Winding Active Edge Table.
------------------------------------------------------------------------------

    procedure Evaluate_Edge_Winding (P_Aet      : in out X_Edge_Table_Entry;  
                                     P_Prev_Aet : in out X_Edge_Table_Entry;  
                                     Y          :        S_Long;  
                                     Fix_Waet   : in out Boolean) is  
    begin  
        if P_Aet.Y_Max = Y then        -- leaving this edge

            P_Prev_Aet.Next := P_Aet.Next;  
            P_Aet           := P_Prev_Aet.Next;  
            Fix_Waet        := True;  
            if P_Aet /= null then  
                P_Aet.Back := P_Prev_Aet;  
            end if;

        else

            B_Res_Incr_Pgon_Struct (P_Aet.Bres);  
            P_Prev_Aet := P_Aet;  
            P_Aet      := P_Aet.Next;

        end if;

    end Evaluate_Edge_Winding;

--\x0c
    ------------------------------------------------------------------------------
--     Evaluate the given edge at the given scan_line.
--     If the edge has expired, then we leave it and fix up
--     the active edge table; otherwise, we increment the
--     x value to be ready for the next scan_line.
--     The even-odd rule is in effect.
------------------------------------------------------------------------------

    procedure Evaluate_Edge_Even_Odd (P_Aet      : in out X_Edge_Table_Entry;  
                                      P_Prev_Aet : in out X_Edge_Table_Entry;  
                                      Y          :        S_Long) is  
    begin  
        if P_Aet.Y_Max = Y then         -- leaving this edge

            P_Prev_Aet.Next := P_Aet.Next;  
            P_Aet           := P_Prev_Aet.Next;  
            if P_Aet /= null then  
                P_Aet.Back := P_Prev_Aet;  
            end if;

        else

            B_Res_Incr_Pgon_Struct (P_Aet.Bres);  
            P_Prev_Aet := P_Aet;  
            P_Aet      := P_Aet.Next;

        end if;

    end Evaluate_Edge_Even_Odd;

--\x0c
    ------------------------------------------------------------------------------
--     Insert_Edge_In_ET
--
--     Insert the given edge into the edge table.
--     First we must find the correct bucket in the
--     Edge table, then find the right slot in the
--     bucket.  Finally, we can insert it.
------------------------------------------------------------------------------

    procedure Insert_Edge_In_Et (Et          :        X_Edge_Table;  
                                 Ete         :        X_Edge_Table_Entry;  
                                 Scan_Line   :        S_Long;  
                                 Sll_Block   : in out X_Scan_Line_List_Block;  
                                 I_Sll_Block : in out S_Natural) is  
        Start         : X_Edge_Table_Entry;  
        Prev          : X_Edge_Table_Entry;  
        P_Sll         : X_Scan_Line_List;  
        P_Prev_Sll    : X_Scan_Line_List;  
        Tmp_Sll_Block : X_Scan_Line_List_Block;  
    begin

----Find the right bucket to put the edge into.

        P_Prev_Sll := Et.Scan_Lines;  
        P_Sll      := P_Prev_Sll.Next;  
        while P_Sll /= null and then P_Sll.Scan_Line < Scan_Line loop  
            P_Prev_Sll := P_Sll;  
            P_Sll      := P_Sll.Next;  
        end loop;

----Reassign p_SLL (pointer to Scan_Line_List) if necessary

        if P_Sll = null or else P_Sll.Scan_Line > Scan_Line then  
            if I_Sll_Block > Slls_Per_Block - 1 then  
                Tmp_Sll_Block      := new X_Scan_Line_List_Block_Rec;  
                Sll_Block.Next     := Tmp_Sll_Block;  
                Tmp_Sll_Block.Next := null;  
                Sll_Block          := Tmp_Sll_Block;  
                I_Sll_Block        := 0;  
            end if;  
            P_Sll       := Sll_Block.Slls (I_Sll_Block);  
            I_Sll_Block := I_Sll_Block + 1;

            P_Sll.Next      := P_Prev_Sll.Next;  
            P_Sll.Edgelist  := null;  
            P_Prev_Sll.Next := P_Sll;  
        end if;  
        P_Sll.Scan_Line := Scan_Line;

----Now insert the edge in the right bucket

        Prev  := null;  
        Start := P_Sll.Edgelist;  
        while Start /= null and then  
                 Start.Bres.Minor_Axis < Ete.Bres.Minor_Axis loop  
            Prev  := Start;  
            Start := Start.Next;  
        end loop;  
        Ete.Next := Start;

        if Prev /= null then  
            Prev.Next := Ete;  
        else  
            P_Sll.Edgelist := Ete;  
        end if;

    end Insert_Edge_In_Et;

--\x0c
    procedure Create_Et_And_Aet (Pts            : X_Point_Array;  
                                 Et             : in out X_Edge_Table;  
                                 Aet            : X_Edge_Table_Entry;  
                                 P_Etes         : X_Edge_Table_Entry_Array;  
                                 P_Sll_Block_In : X_Scan_Line_List_Block) is
------------------------------------------------------------------------------
--     Create_Edge_Table
--
--     This routine creates the edge table for
--     scan converting polygons.
--     The Edge Table (ET) looks like:
--
--    Edge_Table
--     ---------
--    | y_max   |      Scan_Line_Lists
--    |scan_line|...---------.....---------....
--     --------    |scan_line|   |scan_line|
--                 |edgelist |   |edgelist |
--                  ---------     ---------
--                     |             |
--                     |             |
--                     V             V                  list of ETEs  list of ETEs
--
--     where ETE is an Edge_Table_Entry data structure,
--     and there is one Scan_Line_List per scan_line at
--     which an edge is initially entered.
--
------------------------------------------------------------------------------
        P_Sll_Block : X_Scan_Line_List_Block := P_Sll_Block_In;  
        Top         : S_Natural;  
        Bottom      : S_Natural;  
        Prev_Pt     : S_Natural;  
        I_Sll_Block : S_Natural              := 0;  
        Dy          : S_Long;  
        P_Etes_I    : S_Natural              := P_Etes'First;  
    begin

        if Pts'Length < 2 then  
            return;  
        end if;

----Initialize the Active Edge Table

        Aet.Next            := null;  
        Aet.Back            := null;  
        Aet.Next_Wete       := null;  
        Aet.Bres.Minor_Axis := Small_Coordinate;

----Initialize the Edge Table.

        Et.Scan_Lines.Next := null;  
        Et.Y_Max           := Small_Coordinate;  
        Et.Y_Min           := Large_Coordinate;  
        P_Sll_Block.Next   := null;

        Prev_Pt := Pts'Length - 1;

----For each vertex in the array of points...
--  In this loop we are dealing with two vertices at a time.  These make up
--  one edge of the polygon.

        for Curr_Pt in Pts'First .. Pts'First + Pts'Length - 1 loop

----Find out which point is above and which is below.

            if Pts (Prev_Pt).Y > Pts (Curr_Pt).Y then

                Bottom                       := Prev_Pt;  
                Top                          := Curr_Pt;  
                P_Etes (P_Etes_I).Clock_Wise := Counterclockwise;

            else

                Bottom                       := Curr_Pt;  
                Top                          := Prev_Pt;  
                P_Etes (P_Etes_I).Clock_Wise := Clockwise;

            end if;

----Don't add horizontal edges to the Edge table.

            if Pts (Bottom).Y /= Pts (Top).Y then

                P_Etes (P_Etes_I).Y_Max := S_Long (Pts (Bottom).Y) - 1;
                -- -1 so we don't get last scan_line

----Initialize integer edge algorithm

                Dy := S_Long (Pts (Bottom).Y) - S_Long (Pts (Top).Y);  
                B_Res_Init_Pgon_Struct (Dy, S_Long (Pts (Top).X),  
                                        S_Long (Pts (Bottom).X),  
                                        P_Etes (P_Etes_I).Bres);

                Insert_Edge_In_Et (Et, P_Etes (P_Etes_I), S_Long (Pts (Top).Y),  
                                   P_Sll_Block, I_Sll_Block);

                Et.Y_Max := Max (Et.Y_Max, S_Long (Pts (Prev_Pt).Y));  
                Et.Y_Min := Min (Et.Y_Min, S_Long (Pts (Prev_Pt).Y));  
                P_Etes_I := P_Etes_I + 1;

            end if;

            Prev_Pt := Curr_Pt;  
        end loop;

    end Create_Et_And_Aet;

--\x0c
    procedure Load_Aet (Aet_In  : X_Edge_Table_Entry;  
                        Etes_In : X_Edge_Table_Entry) is
------------------------------------------------------------------------------
--     load_AET
--
--     This routine moves Edge_Table_Entries from the
--     Edge_Table into the Active Edge Table,
--     leaving them sorted by smaller x coordinate.
--
------------------------------------------------------------------------------
        Aet        : X_Edge_Table_Entry := Aet_In;  
        Etes       : X_Edge_Table_Entry := Etes_In;  
        P_Prev_Aet : X_Edge_Table_Entry;  
        Tmp        : X_Edge_Table_Entry;  
    begin

        P_Prev_Aet := Aet;  
        Aet        := Aet.Next;  
        while Etes /= null loop

            while Aet /= null and then  
                     Aet.Bres.Minor_Axis < Etes.Bres.Minor_Axis loop  
                P_Prev_Aet := Aet;  
                Aet        := Aet.Next;  
            end loop;

            Tmp       := Etes.Next;  
            Etes.Next := Aet;  
            if Aet /= null then  
                Aet.Back := Etes;  
            end if;  
            Etes.Back       := P_Prev_Aet;  
            P_Prev_Aet.Next := Etes;  
            P_Prev_Aet      := Etes;

            Etes := Tmp;

        end loop;

    end Load_Aet;

--\x0c
    procedure Compute_Waet (Aet_In : X_Edge_Table_Entry) is
------------------------------------------------------------------------------
--     compute_WAET
--
--     This routine links the AET by the
--     next_WETE (winding Edge_Table_Entry) link for
--     use by the winding number rule.  The final
--     Active Edge Table (AET) might look something
--     like:
--
--     AET
--     ----------  ---------   ---------
--     |y_max    or  |y_max    or  |y_max    or
--     or ...    or  |...     or  |...     |
--     |next    |.|next    |.|next    |....
--     |next_WETE|  |next_WETE|  |next_WETE|
--     ---------   ---------   ^--------
--         or                   or       |
--         V------------------.       V--. ...
--
------------------------------------------------------------------------------
        P_Wete   : X_Edge_Table_Entry;  
        Aet      : X_Edge_Table_Entry := Aet_In;  
        Inside   : Boolean            := True;  
        Isinside : Integer            := 0;  
    begin

        Aet.Next_Wete := null;  
        P_Wete        := Aet;  
        Aet           := Aet.Next;  
        while Aet /= null loop  
            if Aet.Clock_Wise = Clockwise then  
                Isinside := Isinside + 1;  
            else  
                Isinside := Isinside - 1;  
            end if;

            if (not Inside and then Isinside = 0) or else  
               (Inside and then Isinside /= 0) then  
                P_Wete.Next_Wete := Aet;  
                P_Wete           := Aet;  
                Inside           := not Inside;  
            end if;  
            Aet := Aet.Next;  
        end loop;  
        P_Wete.Next_Wete := null;

    end Compute_Waet;

--\x0c
    function Insertion_Sort (Aet_In : X_Edge_Table_Entry) return Boolean is
------------------------------------------------------------------------------
--     Insertion_Sort
--
--     Just a simple insertion sort using
--     pointers and back pointers to sort the Active
--     Edge Table.
------------------------------------------------------------------------------
        Aet                  : X_Edge_Table_Entry := Aet_In;  
        P_Ete_Chase          : X_Edge_Table_Entry;  
        P_Ete_Insert         : X_Edge_Table_Entry;  
        P_Ete_Chase_Back_Tmp : X_Edge_Table_Entry;  
        Changed              : Boolean            := False;  
    begin

        Aet := Aet.Next;  
        while Aet /= null loop  
            P_Ete_Insert := Aet;  
            P_Ete_Chase  := Aet;  
            while P_Ete_Chase.Back.Bres.Minor_Axis > Aet.Bres.Minor_Axis loop  
                P_Ete_Chase := P_Ete_Chase.Back;  
            end loop;

            Aet := Aet.Next;  
            if P_Ete_Chase /= P_Ete_Insert then  
                P_Ete_Chase_Back_Tmp   := P_Ete_Chase.Back;  
                P_Ete_Insert.Back.Next := Aet;  
                if Aet /= null then  
                    Aet.Back := P_Ete_Insert.Back;  
                end if;  
                P_Ete_Insert.Next     := P_Ete_Chase;  
                P_Ete_Chase.Back.Next := P_Ete_Insert;  
                P_Ete_Chase.Back      := P_Ete_Insert;  
                P_Ete_Insert.Back     := P_Ete_Chase_Back_Tmp;  
                Changed               := True;  
            end if;  
        end loop;  
        return Changed;

    end Insertion_Sort;

--\x0c
    procedure Pts_To_Region (Num_Full_Pt_Blocks_In :     S_Natural;  
                             I_Cur_Pt_Block        :     S_Natural;  
                             First_Pt_Block        :     X_Point_Block;  
                             Reg                   :     X_Region;  
                             Success               : out Boolean) is
------------------------------------------------------------------------------
--     Create an array of rectangles from a list of points.
--     If indeed these things (POINTS, RECTS) are the same,
--     then this proc is still needed, because it allocates
--     storage for the array, which was allocated on the
--     stack by the calling procedure.
------------------------------------------------------------------------------
        Num_Full_Pt_Blocks : S_Natural := Num_Full_Pt_Blocks_In;  
        Rects              : S_Natural;  
        Cur_Pt_Block       : X_Point_Block;  
        Extents            : X_Box_Rec renames Reg.Extents;  
        Num_Rects          : S_Natural;  
    begin

        Num_Rects :=  
           (Num_Full_Pt_Blocks * X_Num_Pts_To_Buffer + I_Cur_Pt_Block) / 2;

        begin  
            Reg.Rects := new X_Box_Array (1 .. Num_Rects);  
        exception  
            when Storage_Error =>  
                Success := False;  
                return;  
        end;

        Reg.Size     := Num_Rects;  
        Cur_Pt_Block := First_Pt_Block;  
        Rects        := 1;

        Extents.X1 := Max_Short;  
        Extents.X2 := Min_Short;

        while Num_Full_Pt_Blocks /= 0 loop  
            Num_Full_Pt_Blocks := Num_Full_Pt_Blocks - 1;  
            for I in 1 .. S_Natural (X_Num_Pts_To_Buffer) / 2 loop
                -- the loop uses 2 points per iteration
                declare  
                    Pts  : X_Point renames Cur_Pt_Block.Pts  
                                              (Cur_Pt_Block.Pts'First - 1 + I);  
                    Pts1 : X_Point renames Cur_Pt_Block.Pts  
                                              (Cur_Pt_Block.Pts'First + I);  
                    Rect : X_Box_Rec renames Reg.Rects (Rects);  
                begin  
                    Rect.X1 := Pts.X;  
                    Rect.Y1 := Pts.Y;  
                    if Pts1.X = Rect.X1 then  
                        Num_Rects := Num_Rects - 1;  
                    else  
                        Rect.X2    := Pts1.X;  
                        Rect.Y2    := Pts1.Y + 1;  
                        Extents.X1 := Min (Extents.X1, Pts.X);  
                        Extents.X2 := Max (Extents.X2, Pts1.X);  
                        Rects      := Rects + 1;  
                    end if;  
                end;  
            end loop;  
            Cur_Pt_Block := Cur_Pt_Block.Next;  
        end loop;

        if I_Cur_Pt_Block /= 0 then  
            for I in 1 .. I_Cur_Pt_Block / 2 loop  
                while I_Cur_Pt_Block /= 0 loop  
                    declare  
                        Pts  : X_Point  
                            renames Cur_Pt_Block.Pts  
                                       (Cur_Pt_Block.Pts'First - 2 + 2 * I);  
                        Pts1 : X_Point  
                            renames Cur_Pt_Block.Pts  
                                       (Cur_Pt_Block.Pts'First - 1 + 2 * I);  
                        Rect : X_Box_Rec renames Reg.Rects (Rects);  
                    begin  
                        Rect.X1 := Pts.X;  
                        Rect.Y1 := Pts.Y;  
                        if Pts1.X = Rect.X1 then  
                            Num_Rects := Num_Rects - 1;  
                        else  
                            Rect.X2    := Pts1.X;  
                            Rect.Y2    := Pts1.Y + 1;  
                            Extents.X1 := Min (Extents.X1, Pts.X);  
                            Extents.X2 := Max (Extents.X2, Pts1.X);  
                            Rects      := Rects + 1;  
                        end if;  
                    end;  
                end loop;  
            end loop;  
            if Num_Rects > 0 then  
                Extents.Y1 := Reg.Rects (0).Y1;  
                Extents.Y2 := Cur_Pt_Block.Pts (Cur_Pt_Block.Pts'First +  
                                                I_Cur_Pt_Block).Y + 1;  
            end if;  
        end if;

        Reg.Num_Rects := Num_Rects;  
        Reg.Size      := Reg.Num_Rects;

        Success := True;

    end Pts_To_Region;

--\x0c
    function X_Polygon_Region (Points : X_Point_Array;  
                               Rule   : X_Fill_Rule) return X_Region is
------------------------------------------------------------------------------
-- poly_to_region
--
-- Scan converts a polygon by returning a run-length encoding of the resultant
-- bitmap -- the run-length encoding is in the form of an array of rectangles.
------------------------------------------------------------------------------
        Regn       : X_Region;  
        Y          : S_Long;                -- current scan line
        P_Aet      : X_Edge_Table_Entry;    -- Active Edge Table
        I_Pts      : S_Natural := 0;        -- number of points in buffer
        P_Wete     : X_Edge_Table_Entry;    -- Winding Edge Table Entry
        P_Sll      : X_Scan_Line_List;      -- current scan_Line_List
        L_Pts      : X_Point_Block;         -- output buffer
        L_I_Pts    : S_Natural;  
        P_Prev_Aet : X_Edge_Table_Entry;    -- ptr to previous AET
        Et         : X_Edge_Table;          -- header node for ET
        Aet        : X_Edge_Table_Entry;    -- header node for AET

        P_Etes    : X_Edge_Table_Entry_Array (1 .. Points'Length);-- ETE pool
        Sll_Block : X_Scan_Line_List_Block; -- header for scan_line_list

        Fix_Waet           : Boolean   := False;  
        First_Pt_Block     : X_Point_Block;  
        Cur_Pt_Block       : X_Point_Block; -- Pt_Block buffers
        Tmp_Pt_Block       : X_Point_Block;  
        Num_Full_Pt_Blocks : S_Natural := 0;  
        Void               : Boolean;  
    begin

        Regn := X_Create_Region;  
        if Regn = None_X_Region then  
            return None_X_Region;  
        end if;

----Special case a rectangle.

        I_Pts := Points'First;  
        if (Points'Length = 4 or else  
            (Points'Length = 5 and then  
             Points (4).X = Points (0).X and then  
             Points (4).Y = Points (0).Y)) and then  
           ((Points (0).Y = Points (1).Y and then  
             Points (1).X = Points (2).X and then  
             Points (2).Y = Points (3).Y and then  
             Points (3).X = Points (0).X) or else  
            (Points (0).X = Points (1).X and then  
             Points (1).Y = Points (2).Y and then  
             Points (2).X = Points (3).X and then  
             Points (3).Y = Points (0).Y)) then  
            Regn.Extents.X1 := Min (Points (0).X, Points (2).X);  
            Regn.Extents.Y1 := Min (Points (0).Y, Points (2).Y);  
            Regn.Extents.X2 := Max (Points (0).X, Points (2).X);  
            Regn.Extents.Y2 := Max (Points (0).Y, Points (2).Y);  
            if Regn.Extents.X1 /= Regn.Extents.X2 and then  
               Regn.Extents.Y1 /= Regn.Extents.Y2 then  
                Regn.Num_Rects := 1;  
                Regn.Rects     := new X_Box_Array'(1 => Regn.Extents);  
            end if;  
            return Regn;  
        end if;

        First_Pt_Block := new X_Point_Block_Rec;  
        L_Pts          := First_Pt_Block;  
        L_I_Pts        := L_Pts.Pts'First;  
        Create_Et_And_Aet (Points, Et, Aet, P_Etes, Sll_Block);  
        P_Sll        := Et.Scan_Lines.Next;  
        Cur_Pt_Block := First_Pt_Block;

        if Rule = Even_Odd_Rule then

----For each scan_line....

            Y := Et.Y_Min;  
            while Y < Et.Y_Max loop

----Add a new edge to the active edge table when we get to the next edge.

                if P_Sll /= null and then Y = P_Sll.Scan_Line then  
                    Load_Aet (Aet, P_Sll.Edgelist);  
                    P_Sll := P_Sll.Next;  
                end if;  
                P_Prev_Aet := Aet;  
                P_Aet      := Aet.Next;

----For each active edge....

                while P_Aet /= null loop  
                    L_Pts.Pts (L_I_Pts).X := S_Short (P_Aet.Bres.Minor_Axis);  
                    L_Pts.Pts (L_I_Pts).Y := S_Short (Y);  
                    L_I_Pts               := L_I_Pts + 1;  
                    I_Pts                 := I_Pts + 1;

----Send out the buffer.

                    if I_Pts = X_Num_Pts_To_Buffer then  
                        Tmp_Pt_Block       := new X_Point_Block_Rec;  
                        Cur_Pt_Block.Next  := Tmp_Pt_Block;  
                        Cur_Pt_Block       := Tmp_Pt_Block;  
                        L_Pts              := Cur_Pt_Block;  
                        L_I_Pts            := L_Pts.Pts'First;  
                        Num_Full_Pt_Blocks := Num_Full_Pt_Blocks + 1;  
                        I_Pts              := 0;  
                    end if;  
                    Evaluate_Edge_Even_Odd (P_Aet, P_Prev_Aet, Y);  
                end loop;  
                Void := Insertion_Sort (Aet);  
                Y    := Y + 1;  
            end loop;

        else

----For each scan_line....

            for Y in Et.Y_Min .. Et.Y_Max - 1 loop

----Add a new edge to the active edge table when we get to the next edge.

                if P_Sll /= null and then Y = P_Sll.Scan_Line then  
                    Load_Aet (Aet, P_Sll.Edgelist);  
                    Compute_Waet (Aet);  
                    P_Sll := P_Sll.Next;  
                end if;  
                P_Prev_Aet := Aet;  
                P_Aet      := Aet.Next;  
                P_Wete     := P_Aet;

----For each active edge....

                while P_Aet /= null loop

----Add to the buffer only those edges that are in the Winding active edge table.

                    if P_Wete = P_Aet then  
                        L_Pts.Pts (L_I_Pts).X :=  
                           S_Short (P_Aet.Bres.Minor_Axis);  
                        L_Pts.Pts (L_I_Pts).Y := S_Short (Y);  
                        L_I_Pts               := L_I_Pts + 1;  
                        I_Pts                 := I_Pts + 1;

----Send out the buffer

                        if I_Pts = X_Num_Pts_To_Buffer then  
                            Tmp_Pt_Block       := new X_Point_Block_Rec;  
                            Cur_Pt_Block.Next  := Tmp_Pt_Block;  
                            Cur_Pt_Block       := Tmp_Pt_Block;  
                            L_Pts              := Cur_Pt_Block;  
                            L_I_Pts            := L_Pts.Pts'First;  
                            Num_Full_Pt_Blocks := Num_Full_Pt_Blocks + 1;  
                            I_Pts              := 0;  
                        end if;  
                        P_Wete := P_Wete.Next_Wete;  
                    end if;  
                    Evaluate_Edge_Winding (P_Aet, P_Prev_Aet, Y, Fix_Waet);  
                end loop;

----Recompute the winding active edge table if we just resorted or have exited
--  an edge.

                if Insertion_Sort (Aet) or else Fix_Waet then  
                    Compute_Waet (Aet);  
                    Fix_Waet := False;  
                end if;  
            end loop;  
        end if;  
        Free_X_Scan_Line_List_Block (Sll_Block.Next);  
        Pts_To_Region (Num_Full_Pt_Blocks, I_Pts, First_Pt_Block, Regn, Void);

----Free up storage used.

        Tmp_Pt_Block := First_Pt_Block.Next;  
        loop  
            Free_X_Point_Block (First_Pt_Block);  
            First_Pt_Block := Tmp_Pt_Block;  
            if First_Pt_Block = null then  
                exit;  
            end if;  
            Tmp_Pt_Block := First_Pt_Block.Next;  
        end loop;  
        return Regn;

    exception

        when others =>  
            Free_X_Region (Regn);  
            while First_Pt_Block /= null loop  
                Tmp_Pt_Block := First_Pt_Block.Next;  
                Free_X_Point_Block (First_Pt_Block);  
                First_Pt_Block := Tmp_Pt_Block;  
            end loop;  
            raise;

    end X_Polygon_Region;

--\x0c
    function Max (A, B : S_Natural) return S_Natural is  
    begin  
        if A > B then  
            return A;  
        else  
            return B;  
        end if;  
    end Max;

--/ if INLINE then
--//     pragma Inline (Max);
--/ end if;

--\x0c
    --
-- The functions in this file implement the Region abstraction used extensively
-- throughout the X11 sample server. A Region is simply an area, as the name
-- implies, and is implemented as a "y-x-banded" array of rectangles. To
-- explain: Each Region is made up of a certain number of rectangles sorted
-- by y coordinate first, and then by x coordinate.
--
-- Furthermore, the rectangles are banded such that every rectangle with a
-- given upper-left y coordinate (y1) will have the same lower-right y
-- coordinate (y2) and vice versa. If a rectangle has scan_lines in a band, it
-- will span the entire vertical distance of the band. This means that some
-- areas that could be merged into a taller rectangle will be represented as
-- several shorter rectangles to account for shorter rectangles to its left
-- or right but within its "vertical scope".
--
-- An added constraint on the rectangles is that they must cover as much
-- horizontal area as possible. E.g. no two rectangles in a band are allowed
-- to touch.
--
-- Whenever possible, bands will be merged together to cover a greater vertical
-- distance (and thus reduce the number of rectangles). Two bands can be merged
-- only if the bottom of one touches the top of the other and they have
-- rectangles in the same places (of the same width, of course). This maintains
-- the y-x-banding that's so nice to have...
--

--\x0c
    function X_Create_Region return X_Region is
------------------------------------------------------------------------------
--  Create a new empty region
------------------------------------------------------------------------------
        Temp : X_Region;  
    begin

        Temp            := new X_Region_Rec;  
        Temp.Rects      := new X_Box_Array (1 .. 1);  
        Temp.Num_Rects  := 0;  
        Temp.Extents.X1 := 0;  
        Temp.Extents.Y1 := 0;  
        Temp.Extents.X2 := 0;  
        Temp.Extents.Y2 := 0;  
        Temp.Size       := 1;  
        return Temp;

    exception  
        when others =>  
            Free_X_Region (Temp);  
            raise;  
    end X_Create_Region;

--\x0c
    procedure X_Clip_Box (Region    :     X_Region;  
                          Rectangle : out X_Rectangle) is  
    begin  
        Rectangle.X      := Region.Extents.X1;  
        Rectangle.Y      := Region.Extents.Y1;  
        Rectangle.Width  := U_Short (Region.Extents.X2 - Region.Extents.X1);  
        Rectangle.Height := U_Short (Region.Extents.Y2 - Region.Extents.Y1);  
    end X_Clip_Box;

--\x0c
    procedure X_Union_Rect_With_Region (Rectangle  : X_Rectangle;  
                                        Region     : X_Region;  
                                        New_Region : X_Region) is  
        Lregion : X_Region;  
    begin

        Lregion            := new X_Region_Rec;  
        Lregion.Extents.X1 := Rectangle.X;  
        Lregion.Extents.Y1 := Rectangle.Y;  
        Lregion.Extents.X2 := Rectangle.X + S_Short (Rectangle.Width);  
        Lregion.Extents.Y2 := Rectangle.Y + S_Short (Rectangle.Height);  
        Lregion.Size       := 1;  
        Lregion.Rects      := new X_Box_Array'(1 => Region.Extents);  
        Lregion.Num_Rects  := 1;

        X_Union_Region (Lregion, Region, New_Region);

        Free_X_Region (Lregion);  
        Free_X_Box_List (Lregion.Rects);

    exception  
        when others =>  
            Free_X_Region (Lregion);  
            raise;  
    end X_Union_Rect_With_Region;

--\x0c
    procedure Mi_Set_Extents (P_Reg : X_Region) is
-------------------------------------------------------------------------
-- mi_Set_Extents --
--  Reset the extents of a region to what they should be. Called by
--  mi_Subtract and mi_Intersect b/c they can't figure it out along the
--  way or do so easily, as mi_Union can.
--
-- Results:
--  None.
--
-- Side Effects:
--  The region's 'extents' structure is overwritten.
--
-------------------------------------------------------------------------
        P_Extents : X_Box_Rec  renames P_Reg.Extents;  
        P_Box     : X_Box_List renames P_Reg.Rects;  
    begin

----No rectangles means no extents.

        if P_Reg.Num_Rects = 0 then  
            P_Extents.X1 := 0;  
            P_Extents.Y1 := 0;  
            P_Extents.X2 := 0;  
            P_Extents.Y2 := 0;  
            return;  
        end if;

----Since p_Box is the first rectangle in the region, it must have the smallest
--  y1 and since p_Box_End is the last rectangle in the region, it must have
--  the largest y2, because of banding.  Initialize x1 and x2 from p_Box and
--  p_Box_End, resp., as good things to initialize them to...

        P_Extents.X1 := P_Box (1).X1;  
        P_Extents.Y1 := P_Box (1).Y1;  
        P_Extents.X2 := P_Box (P_Reg.Num_Rects).X2;  
        P_Extents.Y2 := P_Box (P_Reg.Num_Rects).Y2;

--/ if DEBUG then
        if not (P_Extents.Y1 < P_Extents.Y2) then  
            raise X_Library_Confusion;  
        end if;
--/ end if;

        for Pbi in 1 .. P_Reg.Num_Rects loop  
            if P_Box (Pbi).X1 < P_Extents.X1 then  
                P_Extents.X1 := P_Box (Pbi).X1;  
            end if;  
            if P_Box (Pbi).X2 > P_Extents.X2 then  
                P_Extents.X2 := P_Box (Pbi).X2;  
            end if;  
        end loop;

--/ if DEBUG then
        if not (P_Extents.X1 < P_Extents.X2) then  
            raise X_Library_Confusion;  
        end if;
--/ end if;

    end Mi_Set_Extents;

--\x0c
    procedure X_Set_Region (Display : X_Display;  
                            Gc      : X_Gc;  
                            Region  : X_Region) is  
        X_R : X_Rectangle_Array (1 .. Region.Num_Rects);  
    begin

        for I in X_R'Range loop  
            X_R (I).X      := Region.Rects (I).X1;  
            X_R (I).Y      := Region.Rects (I).Y1;  
            X_R (I).Width  := U_Short  
                                 (Region.Rects (I).X2 - Region.Rects (I).X1);  
            X_R (I).Height := U_Short  
                                 (Region.Rects (I).Y2 - Region.Rects (I).Y1);  
        end loop;  
        X_Set_Clip_Rectangles (Display, Gc, 0, 0, X_R, Unsorted);

    end X_Set_Region;

--\x0c
    procedure X_Offset_Region (Region : X_Region;  
                               Dx     : S_Short;  
                               Dy     : S_Short) is
------------------------------------------------------------------------------
-- Translate_Region(Region, x, y)
-- translates in place
-- added by raymond
------------------------------------------------------------------------------
        Pbox : X_Box_List renames Region.Rects;  
    begin

        for I in 1 .. Region.Num_Rects loop  
            Pbox (I).X1 := Pbox (I).X1 + Dx;  
            Pbox (I).X2 := Pbox (I).X2 + Dx;  
            Pbox (I).Y1 := Pbox (I).Y1 + Dy;  
            Pbox (I).Y2 := Pbox (I).Y2 + Dy;  
        end loop;  
        Region.Extents.X1 := Region.Extents.X1 + Dx;  
        Region.Extents.X2 := Region.Extents.X2 + Dx;  
        Region.Extents.Y1 := Region.Extents.Y1 + Dy;  
        Region.Extents.Y2 := Region.Extents.Y2 + Dy;

    end X_Offset_Region;

--\x0c
    --   Utility procedure Compress:
--   Replace r by the region r', where
--     p in r' iff (Quantifer m <= dx) (p + m in r), and
--     Quantifier is Exists if grow is TRUE, For all if grow is FALSE, and
--     (x,y) + m = (x+m,y) if xdir is TRUE; (x,y+m) if xdir is FALSE.
--
--   Thus, if xdir is TRUE and grow is FALSE, r is replaced by the region
--   of all points p such that p and the next dx points on the same
--   horizontal scan line are all in r.  We do this using by noting
--   that p is the head of a run of length 2^i + k iff p is the head
--   of a run of length 2^i and p+2^i is the head of a run of length
--   k. Thus, the loop invariant: s contains the region corresponding
--   to the runs of length shift.  r contains the region corresponding
--   to the runs of length 1 + dxo & (shift-1), where dxo is the original
--   value of dx.  dx = dxo & ~(shift-1).  As parameters, s and t are
--   scratch regions, so that we don't have to allocate them on every
--   call.

    procedure Compress (R    : X_Region;  
                        S    : X_Region;  
                        T    : X_Region;  
                        Dx   : S_Short;  
                        Xdir : Boolean;  
                        Grow : Boolean) is

        Shift : S_Short  = 1;  
        Rp    : X_Region := R;  
        Sp    : X_Region := S;  
        Tp    : X_Region := T;  
        Dxi   : S_Short  := Dx;

        procedure Zopregion (A : X_Region; B : X_Region; C : X_Region) is  
        begin  
            if Grow then  
                X_Union_Region (A, B, C);  
            else  
                X_Intersect_Region (A, B, C);  
            end if;  
        end Zopregion;

        procedure Zshiftregion (A : X_Region; B : S_Short) is  
        begin  
            if Xdir then  
                X_Offset_Region (A, B, 0);  
            else  
                X_Offset_Region (A, 0, B);  
            end if;  
        end Zshiftregion;

        procedure Zcopyregion (A : X_Region; B : X_Region) is  
        begin  
            X_Union_Region (A, A, B);  
        end Zcopyregion;

    begin

        Zcopyregion (Rp, Sp);  
        while Dxi /= 0 loop  
            if Dxi mod 2 /= 0 then  
                Zshiftregion (Rp, -Shift);  
                Zopregion (Rp, Sp, Rp);  
                Dxi := Dxi / 2;  
                if Dxi = 0 then  
                    exit;  
                end if;  
            end if;  
            Zcopyregion (Sp, Tp);  
            Zshiftregion (Sp, -Shift);  
            Zopregion (Sp, Tp, Sp);  
            if Dxi /= 0 then
                ----We don't want overflow; dxi /= 0 means this is ok.
                Shift := Shift + Shift;  
            end if;  
        end loop;

    end Compress;

--\x0c
    procedure X_Shrink_Region (Region : X_Region;  
                               Dx     : S_Short;  
                               Dy     : S_Short) is  
        Regioni : X_Region := Region;  
        S       : X_Region;  
        T       : X_Region;  
        Grow    : Boolean;  
        Dxi     : S_Short  := Dx;  
        Dyi     : S_Short  := Dy;  
    begin

        if Dx = 0 and then  
           Dy = 0 then  
            return;  
        end if;  
        S    := new X_Region_Rec;  
        T    := new X_Region_Rec;  
        Grow := Dxi < 0;  
        if Grow then  
            Dxi := -Dxi;  
        end if;  
        if Dxi /= 0 then  
            Compress (Regioni, S, T, 2 * Dxi, True, Grow);  
        end if;  
        Grow := Dyi < 0;  
        if Grow then  
            Dyi := -Dyi;  
        end if;  
        if Dyi /= 0 then  
            Compress (Regioni, S, T, 2 * Dyi, False, Grow);  
        end if;  
        X_Offset_Region (Region, Dxi, Dyi);  
        Free_X_Region (S);  
        Free_X_Region (T);

    exception

        when others =>  
            Free_X_Region (S);  
            Free_X_Region (T);  
            raise;

    end X_Shrink_Region;

--\x0c
    -- #ifdef notdef
-- --**********************************************************
-- --     Bop down the array of rects until we have passed
-- --     scan_line y.  num_Rects is the size of the array.
-- --*********************************************************
--
-- static BOX
-- *Index_Rects(rects, num_Rects, y)
--     BOX *rects;
--     s_long num_Rects;
--     s_long y;
-- {
--      while ((num_Rects--) and then (rects.y2 <= y))
--         rects++;
--      return(rects);
-- }
-- #endif

--\x0c
    --======================================================================
--      Generic Region Operator
--====================================================================

    function Mi_Coalesce  
                (P_Reg         : X_Region; -- Region to coalesce
                 Prev_Start_In : S_Natural;   -- Index of start of previous band
                 Cur_Start_In  : S_Natural)    -- Index of start of current band
                return S_Natural is
-------------------------------------------------------------------------
-- mi_Coalesce --
--  Attempt to merge the boxes in the current band with those in the
--  previous one. Used only by mi_Region_Op.
--
-- Results:
--  The new index for the previous band.
--
-- Side Effects:
--  If coalescing takes place:
--      - rectangles in the previous band will have their y2 fields altered.
--      - p_Reg.num_Rects will be decreased.
--
-------------------------------------------------------------------------
        Prev_Start     : S_Natural := Prev_Start_In;  
        Cur_Start      : S_Natural := Cur_Start_In;  
        P_Prev_Box     : S_Natural;    -- Current box in previous band
        P_Cur_Box      : S_Natural;    -- Current box in current band
        P_Reg_End      : S_Natural;    -- End of regionn
        Cur_Num_Rects  : S_Natural;    -- Number of rectangles in current band
        Prev_Num_Rects : S_Natural;    -- Number of rectangles in previous band
        Bandy1         : S_Short;      -- Y1 coordinate for current band
    begin

        P_Reg_End      := P_Reg.Num_Rects + 1;  
        P_Prev_Box     := Prev_Start;  
        Prev_Num_Rects := Cur_Start - Prev_Start;

----Figure out how many rectangles are in the current band. Have to do this
--  because multiple bands could have been added in mi_Region_Op at the end
--  when one region has been exhausted.

        P_Cur_Box     := Cur_Start;  
        Bandy1        := P_Reg.Rects (P_Cur_Box).Y1;  
        Cur_Num_Rects := 0;  
        while P_Cur_Box < P_Reg_End and then  
                 P_Reg.Rects (P_Cur_Box).Y1 = Bandy1 loop  
            Cur_Num_Rects := Cur_Num_Rects + 1;  
            P_Cur_Box     := P_Cur_Box + 1;  
        end loop;

----If more than one band was added, we have to find the start of the last band
--  added so the next coalescing job can start at the right place... (given when
--  multiple bands are added,  this may be pointless -- see above).

        if P_Cur_Box < P_Reg_End then  
            Cur_Start := P_Reg_End - 1;  
            while P_Reg.Rects (Cur_Start - 1).Y1 =  
                     P_Reg.Rects (Cur_Start).Y1 loop  
                Cur_Start := Cur_Start - 1;  
            end loop;  
        end if;

        if Cur_Num_Rects = Prev_Num_Rects and then Cur_Num_Rects /= 0 then  
            P_Cur_Box := P_Cur_Box - Cur_Num_Rects;

----The bands may only be coalesced if the bottom of the previous matches the
--  top scan_line of the current.

            if P_Reg.Rects (P_Prev_Box).Y2 = P_Reg.Rects (P_Cur_Box).Y1 then

----Make sure the bands have boxes in the same places.  This assumes that boxes
--  have been added in such a way that they cover the most area possible.  I.e.
--  two boxes in a band must have some horizontal space between them.

                loop  
                    if P_Reg.Rects (P_Prev_Box).X1 /=  
                       P_Reg.Rects (P_Cur_Box).X1 or else  
                       P_Reg.Rects (P_Prev_Box).X2 /=  
                          P_Reg.Rects (P_Cur_Box).X2 then

----The bands don't line up so they can't be coalesced.

                        return Cur_Start;  
                    end if;  
                    P_Prev_Box     := P_Prev_Box + 1;  
                    P_Cur_Box      := P_Cur_Box + 1;  
                    Prev_Num_Rects := Prev_Num_Rects - 1;  
                    if Prev_Num_Rects = 0 then  
                        exit;  
                    end if;  
                end loop;

                P_Reg.Num_Rects := P_Reg.Num_Rects - Cur_Num_Rects;  
                P_Cur_Box       := P_Cur_Box - Cur_Num_Rects;  
                P_Prev_Box      := P_Prev_Box - Cur_Num_Rects;

----The bands may be merged, so set the bottom y of each box in the previous
--  band to that of the corresponding box in the current band.

                loop  
                    P_Reg.Rects (P_Prev_Box).Y2 := P_Reg.Rects (P_Cur_Box).Y2;  
                    P_Prev_Box                  := P_Prev_Box + 1;  
                    P_Cur_Box                   := P_Cur_Box + 1;  
                    Cur_Num_Rects               := Cur_Num_Rects - 1;  
                    if Cur_Num_Rects = 0 then  
                        exit;  
                    end if;  
                end loop;

----If only one band was added to the region, we have to backup cur_Start to
--  the start of the previous band.
--
--  If more than one band was added to the region, copy the other bands down.
--  The assumption here is that the other bands came from the same region as
--  the current one and no further coalescing can be done on them since it's
--  all been done already...  Cur_Start is already in the right place.

                if P_Cur_Box = P_Reg_End then  
                    Cur_Start := Prev_Start;  
                else  
                    loop  
                        P_Reg.Rects (P_Prev_Box) := P_Reg.Rects (P_Cur_Box);  
                        P_Prev_Box               := P_Prev_Box + 1;  
                        P_Cur_Box                := P_Cur_Box + 1;  
                        if P_Cur_Box = P_Reg_End then  
                            exit;  
                        end if;  
                    end loop;  
                end if;

            end if;  
        end if;  
        return Cur_Start;

    end Mi_Coalesce;

--\x0c
    generic  
        Overlap_Func_Non_Null      : in Boolean;  
        Non_Overlap1_Func_Non_Null : in Boolean;  
        Non_Overlap2_Func_Non_Null : in Boolean;  
        with procedure Overlap_Func (New_Reg    : X_Region;  
                                     Reg1       : X_Box_List;  
                                     Reg1_Begin : S_Natural;  
                                     Reg1_End   : S_Natural;  
                                     Reg2       : X_Box_List;  
                                     Reg2_Begin : S_Natural;  
                                     Reg2_End   : S_Natural;  
                                     Y_Top      : S_Short;  
                                     Y_Bot      : S_Short);
        -- called for overlapping bands
        with procedure Non_Overlap1_Func (New_Reg    : X_Region;  
                                          Reg1       : X_Box_List;  
                                          Reg1_Begin : S_Natural;  
                                          Reg1_End   : S_Natural;  
                                          Top        : S_Short;  
                                          Bot        : S_Short);
        -- called for non-overlapping bands in region 1
        with procedure Non_Overlap2_Func (New_Reg    : X_Region;  
                                          Reg2       : X_Box_List;  
                                          Reg2_Begin : S_Natural;  
                                          Reg2_End   : S_Natural;  
                                          Top        : S_Short;  
                                          Bot        : S_Short);
        -- called for non-overlapping bands in region 2
    procedure Mi_Region_Op (New_Reg : X_Region; -- Place to store result
                            Reg1    : X_Region; -- First region in operation
                            Reg2    : X_Region); -- 2d region in operation


    procedure Mi_Region_Op (New_Reg : X_Region; -- Place to store result
                            Reg1    : X_Region; -- 1st region in operation
                            Reg2    : X_Region) is -- 2nd region in operation
-------------------------------------------------------------------------
-- mi_Region_Op --
--  Apply an operation to two regions. Called by mi_Union, mi_Inverse,
--  mi_Subtract, mi_Intersect...
--
-- Results:
--  None.
--
-- Side Effects:
--  The new region is overwritten.
--
-- Notes:
--  The idea behind this funct is to view the two regions as sets.  Together
--  they cover a rectangle of area that this funct divides into horizontal
--  bands where points are covered only by one region or by both.  For the
--  first case, the non_Overlap_Func is called with each the band and the
--  band's upper and lower extents.  For the second, the Overlap_Func is
--  called to process the entire band.  It is responsible for clipping the
--  rectangles in the band, though this function provides the boundaries.
--  At the end of each band, the new region is coalesced, if possible, to
--  reduce the number of rectangles in the region.
--
-------------------------------------------------------------------------
        Rects1      : X_Box_List := Reg1.Rects;  
        Rects2      : X_Box_List := Reg2.Rects;  
        R1          : S_Natural;               -- Pointer into 1st region
        R2          : S_Natural;               -- Pointer into 2nd region
        R1_End      : S_Natural;           -- End of 1st region
        R2_End      : S_Natural;           -- End of 2nd region
        Y_Bot       : S_Short;            -- Bottom of intersection
        Y_Top       : S_Short;            -- Top of intersection
        Old_Rects   : X_Box_List;     -- Old rects for new_Reg
        Prev_Band   : S_Natural;        -- Index of start of previous band
                                        --  in new_Reg
        Cur_Band    : S_Natural;         -- Index of start of current band
                                         --  in new_Reg
        R1_Band_End : S_Natural;      -- End of current band in r1
        R2_Band_End : S_Natural;      -- End of current band in r2
        Top         : S_Short;              -- Top of non-overlapping band
        Bot         : S_Short;              -- Bottom of non-overlapping band
    begin

----Initialization:
--  Set r1, r2, r1_End and r2_End appropriately, preserve the important parts
--  of the destination region until the end in case it's one of the two source
--  regions, then mark the "new" region empty, allocating another array of
--  rectangles for it to use.

        R1        := 1;  
        R2        := 1;  
        R1_End    := Reg1.Num_Rects + 1;  
        R2_End    := Reg2.Num_Rects + 1;  
        Old_Rects := New_Reg.Rects;  
        Empty_Region (New_Reg);

----Allocate a reasonable number of rectangles for the new region. The idea is
--  to allocate enough so the individual functions don't need to reallocate and
--  copy the array, which is time consuming, yet we don't have to worry about
--  using too much memory. I hope to be able to nuke the X_realloc() at the end
--  of this funct eventually.

        New_Reg.Size  := Max (Reg1.Num_Rects, Reg2.Num_Rects) * 2;  
        New_Reg.Rects := new X_Box_Array (0 .. New_Reg.Size - 1);

----Initialize y_bot and y_top.  In the upcoming loop, y_bot and y_top serve
--  different functions depending on whether the band being handled is an
--  overlapping or non-overlapping band.
--  In the case of a non-overlapping band (only one of the regions has points
--  in the band), y_bot is the bottom of the most recent intersection and thus
--  clips the top of the rectangles in that band.  y_top is the top of the
--  next intersection between the two regions and serves to clip the bottom of
--  the rectangles in the current band.
--  For an overlapping band where the two regions intersect), y_top clips the
--  top of the rectangles of both regions and y_bot clips the bottoms.

        if Reg1.Extents.Y1 < Reg2.Extents.Y1 then  
            Y_Bot := Reg1.Extents.Y1;  
        else  
            Y_Bot := Reg2.Extents.Y1;  
        end if;

----Prev_Band serves to mark the start of the previous band so rectangles can
--  be coalesced into larger rectangles.  qv. mi_Coalesce, above.  In the
--  beginning, there is no previous band, so prev_Band = cur_Band (cur_Band is
--  set later on, of course, but the first band will always start at index 1).
--  prev_Band and cur_Band must be indices because of the possible expansion,
--  and resultant moving, of the new region's array of rectangles.

        Prev_Band := 1;  
        loop  
            Cur_Band := New_Reg.Num_Rects;

----This algorithm proceeds one source-band (as opposed to a destination band,
--  which is determined by where the two regions intersect) at a time.
--  r1_Band_End and r2_Band_End serve to mark the rectangle after the last one
--  in the current band for their respective regions.

            R1_Band_End := R1;  
            while R1_Band_End < R1_End and then  
                     Rects1 (R1_Band_End).Y1 = Rects1 (R1).Y1 loop  
                R1_Band_End := R1_Band_End + 1;  
            end loop;

            R2_Band_End := R2;  
            while R2_Band_End < R2_End and then  
                     Rects2 (R2_Band_End).Y1 = Rects2 (R2).Y1 loop  
                R2_Band_End := R2_Band_End + 1;  
            end loop;

----First handle the band that doesn't intersect, if any.
--  Note that attention is restricted to one band in the non-intersecting region
--  at once, so if a region has N bands between the current the_position and
--  the next place it overlaps the other, this entire loop will be passed
--  through N times.

            if Rects1 (R1).Y1 < Rects2 (R2).Y1 then

                Top := Max (Rects1 (R1).Y1, Y_Bot);  
                Bot := Min (Rects1 (R1).Y2, Rects2 (R2).Y1);  
                if Non_Overlap1_Func_Non_Null and then  
                   Top /= Bot then  
                    Non_Overlap1_Func (New_Reg, Rects1, R1, R1_Band_End,  
                                       Top, Bot);  
                end if;  
                Y_Top := Rects2 (R2).Y1;

            elsif Rects2 (R2).Y1 < Rects1 (R1).Y1 then

                Top := Max (Rects2 (R2).Y1, Y_Bot);  
                Bot := Min (Rects2 (R2).Y2, Rects1 (R1).Y1);  
                if Non_Overlap2_Func_Non_Null and then  
                   Top /= Bot then  
                    Non_Overlap2_Func (New_Reg, Rects2, R2, R2_Band_End,  
                                       Top, Bot);  
                end if;  
                Y_Top := Rects1 (R1).Y1;

            else  
                Y_Top := Rects1 (R1).Y1;  
            end if;

----If any rectangles got added to the region, try and coalesce them with
--  rectangles from the previous band.  Note we could just do this test in
--  mi_Coalesce, but some machines incur a not inconsiderable cost for
--  function calls, so...

            if New_Reg.Num_Rects /= Cur_Band then  
                Prev_Band := Mi_Coalesce (New_Reg, Prev_Band, Cur_Band + 1);  
            end if;

----Now see if we've hit an intersecting band.  The two bands only intersect
--  if y_bot > y_top.

            Y_Bot    := Min (Rects1 (R1).Y2, Rects2 (R2).Y2);  
            Cur_Band := New_Reg.Num_Rects;  
            if Overlap_Func_Non_Null and then  
               Y_Bot > Y_Top then  
                Overlap_Func (New_Reg,  
                              Rects1, R1, R1_Band_End,  
                              Rects2, R2, R2_Band_End,  
                              Y_Top, Y_Bot);  
            end if;

            if New_Reg.Num_Rects /= Cur_Band then  
                Prev_Band := Mi_Coalesce (New_Reg, Prev_Band, Cur_Band + 1);  
            end if;

----If we've finished with a band (y2 = y_bot) we skip forward in the region to
--  the next band.

            if Rects1 (R1).Y2 = Y_Bot then  
                R1 := R1_Band_End;  
            end if;  
            if Rects2 (R2).Y2 = Y_Bot then  
                R2 := R2_Band_End;  
            end if;  
            if R1 = R1_End or else R2 = R2_End then  
                exit;  
            end if;  
        end loop;

----Deal with whichever region still has rectangles left.

        Cur_Band := New_Reg.Num_Rects;  
        if R1 < R1_End and then Non_Overlap1_Func_Non_Null then

            loop  
                R1_Band_End := R1 + 1;  
                while R1_Band_End < R1_End and then  
                         Rects1 (R1_Band_End).Y1 = Rects1 (R1).Y1 loop  
                    R1_Band_End := R1_Band_End + 1;  
                end loop;  
                Non_Overlap1_Func (New_Reg, Rects1, R1, R1_Band_End,  
                                   Max (Rects1 (R1).Y1, Y_Bot), Rects1 (R1).Y2);  
                R1 := R1_Band_End;  
                if R1 >= R1_End then  
                    exit;  
                end if;  
            end loop;

        elsif R2 < R2_End and then Non_Overlap2_Func_Non_Null then

            loop  
                R2_Band_End := R2 + 1;  
                while R2_Band_End < R2_End and then  
                         Rects2 (R2_Band_End).Y1 = Rects2 (R2).Y1 loop  
                    R2_Band_End := R2_Band_End + 1;  
                end loop;  
                Non_Overlap2_Func (New_Reg, Rects2, R2, R2_Band_End,  
                                   Max (Rects2 (R2).Y1, Y_Bot), Rects2 (R2).Y2);  
                R2 := R2_Band_End;  
                if R2 >= R2_End then  
                    exit;  
                end if;  
            end loop;  
        end if;

        if New_Reg.Num_Rects /= Cur_Band then  
            Prev_Band := Mi_Coalesce (New_Reg, Prev_Band, Cur_Band + 1);  
        end if;

----A bit of cleanup.  To keep regions from growing without bound, we shrink
--  the array of rectangles to match the new number of rectangles in the region.
--  This never goes to 0, however...
--
--  Only do this stuff if the number of rectangles allocated is more than twice
--  the number of rectangles in the region (a simple optimization...).

        if New_Reg.Num_Rects < New_Reg.Size / 2 then  
            if Region_Not_Empty (New_Reg) then  
                New_Reg.Size := New_Reg.Num_Rects;  
                declare  
                    Newa : X_Box_List := new X_Box_Array (1 .. New_Reg.Size);  
                begin  
                    Newa.all := New_Reg.Rects (Newa'Range);  
                    Free_X_Box_List (New_Reg.Rects);  
                    New_Reg.Rects := Newa;  
                end;

----No point in doing the extra work involved in a copy if the region is empty.

            else  
                New_Reg.Size := 1;  
                Free_X_Box_List (New_Reg.Rects);  
                New_Reg.Rects := new X_Box_Array (1 .. 1);  
            end if;  
        end if;  
        Free_X_Box_List (Old_Rects);

    exception

        when others =>  
            if New_Reg.Rects = Old_Rects then  
                Old_Rects := null;  
            end if;  
            Free_X_Box_List (New_Reg.Rects);  
            Free_X_Box_List (Old_Rects);  
            raise;

    end Mi_Region_Op;

--\x0c
    -- procedure Null_Overlap_Func (New_Reg    : X_Region;
    --                              Reg1       : X_Box_List;
    --                              Reg1_Begin : S_Natural;
    --                              Reg1_End   : S_Natural;
    --                              Reg2       : X_Box_List;
    --                              Reg2_Begin : S_Natural;
    --                              Reg2_End   : S_Natural;
    --                              Y_Top      : S_Short;
    --                              Y_Bot      : S_Short) is
    --     -- called for overlapping bands
    -- begin
    --     null;
    -- end Null_Overlap_Func;
    --
    procedure Null_Non_Overlap1_Func (New_Reg    : X_Region;  
                                      Reg1       : X_Box_List;  
                                      Reg1_Begin : S_Natural;  
                                      Reg1_End   : S_Natural;  
                                      Top        : S_Short;  
                                      Bot        : S_Short) is
        -- called for non-overlapping bands in region 1
    begin  
        null;  
    end Null_Non_Overlap1_Func;

    procedure Null_Non_Overlap2_Func (New_Reg    : X_Region;  
                                      Reg2       : X_Box_List;  
                                      Reg2_Begin : S_Natural;  
                                      Reg2_End   : S_Natural;  
                                      Top        : S_Short;  
                                      Bot        : S_Short) is
        -- called for non-overlapping bands in region 2
    begin  
        null;  
    end Null_Non_Overlap2_Func;

--\x0c
    --======================================================================
--      Region Intersection
--====================================================================

    procedure Mi_Intersect_O (P_Reg  : X_Region;  
                              Rects1 : X_Box_List;  
                              R1     : S_Natural;  
                              R1_End : S_Natural;  
                              Rects2 : X_Box_List;  
                              R2     : S_Natural;  
                              R2_End : S_Natural;  
                              Y1     : S_Short;  
                              Y2     : S_Short) is
-------------------------------------------------------------------------
-- mi_Intersect_O --
--  Handle an overlapping band for mi_Intersect.
--
-- Results:
--  None.
--
-- Side Effects:
--  Rectangles may be added to the region.
--
-------------------------------------------------------------------------
        X1   : S_Short;  
        X2   : S_Short;  
        R1_I : S_Natural := 1;  
        R2_I : S_Natural := 1;  
        I    : S_Natural := P_Reg.Num_Rects;  
    begin

        while R1_I < R1_End and then R2_I < R2_End loop

            X1 := Max (Rects1 (R1_I).X1, Rects2 (R2_I).X1);  
            X2 := Min (Rects1 (R1_I).X2, Rects2 (R2_I).X2);

----If there's any overlap between the two rectangles, add that overlap to the
--  new region.  There's no need to check for subsumption because the only way
--  such a need could arise is if some region has two rectangles right next to
--  each other. Since that should never happen...

            if X1 < X2 then
--/ if DEBUG then
                if not (Y1 < Y2) then  
                    raise X_Library_Confusion;  
                end if;
--/ end if;
                P_Reg.Num_Rects    := P_Reg.Num_Rects + 1;  
                I                  := P_Reg.Num_Rects;  
                P_Reg.Rects (I).X1 := X1;  
                P_Reg.Rects (I).Y1 := Y1;  
                P_Reg.Rects (I).X2 := X2;  
                P_Reg.Rects (I).Y2 := Y2;  
            end if;

----Need to advance the pointers.  Shift the one that extends to the right the
--  least, since the other still has a chance to overlap with that region's
--  next rectangle, if you see what I mean.

            if Rects1 (R1_I).X2 < Rects2 (R2_I).X2 then  
                R1_I := R1_I + 1;  
            elsif Rects2 (R2_I).X2 < Rects1 (R1_I).X2 then  
                R2_I := R2_I + 1;  
            else  
                R1_I := R1_I + 1;  
                R2_I := R2_I + 1;  
            end if;  
        end loop;

    end Mi_Intersect_O;

--\x0c
    procedure Mi_Region_Op_Intersect is  
       new Mi_Region_Op  
              (True, False, False,  
               Mi_Intersect_O, Null_Non_Overlap1_Func, Null_Non_Overlap2_Func);

--\x0c
    procedure X_Intersect_Region  
                 (Region1    : X_Region;  
                  Region2    : X_Region;       -- source regions
                  New_Region : X_Region) is -- destination Region
    begin

----Check for trivial reject

        if Region1.Num_Rects = 0 or else Region2.Num_Rects = 0 or else  
           not Extent_Check (Region1.Extents, Region2.Extents) then  
            New_Region.Num_Rects := 0;  
        else  
            Mi_Region_Op_Intersect (New_Region, Region1, Region2);  
        end if;

----Can't alter New_Region's extents before we call mi_Region_Op because it might
--  be one of the source regions and mi_Region_Op depends on the extents of
--  those regions being the same. Besides, this way there's no checking against
--  rectangles that will be nuked due to coalescing, so we have to examine
--  fewer rectangles.

        Mi_Set_Extents (New_Region);

    end X_Intersect_Region;

--\x0c
    procedure Mi_Region_Copy (Dst_Rgn : X_Region;  
                              Rgn     : X_Region) is  
    begin

        if Dst_Rgn /= Rgn --  don't want to copy to itself
            then  
            if Dst_Rgn.Size < Rgn.Num_Rects then  
                if Dst_Rgn.Rects /= null then  
                    Free_X_Box_List (Dst_Rgn.Rects);  
                end if;  
                Dst_Rgn.Rects := new X_Box_Array (1 .. Rgn.Num_Rects);  
                Dst_Rgn.Size  := Rgn.Num_Rects;  
            end if;  
            Dst_Rgn.Num_Rects                  := Rgn.Num_Rects;  
            Dst_Rgn.Extents                    := Rgn.Extents;  
            Dst_Rgn.Rects (1 .. Rgn.Num_Rects) :=  
               Rgn.Rects (1 .. Rgn.Num_Rects);  
        end if;

    end Mi_Region_Copy;

--\x0c
    --     procedure Combine_Regs
--                  (New_Reg : X_Region_internal;
--                   Reg1 : X_Region_internal;
--                   Reg2 : X_Region_internal) is
-- ------------------------------------------------------------------------------
-- -- if one region is above or below the other.
-- ------------------------------------------------------------------------------
--         Temp_Reg : X_Region_internal;
--         Rects : s_natural;
--         Rects1 : s_natural;
--         Rects2 : s_natural;
--         Total : s_natural;
--     begin
--
--         Rects1 := 1;
--         Rects2 := 1;
--
--         Total := Reg1.Num_Rects + Reg2.Num_Rects;
--         Temp_Reg := X_Create_Region;
--         Temp_Reg.Size := Total;
--
-- ----Region 1 is below region 2
--
--         if Reg1.Extents.Y1 > Reg2.Extents.Y1 then
--             Mi_Region_Copy (Temp_Reg, Reg2);
--             Rects := Temp_Reg.Num_Rects + 1;
--             for I in 0 .. Total - Temp_Reg.Num_Rects - 1 loop
--                 Temp_Reg.Rects (Rects + I) := Reg1.Rects (Rects1 + I);
--             end loop;
--         else
--             Mi_Region_Copy (Temp_Reg, Reg1);
--             Rects := Temp_Reg.Num_Rects + 1;
--             for I in 0 .. Total - Temp_Reg.Num_Rects - 1 loop
--                 Temp_Reg.Rects (Rects + 1) := Reg2.Rects (Rects2 + 1);
--             end loop;
--         end if;
--
--         Temp_Reg.Extents := Reg1.Extents;
--         Temp_Reg.Num_Rects := Total;
--         Extents (Reg2.Extents, Temp_Reg);
--         Mi_Region_Copy (New_Reg, Temp_Reg);
--         Free_X_Region_internal (Temp_Reg);
--
--     end Combine_Regs;


-- #ifdef notdef
-- --
-- --  Quick_Check checks to see if it does not have to go through all the
-- --  the ugly code for the region call.  It returns 1 if it did all
-- --  the work for Union, otherwise 0 - still work to be done.
--  --
--
-- static int
-- Quick_Check(new_Reg, reg1, reg2)
--     Region new_Reg, reg1, reg2;
-- {
--
--     --  if unioning with itself or no rects to union with
--     if ( (reg1 = reg2) or else (!(reg1.num_Rects)) )
--     {
--         mi_Region_Copy(new_Reg, reg2);
--         return(TRUE);
--     }
--
--     --   if nothing to union
--     if (!(reg2.num_Rects))
--     {
--         mi_Region_Copy(new_Reg, reg1);
--         return(TRUE);
--     }
--
--     --   could put an extent check to see if add above or below
--
--     if ((reg1.extents.y1 >= reg2.extents.y2)  or else
--         (reg2.extents.y1 >= reg1.extents.y2) )
--     {
--         combine_Regs(new_Reg, reg1, reg2);
--         return(TRUE);
--     }
--     return(FALSE);
-- }
-- #endif
--
-- #ifdef notdef
-- --   Top_Rects(rects, reg1, reg2)
-- -- N.B. We now assume that reg1 and reg2 intersect.  Therefore we are
-- -- NOT checking in the two while loops for stepping off the end of the
-- -- region.
-- --
--
-- static int
-- Top_Rects(new_Reg, rects, reg1, reg2, First_Rect)
--     Region new_Reg;
--     box_ptr rects;
--     Region reg1;
--     Region reg2;
--     box_ptr First_Rect;
-- {
--     box_ptr temp_Rects;
--
--     --  need to add some rects from region 1
--     if (reg1.extents.y1 < reg2.extents.y1)
--     {
--         temp_Rects := reg1.rects;
--         while(temp_Rects.y1 < reg2.extents.y1)
--     {
--         MEM_CHECK(new_Reg, rects, First_Rect);
--             ADD_RECT_NOX(new_Reg,rects, temp_Rects.x1, temp_Rects.y1,
--                temp_Rects.x2, MIN(temp_Rects.y2, reg2.extents.y1));
--             temp_Rects++;
--     }
--     }
--     --  need to add some rects from region 2
--     if (reg2.extents.y1 < reg1.extents.y1)
--     {
--         temp_Rects := reg2.rects;
--         while (temp_Rects.y1 < reg1.extents.y1)
--         {
--             MEM_CHECK(new_Reg, rects, First_Rect);
--             ADD_RECT_NOX(new_Reg, rects, temp_Rects.x1,temp_Rects.y1,
--                temp_Rects.x2, MIN(temp_Rects.y2, reg1.extents.y1));
--             temp_Rects++;
--     }
--     }
--     return(1);
-- }
-- #endif

--\x0c
    --======================================================================
--      Region Union
--====================================================================

    procedure Mi_Union_Non_O (P_Reg : X_Region;  
                              Rects : X_Box_List;  
                              R     : S_Natural;  
                              R_End : S_Natural;  
                              Y1    : S_Short;  
                              Y2    : S_Short) is
-------------------------------------------------------------------------
-- mi_Union_Non_O --
--  Handle a non-overlapping band for the union operation. Just
--  Adds the rectangles into the region. Doesn't have to check for
--  subsumption or anything.
--
-- Results:
--  None.
--
-- Side Effects:
--  p_Reg.num_Rects is incremented and the final rectangles overwritten
--  with the rectangles we're passed.
--
-------------------------------------------------------------------------
        I : S_Natural;  
    begin

--/ if DEBUG then
        if not (Y1 < Y2) then  
            raise X_Library_Confusion;  
        end if;
--/ end if;

        for Ri in R .. R_End - 1 loop
--/ if DEBUG then
            if not (Rects (Ri).X1 < Rects (Ri).X2) then  
                raise X_Library_Confusion;  
            end if;
--/ end if;
            P_Reg.Num_Rects    := P_Reg.Num_Rects + 1;  
            I                  := P_Reg.Num_Rects;  
            P_Reg.Rects (I).X1 := Rects (Ri).X1;  
            P_Reg.Rects (I).Y1 := Y1;  
            P_Reg.Rects (I).X2 := Rects (Ri).X2;  
            P_Reg.Rects (I).Y2 := Y2;  
        end loop;

    end Mi_Union_Non_O;

--\x0c
    procedure Mi_Union_O (P_Reg  : X_Region;  
                          Rects1 : X_Box_List;  
                          R1     : S_Natural;  
                          R1_End : S_Natural;  
                          Rects2 : X_Box_List;  
                          R2     : S_Natural;  
                          R2_End : S_Natural;  
                          Y1     : S_Short;  
                          Y2     : S_Short) is
-------------------------------------------------------------------------
-- mi_Union_O --
--  Handle an overlapping band for the union operation. Picks the
--  left-most rectangle each time and merges it into the region.
--
-- Results:
--  None.
--
-- Side Effects:
--  Rectangles are overwritten in p_Reg.rects and p_Reg.num_Rects will
--  be changed.
--
-------------------------------------------------------------------------
        I    : S_Natural;  
        R1_I : S_Natural := R1;  
        R2_I : S_Natural := R2;

        procedure Merge_Rect (R : X_Box_List; Ri : in out S_Natural) is  
        begin  
            if I /= 0 and then P_Reg.Rects (I - 1).Y1 = Y1 and then  
               P_Reg.Rects (I - 1).Y2 = Y2 and then  
               P_Reg.Rects (I - 1).X2 >= R (Ri).X1 then  
                if P_Reg.Rects (I - 1).X2 < R (Ri).X2 then  
                    P_Reg.Rects (I - 1).X2 := R (R1).X2;
--/ if DEBUG then
                    if not (P_Reg.Rects (I - 1).X1 <  
                            P_Reg.Rects (I - 1).X2) then  
                        raise X_Library_Confusion;  
                    end if;
--/ end if;
                end if;  
            else  
                P_Reg.Num_Rects    := P_Reg.Num_Rects + 1;  
                I                  := P_Reg.Num_Rects;  
                P_Reg.Rects (I).Y1 := Y1;  
                P_Reg.Rects (I).Y2 := Y2;  
                P_Reg.Rects (I).X1 := R (Ri).X1;  
                P_Reg.Rects (I).X2 := R (Ri).X2;  
            end if;  
            Ri := Ri + 1;  
        end Merge_Rect;

    begin

        I := P_Reg.Num_Rects;


--/ if DEBUG then
        if not (Y1 < Y2) then  
            raise X_Library_Confusion;  
        end if;
--/ end if;
        while R1_I < R1_End and then R2_I < R2_End loop  
            if Rects1 (R1_I).X1 < Rects2 (R2_I).X1 then  
                Merge_Rect (Rects1, R1_I);  
            else  
                Merge_Rect (Rects2, R2_I);  
            end if;  
        end loop;

        if R1_I < R1_End then  
            loop  
                Merge_Rect (Rects1, R1_I);  
                if R1 = R1_End then  
                    exit;  
                end if;  
            end loop;  
        else  
            while R2 < R2_End loop  
                Merge_Rect (Rects2, R2_I);  
            end loop;  
        end if;

    end Mi_Union_O;

--\x0c
    procedure Mi_Region_Op_Union is  
       new Mi_Region_Op  
              (True, True, True,  
               Mi_Union_O, Mi_Union_Non_O, Mi_Union_Non_O);

--\x0c
    procedure X_Union_Region (Region1    : X_Region;  
                              Region2    : X_Region;        -- source regions
                              New_Region : X_Region) is  -- destination regions
    begin

----Checks all the simple cases

----Region 1 and 2 are the same or region 1 is empty

        if Region1 = Region2 or else Region1.Num_Rects = 0 then  
            if New_Region /= Region2 then  
                Mi_Region_Copy (New_Region, Region2);  
            end if;  
            return;  
        end if;

----If nothing to union (region 2 empty)

        if Region2.Num_Rects = 0 then  
            if New_Region /= Region1 then  
                Mi_Region_Copy (New_Region, Region1);  
            end if;  
            return;  
        end if;

----Region 1 completely subsumes region 2

        if Region1.Num_Rects = 1 and then  
           Region1.Extents.X1 <= Region2.Extents.X1 and then  
           Region1.Extents.Y1 <= Region2.Extents.Y1 and then  
           Region1.Extents.X2 >= Region2.Extents.X2 and then  
           Region1.Extents.Y2 >= Region2.Extents.Y2 then  
            if New_Region /= Region1 then  
                Mi_Region_Copy (New_Region, Region1);  
            end if;  
            return;  
        end if;

----Region 2 completely subsumes region 1

        if Region2.Num_Rects = 1 and then  
           Region2.Extents.X1 <= Region1.Extents.X1 and then  
           Region2.Extents.Y1 <= Region1.Extents.Y1 and then  
           Region2.Extents.X2 >= Region1.Extents.X2 and then  
           Region2.Extents.Y2 >= Region1.Extents.Y2 then  
            if New_Region /= Region2 then  
                Mi_Region_Copy (New_Region, Region2);  
            end if;  
            return;  
        end if;

        Mi_Region_Op_Union (New_Region, Region1, Region2);

        New_Region.Extents.X1 := Min (Region1.Extents.X1, Region2.Extents.X1);  
        New_Region.Extents.Y1 := Min (Region1.Extents.Y1, Region2.Extents.Y1);  
        New_Region.Extents.X2 := Max (Region1.Extents.X2, Region2.Extents.X2);  
        New_Region.Extents.Y2 := Max (Region1.Extents.Y2, Region2.Extents.Y2);

    end X_Union_Region;


--\x0c
    --======================================================================
--            Region Subtraction
--====================================================================

    procedure Mi_Subtract_Non_O1 (P_Reg : X_Region;  
                                  Rects : X_Box_List;  
                                  R     : S_Natural;  
                                  R_End : S_Natural;  
                                  Y1    : S_Short;  
                                  Y2    : S_Short) is
-------------------------------------------------------------------------
-- mi_Subtract_Non_O --
--  Deal with non-overlapping band for subtraction. Any parts from
--  region 2 we discard.  Anything from region 1 we add to the region.
--
-- Results:
--  None.
--
-- Side Effects:
--  p_Reg may be affected.
--
-------------------------------------------------------------------------
        I : S_Natural;  
    begin

--/ if DEBUG then
        if not (Y1 < Y2) then  
            raise X_Library_Confusion;  
        end if;
--/ end if;

        for Ri in R .. R_End - 1 loop
--/ if DEBUG then
            if not (Rects (Ri).X1 < Rects (Ri).X2) then  
                raise X_Library_Confusion;  
            end if;
--/ end if;
            P_Reg.Num_Rects    := P_Reg.Num_Rects + 1;  
            I                  := P_Reg.Num_Rects;  
            P_Reg.Rects (I).X1 := Rects (Ri).X1;  
            P_Reg.Rects (I).Y1 := Y1;  
            P_Reg.Rects (I).X2 := Rects (Ri).X2;  
            P_Reg.Rects (I).Y2 := Y2;  
        end loop;

    end Mi_Subtract_Non_O1;

--\x0c
    procedure Mi_Subtract_O (P_Reg  : X_Region;  
                             Rects1 : X_Box_List;  
                             R1     : S_Natural;                              R1_End : S_Natural;  
                             Rects2 : X_Box_List;  
                             R2     : S_Natural;  
                             R2_End : S_Natural;  
                             Y1     : S_Short;  
                             Y2     : S_Short) is
-------------------------------------------------------------------------
-- mi_Subtract_O --
--  Overlapping band subtraction. x1 is the left-most point not yet
--  checked.
--
-- Results:
--  None.
--
-- Side Effects:
--  p_Reg may have rectangles added to it.
--
-------------------------------------------------------------------------
        X1   : S_Short;  
        R1_I : S_Natural := R1;  
        R2_I : S_Natural := R2;  
        I    : S_Natural;  
    begin

        X1 := Rects1 (R1_I).X1;

--/ if DEBUG then
        if not (Y1 < Y2) then  
            raise X_Library_Confusion;  
        end if;
--/ end if;

        while R1_I < R1_End and then R2_I < R2_End loop

----If subtrahend missed the boat: go to next subtrahend.

            if Rects2 (R2_I).X2 <= X1 then  
                R2_I := R2_I + 1;

----If subtrahend preceeds minuend: nuke left edge of minuend.

            elsif Rects2 (R2_I).X1 <= X1 then  
                X1 := Rects2 (R2_I).X2;

----If minuend completely covered: advance to next minuend and reset left fence
--  to edge of new minuend.

                if X1 >= Rects1 (R1_I).X2 then  
                    R1_I := R1_I + 1;  
                    X1   := Rects1 (R1_I).X1;

----Else subtrahend now used up since it doesn't extend beyond minuend

                else  
                    R2_I := R2_I + 1;  
                end if;

----Left part of subtrahend covers part of minuend: add uncovered part of
--  minuend to region and skip to next subtrahend.

            elsif Rects2 (R2_I).X1 < Rects1 (R1_I).X2 then
--/ if DEBUG then
                if not (X1 < Rects2 (R2_I).X1) then  
                    raise X_Library_Confusion;  
                end if;
--/ end if;
                P_Reg.Num_Rects    := P_Reg.Num_Rects + 1;  
                I                  := P_Reg.Num_Rects;  
                P_Reg.Rects (I).X1 := X1;  
                P_Reg.Rects (I).Y1 := Y1;  
                P_Reg.Rects (I).X2 := Rects2 (R2_I).X1;  
                P_Reg.Rects (I).Y2 := Y2;

                X1 := Rects2 (R2_I).X2;

---If minuend used up: advance to new...

                if X1 >= Rects1 (R2_I).X2 then  
                    R1_I := R1_I + 1;  
                    X1   := Rects1 (R1_I).X1;

----Else subtrahend used up

                else  
                    R2_I := R2_I + 1;  
                end if;

----Minuend used up: add any remaining piece before advancing.

            else  
                if Rects1 (R1_I).X2 > X1 then  
                    P_Reg.Num_Rects    := P_Reg.Num_Rects + 1;  
                    I                  := P_Reg.Num_Rects;  
                    P_Reg.Rects (I).X1 := X1;  
                    P_Reg.Rects (I).Y1 := Y1;  
                    P_Reg.Rects (I).X2 := Rects1 (R1_I).X2;  
                    P_Reg.Rects (I).Y2 := Y2;  
                end if;  
                R1_I := R1_I + 1;  
                X1   := Rects1 (R1_I).X1;  
            end if;  
        end loop;

----Add remaining minuend rectangles to region.

        while R1_I < R1_End loop
--/ if DEBUG then
            if not (X1 < Rects1 (R1_I).X2) then  
                raise X_Library_Confusion;  
            end if;
--/ end if;
            P_Reg.Num_Rects    := P_Reg.Num_Rects + 1;  
            I                  := P_Reg.Num_Rects;  
            P_Reg.Rects (I).X1 := X1;  
            P_Reg.Rects (I).Y1 := Y1;  
            P_Reg.Rects (I).X2 := Rects1 (R1_I).X2;  
            P_Reg.Rects (I).Y2 := Y2;

--/ if DEBUG then
            if not (P_Reg.Num_Rects <= P_Reg.Size) then  
                raise X_Library_Confusion;  
            end if;
--/ end if;

            R1_I := R1_I + 1;  
            if R1_I < R1_End then  
                X1 := Rects1 (R1_I).X1;  
            end if;  
        end loop;

    end Mi_Subtract_O;

--\x0c
    procedure Mi_Region_Op_Subtract is  
       new Mi_Region_Op  
              (True, True, False,  
               Mi_Subtract_O, Mi_Subtract_Non_O1, Null_Non_Overlap2_Func);

--\x0c
    procedure X_Subtract_Region (Region1    : X_Region;  
                                 Region2    : X_Region;  
                                 New_Region : X_Region) is
-------------------------------------------------------------------------
-- mi_Subtract --
--  Subtract Region2 from Region1 and leave the result in New_Region.
--  S stands for subtrahend, M for minuend and D for difference.
--
-- Results:
--  TRUE.
--
-- Side Effects:
--  New_Region is overwritten.
--
-------------------------------------------------------------------------
    begin

----Check for trivial reject.

        if Region1.Num_Rects = 0 or else  
           Region2.Num_Rects = 0 or else  
           not Extent_Check (Region1.Extents, Region2.Extents) then  
            Mi_Region_Copy (New_Region, Region1);  
            return;  
        end if;

        Mi_Region_Op_Subtract (New_Region, Region1, Region2);

----Can't alter New_Region's extents before we call mi_Region_Op because it might
--  be one of the source regions and mi_Region_Op depends on the extents of
--  those regions being unaltered. Besides, this way there's no checking
--  against rectangles that will be nuked due to coalescing, so we have to
--  examine fewer rectangles.

        Mi_Set_Extents (New_Region);

    end X_Subtract_Region;

--\x0c
    procedure X_Xor_Region (Region1    : X_Region;  
                            Region2    : X_Region;  
                            New_Region : X_Region) is  
        Tra : X_Region;  
        Trb : X_Region;  
    begin

        Tra := new X_Region_Rec;  
        Trb := new X_Region_Rec;  
        X_Subtract_Region (Region1, Region2, Tra);  
        X_Subtract_Region (Region2, Region1, Trb);  
        X_Union_Region (Tra, Trb, New_Region);  
        Free_X_Region (Tra);  
        Free_X_Region (Trb);

    exception

        when others =>  
            Free_X_Region (Tra);  
            Free_X_Region (Trb);  
            raise;

    end X_Xor_Region;


--\x0c
    function X_Empty_Region (Region : X_Region) return Boolean is
------------------------------------------------------------------------------
-- Check to see if the region is empty.  Assumes a region is passed
-- as a parameter
------------------------------------------------------------------------------
    begin

        return Region.Num_Rects = 0;

    end X_Empty_Region;

--\x0c
    function X_Equal_Region (Region1 : X_Region;  
                             Region2 : X_Region) return Boolean is
------------------------------------------------------------------------------
--  Check to see if two regions are equal
------------------------------------------------------------------------------
    begin

        if Region1.Num_Rects /= Region2.Num_Rects then  
            return False;  
        elsif Region1.Num_Rects = 0 then  
            return True;  
        elsif Region1.Extents /= Region2.Extents then  
            return False;  
        end if;  
        for I in 1 .. Region1.Num_Rects loop  
            if Region1.Rects (I) /= Region2.Rects (I) then  
                return False;  
            end if;  
        end loop;  
        return True;

    end X_Equal_Region;

--\x0c
    function X_Point_In_Region (Region : X_Region;  
                                X      : S_Short;  
                                Y      : S_Short) return Boolean is  
    begin

        if Region.Num_Rects = 0 then  
            return False;  
        end if;  
        if not In_Box (Region.Extents, X, Y) then  
            return False;  
        end if;  
        for I in 1 .. Region.Num_Rects loop  
            if In_Box (Region.Rects (I), X, Y) then  
                return True;  
            end if;  
        end loop;  
        return False;

    end X_Point_In_Region;

--\x0c
    function X_Rect_In_Region  
                (Region : X_Region;  
                 X      : S_Short;  
                 Y      : S_Short;  
                 Width  : U_Short;  
                 Height : U_Short) return X_Rect_In_Region_Returns is  
        Prect    : X_Box_Rec;  
        Part_In  : Boolean;  
        Part_Out : Boolean;  
        Lx       : S_Short := X;  
        Ly       : S_Short := Y;  
    begin

        Prect.X1 := Lx;  
        Prect.Y1 := Ly;  
        Prect.X2 := S_Short (Width) + Lx;  
        Prect.Y2 := S_Short (Height) + Ly;

----This is (just) a useful optimization.

        if Region.Num_Rects = 0 or else  
           not Extent_Check (Region.Extents, Prect) then  
            return Rectangle_Out;  
        end if;

        Part_Out := False;  
        Part_In  := False;

----Can stop when both part_Out and part_In are TRUE, or we reach prect.y2.

        for Pbox in 1 .. Region.Num_Rects loop

            declare  
                Box : X_Box_Rec renames Region.Rects (Pbox);  
            begin  
                if Box.Y2 <= Ly then
                    -- getting up to speed or skipping remainder of band
                    goto Continue_Loop;  
                end if;

                if Box.Y1 > Ly then  
                    Part_Out := True;       -- missed part of rectangle above
                    if Part_In or else Box.Y1 >= Prect.Y2 then  
                        exit;  
                    end if;  
                    Ly := Box.Y1;          -- x guaranteed to be = prect.x1
               end if;

                if Box.X2 <= Lx then  
                    goto Continue_Loop;     -- not far enough over yet
                end if;

                if Box.X1 > Lx then  
                    Part_Out := True;       -- missed part of rectangle to left
                    if Part_In then  
                        exit;  
                    end if;  
                end if;

                if Box.X1 < Prect.X2 then  
                    Part_In := True;        -- definitely overlap
                    if Part_Out then  
                        exit;  
                    end if;  
                end if;

                if Box.X2 >= Prect.X2 then  
                    Ly := Box.Y2;          -- finished with this band
                    if Ly >= Prect.Y2 then  
                        exit;  
                    end if;  
                    Lx := Prect.X1;        -- reset x out to left again
                else

----Because boxes in a band are maximal width, if the first box to overlap the
--  rectangle doesn't completely cover it in that band, the rectangle must be
--  partially out, since some of it will be uncovered in that band. part_In
--  will have been set true by now...

                    exit;  
                end if;  
            end;

            <<Continue_Loop>> null;  
        end loop;

        if Part_In then  
            if Ly < Prect.Y2 then  
                return Rectangle_Part;  
            else  
                return Rectangle_In;  
            end if;  
        else  
            return Rectangle_Out;  
        end if;

    end X_Rect_In_Region;

end Xlbp_Region;  

E3 Meta Data

    nblk1=a8
    nid=a8
    hdr6=14e
        [0x00] rec0=23 rec1=00 rec2=01 rec3=052
        [0x01] rec0=0f rec1=00 rec2=02 rec3=046
        [0x02] rec0=13 rec1=00 rec2=03 rec3=064
        [0x03] rec0=18 rec1=00 rec2=04 rec3=04a
        [0x04] rec0=01 rec1=00 rec2=a7 rec3=012
        [0x05] rec0=17 rec1=00 rec2=05 rec3=000
        [0x06] rec0=1c rec1=00 rec2=06 rec3=020
        [0x07] rec0=00 rec1=00 rec2=a6 rec3=00c
        [0x08] rec0=1c rec1=00 rec2=07 rec3=01c
        [0x09] rec0=16 rec1=00 rec2=08 rec3=06a
        [0x0a] rec0=00 rec1=00 rec2=a5 rec3=014
        [0x0b] rec0=1a rec1=00 rec2=09 rec3=01c
        [0x0c] rec0=00 rec1=00 rec2=a4 rec3=002
        [0x0d] rec0=13 rec1=00 rec2=0a rec3=07e
        [0x0e] rec0=12 rec1=00 rec2=0b rec3=058
        [0x0f] rec0=12 rec1=00 rec2=0c rec3=084
        [0x10] rec0=1c rec1=00 rec2=0d rec3=026
        [0x11] rec0=21 rec1=00 rec2=0e rec3=04e
        [0x12] rec0=1d rec1=00 rec2=0f rec3=028
        [0x13] rec0=1b rec1=00 rec2=10 rec3=03e
        [0x14] rec0=01 rec1=00 rec2=a3 rec3=006
        [0x15] rec0=19 rec1=00 rec2=11 rec3=00c
        [0x16] rec0=01 rec1=00 rec2=a2 rec3=030
        [0x17] rec0=1e rec1=00 rec2=12 rec3=012
        [0x18] rec0=00 rec1=00 rec2=a1 rec3=028
        [0x19] rec0=15 rec1=00 rec2=13 rec3=004
        [0x1a] rec0=1b rec1=00 rec2=14 rec3=064
        [0x1b] rec0=01 rec1=00 rec2=a0 rec3=018
        [0x1c] rec0=1c rec1=00 rec2=15 rec3=030
        [0x1d] rec0=02 rec1=00 rec2=9f rec3=012
        [0x1e] rec0=15 rec1=00 rec2=16 rec3=026
        [0x1f] rec0=01 rec1=00 rec2=9e rec3=008
        [0x20] rec0=18 rec1=00 rec2=9d rec3=052
        [0x21] rec0=03 rec1=00 rec2=17 rec3=018
        [0x22] rec0=1b rec1=00 rec2=9c rec3=004
        [0x23] rec0=00 rec1=00 rec2=18 rec3=004
        [0x24] rec0=18 rec1=00 rec2=19 rec3=026
        [0x25] rec0=01 rec1=00 rec2=9b rec3=010
        [0x26] rec0=21 rec1=00 rec2=1a rec3=04c
        [0x27] rec0=03 rec1=00 rec2=9a rec3=006
        [0x28] rec0=19 rec1=00 rec2=1b rec3=088
        [0x29] rec0=01 rec1=00 rec2=99 rec3=052
        [0x2a] rec0=1f rec1=00 rec2=1c rec3=03c
        [0x2b] rec0=01 rec1=00 rec2=98 rec3=01c
        [0x2c] rec0=21 rec1=00 rec2=1d rec3=01c
        [0x2d] rec0=00 rec1=00 rec2=97 rec3=030
        [0x2e] rec0=1a rec1=00 rec2=1e rec3=04c
        [0x2f] rec0=01 rec1=00 rec2=95 rec3=01a
        [0x30] rec0=1b rec1=00 rec2=96 rec3=014
        [0x31] rec0=02 rec1=00 rec2=1f rec3=044
        [0x32] rec0=19 rec1=00 rec2=20 rec3=070
        [0x33] rec0=01 rec1=00 rec2=94 rec3=01a
        [0x34] rec0=12 rec1=00 rec2=21 rec3=06e
        [0x35] rec0=02 rec1=00 rec2=93 rec3=01a
        [0x36] rec0=18 rec1=00 rec2=22 rec3=076
        [0x37] rec0=00 rec1=00 rec2=92 rec3=004
        [0x38] rec0=18 rec1=00 rec2=90 rec3=050
        [0x39] rec0=00 rec1=00 rec2=23 rec3=02e
        [0x3a] rec0=15 rec1=00 rec2=24 rec3=00e
        [0x3b] rec0=00 rec1=00 rec2=91 rec3=016
        [0x3c] rec0=18 rec1=00 rec2=25 rec3=06a
        [0x3d] rec0=01 rec1=00 rec2=8f rec3=016
        [0x3e] rec0=14 rec1=00 rec2=26 rec3=026
        [0x3f] rec0=02 rec1=00 rec2=8e rec3=02e
        [0x40] rec0=16 rec1=00 rec2=27 rec3=012
        [0x41] rec0=1b rec1=00 rec2=28 rec3=014
        [0x42] rec0=00 rec1=00 rec2=8d rec3=008
        [0x43] rec0=16 rec1=00 rec2=8a rec3=030
        [0x44] rec0=02 rec1=00 rec2=29 rec3=036
        [0x45] rec0=1f rec1=00 rec2=2a rec3=028
        [0x46] rec0=00 rec1=00 rec2=8c rec3=018
        [0x47] rec0=14 rec1=00 rec2=2b rec3=04a
        [0x48] rec0=03 rec1=00 rec2=8b rec3=024
        [0x49] rec0=1d rec1=00 rec2=2c rec3=02e
        [0x4a] rec0=1f rec1=00 rec2=2d rec3=00a
        [0x4b] rec0=14 rec1=00 rec2=2e rec3=022
        [0x4c] rec0=1f rec1=00 rec2=2f rec3=008
        [0x4d] rec0=00 rec1=00 rec2=89 rec3=044
        [0x4e] rec0=1c rec1=00 rec2=30 rec3=00e
        [0x4f] rec0=00 rec1=00 rec2=88 rec3=02e
        [0x50] rec0=1d rec1=00 rec2=31 rec3=01a
        [0x51] rec0=00 rec1=00 rec2=87 rec3=00a
        [0x52] rec0=20 rec1=00 rec2=32 rec3=02a
        [0x53] rec0=18 rec1=00 rec2=33 rec3=010
        [0x54] rec0=00 rec1=00 rec2=86 rec3=018
        [0x55] rec0=1a rec1=00 rec2=34 rec3=024
        [0x56] rec0=13 rec1=00 rec2=35 rec3=032
        [0x57] rec0=00 rec1=00 rec2=85 rec3=002
        [0x58] rec0=22 rec1=00 rec2=36 rec3=01a
        [0x59] rec0=00 rec1=00 rec2=84 rec3=018
        [0x5a] rec0=20 rec1=00 rec2=37 rec3=006
        [0x5b] rec0=01 rec1=00 rec2=83 rec3=008
        [0x5c] rec0=22 rec1=00 rec2=38 rec3=072
        [0x5d] rec0=01 rec1=00 rec2=82 rec3=002
        [0x5e] rec0=1b rec1=00 rec2=39 rec3=03e
        [0x5f] rec0=17 rec1=00 rec2=3a rec3=018
        [0x60] rec0=01 rec1=00 rec2=81 rec3=000
        [0x61] rec0=16 rec1=00 rec2=3b rec3=022
        [0x62] rec0=00 rec1=00 rec2=80 rec3=01e
        [0x63] rec0=19 rec1=00 rec2=3c rec3=00a
    tail 0x21500963081978318fba4 0x42a00088462063203
Free Block Chain:
  0xa8: 0000  00 00 0a 00 1e 87 e0 20 07 f0 20 2a 00 7c 09 80  ┆           * |  ┆