with Actions; use Actions;
with Allegro.Bitmaps; use Allegro.Bitmaps;
with Allegro.Truecolor; use Allegro.Truecolor;
with Drawing_Contexts; use Drawing_Contexts;
with Events.Input; use Events.Input;
with Keyboard; use Keyboard;
with Objects; use Objects;
with Processes; use Processes;
with Themes; use Themes;
limited with Game_Views;
private with Ada.Containers.Doubly_Linked_Lists;
private with Ada.Containers.Indefinite_Hashed_Maps;
private with Ada.Strings.Hash_Case_Insensitive;
private with Ada.Strings.Equal_Case_Insensitive;
private with Ada.Strings.Unbounded;
private with Associations;
private with Values;
limited private with Widgets.Containers.Windows;
pragma Elaborate_All( Actions );
package Widgets is
-- Represents a widget action involving a keyboard key, such as a key press
-- or release.
type Key_Action is new Action with private;
type A_Key_Action is access all Key_Action'Class;
Key_Press : constant Action_Id; -- key pressed down
Key_Held : constant Action_Id; -- key held for the key repeat delay
Key_Release : constant Action_Id; -- key released
-- Returns the scancode of the key involved in the action.
function Get_Key( this : not null access Key_Action'Class ) return Integer;
-- Returns the state of all modifier keys at the time of the action.
function Get_Modifiers( this : not null access Key_Action'Class ) return Modifiers_Array;
-- This is the interface to implement in order to listen to key actions.
-- When a key action occurs, the listener will be notified of the type of
-- action performed and the widget that received the key action.
type Key_Listener is limited interface and Action_Listener;
type A_Key_Listener is access all Key_Listener'Class;
-- Handles the key action 'action'. If 'handled' returns True, the action
-- will not be propagated to the next registered listener.
procedure Handle_Action( this : access Key_Listener;
action : A_Key_Action;
handled : out Boolean ) is abstract;
-- A simple procedure to handle a key action, used by Simple_Key_Listener.
type A_Key_Handler is
access procedure( action : A_Key_Action;
handled : out Boolean );
----------------------------------------------------------------------------
-- Represents a widget resize or move action.
type Resize_Action is new Action with private;
type A_Resize_Action is access all Resize_Action'Class;
Widget_Resized : constant Action_Id; -- resized/moved
-- This is the interface to implement in order to listen to resize actions.
-- When a resize action occurs, the listener will be notified of the source
-- widget's content size changed.
type Resize_Listener is limited interface and Action_Listener;
type A_Resize_Listener is access all Resize_Listener'Class;
-- Handles the resize action 'action'.
procedure Handle_Action( this : access Resize_Listener;
action : A_Resize_Action ) is abstract;
----------------------------------------------------------------------------
-- Represents a change in the widget's visability state, either directly or
-- indirectly via a change in an ancestor's visability.
type Visibility_Action is new Action with private;
type A_Visibility_Action is access all Visibility_Action'Class;
Change_Visibility : constant Action_Id; -- visibility changed
-- Returns True if the source widget is now visible.
function Is_Visible( this : not null access Visibility_Action'Class ) return Boolean;
-- Implement this interface to receive notifications when a widget's
-- visibility changes.
type Visibility_Listener is limited interface and Action_Listener;
type A_Visibility_Listener is access all Visibility_Listener'Class;
-- Handles the visibility action 'action'.
procedure Handle_Action( this : access Visibility_Listener;
action : A_Visibility_Action ) is abstract;
----------------------------------------------------------------------------
-- Implement the Animated interface to automatically run a widget as a
-- process when it's visible. Animated extends Process, so the implementor
-- must have a Tick procedure that will be automatically called. The widget
-- subclass does not need to attach itself to a Process_Manager; that is
-- handled automatically.
type Animated is limited interface and Process;
----------------------------------------------------------------------------
-- A Widget is the most basic component of the GUI. A widget represents a
-- control element, display element, or container in the interface. Widgets
-- are organized as a tree, ultimately rooted at a Window widget, with each
-- widget having one parent. Widgets are part of an event-based interface
-- model, where Action_Listeners listen for and handle Actions that are
-- generated by widgets when a change occurs or input is received.
type Widget is abstract new Limited_Object with private;
type A_Widget is access all Widget'Class;
-- Adds an object as a listener for key actions, such as press, release
-- and held actions.
procedure Add_Listener( this : not null access Widget'Class;
listener : not null A_Key_Listener );
-- Adds the handler procedure as a simple listener. The listener can't be
-- removed and can be added multiple times.
procedure Add_Listener( this : not null access Widget'Class;
key : Integer;
modifiers : Modifiers_Pattern;
handler : not null A_Key_Handler );
-- Adds the handler procedure as a simple listener. The listener can't be
-- removed and can be added multiple times. The key modifiers will match any
-- combination so this procedure is equivalent to calling Add_Listener with
-- modifiers => MODIFIERS_ANY.
procedure Add_Listener( this : not null access Widget'Class;
key : Integer;
handler : not null A_Key_Handler );
-- Adds an object as a listener for resize actions. Resize listeners are
-- notified when the widget's content size changes.
procedure Add_Listener( this : not null access Widget'Class;
listener : not null A_Resize_Listener );
-- Adds an object as a listener for visibility actions. Visibility listeners
-- are notified when the widget becomes visible or hidden.
procedure Add_Listener( this : not null access Widget'Class;
listener : not null A_Visibility_Listener );
-- Draws the widget and children to bmp, redrawing contents if necessary
procedure Draw( this : access Widget; bmp : not null A_Bitmap; x, y : Integer );
-- Returns the value of the specified attribute as an integer. If the
-- attribute is not an integer, it will be converted. If the attribute does
-- not exist or can not be converted then VALUE_NOT_FOUND or
-- INVALID_CONVERSION will be raised, respectively.
function Get_Attribute( this : not null access Widget'Class;
name : String ) return Integer;
pragma Precondition( name'Length > 0 );
-- Returns the value of the specified attribute as a string. If the
-- attribute is not an string, it will be converted. If the attribute does
-- not exist or can not be converted then VALUE_NOT_FOUND or
-- INVALID_CONVERSION will be raised, respectively.
function Get_Attribute( this : not null access Widget'Class;
name : String ) return String;
pragma Precondition( name'Length > 0 );
-- Returns the widget's drawn border type
function Get_Border( this : not null access Widget'Class ) return Border_Type;
-- Returns the color used by the widget for a specific purpose. Not all
-- color purposes apply to every widget.
function Get_Color( this : access Widget; purpose : Color_Purpose ) return Color_Type;
-- Returns the name of the widget's font.
function Get_Font_Name( this : not null access Widget'Class ) return String;
-- Returns the point size of the widget's font.
function Get_Font_Size( this : not null access Widget'Class ) return Positive;
-- Returns the screen height of the widget (height of the viewport)
function Get_Height( this : not null access Widget'Class ) return Integer;
-- Returns the unique id of the widget
function Get_Id( this : not null access Widget'Class ) return String;
pragma Postcondition( Get_Id'Result'Length > 0 );
-- Returns the view controlling this widget.
function Get_View( this : access Widget ) return access Game_Views.Game_View'Class;
-- Returns the screen width of the widget (width of the viewport).
function Get_Width( this : not null access Widget'Class ) return Natural;
-- Returns the zoom factor of the widget. Numbers greater than one mean the
-- view of the widget is zoomed in.
function Get_Zoom( this : not null access Widget'Class ) return Float;
-- Returns true if the widget is current enabled.
function Is_Enabled( this : not null access Widget'Class ) return Boolean;
-- Returns true if the widget is currently visible.
function Is_Visible( this : not null access Widget'Class ) return Boolean;
-- Moves the widget within its parent's content region.
procedure Move( this : not null access Widget'Class; xdist, ydist : Integer );
-- Moves the widget to an absolute location with its parent's content
-- region. The top left of the widget is positioned at x, y.
procedure Move_To( this : not null access Widget'Class; x, y : Integer );
-- Unregisters 'listener' as a key action listener.
procedure Remove_Listener( this : not null access Widget'Class;
listener : not null A_Key_Listener );
-- Unregisters 'listener' as a resize action listener.
procedure Remove_Listener( this : not null access Widget'Class;
listener : not null A_Resize_Listener );
-- Unregisters 'listener' as a visibility action listener.
procedure Remove_Listener( this : not null access Widget'Class;
listener : not null A_Visibility_Listener );
-- Forces the widget to redraw itself on the next frame.
procedure Redraw( this : not null access Widget'Class );
-- Scrolls the widget's viewport, if possible, by the given x, y distances.
-- The positive scroll direction is down and to the right.
procedure Scroll( this : not null access Widget'Class; x, y : Integer );
-- Scrolls the widget's viewport by moving the top left corner to the given
-- location.
procedure Scroll_To( this : not null access Widget'Class; x, y : Integer );
-- Sets an integer attribute on the widget. Attributes are used for
-- encapsulating minor additional data without extending a widget class.
procedure Set_Attribute( this : not null access Widget'Class;
name : String;
val : Integer );
pragma Precondition( name'Length > 0 );
-- Sets a string attribute on the widget. Attributes are used for
-- encapsulating minor additional data without extending a widget class.
procedure Set_Attribute( this : not null access Widget'Class;
name : String;
val : String );
pragma Precondition( name'Length > 0 );
-- Sets the border for the widget, if it uses one.
procedure Set_Border( this : not null access Widget'Class;
border : Border_Type );
-- Sets the color used by the widget for a specific purpose. Not all color
-- purposes apply to every widget.
procedure Set_Color( this : access Widget;
purpose : Color_Purpose;
color : Color_Type );
-- Sets whether the widget is enabled or not. If not enabled, the widget
-- will ignore all user interaction. If a widget is disabled, all of its
-- children are also implicitly disabled.
procedure Set_Enabled( this : not null access Widget'Class; enabled : Boolean );
-- Sets whether the widget can accept focus.
procedure Set_Focusable( this : not null access Widget'Class;
focusable : Boolean );
-- Sets the widget's focused state. This does not focus the widget. It
-- should be called only by a Window widget.
procedure Set_Focused( this : not null access Widget'Class; focused : Boolean );
-- Sets the widget's font name and/or size.
procedure Set_Font( this : not null access Widget'Class;
name : String := "";
size : Natural := 0 );
-- Sets the widget's layout as centered within the parent's content area,
-- given the viewport size.
procedure Set_Layout_Center( this : not null access Widget'Class;
width,
height : Natural );
-- Sets the widget's layout as centered horizontally and spaced from the top
-- and bottom of the parent's content area like layout LTRB.
procedure Set_Layout_CenterH( this : not null access Widget'Class;
width : Natural;
top,
bottom : Integer );
-- Sets the widget's layout as centered horizontally and positioned
-- absolutely in the vertical dimension. y1 and y2 are both distances from
-- the top of the parent's content region. Negative values will position
-- the widget off the top edge of the parent's content.
procedure Set_Layout_CenterHY( this : not null access Widget'Class;
width : Natural;
y1, y2 : Integer );
-- Sets the widget's layout based on the distance of the viewport's edges
-- from the edges of the parent's content area.
procedure Set_Layout_LTRB( this : not null access Widget'Class;
left,
top,
right,
bottom : Integer );
-- Sets the widget's layout based on a size and distance from the top left
-- edges of the parent's content area. If top or left is negative then the
-- top left corner of the widget will be positioned relative to the bottom
-- or right edge of the content area. If width or height is 0 then the
-- widget's minimum width or height will be used instead.
procedure Set_Layout_LTWH( this : not null access Widget'Class;
left,
top : Integer;
width,
height : Natural );
-- Sets the widget's layout based on a size and absolute distance from the
-- top left corner of the parent's content area. This layout is nearly
-- identical to LTWH except negative values for 'x' and 'y' are kept
-- relative to the upper left. If width or height is 0 then the
-- widget's minimum width or height will be used instead.
procedure Set_Layout_XYWH( this : not null access Widget'Class;
x, y : Integer;
width,
height : Natural );
-- Sets the minimum height value to override the computed minimum height
-- for the widget. If height is set to zero, the computed value is returned
-- by Get_Min_Height.
procedure Set_Min_Height( this : not null access Widget'Class;
height : Natural );
-- Sets the minimum width value to override the computed minimum width
-- for the widget. If width is set to zero, the computed value is returned
-- by Get_Min_Width.
procedure Set_Min_Width( this : not null access Widget'Class;
width : Natural );
-- Sets the next widget to receive focus when tab is pressed on this widget.
procedure Set_Next( this : not null access Widget'Class; id : String );
-- Sets the next widget to receive focus when shift + tab is pressed on this
-- widget.
procedure Set_Prev( this : not null access Widget'Class; id : String );
-- Set to true if the widget is partly transparent so that it will be drawn
-- over the background.
procedure Set_Transparent( this : not null access Widget'Class;
transparent : Boolean );
-- Sets whether the widget is visible.
procedure Set_Visible( this : not null access Widget'Class; visible : Boolean );
-- Sets the zoom factor. Values > 1 make the contents larger and values < 1
-- make the contents smaller. This does not affect the screen size of the
-- widget; Increasing the zoom decreases the visible content area.
procedure Set_Zoom( this : access Widget; zoom : Float );
-- Enable/disable font smoothing if the widget draws text. This is only a
-- hint; it can be used to disable font smoothing, but font smoothing can
-- only work if the conditions support it (type of font, transparency, etc.)
-- Smooth fonts are enabled by default.
procedure Smooth_Text( this : not null access Widget'Class; enabled : Boolean );
-- Deletes the Widget and all children.
procedure Delete( this : in out A_Widget );
pragma Postcondition( this = null );
private
use Ada.Strings.Unbounded;
use Associations;
use Values;
----------------------------------------------------------------------------
-- A Simple_Action_Listener is the abstract superclass for light-weight
-- action listener objects. A simple listener allows action-specific
-- procedures to be registered with a widget as action listeners, in
-- addition to full Action_Listener objects.
type Simple_Action_Listener is abstract new Object with null record;
----------------------------------------------------------------------------
-- A layout is a decorator that determines a child widget's size and
-- position within its parent container.
type Layout is abstract new Object with null record;
type A_Layout is access all Layout'Class;
-- Raises Constraint_Error because this is an abstract procedure that should
-- not be directly called. This procedure isn't officially declared abstract
-- so that the Layout class can remain in the private section.
procedure Apply( this : access Layout; widget : not null A_Widget );
----------------------------------------------------------------------------
-- provides a list of Action_Listeners
package Action_Listeners is new Ada.Containers.Doubly_Linked_Lists( A_Action_Listener, "=" );
use Action_Listeners;
-- maps Action_Id strings to lists of Action_Listeners; case insensitive
package Listener_Maps is new
Ada.Containers.Indefinite_Hashed_Maps( String, Action_Listeners.List,
Ada.Strings.Hash_Case_Insensitive,
Ada.Strings.Equal_Case_Insensitive,
Action_Listeners."=" );
use Listener_Maps;
----------------------------------------------------------------------------
Key_Press : constant Action_Id := To_Action_Id( "key.press" );
Key_Held : constant Action_Id := To_Action_Id( "key.held" );
Key_Release : constant Action_Id := To_Action_Id( "key.release" );
type Key_Action is new Action with
record
key : Integer;
modifiers : Modifiers_Array;
end record;
procedure Construct( this : access Key_Action;
id : Action_Id;
source : not null A_Widget;
key : Integer;
modifiers : Modifiers_Array );
-- Deletes a Key_Action.
procedure Delete( this : in out A_Key_Action );
pragma Postcondition( this = null );
----------------------------------------------------------------------------
-- A Simple_Key_Listener is an adapter class that listens for Key_Action
-- events and invokes a callback, A_Key_Handler, if the action matches
-- criteria provided at construction. This allows callback procedures to
-- handle key actions instead of requiring an object to do so.
type Simple_Key_Listener is new Simple_Action_Listener and Key_Listener with
record
key : Integer;
modifiers : Modifiers_Pattern;
handler : A_Key_Handler := null;
end record;
type A_Simple_Key_Listener is access all Simple_Key_Listener'Class;
-- Creates a Simple_Key_Listener that invokes 'handler' when it receives a
-- key action for 'key' with matching 'modifiers'.
function Create_Listener( key : Integer;
modifiers : Modifiers_Pattern;
handler : not null A_Key_Handler
) return A_Key_Listener;
pragma Postcondition( Create_Listener'Result /= null );
procedure Construct( this : access Simple_Key_Listener;
key : Integer;
modifiers : Modifiers_Pattern;
handler : not null A_Key_Handler );
-- Invokes the simple key listener's Key_Handler procedure if the key action
-- matches the listener's criteria provided at construction.
procedure Handle_Action( this : access Simple_Key_Listener;
action : A_Key_Action;
handled : out Boolean );
----------------------------------------------------------------------------
Widget_Resized : constant Action_Id := To_Action_Id( "widget.resized" );
type Resize_Action is new Action with null record;
-- Deletes the Resize_Action.
procedure Delete( this : in out A_Resize_Action );
pragma Postcondition( this = null );
----------------------------------------------------------------------------
Change_Visibility : constant Action_Id := To_Action_Id( "visibility.changed" );
type Visibility_Action is new Action with
record
visible : Boolean;
end record;
procedure Construct( this : access Visibility_Action;
id : Action_Id;
source : not null A_Widget;
visible : Boolean );
-- Deletes the Visibility_Action.
procedure Delete( this : in out A_Visibility_Action );
pragma Postcondition( this = null );
----------------------------------------------------------------------------
-- Enumeration for specifying the corner of a widget
type Widget_Corner_Type is (Widget_Top_Left, Widget_Top_Right,
Widget_Bottom_Left, Widget_Bottom_Right);
----------------------------------------------------------------------------
-- A dummy class-wide access type to use for the 'view' field, that really
-- points to a Game_View object. This is a workaround for a 6.4 compiler
-- issue, where the compiler crashes if 'view' is an anonymous access type
-- to Game_View'Class. Fix this in the future.
type Game_View2 is tagged null record;
type A_Game_View2 is access all Game_View2'Class;
pragma No_Strict_Aliasing( A_Game_View2 );
type Widget is abstract new Limited_Object with
record
view : A_Game_View2; -- widget's game view
id : Unbounded_String; -- unique id of the instance
registered : Boolean := False; -- successfully added to registry
parent : A_Widget := null; -- parent/containing widget
bmp, -- the widget's display bitmap (width x height)
drawbmp : A_Bitmap := null; -- the bitmap for drawing (view width x view height)
dirty : Boolean := True; -- flag for redrawing contents
x1, y1, -- offset of viewport from top
x2, y2, -- left of parent's content area
vx1, vy1, -- offset of viewport from top
vx2, vy2 : Integer := 0; -- left of own content area
cwidth, -- width of the content area
cheight : Natural := 0; -- height of the content area
minWidth, -- overrides minimum width if > 0
minHeight : Natural := 0; -- overrides minimum height if > 0
zoom : Float := 1.0; -- >1 is bigger
-- zoom = (x2-x1)/(vx2-vx1) or
-- (y2-y1)/(vy2-vy1)
zoomable : Boolean := True; -- widget can be zoomed in/out
layout : A_Layout := null;
visible : Boolean := False; -- widget is visible
enabled : Boolean := True; -- user interaction allowed
hover : Boolean := False; -- mouse is over widget
pressed : Boolean := False; -- mouse LB is pressed on widget
acceptFocus : Boolean := True; -- widget accepts focus
focused : Boolean := False; -- widget is focused
colors : Colors_Array := Colors_Array'(others => 0);
border : Border_Type := Border_None;
transparent : Boolean := False; -- widget is partly transparent
attrs : A_Association := null; -- map of additional attributes
listeners : Listener_Maps.Map; -- listeners registered to
-- receive widget actions
nextId, -- widget to focus on Tab key
prevId : Unbounded_String; -- widget to focus on Shift+Tab
fontName : Unbounded_String := To_Unbounded_String( DEFAULT_FONT_NAME );
fontSize : Positive := DEFAULT_FONT_SIZE;
fontSmooth : Boolean := True; -- smooth fonts (hint)
end record;
-- Returns true if the widget accepts input focus.
function Accepts_Focus( this : not null access Widget'Class ) return Boolean;
-- Activates a popup menu. Corner specifies which corner of the popup to
-- place at the given coordinates. Arguments x, y are in widget content
-- coordinates. Width and height specify the size of the popup widget.
-- Passing zero in either dimension will size the popup to its own reported
-- reported minimum. Note that the popup will be a child of the window; thus
-- without scaling, the size of the popup will be treated as window content
-- coordinates which may be different than this widget. The scale argument
-- determines whether or not the given popup size will be scaled from this
-- widget's content coordinates to the window's content coordinates.
--
-- Example situations for specifying/omitting sizes are as follows:
-- Select-enum choices popup : Specify width, omit height, scale
-- Pulldown menu : Omit width and height, no scaling (menubars don't zoom)
-- Contextual popup menu : Omit width and height, no scaling
procedure Activate_Popup( this : access Widget;
popup : not null A_Widget;
corner : Widget_Corner_Type;
x, y : Integer;
width : Natural := 0;
height : Natural := 0;
scale : Boolean := False );
-- Registers an action listener. Argument 'listenerType' is the string name
-- of the exact listener interface to register the listener as, for example
-- "Button_Listener" to register the action listener for button actions.
procedure Add_Listener( this : not null access Widget'Class;
listenerType : String;
listener : not null A_Action_Listener );
pragma Precondition( listenerType'Length > 0 );
-- Brings this widget and its ancestors of the front.
procedure Bring_To_Front( this : access Widget );
-- Raises DUPLICATE_ID exception if 'id' has already been registered with
-- the widget's view. Widget id strings must be unique per view.
procedure Construct( this : access Widget;
view : not null access Game_Views.Game_View'Class;
id : String );
pragma Precondition( id'Length > 0 );
-- Deactivates the popup menu by popping popups from the window until the
-- given popup has been deactivated. If the given popup menu isn't active,
-- nothing will happen.
procedure Deactivate_Popup( this : not null access Widget'Class; popup : not null A_Widget );
procedure Delete( this : in out Widget );
-- Dispatches a key action to the widget's listeners. Returns True if the
-- key action was handled by a listener.
function Dispatch_Key_Action( this : not null access Widget'Class;
id : Action_Id;
key : Integer;
modifiers : Modifiers_Array ) return Boolean;
-- Dispatches a resize action to the widget's listeners to notify them that
-- a resize occurred.
procedure Dispatch_Resize_Action( this : not null access Widget'Class );
-- Dispatches a visibility action to the widget's listeners.
procedure Dispatch_Visibility_Action( this : not null access Widget'Class;
visible : Boolean );
-- Draws the widget content within the viewport. This procedure must be
-- overridden.
procedure Draw_Content( this : access Widget; dc : Drawing_Context ) is null;
-- Returns the widget containing the given screen coordinates (coordinates
-- relative to the widget's viewport), and the widget coordinates that x,y
-- map to within the found widget's content area.
procedure Find_Widget( this : access Widget;
x, y : Integer;
wx, wy : out Integer;
found : out A_Widget );
-- Attempts to focus the previous widget, or if it's disabled, its
-- previous. Returns True if a previous widget was focused.
function Focus_Prev( this : not null access Widget'Class ) return Boolean;
-- Attempts to focus the next widget, or if it's disabled- its next.
-- Returns True if a next widget was focused.
function Focus_Next( this : not null access Widget'Class ) return Boolean;
-- Returns the height of the widget's content.
function Get_Content_Height( this : not null access Widget'Class ) return Natural;
-- Returns the width of the widget's content.
function Get_Content_Width( this : not null access Widget'Class ) return Natural;
-- Returns the minimum allowable height for this widget based on its
-- content.
function Get_Min_Height( this : access Widget ) return Natural;
-- Returns the minimum allowable width for this widget based on its content.
function Get_Min_Width( this : access Widget ) return Natural;
-- Returns the To_String representation of the widget as a process name.
-- This is used to provide default behavior in the event that a Widget class
-- implements Animated (and by extension, Process).
function Get_Process_Name( this : access Widget ) return String;
-- Returns the widget's visible drawing area in widget coordinates.
procedure Get_Viewport( this : not null access Widget'Class;
x1, y1,
x2, y2 : out Integer );
-- Returns the window containing this widget. If the widget does not have a
-- window yet then null will be returned.
function Get_Window( this : access Widget
) return access Widgets.Containers.Windows.Window'Class;
-- Override ths procedure to handle lost focus events.
procedure Handle_Blur( this : access Widget ) is null;
-- Override this procedure to handle mouse click events.
procedure Handle_Click( this : access Widget;
evt : not null A_Mouse_Button_Event ) is null;
-- This is called on a visible widget when it, or an ancestor, becomes
-- hidden, in order to notify this widget's visibility listeners and those
-- of its visible children, if any.
procedure Handle_Ancestor_Hidden( this : access Widget );
-- This is called on a hidden widget when it, or an ancestor, becomes
-- visible, in order to notify this widget's visibility listeners and those
-- of its visible children, if any.
procedure Handle_Ancestor_Unhidden( this : access Widget );
-- This is called when a previously visible widget becomes hidden. This
-- should be handled by the root widget (window) appropriately.
procedure Handle_Descendant_Hidden( this : access Widget;
descendant : not null A_Widget );
-- This is called when a previously hidden widget becomes visible. This
-- should be handled by the root widget (window) appropriately.
procedure Handle_Descendant_Unhidden( this : access Widget;
descendant : not null A_Widget );
-- This is called when the widget is directly disabled from an enabled
-- state. Override this function to implement behavior when
-- Set_Enabled( False ) is called on this widget. Note that this is not
-- called when the enabled state of an ancestor changes.
procedure Handle_Disabled( this : access Widget ) is null;
-- This is called when the widget is directly enabled from a disabled state.
-- Override this function to implement behavior when Set_Enabled( True ) is
-- called on this widget. Note that this is not called when the enabled
-- state of an ancestor changes.
procedure Handle_Enabled( this : access Widget ) is null;
-- Override this procedure to handle mouse enter events. This should be
-- called at the start of the overriding procedure.
procedure Handle_Enter( this : access Widget );
-- Override this procedure to handle mouse exit events. This should be
-- called at the start of the overriding procedure.
procedure Handle_Exit( this : access Widget );
-- Override this procedure to handle received focus events.
procedure Handle_Focus( this : access Widget ) is null;
-- Override this procedure to handle the widget becoming visible, taking
-- parent visibility into account. This gets called just before registered
-- Visibility_Listeners are notified. This procedure should be called at
-- the end of the overriding procedure.
procedure Handle_Hidden( this : access Widget );
-- Override this function to handle key held events.
function Handle_Key_Held( this : access Widget;
evt : not null A_Key_Event ) return Boolean;
-- Override this function to handle key press events.
function Handle_Key_Press( this : access Widget;
evt : not null A_Key_Event ) return Boolean;
-- Override this function to handle key release events.
function Handle_Key_Release( this : access Widget;
evt : not null A_Key_Event ) return Boolean;
-- Override this function to handle mouse held events.
procedure Handle_Mouse_Held( this : access Widget;
evt : not null A_Mouse_Button_Event ) is null;
-- Override this function to handle mouse move events.
procedure Handle_Mouse_Move( this : access Widget;
evt : not null A_Mouse_Event ) is null;
-- Override this procedure to handle mouse press events. This should be
-- called at the start of the overriding procedure.
procedure Handle_Mouse_Press( this : access Widget;
evt : not null A_Mouse_Button_Event );
-- Override this procedure to handle mouse click events. This should be
-- called at the start of the overriding procedure.
procedure Handle_Mouse_Release( this : access Widget;
evt : not null A_Mouse_Button_Event );
-- Override this procedure to handle mouse scrollwheel events.
function Handle_Mouse_Scroll( this : access Widget;
evt : not null A_Mouse_Scroll_Event ) return Boolean;
-- This is called when Pack changes the size of the widget's viewport.
procedure Handle_Resize( this : access Widget );
-- Override this procedure to handle the widget going invisible, taking
-- parent visibility into account. This gets called just before registered
-- Visibility_Listeners are notified. This procedure should be called at
-- the start of the overriding procedure.
procedure Handle_Unhidden( this : access Widget );
-- Checks if the widget is a descendent of the given widget.
function Is_Descendant_Of( this : not null access Widget'Class;
ancestor : A_Widget ) return Boolean;
-- Iterate through the list of action listeners registered for a specific
-- action type.
procedure Iterate_Listeners( this : not null access Widget'Class;
listenerType : String;
examine : not null access procedure( listener : A_Action_Listener ) );
pragma Precondition( listenerType'Length > 0 );
-- Packs the widget into its parent container, calculating its size and
-- applying its Layout. This is called after the widget's parent changes
-- (either the parent itself, or just the parent's layout), and when
-- its own layout changes.
procedure Pack( this : access Widget );
-- Adds an action listener to the front of the listener list for the given
-- type of listener. The listener will be the first to be notified of an
-- action (until another listener of the same type is prepended).
procedure Prepend_Listener( this : not null access Widget'Class;
listenerType : String;
listener : not null A_Action_Listener );
pragma Precondition( listenerType'Length > 0 );
-- Unregisters an action listener for receiving actions of the given type.
procedure Remove_Listener( this : not null access Widget'Class;
listenerType : String;
listener : not null A_Action_Listener );
pragma Precondition( listenerType'Length > 0 );
-- Sets a generic attribute on the widget. Attributes are used for
-- encapsulating minor additional data without extending a widget class.
-- 'val' is consumed.
procedure Set_Attribute( this : not null access Widget'Class;
name : String;
val : in out A_Value );
pragma Precondition( name'Length > 0 );
pragma Postcondition( val = null );
-- Marks the widget as dirty, causing it to refresh its contents on the next
-- redraw.
procedure Set_Dirty( this : access Widget );
-- Replaces the widget's current layout, if any, and repacks the parent
-- widget, if this widget has one.
procedure Set_Layout( this : not null access Widget'Class;
layout : in out A_Layout );
pragma Postcondition( layout = null );
-- Sets a widget as the parent of this.
procedure Set_Parent( this : access Widget; parent : A_Widget );
-- Returns a string representation of the widget.
function To_String( this : access Widget ) return String;
-- Translates screen coordinates into the widget's content coodinates.
procedure Translate_To_Content( this : access Widget;
sx, sy : Integer;
cx, cy : out Integer );
-- Translates the widget's content coordinates into window coordinates.
procedure Translate_To_Window( this : access Widget;
cx, cy : Integer;
wx, wy : out Integer );
-- Compares widgets 'l' and 'r' by id; returns True if 'l' is less than 'r'.
function Lt( l, r : A_Widget ) return Boolean;
end Widgets;