PRAGMA init_bloc
(init_op => initialize)
-- Dining Philosophers - Ada 95 edition
--
-- Manager for simple, nonoverlapping screen windows.
--
-- Michael B. Feldman, The George Washington University, July 1995.
-- HOOD version by Pierre Dissaux, TNI, June 1998.
-- required interface :
-- Required OPERATION :
-- OPERATION : ClearScreen of object : screen
-- OPERATION : MoveCursor of object : screen
-- OPERATION : New_Line of object : text_io
-- OPERATION : Put of object : text_io
-- Required EXCEPTION : NONE
-- Required TYPE :
-- TYPE : Height of object : screen
-- TYPE : Width of object : screen
-- TYPE : Position of object : screen
-- TYPE : Character of object : standard
-- TYPE : String of object : standard
-- Required CONSTANT : NONE
-- Required DATA : NONE
-- visibility on required modules :
with screen;
use type screen.Height;
use type screen.Width;
use type screen.Position;
package windows is
type Window is private;
-- Pre: UpperLeft, Weight, and Width are defined
-- Post: returns a Window with the given upper-left corner, height, and width
function open (
UpperLeft : IN Screen.Position;
Height : IN Screen.Height;
Width : IN Screen.Width)
return Window;
-- Pre: me, Name, and Under are defined
-- Post: Name is displayed at the top of the window me, underlined with the
-- character Under
procedure title (
me : IN OUT Window;
Name : IN String;
Under : IN Character);
-- Pre: All parameters are defined
-- Post: Draw border around current writable area in window with characters
-- specified.
-- Call this BEFORE Title.
procedure borders (
me : IN OUT Window;
Corner : IN Character;
Down : IN Character;
Across : IN Character);
-- Pre: me, and P are defined, and P lies within the area of me
-- Post: Cursor is moved to the specified position.
-- Coordinates are relative to the upper left corner of me, which is (1,1)
procedure movecursor (
me : IN OUT Window;
P : IN Screen.Position);
-- Pre: me, and Ch are defined.
-- Post: Ch is displayed in the window at the next available position.
-- If end of column, go to the next row.
-- If end of window, go to the top of the window.
procedure put (
me : IN OUT Window;
Ch : IN Character);
-- Pre: me, and S are defined.
-- Post: Ch is displayed in the window, "line-wrapped" if necessary
procedure put (
me : IN OUT Window;
S : IN String);
-- Pre: me is defined.
-- Post: Cursor moves to beginning of next line of me;
-- line is not blanked until next character is written
procedure new_line (
me : IN OUT Window);
private
-- First : coordinates of upper left corner;
-- Last : coordinates of lower right corner;
-- Current : current cursor position.
type Window is tagged
record
First : screen.Position;
Last : screen.Position;
Current : screen.Position;
end record;
end windows;
-- Dining Philosophers - Ada 95 edition
--
-- Manager for simple, nonoverlapping screen windows.
--
-- Michael B. Feldman, The George Washington University, July 1995.
-- HOOD version by Pierre Dissaux, TNI, June 1998.
-- visibility on required modules :
with text_io;
-- visibility on objects required by nested operation bodies :
package body windows is
-- Used to erase partially the screen.
procedure erasetoendofline (
me : IN OUT Window);
-- Instanciates a new Window named "Result"
-- Sets Result attributes (Current, First and Last)
-- Returns Result.
function open (
UpperLeft : IN Screen.Position;
Height : IN Screen.Height;
Width : IN Screen.Width)
return Window is
Result : Window;
begin
Result.Current := UpperLeft;
Result.First := UpperLeft;
Result.Last := (Row => UpperLeft.Row + Height - 1,
Column => UpperLeft.Column + Width - 1);
return Result;
end open;
-- Sets cursor at the beginning of first line.
-- Writes title string
-- If "Under" is blank then continue
-- else draw a separation line
-- Reduces writable area as required.
procedure title (
me : IN OUT Window;
Name : IN String;
Under : IN Character) is
begin
-- Put name on top line
me.Current := me.First;
Put(me, Name);
New_Line(me);
-- Underline name if desired, and reduce the writable area
-- of the window by one line
if Under = ' ' then
-- no underlining
me.First.Row := me.First.Row + 1;
else
-- go across the row, underlining
for Count in me.First.Column..me.Last.Column loop
Put(me, Under);
end loop;
New_Line(me);
-- reduce writable area
me.First.Row := me.First.Row + 2;
end if;
end title;
-- Draws top line border.
-- Draws the two side lines.
-- Draws the bottom line of the border.
-- Make the Window smaller by one character on each side.
procedure borders (
me : IN OUT Window;
Corner : IN Character;
Down : IN Character;
Across : IN Character) is
begin
-- Put top line of border
Screen.MoveCursor(me.First);
Text_IO.Put(Corner);
for Count in me.First.Column+1 .. me.Last.Column-1 loop
Text_IO.Put(Across);
end loop;
Text_IO.Put(Corner);
-- Put the two side lines
for Count in me.First.Row+1 .. me.Last.Row-1 loop
Screen.MoveCursor((Row => Count,Column => me.First.Column));
Text_IO.Put(Down);
Screen.MoveCursor((Row => Count,Column => me.Last.Column));
Text_IO.Put(Down);
end loop;
-- Put the bottom line of the border
Screen.MoveCursor((Row => me.Last.Row,Column => me.First.Column));
Text_IO.Put(corner);
for Count in me.First.Column+1 .. me.Last.Column-1 loop
Text_IO.Put (Across);
end loop;
Text_IO.Put(Corner);
-- Make the Window smaller by one character on each side
me.First := (Row => me.First.Row+1,Column => me.First.Column+1);
me.Last := (Row => me.Last.Row-1,Column => me.Last.Column-1);
me.Current := me.First;
end borders;
-- Cursor position passed as parameter is relative to window boundaries.
procedure movecursor (
me : IN OUT Window;
P : IN Screen.Position) is
-- Relative to writable Window boundaries, of course
begin
me.Current.Row := me.First.Row + P.Row;
me.Current.Column := me.First.Column + P.Column;
end movecursor;
-- If at end of current line then move to next line.
-- If at beginning of current line then erase the entire line.
-- Writes given character.
procedure put (
me : IN OUT Window;
Ch : IN Character) is
begin
-- If at end of current line, move to next line
if me.Current.Column > me.Last.Column then
if me.Current.Row = me.Last.Row then
me.Current.Row := me.First.Row;
else
me.Current.Row := me.Current.Row + 1;
end if;
me.Current.Column := me.First.Column;
end if;
-- If at First char, erase line
if me.Current.Column = me.First.Column then
EraseToEndOfLine(me);
end if;
Screen.MoveCursor(To => me.Current);
-- here is where we actually write the character!
Text_IO.Put(Ch);
me.Current.Column := me.Current.Column + 1;
end put;
-- Uses put#1 to write each character of the string.
procedure put (
me : IN OUT Window;
S : IN String) is
begin
for Count in S'Range loop
Put(me, S (Count));
end loop;
end put;
-- If cursor is at beginning of a line then first erase this line.
-- If cursor is on last line then put it on first line.
-- Else put it on next line.
procedure new_line (
me : IN OUT Window) is
begin
if me.Current.Column = 1 then
EraseToEndOfLine(me);
end if;
if me.Current.Row = me.Last.Row then
me.Current.Row := me.First.Row;
else
me.Current.Row := me.Current.Row + 1;
end if;
me.Current.Column := me.First.Column;
end new_line;
-- Puts blank characters from current cursor position to the end of current
-- line.
-- Current cursor position remains unchanged.
procedure erasetoendofline (
me : IN OUT Window) is
begin
Screen.MoveCursor (me.Current);
for Count in me.Current.Column .. me.Last.Column loop
Text_IO.Put (' ');
end loop;
Screen.MoveCursor (me.Current);
end erasetoendofline;
begin
Text_IO.New_Line;
Screen.ClearScreen;
Text_IO.New_Line;
end windows;