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 Tools;                             use Tools; 
  10.  
  11. private with Ada.Strings.Unbounded; 
  12. private with Widgets.Simple_Key_Listeners; 
  13. private with Widgets.Buttons; 
  14. private with Widgets.Buttons.Simple_Listeners; 
  15. private with Widgets.Buttons.Groups; 
  16. private with Widgets.Buttons.Groups.Simple_Listeners; 
  17. private with Widgets.Menu_Items.Simple_Listeners; 
  18.  
  19. pragma Elaborate_All( Widgets.Simple_Key_Listeners ); 
  20. pragma Elaborate_All( Widgets.Buttons.Simple_Listeners ); 
  21. pragma Elaborate_All( Widgets.Buttons.Groups.Simple_Listeners ); 
  22. pragma Elaborate_All( Widgets.Menu_Items.Simple_Listeners ); 
  23.  
  24. package Game_Views.Ked is 
  25.  
  26.     type Dialog_Action is ( DA_None, DA_New, DA_Open, DA_Import, DA_Quit, DA_Save ); 
  27.  
  28.     type Ked_View is new Game_View with private; 
  29.     type A_Ked_View is access all Ked_View'Class; 
  30.  
  31.     -- Performs a dialog action. If the world has been modified and saveChanges 
  32.     -- is True, the dialog action will be postponed and the Save Changes 
  33.     -- confirmation dialog will be shown first. 
  34.     procedure Do_Dialog_Action( this        : not null access Ked_View'Class; 
  35.                                 action      : Dialog_Action; 
  36.                                 saveChanges : Boolean ); 
  37.  
  38.     -- Performs the previously requested dialog action, or nothing if one hasn't 
  39.     -- been requested yet. If 'saveChanges' is True then changes will be saved 
  40.     -- before performing the dialog action if the current world has a filename. 
  41.     -- If the world doesn't have a filename, the previously requested dialog 
  42.     -- action will be postponed and the save world dialog will be shown first. 
  43.     procedure Do_Dialog_Action( this        : not null access Ked_View'Class; 
  44.                                 saveChanges : Boolean ); 
  45.  
  46.     -- Returns the filename of the currently open world. 
  47.     function Get_Filename( this : not null access Ked_View'Class ) return String; 
  48.  
  49.     -- Returns the type of the currently active tool. 
  50.     function Get_Tool( this : not null access Ked_View'Class ) return Tool_Type; 
  51.  
  52.     -- Raises an exception on error. 
  53.     procedure Save_World( this : not null access Ked_View'Class; filename : String ); 
  54.     pragma Precondition( filename'Length > 0 ); 
  55.  
  56. private 
  57.  
  58.     use Ada.Strings.Unbounded; 
  59.     use Widgets.Buttons; 
  60.     use Widgets.Buttons.Groups; 
  61.  
  62.     ---------------------------------------------------------------------------- 
  63.  
  64.     type Ked_View is new Game_View with 
  65.         record 
  66.             loaded      : Boolean := False;     -- world is loaded 
  67.             modified    : Boolean := False;     -- world modified since load/create? 
  68.             filename    : Unbounded_String;     -- world filename 
  69.             gridsnap    : Boolean := True;      -- snap items to grid 
  70.             paletteGrp, 
  71.             layerGrp    : A_Button_Group := null; 
  72.             nextAction  : Dialog_Action := DA_None; 
  73.             paletteOn   : Boolean := False; 
  74.             tool        : A_Tool := null; 
  75.         end record; 
  76.  
  77.     procedure Construct( this    : access Ked_View; 
  78.                          display : not null A_Allegro_Display ); 
  79.  
  80.     procedure Delete( this : in out Ked_View ); 
  81.  
  82.     procedure Handle_Event( this : access Ked_View; 
  83.                             evt  : in out A_Event; 
  84.                             resp : out Response_Type ); 
  85.     pragma Precondition( evt /= null ); 
  86.  
  87.     procedure Initialize_Widgets( this : access Ked_View; 
  88.                                   win  : not null A_Window ); 
  89.  
  90.     function Is_World_Loaded( this : not null access Ked_View'Class ) return Boolean; 
  91.  
  92.     procedure On_Close_Window( this    : access Ked_View; 
  93.                                allowed : in out Boolean ); 
  94.  
  95.     procedure On_Initialize( this : access Ked_View ); 
  96.  
  97.     procedure On_Finalize( this : access Ked_View ); 
  98.  
  99.     procedure On_Game_Paused( this : access Ked_View; paused : Boolean ); 
  100.  
  101.     procedure On_World_Property_Changed( this  : access Ked_View; 
  102.                                          name  : String; 
  103.                                          value : Value_Ptr'Class); 
  104.  
  105.     ---------------------------------------------------------------------------- 
  106.  
  107.     package Button_Listeners is new Widgets.Buttons.Simple_Listeners(Ked_View); 
  108.     use Button_Listeners; 
  109.  
  110.     package Button_Group_Listeners is new Widgets.Buttons.Groups.Simple_Listeners(Ked_View); 
  111.     use Button_Group_Listeners; 
  112.  
  113.     package Key_Listeners is new Widgets.Simple_Key_Listeners(Ked_View); 
  114.     use Key_Listeners; 
  115.  
  116.     package Menu_Listeners is new Widgets.Menu_Items.Simple_Listeners(Ked_View); 
  117.     use Menu_Listeners; 
  118.  
  119. end Game_Views.Ked;