1. -- 
  2. -- Copyright (c) 2012 Kevin Wellwood 
  3. -- All rights reserved. 
  4. -- 
  5. -- This source code is distributed under the Modified BSD License. For terms and 
  6. -- conditions, see license.txt. 
  7. -- 
  8.  
  9. with Allegro.Bitmaps;                   use Allegro.Bitmaps; 
  10.  
  11. package Entities.Items is 
  12.  
  13.     -- An Item is an animated Entity, unaffected by gravity, that gives the 
  14.     -- player a bonus when he touches it. It automatically destroys itself on 
  15.     -- collision so the bonus is only given once. 
  16.     type Item is abstract new Entity with private; 
  17.     type A_Item is access all Item'Class; 
  18.  
  19.     -- Returns a reference to a bitmap icon that represents the item. This can 
  20.     -- used for displaying a visual representation of the item, in a palette, 
  21.     -- for instance. The reference returned is owned by the item. Do not modify 
  22.     -- it. 
  23.     function Get_Icon( this : access Item ) return A_Allegro_Bitmap; 
  24.  
  25.     -- Gives the item's bonus to the player. Each item class gives a different 
  26.     -- bonus. This is called when the Player entity collides with the Item. 
  27.     procedure Give_Item( this : access Item ) is abstract; 
  28.  
  29.     -- A class pattern that matches all item class ids registered in the entity 
  30.     -- factory. 
  31.     CLASS_PATTERN : constant String := "Entities.Items.*"; 
  32.  
  33. private 
  34.  
  35.     type Item is abstract new Entity with 
  36.         record 
  37.             frameDelay : Time_Span := Time_Span_Zero; 
  38.             firstFrame : Natural := 0; 
  39.             maxFrames  : Positive := 1; 
  40.         end record; 
  41.  
  42.     -- Constructs the Item. Constructors of subclasses should call this first. 
  43.     -- Raises an exception on error. 
  44.     procedure Construct( this       : access Item; 
  45.                          width, 
  46.                          height     : Natural; 
  47.                          libName    : String; 
  48.                          firstFrame : String; 
  49.                          maxFrames  : Positive; 
  50.                          frameDelay : Time_Span ); 
  51.  
  52.     -- Implements the entity On_Collide behavior to call Give_Item if the 
  53.     -- colliding entity is a player. An overriding implemetation should call 
  54.     -- this first. 
  55.     procedure On_Collide( this : access Item; e : not null A_Entity ); 
  56.  
  57.     -- Executes one time frame of logic for the Item to keep the frame up to 
  58.     -- date. An overriding implementation must call this first. 
  59.     procedure Update( this : access Item; time : Tick_Time ); 
  60.  
  61.     procedure Object_Read( stream : access Root_Stream_Type'Class; obj : out Item ); 
  62.     for Item'Read use Object_Read; 
  63.  
  64.     procedure Object_Write( stream : access Root_Stream_Type'Class; obj : Item ); 
  65.     for Item'Write use Object_Write; 
  66.  
  67. end Entities.Items;