mfeldman@seas.gwu.edu (Michael Feldman) (09/23/90)
NOTE: This package is supplied with the source code for Ada-Tutor, which is
a shareware package distributed by the author listed below. I am sending
another file consisting of the C code for the body of ONECHAR.C
---------------------------------------------------------------------------
Prof. Michael Feldman
Department of Electrical Engineering and Computer Science
The George Washington University
Washington, DC 20052
202-994-5253
mfeldman@seas.gwu.edu
---------------------------------------------------------------------------
-- UNIX.ADA Ver. 1.22 18-FEB-1989
-- Copyright 1988-1989 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 on a UNIX based system. You must
-- also compile ONECHAR.C or ALTCHAR.C with a C compiler before linking. See
-- first page of ADA_TUTR.ADA for more details.
--
with TEXT_IO;
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 := CHARACTER'VAL(COLOR'POS(FOREGRND_COLOR)+48);
BACK_COLOR_DIGIT : CHARACTER := CHARACTER'VAL(COLOR'POS(BACKGRND_COLOR)+48);
NORMAL_COLORS : STRING(1 .. 10) := ASCII.ESC & "[0;3" &
FORE_COLOR_DIGIT & ";4" & BACK_COLOR_DIGIT & "m";
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 TEXT_IO.PUT;
procedure PUT (STR : in STRING) renames TEXT_IO.PUT;
procedure PUT_LINE (STR : in STRING) renames TEXT_IO.PUT_LINE;
procedure GET_LINE (STR : out STRING;
LAST : out NATURAL) renames TEXT_IO.GET_LINE;
procedure NEW_LINE (SPACING : in TEXT_IO.COUNT := 1)
renames TEXT_IO.NEW_LINE;
end CUSTOM_IO;
package body CUSTOM_IO is
procedure SET_BORDER_COLOR(TO : in COLOR) is
-- Dummy procedure for computers other than PCs.
begin
null;
end SET_BORDER_COLOR;
procedure GET(CHAR : out CHARACTER) is
function ONECHAR return CHARACTER;
pragma INTERFACE (C, ONECHAR);
begin
CHAR := ONECHAR;
end GET;
end CUSTOM_IO;