home *** CD-ROM | disk | FTP | other *** search
/ Hall of Fame / HallofFameCDROM.cdr / prog1 / ada-tutr.lzh / UNIX.ADA < prev    next >
Text File  |  1988-12-21  |  2KB  |  47 lines
  1. -- UNIX.ADA   Ver. 1.20   21-DEC-1988
  2. -- Copyright 1988 John J. Herro
  3. -- Software Innovations Technology
  4. -- 1083 Mandarin Drive NE, Palm Bay, FL 32905-4706   (407)951-0233
  5. --
  6. -- Compile this before compiling ADA-TUTR.ADA on a UNIX based system.  You must
  7. -- also compile ONECHAR.C with a C compiler before linking.  See first page of
  8. -- ADA-TUTR.ADA for more details.
  9. --
  10. with TEXT_IO;
  11. package CUSTOM_IO is
  12.    type COLOR is (BLACK, RED, GREEN, YELLOW, BLUE, MAGENTA, CYAN, WHITE);
  13.    FOREGRND_COLOR   : COLOR := WHITE;                 -- Default values in case
  14.    BACKGRND_COLOR   : COLOR := BLACK;                 -- ADA-TUTR finds no User
  15.    BORDER_COLOR     : COLOR := BLACK;                 -- File.
  16.    FORE_COLOR_DIGIT : CHARACTER := CHARACTER'VAL(COLOR'POS(FOREGRND_COLOR)+48);
  17.    BACK_COLOR_DIGIT : CHARACTER := CHARACTER'VAL(COLOR'POS(BACKGRND_COLOR)+48);
  18.    NORMAL_COLORS    : STRING(1 .. 10) := ASCII.ESC & "[0;3" &
  19.                               FORE_COLOR_DIGIT & ";4" & BACK_COLOR_DIGIT & "m";
  20.    CLEAR_SCRN       : constant STRING := ASCII.ESC & "[H" & ASCII.ESC & "[2J";
  21.  
  22.    procedure SET_BORDER_COLOR (TO   : in COLOR);
  23.    procedure GET              (CHAR : out CHARACTER);
  24.    procedure PUT              (CHAR : in  CHARACTER) renames TEXT_IO.PUT;
  25.    procedure PUT              (STR  : in  STRING)    renames TEXT_IO.PUT;
  26.    procedure PUT_LINE         (STR  : in  STRING)    renames TEXT_IO.PUT_LINE;
  27.    procedure GET_LINE         (STR  : out STRING;
  28.                                LAST : out NATURAL)   renames TEXT_IO.GET_LINE;
  29.    procedure NEW_LINE      (SPACING : in  TEXT_IO.COUNT := 1)
  30.                                                      renames TEXT_IO.NEW_LINE;
  31. end CUSTOM_IO;
  32.  
  33. package body CUSTOM_IO is
  34.    procedure SET_BORDER_COLOR(TO : in COLOR) is
  35.       -- Dummy procedure for computers other than PCs.
  36.    begin
  37.       null;
  38.    end SET_BORDER_COLOR;
  39.  
  40.    procedure GET(CHAR : out CHARACTER) is
  41.       function ONECHAR return CHARACTER;
  42.       pragma INTERFACE (C, ONECHAR);
  43.    begin
  44.       CHAR := ONECHAR;
  45.    end GET;
  46. end CUSTOM_IO;
  47.