|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 58368 (0xe400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Xlbp_Graphics, seg_004f69
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Xlbt_Arithmetic;
use Xlbt_Arithmetic;
with Xlbt_Display2;
use Xlbt_Display2;
with Xlbt_Graphics;
use Xlbt_Graphics;
with Xlbt_Misc;
use Xlbt_Misc;
with Xlbt_Request;
use Xlbt_Request;
with Xlbp_Gc;
use Xlbp_Gc;
with Xlbip_Graphic_Converters;
use Xlbip_Graphic_Converters;
with Xlbip_Internal;
use Xlbip_Internal;
with Xlbip_Put_Request;
use Xlbip_Put_Request;
package body Xlbp_Graphics is
------------------------------------------------------------------------------
-- X Library Graphics
--
-- Xlbp_Graphics - Draw various types of things on a window
------------------------------------------------------------------------------
-- Copyright 1989 - 1991 by Rational, Santa Clara, California.
-- Copyright 1985 - 1989 by the Massachusetts Institute of Technology
--
-- All Rights Reserved.
--
-- Permission to use, copy, modify, and distribute this software and its
-- documentation for any purpose and without fee is hereby granted,
-- provided that the above copyright notice(s) appear in all copies and that
-- both that copyright notice(s) and this permission notice appear in
-- supporting documentation, and that the names of MIT or Rational not be
-- used in advertising or publicity pertaining to distribution of the software
-- without specific, written prior permission.
--
-- MIT and Rational disclaim all warranties with regard to this software,
-- including all implied warranties of merchantability and fitness, in no
-- event shall MIT or Rational be liable for any special, indirect or
-- consequential damages or any damages whatsoever resulting from loss of use,
-- data or profits, whether in an action of contract, negligence or other
-- tortious action, arising out of or in connection with the use or performance
-- of this software.
------------------------------------------------------------------------------
--\x0c
procedure X_Clear_Area (Display : X_Display;
Window : X_Window;
X : S_Short;
Y : S_Short;
Width : U_Short;
Height : U_Short;
Exposures : Boolean) is
begin
----Lock the display.
Lock_Display (Display);
begin
----Send the request.
Put_X_Clear_Area_Request
(Display, (Kind => Clear_Area,
Length => X_Clear_Area_Request'Size / 32,
Exposures => From_Boolean (Exposures),
Window => Window,
X => X,
Y => Y,
Width => Width,
Height => Height));
----Catch exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; and return.
Unlock_Display (Display);
Sync_Handle (Display);
end X_Clear_Area;
--\x0c
procedure X_Clear_Window (Display : X_Display;
Window : X_Window) is
begin
----These X/Y/Width/Height values mean "the entire window".
X_Clear_Area (Display, Window, 0, 0, 0, 0, False);
end X_Clear_Window;
--\x0c
procedure X_Copy_Area (Display : X_Display;
Source : X_Drawable;
Destination : X_Drawable;
Gc : X_Gc;
Source_X : S_Short;
Source_Y : S_Short;
Width : U_Short;
Height : U_Short;
Destination_X : S_Short;
Destination_Y : S_Short) is
begin
----Lock the display.
Lock_Display (Display);
begin
----Flush the GC before use and send the request.
Private_X_Flush_Gc_Cache (Display, Gc);
Put_X_Copy_Area_Request
(Display, (Kind => Copy_Area,
Length => X_Copy_Area_Request'Size / 32,
Pad => 0,
Src_Drawable => Source,
Dst_Drawable => Destination,
Gc => Gc.Gid,
Src_X => Source_X,
Src_Y => Source_Y,
Dst_X => Destination_X,
Dst_Y => Destination_Y,
Width => Width,
Height => Height));
----Catch exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; and return.
Unlock_Display (Display);
Sync_Handle (Display);
end X_Copy_Area;
--\x0c
procedure X_Copy_Plane (Display : X_Display;
Source : X_Drawable;
Destination : X_Drawable;
Gc : X_Gc;
Source_X : S_Short;
Source_Y : S_Short;
Width : U_Short;
Height : U_Short;
Destination_X : S_Short;
Destination_Y : S_Short;
Bit_Plane : X_Plane_Mask) is
begin
----Lock the display.
Lock_Display (Display);
begin
----Flush the GC and send the request.
Private_X_Flush_Gc_Cache (Display, Gc);
Put_X_Copy_Plane_Request
(Display, (Kind => Copy_Plane,
Length => X_Copy_Plane_Request'Size / 32,
Pad => 0,
Src_Drawable => Source,
Dst_Drawable => Destination,
Gc => Gc.Gid,
Src_X => Source_X,
Src_Y => Source_Y,
Dst_X => Destination_X,
Dst_Y => Destination_Y,
Width => Width,
Height => Height,
Bit_Plane => Bit_Plane));
----Catch exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; and return.
Unlock_Display (Display);
Sync_Handle (Display);
end X_Copy_Plane;
--\x0c
procedure X_Draw_Arcs (Display : X_Display;
Drawable : X_Drawable;
Gc : X_Gc;
Arcs : X_Arc_Array) is
N_Arcs : S_Natural;
Arcsi : S_Natural;
Size : S_Natural;
N : S_Natural;
begin
----Lock the display.
Lock_Display (Display);
begin
----Flush the GC before use and send the request.
Private_X_Flush_Gc_Cache (Display, Gc);
N_Arcs := Arcs'Length;
Arcsi := Arcs'First;
while N_Arcs > 0 loop
----Figure out how many arcs we can send this time.
if N_Arcs > S_Natural (Display.Poly_Arc_Limit) then
N := S_Natural (Display.Poly_Arc_Limit);
else
N := N_Arcs;
end if;
Size := N * (X_Arc'Size / 32);
----Send the request.
Put_X_Poly_Arc_Request
(Display => Display,
Req => (Kind => Poly_Arc,
Length => X_Poly_Arc_Request'Size / 32
+ U_Short (Size),
Pad => 0,
Drawable => Drawable,
Gc => Gc.Gid),
Extra => 4 * Size);
----Send the extra data.
Put_X_Arc_Array (Display, Arcs (Arcsi .. Arcsi - 1 + N));
Arcsi := Arcsi + N;
N_Arcs := N_Arcs - N;
end loop;
----Catch exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; and return
Unlock_Display (Display);
Sync_Handle (Display);
end X_Draw_Arcs;
--\x0c
procedure X_Draw_Arc (Display : X_Display;
Drawable : X_Drawable;
Gc : X_Gc;
X : S_Short;
Y : S_Short;
Width : U_Short;
Height : U_Short;
Angle1 : S_Short;
Angle2 : S_Short) is
------------------------------------------------------------------------------
-- Note to future maintainers: XDrawArc does NOT batch successive PolyArc
-- requests into a single request like XDrawLine, XDrawPoint, etc.
-- We don't do this because X_PolyArc applies the GC's join-style if
-- the last point in one arc coincides with the first point in another.
-- The client wouldn't expect this and would have no easy way to defeat it.
------------------------------------------------------------------------------
begin
----Lock the display.
Lock_Display (Display);
begin
----Flush the GC before use. If the previous request was a Draw_Arc with the
-- same drawable then batch the request.
Private_X_Flush_Gc_Cache (Display, Gc);
Put_X_Poly_Arc_Request
(Display => Display,
Req => (Kind => Poly_Arc,
Pad => 0,
Length =>
X_Poly_Arc_Request'Size / 32 + X_Arc'Size / 32,
Drawable => Drawable,
Gc => Gc.Gid),
Extra => X_Arc'Size / 8);
Put_X_Arc (Display,
X_Arc'(X => X,
Y => Y,
Width => Width,
Height => Height,
Angle1 => Angle1,
Angle2 => Angle2));
----Catch exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; and return
Unlock_Display (Display);
Sync_Handle (Display);
end X_Draw_Arc;
--\x0c
procedure X_Fill_Arcs (Display : X_Display;
Drawable : X_Drawable;
Gc : X_Gc;
Arcs : X_Arc_Array) is
N_Arcs : S_Natural := Arcs'Length;
Arcsi : S_Natural := Arcs'First;
N : S_Natural;
Size : S_Natural;
begin
----Lock the display.
Lock_Display (Display);
begin
----Flush the GC before use.
Private_X_Flush_Gc_Cache (Display, Gc);
----Loop until all arcs are sent.
while N_Arcs > 0 loop
----Figure out how many arcs we can send this time.
if N_Arcs > S_Natural (Display.Poly_Arc_Limit) then
N := S_Natural (Display.Poly_Arc_Limit);
else
N := N_Arcs;
end if;
Size := N * (X_Arc'Size / 32);
----Send the request.
Put_X_Poly_Fill_Arc_Request
(Display => Display,
Req => (Kind => Poly_Fill_Arc,
Length =>
X_Poly_Fill_Arc_Request'Size / 32 +
U_Short (Size),
Pad => 0,
Drawable => Drawable,
Gc => Gc.Gid),
Extra => 4 * Size);
----Send the extra data.
Put_X_Arc_Array (Display, Arcs (Arcsi .. Arcsi + N - 1));
Arcsi := Arcsi + N;
N_Arcs := N_Arcs - N;
end loop;
----Catch exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; and return
Unlock_Display (Display);
Sync_Handle (Display);
end X_Fill_Arcs;
--\x0c
procedure X_Fill_Arc (Display : X_Display;
Drawable : X_Drawable;
Gc : X_Gc;
X : S_Short;
Y : S_Short;
Width : U_Short;
Height : U_Short;
Angle1 : _Short;
Angle2 : S_Short) is
Lreq : X_Last_Request renames Display.Last_Request;
begin
----Lock the display.
Lock_Display (Display);
begin
----Flush the GC before use. If the previous request was a Fill_Arc with the
-- same drawable then batch the request.
Private_X_Flush_Gc_Cache (Display, Gc);
if Lreq.Kind = Poly_Fill_Arc and then
Lreq.Poly_Fill_Arc_Req.Drawable = Drawable and then
Lreq.Poly_Fill_Arc_Req.Gc = Gc.Gid then
----Increment the length of the request and put out the new data element.
Lreq.Poly_Fill_Arc_Req.Length :=
Lreq.Poly_Fill_Arc_Req.Length + X_Arc'Size / 32;
Put_X_Arc (Display, (X => X,
Y => Y,
Width => Width,
Height => Height,
Angle1 => Angle1,
Angle2 => Angle2));
----If we just used the last available space then put out the request and
-- turn "off" the Last_Request.Kind.
Lreq.Spaces_Left := Lreq.Spaces_Left - 1;
if Lreq.Spaces_Left = 0 then
Put_X_Poly_Fill_Arc_Request
(Display => Display,
Req => Lreq.Poly_Fill_Arc_Req,
Reservation => Lreq.Request_Position);
Lreq.Kind := Invalid_Request;
end if;
----We are to start a new request. Flush the last request if necessary.
else
if Lreq.Kind /= Invalid_Request then
Internal_X_Flush_Last_Request (Display);
end if;
----Create the request and then reserve space for it and its data.
Lreq.Poly_Fill_Arc_Req :=
(Kind => Poly_Fill_Arc,
Pad => 0,
Length => X_Poly_Fill_Arc_Request'Size / 32 +
X_Arc'Size / 32,
Drawable => Drawable,
Gc => Gc.Gid);
Reserve_X_Poly_Fill_Arc_Request (Display,
Display.Poly_Arc_Limit,
Lreq.Poly_Fill_Arc_Req,
(1 => (X => X,
Y => Y,
Width => Width,
Height => Height,
Angle1 => Angle1,
Angle2 => Angle2)),
Lreq.Request_Position,
Lreq.Spaces_Left);
----If there are no Spaces_Left then the request is already on the way out
-- and we cannot add anything to it later.
if Lreq.Spaces_Left = 0 then
Lreq.Kind := Invalid_Request;
else
Lreq.Kind := Poly_Fill_Arc;
end if;
end if;
----Catch exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; and return
Unlock_Display (Display);
Sync_Handle (Display);
end X_Fill_Arc;
--\x0c
procedure X_Draw_Points (Display : X_Display;
Drawable : X_Drawable;
Gc : X_Gc;
Points : X_Point_Array;
Mode : X_Coordinate_Mode) is
N_Points : S_Natural := Points'Length;
Pointsi : S_Natural := Points'First;
N : S_Natural;
Size : S_Natural;
Xoff : S_Short;
Yoff : S_Short;
Pt : X_Point;
begin
----Lock the display.
Lock_Display (Display);
begin
Private_X_Flush_Gc_Cache (Display, Gc);
----Go into a loop where each time through the loop we send as many individual
-- points as possible. Maybe we can send it all in one request and maybe not.
Xoff := 0;
Yoff := 0;
while N_Points > 0 loop
----Figure out how many points we can send in this one request.
if N_Points > S_Natural (Display.Poly_Point_Limit) then
N := S_Natural (Display.Poly_Point_Limit);
else
N := N_Points;
end if;
Size := N * (X_Point'Size / 32);
----Make the basic request.
Put_X_Poly_Point_Request
(Display => Display,
Req => (Kind => Poly_Point,
Length => X_Poly_Point_Request'Size / 32 +
U_Short (Size),
Drawable => Drawable,
Gc => Gc.Gid,
Coord_Mode => Mode),
Extra => 4 * Size);
----If this isn't the first request then start our request with the coordinates
-- that the last request terminated upon.
if Xoff /= 0 or else
Yoff /= 0 then
Pt.X := Xoff + Points (Pointsi).X;
Pt.Y := Yoff + Points (Pointsi).Y;
Put_X_Point (Display, Pt);
if N > 1 then
Put_X_Point_Array (Display,
Points (Pointsi + 1 ..
Pointsi + N - 1));
end if;
else
Put_X_Point_Array (Display,
Points (Pointsi .. Pointsi + N - 1));
end if;
N_Points := N_Points - N;
if N_Points > 0 and then Mode = Coord_Mode_Previous then
for I in 0 .. N - 1 loop
Xoff := Xoff + Points (Pointsi + I).X;
Yoff := Yoff + Points (Pointsi + I).Y;
end loop;
end if;
Pointsi := Pointsi + N;
end loop;
----Catch exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; and return.
Unlock_Display (Display);
Sync_Handle (Display);
end X_Draw_Points;
--\x0c
procedure X_Draw_Point (Display : X_Display;
Drawable : X_Drawable;
Gc : X_Gc;
X : S_Short;
Y : S_Short) is
Lreq : X_Last_Request renames Display.Last_Request;
begin
----Lock the display.
Lock_Display (Display);
begin
----Flush the GC before use.
Private_X_Flush_Gc_Cache (Display, Gc);
----Try to merge with a previous request.
if Lreq.Kind = Poly_Point and then
Lreq.Poly_Point_Req.Drawable = Drawable and then
Lreq.Poly_Point_Req.Gc = Gc.Gid and then
Lreq.Poly_Point_Req.Coord_Mode = Coord_Mode_Origin then
----Increment the length of the request and put out the new data element.
Lreq.Poly_Point_Req.Length :=
Lreq.Poly_Point_Req.Length + X_Point'Size / 32;
Put_X_Point (Display, (X => X,
Y => Y));
----If we just used the last available space then put out the request and
-- turn "off" the Last_Request.Kind.
Lreq.Spaces_Left := Lreq.Spaces_Left - 1;
if Lreq.Spaces_Left = 0 then
Put_X_Poly_Point_Request
(Display => Display,
Req => Lreq.Poly_Point_Req,
Reservation => Lreq.Request_Position);
Lreq.Kind := Invalid_Request;
end if;
----We are to start a new request. Flush the last request if necessary.
else
if Lreq.Kind /= Invalid_Request then
Internal_X_Flush_Last_Request (Display);
end if;
----Create the request and then reserve space for it and its data.
Lreq.Poly_Point_Req :=
(Kind => Poly_Point,
Length => X_Poly_Point_Request'Size / 32 +
X_Point'Size / 32,
Drawable => Drawable,
Gc => Gc.Gid,
Coord_Mode => Coord_Mode_Origin);
Reserve_X_Poly_Point_Request (Display,
Display.Poly_Point_Limit,
Lreq.Poly_Point_Req,
(1 => (X => X,
Y => Y)),
Lreq.Request_Position,
Lreq.Spaces_Left);
----If there are no Spaces_Left then the request is already on the way out
-- and we cannot add anything to it later.
if Lreq.Spaces_Left = 0 then
Lreq.Kind := Invalid_Request;
else
Lreq.Kind := Poly_Point;
end if;
end if;
----Catch exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; and return.
Unlock_Display (Display);
Sync_Handle (Display);
end X_Draw_Point;
--\x0c
procedure X_Fill_Polygon (Display : X_Display;
Drawable : X_Drawable;
Gc : X_Gc;
Points : X_Point_Array;
Shape : X_Polygon_Shape;
Mode : X_Coordinate_Mode) is
begin
----Lock the display.
Lock_Display (Display);
begin
----Flush the GC before use.
Private_X_Flush_Gc_Cache (Display, Gc);
----Send the request.
Put_X_Fill_Poly_Request
(Display => Display,
Req => (Kind => Fill_Poly,
Length => X_Fill_Poly_Request'Size / 32 +
Points'Length * X_Point'Size / 32,
Drawable => Drawable,
Pad => 0,
Pad1 => 0,
Gc => Gc.Gid,
Shape => Shape,
Coord_Mode => Mode),
Extra => Points'Length * X_Point'Size / 8);
----Send the extra data.
Put_X_Point_Array (Display, Points);
----Catch exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; and return.
Unlock_Display (Display);
Sync_Handle (Display);
end X_Fill_Polygon;
--\x0c
procedure X_Draw_Lines (Display : X_Display;
Drawable : X_Drawable;
Gc : X_Gc;
Points : X_Point_Array;
Mode : X_Coordinate_Mode) is
begin
----Lock the display.
Lock_Display (Display);
begin
----Flush the GC before use; send the request.
Private_X_Flush_Gc_Cache (Display, Gc);
Put_X_Poly_Line_Request
(Display => Display,
Req => (Kind => Poly_Line,
Length => X_Poly_Line_Request'Size / 32 +
Points'Length * X_Point'Size / 32,
Drawable => Drawable,
Gc => Gc.Gid,
Coord_Mode => Mode),
Extra => Points'Length * X_Point'Size / 8);
----Send the extra data.
Put_X_Point_Array (Display, Points);
----Catch exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync and return;
Unlock_Display (Display);
Sync_Handle (Display);
end X_Draw_Lines;
--\x0c
procedure X_Draw_Line (Display : X_Display;
Drawable : X_Drawable;
Gc : X_Gc;
X1 : S_Short;
Y1 : S_Short;
X2 : S_Short;
Y2 : S_Short) is
Lreq : X_Last_Request renames Display.Last_Request;
begin
----Lock the display.
Lock_Display (Display);
begin
----Flush the GC before use.
Private_X_Flush_Gc_Cache (Display, Gc);
----If the previous request was the same kind and used the same drawable then
-- batch the request.
if Lreq.Kind = Poly_Segment and then
Lreq.Poly_Segment_Req.Drawable = Drawable and then
Lreq.Poly_Segment_Req.Gc = Gc.Gid then
----Increment the length of the request and put out the new data element.
Lreq.Poly_Segment_Req.Length :=
Lreq.Poly_Segment_Req.Length + X_Segment'Size / 32;
Put_X_Segment (Display, (X1 => X1,
Y1 => Y1,
X2 => X2,
Y2 => Y2));
----If we just used the last available space then put out the request and
-- turn "off" the Last_Request.Kind.
Lreq.Spaces_Left := Lreq.Spaces_Left - 1;
if Lreq.Spaces_Left = 0 then
Put_X_Poly_Segment_Request
(Display => Display,
Req => Lreq.Poly_Segment_Req,
Reservation => Lreq.Request_Position);
Lreq.Kind := Invalid_Request;
end if;
----We are to start a new request. Flush the last request if necessary.
else
if Lreq.Kind /= Invalid_Request then
Internal_X_Flush_Last_Request (Display);
end if;
----Create the request and then reserve space for it and its data.
Lreq.Poly_Segment_Req :=
(Kind => Poly_Segment,
Length => X_Poly_Segment_Request'Size / 32 +
X_Segment'Size / 32,
Pad => 0,
Drawable => Drawable,
Gc => Gc.Gid);
Reserve_X_Poly_Segment_Request (Display,
Display.Poly_Segment_Limit,
Lreq.Poly_Segment_Req,
(1 => (X1 => X1,
Y1 => Y1,
X2 => X2,
Y2 => Y2)),
Lreq.Request_Position,
Lreq.Spaces_Left);
----If there are no Spaces_Left then the request is already on the way out
-- and we cannot add anything to it later.
if Lreq.Spaces_Left = 0 then
Lreq.Kind := Invalid_Request;
else
Lreq.Kind := Poly_Segment;
end if;
end if;
----Catch exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync and return;
Unlock_Display (Display);
Sync_Handle (Display);
end X_Draw_Line;
--\x0c
procedure X_Draw_Segments (Display : X_Display;
Drawable : X_Drawable;
Gc : X_Gc;
Segments : X_Segment_Array) is
N_Segments : S_Natural := Segments'Length;
Segmentsi : S_Natural := Segments'First;
N : S_Natural;
Size : S_Natural;
begin
----Lock the display.
Lock_Display (Display);
begin
----Flush the GC before use.
Private_X_Flush_Gc_Cache (Display, Gc);
----Loop until all segments have been sent.
while N_Segments > 0 loop
----Figure out how many we can send this time.
if N_Segments > S_Natural (Display.Poly_Segment_Limit) then
N := S_Natural (Display.Poly_Segment_Limit);
else
N := N_Segments;
end if;
Size := N * (X_Segment'Size / 32);
----Send the request.
Put_X_Poly_Segment_Request
(Display => Display,
Req => (Kind => Poly_Segment,
Length =>
X_Poly_Segment_Request'Size / 32 +
U_Short (Size),
Pad => 0,
Drawable => Drawable,
Gc => Gc.Gid),
Extra => 4 * Size);
----Send the extra data.
Put_X_Segment_Array (Display,
Segments (Segmentsi .. Segmentsi + N - 1));
Segmentsi := Segmentsi + N;
N_Segments := N_Segments - N;
end loop;
----Catch exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; return.
Unlock_Display (Display);
Sync_Handle (Display);
end X_Draw_Segments;
--\x0c
procedure X_Draw_Rectangles (Display : X_Display;
Drawable : X_Drawable;
Gc : X_Gc;
Rectangles : X_Rectangle_Array) is
N_Rectangles : S_Natural := Rectangles'Length;
Rectanglesi : S_Natural := Rectangles'First;
N : S_Natural;
Size : S_Natural;
begin
----Lock the display.
Lock_Display (Display);
begin
----Flush the GC before use.
Private_X_Flush_Gc_Cache (Display, Gc);
----Loop until we have sent every rectangle. We try for as few requests as
-- possible.
while N_Rectangles > 0 loop
----Figure out how many we can send with this request.
if N_Rectangles > S_Natural (Display.Poly_Rectangle_Limit) then
N := S_Natural (Display.Poly_Rectangle_Limit);
else
N := N_Rectangles;
end if;
Size := N * (X_Rectangle'Size / 32);
----Make the request.
Put_X_Poly_Rectangle_Request
(Display => Display,
Req => (Kind => Poly_Rectangle,
Length =>
X_Poly_Rectangle_Request'Size / 32 +
U_Short (Size),
Pad => 0,
Drawable => Drawable,
Gc => Gc.Gid),
Extra => 4 * Size);
----Send the extra data.
Put_X_Rectangle_Array (Display,
Rectangles (Rectanglesi ..
Rectanglesi + N - 1));
Rectanglesi := Rectanglesi + N;
N_Rectangles := N_Rectangles - N;
end loop;
----Catch exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; return.
Unlock_Display (Display);
Sync_Handle (Display);
end X_Draw_Rectangles;
--\x0c
procedure X_Draw_Rectangle (Display : X_Display;
Drawable : X_Dawable;
Gc : X_Gc;
X : S_Short;
Y : S_Short;
Width : U_Short;
Height : U_Short) is
Lreq : X_Last_Request renames Display.Last_Request;
begin
----Lock the display.
Lock_Display (Display);
begin
----Flush the GC before use.
Private_X_Flush_Gc_Cache (Display, Gc);
----If possible then batch this request with a previous one.
if Lreq.Kind = Poly_Rectangle and then
Lreq.Poly_Rectangle_Req.Drawable = Drawable and then
Lreq.Poly_Rectangle_Req.Gc = Gc.Gid then
----Increment the length of the request and put out the new data element.
Lreq.Poly_Rectangle_Req.Length :=
Lreq.Poly_Rectangle_Req.Length + X_Rectangle'Size / 32;
Put_X_Rectangle (Display, (X => X,
Y => Y,
Width => Width,
Height => Height));
----If we just used the last available space then put out the request and
-- turn "off" the Last_Request.Kind.
Lreq.Spaces_Left := Lreq.Spaces_Left - 1;
if Lreq.Spaces_Left = 0 then
Put_X_Poly_Rectangle_Request
(Display => Display,
Req => Lreq.Poly_Rectangle_Req,
Reservation => Lreq.Request_Position);
Lreq.Kind := Invalid_Request;
end if;
----We are to start a new request. Flush the last request if necessary.
else
if Lreq.Kind /= Invalid_Request then
Internal_X_Flush_Last_Request (Display);
end if;
----Create the request and then reserve space for it and its data.
Lreq.Poly_Rectangle_Req :=
(Kind => Poly_Rectangle,
Length => X_Poly_Rectangle_Request'Size / 32 +
X_Rectangle'Size / 32,
Pad => 0,
Drawable => Drawable,
Gc => Gc.Gid);
Reserve_X_Poly_Rectangle_Request (Display,
Display.Poly_Rectangle_Limit,
Lreq.Poly_Rectangle_Req,
(1 => (X => X,
Y => Y,
Width => Width,
Height => Height)),
Lreq.Request_Position,
Lreq.Spaces_Left);
----If there are no Spaces_Left then the request is already on the way out
-- and we cannot add anything to it later.
if Lreq.Spaces_Left = 0 then
Lreq.Kind := Invalid_Request;
else
Lreq.Kind := Poly_Rectangle;
end if;
end if;
----Catch exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; return.
Unlock_Display (Display);
Sync_Handle (Display);
end X_Draw_Rectangle;
--\x0c
procedure X_Fill_Rectangles (Display : X_Display;
Drawable : X_Drawable;
Gc : X_Gc;
Rectangles : X_Rectangle_Array) is
N_Rectangles : S_Natural := Rectangles'Length;
Rectanglesi : S_Natural := Rectangles'First;
N : S_Natural;
Size : S_Natural;
begin
----Lock the display.
Lock_Display (Display);
begin
----Flush the GC before use.
Private_X_Flush_Gc_Cache (Display, Gc);
----Loop until all Rectangles are sent.
while N_Rectangles > 0 loop
----Figure out how many Rectangles we can send this time.
if N_Rectangles > S_Natural (Display.Poly_Rectangle_Limit) then
N := S_Natural (Display.Poly_Rectangle_Limit);
else
N := N_Rectangles;
end if;
Size := N * (X_Rectangle'Size / 32);
----Send the request.
Put_X_Poly_Fill_Rectangle_Request
(Display => Display,
Req => (Kind => Poly_Fill_Rectangle,
Length =>
X_Poly_Fill_Rectangle_Request'Size / 32 +
U_Short (Size),
Pad => 0,
Drawable => Drawable,
Gc => Gc.Gid),
Extra => 4 * Size);
----Send the extra data.
Put_X_Rectangle_Array (Display,
Rectangles (Rectanglesi ..
Rectanglesi + N - 1));
Rectanglesi := Rectanglesi + N;
N_Rectangles := N_Rectangles - N;
end loop;
----Catch exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; return.
Unlock_Display (Dislay);
Sync_Handle (Display);
end X_Fill_Rectangles;
--\x0c
procedure X_Fill_Rectangle (Display : X_Display;
Drawable : X_Drawable;
Gc : X_Gc;
X : S_Short;
Y : S_Short;
Width : U_Short;
Height : U_Short) is
Lreq : X_Last_Request renames Display.Last_Request;
begin
----Lock the display.
Lock_Display (Display);
begin
----Flush the GC before use.
Private_X_Flush_Gc_Cache (Display, Gc);
----Batch with a previous request if possible.
if Lreq.Kind = Poly_Fill_Rectangle and then
Lreq.Poly_Fill_Rectangle_Req.Drawable = Drawable and then
Lreq.Poly_Fill_Rectangle_Req.Gc = Gc.Gid then
----Increment the length of the request and put out the new data element.
Lreq.Poly_Fill_Rectangle_Req.Length :=
Lreq.Poly_Fill_Rectangle_Req.Length + X_Rectangle'Size / 32;
Put_X_Rectangle (Display, (X => X,
Y => Y,
Width => Width,
Height => Height));
----If we just used the last available space then put out the request and
-- turn "off" the Last_Request.Kind.
Lreq.Spaces_Left := Lreq.Spaces_Left - 1;
if Lreq.Spaces_Left = 0 then
Put_X_Poly_Fill_Rectangle_Request
(Display => Display,
Req => Lreq.Poly_Fill_Rectangle_Req,
Reservation => Lreq.Request_Position);
Lreq.Kind := Invalid_Request;
end if;
----We are to start a new request. Flush the last request if necessary.
else
if Lreq.Kind /= Invalid_Request then
Internal_X_Flush_Last_Request (Display);
end if;
----Create the request and then reserve space for it and its data.
Lreq.Poly_Fill_Rectangle_Req :=
(Kind => Poly_Fill_Rectangle,
Length => X_Poly_Fill_Rectangle_Request'Size / 32 +
X_Rectangle'Size / 32,
Pad => 0,
Drawable => Drawable,
Gc => Gc.Gid);
Reserve_X_Poly_Fill_Rectangle_Request
(Display,
Display.Poly_Rectangle_Limit,
Lreq.Poly_Fill_Rectangle_Req,
(1 => (X => X,
Y => Y,
Width => Width,
Height => Height)),
Lreq.Request_Position,
Lreq.Spaces_Left);
----If there are no Spaces_Left then the request is already on the way out
-- and we cannot add anything to it later.
if Lreq.Spaces_Left = 0 then
Lreq.Kind := Invalid_Request;
else
Lreq.Kind := Poly_Fill_Rectangle;
end if;
end if;
----Catch exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; return.
Unlock_Display (Display);
Sync_Handle (Display);
end X_Fill_Rectangle;
--\x0c
end Xlbp_Graphics;
nblk1=38
nid=0
hdr6=70
[0x00] rec0=23 rec1=00 rec2=01 rec3=038
[0x01] rec0=11 rec1=00 rec2=02 rec3=04a
[0x02] rec0=1d rec1=00 rec2=03 rec3=022
[0x03] rec0=1d rec1=00 rec2=04 rec3=032
[0x04] rec0=18 rec1=00 rec2=05 rec3=054
[0x05] rec0=21 rec1=00 rec2=06 rec3=010
[0x06] rec0=18 rec1=00 rec2=07 rec3=036
[0x07] rec0=25 rec1=00 rec2=08 rec3=074
[0x08] rec0=00 rec1=00 rec2=38 rec3=012
[0x09] rec0=1d rec1=00 rec2=09 rec3=00c
[0x0a] rec0=00 rec1=00 rec2=37 rec3=002
[0x0b] rec0=1a rec1=00 rec2=0a rec3=016
[0x0c] rec0=18 rec1=00 rec2=0b rec3=026
[0x0d] rec0=23 rec1=00 rec2=0c rec3=014
[0x0e] rec0=00 rec1=00 rec2=36 rec3=010
[0x0f] rec0=1e rec1=00 rec2=0d rec3=00a
[0x10] rec0=21 rec1=00 rec2=0e rec3=04a
[0x11] rec0=00 rec1=00 rec2=35 rec3=002
[0x12] rec0=1a rec1=00 rec2=0f rec3=06c
[0x13] rec0=19 rec1=00 rec2=10 rec3=034
[0x14] rec0=10 rec1=00 rec2=11 rec3=01a
[0x15] rec0=21 rec1=00 rec2=12 rec3=004
[0x16] rec0=1d rec1=00 rec2=13 rec3=048
[0x17] rec0=01 rec1=00 rec2=34 rec3=02e
[0x18] rec0=17 rec1=00 rec2=14 rec3=030
[0x19] rec0=19 rec1=00 rec2=15 rec3=01c
[0x1a] rec0=24 rec1=00 rec2=16 rec3=032
[0x1b] rec0=17 rec1=00 rec2=17 rec3=05c
[0x1c] rec0=14 rec1=00 rec2=18 rec3=058
[0x1d] rec0=24 rec1=00 rec2=19 rec3=00e
[0x1e] rec0=1e rec1=00 rec2=1a rec3=00e
[0x1f] rec0=20 rec1=00 rec2=1b rec3=008
[0x20] rec0=21 rec1=00 rec2=1c rec3=040
[0x21] rec0=1c rec1=00 rec2=1d rec3=012
[0x22] rec0=18 rec1=00 rec2=1e rec3=01e
[0x23] rec0=13 rec1=00 rec2=1f rec3=01a
[0x24] rec0=27 rec1=00 rec2=20 rec3=022
[0x25] rec0=00 rec1=00 rec2=33 rec3=020
[0x26] rec0=1c rec1=00 rec2=21 rec3=00c
[0x27] rec0=1e rec1=00 rec2=22 rec3=00c
[0x28] rec0=02 rec1=00 rec2=32 rec3=018
[0x29] rec0=1e rec1=00 rec2=23 rec3=04e
[0x2a] rec0=20 rec1=00 rec2=24 rec3=05c
[0x2b] rec0=00 rec1=00 rec2=31 rec3=002
[0x2c] rec0=1d rec1=00 rec2=25 rec3=014
[0x2d] rec0=16 rec1=00 rec2=26 rec3=012
[0x2e] rec0=12 rec1=00 rec2=27 rec3=03c
[0x2f] rec0=21 rec1=00 rec2=28 rec3=066
[0x30] rec0=21 rec1=00 rec2=29 rec3=038
[0x31] rec0=00 rec1=00 rec2=30 rec3=028
[0x32] rec0=1c rec1=00 rec2=2a rec3=036
[0x33] rec0=00 rec1=00 rec2=2f rec3=002
[0x34] rec0=21 rec1=00 rec2=2b rec3=036
[0x35] rec0=15 rec1=00 rec2=2c rec3=026
[0x36] rec0=18 rec1=00 rec2=2d rec3=006
[0x37] rec0=1f rec1=00 rec2=2e rec3=000
tail 0x217006cc2819782766c98 0x42a00088462063203