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. private with Ada.Containers.Indefinite_Doubly_Linked_Lists; 
  10.  
  11. package Widgets.Containers is 
  12.  
  13.     -- A Container widget is a parent widget that contains multiple child 
  14.     -- widgets. Each child widget is drawn within the content area of the 
  15.     -- parent. Widget layouts applied to child widgets are relative to the 
  16.     -- content area of their container. An input event not handled by a widget 
  17.     -- will be passed up the widget tree to its container. 
  18.     type Container is abstract new Widget with private; 
  19.     type A_Container is access all Container'Class; 
  20.  
  21.     -- Applies the container's special child layout to the given child widget. 
  22.     procedure Apply_Container_Layout( this  : access Container; 
  23.                                       child : not null A_Widget ); 
  24.  
  25.     -- Brings the 'child' widget to the front of the drawing Z-order within this 
  26.     -- container. If 'child' overlaps any sibling widgets, it will be drawn on 
  27.     -- top. 
  28.     procedure Bring_To_Front( this  : access Container; 
  29.                               child : not null A_Widget ); 
  30.  
  31.     -- Gives focus to 'target'. If this widget is not rooted with a window, the 
  32.     -- operation will be ignored. If the widget does not accept focus, the next 
  33.     -- possible candidate will be receive focus. 
  34.     procedure Give_Focus( this : access Container; target : not null A_Widget ); 
  35.  
  36. private 
  37.  
  38.     WIDGET_NOT_FOUND : exception; 
  39.  
  40.     -- provides a linked list of widgets 
  41.     package Widget_Lists is new Ada.Containers.Indefinite_Doubly_Linked_Lists( A_Widget, "=" ); 
  42.  
  43.     ---------------------------------------------------------------------------- 
  44.  
  45.     type Container is abstract new Widget with 
  46.         record 
  47.             children    : Widget_Lists.List; 
  48.             childLayout : A_Layout := null; 
  49.         end record; 
  50.  
  51.     procedure Delete( this : in out Container ); 
  52.  
  53.     -- Adds 'child' as a child widget of this container. The child's parent is 
  54.     -- set by this procedure. If 'consume' is True, 'child' will be consumed, 
  55.     -- otherwise it will be left as-is. In either case, however, the Container 
  56.     -- will own 'child' after this is called, and will delete it if it's still a 
  57.     -- child at the time of deletion. 
  58.     procedure Add_Child( this    : access Container; 
  59.                          child   : in out A_Widget; 
  60.                          consume : Boolean := True ); 
  61.     pragma Precondition( child /= null ); 
  62.     pragma Postcondition( consume xor child /= null ); 
  63.  
  64.     -- Removes and deletes a child widget. If the given widget is not a child 
  65.     -- then a WIDGET_NOT_FOUND exception will be raised. 'child' will be 
  66.     -- consumed if successful. 
  67.     procedure Delete_Child( this  : access Container; 
  68.                             child : in out A_Widget ); 
  69.     pragma Precondition( child /= null ); 
  70.     pragma Postcondition( child = null ); 
  71.  
  72.     -- Removes and deletes all child widgets. 
  73.     procedure Delete_Children( this : access Container ); 
  74.  
  75.     -- Draws self before drawing children, in a back-to-front order. 
  76.     procedure Draw( this : access Container ); 
  77.  
  78.     -- Draws each of the children onto the widget's drawing area. 
  79.     procedure Draw_Children( this : access Container ); 
  80.  
  81.     -- Draws the container's background content behind its children. This will 
  82.     -- be called before child widgets are drawn on top of the widget's 
  83.     -- background content. Override this procedure to draw the container 
  84.     -- widget's background. 
  85.     procedure Draw_Content( this : access Container ) is null; 
  86.  
  87.     -- Draws the container's foreground content over its children. This will be 
  88.     -- called after child widgets are drawn. Override this procedure to draw the 
  89.     -- container widget's foreground. 
  90.     procedure Draw_Content_Foreground( this : access Container ) is null; 
  91.  
  92.     -- Returns the child widget (or self) containing the given coordinates 
  93.     -- relative to the widget's viewport, and the widget coordinates that 
  94.     -- 'x','y' map to ('wx','wy') within the found widget's content area. 
  95.     procedure Find_Widget_At( this   : access Container; 
  96.                               x, y   : Integer; 
  97.                               wx, wy : out Integer; 
  98.                               found  : out A_Widget ); 
  99.  
  100.     -- Invokes Handle_Rooted on each of the children and then handles the rooted 
  101.     -- notification for itself. 
  102.     procedure Handle_Rooted( this : access Container; rooted : Boolean ); 
  103.  
  104.     -- Invokes Handle_Shown on each of the children and then handles the 
  105.     -- showing notification for itself. 
  106.     procedure Handle_Shown( this : access Container; shown : Boolean ); 
  107.  
  108.     -- Calls Pack on each of the children after packing self. 
  109.     procedure Pack( this : access Container ); 
  110.  
  111.     -- Removes the widget from the child list without deleting it. The child's 
  112.     -- parent reference is set to null. An exception will be raised if 'child' 
  113.     -- is not a child of the widget. 
  114.     procedure Remove_Child( this  : access Container; 
  115.                             child : not null A_Widget ); 
  116.  
  117. end Widgets.Containers;