diff options
Diffstat (limited to 'src/fltk-tooltips.adb')
| -rw-r--r-- | src/fltk-tooltips.adb | 313 |
1 files changed, 313 insertions, 0 deletions
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; + |