* Re: Clearscreen
2001-12-24 0:19 ` Clearscreen Liddle Feesh
@ 2001-12-25 0:17 ` Frode Tennebø
2001-12-26 12:04 ` Clearscreen Liddle Feesh
0 siblings, 1 reply; 8+ messages in thread
From: Frode Tennebø @ 2001-12-25 0:17 UTC (permalink / raw)
On Monday 24 December 2001 01:19 Liddle Feesh wrote:
> "Liddle Feesh" wrote:
>> Sounds simple, but anyone know how to clear the screen in Ada?
>>
>> I've noticed quite a lot that the [12j needs to be 'putted' after the
> escape
>> char, but apart from that - I'm baffled...
>>
>> Any hints?
>
> Still none the wiser after loading the ANSI.SYS driver.
>
> Program is running in the DOS environment
I have attached a package I made a LONG time ago when I was
fiddeling about in DOS. Feel free to adapt them to your needs.
-Frode
--
^ Frode Tenneb� | email: frode@tennebo.com | Frode@IRC ^
| with Standard.Disclaimer; use Standard.Disclaimer; |
--**************************************************************************--
--* THIS BRILLIANT PACKAGE *--
--* WAS MADE BY *--
--* FRODE TENNEBO *--
--* (C) 30.10.1992 *--
--**************************************************************************--
package DISPLAY is
subtype T_ATTRIB is NATURAL range 0..8;
type E_ATTRIB is (normal,bold,flash,inverse,hidden);
--You can either use the subtype T_ATTRIB, which is a numerical type
-- with the values 0, 1, 4, 5, 7, and 8,
-- or E_ATTRIB, which is a enumerical type with the values
-- indicated above,
-- with the procedure TEXT_ATTRIBUTES.
--It's your choice!
subtype T_COLOR is NATURAL range 0..7;
type E_COLOR is (black,red,green,yellow,blue,magenta,cyan,white);
--You can either use the subtype T_COLOR, which is a numerical type
-- ranging from 0 to 7 including,
-- or E_COLOR, which is a enumerical type with the values
-- indicated above,
-- with the procedures FOREGROUND_COLOR and BACKGROUND_COLOR.
--It's your choice!
subtype T_MODE is NATURAL range 0..19;
type E_MODE is (HI,LO);
--You can either use the subtype T_MODE, which is a numerical type
-- ranging from 0 to 7 and 13 to 19 including,
-- or E_MODE, which is a special enumerical type with the two
-- quicky values indicated above,
-- with the procedure TEXT_MODE.
--It's your choice!
--Also refer to the procedure in question!
--******************************************************************--
procedure GOTOXY (col:in NATURAL:=1;row:in NATURAL:=1);
--Moves cursor to the specified position. Default is 1,1.
--The upper-left corner is 1,1; bottom-right is 80,25.
--NB! 0,0 and 1,1 are identical screen cooridnates!?!?
procedure UP (lines :in NATURAL:=1);
--Moves cursor up the specified numbers of lines. Default is 1.
procedure DOWN (lines :in NATURAL:=1);
--Moves cursor down the specified number of lines. Default is 1.
procedure RIGHT (col :in NATURAL:=1);
--Moves cursor right the specified number of columns. Default is 1.
procedure LEFT (col :in NATURAL:=1);
--Moves cursor left the specified number of columns. Defualt is 1.
procedure SAVE_CURSOR;
--Saves current cursor position. Use with RESTORE_CURSOR.
procedure RESTORE_CURSOR;
--Restores cursor to the position saved by SAVE_CURSOR.
procedure CLRSCR;
--Clears the display and sets cursor to 0,0.
procedure CLREOL;
--Clears the line from cursor porsition to the end of line.
procedure TEXT_ATTRIBUTES(a :in E_ATTRIB); --defualt: normal.
--Sets the text attributes to:
-- Normal,Bold on,Flash on,Inverse,Hidden.
procedure TEXT_ATTRIBUTES(a :in T_ATTRIB:=0);
--Sets the text attributes to:
-- 0=normal 1=bold 5=flash
-- 7=inverse 8=hidden
procedure FOREGROUND_COLOR(C :in E_COLOR); --default: white.
--Sets the foreground color to:
-- black, red, green,yellow,blue,magenta,cyan or White
procedure FOREGROUND_COLOR(C :in T_COLOR:=7);
--Sets the foreground color to a specified color:
-- 0=black 1=red 2=green 3=Yellow
-- 4=Blue 5=Magenta 6=Cyan 7=White
procedure BACKGROUND_COLOR(c :in E_COLOR); --default: black.
--Sets the background color to a specified color.
--Same as for FOREGROUND_COLOR.
procedure BACKGROUND_COLOR(c :in T_COLOR:=0);
--Sets the background color to a specified color.
--Same as for BACKGROUND_COLOR.
procedure TEXT_MODE (mode :in E_MODE); --defualt: hi.
--Sets the display mode to:
-- LO=40x25 color HI=80x25 color
procedure TEXT_MODE (mode :in T_MODE:=3);
--Sets the display mode to:
-- 0=40x25 mono 1=40x25 color 2=80x25 mono
-- 3=80x25 color 4=320x200 4-color 5=320x200 mono
-- 6=640x200 mono 7=Line warping 13=320x200 color
--14=640x200 16-color 15=640x350 mono 16=640x350 16-color
--17=640x480 mono 18=640x480 16-color 19=320x200 256-color
procedure REPORT_ERROR (str :in STRING);
--Prints the error message in the string str centered on
--the bottom line. Press any key to continue from here.
procedure BELL (b :in NATURAL:=1);
--Makes the bell sound for b number of times.
end DISPLAY;
--**************************************************************************--
--* THIS BRILLIANT PACKAGE *--
--* WAS MADE BY *--
--* FRODE TENNEBO *--
--* (C) 30.10.1992 *--
--**************************************************************************--
with TEXT_IO;
use TEXT_IO;
package body DISPLAY is
package INT_IO is new INTEGER_IO(INTEGER);
use INT_IO;
ESC :constant CHARACTER :=ASCII.ESC;
BEL :constant CHARACTER :=ASCII.BEL;
SEQ :STRING(1..2) :=(ESC & "[");
tmod :T_MODE :=3;
fcol :T_COLOR :=7;
bcol :T_COLOR :=0;
att :NATURAL :=0;
function FIND_COLOR(c :in E_COLOR) return T_COLOR is
col :T_COLOR;
begin
case c is
when black=>
col:=0;
when red=>
col:=1;
when green=>
col:=2;
when yellow=>
col:=3;
when blue=>
col:=4;
when magenta=>
col:=5;
when cyan=>
col:=6;
when white=>
col:=7;
end case;
return col;
end FIND_COLOR;
procedure GOTOXY (col:in NATURAL:=1;row:in NATURAL:=1) is
begin
put (seq);
put (row,1);
put (";");
put (col,1);
put ("f");
end GOTOXY;
procedure UP (lines :in NATURAL:=1) is
begin
put (seq);
put (lines,1);
put ("A");
end UP;
procedure DOWN (lines :in NATURAL:=1) is
begin
put (seq);
put (lines,1);
put ("B");
end DOWN;
procedure RIGHT (col :in NATURAL:=1) is
begin
put (seq);
put (col,1);
put ("C");
end RIGHT;
procedure LEFT (col :in NATURAL:=1) is
begin
put (seq);
put (col,1);
put ("D");
end LEFT;
procedure SAVE_CURSOR is
begin
put (seq);
put ("s");
end SAVE_CURSOR;
procedure RESTORE_CURSOR is
begin
put (seq);
put ("u");
end RESTORE_CURSOR;
procedure CLRSCR is
begin
put (seq);
put ("2J");
end CLRSCR;
procedure CLREOL is
begin
put (seq);
put ("K");
end CLREOL;
procedure TEXT_ATTRIBUTES (a :in E_ATTRIB) is
begin
case a is
when normal =>
att:=0;
when bold =>
att:=1;
when flash =>
att:=5;
when inverse =>
att:=7;
when hidden =>
att:=8;
end case;
put (seq);
put (att,1);
put ("m");
end TEXT_ATTRIBUTES;
procedure TEXT_ATTRIBUTES (a :in T_ATTRIB:=0) is
begin
put (seq);
put (att,1);
put ("m");
end TEXT_ATTRIBUTES;
procedure FOREGROUND_COLOR (c :in E_COLOR) is
begin
FOREGROUND_COLOR(find_color(c));
end FOREGROUND_COLOR;
procedure FOREGROUND_COLOR (C :in T_COLOR:=7) is
begin
put (seq);
put (fcol+30,1);
put ("m");
end FOREGROUND_COLOR;
procedure BACKGROUND_COLOR (c :in E_COLOR) is
begin
BACKGROUND_COLOR(find_color(c));
end BACKGROUND_COLOR;
procedure BACKGROUND_COLOR (c :in T_COLOR:=0) is
begin
put (seq);
put (bcol+40,1);
put ("m");
end BACKGROUND_COLOR;
procedure TEXT_MODE (mode :in E_MODE) is
begin
case mode is
when LO =>
tmod:=1;
when HI =>
tmod:=3;
end case;
put (seq & "=");
put (tmod,1);
put ("h");
end TEXT_MODE;
procedure TEXT_MODE (mode :in T_MODE:=3) is
begin
put (seq & "=");
put (tmod,1);
put ("h");
end TEXT_MODE;
procedure REPORT_ERROR (str :in STRING) is
len :integer :=0;
begin
case tmod is
when 1..2 =>
len:=40;
when 3..4 =>
len:=80;
when others =>
null;
end case;
if len/=0 then
SAVE_CURSOR;
gotoxy((len-str'length)/2,25);
put (str);
gotoxy(0,25);
CLREOL;
RESTORE_CURSOR;
end if;
end REPORT_ERROR;
procedure BELL (b :in NATURAL:=1) is
begin
for f in 1..b loop
put (bel);
end loop;
end BELL;
begin
TEXT_ATTRIBUTES(att);
TEXT_MODE(tmod);
FOREGROUND_COLOR(fcol);
BACKGROUND_COLOR(bcol);
end DISPLAY;
^ permalink raw reply [flat|nested] 8+ messages in thread