From mboxrd@z Thu Jan 1 00:00:00 1970 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=ham autolearn_force=no version=3.4.4 X-Google-Language: ENGLISH,ASCII X-Google-Thread: 103376,3fb128e1ed30d99d X-Google-Attributes: gid103376,public X-Google-ArrivalTime: 2001-12-25 14:56:17 PST Path: archiver1.google.com!news1.google.com!sn-xit-02!supernews.com!newsfeed.direct.ca!look.ca!news.tele.dk!small.news.tele.dk!128.39.3.168!uninett.no!leia!nobody From: Frode =?ISO-8859-1?Q?Tenneb=F8?= Newsgroups: comp.lang.ada Subject: Re: Clearscreen Date: Tue, 25 Dec 2001 01:17:22 +0100 Organization: UNINETT news service Message-ID: References: NNTP-Posting-Host: anne-bremnes.hiof.no Mime-Version: 1.0 Content-Type: text/plain; charset=iso-8859-1 Content-Transfer-Encoding: 8Bit X-Trace: snipp.uninett.no 1009320974 16666 158.36.52.48 (25 Dec 2001 22:56:14 GMT) X-Complaints-To: news-abuse@uninett.no User-Agent: KNode/0.6.1 Xref: archiver1.google.com comp.lang.ada:18296 Date: 2001-12-25T01:17:22+01:00 List-Id: 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;