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 Events.Listeners;                  use Events.Listeners; 
  10. with Tiles.Matrices;                    use Tiles.Matrices; 
  11.  
  12. private with Ada.Containers.Vectors; 
  13. private with Events; 
  14. private with Tiles.Libraries; 
  15.  
  16. package Widgets.Palettes.Matrices is 
  17.  
  18.     type Matrix_Palette is abstract new Palette and Event_Listener with private; 
  19.  
  20.     function Create_Matrix_Palette( view : not null access Game_Views.Game_View'Class; 
  21.                                     id   : String ) return A_Palette; 
  22.  
  23.     -- Raises an error if tile library 'name' can't be loaded. 
  24.     procedure Set_Library_Name( this : not null access Matrix_Palette'Class; 
  25.                                 name : String ); 
  26.  
  27. private 
  28.  
  29.     use Events; 
  30.     use Tiles.Libraries; 
  31.  
  32.     type Matrix_Rec is 
  33.         record 
  34.             matrix : A_Tile_Matrix := null; 
  35.             row, 
  36.             col, 
  37.             height, 
  38.             width      : Natural := 0; 
  39.         end record; 
  40.  
  41.     function "="( l, r : Matrix_Rec ) return Boolean; 
  42.  
  43.     package Matrix_Vectors is new Ada.Containers.Vectors( Positive, Matrix_Rec, "=" ); 
  44.  
  45.     ---------------------------------------------------------------------------- 
  46.  
  47.     type Matrix_Palette is new Palette and Event_Listener with 
  48.         record 
  49.             lib       : A_Tile_Library := null; 
  50.             matrices  : Matrix_Vectors.Vector; 
  51.             itemCount : Integer := 0;      -- number of slots in the palette 
  52.         end record; 
  53.  
  54.     procedure Construct( this : access Matrix_Palette; 
  55.                          view : not null access Game_Views.Game_View'Class; 
  56.                          id   : String ); 
  57.  
  58.     procedure Delete( this : in out Matrix_Palette ); 
  59.  
  60.     procedure Get_Item_Details( this   : access Matrix_Palette; 
  61.                                 row, 
  62.                                 col    : Natural; 
  63.                                 bmp    : out A_Allegro_Bitmap; 
  64.                                 border : out Allegro_Color ); 
  65.  
  66.     function Get_Scroll_Inc_Y( this : access Matrix_Palette ) return Integer; 
  67.  
  68.     function Get_Item_Count( this : access Matrix_Palette ) return Natural; 
  69.  
  70.     procedure Handle_Event( this : access Matrix_Palette; 
  71.                             evt  : in out A_Event; 
  72.                             resp : out Response_Type ); 
  73.  
  74.     procedure On_Mouse_Press( this : access Matrix_Palette; 
  75.                               evt  : not null A_Mouse_Button_Event ); 
  76.  
  77. end Widgets.Palettes.Matrices;