-- MERIDIAN.ADA   Ver. 1.20   21-DEC-1988
-- Copyright 1988 John J. Herro
-- Software Innovations Technology
-- 1083 Mandarin Drive NE, Palm Bay, FL 32905-4706   (407)951-0233
--
-- Compile this before compiling ADA-TUTR.ADA, when using a PC with the
-- Meridian AdaStarter or AdaVantage compiler and the DOS Environment Library.
--
with TTY;
package CUSTOM_IO is
   type COLOR is (BLACK, RED, GREEN, YELLOW, BLUE, MAGENTA, CYAN, WHITE);
   FOREGRND_COLOR   : COLOR := WHITE;                 -- Default values in case
   BACKGRND_COLOR   : COLOR := BLACK;                 -- ADA-TUTR finds no User
   BORDER_COLOR     : COLOR := BLACK;                 -- File.
   FORE_COLOR_DIGIT : CHARACTER;             -- These three variables are given
   BACK_COLOR_DIGIT : CHARACTER;             -- values in the initialization
   NORMAL_COLORS    : STRING(1 .. 10);       -- section of the package body.
   CLEAR_SCRN       : constant STRING := ASCII.ESC & "[H" & ASCII.ESC &"[2J";

   procedure SET_BORDER_COLOR (TO   : in COLOR);
   procedure GET              (CHAR : out CHARACTER);
   procedure PUT              (CHAR : in  CHARACTER) renames TTY.PUT;
   procedure PUT              (STR  : in  STRING)    renames TTY.PUT;
   procedure PUT_LINE         (STR  : in  STRING)    renames TTY.PUT_LINE;
   procedure GET_LINE         (STR  : out STRING;
                               LAST : out NATURAL)   renames TTY.GET;
   procedure NEW_LINE;
end CUSTOM_IO;

with INTERRUPT;
package body CUSTOM_IO is
   procedure SET_BORDER_COLOR(TO : in COLOR) is
      --
      -- This procedure sets the border color on a PC by calling interrupt
      -- 10 hex.  Before the call, register AH is set to service number 0B hex,
      -- BH is set to zero, and BL is set to an integer as shown in the
      -- declaration of COLOR_NUMBER below.  Note that the integers in
      -- COLOR_NUMBER are bit reversed from the integers defining foreground
      -- and background colors in ANSI escape sequences.  Note also that some
      -- color PCs don't have separate border colors.
      --
      REGIS_BLOCK  : INTERRUPT.REGISTERS;
      COLOR_NUMBER : constant array(COLOR) of INTEGER :=
          (BLACK   => 0,   RED     => 4,   GREEN   => 2,   YELLOW  => 6,
           BLUE    => 1,   MAGENTA => 5,   CYAN    => 3,   WHITE   => 7);
   begin
      REGIS_BLOCK.AX := 16#0B00#;
      REGIS_BLOCK.BX := 16#0000# + COLOR_NUMBER(TO);
      INTERRUPT.VECTOR(ON => 16#10#, REGISTER_BLOCK => REGIS_BLOCK);
   end SET_BORDER_COLOR;

   procedure GET(CHAR : out CHARACTER) is
   begin
      CHAR := TTY.GET;
   end GET;

   procedure NEW_LINE is
   begin
      PUT_LINE("");
   end NEW_LINE;
begin
   -- These variables are initialized here, rather than in the package
   -- specification, to work around a minor bug in version 2.1 of the
   -- Meridian AdaStarter compiler.
   FORE_COLOR_DIGIT := CHARACTER'VAL(COLOR'POS(FOREGRND_COLOR) + 48);
   BACK_COLOR_DIGIT := CHARACTER'VAL(COLOR'POS(BACKGRND_COLOR) + 48);
   NORMAL_COLORS    := ASCII.ESC & "[0;3" & FORE_COLOR_DIGIT & ";4" &
                            BACK_COLOR_DIGIT & "m";
end CUSTOM_IO;