home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / ADA_TUTR.ZIP / VANILLA.ADA < prev    next >
Encoding:
Text File  |  1992-09-04  |  2.6 KB  |  51 lines
  1. -- VANILLA.ADA   Ver. 2.02   4-SEP-1992   Copyright 1988-1992 John J. Herro
  2. -- Software Innovations Technology
  3. -- 1083 Mandarin Drive NE, Palm Bay, FL  32905-4706   (407)951-0233
  4. --
  5. -- "Plain vanilla" version of CUSTOM_IO which should work with ANY standard Ada
  6. -- compiler.  Compile this before compiling ADA_TUTR.ADA.
  7. --
  8. with TEXT_IO;
  9. package CUSTOM_IO is
  10.    type COLOR is (BLACK, RED, GREEN, YELLOW, BLUE, MAGENTA, CYAN, WHITE);
  11.    FOREGRND_COLOR   : COLOR := WHITE;                 -- Default values in case
  12.    BACKGRND_COLOR   : COLOR := BLACK;                 -- ADA-TUTR finds no User
  13.    BORDER_COLOR     : COLOR := BLACK;                 -- File.
  14.    FORE_COLOR_DIGIT : CHARACTER := CHARACTER'VAL(COLOR'POS(FOREGRND_COLOR)+48);
  15.    BACK_COLOR_DIGIT : CHARACTER := CHARACTER'VAL(COLOR'POS(BACKGRND_COLOR)+48);
  16.    NORMAL_COLORS    : STRING(1 .. 10) := ASCII.ESC & "[0;3" &
  17.                               FORE_COLOR_DIGIT & ";4" & BACK_COLOR_DIGIT & "m";
  18.    CLEAR_SCRN       : constant STRING := ASCII.ESC & "[H" & ASCII.ESC & "[2J";
  19.  
  20.    procedure SET_BORDER_COLOR (TO   : in COLOR);
  21.    procedure GET              (CHAR : out CHARACTER) renames TEXT_IO.GET;
  22.    procedure PUT              (CHAR : in  CHARACTER) renames TEXT_IO.PUT;
  23.    procedure PUT              (STR  : in  STRING)    renames TEXT_IO.PUT;
  24.    procedure PUT_LINE         (STR  : in  STRING)    renames TEXT_IO.PUT_LINE;
  25.    procedure GET_LINE         (STR  : out STRING;
  26.                                LAST : out NATURAL)   renames TEXT_IO.GET_LINE;
  27.    procedure NEW_LINE      (SPACING : in  TEXT_IO.COUNT := 1)
  28.                                                      renames TEXT_IO.NEW_LINE;
  29. end CUSTOM_IO;
  30.  
  31. package body CUSTOM_IO is
  32.    procedure SET_BORDER_COLOR(TO : in COLOR) is
  33.       --
  34.       -- This is a dummy procedure.  If your PC Ada compiler allows interrupt
  35.       -- calls or assembly language, you may want to write code to call
  36.       -- interrupt 10 hex.  (See JANUS.ADA and MERIDIAN.ADA for examples.)
  37.       -- Before the call, set register AH to service number 0B hex, set BH to
  38.       -- zero, and set BL to COLOR_NUMBER(TO), where COLOR_NUMBER is declared
  39.       -- below.  Note that the integers in COLOR_NUMBER are bit reversed from
  40.       -- the integers defining foreground and background colors in ANSI escape
  41.       -- sequences.  Note also that some color PCs don't have separate border
  42.       -- colors.
  43.       --
  44.       COLOR_NUMBER : constant array(COLOR) of INTEGER :=
  45.           (BLACK   => 0,   RED     => 4,   GREEN   => 2,   YELLOW  => 6,
  46.            BLUE    => 1,   MAGENTA => 5,   CYAN    => 3,   WHITE   => 7);
  47.    begin
  48.       null;
  49.    end SET_BORDER_COLOR;
  50. end CUSTOM_IO;
  51.