home *** CD-ROM | disk | FTP | other *** search
/ BURKS 2 / BURKS_AUG97.ISO / BURKS / LANGUAGE / ADA / LOVELACE / occupant.adb < prev    next >
Text File  |  1996-03-01  |  3KB  |  100 lines
  1. --
  2. -- Copyright (C) 1996 Ada Resource Association (ARA), Columbus, Ohio.
  3. -- Author: David A. Wheeler
  4. --
  5.  
  6. with Text_IO, Ada.Strings.Unbounded, Ustrings, Rooms;
  7. use  Text_IO, Ada.Strings.Unbounded, Ustrings, Rooms;
  8.  
  9. package body Occupants is
  10.  
  11.  
  12.  procedure Put_View(T : access Occupant; Agent : access Thing'Class) is
  13.  begin
  14.   Put("You are inside ");
  15.   Put_Line(Short_Description(T));
  16.   Put_Line(".");
  17.   Put_Contents(T, Agent, "You see:");
  18.  end Put_View;
  19.  
  20.  procedure Look(T : access Occupant) is
  21.  -- T is running a "look" command; tell T what he views.
  22.  begin
  23.   if Container(T) = null then
  24.     Put("You are inside nothing at all.");
  25.   else
  26.     Put_View(Container(T), T);
  27.   end if;
  28.  end Look;
  29.  
  30.  
  31.  procedure Get(Agent : access Occupant; Direct_Object : access Occupant'Class)
  32.  is
  33.  begin
  34.    if May_I_Get(Direct_Object, Agent) then
  35.      Place(T => Direct_Object, Into => Thing_Access(Agent));
  36.    end if;
  37.  end Get;
  38.  
  39.  function May_I_Get(Direct_Object : access Occupant;
  40.                     Agent : access Occupant'Class)
  41.           return Boolean is
  42.  begin
  43.    Sorry("get", Name(Direct_Object));  -- Tell the getter sorry, can't get it
  44.    return False;
  45.  end May_I_Get;
  46.  
  47.  procedure Drop(Agent : access Occupant;
  48.                 Direct_Object : access Occupant'Class) is
  49.  begin
  50.    if May_I_Drop(Direct_Object, Agent) then
  51.      Place(T => Direct_Object, Into => Container(Agent));
  52.    end if;
  53.  end Drop;
  54.  
  55.  function  May_I_Drop(Direct_Object : access Occupant;
  56.                       Agent : access Occupant'Class)
  57.            return Boolean is
  58.  begin
  59.    return True;
  60.  end May_I_Drop;
  61.  
  62.  
  63.  procedure Inventory(Agent : access Occupant) is
  64.  begin
  65.   Put_Contents(Agent, Agent,
  66.                "You're carrying:",
  67.                "You aren't carrying anything.");
  68.  end Inventory;
  69.  
  70.  procedure Go(Agent : access Occupant; Dir : in Direction) is
  71.  begin
  72.   if Container(Agent) = null then
  73.     Put_Line("Sorry, you're not in a room!");
  74.   else
  75.     declare
  76.       Destination : Thing_Access := What_Is(Container(Agent), Dir);
  77.     begin
  78.      if Destination = null then
  79.        Put_Line("Sorry, you can't go that way.");
  80.      else
  81.        Place(Agent, Destination);
  82.      end if;
  83.     end;
  84.   end if;
  85.  end Go;
  86.  
  87. end Occupants;
  88.  
  89. --
  90. -- Permission to use, copy, modify, and distribute this software and its
  91. -- documentation for any purpose and without fee is hereby granted,
  92. -- provided that the above copyright and authorship notice appear in all
  93. -- copies and that both that copyright notice and this permission notice
  94. -- appear in supporting documentation.
  95. -- 
  96. -- The ARA makes no representations about the suitability of this software
  97. -- for any purpose.  It is provided "as is" without express
  98. -- or implied warranty.
  99. -- 
  100.