|
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 - metrics - downloadIndex: B T
Length: 26144 (0x6620)
Types: TextFile
Names: »B«
└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
└─⟦5cb1d1d7f⟧ »DATA«
└─⟦3b1ee7bd8⟧
└─⟦this⟧
with Text_Io;
use Text_Io;
with Calendar;
use Calendar;
with String_Pkg;
use String_Pkg;
with Unchecked_Deallocation;
package body Simple_Paginated_Output is
package Int_Io is new Integer_Io (Integer);
Month_Name : constant Variable_String_Array (1 .. 12) :=
(1 => Create ("January"),
2 => Create ("February"),
3 => Create ("March"),
4 => Create ("April"),
5 => Create ("May"),
6 => Create ("June"),
7 => Create ("July"),
8 => Create ("August"),
9 => Create ("September"),
10 => Create ("October"),
11 => Create ("November"),
12 => Create ("December"));
function Convert (Input_Number : in Integer; Digit : in Integer := 0)
return String is
--|-Algorithm:
--| If integer value is negative or greater than 99
--| then return null text
--| If input value is less than 10 (ie. single decimal digit)
--| then concatenate 0 and character equivalent of the given value
--| else convert value to character equivalent
--| Return converted text
--|+
Temp_Text : String (1 .. 16);
Index : Integer;
begin
if Digit > Temp_Text'Last then
return "";
end if;
Int_Io.Put (Temp_Text, Input_Number);
if Digit <= 0 then
Index := Temp_Text'Last;
for I in Temp_Text'Range loop
if Temp_Text (I) /= ' ' then
Index := I;
exit;
end if;
end loop;
else
Index := Temp_Text'Last - Digit + 1;
for I in Index .. Temp_Text'Last loop
if Temp_Text (I) = ' ' then
Temp_Text (I) := '0';
end if;
end loop;
end if;
return Temp_Text (Index .. Temp_Text'Last);
end Convert;
pragma Page;
procedure Set_Date_Time (File_Handle : in Paginated_File_Handle) is
--|-Algorithm:
--| Get the current system date/time
--| Separate date/time into appropriate components
--| Calculate in terms of hours, minutes, and seconds
--| Set current date/time in the file structure
--| Set the current date in "English" (eg. January 1, 1985)
--| in the file structure
--| Exit
--|+
Clock_Value : Calendar.Time;
Year : Calendar.Year_Number;
Month : Calendar.Month_Number;
Day : Calendar.Day_Number;
Duration : Calendar.Day_Duration;
begin
Clock_Value := Calendar.Clock;
Calendar.Split (Clock_Value, Year, Month, Day, Duration);
File_Handle.Current_Date := Convert (Integer (Month), 2) & "/" &
Convert (Integer (Day), 2) & "/" &
Convert (Integer (Year mod 100), 2);
File_Handle.Current_Time :=
Convert (Integer (Duration) / (60 * 60), 2) & ":" &
Convert ((Integer (Duration) mod (60 * 60)) / 60, 2) &
":" & Convert (Integer (Duration) mod 60, 2);
String_Pkg.Mark;
File_Handle.Current_Calendar :=
String_Pkg.Make_Persistent
(Month_Name (Integer (Month)) &
Integer'Image (Day) & "," & Integer'Image (Year));
String_Pkg.Release;
end Set_Date_Time;
pragma Page;
procedure Check_Valid (File_Handle : in Paginated_File_Handle) is
--|-Algorithm:
--| If handle is null or external file name is null
--| then raise an error
--| Exit
--|+
begin
if File_Handle = null then
raise Invalid_File;
end if;
end Check_Valid;
pragma Page;
procedure Clear_Text (Text_Handle : in Variable_String_Array_Handle) is
--|-Algorithm:
--| If valid access to text array
--| then return text array storage to the heap (access set to null)
--| Exit
--|+
begin
if Text_Handle /= null then
for I in Text_Handle'Range loop
String_Pkg.Flush (Text_Handle (I));
end loop;
end if;
end Clear_Text;
pragma Page;
procedure Set_Text (File_Handle : in Paginated_File_Handle;
Text_String : in Variable_String_Array) is
--|-Algorithm:
--| Validate paginated file structure (raise error if not valid)
--| If requested text array is too large
--| then raise an error
--| Clear old text array
--| Set new text array with specified justification (top or bottom)
--| in the area as specified
--| Exit
--|+
Text_Index : Integer;
begin
Check_Valid (File_Handle);
Text_Index := 1;
if File_Handle.Header_Size < Text_String'Last then
raise Text_Overflow;
end if;
Clear_Text (File_Handle.Page_Header);
for I in Text_String'Range loop
File_Handle.Page_Header (Text_Index) :=
String_Pkg.Make_Persistent (Text_String (I));
Text_Index := Text_Index + 1;
end loop;
end Set_Text;
pragma Page;
function Tilde_Substitute
(File_Handle : in Paginated_File_Handle;
Input_Text : in String_Pkg.String_Type) return String is
--|-Algorithm:
--| Set the length of the text in question
--| Clear the result string to null
--| Loop until all input characters are processed
--| Fetch one character
--| If the character is a tilde (~)
--| then bump input index and if past the end exit the loop
--| Fetch the next character
--| Based on this character substitute appropriately
--| else add this to the output
--| Bump input index and loop
--| Return the output (substituted) string
--| Exit
--|+
Output_Text : String_Pkg.String_Type;
S_Str : String_Pkg.String_Type;
Letter : Character;
Index : Natural;
begin
S_Str := Input_Text;
loop
Index := String_Pkg.Match_C (S_Str, '~');
if Index = 0 then
Output_Text := Output_Text & S_Str;
exit;
end if;
if Index > 1 then
Output_Text := Output_Text &
String_Pkg.Substr (S_Str, 1, Index - 1);
end if;
if Index < String_Pkg.Length (S_Str) then
Letter := String_Pkg.Fetch (S_Str, Index + 1);
else
exit;
end if;
case Letter is
when 'f' | 'F' =>
Output_Text := Output_Text & File_Handle.File_Name;
when 'c' | 'C' =>
Output_Text := Output_Text & File_Handle.Current_Calendar;
when 'd' | 'D' =>
Output_Text := Output_Text & File_Handle.Current_Date;
when 't' | 'T' =>
Output_Text := Output_Text & File_Handle.Current_Time;
when 'p' | 'P' =>
Output_Text := Output_Text &
Convert (File_Handle.Current_Page, 0);
when others =>
Output_Text := Output_Text & ("" & Letter);
end case;
Index := Index + 2;
if Index > String_Pkg.Length (S_Str) then
exit;
end if;
S_Str := String_Pkg.Substr (S_Str, Index,
String_Pkg.Length (S_Str) - Index + 1);
end loop;
return String_Pkg.Value (Output_Text);
end Tilde_Substitute;
pragma Page;
procedure Put_Text (File_Handle : in Paginated_File_Handle) is
--|-Algorithm:
--| If access to text array is null
--| then write appropriate number of line terminators
--| exit
--| Loop over the depth of the text array
--| If text is null
--| then write line terminator
--| else resolve tilde substitution
--| write a line of text followed by a line terminator
--| Exit
--|+
Text_Size : Integer;
begin
if File_Handle.Header_Size = 0 then
return;
end if;
Text_Size := File_Handle.Header_Size;
if File_Handle.Page_Header = null then
Text_Io.New_Line (File_Handle.File_Reference,
Text_Io.Positive_Count (Text_Size));
return;
end if;
for I in 1 .. Text_Size loop
String_Pkg.Mark;
if String_Pkg.Is_Empty (File_Handle.Page_Header (I)) then
Text_Io.New_Line (File_Handle.File_Reference, 1);
else
Text_Io.Put_Line
(File_Handle.File_Reference,
Tilde_Substitute
(File_Handle, File_Handle.Page_Header (I)));
end if;
String_Pkg.Release;
end loop;
end Put_Text;
pragma Page;
procedure Free_Structure is
new Unchecked_Deallocation
(Paginated_File_Structure, Paginated_File_Handle);
procedure Abort_Paginated_Output
(File_Handle : in out Paginated_File_Handle) is
--|-Algorithm:
--| If given handle is null
--| return
--| Return header/footer text array storage to the heap
--| Close file
--| Return file structure storage to the heap
--| Exit
--|+
begin
if File_Handle = null then
return;
end if;
Clear_Text (File_Handle.Page_Header);
String_Pkg.Flush (File_Handle.Current_Calendar);
String_Pkg.Flush (File_Handle.File_Name);
Text_Io.Close (File_Handle.File_Reference);
Free_Structure (File_Handle);
exception
when Text_Io.Status_Error =>
Free_Structure (File_Handle);
end Abort_Paginated_Output;
pragma Page;
procedure Line_Feed (File_Handle : in Paginated_File_Handle;
Count : in Integer) is
--|-Algorithm:
--| If at top of the page
--| then write header
--| If the request count is 0
--| then return
--| If the request is greater than the remainder on the page
--| then write remainder number of new lines
--| decrement request by this amount
--| write footer
--| eject page and update page and line count
--| if more space needed
--| then recursively call self with count
--| else write requested number of new lines
--| update line count
--| Exit
--|+
Skip_Count : Integer;
begin
if File_Handle.Current_Line = 0 and File_Handle.Page_Size /= 0 then
File_Handle.Current_Line := 1;
File_Handle.Current_Page := File_Handle.Current_Page + 1;
Text_Io.New_Page (File_Handle.File_Reference);
Put_Text (File_Handle);
end if;
if Count <= 0 then
return;
end if;
Skip_Count := File_Handle.Maximum_Line - File_Handle.Current_Line + 1;
if Count >= Skip_Count and File_Handle.Page_Size /= 0 then
Text_Io.New_Line (File_Handle.File_Reference,
Text_Io.Positive_Count (Skip_Count));
Skip_Count := Count - Skip_Count;
File_Handle.Current_Line := 0;
if Skip_Count /= 0 then
Line_Feed (File_Handle, Skip_Count);
end if;
else
Text_Io.New_Line (File_Handle.File_Reference,
Text_Io.Positive_Count (Count));
if File_Handle.Page_Size /= 0 then
File_Handle.Current_Line := File_Handle.Current_Line + Count;
end if;
end if;
end Line_Feed;
pragma Page;
procedure Page_Eject (File_Handle : in Paginated_File_Handle;
Count : in Integer := 1) is
--|-Algorithm:
--| Validate paginated file structure (raise error if not valid)
--| Raise Invalid_Count if page request is too large
--| Convert the number of pages to skip into number of lines
--| Write out this number of new line control characters
--| while taking into account header, footer, and pagination.
--| Exit
--|+
begin
if File_Handle.Page_Size = 0 then
Line_Feed (File_Handle, 1);
return;
end if;
if Count > 99 then
raise Invalid_Count;
end if;
if File_Handle.Current_Line = 0 then
Line_Feed (File_Handle, (Count * File_Handle.Maximum_Line));
else
Line_Feed (File_Handle, (Count * File_Handle.Maximum_Line -
File_Handle.Current_Line + 1));
end if;
end Page_Eject;
pragma Page;
procedure Set_Text_Area (Text_Handle : in out Variable_String_Array_Handle;
Area_Size : in Integer) is
Temp_Handle : Variable_String_Array_Handle;
begin
if Area_Size <= 0 then
return;
end if;
if Text_Handle = null or else Text_Handle'Last < Area_Size then
Temp_Handle := Text_Handle;
Text_Handle := new Variable_String_Array (1 .. Area_Size);
if Temp_Handle /= null then
for I in Temp_Handle'Range loop
Text_Handle (I) :=
String_Pkg.Make_Persistent (Temp_Handle (I));
end loop;
Clear_Text (Temp_Handle);
end if;
end if;
end Set_Text_Area;
pragma Page;
procedure Write (File_Handle : in Paginated_File_Handle;
Text_Line : in String;
Feed : in Boolean) is
--|-Algorithm:
--| Validate paginated file structure (raise error if not valid)
--| If at the top of the page
--| then write out the header
--| Output the given line of text to the paginated file
--| Write out a new line control character
--| If at the bottom of the page
--| then write out the footer and eject the page
--| Exit
--|+
begin
Check_Valid (File_Handle);
Line_Feed (File_Handle, 0);
Text_Io.Put (File_Handle.File_Reference, Text_Line);
if Feed then
Line_Feed (File_Handle, 1);
end if;
end Write;
pragma Page;
procedure Create_Paginated_File (File_Name : in Host_File_Name := "";
File_Handle : in out Paginated_File_Handle;
Page_Size : in Integer := 60;
Header_Size : in Integer := 6) is
--|-Algorithm:
--| If an active (ie. non-null) handle is given
--| then close that file first
--| Create a paginated file structure
--| If no file name is given
--| then assume standard output
--| else create (open) an external file
--| Fill the paginated file structure with external file information,
--| page layout information, and current date/time
--| Return access to the completed structure
--| Exit
--|+
begin
Close_Paginated_File (File_Handle);
File_Handle := new Paginated_File_Structure;
if File_Name /= "" then
File_Handle.File_Name := String_Pkg.Make_Persistent (File_Name);
Text_Io.Create (File => File_Handle.File_Reference,
Name => File_Name);
end if;
Set_Page_Layout (File_Handle, Page_Size, Header_Size);
Set_Date_Time (File_Handle);
exception
when Text_Io.Status_Error =>
Abort_Paginated_Output (File_Handle);
raise File_Already_Open;
when Text_Io.Name_Error | Text_Io.Use_Error =>
Abort_Paginated_Output (File_Handle);
raise File_Error;
when Page_Layout_Error =>
Abort_Paginated_Output (File_Handle);
raise Page_Layout_Error;
end Create_Paginated_File;
pragma Page;
pragma Page;
procedure Set_Page_Layout (File_Handle : in Paginated_File_Handle;
Page_Size : in Integer;
Header_Size : in Integer) is
--|-Algorithm:
--| Validate paginated file structure (raise error if not valid)
--| If page layout is contradictory
--| then raise an error
--| If not at the top of the page
--| then eject current page
--| Set page size, header size, footer size, and text area size
--| per page
--| Exit
--|+
Temp_Handle : Variable_String_Array_Handle;
begin
Check_Valid (File_Handle);
if Page_Size < 0 or Header_Size < 0 or
(Page_Size /= 0 and Page_Size <= Header_Size) then
raise Page_Layout_Error;
end if;
if File_Handle.Current_Line /= 0 and File_Handle.Page_Size /= 0 then
Page_Eject (File_Handle, 1);
end if;
File_Handle.Page_Size := Page_Size;
if Page_Size = 0 then
File_Handle.Maximum_Line := 0;
else
File_Handle.Maximum_Line := Page_Size - Header_Size;
end if;
File_Handle.Header_Size := Header_Size;
Set_Text_Area (File_Handle.Page_Header, File_Handle.Header_Size);
end Set_Page_Layout;
procedure Set_Header (File_Handle : in Paginated_File_Handle;
Header_Text : in Variable_String_Array) is
--|-Algorithm:
--| Set given header text as odd page header
--| Exit
--|+
begin
Set_Text (File_Handle, Header_Text);
end Set_Header;
pragma Page;
procedure Set_Header (File_Handle : in Paginated_File_Handle;
Header_Line : in Integer;
Header_Text : in String_Pkg.String_Type) is
--|-Algorithm:
--| Validate paginated file structure (raise error if not valid)
--| If requested header line number is out of range
--| then raise an error
--| Set header text at requested line for odd pages
--| Exit
--|+
begin
Check_Valid (File_Handle);
if Header_Line < 1 then
raise Text_Underflow;
end if;
if Header_Line > File_Handle.Header_Size then
raise Text_Overflow;
end if;
File_Handle.Page_Header (Header_Line) :=
String_Pkg.Make_Persistent (Header_Text);
end Set_Header;
pragma Page;
procedure Set_Header (File_Handle : in Paginated_File_Handle;
Header_Line : in Integer;
Header_Text : in String) is
--|-Algorithm:
--| Create a variable string
--| Set odd page header
--| Exit
--|+
Text : String_Pkg.String_Type;
begin
Text := String_Pkg.Make_Persistent (Header_Text);
Set_Header (File_Handle, Header_Line, Text);
String_Pkg.Flush (Text);
end Set_Header;
procedure Close_Paginated_File
(File_Handle : in out Paginated_File_Handle) is
--|-Algorithm:
--| If no file (ie. handle is null)
--| then return
--| If not at the top of the page
--| then eject current page
--| Return all storage used for this file to the heap
--| Close the external file
--| Exit
--|+
begin
if File_Handle = null then
return;
end if;
if File_Handle.Current_Line /= 0 and File_Handle.Page_Size /= 0 then
Page_Eject (File_Handle, 1);
end if;
Abort_Paginated_Output (File_Handle);
end Close_Paginated_File;
pragma Page;
procedure Put (File_Handle : in Paginated_File_Handle;
Text : in Character) is
begin
Write (File_Handle, "" & Text, False);
end Put;
pragma Page;
procedure Put (File_Handle : in Paginated_File_Handle; Text : in String) is
--|-Algorithm:
--| Execute Write procedure with feed
--| Exit
--|+
begin
Write (File_Handle, Text, False);
end Put;
pragma Page;
procedure Put (File_Handle : in Paginated_File_Handle;
Text : in String_Pkg.String_Type) is
--|-Algorithm:
--| Create a fixed length string
--| Output the line
--| Exit
--|+
begin
Write (File_Handle, String_Pkg.Value (Text), False);
end Put;
pragma Page;
procedure Put (File_Handle : in Paginated_File_Handle;
Text : in Variable_String_Array) is
--|-Algorithm:
--| Loop for all elements of the variable string array
--| Create a fixed length string
--| Output the line
--| Exit
--|+
begin
for I in Text'Range loop
Write (File_Handle, String_Pkg.Value (Text (I)), False);
end loop;
end Put;
pragma Page;
procedure Space (File_Handle : in Paginated_File_Handle;
Count : in Integer) is
begin
Check_Valid (File_Handle);
if Count <= 0 then
return;
end if;
declare
Space_String : String (1 .. Count) := (1 .. Count => ' ');
begin
Write (File_Handle, Space_String, False);
end;
end Space;
pragma Page;
procedure Put_Line (File_Handle : in Paginated_File_Handle;
Text_Line : in String) is
--|-Algorithm:
--| Execute Write procedure with feed
--| Exit
--|+
begin
Write (File_Handle, Text_Line, True);
end Put_Line;
pragma Page;
procedure Put_Line (File_Handle : in Paginated_File_Handle;
Text_Line : in String_Pkg.String_Type) is
--|-Algorithm:
--| Create a fixed length string
--| Output the line
--| Exit
--|+
begin
Write (File_Handle, String_Pkg.Value (Text_Line), True);
end Put_Line;
pragma Page;
procedure Put_Line (File_Handle : in Paginated_File_Handle;
Text_Line : in Variable_String_Array) is
--|-Algorithm:
--| Loop for all elements of the variable string array
--| Create a fixed length string
--| Output the line
--| Exit
--|+
begin
for I in Text_Line'Range loop
Write (File_Handle, String_Pkg.Value (Text_Line (I)), True);
end loop;
end Put_Line;
pragma Page;
procedure Space_Line (File_Handle : in Paginated_File_Handle;
Count : in Integer := 1) is
--|-Algorithm:
--| Validate paginated file structure (raise error if not valid)
--| Raise Invalid_Count if space request is too large
--| Write out the given number of new line control characters
--| while taking into account header, footer, and pagination.
--| Exit
--|+
begin
Check_Valid (File_Handle);
Line_Feed (File_Handle, Count);
end Space_Line;
pragma Page;
procedure Skip_Line (File_Handle : in Paginated_File_Handle;
Count : in Integer := 1) is
--|-Algorithm:
--| Validate paginated file structure (raise error if not valid)
--| Set the number of new line characters to be written as the
--| number specified or the number of lines remaining on the
--| page which ever is smaller.
--| Write out this number of new line control characters
--| while taking into account header, footer, and pagination.
--| (If at the top of the page then Skip_Lines does nothing)
--| Exit
--|+
Skip_Count : Integer;
begin
Check_Valid (File_Handle);
if File_Handle.Current_Line /= 0 or File_Handle.Page_Size = 0 then
Skip_Count := File_Handle.Maximum_Line -
File_Handle.Current_Line + 1;
if Skip_Count > Count or File_Handle.Page_Size = 0 then
Skip_Count := Count;
end if;
Line_Feed (File_Handle, Skip_Count);
end if;
end Skip_Line;
pragma Page;
procedure Put_Page (File_Handle : in Paginated_File_Handle;
Count : in Integer := 1) is
--|-Algorithm:
--| Validate paginated file structure (raise error if not valid)
--| Raise Invalid_Count if page request is too large
--| Convert the number of pages to skip into number of lines
--| Write out this number of new line control characters
--| while taking into account header, footer, and pagination.
--| Exit
--|+
begin
Check_Valid (File_Handle);
Page_Eject (File_Handle, Count);
end Put_Page;
pragma Page;
function Available_Lines
(File_Handle : in Paginated_File_Handle) return Integer is
--|-Algorithm:
--| Validate paginated file structure (raise error if not valid)
--| Return the number of lines remaining on the page
--|+
begin
Check_Valid (File_Handle);
if File_Handle.Page_Size = 0 then
return -1;
end if;
if File_Handle.Current_Line = 0 then
return File_Handle.Maximum_Line;
else
return File_Handle.Maximum_Line - File_Handle.Current_Line + 1;
end if;
end Available_Lines;
end Simple_Paginated_Output;