WITH Ada.Text_IO;
WITH Screen;
PACKAGE BODY Spider IS
------------------------------------------------------------------
--|
--| This package provides procedures to emulate "Spider"
--| commands. The spider is can move around
--| the screen drawing simple patterns.
--|
--| Author: John Dalbey, Cal Poly San Luis Obispo, 1992
--| Adapted by: Michael B. Feldman, The George Washington University
--| Last Modified: July 1995
--|
------------------------------------------------------------------
TYPE ScreenColors IS (Red, Blue, Green, Black); -- available colors
-- Spider's View of her Room - rows and cols both numbered 1..20
SUBTYPE Rows IS Positive RANGE 1..20;
SUBTYPE Cols IS Positive RANGE 1..20;
RowsInRoom : CONSTANT Positive := Rows'Last;
ColsInRoom : CONSTANT Positive := Cols'Last;
-- Spider State
Spidersym : CONSTANT character := '*'; -- asterisk
CurrentColumn: Cols; -- spider's position
CurrentRow : Rows; -- in the room.
Heading : Directions; -- spider's direction
Ink : ScreenColors; -- spider's color
-- Screen Description Constants: for 24 x 80 screen,
-- 1 spider row = 1 screen row, 1 spider col = 2 screen cols
RowLow : CONSTANT Screen.Depth := 2; -- room row bounds
RowHigh : CONSTANT Screen.Depth := RowLow + Rows'Last;
ColLow : CONSTANT Screen.Width := 21; -- lower column bound
ColHigh : CONSTANT Screen.Width := ColLow + 2*Cols'Last;
DebugFlag : Boolean := False; -- Is single stepping on?
-- internal procedures and functions, not in specification
-- and therefore not available to client program
PROCEDURE DrawSymbol (Which: Character) IS
-- Pre: Which is defined
-- Post: Which appears in its proper position on the screen
BEGIN
Screen.MoveCursor (Row => (RowLow - 1) + CurrentRow,
Column => (ColLow - 2) + (2 * CurrentColumn));
Ada.Text_IO.Put (Item => Which);
Ada.Text_IO.Flush;
END DrawSymbol;
FUNCTION ColorSymbols (Color: ScreenColors) RETURN Character IS
-- Pre: Color is defined
-- Post: Returns the drawing character corresponding to Color
BEGIN
CASE Color IS
WHEN Red => RETURN '+';
WHEN Blue => RETURN 'X';
WHEN Green => RETURN 'O';
WHEN Black => RETURN '.';
END CASE;
END ColorSymbols;
FUNCTION Compass (Direction: Directions) RETURN Character IS
-- Pre: Direction is defined
-- Post: Returns drawing character corresponding to Direction
BEGIN
CASE Direction IS
WHEN North => RETURN '^';
WHEN East => RETURN '>';
WHEN South => RETURN 'v';
WHEN West => RETURN '<';
END CASE;
END Compass;
PROCEDURE DrawStatus IS
-- Pre: None
-- Post: Status Box appears on the screen
BEGIN
Screen.MoveCursor (Row => 2, Column => 1);
Ada.Text_IO.Put (" --- ");
Screen.MoveCursor (Row => 3, Column => 1);
Ada.Text_IO.Put ("| |");
Screen.MoveCursor (Row => 4, Column => 1);
Ada.Text_IO.Put ("| |");
Screen.MoveCursor (Row => 5, Column => 1);
Ada.Text_IO.Put (" --- ");
END DrawStatus;
PROCEDURE DrawRoom IS
-- Pre: None
-- Post: Room appears on the screen
BEGIN
Screen.ClearScreen;
Screen.MoveCursor (Row => 1, Column => 1);
-- Top Bar
Ada.Text_IO.Put (" ");
Ada.Text_IO.Put (" --------------------------------------- ");
Ada.Text_IO.New_Line;
FOR I in 1..20 LOOP
Ada.Text_IO.Put (" ");
Ada.Text_IO.Put ("|. . . . . . . . . . . . . . . . . . . .|");
Ada.Text_IO.New_Line;
END LOOP;
Ada.Text_IO.Put (" ");
Ada.Text_IO.Put (" --------------------------------------- ");
DrawStatus;
END DrawRoom;
PROCEDURE ChgColor (NewColor : ScreenColors) IS
-- Pre: NewColor is defined
-- Post: Ink is changed to NewColor and displayed in status box
BEGIN
Ink := NewColor;
Screen.MoveCursor ( Row => 4, Column => 3);
Ada.Text_IO.Put (ColorSymbols(Ink));
END ChgColor;
PROCEDURE ShowDirection IS
-- Pre: None
-- Post: Heading is displayed in the status box
BEGIN
Screen.MoveCursor(Row => 3,Column => 3);
Ada.Text_IO.Put (Compass(Heading));
END ShowDirection;
PROCEDURE ShowSpider IS
-- Pre: None
-- Post: The spider symbol appears in its current position
BEGIN
DrawSymbol (SpiderSym);
END ShowSpider;
-- These procedures are in the package specification
-- and implement the "official" spider commands
PROCEDURE Start IS
BEGIN
DrawRoom;
CurrentColumn := 10; -- these are in the spider's view
CurrentRow := 11;
Heading := North;
Green;
ShowSpider;
ShowDirection;
END Start;
PROCEDURE Blue IS
BEGIN
ChgColor (blue);
END Blue;
PROCEDURE Green IS
BEGIN
ChgColor (green);
END Green;
PROCEDURE Red IS
BEGIN
ChgColor (red);
END Red;
PROCEDURE Black IS
BEGIN
ChgColor (black);
END Black;
PROCEDURE Right IS
BEGIN
IF Heading = Directions'Last THEN
Heading := Directions'First;
ELSE
Heading := Directions'Succ (Heading);
END IF;
ShowDirection;
END Right;
PROCEDURE Face (WhichWay: IN Directions) IS
BEGIN
Heading := WhichWay;
ShowDirection;
END Face;
FUNCTION IsFacing RETURN Directions IS
BEGIN
RETURN Heading;
END IsFacing;
FUNCTION AtWall RETURN Boolean IS
BEGIN
-- Check for out of bounds (in the spider's view)
CASE Heading IS
WHEN North =>
RETURN CurrentRow <= Rows'First;
WHEN East =>
RETURN CurrentColumn >= Cols'Last;
WHEN South =>
RETURN CurrentRow >= Rows'Last;
WHEN West =>
RETURN CurrentColumn <= Cols'First;
END CASE;
END AtWall;
PROCEDURE Step IS
BEGIN
-- leave a track where spider is standing
DrawSymbol (ColorSymbols (Ink) );
-- If out of bounds raise exception.
IF AtWall THEN
Screen.Beep;
RAISE Hit_the_Wall;
END IF;
-- change the spider's location
CASE Heading IS
WHEN North =>
CurrentRow := CurrentRow - 1;
WHEN East =>
CurrentColumn := CurrentColumn + 1;
WHEN South =>
CurrentRow := CurrentRow + 1;
WHEN West =>
CurrentColumn := CurrentColumn - 1;
END CASE;
-- draw the spider in her new location
ShowSpider;
-- if debug mode, wait for user to press RETURN
IF Debugging = On THEN
Ada.Text_IO.Skip_Line;
ELSE
DELAY 0.5;
END IF;
END Step;
PROCEDURE Quit IS
-- Quit command.
BEGIN
Screen.MoveCursor(Row => 23,Column => 1);
END Quit;
PROCEDURE Debug (Setting: Switch) is
-- Toggle debugging mode
BEGIN
IF Setting = ON THEN
DebugFlag := true;
Screen.MoveCursor (Row => 10,Column => 1);
Ada.Text_IO.Put ("-- DEBUG ON -- ");
Ada.Text_IO.New_Line;
Ada.Text_IO.Put (" Press Enter");
ELSE
DebugFlag := false;
Screen.MoveCursor (Row => 10,Column => 1);
Ada.Text_IO.Put (" ");
Ada.Text_IO.New_Line;
Ada.Text_IO.Put (" ");
END IF;
END Debug;
FUNCTION Debugging RETURN Switch IS
BEGIN
IF DebugFlag THEN
RETURN On;
ELSE
RETURN Off;
END IF;
END Debugging;
END Spider;