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.             childbmp        : A_Bitmap := null; 
  48.             children        : Widget_Lists.List; 
  49.             childLayout     : A_Layout := null; 
  50.  
  51.             -- If True, Draw_Content will be called a second time after drawing 
  52.             -- children, with the layer of the drawing context set to Foreground. 
  53.             -- This is so the widget can draw over its children. Setting this to 
  54.             -- True will cause Draw_Content to be called twice on every redraw, 
  55.             -- regardless of the container's dirty flag, which is expensive. 
  56.             drawForeground : Boolean := False; 
  57.         end record; 
  58.  
  59.     procedure Delete( this : in out Container ); 
  60.  
  61.     -- Adds 'child' as a child widget of this container. The child's parent is 
  62.     -- set by this procedure. If 'consume' is True, 'child' will be consumed, 
  63.     -- otherwise it will be left as-is. In either case, however, the Container 
  64.     -- will own 'child' after this is called, and will delete it if it's still a 
  65.     -- child at the time of deletion. 
  66.     procedure Add_Child( this    : access Container; 
  67.                          child   : in out A_Widget; 
  68.                          consume : Boolean := True ); 
  69.     pragma Precondition( child /= null ); 
  70.     pragma Postcondition( consume xor child /= null ); 
  71.  
  72.     -- Removes and deletes a child widget. If the given widget is not a child 
  73.     -- then a WIDGET_NOT_FOUND exception will be raised. 'child' will be 
  74.     -- consumed if successful. 
  75.     procedure Delete_Child( this  : access Container; 
  76.                             child : in out A_Widget ); 
  77.     pragma Precondition( child /= null ); 
  78.     pragma Postcondition( child = null ); 
  79.  
  80.     -- Removes and deletes all child widgets. 
  81.     procedure Delete_Children( this : access Container ); 
  82.  
  83.     -- Draws self before drawing children, in a back-to-front order. 
  84.     procedure Draw( this : access Container; 
  85.                     bmp  : not null A_Bitmap; 
  86.                     x, y : Integer ); 
  87.  
  88.     -- Draws each of the children onto 'bmp'. 'bmp' must match the size of the 
  89.     -- container's content area. 
  90.     procedure Draw_Children( this : access Container; 
  91.                              bmp  : not null A_Bitmap ); 
  92.  
  93.     -- Draws the container's content behind its children. This will be called 
  94.     -- before child widgets are drawn, in the back-to-front drawing model. This 
  95.     -- must be overriden, as the default implementation for Container is null. 
  96.     procedure Draw_Content( this : access Container; dc : Drawing_Context ) is null; 
  97.  
  98.     -- Returns the child widget (or self) containing the given coordinates 
  99.     -- relative to the widget's viewport, and the widget coordinates that 
  100.     -- 'x','y' map to ('wx','wy') within the found widget's content area. 
  101.     procedure Find_Widget_At( this   : access Container; 
  102.                               x, y   : Integer; 
  103.                               wx, wy : out Integer; 
  104.                               found  : out A_Widget ); 
  105.  
  106.    -- Handles a resize notification by resizing its internal bitmaps. 
  107.     procedure Handle_Resize( this : access Container ); 
  108.  
  109.     -- Invokes Handle_Rooted on each of the children and then handles the rooted 
  110.     -- notification for itself. An overriding implementation must call this 
  111.     -- procedure first. 
  112.     procedure Handle_Rooted( this : access Container; rooted : Boolean ); 
  113.  
  114.     -- Invokes Handle_Shown on each of the children and then handles the 
  115.     -- showing notification for itself. An overriding implementation must call 
  116.     -- this procedure first. 
  117.     procedure Handle_Shown( this : access Container; shown : Boolean ); 
  118.  
  119.     -- Calls Pack on each of the children after packing self. 
  120.     procedure Pack( this : access Container ); 
  121.  
  122.     -- Removes the widget from the child list without deleting it. The child's 
  123.     -- parent reference is set to null. An exception will be raised if 'child' 
  124.     -- is not a child of the widget. 
  125.     procedure Remove_Child( this  : access Container; 
  126.                             child : not null A_Widget ); 
  127.  
  128.     -- Sets the zoom level of the container. If zooming in, the child widgets 
  129.     -- will appear proportionately larger in size. Their zoom levels remain 
  130.     -- independently controlled, as expected. 
  131.     procedure Set_Zoom( this : access Container; zoom : Float ); 
  132.  
  133. end Widgets.Containers;