[gtkada] Help needed creating custom gtkada widget

[Dmitry A. Kazakov]

Here, fixed initialization. So far that the thingy starts, no further.

bbs_widget_dial.ads -------------------------------->
with Ada.Text_IO;
with Gtkada.Types;
with Gtk.Main;
with Gtkada.Builder;
with Gtk.Widget;
with Gtk.Misc;
with Gtk.Level_Bar;
with Gtk.Progress_Bar;
with Gtk.Drawing_Area;
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.Drawing_Area.Gtk_Drawing_Area_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.Drawing_Area.Gtk_Drawing_Area_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 bbs_widget_dial;

bbs_widget_dial.adb -------------------------------->
package body bbs_widget_dial is

    function Get_Type return Glib.GType is
    begin
        Glib.Object.Initialize_Class_Record
          (Ancestor     => Gtk.Drawing_Area.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.Drawing_Area.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 bbs_widget_dial;

test_bbs.adb ------------------------>
with Ada.Exceptions;   use Ada.Exceptions;
with Ada.Text_IO;      use Ada.Text_IO;
with Gdk.Event;        use Gdk.Event;
with Gtk.Box;          use Gtk.Box;
with Gtk.Button;       use Gtk.Button;
with Gtk.Window;       use Gtk.Window;
with Gtk.Widget;       use Gtk.Widget;
with bbs_widget_dial;  use bbs_widget_dial;

with Gtk.Main;

procedure Test_BBS is
    Window : Gtk_Window;
    Box    : Gtk_VBox;
    Dial   : bbs_dial;
begin
    Gtk.Main.Init;
    Gtk.Window.Gtk_New (Window);
    Window.Set_Title ("Test BBS");
    Gtk_New_VBox (Box);
    Add (Window, Box);

    Gtk_New (Dial);
    Box.Pack_Start (Dial);

    Window.Show_All;
    Gtk.Main.Main;
exception
    when Error : others =>
       Put_Line ("Fatal error: " & Exception_Information (Error));
end Test_BBS;