And ADA version of C's printf??
Ross William Irvine
Hello all, I would like know if there is such a thing that someone has
written in ADA (An ada version of C's printf).
As I find it a lot easier to do display's to the screen with one line of
code, rather than doing heaps of put's just to output one line.
This is NOT mean't to be a flame at ADA or C, I would just like to know if
someone has done this and where I could get a copy if so..
regards..
--
Ross Irvine s931...@arcadia.cs.rmit.edu.au
Comp. Sci. @ RMIT
Joel Rudy
As everyone knows, Ada is a very programmer friendly language.
To do what you ask, the simple-to-use TEXT_IO package provides this capability.
To print a string variable just type:
PUT_LINE ("Hello"&STRING_NAME&". It is a pleasure to meet you.");
To print any other kind of variable, you need to convert it into a string:
PUT_LINE ("I am "&INTEGER'IMAGE(INTEGER_VAR)&" years old.");
Hope that this helps.
Joel
Robert Dewar
type unsafe, and that's hard to copy in Ada. You can copy it by using
'Address and unchecked conversions, but I am not sure that this is the
way you want to go!
Matthew Jones
>In article <31024v$d...@goanna.cs.rmit.oz.au>, s931...@arcadia.cs.rmit.EDU.AU (Ross William Irvine) says:
>>
>>
>>Hello all, I would like know if there is such a thing that someone has
>>written in ADA (An ada version of C's printf).
>As everyone knows, Ada is a very programmer friendly language.
>To do what you ask, the simple-to-use TEXT_IO package provides this capability.
>To print a string variable just type:
> PUT_LINE ("Hello"&STRING_NAME&". It is a pleasure to meet you.");
>To print any other kind of variable, you need to convert it into a string:
> PUT_LINE ("I am "&INTEGER'IMAGE(INTEGER_VAR)&" years old.");
>Hope that this helps.
While this is helpful response it does not really allow you to replicate
the capability of printf.
'Image can only be used with discrete types. Therefore you cannot use it
to print out floating point types. Also printf allows for left and right
justification of (indivual) fields as well as zero padding.
Good luck.
Matthew Jones
jo...@io.dsd.litton.com
jon...@cerf.net
Ross William Irvine
: Of course it is not that easy to duplicate printf, since it is fundamentally
: type unsafe, and that's hard to copy in Ada. You can copy it by using
: 'Address and unchecked conversions, but I am not sure that this is the
: way you want to go!
Could you please expand on that as I have never come across the "'Address"
command before..
regards..
--
Ross Irvine s931...@arcadia.cs.rmit.edu.au
Comp. Sci @ RMIT
John J Cupak Jr CCP
For those interested in a printf capability in Ada,
I've attached the following files to the end of this message:
ftest.ada
ftest.out
formatter.spc
formatter.bdy
fchar.sub
fget.sub
fnumb.sub
freal.sub
fstr.sub
See the ftest.ada program and ftest.out to see what it can do.
Comments, criticisms, etc welcomed.
--
John J. Cupak, Jr., CCP Lockheed DECNet: NHQVAX::CUPAK
Lockheed Sanders, Inc. Internet : cu...@rapnet.sanders.LOCKHEED.COM
95 Canal Street / MER15-2802 CompuServe : 72411...@compuserve.com
Nashua, NH 03061-0868 Telephone : (603) 885-2142 FAX: 885-1480
---------------------------
with Text_IO;
with Formatter;
procedure Formatter_Test is
-- ++
--
-- FUNCTIONAL DESCRIPTION:
--
-- This is a test driver program for the generic Formatter package.
--
-- FORMAL PARAMETERS:
--
-- None.
--
-- DESIGN:
--
-- This test driver contains a number of calls to the Formatter Put
-- procedure with a format string and data values. Each test is identified
-- by a test number and a description of the test.
--
-- EXCEPTIONS:
--
-- No exceptions are declared in this test driver, although any exception
-- raised by Formatter.Put are handled.
--
-- KEYWORDS:
--
-- Test Driver.
--
-- --
type Days_of_Week is (Sunday,
Monday,
Tuesday,
Wednesday,
Thursday,
Friday,
Saturday);
package Ada_Format is
new Formatter (Enumerated => Days_of_Week);
use Ada_Format; -- Direct visibility of F conversion functions
Name : String(1..6);
Integer_Value : Positive := 66;
Real_Value : Float := 3.1415927;
Character_Value : Character := 'x';
Enumeration_Value : Days_of_Week := Thursday;
begin -- Formatter_Test
Test_1:
begin
Name := "Test_1";
Ada_Format.Put("%s:\tDefault Formats\n", F(Name));
Ada_Format.Put("Integer_Value = '%i'\n", F(Integer_Value));
Ada_Format.Put("Real_Value = '%f'\n", F(Real_Value));
Ada_Format.Put("Scientific_Value = '%e'\n", F(Real_Value));
Ada_Format.Put("Character_Value = '%c'\n", F(Character_Value));
Ada_Format.Put("Enumeration_Value = '%s'\n\n", F(Enumeration_Value));
exception
when others =>
Text_IO.Put_Line("Test_1: Unknown exception raised.");
Text_IO.New_Line;
end Test_1;
Test_2:
begin
Name := "Test_2";
Ada_Format.Put("%s:\t" &
"Wide-Field Formats\n" &
"Integer_Value = '%15i'\n" &
"Real_Value = '%15f'\n" &
"Scientific_Value = '%15e'\n" &
"Character_Value = '%15c'\n" &
"Enumeration_Value = '%15s'\n\n",
(F(Name),
F(Integer_Value),
F(Real_Value),
F(Real_Value),
F(Character_Value),
F(Enumeration_Value)));
exception
when others =>
Text_IO.Put_Line("Test_2: Unknown exception raised.");
Text_IO.New_Line;
end Test_2;
Test_3:
begin
Name := "Test_3";
Ada_Format.Put("%s:\t" &
"Wide-Field Left-Justified Formats\n" &
"Integer_Value = '%-15i'\n" &
"Real_Value = '%-15f'\n" &
"Scientific_Value = '%-15e'\n" &
"Character_Value = '%-15c'\n" &
"Enumeration_Value = '%-15s'\n\n",
(F(Name),
F(Integer_Value),
F(Real_Value),
F(Real_Value),
F(Character_Value),
F(Enumeration_Value)));
exception
when others =>
Text_IO.Put_Line("Test_3: Unknown exception raised.");
Text_IO.New_Line;
end Test_3;
Test_4:
begin
Name := "Test_4";
Ada_Format.Put("%s:\tDefault Formats, Zero-Fill\n", F(Name));
Ada_Format.Put("Integer_Value = '%0i'\n", F(Integer_Value));
Ada_Format.Put("Real_Value = '%0f'\n", F(Real_Value));
Ada_Format.Put("Scientific_Value = '%0e'\n\n", F(Real_Value));
exception
when others =>
Text_IO.Put_Line("Test_4: Unknown exception raised.");
Text_IO.New_Line;
end Test_4;
Test_5:
begin
Name := "Test_5";
Ada_Format.Put("%s:\t" &
"Specified Field Width, Non-Decimal Bases\n" &
"Integer Value = '%4i'\n" &
"Hexadecimal Value = '%4x'\n" &
"Octal Value = '%4o'\n\n",
(F(Name),
F(Integer_Value),
F(Integer_Value),
F(Integer_Value)));
exception
when others =>
Text_IO.Put_Line("Test_5: Unknown exception raised.");
Text_IO.New_Line;
end Test_5;
Test_6:
begin
Name := "Test_6";
Ada_Format.Put("%s:\t" &
"Precision Formats\n" &
"Integer_Value = '%15.4i'\n" &
"Real_Value = '%15.4f'\n" &
"Scientific_Value = '%15.4e'\n" &
"String_Value = '%15.6s'\n\n",
(F(Name),
F(Integer_Value),
F(Real_Value),
F(Real_Value),
F(Name)));
exception
when others =>
Text_IO.Put_Line("Test_6: Unknown exception raised.");
Text_IO.New_Line;
end Test_6;
Test_7:
begin
Name := "Test_7";
Ada_Format.Put("%s:\t" &
"Incorrect Field Widths\n" &
"Integer_Value = '%1i'\n" &
"Real_Value = '%2.1f'\n" &
"Scientific_Value = '%3.2e'\n" &
"String_Value = '%4s'\n" &
"Unknown Format = '%+02,7z'\n\n",
(F(Name),
F(Integer_Value),
F(Real_Value),
F(Real_Value),
F(Name),
F(25)));
exception
when others =>
Text_IO.Put_Line("Test_7: Unknown exception raised.");
Text_IO.New_Line;
end Test_7;
end Formatter_Test;
-----------------------------
Test_1: Default Formats
Integer_Value = ' 66'
Real_Value = ' 3.1'
Scientific_Value = ' 3.1E+00'
Character_Value = 'x'
Enumeration_Value = 'THURSDAY'
Test_2: Wide-Field Formats
Integer_Value = ' 66'
Real_Value = ' 3.1'
Scientific_Value = ' 3.1E+00'
Character_Value = ' x'
Enumeration_Value = ' THURSDAY'
Test_3: Wide-Field Left-Justified Formats
Integer_Value = '66 '
Real_Value = '3.1 '
Scientific_Value = '3.1E+00 '
Character_Value = 'x '
Enumeration_Value = 'THURSDAY '
Test_4: Default Formats, Zero-Fill
Integer_Value = '00000066'
Real_Value = '000003.1'
Scientific_Value = '03.1E+00'
Test_5: Specified Field Width, Non-Decimal Bases
Integer Value = ' 66'
Hexadecimal Value = ' 42'
Octal Value = ' 102'
Test_6: Precision Formats
Integer_Value = ' 66'
Real_Value = ' 3.1416'
Scientific_Value = ' 3.1416E+00'
String_Value = ' Test_6'
Test_7: Incorrect Field Widths
Integer_Value = '*'
Real_Value = '********'
Scientific_Value = '********'
String_Value = 'st_7'
Unknown Format = '********02,7z'
-------------------------------------------------------------------------------
generic
-- User's instantiation enumeration type
type Enumerated is (<>);
package Formatter is
-- Purpose: Format variable numeric arguments
--
-- F Returns the CONTENTS variant record set to the appropriate type
-- to allow a common data type to be passed to either GET or PUT.
--
-- Put Writes a formatted string given a variable number of data
-- values and a FORMAT string.
--
-- Get Returns a formatted string given a variable number of data
-- values and a FORMAT string.
type DP_Float is digits 15; -- Double precision float type
-- Allowable data types to format
type Data_Type is (Integer_Type,
Float_Type,
DP_Float_Type,
String_Type,
Character_Type,
Unknown_Type);
-- Abstract Data Type (ADT) specification
type Contents(Class : Data_Type := Unknown_type) is private;
-- Unconstrained array of data values to format
type Values is array (positive range <>) of Contents;
-- Specific data type to ADT conversion functions (overloaded)
function F(Data : in Integer) return Contents;
function F(Data : in Float) return Contents;
function F(Data : in DP_Float) return Contents;
function F(Data : in Character) return Contents;
function F(Data : in String) return Contents;
function F(Data : in Enumerated) return Contents;
-- Output formatted values procedures (overloaded)
procedure Put(Format : In String;
Value : In Values); -- Multiple data values
procedure Put(Format : In String;
Value : In Contents); -- Single data value
procedure Put(Format : In String); -- No data values
-- Output formatted values string functions (overloaded)
function Get(Format : In String;
Value : In Values) Return String; -- Multiple data values
function Get(Format : In String;
Value : In Contents) Return String; -- Single data value
function Get(Format : In String) Return String; -- No data values
private
-- Private string type
type String_Pointer is access String;
type String_Record is
record
The_String : String_Pointer;
The_Length : Natural := 0;
end record;
-- Abstract Data Type implementation
type Contents(Class : Data_Type := Unknown_type) is
record
case Class is
when Integer_type => Integer_value : Integer;
when Float_type => Float_value : Float;
when DP_Float_type => DP_Float_value : DP_float;
when Character_Type => Character_Value : Character;
when String_type => String_value : String_Record;
when Unknown_type => null;
end case;
end record;
end Formatter;
with Text_IO;
package body Formatter is
-- Instantiated Input-Output packages
package IO is new Text_io.Integer_io(Integer);
package FIO is new Text_io.Float_io(Float);
package DFIO is new Text_io.Float_io(Dp_float);
-- Overloaded Data Type to Variant Record conversion functions
function F (Data : in Integer) return Contents is
begin
return Contents'(Class => Integer_Type,
Integer_Value => Data);
exception
when others =>
return Contents'(Class => Unknown_Type);
end F;
function F (Data : in Enumerated) return Contents is
Data_String : constant String := Enumerated'Image(Data);
begin
return Contents'(Class => String_Type,
String_Value => (The_String => new String'(Data_String),
The_Length => Data_String'Length));
exception
when others =>
return Contents'(Class => Unknown_Type);
end F;
function F (Data : in Float) return Contents is
begin
return Contents'(Class => Float_Type,
Float_Value => Data);
exception
when others =>
return Contents'(Class => Unknown_Type);
end F;
function F (Data : in Dp_Float) return Contents is
begin
return Contents'(Class => Dp_Float_Type,
Dp_Float_Value => Data);
exception
when others =>
return Contents'(Class => Unknown_Type);
end F;
function F (Data : in String) return Contents is
begin
return Contents'(Class => String_Type,
String_Value => (The_String => new String'(Data),
The_Length => Data'Length));
exception
when others =>
return Contents'(Class => Unknown_Type);
end F;
function F (Data : in Character) return Contents is
begin
return Contents'(Class => Character_Type,
Character_Value => Data);
exception
when others =>
return Contents'(Class => Unknown_Type);
end F;
-- Overloaded Print Formatted Value procedures
procedure Put(Format : in String;
Value : in Values) is
begin
-- Write formatted string returned by Formatter.Get
Text_Io.Put(Get(Format, Value));
end Put;
procedure Put(Format : in String) is
Value_List : Values (1..0);
begin
Put(Format => Format,
Value => Value_List);
end Put;
procedure Put(Format : in String;
Value : in Contents) is
Value_List : Values(1..1) := (1 => Value);
begin
Put(Format => Format,
Value => Value_List);
end Put;
-- Overloaded Formatted Value String functions
function Get(Format : in String;
Value : in Values) return String
is separate;
function Get(Format : in String) return String is
Value_List : Values (1..0);
begin
return Get(Format => Format,
Value => Value_List);
end Get;
function Get(Format : in String;
Value : in Contents) return String is
Value_List : Values(1..1) := (1 => Value);
begin
return Get(Format => Format,
Value => Value_List);
end Get;
end Formatter;
separate(FORMATTER)
function Get (Format : in String;
Value : in Values ) return String is
-- ++
--
-- FUNCTIONAL DESCRIPTION:
--
-- Returns a formatted string given a FORMAT string and a
-- variable number of data values.
--
-- FORMAL PARAMETERS:
--
-- Format : The input format string.
--
-- Value : an array of data values.
--
-- RETURN VALUE:
--
-- The formatted string.
--
-- DESIGN:
--
-- for all input characters loop
-- if input character is an escape character ("\") then
-- translate to appropriate ASCII representation
-- insert in output string at current position
-- update current position
-- if input character is a data format character ("%") then
-- test for left justification ("-")
-- test for zero fill ("0")
-- get field width
-- if decimal point present, skip over it
-- get optional precision width
-- get format specifier
-- if character format specifier ("c") then Format_Character
-- if scientific format specifier ("e") then Format_Real
-- if floating point format specifier ("f") then Format_Real
-- if integer number format specifier ("i") then Format_Number
-- if octal number format specifier ("o") then Format_Number
-- if string format specifier ("s") then Format_String
-- if hexadecimal number format specifier ("x") then Format_Number
-- else Format_Error string
-- else copy character
-- end loop
--
--
-- EXCEPTIONS:
--
-- End_of_Format_String is raised by internal Get_Character procedure
-- when there are no more characters in the input
-- format string. Remaining data values, if any,
-- are ignored and the function returns the
-- Formatted_String.
--
-- KEYWORDS:
--
-- Format
--
-- --
-- Input dependent variables
C : Character; -- Format character being examined
Item : Natural range 0..Value'last := 0; -- Value index
-- Format specifier flags
Fill_With_Zeros : Boolean := False;
Left_Justify : Boolean := False;
Specified_Width : Integer;
Precision : Integer;
-- Formatted output string
Formatted_String : String(1..255) := (others => ' ');
Source_Position : Natural := 0; -- Input Format string character position
Target_Position : Natural := 1; -- Formatted string character position
-- Temporary data values
Octal_Value : Integer := 0;
Hexadecimal_Value : Integer := 0;
-- Exception declarations
End_Of_Format_String : Exception;
-- Constant declarations
Escape_Character : constant character := Ascii.Back_Slash; -- '\'
Data_Format : constant character := Ascii.Percent; -- '%'
Default_Width : constant := 8;
Base_Eight : constant := 8;
Base_Ten : constant := 10;
Base_Sixteen : constant := 16;
-- Local program units
procedure Get_Character ( C : out Character ) is
begin
C := Character(Format(Source_Position + 1)); -- Convert Working_String_Type to Character
Source_Position := Source_Position + 1; -- Global symbol reference
exception
when Constraint_Error =>
raise End_Of_Format_String;
end Get_Character;
function Is_Digit (C : in Character ) return Boolean is
begin
return C in '0'..'9';
end Is_Digit;
function Zero_Fill (The_String : in String ) return String is
-- Local constants
Blank : constant character := ' ';
Zero : constant character := '0';
-- Working String
Temp_String : String(1..The_String'Length) := The_String;
begin
for Next_Character in Temp_String'range loop
exit when Temp_String(Next_Character) /= Blank;
Temp_String(Next_Character) := Zero;
end loop;
return Temp_String;
end Zero_Fill;
function Left_Justified(Data : in String) return String is
Blank : constant Character := ' ';
First : Natural := Data'First;
begin -- Left_Justified
-- Starting at the left, find first non-blank character
while Data(First) = Blank loop
First := First + 1;
end loop;
return Data(First..Data'Last) & Data(Data'First..First-1);
end Left_Justified;
procedure Format_Error(In_The_String : in out String;
Location : in out Positive;
Width : in Positive) is
Stars : String(1..Width) := (others => '*');
begin
In_The_String(Location..Location + Width - 1) := Stars;
Location := Location + Width;
end Format_Error;
-- Data format conversion procedures
procedure Format_character (Data : in Contents;
In_The_String : in out String;
Location : in out Natural;
Width : in Natural := 0;
Left_Justify : in Boolean := False) is separate;
procedure Format_string (Data : in Contents;
In_The_String : in out String;
Location : in out Natural;
Width : in Natural := 0;
Precision : in Natural := 0;
Left_Justify : in Boolean := False) is separate;
procedure Format_Number (Data : in Contents;
In_The_String : in out String;
Location : in out Natural;
Number_Base : in Natural := 10;
Width : in Natural := 0;
Left_Justify : in Boolean := False;
Fill_With_Zeros : in Boolean := False) is separate;
procedure Format_Real (Data : in Contents;
In_The_String : in out String;
Location : in out Natural;
Width : in Natural := 0;
Precision : in Natural := 0;
Exponent : in Natural := 0;
Fill_With_Zeros : in Boolean := False) is separate;
begin
For_All_Characters : loop
Get_Character(C);
case C is
when Escape_Character =>
-- a) a 3 digit octal number follows
-- b) a control character follows
-- \n is newline
-- \t is tab
-- \b is backspace
-- \r is carriage return
-- \f is form feed
-- c) a literal character follows
-- \\ is backslash character
-- \% is percent character
-- \ followed by any other character is output as is
Get_Character(C); -- Skip over Escape character
case C is
when '0'.. '7' => -- Convert octal string
Octal_value := (Character'pos(C) - Character'pos('0'));
for Next in 1..2 loop
Get_Character(C);
Octal_value := 8 * Octal_value + (Character'pos(C) - Character'pos('0'));
end loop;
Formatted_String(Target_Position) := Character'Val(Octal_value);
Target_Position := Target_Position + 1;
when 'n' => -- "\n" is a new line
Formatted_String(Target_Position..Target_Position + 1) := Ascii.Cr & Ascii.Lf;
Target_Position := Target_Position + 2;
when 't' => -- "\t" is a tab
Formatted_String(Target_Position) := Ascii.Ht;
Target_Position := Target_Position + 1;
when 'b' => -- "\b" is a backspace
Formatted_String(Target_Position) := Ascii.Bs;
Target_Position := Target_Position + 1;
when 'r' => -- "\r" is a carriage return
Formatted_String(Target_Position) := Ascii.Cr;
Target_Position := Target_Position + 1;
when 'f' => -- "\f" is a form feed
Formatted_String(Target_Position) := Ascii.Ff;
Target_Position := Target_Position + 1;
when '\' => -- "\\" is the '\' character
Formatted_String(Target_Position) := C;
Target_Position := Target_Position + 1;
when '%' => -- "\%" is the '%' character
Formatted_String(Target_Position) := C;
Target_Position := Target_Position + 1;
when others => -- Literal character
Formatted_String(Target_Position) := C;
Target_Position := Target_Position + 1;
end case;
when Data_Format =>
-- Format in form %-0w.pS where:
-- - specifies left justification
-- 0 specifies zero fill
-- w specifies the total field width (decimal value)
-- p specifies the precision width (decimal value)
-- s is the format specifier:
-- c - character
-- e - scientific (exponent) format
-- f - floating point
-- i - integer format
-- o - octal format
-- s - string
-- x - hexadecimal format
Get_Character(C); -- Skip over current data format character
-- Initialize data format flags and values
Left_Justify := False;
Fill_With_Zeros := False;
Specified_Width := 0;
Precision := 0;
-- Set data format flags and values
if C = '-' then -- Set Left-justify string
Left_justify := true;
Get_Character(C); -- Skip over current '-' character in FORMAT
end if;
if C = '0' then -- Set Zero fill string
Fill_with_zeros := true;
Get_Character(C); -- Skip over current '0' character in FORMAT
end if;
while Is_digit(C) loop -- Get field width
Specified_Width := 10 * Specified_Width + (Character'pos(C) - Character'pos('0'));
Get_Character(C);
end loop;
if C = '.' then -- Skip precision separator character
Get_Character(C);
end if;
while Is_digit(C) loop -- Get field precision
Precision := 10 * Precision + (Character'pos(C) - Character'pos('0'));
Get_Character(C);
end loop;
-- Exits with data format specifier in C
-- Process data item according to format specifier
Item := Item + 1; -- Get next data item to format
case C is -- Convert specification character
when 'c' | 'C' => Format_character(Data => Value(Item),
In_The_String => Formatted_String,
Location => Target_Position,
Width => Specified_Width,
Left_Justify => Left_Justify);
when 'e' | 'E' => Format_Real(Data => Value(Item), -- Scientific Notation
In_The_String => Formatted_String,
Location => Target_Position,
Width => Specified_Width,
Precision => Precision,
Exponent => 3,
Fill_With_Zeros => Fill_With_Zeros);
when 'f' | 'F' => Format_Real(Data => Value(Item), -- Floating Decimal
In_The_String => Formatted_String,
Location => Target_Position,
Width => Specified_Width,
Precision => Precision,
Fill_With_Zeros => Fill_With_Zeros);
when 'i' | 'I' => Format_Number(Data => Value(Item), -- Decimal Number
In_The_String => Formatted_String,
Location => Target_Position,
Number_Base => Base_Ten,
Width => Specified_Width,
Left_Justify => Left_Justify,
Fill_With_Zeros => Fill_With_Zeros);
when 'o' | 'O' => Format_Number(Data => Value(Item), -- Octal Number
In_The_String => Formatted_String,
Location => Target_Position,
Number_Base => Base_Eight,
Width => Specified_Width,
Left_Justify => Left_Justify,
Fill_With_Zeros => Fill_With_Zeros);
when 's' | 'S' => Format_string(Data => Value(Item),
In_The_String => Formatted_String,
Location => Target_Position,
Width => Specified_Width,
Precision => Precision,
Left_Justify => Left_Justify);
when 'x' | 'X' => Format_Number(Data => Value(Item), -- Hexadecimal Number
In_The_String => Formatted_String,
Location => Target_Position,
Number_Base => Base_Sixteen,
Width => Specified_Width,
Left_Justify => Left_Justify,
Fill_With_Zeros => Fill_With_Zeros);
when others => Format_Error(In_The_String => Formatted_String,
Location => Target_Position,
Width => Default_Width);
end case;
when others => -- Copy character
Formatted_String(Target_Position) := C;
Target_Position := Target_Position + 1;
end case;
end loop For_All_Characters;
return Formatted_String(1..Target_Position - 1);
exception
when End_of_format_string =>
return Formatted_String(1..Target_Position - 1);
end Get;
separate(Formatter.Get)
procedure Format_Number(Data : in Contents;
In_The_String : in out String;
Location : in out Natural;
Number_Base : in Natural := 10;
Width : in Natural := 0;
Left_Justify : in Boolean := False;
Fill_With_Zeros : in Boolean := False) is
-- ++
--
-- FUNCTIONAL DESCRIPTION:
--
-- Formats non-real number based on input parameters.
--
-- FORMAL PARAMETERS:
--
-- Data:
-- The input data to format, contained in a variant record.
--
-- In_The_String:
-- The output string where the formatted number is placed.
--
-- Location:
-- The position where the formatted number is placed.
--
-- Number_Base:
-- Which base to convert the number to: 8, 10, or 16.
--
-- Width:
-- The width of the formatted number.
--
-- Left_Justify:
-- Logical (Boolean) switch which causes the formatted number to be
-- left justified in the output field.
--
-- Fill_With_Zeros:
-- Logical (Boolean) switch which causes the right-justified, formatted
-- number to be padded with leading zeros.
--
-- DESIGN:
--
-- Determine output field width.
-- Convert number to correct number base.
-- Strip off number base delimiters.
-- Convert number to string.
-- Call Format_String to format number string.
--
-- EXCEPTIONS:
--
-- A constraint error will generate a default field of all asterisks.
--
-- --
-- Local variables
Temp_String : String(1..255) := (others => ' ');
Field_Width : Natural; -- Output field width
Based_Width : Natural; -- Width of based number
Number_String : Formatter.Contents;
-- Local functions
function Based_Value_Of(The_String : in String) return String is
-- PURPOSE: Returns based value string without base type or delimiters
-- Local constant
Delimiter : constant Character := ASCII.SHARP; -- '#'
-- Character indices
First : Positive; -- Position of first digit after '#' delimiter
Last : Positive; -- Position of last digit before '#' delimiter
begin -- Based_Value_Of
-- Find first digit after initial Delimiter
First := The_String'First;
while The_String(First) /= Delimiter loop
if First = The_String'Last then -- Decimal number
return The_String; -- No Delimiter found
else
First := First + 1; -- Check next char
end if;
end loop;
First := First + 1; -- Skip Initial Delimiter
-- Find last digit before final Delimiter
Last := First;
while The_String(Last) /= Delimiter loop
Last := Last + 1;
end loop;
Last := Last - 1; -- Ignore Terminal Delimiter
return The_String(First..Last);
end Based_Value_Of;
begin -- Format_Number
-- Determine width of output
if Width = 0 then
Field_Width := Get.Default_Width;
else
Field_Width := Width;
end if;
-- Check for correct data type to format
if Data.Class = Integer_type then
-- Adjust field width for based value delimiters
if Number_Base = 10 then
Based_Width := Field_Width;
else
Based_Width := Field_Width + 4;
end if;
-- Convert integer value to string in correct Number_Base
Io.Put(Item => Data.Integer_value,
To => Temp_string(1..Based_width),
Base => Number_base);
if Left_Justify then
Temp_String(1..Based_Width) :=
Get.Left_Justified(Temp_String(1..Based_Width));
end if;
if Number_Base = Base_Ten then
if Fill_With_Zeros then
-- Generate zero-filled Number_String
Number_String := Contents'(Class => String_Type,
String_Value => (The_String => new
String'(Get.Zero_Fill(Temp_String(1..Based_Width))),
The_Length => Based_Width));
else
-- Generate Number_String
Number_String := Contents'(Class => String_Type,
String_Value => (The_String => new
String'(Temp_String(1..Based_Width)),
The_Length => Based_Width));
end if;
else
Non_Decimal_Base:
declare
-- Strip off Based value delimiters
Based_Value_String : constant String := Based_Value_Of(Temp_String(1..Based_Width));
begin
if Fill_With_Zeros then
-- Generate zero-filled Number_String
Number_String := Contents'(Class => String_Type,
String_Value => (The_String => new String'(Get.Zero_Fill(Based_Value_String)),
The_Length => Based_Value_String'length));
else
-- Generate Number_String
Number_String := Contents'(Class => String_Type,
String_Value => (The_String => new String'(Based_Value_String),
The_Length => Based_Value_String'length));
end if;
end Non_Decimal_Base;
end if;
-- Insert Number_String into Output String
Format_String(Number_String,In_The_String,Location,Field_Width);
else -- Incorrect data type
-- Fill field with error symbols
Format_Error(In_The_String, Location, Field_Width);
end if;
exception
when others =>
Format_Error(In_The_String, Location, Field_Width);
end Format_Number;
separate(Formatter.Get)
procedure Format_character (Data : in Contents;
In_The_String : in out String;
Location : in out Natural;
Width : in Natural := 0;
Left_Justify : in Boolean := False) is
-- ++
--
-- FUNCTIONAL DESCRIPTION:
--
-- This procedure formats a character and places it in the output string at
-- the specified location. The character may be left or right-justified in
-- a field of a specified width.
--
-- FORMAL PARAMETERS:
--
-- Data:
-- The variant record containing character to format.
--
-- In_The_String:
-- The output string in which to place the formatted character.
--
-- Location:
-- The position in the output string to place the formatted character.
--
-- Width:
-- The field width alloted to the formatted character.
--
-- Left_Justify:
-- Logical (Boolean) switch.
--
-- DESIGN:
--
-- If the input Width parameter is zero, then set the output field width to
-- one, otherwise set it to the specified width.
--
-- If the field width is equal to one, then move the input character into
-- the output string; otherwise, move the input character into output
-- string field and left-justify it if required.
--
-- EXCEPTIONS:
--
-- If constraint error is detected, try to place the character in a
-- a default width output field.
--
-- KEYWORDS:
--
-- Character, Justify
--
-- --
-- Local constant declarations
Blanks : constant String(1..255) := (others => ' ');
-- Local variables
Field_Width : Natural;
begin
-- Set the field width
if Width = 0 then
Field_Width := 1; -- Single character
else
Field_Width := Width; -- Input parameter
end if;
-- Verify correct data type to convert
if Data.Class = Character_type then
if Field_Width = 1 then
In_The_String(Location) := Data.Character_Value;
else
if Left_justify then
In_The_String(Location..Location + Field_Width - 1) :=
Data.Character_value & Blanks(1..Field_Width - 1);
else
In_The_String(Location..Location + Field_Width - 1) :=
Blanks(1..Field_width - 1) & Data.Character_Value;
end if;
end if;
Location := Location + Field_Width;
else -- Not correct data type to convert
Format_Error(In_The_String, Location, Field_Width);
end if;
exception
when others =>
-- Use Default_Width global constant
Format_Error(In_The_String, Location, Default_Width);
end Format_character;
separate(Formatter.Get)
procedure Format_Real(Data : in Contents;
In_The_String : in out String;
Location : in out Natural;
Width : in Natural := 0;
Precision : in Natural := 0;
Exponent : in Natural := 0;
Fill_With_Zeros : in Boolean := False) is
-- ++
--
-- FUNCTIONAL DESCRIPTION:
--
-- Formats real number according to specified parameters.
--
-- FORMAL PARAMETERS:
--
-- Data:
-- The input real number in a variant record.
--
-- In_The_String:
-- The output string where the formatted real number is placed.
--
-- Location:
-- The position of the formatted real number in the output string.
--
-- Width:
-- The output formatted real number field width.
--
-- Precision:
-- The number of decimal positions.
--
-- Exponent:
-- The number of exponent positions.
--
-- Fill_With_Zeros:
-- Logical (Boolean) flag specifying the formatted real number is to be
-- padded with leading zeros.
--
-- DESIGN:
--
-- Format the real number directly into the output string using Float or
-- Double-Float IO Put procedure.
--
-- --
-- Local variable(s)
Field_Width : Natural;
begin
-- Determine output field width
if Width > 0 then
Field_Width := Width; -- Set to specified width
else
Field_Width := Get.Default_Width;
end if;
if Data.Class = Float_Type then -- Correct data type
-- Convert to string
FIO.Put(ITEM => Data.Float_Value,
AFT => Precision,
EXP => Exponent,
TO => In_The_String(Location..Location + Field_Width - 1));
if Left_Justify then
In_The_String(Location..Location + Field_Width - 1) :=
Get.Left_Justified(In_The_String(Location..Location + Field_Width-1));
end if;
if Fill_With_Zeros then
In_The_String(Location..Location + Field_Width - 1) :=
Get.Zero_Fill(In_The_String(Location..Location + Field_Width-1));
end if;
-- Update next output position
Location := Location + Field_Width;
elsif Data.Class = DP_Float_Type then -- Correct data type
-- Format directly to output string
DFIO.Put(ITEM => Data.DP_Float_Value,
AFT => Precision,
EXP => Exponent,
TO => In_The_String(Location..Location + Field_Width - 1));
if Left_Justify then
In_The_String(Location..Location + Field_Width - 1) :=
Get.Left_Justified(In_The_String(Location..Location + Field_Width-1));
end if;
if Fill_With_Zeros then
In_The_String(Location..Location + Field_Width - 1) :=
Get.Zero_Fill(In_The_String(Location..Location + Field_Width-1));
end if;
Location := Location + Field_Width;
else -- Not correct data type to convert
Format_Error(In_The_String, Location, Field_Width);
end if;
exception
when others =>
Format_Error(In_The_String, Location, Get.Default_Width);
end Format_Real;
separate(Formatter.Get)
procedure Format_string (Data : in Contents;
In_The_String : in out String;
Location : in out Natural;
Width : in Natural := 0;
Precision : in Natural := 0;
Left_Justify : in Boolean := False) is
-- ++
--
-- FUNCTIONAL DESCRIPTION:
--
-- Formats data string according to input parameters.
--
-- FORMAL PARAMETERS:
--
-- Data:
-- Input data string contained in variant record.
--
-- In_The_String:
-- Formatted Output String
--
-- Location:
-- Position in output string to place formatted input data string.
--
-- Width:
-- Field width of formatted output.
--
-- Precision:
-- Number of characters of input string to place in formatted output
-- field.
--
-- Left_Justify:
-- Logical (Boolean) switch which specifies to left-justify output
-- formatted string.
--
-- DESIGN:
--
-- If input string is greater than specified output field width then place
-- justified sub-string in output field. Otherwise, place justified string
-- in output field.
--
-- --
-- Local variables
Blanks : String(1..255) := (others => ' ');
Data_Width : integer;
begin
-- Check data type
if Data.Class = String_type then -- Is correct type to convert
if Width = 0 then
-- Put entire string into output buffer
In_the_string(Location..Location + Data.String_value.The_Length - 1) :=
Data.String_value.The_String.All;
Location := Location + Data.String_value.The_Length;
else -- Non-zero field Width specified
Data_Width := Data.String_value.The_Length;
if Data_width > Width then -- Data string too long
if Precision > 0 then -- Sub-string specified
if Left_justify then
In_The_String(Location..Location + Width - 1) :=
Data.String_value.The_String(1..Precision) & Blanks(1..Width - Precision);
Location := Location + Width;
else -- Right-justify
In_The_String(Location..Location + WIDTH - 1) :=
Blanks(1..Width - Precision) & Data.String_value.The_String(1..Precision);
Location := Location + WIDTH;
end if;
else -- Truncate string to fit in width of field
if Left_Justify then -- Take left-most "width" characters
In_the_string (Location..Location + Width - 1) := Data.String_value.The_String(1..Width);
else -- Take right-most "width" characters
In_the_string (Location..Location + Width - 1) := Data.String_value.The_String(Data_Width - Width + 1..Data_Width);
end if;
Location := Location + Width;
end if; -- Long String
else -- String < specified field Width
If Precision > 0 Then -- Sub-String Specified
If Left_justify Then
In_the_string(Location..Location + Width - 1) :=
Data.String_value.The_String(1..Precision) & Blanks(1..Width - Precision);
Location := Location + Width;
Else -- Right-Justify
In_the_string(Location..Location + Width - 1) :=
Blanks(1..Width - Precision) & Data.String_value.The_String(1..Precision);
Location := Location + Width;
end if;
else -- No substring specified
If Left_justify Then
In_the_string(Location..Location + Width - 1) :=
Data.String_value.The_String.All & Blanks(1..Width - Data_width);
Location := Location + Width;
else -- Right justify
In_the_string(Location..Location + Width - 1) :=
Blanks(1..Width - Data_width) & Data.String_value.The_String.All;
Location := Location + Width;
end if; -- Justify test
end if; -- Substring specified
end if; -- Field width test
end if;
else -- Wrong class type for format specifier
-- Uses Global Default_Width constant
Format_Error(In_The_String, Location, Default_Width);
end if; -- Class test
exception
When others =>
-- Uses Global Default_Width constant
Format_Error(In_The_String, Location, Default_Width);
end Format_string;
Tucker Taft
Ross William Irvine <s931...@arcadia.cs.rmit.EDU.AU> wrote:
>Hello all, I would like know if there is such a thing that someone has
>written in ADA (An ada version of C's printf).
As has been mentioned in the past, it is possible to
produce a printf-like capability by overloading the "&" operator
to take an object of type Format and an object of some type
and return the Format, properly advanced, after having performed
the appropriate output. The resulting concatenation is
then passed to a Print procedure to output anything left
at the end of the format string. For example:
with Text_IO; use Text_IO;
package Formatted_Output is
type Format is limited private;
function Fmt(Str : String) return Format;
function "&"(Left : Format; Right : Integer) return Format;
function "&"(Left : Format; Right : Float) return Format;
function "&"(Left : Format; Right : String) return Format;
... -- other overloadings of "&"
procedure Print(Fmt : Format);
private;
...
end Formatted_Output;
with Formatted_Output; use Formatted_Output;
procedure Test is
begin
Print(Fmt("%d * %d = %d\n") & X & Y & X*Y);
end Test;
The private part and body of Formatted_Output are left as an
exercise for the reader ;-).
A "File : File_Type" parameter could be added to
an overloading of Fmt if desired (to create something
analagous to fprintf), with Fmt doing a Set_Output(File)
and Print doing a Set_Output(Standard_Output) after finishing
the output.
This capability is analogous to that provided by the "<<" stream
operator of C++.
> ...
>Ross Irvine s931...@arcadia.cs.rmit.edu.au
>Comp. Sci. @ RMIT
-Tucker Taft s...@inmet.com
David Emery
>operator of C++.
And just as ugly and unreadable as C++'s "<<" stream operator, too...
dave
--
--The preceeding opinions do not necessarily reflect the opinions of
--The MITRE Corporation or its sponsors.
-- "It is the fashion these days to make war, and presumably it will last
-- a while yet." Frederick the Great of Prussa, writing to Voltaire, 1742.
-------------------------------------------------------------------------