package Map_Sites.Rooms is pragma Elaborate_Body; type Room (<>) is limited new Map_Site with private; not overriding function New_Room (Number : Natural) return not null access Room; overriding procedure Enter (Site : in out Room); not overriding function Get_Side (Site : Room; Direction : Direction_Type) return access Map_Site'Class; not overriding procedure Set_Side (Site : in out Room; Direction : Direction_Type; Side : access Map_Site'Class); function Find_Room (Number : Natural) return access Room; private type Sides_Type is array (Direction_Type) of access Map_Site'Class; type Room (Number : Natural) is limited new Map_Site with record Sides : Sides_Type; end record; end Map_Sites.Rooms; package Map_Sites is pragma Pure; type Map_Site is abstract tagged limited null record; type Direction_Type is (North, South, East, West); procedure Enter (Site : in out Map_Site) is abstract; end Map_Sites; private with Ada.Containers.Hashed_Sets; pragma Elaborate_All (Ada.Containers.Hashed_Sets); package body Map_Sites.Rooms is use Ada.Containers; -- Hash_Type type Room_Access is not null access Room; function Hash (R : Room_Access) return Hash_Type; package Room_Sets is new Ada.Containers.Hashed_Sets (Element_Type => Room_Access, Hash => Hash, Equivalent_Elements => "="); function Room_Number_Hash (N : Natural) return Hash_Type is begin return Hash_Type (N); end; function Hash (R : Room_Access) return Hash_Type is begin return Room_Number_Hash (R.Number); end; function Get_Room_Number (R : Room_Access) return Natural is begin return R.Number; end; package Room_Number_Keys is new Room_Sets.Generic_Keys (Key_Type => Natural, Key => Get_Room_Number, Hash => Room_Number_Hash, Equivalent_Keys => "="); Room_Set : Room_Sets.Set; use Room_Sets; function New_Room (Number : Natural) return not null access Room is R : constant Room_Access := new Room (Number); begin Room_Set.Insert (R); return R; end New_Room; procedure Enter (Site : in out Room) is begin null; end Enter; function Get_Side (Site : Room; Direction : Direction_Type) return access Map_Site'Class is begin return Site.Sides (Direction); end Get_Side; procedure Set_Side (Site : in out Room; Direction : Direction_Type; Side : access Map_Site'Class) is begin Site.Sides (Direction) := Side; end Set_Side; function Find_Room (Number : Natural) return access Room is C : constant Room_Sets.Cursor := Room_Number_Keys.Find (Room_Set, Number); begin if Has_Element (C) then return Element (C); else return null; end if; end Find_Room; end Map_Sites.Rooms;