--
-- 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_Object : access Occupant'Class) is
begin
if May_I_Drop(Direct_Object, Agent) then
Place(T => Direct_Object, Into => Container(Agent));
end if;
end Drop;
function May_I_Drop(Direct_Object : access Occupant;
Agent : access Occupant'Class)
return Boolean is
begin
return True;
end May_I_Drop;
procedure Inventory(Agent : access Occupant) is
begin
Put_Contents(Agent, Agent,
"You're carrying:",
"You aren't carrying anything.");
end Inventory;
procedure Go(Agent : access Occupant; Dir : in Direction) is
begin
if Container(Agent) = null then
Put_Line("Sorry, you're not in a room!");
else
declare
Destination : Thing_Access := What_Is(Container(Agent), Dir);
begin
if Destination = null then
Put_Line("Sorry, you can't go that way.");
else
Place(Agent, Destination);
end if;
end;
end if;
end Go;
end Occupants;
--
-- 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.
--
You may also see the corresponding specification.
You may also see the list of program units.
The following compilation units are referred to ("with"'ed) by Package body Occupants:
You may return to the Program Small Home Page.This hypertext format was generated by David A. Wheeler's ada2html