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.     -- A Window is the root of the widget tree within the application window. 
  12.     -- 
  13.     -- All interface input events are delivered to the Window and then 
  14.     -- dispatched by the Window to its descendent widgets. Widget events are 
  15.     -- handled in a bottom-up approach, being delivered to the focused widget 
  16.     -- first and then dispatching up the tree, toward the Window, until the 
  17.     -- event is captured and handled. 
  18.     -- 
  19.     -- Input focus, or just "focus", is tracked by the Window. Exactly one 
  20.     -- widget in the Window tree will have focus at all times. If no other 
  21.     -- widget is focused, the Window will be focused by default. The focused 
  22.     -- widget will receive all keyboard events. 
  23.     type Window is new Container with private; 
  24.     type A_Window is access all Window'Class; 
  25.  
  26.     -- Creates a new Window within 'view'. 'width' and 'height' are the size of 
  27.     -- the widget. The window can be upscaled to a higher resolution by setting 
  28.     -- 'scale' > 1 and the upscale filter effect with 'filter'. 
  29.     function Create_Window( view   : access Game_Views.Game_View'Class; 
  30.                             id     : String; 
  31.                             width, 
  32.                             height : Natural; 
  33.                             scale  : Positive := 1; 
  34.                             filter : Filter_Type := Filter_Nearest 
  35.                           ) return A_Window; 
  36.     pragma Precondition( id'Length > 0 ); 
  37.     pragma Postcondition( Create_Window'Result /= null ); 
  38.  
  39.     -- Dispatches a mouse click event to the widget that the mouse clicked on. 
  40.     -- If the button release occurred over a different widget than the press, 
  41.     -- then the click will be ignored. 
  42.     procedure Dispatch_Click( this : access Window; 
  43.                               evt  : not null A_Mouse_Button_Event ); 
  44.  
  45.     -- Dispatches a key held event to the focused widget, if the key was pressed 
  46.     -- after the widget received focus. 
  47.     function Dispatch_Key_Held( this : access Window; 
  48.                                 evt  : not null A_Key_Event ) return Boolean; 
  49.  
  50.     -- Dispatches a key press event to the focused widget. 
  51.     function Dispatch_Key_Press( this : access Window; 
  52.                                  evt  : not null A_Key_Event ) return Boolean; 
  53.  
  54.     -- Dispatches a key release event to the widget that received the key press 
  55.     -- event, regardless of input focus. 
  56.     function Dispatch_Key_Release( this : access Window; 
  57.                                    evt  : not null A_Key_Event ) return Boolean; 
  58.  
  59.     -- Dispatches a mouse held event to the widget that the mouse was over at 
  60.     -- the time the mouse button was pressed. 
  61.     procedure Dispatch_Mouse_Held( this : access Window; 
  62.                                    evt  : not null A_Mouse_Button_Event ); 
  63.  
  64.     -- Dispatches a mouse move event. If the mouse is over a different widget 
  65.     -- than last move then widget exit and widget enter events are dispatched 
  66.     -- appropriately first. 
  67.     -- 
  68.     -- If the left mouse button is being held down, a mouse move event is sent 
  69.     -- to the widget that the mouse was over when the left button was pressed. 
  70.     -- If the mouse is currently over a widget that isn't the one that the left 
  71.     -- mouse button was pressed over, then that widget will also receive a mouse 
  72.     -- move event. 
  73.     procedure Dispatch_Mouse_Move( this : access Window; 
  74.                                    evt  : not null A_Mouse_Event ); 
  75.  
  76.     -- Dispatches a mouse press event to the widget the mouse is currently over. 
  77.     -- If a popup widget (or stack of popup widgets) is being displayed, then 
  78.     -- the popup widgets will be popped off the stack and hidden unless they are 
  79.     -- under the mouse. This allows context menus, etc, to be hidden when the 
  80.     -- user clicks somewhere else in the Window. If a modal dialog widget is 
  81.     -- being displayed, then the press will only be dispatched to descendents of 
  82.     -- the modal widget. 
  83.     procedure Dispatch_Mouse_Press( this : access Window; 
  84.                                     evt  : not null A_Mouse_Button_Event ); 
  85.  
  86.     -- Dispatches a mouse release event to the widget the mouse is over. 
  87.     procedure Dispatch_Mouse_Release( this : access Window; 
  88.                                       evt  : not null A_Mouse_Button_Event ); 
  89.  
  90.     -- Dispatches a scroll wheel event to the widget the mouse is over. 
  91.     function Dispatch_Mouse_Scroll( this : access Window; 
  92.                                     evt  : not null A_Mouse_Scroll_Event ) return Boolean; 
  93.  
  94.     -- Draws the whole window and all its descendents to 'bmp'. This procedure 
  95.     -- is used by the renderer to draw the whole screen. The bitmap 'bmp' must 
  96.     -- be at least (width*scale, height*scale) in size and it can be any kind 
  97.     -- of bitmap (ie: a system/video bitmap). 
  98.     procedure Draw( this : access Window; bmp : not null A_Bitmap ); 
  99.  
  100.     -- Get the scaling factor used when drawing the Window to the screen. A 
  101.     -- return value of 1 means no upscaling. 
  102.     function Get_Scale( this : not null access Window'Class ) return Positive; 
  103.  
  104.     -- Gives input focus to 'target'. If 'target' doesn't accept focus, then 
  105.     -- focus will be given to its "next focus" widget (what happens when you 
  106.     -- press the Tab key). If no "next focus" widget exists or accepts focus, 
  107.     -- then focus will be given to the widget's nearest ancestor that accepts 
  108.     -- it. Changing the input focus will prevent any potential key held and key 
  109.     -- release events from being sent to the old focused widget that received 
  110.     -- the key press. 
  111.     procedure Give_Focus( this : access Window; target : not null A_Widget ); 
  112.  
  113.     -- Pops the top-most widget off the popup stack. If there are no active 
  114.     -- popup widgets, nothing will happen. 
  115.     procedure Pop_Popup( this : access Window ); 
  116.  
  117.     -- Pops all widgets from the popups stack until the given popup widget has 
  118.     -- been popped. If the widget isn't an active popup menu, nothing will 
  119.     -- happen. 
  120.     procedure Pop_Popup( this : access Window; popup : not null A_Widget ); 
  121.  
  122.     -- Pushes a popup widget onto the top of the popup stack, making it visible. 
  123.     -- Popups are the highest in the Z-order, so they will be displayed in front 
  124.     -- of any modal widget, most recent on top. The widget will temporarily 
  125.     -- become a child of the window while its on the popup stack. 
  126.     procedure Push_Popup( this : access Window; popup : not null A_Widget ); 
  127.  
  128.     -- Sets the offset of the top left corner of the window from the top left 
  129.     -- corner of the screen. 
  130.     procedure Set_Offset( this : access Window; x, y : Integer ); 
  131.  
  132.     -- Sets the Window's menu bar widget. The menu bar is optional and there can 
  133.     -- be only one per Window. 'menu' will be consumed. If a menu bar has 
  134.     -- already been set, the old one will be deleted. 
  135.     procedure Set_Menubar( this : access Window; menu : in out A_Menubar ); 
  136.     pragma Postcondition( menu = null ); 
  137.  
  138.     -- Sets the modal widget drawn on top of all others in the Window. This 
  139.     -- widget and its descendents will receive all input events or prevent them 
  140.     -- from being sent to any others, while it is visible. Set 'modal' to null 
  141.     -- to clear the modal widget. 'modal' will be set visible when it's set and 
  142.     -- invisible when another modal widget is set or it's unset. The modal 
  143.     -- modal widget tree will be drawn in front of all other Window children and 
  144.     -- behind any active popup widgets. 
  145.     procedure Set_Modal( this : access Window; modal : A_Widget ); 
  146.  
  147.     -- Sets the title at the top of the application window. 
  148.     procedure Set_Title( this : access Window; title : String ); 
  149.  
  150.     -- Deletes the Window. 
  151.     procedure Delete( this : in out A_Window ); 
  152.     pragma Postcondition( this = null ); 
  153.  
  154. private 
  155.  
  156.     use Allegro.Keyboard; 
  157.     use Mouse; 
  158.  
  159.     -- an array of widgets by mouse button; used for tracking mouse button 
  160.     -- history relative to widgets. 
  161.     type Mouse_Widget_Array is array (Mouse_Button) of A_Widget; 
  162.  
  163.     -- an array of widgets by key scancode. used for tracking key history 
  164.     -- relative to widgets. 
  165.     type Key_Widget_Array is array (1..KEY_MAX) of A_Widget; 
  166.  
  167.     ---------------------------------------------------------------------------- 
  168.  
  169.     type Window is new Container with 
  170.         record 
  171.             scale          : Positive := 1; 
  172.             filter         : Filter_Type := Filter_Nearest; 
  173.             scalebmp       : A_Bitmap := null; 
  174.             menu           : A_Menubar := null; 
  175.             mouseOver      : A_Widget := null; 
  176.             mousePressedOn : Mouse_Widget_Array; 
  177.             mouseClickedOn : Mouse_Widget_Array; 
  178.             focus          : A_Widget := null; 
  179.             modal          : A_Widget := null;     -- widget with modality in window 
  180.             popups         : Widget_Lists.List;    -- stack of active popup widgets 
  181.             keyPressSentTo : Key_Widget_Array := Key_Widget_Array'(others=>null); 
  182.         end record; 
  183.  
  184.     procedure Construct( this   : access Window; 
  185.                          view   : access Game_Views.Game_View'Class; 
  186.                          id     : String; 
  187.                          width, 
  188.                          height : Natural; 
  189.                          scale  : Positive; 
  190.                          filter : Filter_Type ); 
  191.     pragma Precondition( id'Length > 0 ); 
  192.  
  193.     procedure Delete( this : in out Window ); 
  194.  
  195.     -- Dispatches a mouse release event of button 'btn' to the widget on the 
  196.     -- screen at 'x', 'y'. 
  197.     procedure Dispatch_Mouse_Release( this : access Window; 
  198.                                       x, y : Integer; 
  199.                                       btn  : Mouse_Button ); 
  200.  
  201.     -- Draws the Window, all its children, and then the popup widget stack to 
  202.     -- 'bmp' in back-to-front order with an offset of 'x','y'. The modal widget, 
  203.     -- if set, will be the front-most child. The popup widgets, if any are 
  204.     -- active, will still be drawn in front of the modal widget tree and menu 
  205.     -- bar. 'bmp' should be a memory bitmap only. 
  206.     procedure Draw( this : access Window; bmp : not null A_Bitmap; x, y : Integer ); 
  207.  
  208.     -- Draws the window background onto 'dc'. 
  209.     procedure Draw_Content( this : access Window; dc : Drawing_Context ); 
  210.  
  211.     -- find a widget at the given screen coordinates (sx, sy) and return the 
  212.     -- corresponding widget content coordinates if a widget is found (wx, wy). 
  213.     procedure Find_Widget( this   : access Window; 
  214.                            sx, sy : Integer; 
  215.                            wx, wy : out Integer; 
  216.                            found  : out A_Widget ); 
  217.  
  218.     -- Recursively returns the widget's parent Window at the root of its 
  219.     -- ancestors. The Window widget is always its own window: returns 'this'. 
  220.     function Get_Window( this : access Window ) return access Window'Class; 
  221.  
  222.     -- Handles when 'descendant' becomes hidden. If it was focused then the 
  223.     -- focus must be transferred to a visible ancestor, etc. 
  224.     procedure Handle_Descendant_Hidden( this       : access Window; 
  225.                                         descendant : not null A_Widget ); 
  226.  
  227.     -- Handles when 'descendent' becomes visible. 
  228.     procedure Handle_Descendant_Unhidden( this       : access Window; 
  229.                                           descendant : not null A_Widget ); 
  230.  
  231.     -- Handles a key press event captured by the Window. This would mean that 
  232.     -- none of the other ancestors of the focused widget handled the key. Only 
  233.     -- ESC key is handled, to pop/hide the top active popup widget. 
  234.     function Handle_Key_Press( this : access Window; 
  235.                                evt  : not null A_Key_Event ) return Boolean; 
  236.  
  237.     -- Packs the window, all its children, and its menu bar. 
  238.     procedure Pack( this : access Window ); 
  239.  
  240.     -- Translates screen coordinates 'sx','sy' into Window content coordinates, 
  241.     -- 'cx','cy'. 
  242.     procedure Translate_To_Content( this   : access Window; 
  243.                                     sx, sy : Integer; 
  244.                                     cx, cy : out Integer ); 
  245.  
  246.     -- Translates this widget's content coordinates into its Window's content 
  247.     -- coordinates. Because this is the Window widget, no translation actually 
  248.     -- occurs. (This is for a recursive function.) Note that 'wx','wy' here are 
  249.     -- not in the same coordinate space as the screen coordinates, 'sx','sy', 
  250.     -- that are passed to Translate_To_Content. 
  251.     procedure Translate_To_Window( this   : access Window; 
  252.                                    cx, cy : Integer; 
  253.                                    wx, wy : out Integer ); 
  254.  
  255. end Widgets.Containers.Windows;