1. with Actions;                           use Actions; 
  2. with Allegro.Bitmaps;                   use Allegro.Bitmaps; 
  3. with Allegro.Truecolor;                 use Allegro.Truecolor; 
  4. with Drawing_Contexts;                  use Drawing_Contexts; 
  5. with Events.Input;                      use Events.Input; 
  6. with Keyboard;                          use Keyboard; 
  7. with Objects;                           use Objects; 
  8. with Themes;                            use Themes; 
  9.  
  10. limited with Game_Views; 
  11.  
  12. private with Ada.Containers.Doubly_Linked_Lists; 
  13. private with Ada.Containers.Indefinite_Hashed_Maps; 
  14. private with Ada.Strings.Hash_Case_Insensitive; 
  15. private with Ada.Strings.Equal_Case_Insensitive; 
  16. private with Ada.Strings.Unbounded; 
  17. private with Associations; 
  18. private with Values; 
  19.  
  20. limited private with Widgets.Containers.Windows; 
  21.  
  22. package Widgets is 
  23.  
  24.     type Widget is abstract new Object with private; 
  25.     type A_Widget is access all Widget'Class; 
  26.  
  27.     ---------------------------------------------------------------------------- 
  28.  
  29.     type Key_Action is new Action with private; 
  30.     type A_Key_Action is access all Key_Action'Class; 
  31.  
  32.     Key_Press   : constant Action_Id; 
  33.     Key_Held    : constant Action_Id; 
  34.     Key_Release : constant Action_Id; 
  35.  
  36.     function Get_Key( this : access Key_Action ) return Integer; 
  37.  
  38.     function Get_Modifiers( this : access Key_Action ) return Modifiers_Array; 
  39.  
  40.     -- This is the interface to implement in order to listen to key actions. 
  41.     -- When a key action occurs, the listener will be notified of the type of 
  42.     -- action performed and the widget that received the key action. 
  43.     type Key_Listener is limited interface and Action_Listener; 
  44.     type A_Key_Listener is access all Key_Listener'Class; 
  45.  
  46.     procedure Handle_Action( this    : access Key_Listener; 
  47.                              action  : A_Key_Action; 
  48.                              handled : out Boolean ) is abstract; 
  49.  
  50.     type A_Key_Handler is 
  51.         access procedure( action  : A_Key_Action; 
  52.                           handled : out Boolean ); 
  53.  
  54.     ---------------------------------------------------------------------------- 
  55.  
  56.     type Visibility_Action is new Action with private; 
  57.     type A_Visibility_Action is access all Visibility_Action'Class; 
  58.  
  59.     Change_Visibility : constant Action_Id; 
  60.  
  61.     function Is_Visible( this : access Visibility_Action ) return Boolean; 
  62.  
  63.     -- Implement this interface to receive notifications when the widget's 
  64.     -- visibility changes. 
  65.     type Visibility_Listener is limited interface and Action_Listener; 
  66.     type A_Visibility_Listener is access all Visibility_Listener'Class; 
  67.  
  68.     procedure Handle_Action( this   : access Visibility_Listener; 
  69.                              action : A_Visibility_Action ) is abstract; 
  70.  
  71.     ---------------------------------------------------------------------------- 
  72.  
  73.     -- Adds an object as a listener for key actions, such as press, release 
  74.     -- and held actions. 
  75.     procedure Add_Listener( this     : not null access Widget'Class; 
  76.                             listener : not null A_Key_Listener ); 
  77.  
  78.     -- Adds the handler procedure as a simple listener. The listener can't be 
  79.     -- removed and can be added multiple times. 
  80.     procedure Add_Listener( this      : not null access Widget'Class; 
  81.                             key       : Integer; 
  82.                             modifiers : Modifiers_Pattern; 
  83.                             handler   : not null A_Key_Handler ); 
  84.  
  85.     -- Adds the handler procedure as a simple listener. The listener can't be 
  86.     -- removed and can be added multiple times. The key modifiers will match any 
  87.     -- combination so this procedure is equivalent to calling Add_Listener with 
  88.     -- modifiers => MODIFIERS_ANY. 
  89.     procedure Add_Listener( this    : not null access Widget'Class; 
  90.                             key     : Integer; 
  91.                             handler : not null A_Key_Handler ); 
  92.  
  93.     -- Adds an object as a listener for visibility actions. Visibility listeners 
  94.     -- are notified when the widget becomes visibility or hidden. 
  95.     procedure Add_Listener( this     : not null access Widget'Class; 
  96.                             listener : not null A_Visibility_Listener ); 
  97.  
  98.     -- Draws the widget and children to bmp, redrawing contents if necessary 
  99.     procedure Draw( this : access Widget; bmp : not null A_Bitmap; x, y : Integer ); 
  100.  
  101.     -- Draws the widget content within the viewport. This should not be called 
  102.     -- directly. 
  103.     procedure Draw_Content( this : access Widget; dc : Drawing_Context ) is abstract; 
  104.  
  105.     -- Returns the value of the specified attribute as an integer. If the 
  106.     -- attribute is not an integer, it will be converted. If the attribute does 
  107.     -- not exist or can not be converted then VALUE_NOT_FOUND or 
  108.     -- INVALID_CONVERSION will be raised, respectively. 
  109.     function Get_Attribute( this : not null access Widget'Class; 
  110.                             name : String ) return Integer; 
  111.     pragma Precondition( name'Length > 0 ); 
  112.  
  113.     -- Returns the value of the specified attribute as a string. If the 
  114.     -- attribute is not an string, it will be converted. If the attribute does 
  115.     -- not exist or can not be converted then VALUE_NOT_FOUND or 
  116.     -- INVALID_CONVERSION will be raised, respectively. 
  117.     function Get_Attribute( this : not null access Widget'Class; 
  118.                             name : String ) return String; 
  119.     pragma Precondition( name'Length > 0 ); 
  120.  
  121.     -- Returns the widget's drawn border type 
  122.     function Get_Border( this : not null access Widget'Class ) return Border_Type; 
  123.  
  124.     -- Returns the color used by the widget for a specific purpose. Not all 
  125.     -- color purposes apply to every widget. 
  126.     function Get_Color( this : access Widget; purpose : Color_Purpose ) return Color_Type; 
  127.  
  128.     -- Returns the name of the widget's font. 
  129.     function Get_Font_Name( this : not null access Widget'Class ) return String; 
  130.  
  131.     -- Returns the point size of the widget's font. 
  132.     function Get_Font_Size( this : not null access Widget'Class ) return Positive; 
  133.  
  134.     -- Returns the screen height of the widget (height of the viewport) 
  135.     function Get_Height( this : not null access Widget'Class ) return Integer; 
  136.  
  137.     -- Returns the unique id of the widget 
  138.     function Get_Id( this : not null access Widget'Class ) return String; 
  139.     pragma Postcondition( Get_Id'Result'Length > 0 ); 
  140.  
  141.     -- Returns the view controlling this widget. The window widget contains a 
  142.     -- reference to the view and all other widgets must ask for it. 
  143.     function Get_View( this : access Widget ) return access Game_Views.Game_View'Class; 
  144.  
  145.     -- Returns the screen width of the widget (width of the viewport). 
  146.     function Get_Width( this : not null access Widget'Class ) return Natural; 
  147.  
  148.     -- Returns the zoom factor of the widget. Numbers greater than one mean the 
  149.     -- view of the widget is zoomed in. 
  150.     function Get_Zoom( this : not null access Widget'Class ) return Float; 
  151.  
  152.     -- Returns true if the widget is current enabled. 
  153.     function Is_Enabled( this : not null access Widget'Class ) return Boolean; 
  154.  
  155.     -- Returns true if the widget is currently visible. 
  156.     function Is_Visible( this : not null access Widget'Class ) return Boolean; 
  157.  
  158.     -- Moves the widget within its parent's content region. 
  159.     procedure Move( this : not null access Widget'Class; xdist, ydist : Integer ); 
  160.  
  161.     -- Moves the widget to an absolute location with its parent's content 
  162.     -- region. the top left of the widget is positioned at x, y. 
  163.     procedure Move_To( this  : not null access Widget'Class; x, y : Integer ); 
  164.  
  165.     procedure Remove_Listener( this     : not null access Widget'Class; 
  166.                                listener : not null A_Key_Listener ); 
  167.  
  168.     procedure Remove_Listener( this     : not null access Widget'Class; 
  169.                                listener : not null A_Visibility_Listener ); 
  170.  
  171.     -- Forces the widget to redraw itself on the next frame. 
  172.     procedure Redraw( this : not null access Widget'Class ); 
  173.  
  174.     -- Scrolls the widget's viewport, if possible, by the given x, y distances. 
  175.     -- The positive scroll direction is down and to the right. 
  176.     procedure Scroll( this : not null access Widget'Class; x, y : Integer ); 
  177.  
  178.     -- Scrolls the widget's viewport by moving the top left corner to the given 
  179.     -- location. 
  180.     procedure Scroll_To( this : not null access Widget'Class; x, y : Integer ); 
  181.  
  182.     -- Sets an integer attribute on the widget. Attributes are used for 
  183.     -- encapsulating minor additional data without extending a widget class. 
  184.     procedure Set_Attribute( this  : not null access Widget'Class; 
  185.                              name  : String; 
  186.                              val   : Integer ); 
  187.     pragma Precondition( name'Length > 0 ); 
  188.  
  189.     -- Sets a string attribute on the widget. Attributes are used for 
  190.     -- encapsulating minor additional data without extending a widget class. 
  191.     procedure Set_Attribute( this  : not null access Widget'Class; 
  192.                              name  : String; 
  193.                              val   : String ); 
  194.     pragma Precondition( name'Length > 0 ); 
  195.  
  196.     -- Sets the border for the widget, if it uses one. 
  197.     procedure Set_Border( this   : not null access Widget'Class; 
  198.                           border : Border_Type ); 
  199.  
  200.     -- Sets the color used by the widget for a specific purpose. Not all color 
  201.     -- purposes apply to every widget. 
  202.     procedure Set_Color( this    : access Widget; 
  203.                          purpose : Color_Purpose; 
  204.                          color   : Color_Type ); 
  205.  
  206.     -- Sets whether the widget is enabled or not. If not enabled, the widget 
  207.     -- will ignore all user interaction. If a widget is disabled, all of its 
  208.     -- children are also implicitly disabled. 
  209.     procedure Set_Enabled( this : access Widget; enabled : Boolean ); 
  210.  
  211.     -- Sets whether the widget can accept focus. 
  212.     procedure Set_Focusable( this      : not null access Widget'Class; 
  213.                              focusable : Boolean ); 
  214.  
  215.     -- Sets the widget's focused state. This does not focus the widget. It 
  216.     -- should be called only by a Window widget. 
  217.     procedure Set_Focused( this : access Widget; focused : Boolean ); 
  218.  
  219.     -- Sets the widget's font name and/or size. 
  220.     procedure Set_Font( this : not null access Widget'Class; 
  221.                         name : String := ""; 
  222.                         size : Natural := 0 ); 
  223.  
  224.     -- Sets the widget's layout as centered within the parent's content area, 
  225.     -- given the viewport size. 
  226.     procedure Set_Layout_Center( this   : not null access Widget'Class; 
  227.                                  width, 
  228.                                  height : Natural ); 
  229.  
  230.     -- Sets the widget's layout as centered horizontally and spaced from the top 
  231.     -- and bottom of the parent's content area like layout LTRB. 
  232.     procedure Set_Layout_CenterH( this   : not null access Widget'Class; 
  233.                                   width  : Natural; 
  234.                                   top, 
  235.                                   bottom : Integer ); 
  236.  
  237.     -- Sets the widget's layout as centered horizontally and positioned 
  238.     -- absolutely in the vertical dimension. y1 and y2 are both distances from 
  239.     -- the top of the parent's content region. Negative values will position 
  240.     -- the widget off the top edge of the parent's content. 
  241.     procedure Set_Layout_CenterHY( this   : not null access Widget'Class; 
  242.                                    width  : Natural; 
  243.                                    y1, y2 : Integer ); 
  244.  
  245.     -- Sets the widget's layout based on the distance of the viewport's edges 
  246.     -- from the edges of the parent's content area. 
  247.     procedure Set_Layout_LTRB( this   : not null access Widget'Class; 
  248.                                left, 
  249.                                top, 
  250.                                right, 
  251.                                bottom : Integer ); 
  252.  
  253.     -- Sets the widget's layout based on a size and distance from the top left 
  254.     -- edges of the parent's content area. If top or left is negative then the 
  255.     -- top left corner of the widget will be positioned relative to the bottom 
  256.     -- or right edge of the content area. If width or height is 0 then the 
  257.     -- widget's minimum width or height will be used instead. 
  258.     procedure Set_Layout_LTWH( this   : not null access Widget'Class; 
  259.                                left, 
  260.                                top    : Integer; 
  261.                                width, 
  262.                                height : Natural ); 
  263.  
  264.     -- Sets the widget's layout based on a size and absolute distance from the 
  265.     -- top left corner of the parent's content area. This layout is nearly 
  266.     -- identical to LTWH except negative values for 'x' and 'y' are kept 
  267.     -- relative to the upper left. If width or height is 0 then the 
  268.     -- widget's minimum width or height will be used instead. 
  269.     procedure Set_Layout_XYWH( this   : not null access Widget'Class; 
  270.                                x, y   : Integer; 
  271.                                width, 
  272.                                height : Natural ); 
  273.  
  274.     -- Sets the minimum height value to override the computed minimum height 
  275.     -- for the widget. If height is set to zero, the computed value is returned 
  276.     -- by Get_Min_Height. 
  277.     procedure Set_Min_Height( this   : not null access Widget'Class; 
  278.                               height : Natural ); 
  279.  
  280.     -- Sets the minimum width value to override the computed minimum width 
  281.     -- for the widget. If width is set to zero, the computed value is returned 
  282.     -- by Get_Min_Width. 
  283.     procedure Set_Min_Width( this  : not null access Widget'Class; 
  284.                              width : Natural ); 
  285.  
  286.     -- Sets the next widget to receive focus when tab is pressed on this widget. 
  287.     procedure Set_Next( this : not null access Widget'Class; id : String ); 
  288.  
  289.     -- Sets the next widget to receive focus when shift + tab is pressed on this 
  290.     -- widget. 
  291.     procedure Set_Prev( this : not null access Widget'Class; id : String ); 
  292.  
  293.     -- Set to true if the widget is partly transparent so that it will be drawn 
  294.     -- over the background. 
  295.     procedure Set_Transparent( this        : not null access Widget'Class; 
  296.                                transparent : Boolean ); 
  297.  
  298.     -- Sets whether the widget is visible. 
  299.     procedure Set_Visible( this : access Widget; visible : Boolean ); 
  300.  
  301.     -- Sets the zoom factor. Values > 1 make the contents larger and values < 1 
  302.     -- make the contents smaller. This does not affect the screen size of the 
  303.     -- widget; Increasing the zoom decreases the visible content area. 
  304.     procedure Set_Zoom( this : access Widget; zoom : Float ); 
  305.  
  306.     -- Enable/disable font smoothing if the widget draws text. This is only a 
  307.     -- hint; it can be used to disable font smoothing, but font smoothing can 
  308.     -- only work if the conditions support it (type of font, transparency, etc.) 
  309.     -- Smooth fonts are enabled by default. 
  310.     procedure Smooth_Text( this : not null access Widget'Class; enabled : Boolean ); 
  311.  
  312. private 
  313.  
  314.     use Ada.Strings.Unbounded; 
  315.     use Associations; 
  316.     use Values; 
  317.  
  318.     ---------------------------------------------------------------------------- 
  319.  
  320.     type Simple_Action_Listener is abstract new Object with null record; 
  321.  
  322.     ---------------------------------------------------------------------------- 
  323.  
  324.     type Layout is abstract new Object with null record; 
  325.     type A_Layout is access all Layout'Class; 
  326.  
  327.     -- Raises Constraint_Error because this is an abstract procedure that should 
  328.     -- not be directly called. This procedure isn't officially declared abstract 
  329.     -- so the Layout type can remain in the private section. 
  330.     procedure Apply( this : access Layout; widget : not null A_Widget ); 
  331.  
  332.     ---------------------------------------------------------------------------- 
  333.  
  334.     package Action_Listeners is new Ada.Containers.Doubly_Linked_Lists( A_Action_Listener, "=" ); 
  335.     use Action_Listeners; 
  336.  
  337.     package Listener_Maps is new 
  338.         Ada.Containers.Indefinite_Hashed_Maps( String, Action_Listeners.List, 
  339.                                                Ada.Strings.Hash_Case_Insensitive, 
  340.                                                Ada.Strings.Equal_Case_Insensitive, 
  341.                                                Action_Listeners."=" ); 
  342.     use Listener_Maps; 
  343.  
  344.     ---------------------------------------------------------------------------- 
  345.  
  346.     Key_Press   : constant Action_Id := To_Action_Id( "key.press" ); 
  347.     Key_Held    : constant Action_Id := To_Action_Id( "key.held" ); 
  348.     Key_Release : constant Action_Id := To_Action_Id( "key.release" ); 
  349.     Key_Click   : constant Action_Id := To_Action_Id( "key.click" ); 
  350.  
  351.     type Key_Action is new Action with 
  352.         record 
  353.             key       : Integer; 
  354.             modifiers : Modifiers_Array; 
  355.         end record; 
  356.  
  357.     procedure Construct( this      : access Key_Action; 
  358.                          id        : Action_Id; 
  359.                          source    : not null A_Widget; 
  360.                          key       : Integer; 
  361.                          modifiers : Modifiers_Array ); 
  362.  
  363.     procedure Delete( this : in out A_Key_Action ); 
  364.     pragma Postcondition( this = null ); 
  365.  
  366.     ---------------------------------------------------------------------------- 
  367.  
  368.     type Simple_Key_Listener is new Simple_Action_Listener and Key_Listener with 
  369.         record 
  370.             key       : Integer; 
  371.             modifiers : Modifiers_Pattern; 
  372.             handler   : A_Key_Handler := null; 
  373.         end record; 
  374.     type A_Simple_Key_Listener is access all Simple_Key_Listener'Class; 
  375.  
  376.     function Create_Listener( key       : Integer; 
  377.                               modifiers : Modifiers_Pattern; 
  378.                               handler   : not null A_Key_Handler 
  379.                             ) return A_Key_Listener; 
  380.     pragma Postcondition( Create_Listener'Result /= null ); 
  381.  
  382.     procedure Handle_Action( this    : access Simple_Key_Listener; 
  383.                              action  : A_Key_Action; 
  384.                              handled : out Boolean ); 
  385.  
  386.     ---------------------------------------------------------------------------- 
  387.  
  388.     Change_Visibility : constant Action_Id := To_Action_Id( "visibility.changed" ); 
  389.  
  390.     type Visibility_Action is new Action with 
  391.         record 
  392.             visible : Boolean; 
  393.         end record; 
  394.  
  395.     procedure Construct( this    : access Visibility_Action; 
  396.                          id      : Action_Id; 
  397.                          source  : not null A_Widget; 
  398.                          visible : Boolean ); 
  399.  
  400.     procedure Delete( this : in out A_Visibility_Action ); 
  401.     pragma Postcondition( this = null ); 
  402.  
  403.     ---------------------------------------------------------------------------- 
  404.  
  405.     -- Enumeration for specifying the corner of a widget. 
  406.     type Widget_Corner_Type is (Widget_Top_Left,    Widget_Top_Right, 
  407.                                 Widget_Bottom_Left, Widget_Bottom_Right); 
  408.  
  409.     ---------------------------------------------------------------------------- 
  410.  
  411.     type Game_View2 is tagged null record; 
  412.     type A_Game_View2 is access all Game_View2'Class; 
  413.     pragma No_Strict_Aliasing( A_Game_View2 ); 
  414.  
  415.     type Widget is abstract new Object with 
  416.         record 
  417.             view         : A_Game_View2;        -- widget's game view 
  418.             id           : Unbounded_String;    -- unique id of the instance 
  419.             registered   : Boolean := False;    -- successfully added to registry 
  420.             parent       : A_Widget := null;    -- parent/containing widget 
  421.             bmp,                                -- the widget's display bitmap (width x height) 
  422.             drawbmp      : A_Bitmap := null;    -- the bitmap for drawing (view width x view height) 
  423.             dirty        : Boolean := True;     -- flag for redrawing contents 
  424.             x1, y1,                             -- offset of viewport from top 
  425.             x2, y2,                             --   left of parent's content area 
  426.             vx1, vy1,                           -- offset of viewport from top 
  427.             vx2, vy2     : Integer := 0;        --   left of own content area 
  428.             cwidth,                             -- width of the content area 
  429.             cheight      : Natural := 0;        -- height of the content area 
  430.             minWidth,                           -- overrides minimum width if > 0 
  431.             minHeight    : Natural := 0;        -- overrides minimum height if > 0 
  432.             zoom         : Float := 1.0;        -- >1 is bigger 
  433.                                                 -- zoom = (x2-x1)/(vx2-vx1) or 
  434.                                                 --        (y2-y1)/(vy2-vy1) 
  435.             zoomable     : Boolean := True;     -- widget can be zoomed in/out 
  436.             layout       : A_Layout := null; 
  437.             visible      : Boolean := False;    -- widget is visible 
  438.             enabled      : Boolean := True;     -- user interaction allowed 
  439.             hover        : Boolean := False;    -- mouse is over widget 
  440.             pressed      : Boolean := False;    -- mouse LB is pressed on widget 
  441.             acceptFocus  : Boolean := True;     -- widget accepts focus 
  442.             focused      : Boolean := False;    -- widget is focused 
  443.             colors       : Colors_Array := Colors_Array'(others => 0); 
  444.             border       : Border_Type := Border_None; 
  445.             transparent  : Boolean := False;    -- widget is partly transparent 
  446.             attrs        : A_Association := null;   -- map of additional attributes 
  447.             listeners    : Listener_Maps.Map;   -- listeners registered to 
  448.                                                 --   receive widget actions 
  449.             nextId,                             -- widget to focus on Tab key 
  450.             prevId       : Unbounded_String;    -- widget to focus on Shift+Tab 
  451.  
  452.             fontName     : Unbounded_String := To_Unbounded_String( DEFAULT_FONT_NAME ); 
  453.             fontSize     : Positive := DEFAULT_FONT_SIZE; 
  454.             fontSmooth   : Boolean := True;     -- smooth fonts (hint) 
  455.         end record; 
  456.  
  457.     -- Returns true if the widget accepts input focus. 
  458.     function Accepts_Focus( this : not null access Widget'Class ) return Boolean; 
  459.  
  460.     -- Activates a popup menu. Corner specifies which corner of the popup to 
  461.     -- place at the given coordinates. Arguments x, y are in widget content 
  462.     -- coordinates. Width and height specify the size of the popup widget. 
  463.     -- Passing zero in either dimension will size the popup to its own reported 
  464.     -- reported minimum. Note that the popup will be a child of the window; thus 
  465.     -- without scaling, the size of the popup will be treated as window content 
  466.     -- coordinates which may be different than this widget. The scale argument 
  467.     -- determines whether or not the given popup size will be scaled from this 
  468.     -- widget's content coordinates to the window's content coordinates. 
  469.     -- 
  470.     -- Example situations for specifying/omitting sizes are as follows: 
  471.     -- Select-enum choices popup : Specify width, omit height, scale 
  472.     -- Pulldown menu             : Omit width and height, no scaling (menubars don't zoom) 
  473.     -- Contextual popup menu     : Omit width and height, no scaling 
  474.     procedure Activate_Popup( this   : access Widget; 
  475.                               popup  : not null A_Widget; 
  476.                               corner : Widget_Corner_Type; 
  477.                               x, y   : Integer; 
  478.                               width  : Natural := 0; 
  479.                               height : Natural := 0; 
  480.                               scale  : Boolean := False ); 
  481.  
  482.     -- Registers an action listener. Argument 'listenerType' is the string name 
  483.     -- of the exact listener interface to register the listener as, for exmaple 
  484.     -- "Button_Listener" to register the action listener for button actions. 
  485.     procedure Add_Listener( this         : not null access Widget'Class; 
  486.                             listenerType : String; 
  487.                             listener     : not null A_Action_Listener ); 
  488.     pragma Precondition( listenerType'Length > 0 ); 
  489.  
  490.     -- Raises COPY_NOT_ALLOWED. 
  491.     procedure Adjust( this : access Widget ); 
  492.  
  493.     -- Brings this widget and its ancestors of the front. 
  494.     procedure Bring_To_Front( this : access Widget ); 
  495.  
  496.     -- Raises DUPLICATE_ID exception if 'id' has already been registered with 
  497.     -- the widget's view. Widget id strings must be unique per view. 
  498.     procedure Construct( this : access Widget; 
  499.                          view : not null access Game_Views.Game_View'Class; 
  500.                          id   : String ); 
  501.     pragma Precondition( id'Length > 0 ); 
  502.  
  503.     -- Deactivates the a popup menu by popping popups from the window until the 
  504.     -- given popup has been deactivated. If the given popup menu isn't active, 
  505.     -- nothing will happen. 
  506.     procedure Deactivate_Popup( this : access Widget; popup : not null A_Widget ); 
  507.  
  508.     procedure Delete( this : in out Widget ); 
  509.  
  510.     -- Dispatches a visibility action to the widget's listeners. 
  511.     procedure Dispatch_Visibility_Action( this    : not null access Widget'Class; 
  512.                                           visible : Boolean ); 
  513.  
  514.     -- Dispatches a key action to the widget's listeners. Returns True if the 
  515.     -- key action was handled by a listener. 
  516.     function Dispatch_Key_Action( this      : not null access Widget'Class; 
  517.                                   id        : Action_Id; 
  518.                                   key       : Integer; 
  519.                                   modifiers : Modifiers_Array ) return Boolean; 
  520.  
  521.     -- Returns the widget containing the given screen coordinates (coordinates 
  522.     -- relative to the widget's viewport), and the widget coordinates that x,y 
  523.     -- map to within the found widget's content area. 
  524.     procedure Find_Widget( this   : access Widget; 
  525.                            x, y   : Integer; 
  526.                            wx, wy : out Integer; 
  527.                            found  : out A_Widget ); 
  528.  
  529.     -- Returns the height of the widget's content. 
  530.     function Get_Content_Height( this : not null access Widget'Class ) return Natural; 
  531.  
  532.     -- Returns the width of the widget's content. 
  533.     function Get_Content_Width( this : not null access Widget'Class ) return Natural; 
  534.  
  535.     -- Returns the minimum allowable height for this widget based on its 
  536.     -- content. 
  537.     function Get_Min_Height( this : access Widget ) return Natural; 
  538.  
  539.     -- Returns the minimum allowable width for this widget based on its content. 
  540.     function Get_Min_Width( this : access Widget ) return Natural; 
  541.  
  542.     -- Returns the widget's visible drawing area in widget coordinates. 
  543.     procedure Get_Viewport( this   : not null access Widget'Class; 
  544.                             x1, y1, 
  545.                             x2, y2 : out Integer ); 
  546.  
  547.     -- Returns the window containing this widget. If the widget does not have a 
  548.     -- window yet then null will be returned. 
  549.     function Get_Window( this : access Widget 
  550.                        ) return access Widgets.Containers.Windows.Window'Class; 
  551.  
  552.     -- Override this procedure to handle mouse click events. 
  553.     procedure Handle_Click( this : access Widget; 
  554.                             evt  : not null A_Mouse_Button_Event ); 
  555.  
  556.     -- Override ths procedure to handle lost focus events. 
  557.     procedure Handle_Blur( this : access Widget ); 
  558.  
  559.     -- This is called on a visible widget when it, or an ancestor, becomes 
  560.     -- hidden, in order to notify this widget's visibility listeners and those 
  561.     -- of its visible children, if any. 
  562.     procedure Handle_Ancestor_Hidden( this : access Widget ); 
  563.  
  564.     -- This is called on a hidden widget when it, or an ancestor, becomes 
  565.     -- visible, in order to notify this widget's visibility listeners and those 
  566.     -- of its visible children, if any. 
  567.     procedure Handle_Ancestor_Unhidden( this : access Widget ); 
  568.  
  569.     -- This is called when a previously visible widget becomes hidden. This 
  570.     -- should be handled by the root widget (window) appropriately. 
  571.     procedure Handle_Descendant_Hidden( this       : access Widget; 
  572.                                         descendant : not null A_Widget ); 
  573.  
  574.     -- Override this procedure to handle mouse enter events. 
  575.     procedure Handle_Enter( this : access Widget ); 
  576.  
  577.     -- Override this procedure to handle mouse exit events. 
  578.     procedure Handle_Exit( this : access Widget ); 
  579.  
  580.     -- Override this procedure to handle received focus events. 
  581.     procedure Handle_Focus( this : access Widget ); 
  582.  
  583.     -- Override this function to handle key held events. 
  584.     function Handle_Key_Held( this : access Widget; 
  585.                               evt  : not null A_Key_Event ) return Boolean; 
  586.  
  587.     -- Override this function to handle key press events. 
  588.     function Handle_Key_Press( this : access Widget; 
  589.                                evt  : not null A_Key_Event ) return Boolean; 
  590.  
  591.     -- Override this function to handle key release events. 
  592.     function Handle_Key_Release( this : access Widget; 
  593.                                  evt  : not null A_Key_Event ) return Boolean; 
  594.  
  595.     -- Override this function to handle mouse held events. 
  596.     procedure Handle_Mouse_Held( this : access Widget; 
  597.                                  evt  : not null A_Mouse_Button_Event ); 
  598.  
  599.     -- Override this function to handle mouse move events. 
  600.     procedure Handle_Mouse_Move( this : access Widget; 
  601.                                  evt  : not null A_Mouse_Event ); 
  602.  
  603.     -- Override this procedure to handle mouse press events. 
  604.     procedure Handle_Mouse_Press( this : access Widget; 
  605.                                   evt  : not null A_Mouse_Button_Event ); 
  606.  
  607.     -- Override this procedure to handle mouse click events. 
  608.     procedure Handle_Mouse_Release( this : access Widget; 
  609.                                     evt  : not null A_Mouse_Button_Event ); 
  610.  
  611.     -- Override this procedure to handle mouse scrollwheel events. 
  612.     function Handle_Mouse_Scroll( this : access Widget; 
  613.                                   evt  : not null A_Mouse_Scroll_Event ) return Boolean; 
  614.  
  615.     -- This is called when Pack changes the size of the widget's viewport. 
  616.     procedure Handle_Resize( this : access Widget ); 
  617.  
  618.     -- This is called when a previously hidden widget becomes visible. This 
  619.     -- should be handled by the root widget (window) appropriately. 
  620.     procedure Handle_Descendant_Unhidden( this       : access Widget; 
  621.                                           descendant : not null A_Widget ); 
  622.  
  623.     -- Checks if the widget is a descendent of the given widget. 
  624.     function Is_Descendant_Of( this     : not null access Widget'Class; 
  625.                                ancestor : A_Widget ) return Boolean; 
  626.  
  627.     -- Iterate through the list of action listeners registered for a specific 
  628.     -- action type. 
  629.     procedure Iterate_Listeners( this         : not null access Widget'Class; 
  630.                                  listenerType : String; 
  631.                                  examine      : not null access procedure( listener : A_Action_Listener ) ); 
  632.     pragma Precondition( listenerType'Length > 0 ); 
  633.  
  634.     procedure Pack( this : access Widget ); 
  635.  
  636.     -- Adds an action listener to the front of the listener list for the given 
  637.     -- type of listener. The listener will be the first to be notified of an 
  638.     -- action (until another listener of the same type is prepended). 
  639.     procedure Prepend_Listener( this         : not null access Widget'Class; 
  640.                                 listenerType : String; 
  641.                                 listener     : not null A_Action_Listener ); 
  642.     pragma Precondition( listenerType'Length > 0 ); 
  643.  
  644.     -- Unregisters an action listener for receiving actions of the given type. 
  645.     procedure Remove_Listener( this         : not null access Widget'Class; 
  646.                                listenerType : String; 
  647.                                listener     : not null A_Action_Listener ); 
  648.     pragma Precondition( listenerType'Length > 0 ); 
  649.  
  650.     -- Sets a generic attribute on the widget. Attributes are used for 
  651.     -- encapsulating minor additional data without extending a widget class. 
  652.     -- 'val' is consumed. 
  653.     procedure Set_Attribute( this  : not null access Widget'Class; 
  654.                              name  : String; 
  655.                              val   : in out A_Value ); 
  656.     pragma Precondition( name'Length > 0 ); 
  657.     pragma Postcondition( val = null ); 
  658.  
  659.     -- Marks the widget as dirty, causing it to refresh its contents on the next 
  660.     -- redraw. 
  661.     procedure Set_Dirty( this : access Widget ); 
  662.  
  663.     procedure Set_Layout( this   : not null access Widget'Class; 
  664.                           layout : in out A_Layout ); 
  665.     pragma Postcondition( layout = null ); 
  666.  
  667.     -- Sets a widget as the parent of this. 
  668.     procedure Set_Parent( this : access Widget; parent : A_Widget ); 
  669.  
  670.     -- Returns a string representation of the widget. 
  671.     function To_String( this : access Widget ) return String; 
  672.  
  673.     -- Translates screen coordinates into the widget's content coodinates. 
  674.     procedure Translate_To_Content( this   : access Widget; 
  675.                                     sx, sy : Integer; 
  676.                                     cx, cy : out Integer ); 
  677.  
  678.     -- Translates the widget's content coordinates into window coordinates. 
  679.     procedure Translate_To_Window( this   : access Widget; 
  680.                                    cx, cy : Integer; 
  681.                                    wx, wy : out Integer ); 
  682.  
  683.     -- Deletes the Widget. 
  684.     procedure Delete( this : in out A_Widget ); 
  685.     pragma Postcondition( this = null ); 
  686.  
  687.     function Lt( l, r : A_Widget ) return Boolean; 
  688.  
  689. end Widgets;