1. private with Allegro.Digital_Samples; 
  2. private with Almp3; 
  3. private with Resources; 
  4.  
  5. private package Audio_Players.Cache is 
  6.  
  7.     -- Represents a sound effect/music loaded from a file that can be played 
  8.     -- once or in a loop. This is a specific instance of a played sound that 
  9.     -- can be started and stopped. It is backed by an audio resource that 
  10.     -- contains the audio data. 
  11.     type Sound is abstract new Limited_Object with private; 
  12.     type A_Sound is access all Sound'Class; 
  13.  
  14.     -- Returns True if the sound finished playing or it has been stopped. 
  15.     function Is_Done( this : not null access Sound'Class ) return Boolean; 
  16.  
  17.     -- Starts playing the sound. If 'looping' is True, the sound will 
  18.     -- automatically loop when it finishes and will repeat until explicitly 
  19.     -- stopped. 
  20.     procedure Play( this : access Sound; looping : Boolean ) is abstract; 
  21.  
  22.     -- Polls the Sound object to maintain the stream of audio it must send to 
  23.     -- the audio hardware. This should be called approximately every 100ms. 
  24.     procedure Poll( this : access Sound ) is abstract; 
  25.  
  26.     -- Stops playing the sound if it is playing. 
  27.     procedure Stop( this : access Sound ) is abstract; 
  28.  
  29.     ---------------------------------------------------------------------------- 
  30.  
  31.     -- Loads a sound to be played. Sound objects are backed by cached 
  32.     -- Audio_Resource data so they can be played instantly without waiting to 
  33.     -- load or decode anything. An exception is raised on error. 
  34.     function Load_Sound( filename : String ) return A_Sound; 
  35.     pragma Precondition( filename'Length > 0 ); 
  36.     pragma Postcondition( Load_Sound'Result /= null ); 
  37.  
  38.     -- Discards a sound instance when it is no longer being played. It's 
  39.     -- Audio_Resource's reference count will decrease. 
  40.     procedure Unload_Sound( snd : in out A_Sound ); 
  41.  
  42. private 
  43.  
  44.     use Allegro.Digital_Samples; 
  45.     use Almp3; 
  46.     use Resources; 
  47.  
  48.     -- An Audio_Resources is a reference counted object that encapsulates the 
  49.     -- processed audio data necessary to play a sound. All Audio_Resources are 
  50.     -- cached in a thread-safe protected object. 
  51.     type Audio_Resource is abstract new Limited_Object with 
  52.         record 
  53.             refs     : Natural := 0;  -- number of Sound objects referencing this 
  54.             resource : A_Resource_File := null; 
  55.         end record; 
  56.     type A_Audio_Resource is access all Audio_Resource'Class; 
  57.  
  58.     -- Creates an appropriate concrete audio resource from a file. An exception 
  59.     -- will be raised on error. 
  60.     function Create_Audio_Resource( filename : String ) return A_Audio_Resource; 
  61.     pragma Precondition( filename'Length > 0 ); 
  62.     pragma Postcondition( Create_Audio_Resource'Result /= null ); 
  63.  
  64.     -- Loads a Resource_File from 'filename'. The subclass's constructor should 
  65.     -- process the data as necessary. This should be called first by a subclass 
  66.     -- constructor. 
  67.     procedure Construct( this : access Audio_Resource; filename : String ); 
  68.  
  69.     -- Creates and returns a new instance of the sound backed by this audio 
  70.     -- resource. The instance counts as a reference this so it must be deleted 
  71.     -- before the resource. An exception is raised on error. This base procedure 
  72.     -- does nothing and must be overridden by each subclass of Audio_Resource. 
  73.     function Create_Sound( this : access Audio_Resource ) return A_Sound; 
  74.     pragma Postcondition( Create_Sound'Result = null ); 
  75.  
  76.     -- Decrements the Audio_Resource's reference count. 
  77.     procedure Dec_Refs( this : not null access Audio_Resource'Class ); 
  78.  
  79.     procedure Delete( this : in out Audio_Resource ); 
  80.  
  81.     -- Returns a reference to the Audio_Resource's Reference_File. Do not modify it. 
  82.     function Get_Resource_File( this : not null access Audio_Resource'Class ) return A_Resource_File; 
  83.  
  84.     -- Increments the Audio_Resource's reference count. 
  85.     procedure Inc_Refs( this : not null access Audio_Resource'Class ); 
  86.  
  87.     -- Returns the Audio_Resource's reference count. 
  88.     function Ref_Count( this : not null access Audio_Resource'Class ) return Natural; 
  89.  
  90.     -- Destroys the Audio_Resource. This should only be called when the 
  91.     -- reference count reaches zero. 
  92.     procedure Delete( this : in out A_Audio_Resource ); 
  93.  
  94.     ---------------------------------------------------------------------------- 
  95.  
  96.     -- Represents an MP3 audio file. 
  97.     type Mp3_Resource is new Audio_Resource with null record; 
  98.     type A_Mp3_Resource is access all Mp3_Resource'Class; 
  99.  
  100.     -- Returns null on error (file not found). 
  101.     function Create_Mp3_Resource( filename : String ) return A_Audio_Resource; 
  102.     pragma Precondition( filename'Length > 0 ); 
  103.  
  104.     -- Raises an exception on error. 
  105.     function Create_Sound( this : access Mp3_Resource ) return A_Sound; 
  106.     pragma Postcondition( Create_Sound'Result /= null ); 
  107.  
  108.     ---------------------------------------------------------------------------- 
  109.  
  110.     -- Represents an Allegro sample file (.wav or .voc) 
  111.     type Sample_Resource is new Audio_Resource with 
  112.         record 
  113.             sample : A_Sample := null; 
  114.         end record; 
  115.     type A_Sample_Resource is access all Sample_Resource'Class; 
  116.  
  117.     -- Creates a Sample_Resource given an audio file supported by Allegro 4.4. 
  118.     -- Returns null on error. 
  119.     function Create_Sample_Resource( filename : String ) return A_Audio_Resource; 
  120.  
  121.     -- Raises an exception on error. 
  122.     procedure Construct( this : access Sample_Resource; filename : String ); 
  123.  
  124.     -- Raises an exception on error. 
  125.     function Create_Sound( this : access Sample_Resource ) return A_Sound; 
  126.     pragma Postcondition( Create_Sound'Result /= null ); 
  127.  
  128.     procedure Delete( this : in out Sample_Resource ); 
  129.  
  130.     -- Returns a reference to the Sample_Resource's Allegro Sample structure. Do 
  131.     -- not modify it. 
  132.     function Get_Sample( this : not null access Sample_Resource'Class ) return A_Sample; 
  133.     pragma Postcondition( Get_Sample'Result /= null ); 
  134.  
  135.     --========================================================================== 
  136.  
  137.     type Sound is abstract new Limited_Object with 
  138.         record 
  139.             resource : A_Audio_Resource := null; 
  140.             done     : Boolean := False; 
  141.         end record; 
  142.  
  143.     -- 'resource' is the audio data backing this sound. This constructor should 
  144.     -- be called first by an Audio_Resource subclass constructor. 
  145.     procedure Construct( this : access Sound; resource : not null A_Audio_Resource ); 
  146.  
  147.     -- Returns the name of the file that the Sound was loaded from. 
  148.     function Get_Filename( this : not null access Sound'Class ) return String; 
  149.     pragma Postcondition( Get_Filename'Result'Length > 0 ); 
  150.  
  151.     procedure Delete( this : in out A_Sound ); 
  152.     pragma Postcondition( this = null ); 
  153.  
  154.     ---------------------------------------------------------------------------- 
  155.  
  156.     type Mp3_Sound is new Sound with 
  157.         record 
  158.             mp3 : A_mp3 := null; 
  159.         end record; 
  160.     type A_Mp3_Sound is access all Mp3_Sound'Class; 
  161.  
  162.     -- Raises an exception on error (ie: bad file format) 
  163.     function Create_Mp3_Sound( resource : not null A_Mp3_Resource ) return A_Sound; 
  164.     pragma Postcondition( Create_Mp3_Sound'Result /= null ); 
  165.  
  166.     -- Raises an exception on error. 
  167.     procedure Construct( this : access Mp3_Sound; resource : not null A_Mp3_Resource ); 
  168.  
  169.     procedure Delete( this : in out Mp3_Sound ); 
  170.  
  171.     procedure Play( this : access Mp3_Sound; looping : Boolean ); 
  172.  
  173.     procedure Poll( this : access Mp3_Sound ); 
  174.  
  175.     procedure Stop( this : access Mp3_Sound ); 
  176.  
  177.     ---------------------------------------------------------------------------- 
  178.  
  179.     type Sample_Sound is new Sound with 
  180.         record 
  181.             voice : Integer := -1; 
  182.         end record; 
  183.     type A_Sample_Sound is access all Sample_Sound'Class; 
  184.  
  185.     -- Never raises an exception because nothing can go wrong at this point. 
  186.     function Create_Sample_Sound( resource : not null A_Sample_Resource ) return A_Sound; 
  187.     pragma Postcondition( Create_Sample_Sound'Result /= null ); 
  188.  
  189.     procedure Play( this : access Sample_Sound; looping : Boolean ); 
  190.  
  191.     procedure Poll( this : access Sample_Sound ); 
  192.  
  193.     procedure Stop( this : access Sample_Sound ); 
  194.  
  195. end Audio_Players.Cache;