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