--
-- Copyright (c) 2012 Kevin Wellwood
-- All rights reserved.
--
-- This source code is distributed under the Modified BSD License. For terms and
-- conditions, see license.txt.
--
with Drawing; use Drawing;
with Events; use Events;
with Events.Listeners; use Events.Listeners;
with Widgets.Menubars; use Widgets.Menubars;
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 and Event_Listener 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 will automatically be upscaled to a higher
-- resolution if the bitmap it draws onto is a multiple or more of the
-- window size. 'filter' determines the upscaling filter algorithm to use.
function Create_Window( view : access Game_Views.Game_View'Class;
id : String;
width,
height : Natural;
filter : Filter_Type := Filter_Nearest
) return A_Window;
pragma Precondition( id'Length > 0 );
pragma Postcondition( Create_Window'Result /= null );
-- Adds a child widget to the Window. 'child' will be consumed if 'consume'
-- is set to True. In either case, however, the Container will own 'child'
-- after this is called, and will delete it if it's still a child at the
-- time of deletion.
procedure Add_Widget( this : access Window;
child : in out A_Widget;
consume : Boolean := True );
pragma Precondition( child /= null );
pragma Postcondition( consume xor child /= null );
-- Draws the whole Window, all its children, and then the popup widget stack
-- in back-to-front order. 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. This procedure is used by the
-- renderer to draw the whole OS window.
procedure Draw( this : access Window );
-- Returns the color of the outer border that surrounds the window. See
-- Set_Border_Color().
function Get_Outer_Border( this : not null access Window'Class ) return Allegro_Color;
-- Returns the scaling factor used when drawing the Window to the screen. A
-- return value of 1 means it is drawn at actual size.
function Get_Scale( this : not null access Window'Class ) return Positive;
-- Requests input focus be given 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 );
-- Returns True if the Window is showing on the screen. It is showing if it
-- is visible and has been added to the Game_View.
function Is_Showing( this : access Window ) return Boolean;
-- 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 );
-- Removes the widget from the window.
procedure Remove_Widget( this : access Window; child : not null A_Widget );
-- Sets the pixel scaling filter for the entire window. If the window is
-- scaled to a larger resolution on the screen, everything in the window
-- will be scaled up to that resolution with this filter.
procedure Set_Filter( this : not null access Window'Class;
filter : Filter_Type );
-- 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 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 color of the outer border that surrounds the window, if the
-- window widget doesn't fill the entire display. For applications that use
-- a fixed window size that scales to fill the display, the display
-- resolutions in between exact multiples of the window size will show this
-- border color between the edges of the window widget and the display.
procedure Set_Outer_Border( this : not null access Window'Class;
color : Allegro_Color );
-- Sets the title at the top of the application window.
procedure Set_Title( this : not null access Window'Class; 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..ALLEGRO_KEY_MAX-1) of A_Widget;
----------------------------------------------------------------------------
type Window is new Container and Event_Listener with
record
scale : Positive := 1;
filter : Filter_Type := Filter_Nearest;
scaleBmp : A_Allegro_Bitmap := null;
menu : A_Menubar := null;
mouseOver : A_Widget := null;
mousePressedOn : Mouse_Widget_Array;
mouseClickedOn : Mouse_Widget_Array;
keyPressSentTo : Key_Widget_Array := Key_Widget_Array'(others=>null);
focus : A_Widget := null;
modal : A_Widget := null; -- widget with modality in window
popups : Widget_Lists.List; -- stack of active popup widgets
outerBorder : Allegro_Color;
end record;
procedure Construct( this : access Window;
view : access Game_Views.Game_View'Class;
id : String;
width,
height : Natural;
filter : Filter_Type );
pragma Precondition( id'Length > 0 );
procedure Delete( this : in out Window );
-- 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_At( 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 all input events that the Window is registered to receive.
procedure Handle_Event( this : access Window;
evt : in out A_Event;
resp : out Response_Type );
pragma Precondition( evt /= null );
-- Returns True by definition. The Window is the root of every widget
-- hierarchy.
function Is_Rooted( this : access Window ) return Boolean;
-- Handles when 'descendent' is shown or hidden on the screen. If
-- 'descendent' is hidden and it was focused, then focus must be transferred
-- to a visible, focusable ancestor.
procedure On_Descendant_Shown( this : access Window;
descendant : not null A_Widget;
shown : Boolean );
-- Closes any open popups if Escape is pressed.
procedure On_Key_Press( this : access Window;
evt : not null A_Key_Event;
handled : in out 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;