home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 December / simtel1292_SIMTEL_1292_Walnut_Creek.iso / msdos / ada / bd3.arc / CONSOLE.ADA < prev    next >
Text File  |  1989-03-13  |  7KB  |  189 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.  
  57. -- Package CONSOLE
  58.  
  59.     procedure WRITE(ITEM : in INTEGER; WIDTH : in NATURAL := 0);
  60.     -- Print integers
  61.     -- Examples:
  62.     --    Ada procedure call            Prints (without quotes)
  63.     --    ============================        =======================
  64.     --    CONSOLE.WRITE (25);            "25"
  65.     --    CONSOLE.WRITE (-3);            "-3"
  66.     --    CONSOLE.WRITE (25, 5);            "   25"
  67.  
  68.     procedure WRITE(ITEM           : in FLOAT;
  69.             BEFORE_DECIMAL : in NATURAL := 5;
  70.             AFTER_DECIMAL  : in NATURAL := 5);
  71.     procedure WRITE_SCIENTIFIC(ITEM          : in FLOAT;
  72.                    AFTER_DECIMAL : in NATURAL := 8);
  73.     -- Print floats
  74.     -- Examples:
  75.     --    Ada procedure call            Prints (without quotes)
  76.     --    ============================        =======================
  77.     --    CONSOLE.WRITE (25.21);            "   25.21000"
  78.     --    CONSOLE.WRITE (-36.2);            "  -36.20000"
  79.     --    CONSOLE.WRITE (-36.2, 1, 1);        "-36.2"
  80.     --    CONSOLE.WRITE (25.21, 3);        " 25.21000"
  81.     --    CONSOLE.WRITE (25.21, 3, 2);        " 25.21"
  82.     --    CONSOLE.WRITE_SCIENTIFIC (23.0);    " 2.30000000e+01"
  83.     --    CONSOLE.WRITE_SCIENTIFIC (5.7, 2);    " 5.70E+00"
  84.     --    CONSOLE.WRITE_SCIENTIFIC (-4.5e-24, 4);    "-4.5000E-24"
  85.  
  86.     procedure READ(ITEM : out OUTSTRING);
  87.     -- Read strings
  88.     -- Example (note: <CR> refers to the RETURN key):
  89.     --    MY_STRING : CONSOLE.OUTSTRING; -- 80-char string
  90.     --    Ada procedure call        User Types    In MY_STRING
  91.     --    ====================        ==========    ============
  92.     --    CONSOLE.READ (MY_STRING);    "Hi<CR>"    "Hi"<and 78 spaces>
  93.  
  94.     function TRIM(ITEM : in STRING) return STRING;
  95.     -- Generate a string which has no trailing spaces
  96.     -- Example of use:
  97.     --    MY_STRING : CONSOLE.OUTSTRING;
  98.     --    CONSOLE.READ(MY_STRING);
  99.     --    CONSOLE.WRITE("Hello, ");
  100.     --    CONSOLE.WRITE(CONSOLE.TRIM(MY_STRING));
  101.     --    CONSOLE.WRITE(", how are you?");
  102.     -- If the CONSOLE.READ statement returns "Joe" followed by 77 spaces,
  103.     -- the output will look like "Hello, Joe, how are you?"
  104.  
  105. end CONSOLE;
  106. -- 
  107.  
  108. with TEXT_IO;
  109. package body CONSOLE is
  110.  
  111.     -- Generic instantiations for integer and float output
  112.     package INT_CONSOLE is new TEXT_IO.INTEGER_IO(INTEGER);
  113.     package FLT_CONSOLE is new TEXT_IO.FLOAT_IO(FLOAT);
  114.  
  115.     procedure WRITE(ITEM : in STRING) is
  116.     begin
  117.     TEXT_IO.PUT(ITEM);
  118.     end WRITE;
  119.  
  120.     procedure WRITE(ITEM : in CHARACTER) is
  121.     begin
  122.     TEXT_IO.PUT(ITEM);
  123.     end WRITE;
  124.  
  125.     procedure WRITE(ITEM : in SPECIAL_ITEM) is
  126.     begin
  127.     case ITEM is
  128.         when NEW_LINE =>
  129.         TEXT_IO.NEW_LINE;
  130.         when TAB =>
  131.         TEXT_IO.PUT(ASCII.HT);
  132.         when BACKSPACE =>
  133.         TEXT_IO.PUT(ASCII.BS);
  134.     end case;
  135.     end WRITE;
  136.  
  137.     procedure WRITE(ITEM : in INTEGER; WIDTH : in NATURAL := 0) is
  138.     begin
  139.     INT_CONSOLE.PUT(ITEM => ITEM,
  140.                         WIDTH => WIDTH);
  141.     end WRITE;
  142.  
  143.     procedure WRITE(ITEM           : in FLOAT;
  144.             BEFORE_DECIMAL : in NATURAL := 5;
  145.             AFTER_DECIMAL  : in NATURAL := 5) is
  146.     begin
  147.     FLT_CONSOLE.PUT(ITEM => ITEM,
  148.                         FORE => BEFORE_DECIMAL,
  149.                         AFT => AFTER_DECIMAL,
  150.                     EXP => 0);
  151.     end WRITE;
  152.  
  153.     procedure WRITE_SCIENTIFIC(ITEM          : in FLOAT;
  154.                    AFTER_DECIMAL : in NATURAL := 8) is
  155.     begin
  156.     FLT_CONSOLE.PUT(ITEM => ITEM,
  157.                         FORE => 2,
  158.                         AFT => AFTER_DECIMAL,
  159.                         EXP => 3);
  160.     end WRITE_SCIENTIFIC;
  161.  
  162. -- 
  163.  
  164. -- Package body CONSOLE
  165.  
  166.     procedure READ(ITEM : out OUTSTRING) is
  167.     LAST : NATURAL;
  168.     begin
  169.     TEXT_IO.GET_LINE(ITEM, LAST);
  170.     for I in LAST + 1 .. OUTSTRING'LAST loop -- space fill
  171.         ITEM(I) := ' ';
  172.     end loop;
  173.     end READ;
  174.  
  175.     function TRIM(ITEM : in STRING) return STRING is
  176.     INDEX : NATURAL;
  177.     begin
  178.     INDEX := ITEM'FIRST - 1;   -- set for null string
  179.     for I in reverse ITEM'FIRST .. ITEM'LAST loop
  180.         if ITEM(I) /= ' ' then -- last non-space character
  181.         INDEX := I;
  182.         exit;
  183.         end if;
  184.     end loop;
  185.     return (ITEM(ITEM'FIRST .. INDEX));
  186.     end TRIM;
  187.  
  188. end CONSOLE;
  189.