1. private with Allegro.Digital_Samples; 
  2. private with Almp3; 
  3. private with Resources; 
  4.  
  5. private package Audio_Players.Cache is 
  6.  
  7.     type Sound is abstract new Limited_Object with private; 
  8.     type A_Sound is access all Sound'Class; 
  9.  
  10.     function Is_Done( this : not null access Sound'Class ) return Boolean; 
  11.  
  12.     procedure Play( this : access Sound; looping : Boolean ) is abstract; 
  13.  
  14.     procedure Poll( this : access Sound ) is abstract; 
  15.  
  16.     procedure Stop( this : access Sound ) is abstract; 
  17.  
  18.     -- Loads a sound from the cache. An exception is raised on error. 
  19.     function Load_Sound( filename : String ) return A_Sound; 
  20.     pragma Precondition( filename'Length > 0 ); 
  21.     pragma Postcondition( Load_Sound'Result /= null ); 
  22.  
  23.     -- Unloads a sound when it is no longer being played. 
  24.     procedure Unload_Sound( snd : in out A_Sound ); 
  25.  
  26. private 
  27.  
  28.     use Allegro.Digital_Samples; 
  29.     use Almp3; 
  30.     use Resources; 
  31.  
  32.     type Audio_Resource is abstract new Limited_Object with 
  33.         record 
  34.             refs     : Natural := 0;  -- number of Sound objects referencing this 
  35.             resource : A_Resource_File := null; 
  36.         end record; 
  37.     type A_Audio_Resource is access all Audio_Resource'Class; 
  38.  
  39.     -- Creates an appropriate concrete audio resource from a file. An exception 
  40.     -- will be raised on error. 
  41.     function Create_Audio_Resource( filename : String ) return A_Audio_Resource; 
  42.     pragma Precondition( filename'Length > 0 ); 
  43.     pragma Postcondition( Create_Audio_Resource'Result /= null ); 
  44.  
  45.     procedure Construct( this : access Audio_Resource; filename : String ); 
  46.  
  47.     -- Creates and returns a new instance of the sound. The instance counts as 
  48.     -- a reference to the cached sound so it must be deleted later. An exception 
  49.     -- is raised on error. This procedure must be overridden. 
  50.     function Create_Sound( this : access Audio_Resource ) return A_Sound; 
  51.     pragma Postcondition( Create_Sound'Result = null ); 
  52.  
  53.     procedure Dec_Refs( this : not null access Audio_Resource'Class ); 
  54.  
  55.     procedure Delete( this : in out Audio_Resource ); 
  56.  
  57.     function Get_Resource_File( this : not null access Audio_Resource'Class ) return A_Resource_File; 
  58.  
  59.     procedure Inc_Refs( this : not null access Audio_Resource'Class ); 
  60.  
  61.     function Ref_Count( this : not null access Audio_Resource'Class ) return Natural; 
  62.  
  63.     procedure Delete( this : in out A_Audio_Resource ); 
  64.  
  65.     ---------------------------------------------------------------------------- 
  66.  
  67.     type Mp3_Resource is new Audio_Resource with null record; 
  68.     type A_Mp3_Resource is access all Mp3_Resource'Class; 
  69.  
  70.     -- Returns null on error (file not found). 
  71.     function Create_Mp3_Resource( filename : String ) return A_Audio_Resource; 
  72.     pragma Precondition( filename'Length > 0 ); 
  73.  
  74.     -- Raises an exception on error. 
  75.     function Create_Sound( this : access Mp3_Resource ) return A_Sound; 
  76.     pragma Postcondition( Create_Sound'Result /= null ); 
  77.  
  78.     ---------------------------------------------------------------------------- 
  79.  
  80.     type Sample_Resource is new Audio_Resource with 
  81.         record 
  82.             sample : A_Sample := null; 
  83.         end record; 
  84.     type A_Sample_Resource is access all Sample_Resource'Class; 
  85.  
  86.     function Create_Sample_Resource( filename : String ) return A_Audio_Resource; 
  87.  
  88.     -- Raises an exception on error. 
  89.     procedure Construct( this : access Sample_Resource; filename : String ); 
  90.  
  91.     -- Raises an exception on error. 
  92.     function Create_Sound( this : access Sample_Resource ) return A_Sound; 
  93.     pragma Postcondition( Create_Sound'Result /= null ); 
  94.  
  95.     procedure Delete( this : in out Sample_Resource ); 
  96.  
  97.     function Get_Sample( this : not null access Sample_Resource'Class ) return A_Sample; 
  98.     pragma Postcondition( Get_Sample'Result /= null ); 
  99.  
  100.     --========================================================================== 
  101.  
  102.     type Sound is abstract new Limited_Object with 
  103.         record 
  104.             resource : A_Audio_Resource := null; 
  105.             done     : Boolean := False; 
  106.         end record; 
  107.  
  108.     procedure Construct( this : access Sound; resource : not null A_Audio_Resource ); 
  109.  
  110.     function Get_Filename( this : not null access Sound'Class ) return String; 
  111.     pragma Postcondition( Get_Filename'Result'Length > 0 ); 
  112.  
  113.     procedure Delete( this : in out A_Sound ); 
  114.     pragma Postcondition( this = null ); 
  115.  
  116.     ---------------------------------------------------------------------------- 
  117.  
  118.     type Mp3_Sound is new Sound with 
  119.         record 
  120.             mp3 : A_mp3 := null; 
  121.         end record; 
  122.     type A_Mp3_Sound is access all Mp3_Sound'Class; 
  123.  
  124.     -- Raises an exception on error. 
  125.     function Create_Mp3_Sound( resource : not null A_Mp3_Resource ) return A_Sound; 
  126.     pragma Postcondition( Create_Mp3_Sound'Result /= null ); 
  127.  
  128.     -- Raises an exception on error. 
  129.     procedure Construct( this : access Mp3_Sound; resource : not null A_Mp3_Resource ); 
  130.  
  131.     procedure Delete( this : in out Mp3_Sound ); 
  132.  
  133.     procedure Play( this : access Mp3_Sound; looping : Boolean ); 
  134.  
  135.     procedure Poll( this : access Mp3_Sound ); 
  136.  
  137.     procedure Stop( this : access Mp3_Sound ); 
  138.  
  139.     ---------------------------------------------------------------------------- 
  140.  
  141.     type Sample_Sound is new Sound with 
  142.         record 
  143.             voice : Integer := -1; 
  144.         end record; 
  145.     type A_Sample_Sound is access all Sample_Sound'Class; 
  146.  
  147.     -- Never raises an exception. 
  148.     function Create_Sample_Sound( resource : not null A_Sample_Resource ) return A_Sound; 
  149.     pragma Postcondition( Create_Sample_Sound'Result /= null ); 
  150.  
  151.     procedure Play( this : access Sample_Sound; looping : Boolean ); 
  152.  
  153.     procedure Poll( this : access Sample_Sound ); 
  154.  
  155.     procedure Stop( this : access Sample_Sound ); 
  156.  
  157. end Audio_Players.Cache;