Re: Terminal IO, and menus

[John J Cupak Jr <John_J_Cupak@res.raytheon.com>]

[-- Attachment #1: Type: text/plain, Size: 3496 bytes --]

Heath,

I have scoured the 'net for such a package, and other than Feldman's, couldn't
find just what I wanted. I also looked at the VT100/xterm escape sequences and
came up with a series of child packages to handle the different screen
properties. I've attached a screen_files.txt file to this message containing
all the packages - suitable for gnatchop (I checked it). Hope this help you..
and anyone else looking for this.

Yours in Ada95!

John J Cupak Jr, CCP

Heath Isler wrote:

> Hello,
>
> I would like to thank everyone  for the input.  I have decided to use the
> escape sequences for a ansi terminal since my target platforms are Win9X,
> Dos, Unixes, I don't care at this point if it runs on Win NT since I don't
> have it.
>
> Heath
>
> Matthew Heaney <matthew_heaney@acm.org> wrote in message
> news:m3677if8ks.fsf@mheaney.ni.net...
> > "Heath Isler" <isler@gfherald.infi.net> writes:
> >
> > > My question is is there a way in the stadard packages to Clear the
> Screen
> > > and postition the cursor in a specific location, i.e. Locate_Cursor (x
> =>
> > > 10, y =>15); ?  I am plan on using this for menus and data input.
> >
> > No, there's nothing in the Ada predefined packages to do that.
> >
> >
> > > I have also looked through a lot of packages on the net, and some of
> > > them seem to fit my need.  I not sure if I should use one of the
> > > Terminal IO or menu packages.  Can anyone recommend a package to use?
> >
> > In the GNAT source distribution, the dining philosophers example does
> > terminal I/O using escape sequences.
> >
> >
> > --::::::::::
> > --screen.ads
> > --::::::::::
> > package Screen is
> >
> >   -- simple ANSI terminal emulator
> >   -- Michael Feldman, The George Washington University
> >   -- July, 1995
> >
> >   ScreenHeight : constant Integer := 24;
> >   ScreenWidth : constant Integer := 80;
> >
> >   subtype Height is Integer range 1..ScreenHeight;
> >   subtype Width  is Integer range 1..ScreenWidth;
> >
> >   type Position is record
> >     Row   : Height := 1;
> >     Column: Width := 1;
> >   end record;
> >
> >   procedure Beep;
> >   -- Pre:  none
> >   -- Post: the terminal beeps once
> >
> >   procedure ClearScreen;
> >   -- Pre:  none
> >   -- Post: the terminal screen is cleared
> >
> >   procedure MoveCursor (To: in Position);
> >   -- Pre:  To is defined
> >   -- Post: the terminal cursor is moved to the given position
> >
> > end Screen;
> >
> >
> > --::::::::::
> > --screen.adb
> > --::::::::::
> > with Text_IO;
> > package body Screen is
> >
> >   -- simple ANSI terminal emulator
> >   -- Michael Feldman, The George Washington University
> >   -- July, 1995
> >
> >   -- These procedures will work correctly only if the actual
> >   -- terminal is ANSI compatible. ANSI.SYS on a DOS machine
> >   -- will suffice.
> >
> >   package Int_IO is new Text_IO.Integer_IO (Num => Integer);
> >
> >   procedure Beep is
> >   begin
> >     Text_IO.Put (Item => ASCII.BEL);
> >   end Beep;
> >
> >   procedure ClearScreen is
> >   begin
> >     Text_IO.Put (Item => ASCII.ESC);
> >     Text_IO.Put (Item => "[2J");
> >   end ClearScreen;
> >
> >   procedure MoveCursor (To: in Position) is
> >   begin
> >     Text_IO.New_Line;
> >     Text_IO.Put (Item => ASCII.ESC);
> >     Text_IO.Put ("[");
> >     Int_IO.Put (Item => To.Row, Width => 1);
> >     Text_IO.Put (Item => ';');
> >     Int_IO.Put (Item => To.Column, Width => 1);
> >     Text_IO.Put (Item => 'f');
> >   end MoveCursor;
> >
> > end Screen;



[-- Attachment #2: screen_files.txt --]
[-- Type: text/plain, Size: 9618 bytes --]

----------------------------------------------------------------------
--  The Screen Package (Specification)
--
--  Programmer : John Cupak
--  History    :  6Oct97 jcj Created
--               17Oct97 jcj "Base" types package 
--  Description: This package defines the xterm/VT100 size
----------------------------------------------------------------------

package Screen is

   Maximum_Rows    : constant := 24;
   Maximum_Columns : constant := 80;

   subtype Rows    is Positive range 1..Maximum_Rows;
   subtype Columns is Positive range 1..Maximum_Columns;

private

   -- Define constant for use by all child packages

   -- Command Sequence Introducer (CSI)
   -- (provides screen command prefix)

   CSI : constant String := ASCII.ESC & "[";

end Screen;
----------------------------------------------------------------------
--  The Screen Attributes Child Package (Specification)
--
--  Programmer : John Cupak
--  History    : 17Oct97 jcj Created
--  Description: Changes display attributes of characters
----------------------------------------------------------------------
package Screen.Attributes is
   -- Turn off attributes - normal video
   procedure Normal;
   -- Turn on underlined mode
   procedure Underlined;
   -- Turn on inverse video mode
   procedure Inverse;
  -- Turn on highlight video mode
   procedure Highlight;
  -- Turn on blink mode
   procedure Blink;

end Screen.Attributes;
----------------------------------------------------------------------
--  The Screen Colors Child Package (Specification)
--
--  Programmer : John Cupak
--  History    : 17Nov97 jcj Created
--  Description: Sets foreground and background color(s) 
----------------------------------------------------------------------

package Screen.Colors is

   type Color is (Black, 
                  Red, 
                  Green, 
                  Yellow, 
                  Blue, 
                  Magenta, 
                  Cyan, 
                  White, 
                  default); -- Original color

   -- Specify internal representations

   for Color use (Black   => 0,
                  Red     => 1,
                  Green   => 2,
                  Yellow  => 3,
                  Blue    => 4,
                  Magenta => 5,
                  Cyan    => 6,
                  White   => 7,
                  default => 9);
   procedure Set_Foreground(Choice : in Color := default);
   procedure Set_Background(Choice : in Color := default);

end Screen.Colors;
----------------------------------------------------------------------
--  The Screen Cursor Control Child Package (Specification)
--
--  Programmer : John Cupak
--  History    : 17Oct97 jcj Created
--  Description: Moves cursor from current position
----------------------------------------------------------------------

package Screen.Cursor is

   -- Move cursor "By" times - stop at top
   procedure Up   (By : in Positive := 1);

   -- Move cursor down "By" times - stop at bottom
   procedure Down (By : in Positive := 1);

   -- Move cursor right "By" times - stop at far right
   procedure Right(By : in Positive := 1);

   -- Move cursor left "By" times - stop at far left
   procedure Left (By : in Positive := 1);

   -- Set cursor position - Column=X, Row=Y
   procedure Position(Column : Columns;  
                      Row    : Rows   ); -- Line

   -- Set cursor home (1,1)
   procedure Home;

end Screen.Cursor;
----------------------------------------------------------------------
--  The Screen Erase Child Package (Specification)
--
--  Programmer : John Cupak
--  History    : 17Oct97 jcj Created
--  Description: Erases lines and screens
----------------------------------------------------------------------

package Screen.Erase is

   procedure To_End_Of_Line; -- Inclusive
   procedure EOF renames To_End_Of_Line;

   procedure To_Beginning_Of_Line; -- Inclusive
   procedure BOL renames To_Beginning_Of_Line;

   procedure Entire_Line; -- Cursor doesn't move
   procedure Line renames Entire_Line;

   procedure To_End_Of_Screen; -- Inclusive
   procedure EOS renames To_End_Of_Screen;

   procedure To_Beginning_Of_Screen; -- Inclusive;
   procedure BOS renames To_Beginning_Of_Screen;

   procedure Entire_Screen; -- Cursor doesn't move
   procedure Clear renames Entire_Screen;

end Screen.Erase;
----------------------------------------------------------------------
--  The Screen Graphics Child Package (Specification)
--
--  Programmer : John Cupak
--  History    : 17Oct97 jcj Created
--  Description: Sets modes and draws lines 
----------------------------------------------------------------------

package Screen.Graphics is

   procedure Set_Character_Mode; -- Turn off drawing
   procedure Set_Line_Mode;      -- Turn on drawing 

   procedure Corner_UL; -- Draw Upper-Left corner
   procedure Corner_UR; -- Draw Upper-Right corner
   procedure Corner_LL; -- Draw Lower_Left corner
   procedure Corner_LR; -- Draw Lower_Right corner

   procedure Tee_Right; -- Vertical line, right connector
   procedure Tee_Left;  -- Vertical line, left connector
   procedure Tee_Up;    -- Horizontal line, up connector
   procedure Tee_Down;  -- Horizontal line, down connector

   procedure Cross;     -- Intersecting lines

   procedure Vertical;  -- Vertical line

   subtype Position is Positive range 1..5; -- Top to Bottom
   procedure Horizontal(Line : in Position := 3);

end Screen.Graphics;   
with Ada.Text_IO;
use  Ada.Text_IO;
package body Screen.Attributes is

   procedure Normal     is
   begin
      Put(CSI & "0m");
   end Normal;

   procedure Highlight  is
   begin
      Put(CSI & "1m");
   end Highlight;

   procedure Underlined is
   begin
      Put(CSI & "4m");
   end Underlined;

   procedure Blink      is
   begin
      Put(CSI & "5m");
   end Blink;

   procedure Inverse    is
   begin
      Put(CSI & "7m");
   end Inverse;

end Screen.Attributes;   
with Ada.Text_IO;
package body Screen.Colors is

   package Color_IO is new Ada.Text_IO.Enumeration_IO(Color);

   use Ada.Text_IO;
   use Color_IO;

   procedure Set_Foreground(Choice : in Color := default) is
   begin
      Put(CSI);    -- Control Sequence Introducer
      Put("3;");   -- Foreground
      Put(Choice); -- specified color
      Put('m');    -- Character attribute
   end Set_Foreground;

   procedure Set_Background(Choice : in Color := default) is
   begin
      Put(CSI);    -- Control Sequence Introducer
      Put("4;");   -- Background
      Put(Choice); -- Specified color
      Put('m');    -- Character attribute
   end Set_Background;

end Screen.Colors;   
with Ada.Text_IO;
with Ada.Integer_Text_IO;
use Ada.Text_IO;
use Ada.Integer_Text_IO;
package body Screen.Cursor is

   procedure Up   (By : in Positive := 1) is
   begin
      Put(CSI);Put(By,0);Put("A");
   end Up;

   procedure Down (By : in Positive := 1) is
   begin
      Put(CSI);Put(By,0);Put("B");
   end Down;

   procedure Right(By : in Positive := 1) is
   begin
      Put(CSI);Put(By,0);Put("C");
   end Right;

   procedure Left (By : in Positive := 1) is
   begin
      Put(CSI);Put(By,0);Put("D");
   end Left;

   procedure Position(Column : in Columns;
                      Row    : in Rows   ) is
   
   begin                                                
      Put(Item => CSI);
      Put(Item => Row,    Width => 0);
      Put(Item => ';');
      Put(Item => Column, Width => 0);
      Put(Item => 'H');
   end Position;

   procedure Home is
   begin
      Put(CSI & "H");
   end Home;

end Screen.Cursor;   
with Ada.Text_IO;
use Ada.Text_IO;
package body Screen.Erase is

   procedure To_End_Of_Line is
   begin
      Put(CSI & "0K");
   end To_End_Of_Line;

   procedure To_Beginning_Of_Line is
   begin
      Put(CSI & "1K");
   end To_Beginning_Of_Line;
   procedure Entire_Line is
   begin
      Put(CSI & "2K");
   end Entire_Line;
   procedure To_End_Of_Screen is
   begin
      Put(CSI & "0J");
   end To_End_Of_Screen;
   procedure To_Beginning_Of_Screen is
   begin
      Put(CSI & "1J");
   end To_Beginning_Of_Screen;
   procedure Entire_Screen is
   begin
      Put(CSI & "2J" );
   end Entire_Screen;

end Screen.Erase;   
with Ada.Text_IO;
with Ada.Characters.Latin_1; -- for SI and SO

use  Ada.Text_IO;
package body Screen.Graphics is

   procedure Set_Character_Mode is
   begin
      Put(Ada.Characters.Latin_1.SI); -- Shift In
   end Set_Character_Mode;
   procedure Set_Line_Mode is
   begin
      Put(Ada.Characters.Latin_1.SO); -- Shift out
   end Set_Line_Mode;

  -- The following procedures assume that the user
  -- has called Set_Line_Mode first.
   procedure Corner_UL is
   begin
      Put('l');
   end Corner_UL;
   procedure Corner_UR is
   begin
      Put('k');
   end Corner_UR;
   procedure Corner_LL is
   begin
      Put('m');
   end Corner_LL;

   procedure Corner_LR is
   begin
      Put('j');
   end Corner_LR;

   procedure Tee_Right is
   begin
      Put('t');
   end Tee_Right;
   procedure Tee_Left is
   begin
      Put('u');
   end Tee_Left;
   procedure Tee_Up is
   begin
      Put('v');
   end Tee_Up;
   procedure Tee_Down is
   begin
      Put('w');
   end Tee_Down;

   procedure Cross is
   begin
      Put('n');
   end Cross;

   procedure Vertical is
   begin
      Put('x');
   end Vertical;

   procedure Horizontal(Line : in Position := 3) is
   begin
    -- Convert Line Position value to
    --  characters 'o' through 's'
      Put(Character'Val(Character'Pos('n') + Line));
   end Horizontal;

begin -- Initialization

   Put(ASCII.ESC & "(B"); -- Set US char set as G0
   Put(ASCII.ESC & ")0"); -- Set line char set as G1

end Screen.Graphics;

[-- Attachment #3: Card for John J Cupak Jr --]
[-- Type: text/x-vcard, Size: 428 bytes --]

begin:          vcard
fn:             John J Cupak Jr
n:              Cupak Jr;John J
org:            Raytheon Systems Company
adr:            50 Apple Hill Road;;T3MN35;Tewksbury;MA;01876;USA
email;internet: John_J_Cupak@res.raytheon.com
title:          Software Engineering Instructor
tel;work:       978.858.1222
tel;fax:        978.858.4336
x-mozilla-cpt:  ;0
x-mozilla-html: TRUE
version:        2.1
end:            vcard