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. limited with Game_Views; 
  10.  
  11. private with Ada.Containers.Doubly_Linked_Lists; 
  12.  
  13. package Widgets.Menubars is 
  14.  
  15.     -- A Menubar spans the top of a Window and contains pulldown menus. 
  16.     type Menubar is new Widget and Visibility_Listener with private; 
  17.     type A_Menubar is access all Menubar'Class; 
  18.  
  19.     -- Creates a new Menubar within 'view' with widget id 'id'. Each window has 
  20.     -- at most one menu bar. 
  21.     function Create_Menubar( view : not null access Game_Views.Game_View'Class; 
  22.                              id   : String ) return A_Menubar; 
  23.     pragma Precondition( id'Length > 0 ); 
  24.     pragma Postcondition( Create_Menubar'Result /= null ); 
  25.  
  26.     -- Adds a pulldown menu to the menu bar. 'pulldown' will be consumed. 
  27.     procedure Add( this : access Menubar; pulldown : in out A_Widget ); 
  28.     pragma Precondition( pulldown /= null ); 
  29.     pragma Postcondition( pulldown = null ); 
  30.  
  31.     -- Notifies the menu bar that a pulldown menu has been hidden. This is 
  32.     -- intended to be called by a Pulldown_Menu when it closes. 
  33.     procedure Pulldown_Hidden( this : access Menubar; pulldown : not null A_Widget ); 
  34.  
  35. private 
  36.  
  37.     -- A Menu record encapsulates a pulldown menu. It contains the text and 
  38.     -- location of the clickable area that will open its pulldown menu. It's 
  39.     -- essentially a light-weight radio button that shows and hides its 
  40.     -- pulldown menu. 
  41.     type Menu is 
  42.         record 
  43.             pulldown : A_Widget := null; 
  44.             text     : Unbounded_String; 
  45.             x        : Integer := 0; 
  46.             width    : Integer := 0; 
  47.             hover    : Boolean := False; 
  48.             active   : Boolean := False; 
  49.         end record; 
  50.     type A_Menu is access all Menu; 
  51.  
  52.     -- Deletes the Menu record. 
  53.     procedure Delete( m : in out A_Menu ); 
  54.     pragma Postcondition( m = null ); 
  55.  
  56.     -- provides a list of Menu records. 
  57.     package Menu_Lists is new Ada.Containers.Doubly_Linked_Lists( A_Menu, "=" ); 
  58.     use Menu_Lists; 
  59.  
  60.     ---------------------------------------------------------------------------- 
  61.  
  62.     type Menubar is new Widget and Visibility_Listener with 
  63.         record 
  64.             menus    : Menu_Lists.List;     -- list of menus 
  65.             dragging : Boolean := False;    -- mouse is dragging over the menu bar 
  66.         end record; 
  67.  
  68.     procedure Construct( this : access Menubar; 
  69.                          view : not null access Game_Views.Game_View'Class; 
  70.                          id   : String ); 
  71.     pragma Precondition( id'Length > 0 ); 
  72.  
  73.     procedure Delete( this : in out Menubar ); 
  74.  
  75.     procedure Draw_Content( this : access Menubar ); 
  76.  
  77.     -- Updates a pulldown's Menu record when the pulldown becomes invisible. 
  78.     procedure Handle_Action( this   : access Menubar; 
  79.                              action : A_Visibility_Action ); 
  80.  
  81.     procedure On_Exit( this : access Menubar ); 
  82.  
  83.     procedure On_Mouse_Move( this : access Menubar; 
  84.                              evt  : not null A_Mouse_Event ); 
  85.  
  86.     procedure On_Mouse_Press( this : access Menubar; 
  87.                               evt  : not null A_Mouse_Button_Event ); 
  88.  
  89.     procedure On_Mouse_Release( this : access Menubar; 
  90.                                 evt  : not null A_Mouse_Button_Event ); 
  91.  
  92.     -- Applies the menu bar's special layout before setting its parent. 
  93.     procedure Set_Parent( this : access Menubar; parent : A_Widget ); 
  94.  
  95. end Widgets.Menubars;