home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BURKS 2
/
BURKS_AUG97.ISO
/
BURKS
/
LANGUAGE
/
ADA
/
LOVELACE
/
small.txt
< prev
next >
Wrap
Text File
|
1997-04-10
|
42KB
|
1,312 lines
--
-- Copyright (C) 1996 Ada Resource Association (ARA), Columbus, Ohio.
-- Author: David A. Wheeler
--
with Occupants;
use Occupants;
package Creatures is
type Creature is abstract new Occupant with private;
type Creature_Access is access Creature'Class;
private
type Creature is abstract new Occupant with null record;
end Creatures;
--
-- Permission to use, copy, modify, and distribute this software and its
-- documentation for any purpose and without fee is hereby granted,
-- provided that the above copyright and authorship notice appear in all
-- copies and that both that copyright notice and this permission notice
-- appear in supporting documentation.
--
-- The ARA makes no representations about the suitability of this software
-- for any purpose. It is provided "as is" without express
-- or implied warranty.
--
--
-- Copyright (C) 1996 Ada Resource Association (ARA), Columbus, Ohio.
-- Author: David A. Wheeler
--
with Ada.Characters.Handling;
use Ada.Characters.Handling;
package body Directions is
Abbreviations : constant String := "nsewud";
procedure To_Direction(Text : in Unbounded_String;
Is_Direction : out Boolean;
Dir : out Direction) is
Lower_Text : String := To_Lower(To_String(Text));
-- Attempt to turn "Text" into a direction.
-- If successful, set "Is_Direction" True and "Dir" to the value.
-- If not successful, set "Is_Direction" False and "Dir" to arbitrary value.
begin
if Length(Text) = 1 then
-- Check if it's a one-letter abbreviation.
for D in Direction'Range loop
if Lower_Text(1) = Abbreviations(Direction'Pos(D) + 1) then
Is_Direction := True;
Dir := D;
return;
end if;
end loop;
Is_Direction := False;
Dir := North;
return;
else
-- Not a one-letter abbreviation, try a full name.
for D in Direction'Range loop
if Lower_Text = To_Lower(Direction'Image(D)) then
Is_Direction := True;
Dir := D;
return;
end if;
end loop;
Is_Direction := False;
Dir := North;
return;
end if;
end To_Direction;
function To_Direction(Text : in Unbounded_String) return Direction is
Is_Direction : Boolean;
Dir : Direction;
begin
To_Direction(Text, Is_Direction, Dir);
if Is_Direction then
return Dir;
else
raise Constraint_Error;
end if;
end To_Direction;
function Is_Direction(Text : in Unbounded_String) return Boolean is
Is_Direction : Boolean;
Dir : Direction;
begin
To_Direction(Text, Is_Direction, Dir);
return Is_Direction;
end Is_Direction;
end Directions;
--
-- Permission to use, copy, modify, and distribute this software and its
-- documentation for any purpose and without fee is hereby granted,
-- provided that the above copyright and authorship notice appear in all
-- copies and that both that copyright notice and this permission notice
-- appear in supporting documentation.
--
-- The ARA makes no representations about the suitability of this software
-- for any purpose. It is provided "as is" without express
-- or implied warranty.
--
--
-- Copyright (C) 1996 Ada Resource Association (ARA), Columbus, Ohio.
-- Author: David A. Wheeler
--
with Ada.Strings.Unbounded;
use Ada.Strings.Unbounded;
package Directions is
type Direction is (North, South, East, West, Up, Down);
Reverse_Direction : constant array(Direction) of Direction :=
(North => South, South => North,
East =>West, West => East,
Up => Down, Down => Up);
function To_Direction(Text : Unbounded_String) return Direction;
-- Converts Text to Direction; raises Constraint_Error if it's not
-- a legal direction.
function Is_Direction(Text : Unbounded_String) return Boolean;
-- Returns TRUE if Text is a direction, else false.
end Directions;
--
-- Permission to use, copy, modify, and distribute this software and its
-- documentation for any purpose and without fee is hereby granted,
-- provided that the above copyright and authorship notice appear in all
-- copies and that both that copyright notice and this permission notice
-- appear in supporting documentation.
--
-- The ARA makes no representations about the suitability of this software
-- for any purpose. It is provided "as is" without express
-- or implied warranty.
--
--
-- Copyright (C) 1996 Ada Resource Association (ARA), Columbus, Ohio.
-- Author: David A. Wheeler
--
package body Items is
function May_I_Get(Direct_Object : access Item;
Agent : access Occupant'Class) return Boolean is
begin
return True;
end May_I_Get;
end Items;
--
-- Permission to use, copy, modify, and distribute this software and its
-- documentation for any purpose and without fee is hereby granted,
-- provided that the above copyright and authorship notice appear in all
-- copies and that both that copyright notice and this permission notice
-- appear in supporting documentation.
--
-- The ARA makes no representations about the suitability of this software
-- for any purpose. It is provided "as is" without express
-- or implied warranty.
--
--
-- Copyright (C) 1996 Ada Resource Association (ARA), Columbus, Ohio.
-- Author: David A. Wheeler
--
with Occupants;
use Occupants;
package Items is
type Item is new Occupant with private;
type Item_Access is access Item'Class;
function May_I_Get(Direct_Object : access Item;
Agent : access Occupant'Class) return Boolean;
private
type Item is new Occupant with null record;
end Items;
--
-- Permission to use, copy, modify, and distribute this software and its
-- documentation for any purpose and without fee is hereby granted,
-- provided that the above copyright and authorship notice appear in all
-- copies and that both that copyright notice and this permission notice
-- appear in supporting documentation.
--
-- The ARA makes no representations about the suitability of this software
-- for any purpose. It is provided "as is" without express
-- or implied warranty.
--
--
-- Copyright (C) 1996 Ada Resource Association (ARA), Columbus, Ohio.
-- Author: David A. Wheeler
--
with Creatures;
use Creatures;
package Monsters is
type Monster is new Creature with private;
type Monster_Access is access Monster'Class;
private
type Monster is new Creature with null record;
end Monsters;
--
-- Permission to use, copy, modify, and distribute this software and its
-- documentation for any purpose and without fee is hereby granted,
-- provided that the above copyright and authorship notice appear in all
-- copies and that both that copyright notice and this permission notice
-- appear in supporting documentation.
--
-- The ARA makes no representations about the suitability of this software
-- for any purpose. It is provided "as is" without express
-- or implied warranty.
--
--
-- Copyright (C) 1996 Ada Resource Association (ARA), Columbus, Ohio.
-- Author: David A. Wheeler
--
with Text_IO, Ada.Strings.Unbounded, Ustrings, Rooms;
use Text_IO, Ada.Strings.Unbounded, Ustrings, Rooms;
package body Occupants is
procedure Put_View(T : access Occupant; Agent : access Thing'Class) is
begin
Put("You are inside ");
Put_Line(Short_Description(T));
Put_Line(".");
Put_Contents(T, Agent, "You see:");
end Put_View;
procedure Look(T : access Occupant) is
-- T is running a "look" command; tell T what he views.
begin
if Container(T) = null then
Put("You are inside nothing at all.");
else
Put_View(Container(T), T);
end if;
end Look;
procedure Get(Agent : access Occupant; Direct_Object : access Occupant'Class)
is
begin
if May_I_Get(Direct_Object, Agent) then
Place(T => Direct_Object, Into => Thing_Access(Agent));
end if;
end Get;
function May_I_Get(Direct_Object : access Occupant;
Agent : access Occupant'Class)
return Boolean is
begin
Sorry("get", Name(Direct_Object)); -- Tell the getter sorry, can't get it
return False;
end May_I_Get;
procedure Drop(Agent : access Occupant;
Direct_