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