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. package Widgets.Scrollbars is 
  10.  
  11.     -- An abstract scrollbar widget. A scrollbar has a client widget that it is 
  12.     -- responsible for scrolling. The amount that can be scrolled is the 
  13.     -- difference between the client's content region and its viewport. 
  14.     type Scrollbar is abstract new Widget and Resize_Listener with private; 
  15.  
  16.     -- Calculates where the scroll button will be drawn on the scrollbar, based 
  17.     -- on the size of the client widget and the location and size of its 
  18.     -- viewport. 'min' and 'max' are in the range of 0..[scroll_dimension]-1, in 
  19.     -- pixels. For example, if this is a horizontal scrollbar for a client that 
  20.     -- is completely visible in the horizontal dimension, then 'min' will return 
  21.     -- 0 and 'max' will return Scrollbar.Get_Width - 1. This is because the 
  22.     -- button should entirely fill the area scrollbar. 
  23.     procedure Calculate_Button( this : access Scrollbar; min, max : out Integer ) is abstract; 
  24.  
  25.     -- Sets the client widget of the scrollbar; ie: the widget that will be 
  26.     -- controlled. 'client' will not belong to the scrollbar. The client of a 
  27.     -- scrollbar should be removed before its deleted. If 'client' is null, the 
  28.     -- scrollbar will have no client. 
  29.     procedure Set_Client( this : not null access Scrollbar'Class; client : A_Widget ); 
  30.  
  31.     ---------------------------------------------------------------------------- 
  32.  
  33.     -- A horizontal scrollbar widget. 
  34.     type H_Scrollbar is new Scrollbar with private; 
  35.     type A_H_Scrollbar is access all H_Scrollbar'Class; 
  36.  
  37.     -- Creates a horizontal scrollbar within 'view' with widget id 'id'. 
  38.     function Create_H_Scrollbar( view : not null access Game_Views.Game_View'Class; 
  39.                                  id   : String ) return A_H_Scrollbar; 
  40.     pragma Precondition( id'Length > 0 ); 
  41.     pragma Postcondition( Create_H_Scrollbar'Result /= null ); 
  42.  
  43.     ---------------------------------------------------------------------------- 
  44.  
  45.     -- A vertical scrollbar widget. 
  46.     type V_Scrollbar is new Scrollbar with private; 
  47.     type A_V_Scrollbar is access all V_Scrollbar'Class; 
  48.  
  49.     -- Creates a vertical scrollbar within 'view' with widget id 'id'. 
  50.     function Create_V_Scrollbar( view : not null access Game_Views.Game_View'Class; 
  51.                                  id   : String ) return A_V_Scrollbar; 
  52.     pragma Precondition( id'Length > 0 ); 
  53.     pragma Postcondition( Create_V_Scrollbar'Result /= null ); 
  54.  
  55. private 
  56.  
  57.     type Scrollbar is abstract new Widget and Resize_Listener with 
  58.         record 
  59.             client : A_Widget := null;      -- widget to scroll 
  60.             pageUp,                         -- true when paging up 
  61.             pageDown,                       -- true when paging down 
  62.             dragging : Boolean := False;    -- true when button is dragged 
  63.             dragPos  : Integer := 0; 
  64.         end record; 
  65.  
  66.     procedure Construct( this : access Scrollbar; 
  67.                          view : not null access Game_Views.Game_View'Class; 
  68.                          id   : String ); 
  69.     pragma Precondition( id'Length > 0 ); 
  70.  
  71.     procedure Delete( this : in out Scrollbar ); 
  72.  
  73.     procedure Handle_Action( this   : access Scrollbar; 
  74.                              action : A_Resize_Action ); 
  75.  
  76.     procedure On_Mouse_Release( this : access Scrollbar; 
  77.                                 evt  : not null A_Mouse_Button_Event ); 
  78.  
  79.     ---------------------------------------------------------------------------- 
  80.  
  81.     type H_Scrollbar is new Scrollbar with null record; 
  82.  
  83.     procedure Calculate_Button( this : access H_Scrollbar; min, max : out Integer ); 
  84.  
  85.     procedure Draw_Content( this : access H_Scrollbar ); 
  86.  
  87.     procedure On_Mouse_Held( this : access H_Scrollbar; 
  88.                              evt  : not null A_Mouse_Button_Event ); 
  89.  
  90.     procedure On_Mouse_Move( this : access H_Scrollbar; 
  91.                              evt  : not null A_Mouse_Event ); 
  92.  
  93.     procedure On_Mouse_Press( this : access H_Scrollbar; 
  94.                               evt  : not null A_Mouse_Button_Event ); 
  95.  
  96.     ---------------------------------------------------------------------------- 
  97.  
  98.     type V_Scrollbar is new Scrollbar with null record; 
  99.  
  100.     procedure Calculate_Button( this : access V_Scrollbar; min, max : out Integer ); 
  101.  
  102.     procedure Draw_Content( this : access V_Scrollbar ); 
  103.  
  104.     procedure On_Mouse_Held( this : access V_Scrollbar; 
  105.                              evt  : not null A_Mouse_Button_Event ); 
  106.  
  107.     procedure On_Mouse_Move( this : access V_Scrollbar; 
  108.                              evt  : not null A_Mouse_Event ); 
  109.  
  110.     procedure On_Mouse_Press( this : access V_Scrollbar; 
  111.                               evt  : not null A_Mouse_Button_Event ); 
  112.  
  113. end Widgets.Scrollbars;