home *** CD-ROM | disk | FTP | other *** search
/ BURKS 2 / BURKS_AUG97.ISO / BURKS / LANGUAGE / ADA / LOVELACE / things.ads < prev    next >
Text File  |  1996-03-01  |  4KB  |  107 lines
  1. --
  2. -- Copyright (C) 1996 Ada Resource Association (ARA), Columbus, Ohio.
  3. -- Author: David A. Wheeler
  4. --
  5.  
  6. with Ada.Strings.Unbounded, Ada.Finalization, Directions;
  7. use  Ada.Strings.Unbounded, Ada.Finalization, Directions;
  8.  
  9. package Things is
  10.  
  11.  -- "Thing" is the root class for all things in this small world.
  12.  -- Rooms, Players, Items, and Monsters are derived from Thing.
  13.  
  14.  
  15.  type Thing is abstract new Limited_Controlled with private;
  16.  type Thing_Access is access all Thing'Class;
  17.  
  18.  type Article_Type is (A, An, The, Some, None);
  19.  
  20.  -- Public Dispatching operations.
  21.  
  22.  procedure Put_View(T : access Thing; Agent : access Thing'Class) is abstract;
  23.   -- Put what Agents sees inside T.
  24.  
  25.  function What_Is(From : access Thing; Dir : in Direction) return Thing_Access;
  26.  -- Returns what is at direction "Dir" from "From".
  27.  -- Returns null if nothing connected in that direction.
  28.  
  29.  -- Public non-Dispatching operations:
  30.  
  31.  procedure Set_Name(T : access Thing'Class; Article : in Article_Type;
  32.                     Name : in Unbounded_String);
  33.  procedure Set_Name(T : access Thing'Class; Article : in Article_Type;
  34.                     Name : in String);
  35.  function Name(T : access Thing'Class) return Unbounded_String;
  36.  pragma Inline(Name);
  37.  
  38.  function Short_Description(T : access Thing'Class) return Unbounded_String;
  39.  -- Returns Article + Name, i.e. "the box", "a car", "some horses".
  40.  
  41.  procedure Set_Description(T : access Thing'Class;
  42.                            Description : in Unbounded_String);
  43.  procedure Set_Description(T : access Thing'Class;
  44.                            Description : in String);
  45.  function Long_Description(T : access Thing'Class) return Unbounded_String;
  46.  
  47.  procedure Place(T : access Thing'Class; Into : Thing_Access);
  48.    -- Place T inside "Into" (removing it from wherever it was).
  49.    -- Attempting to place T into itself will print an error message
  50.    -- and fail.
  51.    -- The second parameter is Thing_Access, not Thing'Class, because
  52.    -- "null" is a valid value for "Into".
  53.  function Container(T : access Thing'Class) return Thing_Access;
  54.    -- Return access value to the container of T.
  55.  function Has_Contents(T : access Thing'Class) return Boolean;
  56.    -- Does T have anything in it?
  57.  
  58.  function Find(Agent : access Thing'Class;
  59.                Object_Name : in Unbounded_String) return Thing_Access;
  60.           -- Find the given Object_Name in the same container as the agent.
  61.           -- Prints and error message and returns null if not found.
  62.  
  63.  function Find_Inside(Agent       : access Thing'Class;
  64.                       Object_Name : in Unbounded_String)
  65.           return Thing_Access;
  66.           -- Find the given Object_Name inside the agent.
  67.           -- Prints and error message and returns null if not found.
  68.  
  69.  procedure Put_Contents(T : access Thing'Class;
  70.                         Ignore : access Thing'Class;
  71.                         Heading_With_Contents : in String;
  72.                         Heading_Without_Contents : in String := "");
  73.    -- Put a description of the contents of T.
  74.    -- Act as though "Ignore" isn't there.
  75.    -- If there is something, print Heading_With_Contents;
  76.    -- If there isn't something, print Heading_Without_Contents.
  77.  
  78.  procedure Sorry(Prohibited_Operation : String;
  79.                  Prohibited_Direct_Object : Unbounded_String);
  80.    -- Put "Sorry, you may not XXX the YYY".
  81.  
  82.  
  83. private
  84.  
  85.  type Thing is abstract new Limited_Controlled with
  86.   record
  87.    Name, Description : Unbounded_String;
  88.    Article           : Article_Type := A;
  89.    Container         : Thing_Access; -- what Thing contains me?
  90.    Next_Sibling      : Thing_Access; -- next Thing in my container.
  91.    First_Containee   : Thing_Access; -- first Thing inside me.
  92.   end record;
  93.  
  94. end Things;
  95.  
  96. --
  97. -- Permission to use, copy, modify, and distribute this software and its
  98. -- documentation for any purpose and without fee is hereby granted,
  99. -- provided that the above copyright and authorship notice appear in all
  100. -- copies and that both that copyright notice and this permission notice
  101. -- appear in supporting documentation.
  102. -- 
  103. -- The ARA makes no representations about the suitability of this software
  104. -- for any purpose.  It is provided "as is" without express
  105. -- or implied warranty.
  106. -- 
  107.