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