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. with Associations;                      use Associations; 
  10. pragma Warnings( Off, Associations ); 
  11. with Widgets.Menu_Items;                use Widgets.Menu_Items; 
  12.  
  13. limited with Game_Views; 
  14.  
  15. private with Directions; 
  16. private with Widgets.Containers.Panels.Dialogs; 
  17. private with Widgets.Containers.Panels.Popups; 
  18.  
  19. package Widgets.Sprites.Ked is 
  20.  
  21.     type Ked_Sprite is new Sprite and Menu_Listener and  Visibility_Listener with private; 
  22.     type A_Ked_Sprite is access all Ked_Sprite'Class; 
  23.  
  24.     function Create_Ked_Sprite( view       : not null access Game_Views.Game_View'Class; 
  25.                                 eid        : Entity_Id; 
  26.                                 class      : String; 
  27.                                 x, y       : Float; 
  28.                                 width, 
  29.                                 height     : Natural; 
  30.                                 resizeable : Boolean; 
  31.                                 physical   : Boolean; 
  32.                                 libName    : String; 
  33.                                 frame      : Natural ) return A_Ked_Sprite; 
  34.     pragma Precondition( class'Length > 0 ); 
  35.     pragma Precondition( libName'Length > 0 ); 
  36.     pragma Postcondition( Create_Ked_Sprite'Result /= null ); 
  37.  
  38.     -- Consumes the attributes association. 
  39.     procedure Set_Attributes( this       : not null access Ked_Sprite'Class; 
  40.                               attributes : in out A_Association ); 
  41.     pragma Precondition( attributes /= null ); 
  42.     pragma Postcondition( attributes = null ); 
  43.  
  44. private 
  45.  
  46.     use Directions; 
  47.     use Widgets.Containers.Panels.Dialogs; 
  48.     use Widgets.Containers.Panels.Popups; 
  49.  
  50.     type Drag_Action is (Drag_None, Drag_Move, Drag_Resize); 
  51.  
  52.     type Ked_Sprite is new Sprite and Menu_Listener and Visibility_Listener with 
  53.         record 
  54.             resizeable  : Boolean := False;    -- user can resize the sprite 
  55.             dragStartX,                        -- coordinates where the mouse is 
  56.             dragStartY  : Integer := -1;       --   attached to drag 
  57.             dragAction  : Drag_Action := Drag_None; 
  58.             resizeDir   : Direction_Type; 
  59.             dragged     : Boolean := False;    -- location has changed by a drag 
  60.             snapCenter  : Boolean := False;    -- snaps the center of the object to the grid 
  61.             popupMenu   : A_Popup := null;     -- right-click popup menu (belongs to this) 
  62.             dialog      : A_Dialog := null;    -- edit attributes dialog (belongs to Window) 
  63.         end record; 
  64.  
  65.     procedure Construct( this       : access Ked_Sprite; 
  66.                          view       : not null access Game_Views.Game_View'Class; 
  67.                          eid        : Entity_Id; 
  68.                          class      : String; 
  69.                          x, y       : Float; 
  70.                          width, 
  71.                          height     : Natural; 
  72.                          resizeable : Boolean; 
  73.                          physical   : Boolean; 
  74.                          libName    : String; 
  75.                          frame      : Natural ); 
  76.     pragma Precondition( class'Length > 0 ); 
  77.     pragma Precondition( libName'Length > 0 ); 
  78.  
  79.     procedure Delete( this : in out Ked_Sprite ); 
  80.  
  81.     procedure Handle_Action( this   : access Ked_Sprite; 
  82.                              action : A_Menu_Action ); 
  83.  
  84.     procedure Handle_Action( this   : access Ked_Sprite; 
  85.                              action : A_Visibility_Action ); 
  86.  
  87.     procedure Handle_Focus( this : access Ked_Sprite ); 
  88.  
  89.     function Handle_Key_Held( this : access Ked_Sprite; 
  90.                               evt  : not null A_Key_Event ) return Boolean; 
  91.  
  92.     function Handle_Key_Press( this : access Ked_Sprite; 
  93.                                evt  : not null A_Key_Event ) return Boolean; 
  94.  
  95.     function Handle_Key_Release( this : access Ked_Sprite; 
  96.                                  evt  : not null A_Key_Event ) return Boolean; 
  97.  
  98.     procedure Handle_Mouse_Move( this : access Ked_Sprite; 
  99.                                  evt  : not null A_Mouse_Event ); 
  100.  
  101.     procedure Handle_Mouse_Press( this : access Ked_Sprite; 
  102.                                   evt  : not null A_Mouse_Button_Event ); 
  103.  
  104.     procedure Handle_Mouse_Release( this : access Ked_Sprite; 
  105.                                     evt  : not null A_Mouse_Button_Event ); 
  106.  
  107. end Widgets.Sprites.Ked;