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.File_IO;                   use Allegro.File_IO; 
  10. with Interfaces;                        use Interfaces; 
  11. with Streams.Buffers;                   use Streams.Buffers; 
  12. with System;                            use System; 
  13.  
  14. private with Ada.Strings.Unbounded; 
  15. private with Ada.Real_Time; 
  16. private with Streams; 
  17.  
  18. package Resources is 
  19.  
  20.     -- A Resource_File represents a resource file loaded in memory. The contents 
  21.     -- of the file can be accessed via various methods. Once a Resource_File is 
  22.     -- closed, its backing data should no longer be relied upon. If the file 
  23.     -- data is required after the Resource_File must be closed, a copy of the 
  24.     -- contents should be made. 
  25.     -- 
  26.     -- Resource files are cached to avoid the cost of searching and reading from 
  27.     -- disk each time file is needed but the details of the cache and how/when 
  28.     -- it is purged are private. 
  29.     type Resource_File is tagged limited private; 
  30.     type A_Resource_File is access all Resource_File'Class; 
  31.  
  32.     -- Returns the address of the resource file's data. The length of the data 
  33.     -- can be determined by calling Size. 
  34.     function Get_Address( this : not null access Resource_File'Class ) return Address; 
  35.  
  36.     -- Returns the filename of the resource. 
  37.     function Get_Filename( this : not null access Resource_File'Class ) return String; 
  38.  
  39.     -- Returns an identifying string comprised of the original filepath and 
  40.     -- group name used to find the resource. Useful for debugging purposes but 
  41.     -- not absolute identification. 
  42.     function Get_Id( this : not null access Resource_File'Class ) return String; 
  43.  
  44.     -- Returns a new Allegro_File reference to the resource. Be sure to close 
  45.     -- the returned handle before unloading the resource. 
  46.     function Get_File( this : not null access Resource_File'Class ) return A_Allegro_File; 
  47.  
  48.     -- Returns a new read-only stream backed by the resource contents. Be sure 
  49.     -- to close the stream before unloading the resource. 
  50.     procedure Get_Stream( this : not null access Resource_File'Class; 
  51.                           strm : out A_Buffer_Stream ); 
  52.  
  53.     -- Returns the size of the file in bytes; 
  54.     function Size(this : not null access Resource_File'Class ) return Unsigned_32; 
  55.  
  56.     -- Releases the reference to the resource. Resource files are reference 
  57.     -- counted so be sure to call this when finished with a Resource_File. 
  58.     procedure Release( resource : in out A_Resource_File ); 
  59.     pragma Postcondition( resource = null ); 
  60.  
  61.     ---------------------------------------------------------------------------- 
  62.  
  63.     -- Searches for and loads a resource file, returning a reference to it. The 
  64.     -- search order for resource files is as follows: 
  65.     -- 
  66.     -- 1. filepath  (If filepath is an absolute file path) 
  67.     -- 2. working_dir/filename 
  68.     -- 3. working_dir/group/filename 
  69.     -- 4. working_dir/group.zip/filename 
  70.     -- 5. user_dir/filename         (user_dir is defined by Application) 
  71.     -- 6. media_dir/filename        (media_dir is defined by "media" preference) 
  72.     -- 7. media_dir/group/filename 
  73.     -- 8. media_dir/group.zip/filename 
  74.     -- 
  75.     -- (Where 'filename' is the filename taken from 'filepath'.) 
  76.     -- 
  77.     -- NULL will be returned if the file is not found or otherwise can't be 
  78.     -- accessed. Resource files are reference counted, so you must call 
  79.     -- Unload_Resource when finished with the Resource_File. If 'keep' is True, 
  80.     -- the resource will be kept in memory even after no references remain. This 
  81.     -- is useful for keeping the most frequently used resources cached in memory 
  82.     -- for the life of the application. 
  83.     function Load_Resource( filepath : String; 
  84.                             group    : String; 
  85.                             keep     : Boolean := False ) return A_Resource_File; 
  86.     pragma Precondition( filepath'Length > 0 ); 
  87.  
  88.     -- Loads a resource into memory in the same way as Load_Resource except the 
  89.     -- reference will not be returned and the internal reference count will begin 
  90.     -- at zero. Use this to prefetch resources from disk. No load errors are 
  91.     -- reported by this procedure. 
  92.     procedure Preload_Resource( filepath : String; group : String ); 
  93.  
  94.     -- Attempts to find resource 'filepath' and then returns an absolute path 
  95.     -- that can be used to overwrite or override the resource. The same search 
  96.     -- algorithm as Load_Resource will be used. 
  97.     -- 
  98.     -- If the resource is found outside of an archive, its absolute path will be 
  99.     -- returned. 
  100.     -- 
  101.     -- If the resource is found inside an archive, then the returned path will 
  102.     -- point to a file of the same name in the same directory as its archive, 
  103.     -- effectively allowing the new file to override its archived version. If 
  104.     -- this location is not writable (entirely possible for installed 
  105.     -- applications) then the caller should fallback to the current working 
  106.     -- directory. If that fails, fallback to the user directory returned by 
  107.     -- Application.Get_User_Directory. 
  108.     -- 
  109.     -- If the resource is not found, then the returned path will point to a file 
  110.     -- of the same name in the current working directory. If this location is 
  111.     -- not writable (entirely possible for installed applications) then the 
  112.     -- caller should fallback to the user directory . 
  113.     function Write_Path( filepath : String; group : String ) return String; 
  114.     pragma Precondition( filepath'Length > 0 ); 
  115.     pragma Postcondition( Write_Path'Result'Length > 0 ); 
  116.  
  117.     ---------------------------------------------------------------------------- 
  118.  
  119.     RESOURCE_ERROR, 
  120.     RESOURCE_FORMAT_ERROR : exception; 
  121.  
  122. private 
  123.  
  124.     use Ada.Real_Time; 
  125.     use Ada.Strings.Unbounded; 
  126.     use Streams; 
  127.  
  128.     -- File extension for resolving archive files when searching for a resource. 
  129.     ARCHIVE_EXTENSION : constant String := "zip"; 
  130.  
  131.     type Resource_File is tagged limited 
  132.         record 
  133.             refs     : Natural := 1; 
  134.             keep     : Boolean := False;      -- keep in cache 
  135.             lastUse  : Time := Clock; 
  136.             filepath : Unbounded_String; 
  137.             group    : Unbounded_String; 
  138.             data     : A_SEA; 
  139.         end record; 
  140.  
  141.     -- Creates a Resource_File object from a raw buffer. The resource's path and 
  142.     -- group must be specified here manually. Set 'keep' to True to indicate the 
  143.     -- resource should not be removed from the cache even when all references 
  144.     -- have been unloaded. 'data' will be consumed. 
  145.     procedure Create_Resource( this     : out A_Resource_File; 
  146.                                filepath : String; 
  147.                                group    : String; 
  148.                                keep     : Boolean; 
  149.                                data     : in out A_SEA ); 
  150.     pragma Precondition( filepath'Length > 0 ); 
  151.     pragma Precondition( data /= null ); 
  152.     pragma Postcondition( data = null ); 
  153.     pragma Postcondition( this /= null ); 
  154.  
  155.     -- Creates a new Resource_File encapsulating a buffer and returns 
  156.     -- reference. 'filepath' is the original path of the resource, accessible 
  157.     -- via Get_Filename(). 'data' will be consumed. 
  158.     procedure Create_Resource( this     : out A_Resource_File; 
  159.                                filepath : String; 
  160.                                data     : in out A_SEA ); 
  161.     pragma Precondition( filepath'Length > 0 ); 
  162.     pragma Precondition( data /= null ); 
  163.     pragma Postcondition( this /= null ); 
  164.     pragma Postcondition( data = null ); 
  165.  
  166.     -- Increments the reference count for the resource file. 
  167.     procedure Reference( this : not null access Resource_File'Class ); 
  168.  
  169.     -- Decrements the referece count for the resource file. 
  170.     procedure Unreference( this : not null access Resource_File'Class ); 
  171.  
  172.     procedure Delete( this : in out A_Resource_File ); 
  173.  
  174. end Resources;