Re: Access type to member procedure of instance (Object Oriented programming in Ada)

[ake.ragnar.dahlgren@gmail.com]

On Thursday, November 22, 2012 11:24:27 AM UTC+1, Dmitry A. Kazakov wrote:
> On Thu, 22 Nov 2012 01:47:39 -0800 (PST), ake.ragnar.dahlgren@gmail.com
> 
> wrote:
> 
> 
> 
> > As for the Gtkada application I have given up on implementing the MVC
> 
> > pattern using tagged types.
> 
> 
> 
> Could you provide more details?
> 
> 
> 
> Gtk (and so GtkAda) deploys MVC. E.g. Gtk combo boxes, tree views, column
> 
> renderers are all using the MVC pattern.
> 
> 
> 
> > Instead I choose the same approach as was done
> 
> > in the Ada in Denmark wiki.
> 
> 
> 
> It is unclear what are the differences, but MVC is a real help when dealing
> 
> with Gtk and GUI in general. GtkAda should not pose any difficulties for
> 
> MVC. (You don't need pointers to members for MVC, plain pointers to objects
> 
> are sufficient)
> 
> 
> 
> -- 
> 
> Regards,
> 
> Dmitry A. Kazakov
> 
> http://www.dmitry-kazakov.de

I gladly provide more details by giving an example of Ada code. The with statements have been omitted and the GUI described by the main_window.glade file is assumed to contain a Label called Main_Label and the window has a destroy signal called Main_Window_Quit:

procedure Main is
begin
   Application.Main;
end Main;


package Application is

   pragma Elaborate_Body;

   procedure Main;

end Application;



package body Application is

   Main_Window_Controller : Controllers.Main_Window.Controller_Ref_Type;
   Main_Window : Views.Main_Window.Main_Window_Ref_Type;

   procedure On_Main_Window_Quit(Object : access Gtkada.Builder.Gtkada_Builder_Record'Class)
                                 renames Main_Window_Controller.On_Quit;

   procedure Main is
   begin

      Main_Window_Controller := new Controllers.Main_Window.Controller_Type;
      Main_Window := Views.Main_Window.Create_Main_Window(Main_Window_Controller,
                                                          On_Main_Window_Quit'Access);
      Main_Window.Show;

      Gtk.Main.Main;
      -- Enter the main gtk loop.
   end Main;

begin
   Gtk.Main.Init;
end Application;


package Controllers.Main_Window is

   type Controller_Type is tagged private;
   type Controller_Ref_Type is access all Controller_Type;

   procedure On_Quit (This : Controller_Type;
                      Object : access Gtkada.Builder.Gtkada_Builder_Record'Class);

private

   type Controller_Type is new Ada.Finalization.Controlled with null record;

end Controllers.Main_Window;



package body Controllers.Main_Window is

   procedure On_Quit
     (This : Controller_Type;
      Object : access Gtkada.Builder.Gtkada_Builder_Record'Class)
   is
   begin
      GNAT.IO.Put_Line("Will exit the application!");
      Gtk.Main.Main_Quit;
   end On_Quit;

end Controllers.Main_Window;



package Views.Main_Window is

   type Main_Window_Type(<>) is tagged private;
   type Main_Window_Ref_Type is access Main_Window_Type;

   procedure Show(Main_Window : Main_Window_Type);

   function Create_Main_Window(Controller : Controllers.Main_Window.Controller_Ref_Type;
                               On_Quit : Gtkada.Builder.Builder_Handler)
                               return Main_Window_Ref_Type;

private
   type Main_Window_Type(Controller_Ref : Controllers.Main_Window.Controller_Ref_Type) is new Ada.Finalization.Controlled with record
      Builder    : Gtkada.Builder.Gtkada_Builder;
   end record;

   Label : Gtk.Label.Gtk_Label;
   -- Extracted widget from the xml file

   overriding procedure Initialize (Main_Window : in out Main_Window_Type);
   overriding procedure Finalize   (Object : in out Main_Window_Type);

end Views.Main_Window;



package body Views.Main_Window is

   procedure Show(Main_Window : Main_Window_Type) is
   begin
      --  Find our main window, then display it and all of its children.
      Gtk.Widget.Show_All (Main_Window.Builder.Get_Widget ("Main_Window"));
   end Show;

   overriding procedure Initialize (Main_Window : in out Main_Window_Type) is
      Error   : Glib.Error.GError;      
   begin
      --     Step 1: create a Builder and add the XML data,
      Gtkada.Builder.Gtk_New (Main_Window.Builder);
      Error := Main_Window.Builder.Add_From_File ("main_window.glade");
      if Error /= null then
         Ada.Text_IO.Put_Line ("Error : " & Glib.Error.Get_Message (Error));
         Glib.Error.Error_Free (Error);
         raise Constraint_Error;
      end if;

      -- Step 2: Extract all widgets the application wishes to update
      declare
         Widget : Gtk.Widget.Gtk_Widget;
         use type Gtk.Window.Gtk_Window;
      begin
         Widget := Main_Window.Builder.Get_Widget("Main_Label");
         if Widget /= null then
            Label := Gtk.Label.Gtk_Label(Widget);
            if Label /= null then
               Label.Set_Text("Managed to set text successfully!");
            else
               Ada.Text_IO.Put_Line("Could not convert widget to Label");
            end if;
         else
            Ada.Text_IO.Put_Line("Widget not found!");
         end if;
      end;
   end Initialize;

   function Create_Main_Window(Controller : Controllers.Main_Window.Controller_Ref_Type;
                               On_Quit : Gtkada.Builder.Builder_Handler) return Main_Window_Ref_Type
   is
      Main_Window : Main_Window_Ref_Type := new Main_Window_Type(Controller);
   begin
      Gtkada.Builder.Register_Handler
        (Builder      => Main_Window.Builder,
         Handler_Name => "Main_Window_Quit",
         Handler      =>  On_Quit);

      -- Step 3: Call Do_Connect once to connect all registered handlers
      Main_Window.Builder.Do_Connect;

      return Main_Window;
   end Create_Main_Window;

   overriding procedure Finalize   (Object : in out Main_Window_Type) is
   begin
      Object.Builder.Unref;
   end Finalize;

end Views.Main_Window;


What I am trying to achieve is something like can be read in the Application.Main procedure. And to be able to do that I've used the forbidden renames feature of the GNAT compiler (as Brian and Randy has pointed out):
   procedure On_Main_Window_Quit(Object : access Gtkada.Builder.Gtkada_Builder_Record'Class)
                                 renames Main_Window_Controller.On_Quit;

I hope it has been interesting reading these thoughts on Gtkada development.

Best regards,
Åke Ragnar Dahlgren