Added FLTK.Tooltips

5 files changed, 569 insertions, 2 deletions

diff --git a/progress.txt b/progress.txt
index c5a0557..2d47916 100644
--- a/progress.txt
+++ b/progress.txt
@@ -30,6 +30,7 @@ FLTK.Images.RGB.BMP
 FLTK.Images.RGB.JPEG
 FLTK.Images.RGB.PNG
 FLTK.Images.RGB.PNM
+FLTK.Tooltips
 FLTK.Widgets.Boxes
 FLTK.Widgets.Buttons
 FLTK.Widgets.Buttons.Enter
@@ -120,11 +121,10 @@ FL_File_Browser
 FL_Hold_Browser
 FL_Multi_Browser
 FL_Select_Browser
-FL_Help_View (several methods have ABI_VERSION bugs)
+FL_Help_View
 FL_Table
 FL_Table_Row
 FL_Tree
-FL_Tooltip
 FL_Preferences
 FL_Label
 
@@ -136,6 +136,15 @@ FL_Label
 
 
 
+Bugs to fix:
+
+Fl_Help_View ABI_VERSION checks
+Fl_Tooltip ABI_VERSION checks
+Fl_Wizard draw() method private/protected
+
+
+
+
 Never:
 
 FL_FormsBitmap
diff --git a/src/c_fl_tooltip.cpp b/src/c_fl_tooltip.cpp
new file mode 100644
index 0000000..a281333
--- /dev/null
+++ b/src/c_fl_tooltip.cpp
@@ -0,0 +1,111 @@
+
+
+#include <FL/Fl_Tooltip.H>
+#include <FL/Fl_Widget.H>
+#include "c_fl_tooltip.h"
+
+
+
+
+void * fl_tooltip_get_current(void) {
+    return Fl_Tooltip::current();
+}
+
+void fl_tooltip_set_current(void * i) {
+    Fl_Tooltip::current(reinterpret_cast<Fl_Widget*>(i));
+}
+
+int fl_tooltip_enabled(void) {
+    return Fl_Tooltip::enabled();
+}
+
+void fl_tooltip_enable(int v) {
+    Fl_Tooltip::enable(v);
+}
+
+void fl_tooltip_enter_area(void * i, int x, int y, int w, int h, const char * t) {
+    Fl_Tooltip::enter_area(reinterpret_cast<Fl_Widget*>(i),x,y,w,h,t);
+}
+
+
+
+
+float fl_tooltip_get_delay(void) {
+    return Fl_Tooltip::delay();
+}
+
+void fl_tooltip_set_delay(float v) {
+    Fl_Tooltip::delay(v);
+}
+
+float fl_tooltip_get_hoverdelay(void) {
+    return Fl_Tooltip::hoverdelay();
+}
+
+void fl_tooltip_set_hoverdelay(float v) {
+    Fl_Tooltip::hoverdelay(v);
+}
+
+
+
+
+unsigned int fl_tooltip_get_color(void) {
+    return Fl_Tooltip::color();
+}
+
+void fl_tooltip_set_color(unsigned int v) {
+    Fl_Tooltip::color(v);
+}
+
+int fl_tooltip_get_margin_height(void) {
+    return Fl_Tooltip::margin_height();
+}
+
+//void fl_tooltip_set_margin_height(int v) {
+//    Fl_Tooltip::margin_height(v);
+//}
+
+int fl_tooltip_get_margin_width(void) {
+    return Fl_Tooltip::margin_width();
+}
+
+//void fl_tooltip_set_margin_width(int v) {
+//    Fl_Tooltip::margin_width(v);
+//}
+
+int fl_tooltip_get_wrap_width(void) {
+    return Fl_Tooltip::wrap_width();
+}
+
+//void fl_tooltip_set_wrap_width(int v) {
+//    Fl_Tooltip::wrap_width(v);
+//}
+
+
+
+
+unsigned int fl_tooltip_get_textcolor(void) {
+    return Fl_Tooltip::textcolor();
+}
+
+void fl_tooltip_set_textcolor(unsigned int v) {
+    Fl_Tooltip::textcolor(v);
+}
+
+int fl_tooltip_get_font(void) {
+    return Fl_Tooltip::font();
+}
+
+void fl_tooltip_set_font(int v) {
+    Fl_Tooltip::font(v);
+}
+
+int fl_tooltip_get_size(void) {
+    return Fl_Tooltip::size();
+}
+
+void fl_tooltip_set_size(int v) {
+    Fl_Tooltip::size(v);
+}
+
+
diff --git a/src/c_fl_tooltip.h b/src/c_fl_tooltip.h
new file mode 100644
index 0000000..b5a3644
--- /dev/null
+++ b/src/c_fl_tooltip.h
@@ -0,0 +1,41 @@
+
+
+#ifndef FL_TOOLTIP_GUARD
+#define FL_TOOLTIP_GUARD
+
+
+
+
+extern "C" void * fl_tooltip_get_current(void);
+extern "C" void fl_tooltip_set_current(void * i);
+extern "C" int fl_tooltip_enabled(void);
+extern "C" void fl_tooltip_enable(int v);
+extern "C" void fl_tooltip_enter_area(void * i, int x, int y, int w, int h, const char * t);
+
+
+extern "C" float fl_tooltip_get_delay(void);
+extern "C" void fl_tooltip_set_delay(float v);
+extern "C" float fl_tooltip_get_hoverdelay(void);
+extern "C" void fl_tooltip_set_hoverdelay(float v);
+
+
+extern "C" unsigned int fl_tooltip_get_color(void);
+extern "C" void fl_tooltip_set_color(unsigned int v);
+extern "C" int fl_tooltip_get_margin_height(void);
+//extern "C" void fl_tooltip_set_margin_height(int v);
+extern "C" int fl_tooltip_get_margin_width(void);
+//extern "C" void fl_tooltip_set_margin_width(int v);
+extern "C" int fl_tooltip_get_wrap_width(void);
+//extern "C" void fl_tooltip_set_wrap_width(int v);
+
+
+extern "C" unsigned int fl_tooltip_get_textcolor(void);
+extern "C" void fl_tooltip_set_textcolor(unsigned int v);
+extern "C" int fl_tooltip_get_font(void);
+extern "C" void fl_tooltip_set_font(int v);
+extern "C" int fl_tooltip_get_size(void);
+extern "C" void fl_tooltip_set_size(int v);
+
+
+#endif
+
diff --git a/src/fltk-tooltips.adb b/src/fltk-tooltips.adb
new file mode 100644
index 0000000..38bcf66
--- /dev/null
+++ b/src/fltk-tooltips.adb
@@ -0,0 +1,313 @@
+
+
+with
+
+    Interfaces.C,
+    System.Address_To_Access_Conversions;
+
+use type
+
+    Interfaces.C.int;
+
+
+package body FLTK.Tooltips is
+
+
+    function fl_tooltip_get_current
+        return System.Address;
+    pragma Import (C, fl_tooltip_get_current, "fl_tooltip_get_current");
+
+    procedure fl_tooltip_set_current
+           (I : in System.Address);
+    pragma Import (C, fl_tooltip_set_current, "fl_tooltip_set_current");
+
+    function fl_tooltip_enabled
+        return Interfaces.C.int;
+    pragma Import (C, fl_tooltip_enabled, "fl_tooltip_enabled");
+
+    procedure fl_tooltip_enable
+           (V : in Interfaces.C.int);
+    pragma Import (C, fl_tooltip_enable, "fl_tooltip_enable");
+
+    procedure fl_tooltip_enter_area
+           (I          : in System.Address;
+            X, Y, W, H : in Interfaces.C.int;
+            T          : in Interfaces.C.char_array);
+    pragma Import (C, fl_tooltip_enter_area, "fl_tooltip_enter_area");
+
+
+
+
+    function fl_tooltip_get_delay
+        return Interfaces.C.C_float;
+    pragma Import (C, fl_tooltip_get_delay, "fl_tooltip_get_delay");
+
+    procedure fl_tooltip_set_delay
+           (V : in Interfaces.C.C_float);
+    pragma Import (C, fl_tooltip_set_delay, "fl_tooltip_set_delay");
+
+    function fl_tooltip_get_hoverdelay
+        return Interfaces.C.C_float;
+    pragma Import (C, fl_tooltip_get_hoverdelay, "fl_tooltip_get_hoverdelay");
+
+    procedure fl_tooltip_set_hoverdelay
+           (V : in Interfaces.C.C_float);
+    pragma Import (C, fl_tooltip_set_hoverdelay, "fl_tooltip_set_hoverdelay");
+
+
+
+
+    function fl_tooltip_get_color
+        return Interfaces.C.unsigned;
+    pragma Import (C, fl_tooltip_get_color, "fl_tooltip_get_color");
+
+    procedure fl_tooltip_set_color
+           (V : in Interfaces.C.unsigned);
+    pragma Import (C, fl_tooltip_set_color, "fl_tooltip_set_color");
+
+    function fl_tooltip_get_margin_height
+        return Interfaces.C.int;
+    pragma Import (C, fl_tooltip_get_margin_height, "fl_tooltip_get_margin_height");
+
+    --  procedure fl_tooltip_set_margin_height
+    --         (V : in Interfaces.C.int);
+    --  pragma Import (C, fl_tooltip_set_margin_height, "fl_tooltip_set_margin_height");
+
+    function fl_tooltip_get_margin_width
+        return Interfaces.C.int;
+    pragma Import (C, fl_tooltip_get_margin_width, "fl_tooltip_get_margin_width");
+
+    --  procedure fl_tooltip_set_margin_width
+    --         (V : in Interfaces.C.int);
+    --  pragma Import (C, fl_tooltip_set_margin_width, "fl_tooltip_set_margin_width");
+
+    function fl_tooltip_get_wrap_width
+        return Interfaces.C.int;
+    pragma Import (C, fl_tooltip_get_wrap_width, "fl_tooltip_get_wrap_width");
+
+    --  procedure fl_tooltip_set_wrap_width
+    --         (V : in Interfaces.C.int);
+    --  pragma Import (C, fl_tooltip_set_wrap_width, "fl_tooltip_set_wrap_width");
+
+
+
+
+    function fl_tooltip_get_textcolor
+        return Interfaces.C.unsigned;
+    pragma Import (C, fl_tooltip_get_textcolor, "fl_tooltip_get_textcolor");
+
+    procedure fl_tooltip_set_textcolor
+           (V : in Interfaces.C.unsigned);
+    pragma Import (C, fl_tooltip_set_textcolor, "fl_tooltip_set_textcolor");
+
+    function fl_tooltip_get_font
+        return Interfaces.C.int;
+    pragma Import (C, fl_tooltip_get_font, "fl_tooltip_get_font");
+
+    procedure fl_tooltip_set_font
+           (V : in Interfaces.C.int);
+    pragma Import (C, fl_tooltip_set_font, "fl_tooltip_set_font");
+
+    function fl_tooltip_get_size
+        return Interfaces.C.int;
+    pragma Import (C, fl_tooltip_get_size, "fl_tooltip_get_size");
+
+    procedure fl_tooltip_set_size
+           (V : in Interfaces.C.int);
+    pragma Import (C, fl_tooltip_set_size, "fl_tooltip_set_size");
+
+
+
+
+    function fl_widget_get_user_data
+           (W : in System.Address)
+        return System.Address;
+    pragma Import (C, fl_widget_get_user_data, "fl_widget_get_user_data");
+
+    package Widget_Convert is new
+        System.Address_To_Access_Conversions (FLTK.Widgets.Widget'Class);
+
+
+
+
+    function Get_Target
+        return access FLTK.Widgets.Widget'Class
+    is
+        Widget_Ptr : System.Address := fl_tooltip_get_current;
+        Actual_Widget : access FLTK.Widgets.Widget'Class :=
+            Widget_Convert.To_Pointer (fl_widget_get_user_data (Widget_Ptr));
+    begin
+        return Actual_Widget;
+    end Get_Target;
+
+
+    procedure Set_Target
+           (To : in FLTK.Widgets.Widget'Class) is
+    begin
+        fl_tooltip_set_current (Wrapper (To).Void_Ptr);
+    end Set_Target;
+
+
+    function Is_Enabled
+        return Boolean is
+    begin
+        return fl_tooltip_enabled /= 0;
+    end Is_Enabled;
+
+
+    procedure Set_Enabled
+           (To : in Boolean) is
+    begin
+        fl_tooltip_enable (Boolean'Pos (To));
+    end Set_Enabled;
+
+
+    procedure Enter_Area
+           (Item       : in FLTK.Widgets.Widget'Class;
+            X, Y, W, H : in Integer;
+            Tip        : in String) is
+    begin
+        fl_tooltip_enter_area
+           (Wrapper (Item).Void_Ptr,
+            Interfaces.C.int (X),
+            Interfaces.C.int (Y),
+            Interfaces.C.int (W),
+            Interfaces.C.int (H),
+            Interfaces.C.To_C (Tip));
+    end Enter_Area;
+
+
+
+
+    function Get_Delay
+        return Float is
+    begin
+        return Float (fl_tooltip_get_delay);
+    end Get_Delay;
+
+
+    procedure Set_Delay
+           (To : in Float) is
+    begin
+        fl_tooltip_set_delay (Interfaces.C.C_float (To));
+    end Set_Delay;
+
+
+    function Get_Hover_Delay
+        return Float is
+    begin
+        return Float (fl_tooltip_get_hoverdelay);
+    end Get_Hover_Delay;
+
+
+    procedure Set_Hover_Delay
+           (To : in Float) is
+    begin
+        fl_tooltip_set_hoverdelay (Interfaces.C.C_float (To));
+    end Set_Hover_Delay;
+
+
+
+
+    function Get_Background_Color
+        return Color is
+    begin
+        return Color (fl_tooltip_get_color);
+    end Get_Background_Color;
+
+
+    procedure Set_Background_Color
+           (To : in Color) is
+    begin
+        fl_tooltip_set_color (Interfaces.C.unsigned (To));
+    end Set_Background_Color;
+
+
+    function Get_Margin_Height
+        return Natural is
+    begin
+        return Natural (fl_tooltip_get_margin_height);
+    end Get_Margin_Height;
+
+
+    --  procedure Set_Margin_Height
+    --         (To : in Natural) is
+    --  begin
+    --      fl_tooltip_set_margin_height (Interfaces.C.int (To));
+    --  end Set_Margin_Height;
+
+
+    function Get_Margin_Width
+        return Natural is
+    begin
+        return Natural (fl_tooltip_get_margin_width);
+    end Get_Margin_Width;
+
+
+    --  procedure Set_Margin_Width
+    --         (To : in Natural) is
+    --  begin
+    --      fl_tooltip_set_margin_width (Interfaces.C.int (To));
+    --  end Set_Margin_Width;
+
+
+    function Get_Wrap_Width
+        return Natural is
+    begin
+        return Natural (fl_tooltip_get_wrap_width);
+    end Get_Wrap_Width;
+
+
+    --  procedure Set_Wrap_Width
+    --         (To : in Natural) is
+    --  begin
+    --      fl_tooltip_set_wrap_width (Interfaces.C.int (To));
+    --  end Set_Wrap_Width;
+
+
+
+
+    function Get_Text_Color
+        return Color is
+    begin
+        return Color (fl_tooltip_get_textcolor);
+    end Get_Text_Color;
+
+
+    procedure Set_Text_Color
+           (To : in Color) is
+    begin
+        fl_tooltip_set_textcolor (Interfaces.C.unsigned (To));
+    end Set_Text_Color;
+
+
+    function Get_Text_Font
+        return Font_Kind is
+    begin
+        return Font_Kind'Val (fl_tooltip_get_font);
+    end Get_Text_Font;
+
+
+    procedure Set_Text_Font
+           (To : in Font_Kind) is
+    begin
+        fl_tooltip_set_font (Font_Kind'Pos (To));
+    end Set_Text_Font;
+
+
+    function Get_Text_Size
+        return Font_Size is
+    begin
+        return Font_Size (fl_tooltip_get_size);
+    end Get_Text_Size;
+
+
+    procedure Set_Text_Size
+           (To : in Font_Size) is
+    begin
+        fl_tooltip_set_size (Interfaces.C.int (To));
+    end Set_Text_Size;
+
+
+end FLTK.Tooltips;
+
diff --git a/src/fltk-tooltips.ads b/src/fltk-tooltips.ads
new file mode 100644
index 0000000..153825f
--- /dev/null
+++ b/src/fltk-tooltips.ads
@@ -0,0 +1,93 @@
+
+
+with
+
+    FLTK.Widgets;
+
+
+package FLTK.Tooltips is
+
+
+    function Get_Target
+        return access FLTK.Widgets.Widget'Class;
+
+    procedure Set_Target
+           (To : in FLTK.Widgets.Widget'Class);
+
+    function Is_Enabled
+        return Boolean;
+
+    procedure Set_Enabled
+           (To : in Boolean);
+
+    procedure Enter_Area
+           (Item       : in FLTK.Widgets.Widget'Class;
+            X, Y, W, H : in Integer;
+            Tip        : in String);
+
+
+
+
+    function Get_Delay
+        return Float;
+
+    procedure Set_Delay
+           (To : in Float);
+
+    function Get_Hover_Delay
+        return Float;
+
+    procedure Set_Hover_Delay
+           (To : in Float);
+
+
+
+
+    function Get_Background_Color
+        return Color;
+
+    procedure Set_Background_Color
+           (To : in Color);
+
+    function Get_Margin_Height
+        return Natural;
+
+    --  procedure Set_Margin_Height
+    --         (To : in Natural);
+
+    function Get_Margin_Width
+        return Natural;
+
+    --  procedure Set_Margin_Width
+    --         (To : in Natural);
+
+    function Get_Wrap_Width
+        return Natural;
+
+    --  procedure Set_Wrap_Width
+    --         (To : in Natural);
+
+
+
+
+    function Get_Text_Color
+        return Color;
+
+    procedure Set_Text_Color
+           (To : in Color);
+
+    function Get_Text_Font
+        return Font_Kind;
+
+    procedure Set_Text_Font
+           (To : in Font_Kind);
+
+    function Get_Text_Size
+        return Font_Size;
+
+    procedure Set_Text_Size
+           (To : in Font_Size);
+
+
+end FLTK.Tooltips;
+