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