|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ B T ┃
Length: 44086 (0xac36)
Types: TextFile
Names: »B«
└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00
└─ ⟦0c20f784e⟧ »DATA«
└─⟦1abbe589f⟧
└─⟦059497ac5⟧
└─⟦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.
------------------------------------------------------------------------------
--\f
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;
--\f
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;
--\f
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;
--\f
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;
--\f
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;
--\f
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;
--\f
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;
--\f
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 : S_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;
--\f
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;
--\f
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;
--\f
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;
--\f
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;
--\f
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;
--\f
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;
--\f
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;
--\f
procedure X_Draw_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);
----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;
--\f
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 (Display);
Sync_Handle (Display);
end X_Fill_Rectangles;
--\f
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;
--\f
end Xlbp_Graphics;