with Scaling; use Scaling;
with Widgets.Menubars; use Widgets.Menubars;
limited with Game_Views;
private with Allegro.Keyboard;
private with Mouse;
package Widgets.Containers.Windows is
-- A Window is the root of the widget tree within the application window.
--
-- All interface input events are delivered to the Window and then
-- dispatched by the Window to its descendent widgets. Widget events are
-- handled in a bottom-up approach, being delivered to the focused widget
-- first and then dispatching up the tree, toward the Window, until the
-- event is captured and handled.
--
-- Input focus, or just "focus", is tracked by the Window. Exactly one
-- widget in the Window tree will have focus at all times. If no other
-- widget is focused, the Window will be focused by default. The focused
-- widget will receive all keyboard events.
type Window is new Container with private;
type A_Window is access all Window'Class;
-- Creates a new Window within 'view'. 'width' and 'height' are the size of
-- the widget. The window can be upscaled to a higher resolution by setting
-- 'scale' > 1 and the upscale filter effect with 'filter'.
function Create_Window( view : access Game_Views.Game_View'Class;
id : String;
width,
height : Natural;
scale : Positive := 1;
filter : Filter_Type := Filter_Nearest
) return A_Window;
pragma Precondition( id'Length > 0 );
pragma Postcondition( Create_Window'Result /= null );
-- Dispatches a mouse click event to the widget that the mouse clicked on.
-- If the button release occurred over a different widget than the press,
-- then the click will be ignored.
procedure Dispatch_Click( this : access Window;
evt : not null A_Mouse_Button_Event );
-- Dispatches a key held event to the focused widget, if the key was pressed
-- after the widget received focus.
function Dispatch_Key_Held( this : access Window;
evt : not null A_Key_Event ) return Boolean;
-- Dispatches a key press event to the focused widget.
function Dispatch_Key_Press( this : access Window;
evt : not null A_Key_Event ) return Boolean;
-- Dispatches a key release event to the widget that received the key press
-- event, regardless of input focus.
function Dispatch_Key_Release( this : access Window;
evt : not null A_Key_Event ) return Boolean;
-- Dispatches a mouse held event to the widget that the mouse was over at
-- the time the mouse button was pressed.
procedure Dispatch_Mouse_Held( this : access Window;
evt : not null A_Mouse_Button_Event );
-- Dispatches a mouse move event. If the mouse is over a different widget
-- than last move then widget exit and widget enter events are dispatched
-- appropriately first.
--
-- If the left mouse button is being held down, a mouse move event is sent
-- to the widget that the mouse was over when the left button was pressed.
-- If the mouse is currently over a widget that isn't the one that the left
-- mouse button was pressed over, then that widget will also receive a mouse
-- move event.
procedure Dispatch_Mouse_Move( this : access Window;
evt : not null A_Mouse_Event );
-- Dispatches a mouse press event to the widget the mouse is currently over.
-- If a popup widget (or stack of popup widgets) is being displayed, then
-- the popup widgets will be popped off the stack and hidden unless they are
-- under the mouse. This allows context menus, etc, to be hidden when the
-- user clicks somewhere else in the Window. If a modal dialog widget is
-- being displayed, then the press will only be dispatched to descendents of
-- the modal widget.
procedure Dispatch_Mouse_Press( this : access Window;
evt : not null A_Mouse_Button_Event );
-- Dispatches a mouse release event to the widget the mouse is over.
procedure Dispatch_Mouse_Release( this : access Window;
evt : not null A_Mouse_Button_Event );
-- Dispatches a scroll wheel event to the widget the mouse is over.
function Dispatch_Mouse_Scroll( this : access Window;
evt : not null A_Mouse_Scroll_Event ) return Boolean;
-- Draws the whole window and all its descendents to 'bmp'. This procedure
-- is used by the renderer to draw the whole screen. The bitmap 'bmp' must
-- be at least (width*scale, height*scale) in size and it can be any kind
-- of bitmap (ie: a system/video bitmap).
procedure Draw( this : access Window; bmp : not null A_Bitmap );
-- Get the scaling factor used when drawing the Window to the screen. A
-- return value of 1 means no upscaling.
function Get_Scale( this : not null access Window'Class ) return Positive;
-- Gives input focus to 'target'. If 'target' doesn't accept focus, then
-- focus will be given to its "next focus" widget (what happens when you
-- press the Tab key). If no "next focus" widget exists or accepts focus,
-- then focus will be given to the widget's nearest ancestor that accepts
-- it. Changing the input focus will prevent any potential key held and key
-- release events from being sent to the old focused widget that received
-- the key press.
procedure Give_Focus( this : access Window; target : not null A_Widget );
-- Pops the top-most widget off the popup stack. If there are no active
-- popup widgets, nothing will happen.
procedure Pop_Popup( this : access Window );
-- Pops all widgets from the popups stack until the given popup widget has
-- been popped. If the widget isn't an active popup menu, nothing will
-- happen.
procedure Pop_Popup( this : access Window; popup : not null A_Widget );
-- Pushes a popup widget onto the top of the popup stack, making it visible.
-- Popups are the highest in the Z-order, so they will be displayed in front
-- of any modal widget, most recent on top. The widget will temporarily
-- become a child of the window while its on the popup stack.
procedure Push_Popup( this : access Window; popup : not null A_Widget );
-- Sets the offset of the top left corner of the window from the top left
-- corner of the screen.
procedure Set_Offset( this : access Window; x, y : Integer );
-- Sets the Window's menu bar widget. The menu bar is optional and there can
-- be only one per Window. 'menu' will be consumed. If a menu bar has
-- already been set, the old one will be deleted.
procedure Set_Menubar( this : access Window; menu : in out A_Menubar );
pragma Postcondition( menu = null );
-- Sets the modal widget drawn on top of all others in the Window. This
-- widget and its descendents will receive all input events or prevent them
-- from being sent to any others, while it is visible. Set 'modal' to null
-- to clear the modal widget. 'modal' will be set visible when it's set and
-- invisible when another modal widget is set or it's unset. The modal
-- modal widget tree will be drawn in front of all other Window children and
-- behind any active popup widgets.
procedure Set_Modal( this : access Window; modal : A_Widget );
-- Sets the title at the top of the application window.
procedure Set_Title( this : access Window; title : String );
-- Deletes the Window.
procedure Delete( this : in out A_Window );
pragma Postcondition( this = null );
private
use Allegro.Keyboard;
use Mouse;
-- an array of widgets by mouse button; used for tracking mouse button
-- history relative to widgets.
type Mouse_Widget_Array is array (Mouse_Button) of A_Widget;
-- an array of widgets by key scancode. used for tracking key history
-- relative to widgets.
type Key_Widget_Array is array (1..KEY_MAX) of A_Widget;
----------------------------------------------------------------------------
type Window is new Container with
record
scale : Positive := 1;
filter : Filter_Type := Filter_Nearest;
scalebmp : A_Bitmap := null;
menu : A_Menubar := null;
mouseOver : A_Widget := null;
mousePressedOn : Mouse_Widget_Array;
mouseClickedOn : Mouse_Widget_Array;
focus : A_Widget := null;
modal : A_Widget := null; -- widget with modality in window
popups : Widget_Lists.List; -- stack of active popup widgets
keyPressSentTo : Key_Widget_Array := Key_Widget_Array'(others=>null);
end record;
procedure Construct( this : access Window;
view : access Game_Views.Game_View'Class;
id : String;
width,
height : Natural;
scale : Positive;
filter : Filter_Type );
pragma Precondition( id'Length > 0 );
procedure Delete( this : in out Window );
-- Dispatches a mouse release event of button 'btn' to the widget on the
-- screen at 'x', 'y'.
procedure Dispatch_Mouse_Release( this : access Window;
x, y : Integer;
btn : Mouse_Button );
-- Draws the Window, all its children, and then the popup widget stack to
-- 'bmp' in back-to-front order with an offset of 'x','y'. The modal widget,
-- if set, will be the front-most child. The popup widgets, if any are
-- active, will still be drawn in front of the modal widget tree and menu
-- bar. 'bmp' should be a memory bitmap only.
procedure Draw( this : access Window; bmp : not null A_Bitmap; x, y : Integer );
-- Draws the window background onto 'dc'.
procedure Draw_Content( this : access Window; dc : Drawing_Context );
-- find a widget at the given screen coordinates (sx, sy) and return the
-- corresponding widget content coordinates if a widget is found (wx, wy).
procedure Find_Widget( this : access Window;
sx, sy : Integer;
wx, wy : out Integer;
found : out A_Widget );
-- Recursively returns the widget's parent Window at the root of its
-- ancestors. The Window widget is always its own window: returns 'this'.
function Get_Window( this : access Window ) return access Window'Class;
-- Handles when 'descendant' becomes hidden. If it was focused then the
-- focus must be transferred to a visible ancestor, etc.
procedure Handle_Descendant_Hidden( this : access Window;
descendant : not null A_Widget );
-- Handles when 'descendent' becomes visible.
procedure Handle_Descendant_Unhidden( this : access Window;
descendant : not null A_Widget );
-- Handles a key press event captured by the Window. This would mean that
-- none of the other ancestors of the focused widget handled the key. Only
-- ESC key is handled, to pop/hide the top active popup widget.
function Handle_Key_Press( this : access Window;
evt : not null A_Key_Event ) return Boolean;
-- Packs the window, all its children, and its menu bar.
procedure Pack( this : access Window );
-- Translates screen coordinates 'sx','sy' into Window content coordinates,
-- 'cx','cy'.
procedure Translate_To_Content( this : access Window;
sx, sy : Integer;
cx, cy : out Integer );
-- Translates this widget's content coordinates into its Window's content
-- coordinates. Because this is the Window widget, no translation actually
-- occurs. (This is for a recursive function.) Note that 'wx','wy' here are
-- not in the same coordinate space as the screen coordinates, 'sx','sy',
-- that are passed to Translate_To_Content.
procedure Translate_To_Window( this : access Window;
cx, cy : Integer;
wx, wy : out Integer );
end Widgets.Containers.Windows;