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