[gtkada] Help needed creating custom gtkada widget

Brent Seidel brentseidel at mac.com
Mon Jan 11 18:03:01 CET 2016


Hello all,

I may have bitten off more than I should chew at this point.  Most of my Ada experience was scattered through the 90s until I recently discovered the free GNAT and GPS tools.  I also haven’t used GTK before, but have done a bit of GUI programming on the Mac (classic and OS X).

What I would like to do is to create a custom widget that displays a value using a dial.  I’ve been able to do the drawing on a Drawing_Area widget.  The problem comes when I try to bundle it up into its own widget.  I get the following results:
**
Gtk:ERROR:gtkwidget.c:12314:gtk_widget_real_realize: assertion failed: (!_gtk_widget_get_has_window (widget))

Execution terminated by unhandled exception
Exception name: PROGRAM_ERROR
Message: unhandled signal
Load address: 0x10148a000
Call stack traceback locations:
0x1015529d5 0x7fff9251cf18

This appears to happen when I make the call to    Gtk.Window.Show_All(temp);

The spec for my widget is:
with Ada.Text_IO;
with Gtkada.Types;
--use type Gtkada.Types.Chars_Ptr_Array;
with Gtk.Main;
with Gtkada.Builder;
with Gtk.Widget;
with Gtk.Misc;
with Gtk.Level_Bar;
with Gtk.Progress_Bar;
with Gtk.Label;
with Gdk.Window;
with Glib;
use type Glib.Gdouble;
use type Glib.Gint;
with Glib.Object;
with Cairo;
package bbs.widget.dial is

   type bbs_dial_record is new Gtk.Misc.Gtk_Misc_Record with private;
   type bbs_dial is access all bbs_dial_record'class;

   function  Get_Type return Glib.GType;
   procedure gtk_new(self : in out bbs_dial);
   procedure initialize(self : not null access bbs_dial_record'class; minimum : float; maximum : float);
   procedure setup(self : not null access bbs_dial_record'class; minimum : float; maximum : float;
                  parent : Gdk.Gdk_Window);
   procedure draw(self : in out bbs_dial_record'class);
   procedure set_value(self : in out bbs_dial_record'Class; value : Float);

   procedure Get_Preferred_Height
      (self         : not null access Gtk.Widget.Gtk_Widget_Record;
       Minimum_Height : out Glib.Gint;
       Natural_Height : out Glib.Gint);

   procedure Get_Preferred_Height_For_Width
      (self         : not null access Gtk.Widget.Gtk_Widget_Record;
       Width          : Glib.Gint;
       Minimum_Height : out Glib.Gint;
       Natural_Height : out Glib.Gint);

--   procedure Get_Preferred_Size
--      (Widget       : not null access Gtk.Widget.Gtk_Widget_Record;
--       Minimum_Size : out Gtk_Requisition;
--       Natural_Size : out Gtk_Requisition);

   procedure Get_Preferred_Width
      (self        : not null access Gtk.Widget.Gtk_Widget_Record;
       Minimum_Width : out Glib.Gint;
       Natural_Width : out Glib.Gint);

   procedure Get_Preferred_Width_For_Height
      (self        : not null access Gtk.Widget.Gtk_Widget_Record;
       Height        : Glib.Gint;
       Minimum_Width : out Glib.Gint;
       Natural_Width : out Glib.Gint);

private
   type bbs_dial_record is new Gtk.Misc.Gtk_Misc_Record with
      record
         min : Float;
         max : Float;
         value : Float;
      end record;

   klass : aliased Glib.Object.Ada_GObject_Class := Glib.Object.Uninitialized_Class;
   function draw_dial(Self : access Gtk.Widget.Gtk_Widget_Record'Class; context : Cairo.Cairo_Context) return boolean;

end;

The body is:
package body bbs.widget.dial is

   function Get_Type return Glib.GType is
   begin
       Glib.Object.Initialize_Class_Record
         (Ancestor     => Gtk.Widget.Get_Type,
          Class_Record => Klass,
          Type_Name    => "bbs_dial",
          Signals      => Glib.Object.No_Signals,
          Parameters   => Glib.Object.Null_Parameter_Types);
      Ada.Text_IO.Put_Line("Dial get_type called");
      return Klass.The_Type;
   end;

   procedure gtk_new(self : in out bbs_dial) is
   begin
      self := new bbs_dial_record;
      initialize(self, 0.0, 10.0);
      Ada.Text_IO.Put_Line("Dial allocated");
   end;

   procedure initialize(self : not null access bbs_dial_record'class; minimum : float; maximum : float) is
   begin
      Glib.Object.G_New(Object => self,
                        Typ    => Get_Type);
      self.min := minimum;
      self.max := maximum;
--      Gtk.Misc.Initialize(self);
      Glib.Object.Initialize(self);
      self.On_Draw(draw_dial'access, True);
      Ada.Text_IO.Put_Line("Dial initialized");
   end;

   procedure setup(self : not null access bbs_dial_record'class; minimum : float; maximum : float;
                  parent : Gdk.Gdk_Window) is
   begin
      self.min := minimum;
      self.max := maximum;
      self.Set_Window(parent);
      self.Set_Has_Window(True);
      Ada.Text_IO.Put_Line("Dial setup");
   end;

   procedure draw(self : in out bbs_dial_record'Class) is
   begin
      self.Queue_Draw;
   end;

   procedure set_value(self : in out bbs_dial_record'Class; value : Float) is
   begin
      self.value := value;
      self.Queue_Draw;
   end;

   procedure Get_Preferred_Height
      (self         : not null access Gtk.Widget.Gtk_Widget_Record;
       Minimum_Height : out Glib.Gint;
       Natural_Height : out Glib.Gint) is
   begin
      Ada.Text_IO.Put_Line("Dial get preferred height");
      Minimum_Height := 100;
      Natural_Height := 100;
   end;

   procedure Get_Preferred_Height_For_Width
      (self         : not null access Gtk.Widget.Gtk_Widget_Record;
       Width          : Glib.Gint;
       Minimum_Height : out Glib.Gint;
       Natural_Height : out Glib.Gint) is
   begin
      Ada.Text_IO.Put_Line("Dial get preferred height for width");
      Minimum_Height := 100;
      Natural_Height := 100;
   end;

--   procedure Get_Preferred_Size
--      (Widget       : not null access Gtk.Widget.Gtk_Widget_Record;
--       Minimum_Size : out Gtk_Requisition;
--       Natural_Size : out Gtk_Requisition);

   procedure Get_Preferred_Width
      (self        : not null access Gtk.Widget.Gtk_Widget_Record;
       Minimum_Width : out Glib.Gint;
       Natural_Width : out Glib.Gint) is
   begin
      Ada.Text_IO.Put_Line("Dial get preferred width");
      Minimum_Width := 100;
      Natural_Width := 100;
   end;

   procedure Get_Preferred_Width_For_Height
      (self        : not null access Gtk.Widget.Gtk_Widget_Record;
       Height        : Glib.Gint;
       Minimum_Width : out Glib.Gint;
       Natural_Width : out Glib.Gint) is
   begin
      Ada.Text_IO.Put_Line("Dial get preferred width for height");
      Minimum_Width := 100;
      Natural_Width := 100;
   end;

   function draw_dial(Self : access Gtk.Widget.Gtk_Widget_Record'Class; context : Cairo.Cairo_Context) return boolean is
   begin
      Ada.Text_IO.Put_Line("Dial drawing");
      Cairo.Translate(context, 100.0, 100.0);
      Cairo.Set_Line_Width(context, 1.0);
      Cairo.Set_Source_Rgb(context, 0.0, 0.0, 0.0);
      Cairo.Arc(context, 0.0, 0.0, 50.0, 0.0, 6.28);
      for x in 0 .. 9 loop
         Cairo.Rotate(context, Glib.Gdouble(6.28/10.0));
         Cairo.Move_To(context, 0.0, 40.0);
         Cairo.Line_To(context, 0.0, 50.0);
         Cairo.Move_To(context, -5.0, 60.0);
         Cairo.Show_Text(context, Integer'Image(x + 1));
      end loop;
      Cairo.Stroke(context);
--      Cairo.Rotate(context, Glib.Gdouble(bbs_dial_record(self).value*6.28/10.0));
      Cairo.Set_Source_Rgb(context, 1.0, 0.0, 0.0);
      Cairo.Move_To(context, 0.0, -10.0);
      Cairo.Line_To(context, 5.0, 0.0);
      Cairo.Line_To(context, 0.0, 40.0);
      Cairo.Line_To(context, -5.0, 0.0);
      Cairo.Line_To(context, 0.0, -10.0);
      Cairo.Stroke(context);
      return True;
   end;

end;


I’m sure that there’s a bit of “cargo-cult” programming in there.  I’ve looked online to find tutorials and instructions, but they tend to be vague, incomplete, or incorrect.

I would be really appreciative if someone could offer a bit of assistance (I expect that once I know the trick, it will seem obvious).

thanks,
brent



More information about the gtkada mailing list