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

File List | 1989-03-12 | 7.9 KB | 186 lines

  1 package CONSOLE is
  2 --------------------------------------------------------------------------
  3 --| BEGIN PROLOGUE
  4 --| DESCRIPTION            : CONSOLE is a package which implements an
  5 --|                        : abstract state machine, a console terminal,
  6 --|                        : that maps to the user's terminal.  CONSOLE
  7 --|                        : provides routines to output characters,
  8 --|                        : strings, integers, and floats (real numbers)
  9 --|                        : to the user's terminal.  CONSOLE provides
 10 --|                        : a routine to input a string of text from the
 11 --|                        : user's terminal.  Finally, CONSOLE provides
 12 --|                        : a function which can trim leading spaces
 13 --|                        : from a string of text (useful in outputting
 14 --|                        : text which was input by the read routine).
 15 --|                        :
 16 --| REQUIREMENTS SUPPORTED : A simple I/O package for Ada programs
 17 --|                        :
 18 --| LIMITATIONS            : Text input by CONSOLE.READ can be no more
 19 --|                        : than 80 characters long.  Only objects of
 20 --|                        : type CHARACTER, STRING, INTEGER, and FLOAT
 21 --|                        : can be output.
 22 --|                        :
 23 --| AUTHOR(S)              : Richard Conn
 24 --| CHANGE LOG             : 08/30/88  RLC  Initial Design and Code
 25 --|                        :
 26 --| REMARKS                : None
 27 --|                        :
 28 --| PORTABILITY ISSUES     : Uses TEXT_IO, so is very portable; no known
 29 --|                        : portability problems.
 30 --| END PROLOGUE
 31 --------------------------------------------------------------------------
 32
 33     -- Special items to print
 34     type    SPECIAL_ITEM is (NEW_LINE, TAB, BACKSPACE);
 35
 36     -- Type of string used by READ procedure
 37     subtype OUTSTRING    is STRING(1 .. 80);
 38
 39     procedure WRITE(ITEM : in STRING);
 40     procedure WRITE(ITEM : in CHARACTER);
 41     -- Print strings and characters
 42     -- Examples:
 43     --  Ada procedure call                      Prints (without quotes)
 44     --  ============================            =======================
 45     --  CONSOLE.WRITE ("This is a test");       "This is a test"
 46     --  CONSOLE.WRITE ('?');                    "?"
 47
 48     procedure WRITE(ITEM : in SPECIAL_ITEM);
 49     -- Print special items
 50     -- Example:
 51     --  Ada procedure call                      Prints (without quotes)
 52     --  ============================            =======================
 53     --  CONSOLE.WRITE (CONSOLE.NEW_LINE);       <advances to next line>
 54
 55 --
 56 -- Package CONSOLE
 57
 58     procedure WRITE(ITEM : in INTEGER; WIDTH : in NATURAL := 0);
 59     -- Print integers
 60     -- Examples:
 61     --  Ada procedure call                      Prints (without quotes)
 62     --  ============================            =======================
 63     --  CONSOLE.WRITE (25);                     "25"
 64     --  CONSOLE.WRITE (-3);                     "-3"
 65     --  CONSOLE.WRITE (25, 5);                  "   25"
 66
 67     procedure WRITE(ITEM           : in FLOAT;
 68                     BEFORE_DECIMAL : in NATURAL := 5;
 69                     AFTER_DECIMAL  : in NATURAL := 5);
 70     procedure WRITE_SCIENTIFIC(ITEM          : in FLOAT;
 71                                AFTER_DECIMAL : in NATURAL := 8);
 72     -- Print floats
 73     -- Examples:
 74     --  Ada procedure call                      Prints (without quotes)
 75     --  ============================            =======================
 76     --  CONSOLE.WRITE (25.21);                  "   25.21000"
 77     --  CONSOLE.WRITE (-36.2);                  "  -36.20000"
 78     --  CONSOLE.WRITE (-36.2, 1, 1);            "-36.2"
 79     --  CONSOLE.WRITE (25.21, 3);               " 25.21000"
 80     --  CONSOLE.WRITE (25.21, 3, 2);            " 25.21"
 81     --  CONSOLE.WRITE_SCIENTIFIC (23.0);        " 2.30000000e+01"
 82     --  CONSOLE.WRITE_SCIENTIFIC (5.7, 2);      " 5.70E+00"
 83     --  CONSOLE.WRITE_SCIENTIFIC (-4.5e-24, 4); "-4.5000E-24"
 84
 85     procedure READ(ITEM : out OUTSTRING);
 86     -- Read strings
 87     -- Example (note: <CR> refers to the RETURN key):
 88     --  MY_STRING : CONSOLE.OUTSTRING; -- 80-char string
 89     --  Ada procedure call              User Types      In MY_STRING
 90     --  ====================            ==========      ============
 91     --  CONSOLE.READ (MY_STRING);       "Hi<CR>"        "Hi"<and 78 spaces>
 92
 93     function TRIM(ITEM : in STRING) return STRING;
 94     -- Generate a string which has no trailing spaces
 95     -- Example of use:
 96     --  MY_STRING : CONSOLE.OUTSTRING;
 97     --  CONSOLE.READ(MY_STRING);
 98     --  CONSOLE.WRITE("Hello, ");
 99     --  CONSOLE.WRITE(CONSOLE.TRIM(MY_STRING));
100     --  CONSOLE.WRITE(", how are you?");
101     -- If the CONSOLE.READ statement returns "Joe" followed by 77 spaces,
102     -- the output will look like "Hello, Joe, how are you?"
103
104 end CONSOLE;
105 --
106 with TEXT_IO;
107 package body CONSOLE is
108
109     -- Generic instantiations for integer and float output
110     package INT_CONSOLE is new TEXT_IO.INTEGER_IO(INTEGER);
111     package FLT_CONSOLE is new TEXT_IO.FLOAT_IO(FLOAT);
112
113     procedure WRITE(ITEM : in STRING) is
114     begin
115         TEXT_IO.PUT(ITEM);
116     end WRITE;
117
118     procedure WRITE(ITEM : in CHARACTER) is
119     begin
120         TEXT_IO.PUT(ITEM);
121     end WRITE;
122
123     procedure WRITE(ITEM : in SPECIAL_ITEM) is
124     begin
125         case ITEM is
126             when NEW_LINE =>
127                 TEXT_IO.NEW_LINE;
128             when TAB =>
129                 TEXT_IO.PUT(ASCII.HT);
130             when BACKSPACE =>
131                 TEXT_IO.PUT(ASCII.BS);
132         end case;
133     end WRITE;
134
135     procedure WRITE(ITEM : in INTEGER; WIDTH : in NATURAL := 0) is
136     begin
137         INT_CONSOLE.PUT(ITEM => ITEM,
138                         WIDTH => WIDTH);
139     end WRITE;
140
141     procedure WRITE(ITEM           : in FLOAT;
142                     BEFORE_DECIMAL : in NATURAL := 5;
143                     AFTER_DECIMAL  : in NATURAL := 5) is
144     begin
145         FLT_CONSOLE.PUT(ITEM => ITEM,
146                         FORE => BEFORE_DECIMAL,
147                         AFT => AFTER_DECIMAL,
148                         EXP => 0);
149     end WRITE;
150
151     procedure WRITE_SCIENTIFIC(ITEM          : in FLOAT;
152                                AFTER_DECIMAL : in NATURAL := 8) is
153     begin
154         FLT_CONSOLE.PUT(ITEM => ITEM,
155                         FORE => 2,
156                         AFT => AFTER_DECIMAL,
157                         EXP => 3);
158     end WRITE_SCIENTIFIC;
159
160 --
161 -- Package body CONSOLE
162
163     procedure READ(ITEM : out OUTSTRING) is
164         LAST : NATURAL;
165     begin
166         TEXT_IO.GET_LINE(ITEM, LAST);
167         for I in LAST + 1 .. OUTSTRING'LAST loop -- space fill
168             ITEM(I) := ' ';
169         end loop;
170     end READ;
171
172     function TRIM(ITEM : in STRING) return STRING is
173         INDEX : NATURAL;
174     begin
175         INDEX := ITEM'FIRST - 1;   -- set for null string
176         for I in reverse ITEM'FIRST .. ITEM'LAST loop
177             if ITEM(I) /= ' ' then -- last non-space character
178                 INDEX := I;
179                 exit;
180             end if;
181         end loop;
182         return (ITEM(ITEM'FIRST .. INDEX));
183     end TRIM;
184
185 end CONSOLE;