|
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 - metrics - download
Length: 12288 (0x3000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Line_Buffer_Unbounded_Width, seg_0046de
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with String_Utilities;
with Table_Sort_Generic;
package body Line_Buffer_Unbounded_Width is
procedure Reset (The_Buffer : in out Buffer) is
begin
The_Buffer.Current := 1;
The_Buffer.Size := 0;
end Reset;
procedure Append (The_Buffer : Buffer;
To : in out Buffer) is
begin
if The_Buffer.Size + To.Size > To.Length then
raise Overflow;
else
for I in 1 .. The_Buffer.Size loop
Unbounded.Copy (To.Buf (To.Current + I - 1),
Unbounded.Image (The_Buffer.Buf (I)));
end loop;
To.Current := To.Current + The_Buffer.Size;
To.Size := To.Size + The_Buffer.Size;
end if;
end Append;
procedure Append_Line (The_Line : Line; To : in out Buffer) is
begin
if To.Current > To.Length then
raise Overflow;
else
Unbounded.Copy (To.Buf (To.Current), The_Line);
To.Current := To.Current + 1;
To.Size := To.Size + 1;
end if;
end Append_Line;
procedure Prepend_Line (The_Line : Line; To : in out Buffer) is
begin
if To.Current > To.Length then
raise Overflow;
else
for I in reverse 1 .. To.Current loop
Unbounded.Copy (To.Buf (I + 1), Unbounded.Image (To.Buf (I)));
end loop;
Unbounded.Copy (To.Buf (1), The_Line);
To.Current := To.Current + 1;
To.Size := To.Size + 1;
end if;
end Prepend_Line;
procedure Overwrite (The_Line : Line;
At_Location : Positive;
To : in out Buffer) is
begin
if At_Location <= To.Length and At_Location <= To.Size then
Unbounded.Copy (To.Buf (At_Location), The_Line);
else
raise Overflow;
end if;
end Overwrite;
procedure Remove (Line_At_Location : Positive;
In_Buffer : in out Buffer) is
begin
if Line_At_Location <= In_Buffer.Size then
In_Buffer.Buf (Line_At_Location .. In_Buffer.Size - 1) :=
In_Buffer.Buf (Line_At_Location + 1 .. In_Buffer.Size);
In_Buffer.Size := In_Buffer.Size - 1;
In_Buffer.Current := In_Buffer.Current - 1;
else
raise Overflow;
end if;
end Remove;
function Buffer_Length (Of_Buffer : Buffer) return Natural is
begin
return Natural (Of_Buffer.Size);
end Buffer_Length;
function String_Image (Of_Buffer : Buffer; Add_Line_Feeds : Boolean := True)
return String is
Image : Unbounded.Variable_String;
begin
for I in 1 .. Of_Buffer.Size loop
Unbounded.Append (Image, Unbounded.Image (Of_Buffer.Buf (I)));
if Add_Line_Feeds then
Unbounded.Append (Image, Ascii.Lf);
end if;
end loop;
return Unbounded.Image (Image);
end String_Image;
procedure Prepend (Text : String; To_All_Lines_In_Buffer : in out Buffer) is
begin
for I in 1 .. To_All_Lines_In_Buffer.Size loop
Unbounded.Insert (To_All_Lines_In_Buffer.Buf (I), 1, Text);
end loop;
exception
when Constraint_Error =>
raise Overflow;
end Prepend;
procedure Append (Text : String; To_All_Lines_In_Buffer : in out Buffer) is
begin
for I in 1 .. To_All_Lines_In_Buffer.Size loop
Unbounded.Append (To_All_Lines_In_Buffer.Buf (I), Text);
end loop;
exception
when Constraint_Error =>
raise Overflow;
end Append;
procedure Modify (The_Buffer : in out Buffer) is
begin
for I in 1 .. The_Buffer.Size loop
Unbounded.Copy (The_Buffer.Buf (I),
Process (Unbounded.Image (The_Buffer.Buf (I))));
end loop;
end Modify;
procedure Strip (The_Buffer : in out Buffer; Char : Character := ' ') is
function Process (The_Line : Line) return Line is
begin
return String_Utilities.Strip (The_Line, Char);
end Process;
procedure Str is new Modify (Process);
begin
Str (The_Buffer);
end Strip;
procedure Strip_Leading (The_Buffer : in out Buffer;
Char : Character := ' ') is
function Process (The_Line : Line) return Line is
begin
return String_Utilities.Strip_Leading (The_Line, Char);
end Process;
procedure Str is new Modify (Process);
begin
Str (The_Buffer);
end Strip_Leading;
procedure Strip_Trailing (The_Buffer : in out Buffer;
Char : Character := ' ') is
function Process (The_Line : Line) return Line is
begin
return String_Utilities.Strip_Trailing (The_Line, Char);
end Process;
procedure Str is new Modify (Process);
begin
Str (The_Buffer);
end Strip_Trailing;
procedure Filter (The_Buffer : in out Buffer) is
Filtered_Buffer : Buffer (The_Buffer.Length);
begin
for I in 1 .. The_Buffer.Size loop
declare
Line : constant String := Unbounded.Image (The_Buffer.Buf (I));
begin
if not Discard (Line) then
Append_Line (Line, To => Filtered_Buffer);
end if;
end;
end loop;
The_Buffer := Filtered_Buffer;
end Filter;
procedure Sort (The_Buffer : in out Buffer) is
The_Buf : Buffer_Lines (1 .. The_Buffer.Size) :=
The_Buffer.Buf (1 .. The_Buffer.Size);
function "<" (Left, Right : Var_String) return Boolean is
begin
return Unbounded.Image (Left) < Unbounded.Image (Right);
end "<";
procedure Buffer_Sort is
new Table_Sort_Generic (Var_String, Positive, Buffer_Lines, "<");
begin
Buffer_Sort (The_Buf);
The_Buffer.Buf (1 .. The_Buffer.Size) := The_Buf;
end Sort;
function Max (Left, Right : Natural) return Positive is
begin
if Left > Right then
return Left;
else
return Right;
end if;
end Max;
procedure Left_Right_Justify (The_Buffer : in out Buffer) is
Max_Break : Natural := 0;
begin
for I in 1 .. The_Buffer.Size loop
declare
Line : constant String := Unbounded.Image (The_Buffer.Buf (I));
Current_Break : Natural := Break_Point (Line);
begin
if Current_Break > Line'Last or else
Current_Break < Line'First then
null;
else
Max_Break := Max (Max_Break, Current_Break);
end if;
end;
end loop;
for I in 1 .. The_Buffer.Size loop
declare
Line : constant String := Unbounded.Image (The_Buffer.Buf (I));
Current_Break : constant Positive := Break_Point (Line);
Pad : constant String (1 .. Max_Break - Current_Break + 1) :=
(others => ' ');
begin
if Current_Break > Line'Last or else
Current_Break < Line'First then
Unbounded.Copy (The_Buffer.Buf (I), Line);
else
Unbounded.Copy (The_Buffer.Buf (I),
Line (Line'First .. Current_Break - 1) &
Pad & Line (Current_Break .. Line'Last));
end if;
end;
end loop;
end Left_Right_Justify;
procedure Display (The_Buffer : Buffer) is
begin
for I in 1 .. The_Buffer.Size loop
Put_Line (Unbounded.Image (The_Buffer.Buf (I)));
end loop;
end Display;
procedure Init (Iter : in out Iterator; From_Buffer : Buffer) is
begin
Iter := new Buffer'(From_Buffer);
Iter.Current := 1;
end Init;
function Done (Iter : Iterator) return Boolean is
begin
return Iter.Current > Iter.Size;
end Done;
function Value (Iter : Iterator) return Line is
begin
return Unbounded.Image (Iter.Buf (Iter.Current));
end Value;
procedure Next (Iter : in out Iterator) is
begin
Iter.Current := Iter.Current + 1;
end Next;
end Line_Buffer_Unbounded_Width;
nblk1=b
nid=0
hdr6=16
[0x00] rec0=21 rec1=00 rec2=01 rec3=008
[0x01] rec0=00 rec1=00 rec2=0b rec3=00c
[0x02] rec0=1a rec1=00 rec2=02 rec3=018
[0x03] rec0=01 rec1=00 rec2=0a rec3=006
[0x04] rec0=1b rec1=00 rec2=03 rec3=052
[0x05] rec0=1e rec1=00 rec2=04 rec3=026
[0x06] rec0=1f rec1=00 rec2=05 rec3=056
[0x07] rec0=1d rec1=00 rec2=06 rec3=066
[0x08] rec0=1f rec1=00 rec2=07 rec3=076
[0x09] rec0=18 rec1=00 rec2=08 rec3=098
[0x0a] rec0=24 rec1=00 rec2=09 rec3=000
tail 0x217002a40815c673b7e7f 0x42a00088462061e03