1. with Scaling;                           use Scaling; 
  2. with Widgets.Menubars;                  use Widgets.Menubars; 
  3.  
  4. limited with Game_Views; 
  5.  
  6. private with Allegro.Keyboard; 
  7. private with Mouse; 
  8.  
  9. package Widgets.Containers.Windows is 
  10.  
  11.     type Window is new Container with private; 
  12.     type A_Window is access all Window'Class; 
  13.  
  14.     function Create_Window( view   : access Game_Views.Game_View'Class; 
  15.                             id     : String; 
  16.                             width, 
  17.                             height : Natural; 
  18.                             scale  : Positive := 1; 
  19.                             filter : Filter_Type := Filter_Nearest 
  20.                           ) return A_Window; 
  21.     pragma Precondition( id'Length > 0 ); 
  22.     pragma Postcondition( Create_Window'Result /= null ); 
  23.  
  24.     procedure Dispatch_Click( this : access Window; 
  25.                               evt  : not null A_Mouse_Button_Event ); 
  26.  
  27.     function Dispatch_Key_Held( this : access Window; 
  28.                                 evt  : not null A_Key_Event ) return Boolean; 
  29.  
  30.     function Dispatch_Key_Press( this : access Window; 
  31.                                  evt  : not null A_Key_Event ) return Boolean; 
  32.  
  33.     function Dispatch_Key_Release( this : access Window; 
  34.                                    evt  : not null A_Key_Event ) return Boolean; 
  35.  
  36.     procedure Dispatch_Mouse_Held( this : access Window; 
  37.                                    evt  : not null A_Mouse_Button_Event ); 
  38.  
  39.     procedure Dispatch_Mouse_Move( this : access Window; 
  40.                                    evt  : not null A_Mouse_Event ); 
  41.  
  42.     procedure Dispatch_Mouse_Press( this : access Window; 
  43.                                     evt  : not null A_Mouse_Button_Event ); 
  44.  
  45.     procedure Dispatch_Mouse_Release( this : access Window; 
  46.                                       evt  : not null A_Mouse_Button_Event ); 
  47.  
  48.     function Dispatch_Mouse_Scroll( this : access Window; 
  49.                                     evt  : not null A_Mouse_Scroll_Event ) return Boolean; 
  50.  
  51.     procedure Draw( this : access Window; bmp : not null A_Bitmap ); 
  52.  
  53.     function Get_Scale( this : not null access Window'Class ) return Positive; 
  54.  
  55.     procedure Give_Focus( this : access Window; target : not null A_Widget ); 
  56.  
  57.     procedure Pop_Popup( this : access Window ); 
  58.  
  59.     -- Pops all widgets from the popups stack until the given popup widget has 
  60.     -- been popped. If the widget isn't an active popup menu, nothing will 
  61.     -- happen. 
  62.     procedure Pop_Popup( this : access Window; popup : not null A_Widget ); 
  63.  
  64.     -- Pushes a popup widget onto the top of the popup stack for the window, 
  65.     -- making it visible. Popups are the highest in the Z-order, so they will be 
  66.     -- displayed in front of any modal widget, most recent on top. The widget 
  67.     -- will become a child of the window. 
  68.     procedure Push_Popup( this : access Window; popup : not null A_Widget ); 
  69.  
  70.     -- Sets the offset of the window from origin of the screen. 
  71.     procedure Set_Offset( this : access Window; x, y : Integer ); 
  72.  
  73.     procedure Set_Menubar( this : access Window; menu : in out A_Menubar ); 
  74.     pragma Postcondition( menu = null ); 
  75.  
  76.     procedure Set_Modal( this : access Window; modal : A_Widget ); 
  77.  
  78.     procedure Set_Title( this : access Window; title : String ); 
  79.  
  80.     procedure Delete( this : in out A_Window ); 
  81.     pragma Postcondition( this = null ); 
  82.  
  83. private 
  84.  
  85.     use Allegro.Keyboard; 
  86.     use Mouse; 
  87.  
  88.     type Mouse_Widget_Array is array (Mouse_Button) of A_Widget; 
  89.  
  90.     type Key_Widget_Array is array (1..KEY_MAX) of A_Widget; 
  91.  
  92.     ---------------------------------------------------------------------------- 
  93.  
  94.     type Window is new Container with 
  95.         record 
  96.             scale          : Positive := 1; 
  97.             filter         : Filter_Type := Filter_Nearest; 
  98.             scalebmp       : A_Bitmap := null; 
  99.             menu           : A_Menubar := null; 
  100.             mouseOver      : A_Widget := null; 
  101.             mousePressedOn : Mouse_Widget_Array; 
  102.             mouseClickedOn : Mouse_Widget_Array; 
  103.             focus          : A_Widget := null; 
  104.             modal          : A_Widget := null;     -- widget with modality in window 
  105.             popups         : Widget_Lists.List;    -- stack of active popup widgets 
  106.             keyPressSentTo : Key_Widget_Array := Key_Widget_Array'(others=>null); 
  107.         end record; 
  108.  
  109.     procedure Construct( this   : access Window; 
  110.                          view   : access Game_Views.Game_View'Class; 
  111.                          id     : String; 
  112.                          width, 
  113.                          height : Natural; 
  114.                          scale  : Positive; 
  115.                          filter : Filter_Type ); 
  116.     pragma Precondition( id'Length > 0 ); 
  117.  
  118.     procedure Delete( this : in out Window ); 
  119.  
  120.     procedure Dispatch_Mouse_Release( this : access Window; 
  121.                                       x, y : Integer; 
  122.                                       btn  : Mouse_Button ); 
  123.  
  124.     procedure Draw( this : access Window; bmp : not null A_Bitmap; x, y : Integer ); 
  125.  
  126.     procedure Draw_Content( this : access Window; dc : Drawing_Context ); 
  127.  
  128.     -- find a widget at the given screen coordinates (sx, sy) and return the 
  129.     -- corresponding widget content coordinates if a widget is found (wx, wy). 
  130.     procedure Find_Widget( this   : access Window; 
  131.                            sx, sy : Integer; 
  132.                            wx, wy : out Integer; 
  133.                            found  : out A_Widget ); 
  134.  
  135.     function Get_Window( this : access Window ) return access Window'Class; 
  136.  
  137.     procedure Handle_Descendant_Hidden( this       : access Window; 
  138.                                         descendant : not null A_Widget ); 
  139.  
  140.     procedure Handle_Descendant_Unhidden( this       : access Window; 
  141.                                           descendant : not null A_Widget ); 
  142.  
  143.     function Handle_Key_Press( this : access Window; 
  144.                                evt  : not null A_Key_Event ) return Boolean; 
  145.  
  146.     procedure Pack( this : access Window ); 
  147.  
  148.     procedure Translate_To_Content( this   : access Window; 
  149.                                     sx, sy : Integer; 
  150.                                     cx, cy : out Integer ); 
  151.  
  152.     procedure Translate_To_Window( this   : access Window; 
  153.                                    cx, cy : Integer; 
  154.                                    wx, wy : out Integer ); 
  155.  
  156. end Widgets.Containers.Windows;