ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/PROG/MISC/BD3.ZIP/CONSOLE.ADA

Text File | 1989-03-13 | 6.9 KB | 189 lines

package CONSOLE is
--------------------------------------------------------------------------
--| BEGIN PROLOGUE
--| DESCRIPTION            : CONSOLE is a package which implements an
--|                        : abstract state machine, a console terminal,
--|                        : that maps to the user's terminal.  CONSOLE
--|                        : provides routines to output characters,
--|                        : strings, integers, and floats (real numbers)
--|                        : to the user's terminal.  CONSOLE provides
--|                        : a routine to input a string of text from the
--|                        : user's terminal.  Finally, CONSOLE provides
--|                        : a function which can trim leading spaces
--|                        : from a string of text (useful in outputting
--|                        : text which was input by the read routine).
--|                        :
--| REQUIREMENTS SUPPORTED : A simple I/O package for Ada programs
--|                        :
--| LIMITATIONS            : Text input by CONSOLE.READ can be no more
--|                        : than 80 characters long.  Only objects of
--|                        : type CHARACTER, STRING, INTEGER, and FLOAT
--|                        : can be output.
--|                        :
--| AUTHOR(S)              : Richard Conn
--| CHANGE LOG             : 08/30/88  RLC  Initial Design and Code
--|                        :
--| REMARKS                : None
--|                        :
--| PORTABILITY ISSUES     : Uses TEXT_IO, so is very portable; no known
--|                        : portability problems.
--| END PROLOGUE
--------------------------------------------------------------------------

    -- Special items to print
    type    SPECIAL_ITEM is (NEW_LINE, TAB, BACKSPACE);

    -- Type of string used by READ procedure
    subtype OUTSTRING    is STRING(1 .. 80);

    procedure WRITE(ITEM : in STRING);
    procedure WRITE(ITEM : in CHARACTER);
    -- Print strings and characters
    -- Examples:
    --    Ada procedure call            Prints (without quotes)
    --    ============================        =======================
    --    CONSOLE.WRITE ("This is a test");    "This is a test"
    --    CONSOLE.WRITE ('?');            "?"

    procedure WRITE(ITEM : in SPECIAL_ITEM);
    -- Print special items
    -- Example:
    --    Ada procedure call            Prints (without quotes)
    --    ============================        =======================
    --    CONSOLE.WRITE (CONSOLE.NEW_LINE);    <advances to next line>

--

-- Package CONSOLE

    procedure WRITE(ITEM : in INTEGER; WIDTH : in NATURAL := 0);
    -- Print integers
    -- Examples:
    --    Ada procedure call            Prints (without quotes)
    --    ============================        =======================
    --    CONSOLE.WRITE (25);            "25"
    --    CONSOLE.WRITE (-3);            "-3"
    --    CONSOLE.WRITE (25, 5);            "   25"

    procedure WRITE(ITEM           : in FLOAT;
            BEFORE_DECIMAL : in NATURAL := 5;
            AFTER_DECIMAL  : in NATURAL := 5);
    procedure WRITE_SCIENTIFIC(ITEM          : in FLOAT;
                   AFTER_DECIMAL : in NATURAL := 8);
    -- Print floats
    -- Examples:
    --    Ada procedure call            Prints (without quotes)
    --    ============================        =======================
    --    CONSOLE.WRITE (25.21);            "   25.21000"
    --    CONSOLE.WRITE (-36.2);            "  -36.20000"
    --    CONSOLE.WRITE (-36.2, 1, 1);        "-36.2"
    --    CONSOLE.WRITE (25.21, 3);        " 25.21000"
    --    CONSOLE.WRITE (25.21, 3, 2);        " 25.21"
    --    CONSOLE.WRITE_SCIENTIFIC (23.0);    " 2.30000000e+01"
    --    CONSOLE.WRITE_SCIENTIFIC (5.7, 2);    " 5.70E+00"
    --    CONSOLE.WRITE_SCIENTIFIC (-4.5e-24, 4);    "-4.5000E-24"

    procedure READ(ITEM : out OUTSTRING);
    -- Read strings
    -- Example (note: <CR> refers to the RETURN key):
    --    MY_STRING : CONSOLE.OUTSTRING; -- 80-char string
    --    Ada procedure call        User Types    In MY_STRING
    --    ====================        ==========    ============
    --    CONSOLE.READ (MY_STRING);    "Hi<CR>"    "Hi"<and 78 spaces>

    function TRIM(ITEM : in STRING) return STRING;
    -- Generate a string which has no trailing spaces
    -- Example of use:
    --    MY_STRING : CONSOLE.OUTSTRING;
    --    CONSOLE.READ(MY_STRING);
    --    CONSOLE.WRITE("Hello, ");
    --    CONSOLE.WRITE(CONSOLE.TRIM(MY_STRING));
    --    CONSOLE.WRITE(", how are you?");
    -- If the CONSOLE.READ statement returns "Joe" followed by 77 spaces,
    -- the output will look like "Hello, Joe, how are you?"

end CONSOLE;
--

with TEXT_IO;
package body CONSOLE is

    -- Generic instantiations for integer and float output
    package INT_CONSOLE is new TEXT_IO.INTEGER_IO(INTEGER);
    package FLT_CONSOLE is new TEXT_IO.FLOAT_IO(FLOAT);

    procedure WRITE(ITEM : in STRING) is
    begin
    TEXT_IO.PUT(ITEM);
    end WRITE;

    procedure WRITE(ITEM : in CHARACTER) is
    begin
    TEXT_IO.PUT(ITEM);
    end WRITE;

    procedure WRITE(ITEM : in SPECIAL_ITEM) is
    begin
    case ITEM is
        when NEW_LINE =>
        TEXT_IO.NEW_LINE;
        when TAB =>
        TEXT_IO.PUT(ASCII.HT);
        when BACKSPACE =>
        TEXT_IO.PUT(ASCII.BS);
    end case;
    end WRITE;

    procedure WRITE(ITEM : in INTEGER; WIDTH : in NATURAL := 0) is
    begin
    INT_CONSOLE.PUT(ITEM => ITEM,
                        WIDTH => WIDTH);
    end WRITE;

    procedure WRITE(ITEM           : in FLOAT;
            BEFORE_DECIMAL : in NATURAL := 5;
            AFTER_DECIMAL  : in NATURAL := 5) is
    begin
    FLT_CONSOLE.PUT(ITEM => ITEM,
                        FORE => BEFORE_DECIMAL,
                        AFT => AFTER_DECIMAL,
                    EXP => 0);
    end WRITE;

    procedure WRITE_SCIENTIFIC(ITEM          : in FLOAT;
                   AFTER_DECIMAL : in NATURAL := 8) is
    begin
    FLT_CONSOLE.PUT(ITEM => ITEM,
                        FORE => 2,
                        AFT => AFTER_DECIMAL,
                        EXP => 3);
    end WRITE_SCIENTIFIC;

--

-- Package body CONSOLE

    procedure READ(ITEM : out OUTSTRING) is
    LAST : NATURAL;
    begin
    TEXT_IO.GET_LINE(ITEM, LAST);
    for I in LAST + 1 .. OUTSTRING'LAST loop -- space fill
        ITEM(I) := ' ';
    end loop;
    end READ;

    function TRIM(ITEM : in STRING) return STRING is
    INDEX : NATURAL;
    begin
    INDEX := ITEM'FIRST - 1;   -- set for null string
    for I in reverse ITEM'FIRST .. ITEM'LAST loop
        if ITEM(I) /= ' ' then -- last non-space character
        INDEX := I;
        exit;
        end if;
    end loop;
    return (ITEM(ITEM'FIRST .. INDEX));
    end TRIM;

end CONSOLE;