|
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: 41197 (0xa0ed)
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_Basic;
use Xlbt_Basic;
with Xlbt_Display2;
use Xlbt_Display2;
with Xlbt_Error3;
use Xlbt_Error3;
with Xlbt_Event3;
use Xlbt_Event3;
with Xlbt_Exceptions;
use Xlbt_Exceptions;
with Xlbt_Extension3;
use Xlbt_Extension3;
with Xlbt_Proc_Var;
use Xlbt_Proc_Var;
with Xlbt_Reply;
use Xlbt_Reply;
with Xlbt_Request;
use Xlbt_Request;
with Xlbt_String;
use Xlbt_String;
with Xlbp_Error;
use Xlbp_Error;
with Xlbp_Proc_Var;
use Xlbp_Proc_Var;
with Xlbit_Library3;
use Xlbit_Library3;
with Xlbip_Internal;
use Xlbip_Internal;
with Xlbip_Wire_Converters;
use Xlbip_Wire_Converters;
with Xlbmt_Network_Types;
use Xlbmt_Network_Types;
with Xlbmp_Internal;
use Xlbmp_Internal;
with Xlbmp_Network_Interface;
use Xlbmp_Network_Interface;
package body Xlbmp_Get is
------------------------------------------------------------------------------
-- X Library X Server Get Routines
--
-- Xlbmp_Get - Receive info from the X Server
------------------------------------------------------------------------------
-- Copyright 1989 - 1991 by Rational, Santa Clara, California.
--
-- 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 name of Rational not be used in
-- advertising or publicity pertaining to distribution of the software
-- without specific, written prior permission.
--
-- Rational disclaims all warranties with regard to this software, including
-- all implied warranties of merchantability and fitness, in no event shall
-- 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
------------------------------------------------------------------------------
-- Length of any Event/Error that we can receive from the X server. They are
-- all the same size.
------------------------------------------------------------------------------
Event_Length : constant X_Raw_Data_Index := X_Button_Event'Size / 8;
--\f
procedure Get_Reply_Generic (Display : X_Display;
Code : X_Request_Code;
Reply : out Reply_Record;
Extra : S_Natural;
Discard : Boolean;
Status : out X_Status) is
------------------------------------------------------------------------------
-- Display - the display to read from
-- Code - the code for the request indicates the format of the reply
-- Reply - where to put the reply; if one is received
-- Extra - many replies receive extra data; we require at least this
-- much extra to be present or we regard it as an I/O error
-- Discard - TRUE to discard any extra extra data that may appear with the
-- reply
-- Status - Failed if we got an Error instead of a Reply
--
-- Read a reply to a request out of the network connection. You should only
-- request multiples of 4 bytes.
--
-- The Wire_To_Reply procedure has these arguments.
--
-- Code - Specifies the X_Request_Code of the reply
-- Raw - Specifies the raw 32-bytes of data representing the reply
-- Send_Event - Specifies TRUE if this reply was not sent by the server
-- Reply - Receives the converted reply record
-- Length - Specifies the number of additions words (groups of 4 bytes)
-- that make up the rest of the reply; including all variable
-- length data.
------------------------------------------------------------------------------
Rec_Next : X_Raw_Data_Index := 1;
Rec_Len : X_Raw_Data_Index := 0;
New_Next_M1 : X_Raw_Data_Index;
Copy_Amt : S_Natural;
Client_Sent : Boolean;
Sequence_No : U_Short;
Event_Code : X_Event_Code;
Er : X_Error_Contents;
Ret : Boolean := False;
Ret_Code : X_Status;
Ev : X_Event;
Len : S_Natural;
Ext : X_Extension;
Queue_It : X_Status;
----Pull out the serial number now, so that (currently illegal) requests
-- generated by an error handler don't confuse us.
Cur_Request : S_Long := Display.Request;
begin
----If we have gotten an I/O error then don't do more I/O.
if Display.Flags (Xlib_Display_Io_Error) then
return;
end if;
----Flush any pending output (such as the request whose reply we desire).
Internal_X_Flush_Display (Display);
----If there is any pending input in Display.Input then put that into our buffer
-- and add new information to it.
if Display.Input.Used < Display.Input.Data'Last then
if Display.Input.Used > 0 then
Receive_Maybe
(Display.Network.Fd,
Display.Network.Fd_Error,
Display.Input.Data
(Display.Input.Used + 1 .. Display.Input.Data'Last),
Rec_Len);
Display.Input.Used := Display.Input.Used + Rec_Len;
else
Receive_Must
(Display.Network.Fd,
Display.Network.Fd_Error,
Display.Input.Data (1 .. Event_Length),
Rec_Len);
Display.Input.Used := Rec_Len;
end if;
----See if our Receive had an error. Timed_Out is fine.
if Display.Network.Fd_Error /= Ok and then
Display.Network.Fd_Error /= Timed_Out then
Report_Io_Error (Display, "Receive");
end if;
end if;
----Loop until we've received a reply and we've used up all of the data in
-- our buffer that we can use up.
loop
----We can assume here that all Event/Error packets are the same size. However
-- we know that Reply packets are of differing lengths. This is
-- currently true. X11.V4 3/6/90. Calculate the end of the record.
--/ if Raw_Is_Unsigned then
if Display.Input.Data (Rec_Next) > 127 then
Client_Sent := True;
Event_Code := X_Event_Code'Val
(Display.Input.Data (Rec_Next) - 128);
else
Client_Sent := False;
Event_Code := X_Event_Code'Val (Display.Input.Data (Rec_Next));
end if;
--/ else
--// if Display.Input.Data (Rec_Next) < 0 then
--// Client_Sent := True;
--// Event_Code := X_Event_Code'Val
--// ((Display.Input.Data (Rec_Next) + 127) + 1);
--// else
--// Client_Sent := False;
--// Event_Code := X_Event_Code'Val (Display.Input.Data (Rec_Next));
--// end if;
--/ end if;
Sequence_No := U_Short (Display.Input.Data (Rec_Next + 2)) * 256 +
U_Short (Display.Input.Data (Rec_Next + 3));
Display.Input.Data (Rec_Next) := X_Event_Code'Pos (Event_Code);
if Event_Code = Reply_Event then
if Display.Reply_Size (Code) = 0 then
-- All replyable requests should have non-zero in there.
-- A zero value represents a bug; in us or in the server.
raise X_Library_Confusion;
end if;
New_Next_M1 := Rec_Next + Display.Reply_Size (Code) - 1;
else
New_Next_M1 := Rec_Next + Event_Length - 1;
end if;
----If there isn't enough data in the buffer to make up the next record then
-- we'll read in some more data. We watch to make sure that we don't overflow
-- the buffer.
if New_Next_M1 > Display.Input.Used then
if New_Next_M1 > Display.Input.Data'Last then
New_Next_M1 := Display.Input.Used;
Display.Input.Used := Display.Input.Used - Rec_Next + 1;
Display.Input.Data (1 .. Display.Input.Used) :=
Display.Input.Data (Rec_Next .. New_Next_M1);
Rec_Next := 1;
if Event_Code = Reply_Event then
New_Next_M1 := Display.Reply_Size (Code);
else
New_Next_M1 := Event_Length;
end if;
end if;
Receive_Maybe
(Display.Network.Fd,
Display.Network.Fd_Error,
Display.Input.Data
(Display.Input.Used + 1 .. Display.Input.Data'Last),
Rec_Len);
Display.Input.Used := Display.Input.Used + Rec_Len;
----If we timed out and there still isn't enough data to process then do a
-- receive of exactly the right amount of data and wait forever if we have to.
-- Check for errors as well.
if Display.Network.Fd_Error /= Ok and then
Display.Network.Fd_Error /= Timed_Out then
Report_Io_Error (Display, "Receive");
end if;
if New_Next_M1 > Display.Input.Used then
Receive_Must (Display.Network.Fd,
Display.Network.Fd_Error,
Display.Input.Data
(Display.Input.Used + 1 .. New_Next_M1),
Rec_Len);
Display.Input.Used := Display.Input.Used + Rec_Len;
if Display.Network.Fd_Error /= Ok then
Report_Io_Error (Display, "Receive");
end if;
end if;
end if;
----Take the next record and convert it appropriately.
case Event_Code is
----Error are converted and immediately reported except when they pertain to
-- the reply we were expecting. Do not call Display.X_Lib.Error on "no such
-- font", "can't allocate", and "can't grab" failures.
when Error_Event =>
Internal_Wire_To_Error
(Display,
Display.Input.Data (Rec_Next .. New_Next_M1),
Client_Sent,
Er);
----For each error type; see if the Sequence_Number is the same as the request
-- we just made. If so then see if we want to suppress this error.
if Er.Serial = Cur_Request then
case Er.Kind is
when Bad_Name =>
case Er.Nothing.Major_Opcode is
when Open_Font |
Lookup_Color |
Alloc_Named_Color =>
Status := Failed;
Rec_Next := Display.Input.Used;
Display.Input.Used :=
Display.Input.Used - New_Next_M1;
Display.Input.Data
(1 .. Display.Input.Used) :=
Display.Input.Data
(New_Next_M1 + 1 .. Rec_Next);
return;
when others =>
null;
end case;
when Bad_Alloc | Bad_Access =>
Status := Failed;
Rec_Next := Display.Input.Used;
Display.Input.Used :=
Display.Input.Used - New_Next_M1;
Display.Input.Data (1 .. Display.Input.Used) :=
Display.Input.Data
(New_Next_M1 + 1 .. Rec_Next);
return;
when Bad_Font =>
if Er.Resource.Major_Opcode = Query_Font then
Status := Failed;
Rec_Next := Display.Input.Used;
Display.Input.Used :=
Display.Input.Used - New_Next_M1;
Display.Input.Data
(1 .. Display.Input.Used) :=
Display.Input.Data
(New_Next_M1 + 1 .. Rec_Next);
return;
end if;
when others =>
null;
end case;
----The error made it this far; this error pertains to this request so
-- see if some Extension wants to suppress it.
Ext := Display.Ext_Procs;
while Ext /= null loop
if Ext.Error /= None_X_Procedure_Variable then
Proc_Var_X_Error_Extension.Call
(Proc_Var_X_Error_Extension.To_Pv
(Ext.Error),
Display, Er, Ext.Codes, Ret_Code, Ret);
end if;
if Ret then
Status := Ret_Code;
Rec_Next := Display.Input.Used;
Display.Input.Used :=
Display.Input.Used - New_Next_M1;
Display.Input.Data (1 .. Display.Input.Used) :=
Display.Input.Data
(New_Next_M1 + 1 .. Rec_Next);
return;
end if;
Ext := Ext.Next;
end loop;
Ret := True;
end if;
----An unsinkable error; report it and then return failure if it pertains to
-- the current request.
declare
Proc : X_Procedure_Variable;
begin
X_Lib.Get_Error (Display, Proc);
Proc_Var_X_Error_Function.Call
(Proc_Var_X_Error_Function.To_Pv (Proc),
Display, Er);
end;
if Er.Serial = Cur_Request then
Status := Failed;
Rec_Next := Display.Input.Used;
Display.Input.Used := Display.Input.Used - New_Next_M1;
Display.Input.Data (1 .. Display.Input.Used) :=
Display.Input.Data (New_Next_M1 + 1 .. Rec_Next);
return;
end if;
----We got a reply. It had better be the one we've been waiting for. Convert
-- the bytes into a real reply and compute the number of extra bytes sent.
when Reply_Event =>
if Sequence_No = U_Short (Cur_Request mod 16#1_0000#) then
Display.Last_Request_Read := Cur_Request;
else
Cur_Request := Internal_X_Set_Last_Request_Read
(Display, Event_Code, Sequence_No);
end if;
Wire_To_Reply (Code,
Display.Input.Data (Rec_Next .. New_Next_M1),
Client_Sent,
Reply,
Len);
----Len is in words, 4 bytes per word, add this to get the total length of the
-- server's reply.
Len := Len * 4
+ S_Natural (Event_Length)
- S_Natural (New_Next_M1 - Rec_Next + 1);
----Get rid of any extra data a) if there is some; b) he wanted that.
-- Otherwise we return and we assume that our caller will eat it later.
if Discard then
Copy_Amt := Len;
if Copy_Amt <= S_Natural (Display.Input.Used -
New_Next_M1) then
New_Next_M1 := New_Next_M1 +
X_Raw_Data_Index (Copy_Amt);
else
Copy_Amt := Copy_Amt -
S_Natural (Display.Input.Used -
New_Next_M1);
loop
if Copy_Amt >
S_Natural (Display.Input.Data'Last) then
Rec_Next := Display.Input.Data'Last;
else
Rec_Next := X_Raw_Data_Index (Copy_Amt);
end if;
Receive_Must
(Display.Network.Fd,
Display.Network.Fd_Error,
Display.Input.Data (1 .. Rec_Next),
Rec_Len);
if Display.Network.Fd_Error /= Ok then
Report_Io_Error (Display, "Receive");
end if;
Copy_Amt := Copy_Amt - S_Natural (Rec_Len);
if Copy_Amt = 0 then
exit;
end if;
end loop;
New_Next_M1 := Display.Input.Used;
end if;
end if;
Rec_Next := Display.Input.Used;
Display.Input.Used := Display.Input.Used - New_Next_M1;
Display.Input.Data (1 .. Display.Input.Used) :=
Display.Input.Data (New_Next_M1 + 1 .. Rec_Next);
----See if the reply was shorter then we expected. This constitutes an I/O
-- error.
if Extra > Len then
declare
Proc : X_Procedure_Variable;
begin
X_Lib.Get_Io_Error (Display, Proc);
Err (Display.Last_Error,
X_Get_Error_String
("XlibError", "ReplyShort",
"Reply shorter than was requested."));
Proc_Var_X_Io_Error_Function.Call
(Proc_Var_X_Io_Error_Function.To_Pv (Proc),
Display);
raise X_Network_Io_Error;
end;
end if;
Status := Successful;
return;
----Everything else is assumed to be an Event.
when others =>
Proc_Var_X_Wire_Event.Call
(Proc_Var_X_Wire_Event.To_Pv
(Display.Event_Vec (Event_Code)),
Display,
Display.Input.Data (Rec_Next .. New_Next_M1),
Client_Sent,
Ev,
Queue_It);
if Queue_It = Successful then
Internal_X_Enq (Display, Ev);
end if;
end case;
----Advance to the next record from the input (make sure there IS one). If
-- there isn't a next record then we must get one. They are all at least
-- Event_Length in length so require that we get at least that many and wait
-- forever if we have to.
Rec_Next := New_Next_M1 + 1;
if Rec_Next > Display.Input.Used then
Display.Input.Used :=
0; -- May as well reset buffer position.
Rec_Next := 1;
Receive_Must (Display.Network.Fd,
Display.Network.Fd_Error,
Display.Input.Data (1 .. Event_Length),
Rec_Len);
Display.Input.Used := Rec_Len;
if Display.Network.Fd_Error /= Ok then
Report_Io_Error (Display, "Receive");
end if;
end if;
end loop;
end Get_Reply_Generic;
--\f
procedure Get_Data_Private (Display : X_Display;
D : out Original) is
------------------------------------------------------------------------------
-- For Discrete and ordinary Private types.
--
-- Read some data from the network connection. Typically only called when
-- you've previously called Get_Reply or some such and you now want to read
-- data that you know is there.
-- Original - this is the type of data that needs to be sent
-- Original_Size - all X protocol requests are 32 bytes long, this value
-- corresponds to the number of X_Raw_Data items
-- From_Raw - converts the data to X_Raw_Data
-- Display - display to receive the request
-- D - the data to send
------------------------------------------------------------------------------
Data_Length : X_Raw_Data_Index;
Point : X_Raw_Data_Index;
begin
----If there's data in the input buffer to satisfy the request then use that.
-- Copy remaining data at end-of-buffer down to beginning-of-buffer. We do
-- this kind of thing instead of having a begin-data/end-data pointer pair
-- because the amount of data in the buffer will typically be exactly right
-- and the copy becomes a no-op.
if Display.Input.Used >= Original_Size then
From_Raw (D, Display.Input.Data (1 .. Original_Size));
Point := Display.Input.Used;
Display.Input.Used := Display.Input.Used - Original_Size;
Display.Input.Data (1 .. Display.Input.Used) :=
Display.Input.Data (Original_Size + 1 .. Point);
return;
end if;
----We need more data. If Original_Size will fit into the Display buffer then
-- read it into there.
if Original_Size <= Display.Input.Data'Last then
Receive_Must (Display.Network.Fd,
Display.Network.Fd_Error,
Display.Input.Data
(Display.Input.Used + 1 .. Original_Size),
Data_Length);
if Display.Network.Fd_Error /= Ok then
Report_Io_Error (Display, "Receive");
end if;
From_Raw (D, Display.Input.Data (1 .. Original_Size));
Display.Input.Used := 0;
return;
end if;
----Create a buffer area that's big-enough; we won't assume that the type he's
-- receiving will fit into Display.Input.Data. Copy the old data in and
-- Receive however much new data we require. Then do the conversion.
declare
Raw : X_Raw_Data_List;
begin
Raw := new X_Raw_Data_Array (1 .. Original_Size);
Point := Display.Input.Used + 1;
Raw (1 .. Display.Input.Used) :=
Display.Input.Data (1 .. Display.Input.Used);
Display.Input.Used := 0;
Receive_Must (Display.Network.Fd,
Display.Network.Fd_Error,
Raw (Point .. Original_Size),
Data_Length);
if Display.Network.Fd_Error /= Ok then
Report_Io_Error (Display, "Receive");
end if;
From_Raw (D, Raw.all);
Free_X_Raw_Data_List (Raw);
end;
end Get_Data_Private;
--\f
procedure Get_Large_Data_1d (Display : X_Display;
D : out Original_Array) is
------------------------------------------------------------------------------
-- For one-dimensional array types where the element type is "large". A
-- "large" type is any type whose 'Size is a multiple of 32 bits.
--
-- If you get a Constraint_Error when elaborating this generic then you have
-- tried to instantiate it with a type whose 'Size is not N*32.
--
-- Read some data from the network connection. Typically only called when
-- you've previously called Get_Reply or some such and you now want to read
-- data that you know is there.
-- Original - this is the type of data that needs to be sent
-- Original_Size - all X protocol requests are 32 bytes long, this value
-- corresponds to the number of X_Raw_Data items
-- Index - this is the index type for the array type
-- Original_Array - this is the array type
-- From_Raw - converts the data to X_Raw_Data
-- Display - display to receive the request
-- D - the data to send
------------------------------------------------------------------------------
Total_Size : S_Natural := S_Natural (Original_Size) * D'Length;
Data_Length : X_Raw_Data_Index;
Point1 : X_Raw_Data_Index;
Point2 : X_Raw_Data_Index;
Next : S_Long;
Incr : S_Long;
begin
----If there's data in the input buffer to satisfy the request then use that.
-- Copy remaining data at end-of-buffer down to beginning-of-buffer. We do
-- this kind of thing instead of having a begin-data/end-data pointer pair
-- because the amount of data in the buffer will typically be exactly right
-- and the copy becomes a no-op.
if S_Natural (Display.Input.Used) >= Total_Size then
From_Raw (D, Display.Input.Data (1 ..
X_Raw_Data_Index (Total_Size)));
Point1 := X_Raw_Data_Index (Total_Size);
Point2 := Display.Input.Used;
Display.Input.Used := Display.Input.Used - Point1;
Display.Input.Data (1 .. Display.Input.Used) :=
Display.Input.Data (Point1 + 1 .. Point2);
return;
end if;
----We need more data. If Total_Size will fit into the Display buffer then
-- read it into there.
if Total_Size <= S_Natural (Display.Input.Data'Last) then
Receive_Must (Display.Network.Fd,
Display.Network.Fd_Error,
Display.Input.Data (Display.Input.Used + 1 ..
X_Raw_Data_Index (Total_Size)),
Data_Length);
if Display.Network.Fd_Error /= Ok then
Report_Io_Error (Display, "Receive");
end if;
From_Raw (D, Display.Input.Data (1 ..
X_Raw_Data_Index (Total_Size)));
Display.Input.Used := 0;
return;
end if;
----Read the array elements a few at a time.
Next := S_Long (D'First);
Incr := S_Long (Display.Input.Data'Last / Original_Size);
Point1 := Original_Size * X_Raw_Data_Index (Incr);
----First we read them one complete Display.Input.Data buffer-full at a time.
while S_Long (D'Last) - Next >= Incr loop
Receive_Must (Display.Network.Fd,
Display.Network.Fd_Error,
Display.Input.Data (Display.Input.Used + 1 .. Point1),
Data_Length);
if Display.Network.Fd_Error /= Ok then
Report_Io_Error (Display, "Receive");
end if;
From_Raw (D (Index (Next) .. Index (Next + Incr - 1)),
Display.Input.Data (1 .. Point1));
Next := Next + Incr;
end loop;
----Finally we read whatever is left to read.
if Next <= S_Long (D'Last) then
Point1 := Original_Size * X_Raw_Data_Index
(S_Long (D'Last) - Next + 1);
Receive_Must (Display.Network.Fd,
Display.Network.Fd_Error,
Display.Input.Data (1 .. Point1),
Data_Length);
if Display.Network.Fd_Error /= Ok then
Report_Io_Error (Display, "Receive");
end if;
From_Raw (D (Index (Next) .. D'Last),
Display.Input.Data (1 .. Point1));
end if;
Display.Input.Used := 0;
end Get_Large_Data_1d;
--\f
procedure Get_Small_Data_1d (Display : X_Display;
D : out Original_Array) is
------------------------------------------------------------------------------
-- For one-dimensional array types where the element type is "small". A
-- "small" type is any type whose 'Size is less than 32 bits. This is
-- expected to be used for 8 and 16 bit data types. Other sizes of
-- data will probably not work properly.
--
-- If you get a Constraint_Error when elaborating this generic then you have
-- tried to instantiate it with a type whose 'Size is greater than 32.
--
-- Read some data from the network connection. Typically only called when
-- you've previously called Get_Reply or some such and you now want to read
-- data that you know is there.
-- Original - this is the type of data that needs to be sent
-- Original_Size - all X protocol requests are 32 bytes long, this value
-- corresponds to the number of X_Raw_Data items
-- Index - this is the index type for the array type
-- Original_Array - this is the array type
-- From_Raw - converts the data to X_Raw_Data
-- Display - display to receive the request
-- D - the data to send
------------------------------------------------------------------------------
Total_Data_Size : S_Natural := S_Natural (Original_Size) * D'Length;
Total_Xfer_Size : S_Natural := (Total_Data_Size + 3) / 4 * 4;
Data_Length : X_Raw_Data_Index;
Point1 : X_Raw_Data_Index;
Point2 : X_Raw_Data_Index;
Next : S_Long;
Incr : S_Long;
begin
----If there's data in the input buffer to satisfy the request then use that.
-- Copy remaining data at end-of-buffer down to beginning-of-buffer. We do
-- this kind of thing instead of having a begin-data/end-data pointer pair
-- because the amount of data in the buffer will typically be exactly right
-- and the copy becomes a no-op.
if S_Natural (Display.Input.Used) >= Total_Xfer_Size then
From_Raw
(D,
Display.Input.Data (1 .. X_Raw_Data_Index (Total_Data_Size)));
Point1 := X_Raw_Data_Index (Total_Xfer_Size);
Point2 := Display.Input.Used;
Display.Input.Used := Display.Input.Used - Point1;
Display.Input.Data (1 .. Display.Input.Used) :=
Display.Input.Data (Point1 + 1 .. Point2);
return;
end if;
----We need more data. If Total_Xfer_Size will fit into the Display buffer then
-- read it into there.
if Total_Xfer_Size <= S_Natural (Display.Input.Data'Last) then
Point1 := X_Raw_Data_Index (Total_Xfer_Size);
Point2 := X_Raw_Data_Index (Total_Data_Size);
Receive_Must (Display.Network.Fd,
Display.Network.Fd_Error,
Display.Input.Data (Display.Input.Used + 1 .. Point1),
Data_Length);
if Display.Network.Fd_Error /= Ok then
Report_Io_Error (Display, "Receive");
end if;
From_Raw (D, Display.Input.Data (1 .. Point2));
Display.Input.Used := 0;
return;
end if;
----Read the array elements a few at a time.
Next := S_Long (D'First);
Incr := S_Long (Display.Input.Data'Last / Original_Size);
Point1 := Original_Size * X_Raw_Data_Index (Incr);
Point2 := Point1;
----First we read them one complete Display.Input.Data buffer-full at a time.
while Total_Xfer_Size >= S_Natural (Point1) loop
Receive_Must (Display.Network.Fd,
Display.Network.Fd_Error,
Display.Input.Data (Display.Input.Used + 1 .. Point1),
Data_Length);
if Display.Network.Fd_Error /= Ok then
Report_Io_Error (Display, "Receive");
end if;
if S_Long (D'Last) - Next + 1 < Incr then
Incr := S_Long (D'Last) - Next + 1;
Point2 := Original_Size * X_Raw_Data_Index (Incr);
end if;
if Incr > 0 then
From_Raw (D (Index (Next) .. Index (Next + Incr - 1)),
Display.Input.Data (1 .. Point2));
Next := Next + Incr;
end if;
Total_Xfer_Size := Total_Xfer_Size - S_Natural (Point1);
end loop;
----Finally we read whatever is left to read.
if Total_Xfer_Size > 0 then
Point1 := X_Raw_Data_Index (Total_Xfer_Size);
Receive_Must (Display.Network.Fd,
Display.Network.Fd_Error,
Display.Input.Data (1 .. Point1),
Data_Length);
if Display.Network.Fd_Error /= Ok then
Report_Io_Error (Display, "Receive");
end if;
if S_Long (D'Last) - Next + 1 < Incr then
Incr := S_Long (D'Last) - Next + 1;
Point2 := Original_Size * X_Raw_Data_Index (Incr);
end if;
if Incr > 0 then
From_Raw (D (Index (Next) .. Index (Next + Incr - 1)),
Display.Input.Data (1 .. Point2));
end if;
end if;
Display.Input.Used := 0;
end Get_Small_Data_1d;
--\f
procedure Get_Data_2d (Display : X_Display;
D : out Original_Array) is
------------------------------------------------------------------------------
-- For two-dimensional array types.
--
-- Read some data from the network connection. Typically only called when
-- you've previously called Get_Reply or some such and you now want to read
-- data that you know is there.
-- Original - this is the type of data that needs to be sent
-- Original_Size - all X protocol requests are 32 bytes long, this value
-- corresponds to the number of X_Raw_Data items
-- Index1 - this is the first index type for the array type
-- Index2 - this is the second index type for the array type
-- Original_Array - this is the array type
-- From_Raw - converts the data to X_Raw_Data
-- Display - display to receive the request
-- D - the data to send
------------------------------------------------------------------------------
Total_Size : X_Raw_Data_Index :=
Original_Size * D'Length (1) * D'Length (2);
Data_Length : X_Raw_Data_Index;
Point : X_Raw_Data_Index;
begin
----If there's data in the input buffer to satisfy the request then use that.
-- Copy remaining data at end-of-buffer down to beginning-of-buffer. We do
-- this kind of thing instead of having a begin-data/end-data pointer pair
-- because the amount of data in the buffer will typically be exactly right
-- and the copy becomes a no-op.
if Display.Input.Used >= Total_Size then
From_Raw (D, Display.Input.Data (1 .. Total_Size));
Point := Display.Input.Used;
Display.Input.Used := Display.Input.Used - Total_Size;
Display.Input.Data (1 .. Display.Input.Used) :=
Display.Input.Data (Total_Size + 1 .. Point);
return;
end if;
----We need more data. If Total_Size will fit into the Display buffer then
-- read it into there.
if Total_Size <= Display.Input.Data'Last then
Receive_Must (Display.Network.Fd,
Display.Network.Fd_Error,
Display.Input.Data
(Display.Input.Used + 1 .. Total_Size),
Data_Length);
if Display.Network.Fd_Error /= Ok then
Report_Io_Error (Display, "Receive");
end if;
From_Raw (D, Display.Input.Data (1 .. Total_Size));
Display.Input.Used := 0;
return;
end if;
----Read the array elements one at a time. You can't slice a 2-D array.
declare
procedure Get_Data is
new Get_Data_Private (Original, From_Raw);
begin
for I in D'Range (1) loop
for J in D'Range (2) loop
Get_Data (Display, D (I, J));
end loop;
end loop;
end;
end Get_Data_2d;
--\f
procedure Eat_Data_Raw (Display : X_Display;
Amount : S_Natural) is
------------------------------------------------------------------------------
-- Read some data from the network connection. Typically only called when
-- you've previously called Get_Reply or some such and you now want to read
-- data that you know is there.
------------------------------------------------------------------------------
Data_Length : S_Natural;
Point1 : X_Raw_Data_Index;
Point2 : X_Raw_Data_Index;
begin
----Always eat full words.
Data_Length := (Amount + 3) / 4 * 4;
----If there's data in the input buffer to satisfy the request then use that.
-- Copy remaining data at end-of-buffer down to beginning-of-buffer. We do
-- this kind of thing instead of having a begin-data/end-data pointer pair
-- because the amount of data in the buffer will typically be exactly right
-- and the copy becomes a no-op.
if S_Natural (Display.Input.Used) >= Data_Length then
Point1 := X_Raw_Data_Index (Data_Length);
Point2 := Display.Input.Used;
Display.Input.Used := Display.Input.Used - Point1;
Display.Input.Data (1 .. Display.Input.Used) :=
Display.Input.Data (Point1 + 1 .. Point2);
return;
end if;
----Eliminate as much data as we have. Then do a/some Receive(s) for the rest.
Data_Length := Data_Length - S_Natural (Display.Input.Used);
Display.Input.Used := 0;
while Data_Length > 0 loop
if Data_Length > S_Natural (Display.Input.Data'Last) then
Point1 := Display.Input.Data'Last;
else
Point1 := X_Raw_Data_Index (Data_Length);
end if;
Receive_Must (Display.Network.Fd,
Display.Network.Fd_Error,
Display.Input.Data (1 .. Point1),
Point2);
if Display.Network.Fd_Error /= Ok then
Report_Io_Error (Display, "Receive");
end if;
Data_Length := Data_Length - S_Natural (Point2);
end loop;
end Eat_Data_Raw;
--\f
end Xlbmp_Get;