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