From d9b29d2242b7384f4a9a0e7b424dd54fd9fcb740 Mon Sep 17 00:00:00 2001
From: Jedidiah Barber <contact@jedbarber.id.au>
Date: Tue, 4 Feb 2025 12:59:16 +1300
Subject: Filled holes in Fl_Widget binding
---
body/c_fl_table.cpp | 2 +-
body/c_fl_table.h | 2 +-
body/c_fl_widget.cpp | 112 +++++++--
body/c_fl_widget.h | 33 ++-
body/fltk-widgets-groups-tables.adb | 4 +-
body/fltk-widgets.adb | 456 ++++++++++++++++++++++++++++++++----
6 files changed, 540 insertions(+), 69 deletions(-)
(limited to 'body')
diff --git a/body/c_fl_table.cpp b/body/c_fl_table.cpp
index b7b83e2..b264c1e 100644
--- a/body/c_fl_table.cpp
+++ b/body/c_fl_table.cpp
@@ -199,7 +199,7 @@ void fl_table_do_callback(TABLE t, int x, int r, int c) {
static_cast<Fl_Table*>(t)->do_callback(static_cast<Fl_Table::TableContext>(x), r, c);
}
-void fl_table_when(TABLE t, unsigned int w) {
+void fl_table_when(TABLE t, unsigned char w) {
static_cast<Fl_Table*>(t)->when(static_cast<Fl_When>(w));
}
diff --git a/body/c_fl_table.h b/body/c_fl_table.h
index a291301..d93ef4f 100644
--- a/body/c_fl_table.h
+++ b/body/c_fl_table.h
@@ -51,7 +51,7 @@ extern "C" int fl_table_callback_col(TABLE t);
extern "C" int fl_table_callback_row(TABLE t);
extern "C" int fl_table_callback_context(TABLE t);
extern "C" void fl_table_do_callback(TABLE t, int x, int r, int c);
-extern "C" void fl_table_when(TABLE t, unsigned int w);
+extern "C" void fl_table_when(TABLE t, unsigned char w);
extern "C" void fl_table_scroll_cb(void * s, TABLE t);
diff --git a/body/c_fl_widget.cpp b/body/c_fl_widget.cpp
index 6eda9e3..d226305 100644
--- a/body/c_fl_widget.cpp
+++ b/body/c_fl_widget.cpp
@@ -23,8 +23,10 @@ extern "C" int widget_handle_hook(void * ud, int e);
class Friend_Widget : Fl_Widget {
public:
- // probably expand this later when doing a pass for protected methods
+ using Fl_Widget::draw_backdrop;
using Fl_Widget::draw_box;
+ using Fl_Widget::draw_focus;
+ using Fl_Widget::draw_label;
};
@@ -131,6 +133,9 @@ void fl_widget_clear_output(WIDGET w) {
static_cast<Fl_Widget*>(w)->clear_output();
}
+
+
+
int fl_widget_visible(WIDGET w) {
return static_cast<Fl_Widget*>(w)->visible();
}
@@ -147,6 +152,14 @@ void fl_widget_clear_visible(WIDGET w) {
static_cast<Fl_Widget*>(w)->clear_visible();
}
+void fl_widget_show(WIDGET w) {
+ static_cast<Fl_Widget*>(w)->show();
+}
+
+void fl_widget_hide(WIDGET w) {
+ static_cast<Fl_Widget*>(w)->hide();
+}
+
@@ -154,10 +167,18 @@ int fl_widget_get_visible_focus(WIDGET w) {
return static_cast<Fl_Widget*>(w)->visible_focus();
}
+void fl_widget_set_visible_focus2(WIDGET w) {
+ static_cast<Fl_Widget*>(w)->set_visible_focus();
+}
+
void fl_widget_set_visible_focus(WIDGET w, int f) {
static_cast<Fl_Widget*>(w)->visible_focus(f);
}
+void fl_widget_clear_visible_focus(WIDGET w) {
+ static_cast<Fl_Widget*>(w)->clear_visible_focus();
+}
+
int fl_widget_take_focus(WIDGET w) {
return static_cast<Fl_Widget*>(w)->take_focus();
}
@@ -185,6 +206,10 @@ void fl_widget_set_selection_color(WIDGET w, unsigned int c) {
static_cast<Fl_Widget*>(w)->selection_color(c);
}
+void fl_widget_set_colors(WIDGET w, unsigned int b, unsigned int s) {
+ static_cast<Fl_Widget*>(w)->color(b, s);
+}
+
@@ -293,11 +318,15 @@ void fl_widget_set_callback(WIDGET w, void * cb) {
static_cast<Fl_Widget*>(w)->callback(reinterpret_cast<Fl_Callback_p>(cb));
}
-unsigned int fl_widget_get_when(WIDGET w) {
+void fl_widget_default_callback(WIDGET w, void * ud) {
+ Fl_Widget::default_callback(static_cast<Fl_Widget*>(w), ud);
+}
+
+unsigned char fl_widget_get_when(WIDGET w) {
return static_cast<Fl_Widget*>(w)->when();
}
-void fl_widget_set_when(WIDGET w, unsigned int c) {
+void fl_widget_set_when(WIDGET w, unsigned char c) {
static_cast<Fl_Widget*>(w)->when(c);
}
@@ -324,6 +353,10 @@ void fl_widget_size(WIDGET w, int d, int h) {
static_cast<Fl_Widget*>(w)->size(d, h);
}
+void fl_widget_resize(WIDGET o, int x, int y, int w, int h) {
+ static_cast<Fl_Widget*>(o)->resize(x, y, w, h);
+}
+
void fl_widget_position(WIDGET w, int x, int y) {
static_cast<Fl_Widget*>(w)->position(x, y);
}
@@ -353,24 +386,20 @@ void fl_widget_set_type(WIDGET w, unsigned char t) {
-int fl_widget_damage(WIDGET w) {
+unsigned char fl_widget_damage(WIDGET w) {
return static_cast<Fl_Widget*>(w)->damage();
}
-void fl_widget_set_damage(WIDGET w, int t) {
- if (t != 0) {
- static_cast<Fl_Widget*>(w)->damage(0xff);
- } else {
- static_cast<Fl_Widget*>(w)->damage(0x00);
- }
+void fl_widget_set_damage(WIDGET w, unsigned char m) {
+ static_cast<Fl_Widget*>(w)->damage(m);
}
-void fl_widget_set_damage2(WIDGET w, int t, int x, int y, int d, int h) {
- if (t != 0) {
- static_cast<Fl_Widget*>(w)->damage(0xff,x,y,d,h);
- } else {
- static_cast<Fl_Widget*>(w)->damage(0x00,x,y,d,h);
- }
+void fl_widget_set_damage2(WIDGET w, unsigned char m, int x, int y, int d, int h) {
+ static_cast<Fl_Widget*>(w)->damage(m, x, y, d, h);
+}
+
+void fl_widget_clear_damage(WIDGET w, unsigned char m) {
+ static_cast<Fl_Widget*>(w)->clear_damage(m);
}
void fl_widget_draw(WIDGET w) {
@@ -381,8 +410,48 @@ void fl_widget_draw(WIDGET w) {
// and makes uniform the implementation of the Ada Widget Draw subprogram.
}
-void fl_widget_draw_label(WIDGET w, int x, int y, int d, int h, unsigned int a) {
- static_cast<Fl_Widget*>(w)->draw_label(x,y,d,h,a);
+void fl_widget_draw_label(WIDGET w) {
+ void (Fl_Widget::*mydraw)(void) const = &Friend_Widget::draw_label;
+ (static_cast<Fl_Widget*>(w)->*mydraw)();
+}
+
+void fl_widget_draw_label2(WIDGET o, int x, int y, int w, int h) {
+ void (Fl_Widget::*mydraw)(int,int,int,int) const = &Friend_Widget::draw_label;
+ (static_cast<Fl_Widget*>(o)->*mydraw)(x, y, w, h);
+}
+
+void fl_widget_draw_label3(WIDGET w, int x, int y, int d, int h, unsigned int a) {
+ static_cast<Fl_Widget*>(w)->draw_label(x, y, d, h, a);
+}
+
+void fl_widget_draw_backdrop(WIDGET w) {
+ (static_cast<Fl_Widget*>(w)->*(&Friend_Widget::draw_backdrop))();
+}
+
+void fl_widget_draw_box(WIDGET w) {
+ void (Fl_Widget::*mydraw)(void) const = &Friend_Widget::draw_box;
+ (static_cast<Fl_Widget*>(w)->*mydraw)();
+}
+
+void fl_widget_draw_box2(WIDGET w, int k, unsigned int h) {
+ void (Fl_Widget::*mydraw)(Fl_Boxtype,Fl_Color) const = &Friend_Widget::draw_box;
+ (static_cast<Fl_Widget*>(w)->*mydraw)(static_cast<Fl_Boxtype>(k), static_cast<Fl_Color>(h));
+}
+
+void fl_widget_draw_box3(WIDGET o, int k, int x, int y, int w, int h, unsigned int c) {
+ void (Fl_Widget::*mydraw)(Fl_Boxtype,int,int,int,int,Fl_Color) const = &Friend_Widget::draw_box;
+ (static_cast<Fl_Widget*>(o)->*mydraw)
+ (static_cast<Fl_Boxtype>(k), x, y, w, h, static_cast<Fl_Color>(c));
+}
+
+void fl_widget_draw_focus(WIDGET w) {
+ void (Fl_Widget::*mydraw)(void) = &Friend_Widget::draw_focus;
+ (static_cast<Fl_Widget*>(w)->*mydraw)();
+}
+
+void fl_widget_draw_focus2(WIDGET o, int k, int x, int y, int w, int h) {
+ void (Fl_Widget::*mydraw)(Fl_Boxtype,int,int,int,int) const = &Friend_Widget::draw_focus;
+ (static_cast<Fl_Widget*>(o)->*mydraw)(static_cast<Fl_Boxtype>(k), x, y, w, h);
}
void fl_widget_redraw(WIDGET w) {
@@ -398,3 +467,10 @@ int fl_widget_handle(WIDGET w, int e) {
}
+
+
+int fl_widget_use_accents_menu(WIDGET w) {
+ return static_cast<Fl_Widget*>(w)->use_accents_menu();
+}
+
+
diff --git a/body/c_fl_widget.h b/body/c_fl_widget.h
index 9634ba4..2ac2630 100644
--- a/body/c_fl_widget.h
+++ b/body/c_fl_widget.h
@@ -33,14 +33,20 @@ extern "C" void fl_widget_clear_changed(WIDGET w);
extern "C" int fl_widget_output(WIDGET w);
extern "C" void fl_widget_set_output(WIDGET w);
extern "C" void fl_widget_clear_output(WIDGET w);
+
+
extern "C" int fl_widget_visible(WIDGET w);
extern "C" int fl_widget_visible_r(WIDGET w);
extern "C" void fl_widget_set_visible(WIDGET w);
extern "C" void fl_widget_clear_visible(WIDGET w);
+extern "C" void fl_widget_show(WIDGET w);
+extern "C" void fl_widget_hide(WIDGET w);
extern "C" int fl_widget_get_visible_focus(WIDGET w);
+extern "C" void fl_widget_set_visible_focus2(WIDGET w);
extern "C" void fl_widget_set_visible_focus(WIDGET w, int f);
+extern "C" void fl_widget_clear_visible_focus(WIDGET w);
extern "C" int fl_widget_take_focus(WIDGET w);
extern "C" int fl_widget_takesevents(WIDGET w);
@@ -49,6 +55,7 @@ extern "C" unsigned int fl_widget_get_color(WIDGET w);
extern "C" void fl_widget_set_color(WIDGET w, unsigned int b);
extern "C" unsigned int fl_widget_get_selection_color(WIDGET w);
extern "C" void fl_widget_set_selection_color(WIDGET w, unsigned int c);
+extern "C" void fl_widget_set_colors(WIDGET w, unsigned int b, unsigned int s);
extern "C" void * fl_widget_get_parent(WIDGET w);
@@ -81,8 +88,9 @@ extern "C" void fl_widget_measure_label(WIDGET w, int &d, int &h);
extern "C" void fl_widget_set_callback(WIDGET w, void * cb);
-extern "C" unsigned int fl_widget_get_when(WIDGET w);
-extern "C" void fl_widget_set_when(WIDGET w, unsigned int c);
+extern "C" void fl_widget_default_callback(WIDGET w, void * ud);
+extern "C" unsigned char fl_widget_get_when(WIDGET w);
+extern "C" void fl_widget_set_when(WIDGET w, unsigned char c);
extern "C" int fl_widget_get_x(WIDGET w);
@@ -90,6 +98,7 @@ extern "C" int fl_widget_get_y(WIDGET w);
extern "C" int fl_widget_get_w(WIDGET w);
extern "C" int fl_widget_get_h(WIDGET w);
extern "C" void fl_widget_size(WIDGET w, int d, int h);
+extern "C" void fl_widget_resize(WIDGET o, int x, int y, int w, int h);
extern "C" void fl_widget_position(WIDGET w, int x, int y);
@@ -101,16 +110,28 @@ extern "C" unsigned char fl_widget_get_type(WIDGET w);
extern "C" void fl_widget_set_type(WIDGET w, unsigned char t);
-extern "C" int fl_widget_damage(WIDGET w);
-extern "C" void fl_widget_set_damage(WIDGET w, int t);
-extern "C" void fl_widget_set_damage2(WIDGET w, int t, int x, int y, int d, int h);
+extern "C" unsigned char fl_widget_damage(WIDGET w);
+extern "C" void fl_widget_set_damage(WIDGET w, unsigned char m);
+extern "C" void fl_widget_set_damage2(WIDGET w, unsigned char m, int x, int y, int d, int h);
+extern "C" void fl_widget_clear_damage(WIDGET w, unsigned char m);
extern "C" void fl_widget_draw(WIDGET w);
-extern "C" void fl_widget_draw_label(WIDGET w, int x, int y, int d, int h, unsigned int a);
+extern "C" void fl_widget_draw_label(WIDGET w);
+extern "C" void fl_widget_draw_label2(WIDGET o, int x, int y, int w, int h);
+extern "C" void fl_widget_draw_label3(WIDGET w, int x, int y, int d, int h, unsigned int a);
+extern "C" void fl_widget_draw_backdrop(WIDGET w);
+extern "C" void fl_widget_draw_box(WIDGET w);
+extern "C" void fl_widget_draw_box2(WIDGET w, int k, unsigned int h);
+extern "C" void fl_widget_draw_box3(WIDGET o, int k, int x, int y, int w, int h, unsigned int c);
+extern "C" void fl_widget_draw_focus(WIDGET w);
+extern "C" void fl_widget_draw_focus2(WIDGET o, int k, int x, int y, int w, int h);
extern "C" void fl_widget_redraw(WIDGET w);
extern "C" void fl_widget_redraw_label(WIDGET w);
extern "C" int fl_widget_handle(WIDGET w, int e);
+extern "C" int fl_widget_use_accents_menu(WIDGET w);
+
+
#endif
diff --git a/body/fltk-widgets-groups-tables.adb b/body/fltk-widgets-groups-tables.adb
index 30cc642..061deb4 100644
--- a/body/fltk-widgets-groups-tables.adb
+++ b/body/fltk-widgets-groups-tables.adb
@@ -192,7 +192,7 @@ package body FLTK.Widgets.Groups.Tables is
procedure fl_table_when
(T : in Storage.Integer_Address;
- W : in Interfaces.C.unsigned);
+ W : in Interfaces.C.unsigned_char);
pragma Import (C, fl_table_when, "fl_table_when");
pragma Inline (fl_table_when);
@@ -1109,7 +1109,7 @@ package body FLTK.Widgets.Groups.Tables is
(This : in out Table;
Value : in Callback_Flag) is
begin
- fl_table_when (This.Void_Ptr, Interfaces.C.unsigned (Value));
+ fl_table_when (This.Void_Ptr, Flag_To_UChar (Value));
end Set_When;
diff --git a/body/fltk-widgets.adb b/body/fltk-widgets.adb
index 4518491..87ae432 100644
--- a/body/fltk-widgets.adb
+++ b/body/fltk-widgets.adb
@@ -16,6 +16,7 @@ use type
Interfaces.C.int,
Interfaces.C.unsigned,
+ Interfaces.C.unsigned_char,
Interfaces.C.Strings.chars_ptr;
@@ -29,7 +30,26 @@ package body FLTK.Widgets is
(Left, Right : in Callback_Flag)
return Callback_Flag is
begin
- return Left or Right;
+ return
+ (Changed => Left.Changed or Right.Changed,
+ Interact => Left.Interact or Right.Interact,
+ Release => Left.Release or Right.Release,
+ Enter_Key => Left.Enter_Key or Right.Enter_Key);
+ end "+";
+
+
+ function "+"
+ (Left, Right : in Damage_Mask)
+ return Damage_Mask is
+ begin
+ return
+ (Child => Left.Child or Right.Child,
+ Expose => Left.Expose or Right.Expose,
+ Scroll => Left.Scroll or Right.Scroll,
+ Overlay => Left.Overlay or Right.Overlay,
+ User_1 => Left.User_1 or Right.User_1,
+ User_2 => Left.User_2 or Right.User_2,
+ Full => Left.Full or Right.Full);
end "+";
@@ -128,6 +148,9 @@ package body FLTK.Widgets is
pragma Import (C, fl_widget_clear_output, "fl_widget_clear_output");
pragma Inline (fl_widget_clear_output);
+
+
+
function fl_widget_visible
(W : in Storage.Integer_Address)
return Interfaces.C.int;
@@ -150,6 +173,16 @@ package body FLTK.Widgets is
pragma Import (C, fl_widget_clear_visible, "fl_widget_clear_visible");
pragma Inline (fl_widget_clear_visible);
+ procedure fl_widget_show
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_widget_show, "fl_widget_show");
+ pragma Inline (fl_widget_show);
+
+ procedure fl_widget_hide
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_widget_hide, "fl_widget_hide");
+ pragma Inline (fl_widget_hide);
+
@@ -159,12 +192,22 @@ package body FLTK.Widgets is
pragma Import (C, fl_widget_get_visible_focus, "fl_widget_get_visible_focus");
pragma Inline (fl_widget_get_visible_focus);
+ procedure fl_widget_set_visible_focus2
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_widget_set_visible_focus2, "fl_widget_set_visible_focus2");
+ pragma Inline (fl_widget_set_visible_focus2);
+
procedure fl_widget_set_visible_focus
(W : in Storage.Integer_Address;
T : in Interfaces.C.int);
pragma Import (C, fl_widget_set_visible_focus, "fl_widget_set_visible_focus");
pragma Inline (fl_widget_set_visible_focus);
+ procedure fl_widget_clear_visible_focus
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_widget_clear_visible_focus, "fl_widget_clear_visible_focus");
+ pragma Inline (fl_widget_clear_visible_focus);
+
function fl_widget_take_focus
(W : in Storage.Integer_Address)
return Interfaces.C.int;
@@ -204,6 +247,12 @@ package body FLTK.Widgets is
pragma Import (C, fl_widget_set_selection_color, "fl_widget_set_selection_color");
pragma Inline (fl_widget_set_selection_color);
+ procedure fl_widget_set_colors
+ (W : in Storage.Integer_Address;
+ B, S : in Interfaces.C.unsigned);
+ pragma Import (C, fl_widget_set_colors, "fl_widget_set_colors");
+ pragma Inline (fl_widget_set_colors);
+
@@ -354,15 +403,20 @@ package body FLTK.Widgets is
pragma Import (C, fl_widget_set_callback, "fl_widget_set_callback");
pragma Inline (fl_widget_set_callback);
+ procedure fl_widget_default_callback
+ (W, U : in Storage.Integer_Address);
+ pragma Import (C, fl_widget_default_callback, "fl_widget_default_callback");
+ pragma Inline (fl_widget_default_callback);
+
function fl_widget_get_when
(W : in Storage.Integer_Address)
- return Interfaces.C.unsigned;
+ return Interfaces.C.unsigned_char;
pragma Import (C, fl_widget_get_when, "fl_widget_get_when");
pragma Inline (fl_widget_get_when);
procedure fl_widget_set_when
(W : in Storage.Integer_Address;
- T : in Interfaces.C.unsigned);
+ T : in Interfaces.C.unsigned_char);
pragma Import (C, fl_widget_set_when, "fl_widget_set_when");
pragma Inline (fl_widget_set_when);
@@ -399,6 +453,12 @@ package body FLTK.Widgets is
pragma Import (C, fl_widget_size, "fl_widget_size");
pragma Inline (fl_widget_size);
+ procedure fl_widget_resize
+ (O : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int);
+ pragma Import (C, fl_widget_resize, "fl_widget_resize");
+ pragma Inline (fl_widget_resize);
+
procedure fl_widget_position
(W : in Storage.Integer_Address;
X, Y : in Interfaces.C.int);
@@ -423,29 +483,86 @@ package body FLTK.Widgets is
function fl_widget_damage
(W : in Storage.Integer_Address)
- return Interfaces.C.int;
+ return Interfaces.C.unsigned_char;
pragma Import (C, fl_widget_damage, "fl_widget_damage");
pragma Inline (fl_widget_damage);
procedure fl_widget_set_damage
(W : in Storage.Integer_Address;
- T : in Interfaces.C.int);
+ M : in Interfaces.C.unsigned_char);
pragma Import (C, fl_widget_set_damage, "fl_widget_set_damage");
pragma Inline (fl_widget_set_damage);
procedure fl_widget_set_damage2
- (W : in Storage.Integer_Address;
- T : in Interfaces.C.int;
+ (W : in Storage.Integer_Address;
+ M : in Interfaces.C.unsigned_char;
X, Y, D, H : in Interfaces.C.int);
pragma Import (C, fl_widget_set_damage2, "fl_widget_set_damage2");
pragma Inline (fl_widget_set_damage2);
+ procedure fl_widget_clear_damage
+ (W : in Storage.Integer_Address;
+ M : in Interfaces.C.unsigned_char);
+ pragma Import (C, fl_widget_clear_damage, "fl_widget_clear_damage");
+ pragma Inline (fl_widget_clear_damage);
+
+ procedure fl_widget_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_widget_draw, "fl_widget_draw");
+ pragma Inline (fl_widget_draw);
+
procedure fl_widget_draw_label
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_widget_draw_label, "fl_widget_draw_label");
+ pragma Inline (fl_widget_draw_label);
+
+ procedure fl_widget_draw_label2
+ (O : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int);
+ pragma Import (C, fl_widget_draw_label2, "fl_widget_draw_label2");
+ pragma Inline (fl_widget_draw_label2);
+
+ procedure fl_widget_draw_label3
(W : in Storage.Integer_Address;
X, Y, D, H : in Interfaces.C.int;
A : in Interfaces.C.unsigned);
- pragma Import (C, fl_widget_draw_label, "fl_widget_draw_label");
- pragma Inline (fl_widget_draw_label);
+ pragma Import (C, fl_widget_draw_label3, "fl_widget_draw_label3");
+ pragma Inline (fl_widget_draw_label3);
+
+ procedure fl_widget_draw_backdrop
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_widget_draw_backdrop, "fl_widget_draw_backdrop");
+ pragma Inline (fl_widget_draw_backdrop);
+
+ procedure fl_widget_draw_box
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_widget_draw_box, "fl_widget_draw_box");
+ pragma Inline (fl_widget_draw_box);
+
+ procedure fl_widget_draw_box2
+ (W : in Storage.Integer_Address;
+ K : in Interfaces.C.int;
+ H : in Interfaces.C.unsigned);
+ pragma Import (C, fl_widget_draw_box2, "fl_widget_draw_box2");
+ pragma Inline (fl_widget_draw_box2);
+
+ procedure fl_widget_draw_box3
+ (O : in Storage.Integer_Address;
+ K, X, Y, W, H : in Interfaces.C.int;
+ C : in Interfaces.C.unsigned);
+ pragma Import (C, fl_widget_draw_box3, "fl_widget_draw_box3");
+ pragma Inline (fl_widget_draw_box3);
+
+ procedure fl_widget_draw_focus
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_widget_draw_focus, "fl_widget_draw_focus");
+ pragma Inline (fl_widget_draw_focus);
+
+ procedure fl_widget_draw_focus2
+ (O : in Storage.Integer_Address;
+ K, X, Y, W, H : in Interfaces.C.int);
+ pragma Import (C, fl_widget_draw_focus2, "fl_widget_draw_focus2");
+ pragma Inline (fl_widget_draw_focus2);
procedure fl_widget_redraw
(W : in Storage.Integer_Address);
@@ -457,14 +574,6 @@ package body FLTK.Widgets is
pragma Import (C, fl_widget_redraw_label, "fl_widget_redraw_label");
pragma Inline (fl_widget_redraw_label);
-
-
-
- procedure fl_widget_draw
- (W : in Storage.Integer_Address);
- pragma Import (C, fl_widget_draw, "fl_widget_draw");
- pragma Inline (fl_widget_draw);
-
function fl_widget_handle
(W : in Storage.Integer_Address;
E : in Interfaces.C.int)
@@ -475,6 +584,15 @@ package body FLTK.Widgets is
+ function fl_widget_use_accents_menu
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_widget_use_accents_menu, "fl_widget_use_accents_menu");
+ pragma Inline (fl_widget_use_accents_menu);
+
+
+
+
----------------------
-- Exported Hooks --
----------------------
@@ -634,6 +752,13 @@ package body FLTK.Widgets is
end Is_Tree_Active;
+ procedure Set_Active
+ (This : in out Widget) is
+ begin
+ fl_widget_set_active (This.Void_Ptr);
+ end Set_Active;
+
+
procedure Set_Active
(This : in out Widget;
To : in Boolean) is
@@ -646,6 +771,13 @@ package body FLTK.Widgets is
end Set_Active;
+ procedure Clear_Active
+ (This : in out Widget) is
+ begin
+ fl_widget_clear_active (This.Void_Ptr);
+ end Clear_Active;
+
+
function Has_Changed
@@ -656,6 +788,13 @@ package body FLTK.Widgets is
end Has_Changed;
+ procedure Set_Changed
+ (This : in out Widget) is
+ begin
+ fl_widget_set_changed (This.Void_Ptr);
+ end Set_Changed;
+
+
procedure Set_Changed
(This : in out Widget;
To : in Boolean) is
@@ -668,6 +807,13 @@ package body FLTK.Widgets is
end Set_Changed;
+ procedure Clear_Changed
+ (This : in out Widget) is
+ begin
+ fl_widget_clear_changed (This.Void_Ptr);
+ end Clear_Changed;
+
+
function Is_Output_Only
(This : in Widget)
return Boolean is
@@ -676,6 +822,13 @@ package body FLTK.Widgets is
end Is_Output_Only;
+ procedure Set_Output_Only
+ (This : in out Widget) is
+ begin
+ fl_widget_set_output (This.Void_Ptr);
+ end Set_Output_Only;
+
+
procedure Set_Output_Only
(This : in out Widget;
To : in Boolean) is
@@ -688,6 +841,15 @@ package body FLTK.Widgets is
end Set_Output_Only;
+ procedure Clear_Output_Only
+ (This : in out Widget) is
+ begin
+ fl_widget_clear_output (This.Void_Ptr);
+ end Clear_Output_Only;
+
+
+
+
function Is_Visible
(This : in Widget)
return Boolean is
@@ -704,6 +866,13 @@ package body FLTK.Widgets is
end Is_Tree_Visible;
+ procedure Set_Visible
+ (This : in out Widget) is
+ begin
+ fl_widget_set_visible (This.Void_Ptr);
+ end Set_Visible;
+
+
procedure Set_Visible
(This : in out Widget;
To : in Boolean) is
@@ -716,6 +885,27 @@ package body FLTK.Widgets is
end Set_Visible;
+ procedure Clear_Visible
+ (This : in out Widget) is
+ begin
+ fl_widget_clear_visible (This.Void_Ptr);
+ end Clear_Visible;
+
+
+ procedure Show
+ (This : in out Widget) is
+ begin
+ fl_widget_show (This.Void_Ptr);
+ end Show;
+
+
+ procedure Hide
+ (This : in out Widget) is
+ begin
+ fl_widget_hide (This.Void_Ptr);
+ end Hide;
+
+
function Has_Visible_Focus
@@ -726,6 +916,13 @@ package body FLTK.Widgets is
end Has_Visible_Focus;
+ procedure Set_Visible_Focus
+ (This : in out Widget) is
+ begin
+ fl_widget_set_visible_focus2 (This.Void_Ptr);
+ end Set_Visible_Focus;
+
+
procedure Set_Visible_Focus
(This : in out Widget;
To : in Boolean) is
@@ -734,6 +931,13 @@ package body FLTK.Widgets is
end Set_Visible_Focus;
+ procedure Clear_Visible_Focus
+ (This : in out Widget) is
+ begin
+ fl_widget_clear_visible_focus (This.Void_Ptr);
+ end Clear_Visible_Focus;
+
+
function Take_Focus
(This : in out Widget)
return Boolean is
@@ -784,6 +988,17 @@ package body FLTK.Widgets is
end Set_Selection_Color;
+ procedure Set_Colors
+ (This : in out Widget;
+ Back, Sel : in Color) is
+ begin
+ fl_widget_set_colors
+ (This.Void_Ptr,
+ Interfaces.C.unsigned (Back),
+ Interfaces.C.unsigned (Sel));
+ end Set_Colors;
+
+
function Parent
@@ -862,8 +1077,8 @@ package body FLTK.Widgets is
function Top_Window_Offset
- (This : in Widget;
- Offset_X, Offset_Y : out Integer)
+ (This : in Widget;
+ Offset_X, Offset_Y : out Integer)
return access FLTK.Widgets.Groups.Windows.Window'Class
is
Window_Ptr : Storage.Integer_Address := fl_widget_top_window_offset
@@ -904,9 +1119,15 @@ package body FLTK.Widgets is
function Get_Box
(This : in Widget)
- return Box_Kind is
+ return Box_Kind
+ is
+ Result : Interfaces.C.int := fl_widget_get_box (This.Void_Ptr);
begin
- return Box_Kind'Val (fl_widget_get_box (This.Void_Ptr));
+ return Box_Kind'Val (Result);
+ exception
+ when Constraint_Error => raise Internal_FLTK_Error with
+ "Fl_Widget::box returned unexpected int value of " &
+ Interfaces.C.int'Image (Result);
end Get_Box;
@@ -965,6 +1186,16 @@ package body FLTK.Widgets is
end Set_Label;
+ procedure Set_Label
+ (This : in out Widget;
+ Kind : in Label_Kind;
+ Text : in String) is
+ begin
+ This.Set_Label_Kind (Kind);
+ This.Set_Label (Text);
+ end Set_Label;
+
+
function Get_Label_Color
(This : in Widget)
return Color is
@@ -1076,11 +1307,30 @@ package body FLTK.Widgets is
end Do_Callback;
+ procedure Do_Callback
+ (This : in Widget;
+ Using : in out Widget) is
+ begin
+ if This.Callback /= null then
+ This.Callback.all (Using);
+ end if;
+ end Do_Callback;
+
+
+ procedure Default_Callback
+ (This : in out Widget'Class) is
+ begin
+ fl_widget_default_callback
+ (This.Void_Ptr,
+ fl_widget_get_user_data (This.Void_Ptr));
+ end Default_Callback;
+
+
function Get_When
(This : in Widget)
return Callback_Flag is
begin
- return Callback_Flag (fl_widget_get_when (This.Void_Ptr));
+ return UChar_To_Flag (fl_widget_get_when (This.Void_Ptr));
end Get_When;
@@ -1088,7 +1338,7 @@ package body FLTK.Widgets is
(This : in out Widget;
To : in Callback_Flag) is
begin
- fl_widget_set_when (This.Void_Ptr, Interfaces.C.unsigned (To));
+ fl_widget_set_when (This.Void_Ptr, Flag_To_UChar (To));
end Set_When;
@@ -1131,9 +1381,22 @@ package body FLTK.Widgets is
W, H : in Integer) is
begin
fl_widget_size
- (This.Void_Ptr,
- Interfaces.C.int (W),
- Interfaces.C.int (H));
+ (This.Void_Ptr,
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Resize;
+
+
+ procedure Resize
+ (This : in out Widget;
+ X, Y, W, H : in Integer) is
+ begin
+ fl_widget_resize
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
end Resize;
@@ -1142,9 +1405,9 @@ package body FLTK.Widgets is
X, Y : in Integer) is
begin
fl_widget_position
- (This.Void_Ptr,
- Interfaces.C.int (X),
- Interfaces.C.int (Y));
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y));
end Reposition;
@@ -1198,27 +1461,43 @@ package body FLTK.Widgets is
end Is_Damaged;
- procedure Set_Damaged
+ function Get_Damage
+ (This : in Widget)
+ return Damage_Mask is
+ begin
+ return UChar_To_Mask (fl_widget_damage (This.Void_Ptr));
+ end Get_Damage;
+
+
+ procedure Set_Damage
(This : in out Widget;
- To : in Boolean) is
+ Mask : in Damage_Mask) is
begin
- fl_widget_set_damage (This.Void_Ptr, Boolean'Pos (To));
- end Set_Damaged;
+ fl_widget_set_damage (This.Void_Ptr, Mask_To_UChar (Mask));
+ end Set_Damage;
- procedure Set_Damaged
+ procedure Set_Damage
(This : in out Widget;
- To : in Boolean;
+ Mask : in Damage_Mask;
X, Y, W, H : in Integer) is
begin
fl_widget_set_damage2
(This.Void_Ptr,
- Boolean'Pos (To),
+ Mask_To_UChar (Mask),
Interfaces.C.int (X),
Interfaces.C.int (Y),
Interfaces.C.int (W),
Interfaces.C.int (H));
- end Set_Damaged;
+ end Set_Damage;
+
+
+ procedure Clear_Damage
+ (This : in out Widget;
+ Mask : in Damage_Mask := Damage_None) is
+ begin
+ fl_widget_clear_damage (This.Void_Ptr, Mask_To_UChar (Mask));
+ end Clear_Damage;
procedure Draw
@@ -1234,11 +1513,31 @@ package body FLTK.Widgets is
procedure Draw_Label
- (This : in Widget;
- X, Y, W, H : in Integer;
- Align : in Alignment) is
+ (This : in out Widget) is
+ begin
+ fl_widget_draw_label (This.Void_Ptr);
+ end Draw_Label;
+
+
+ procedure Draw_Label
+ (This : in out Widget;
+ X, Y, W, H : in Integer) is
+ begin
+ fl_widget_draw_label2
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Draw_Label;
+
+
+ procedure Draw_Label
+ (This : in out Widget;
+ X, Y, W, H : in Integer;
+ Align : in Alignment) is
begin
- fl_widget_draw_label
+ fl_widget_draw_label3
(This.Void_Ptr,
Interfaces.C.int (X),
Interfaces.C.int (Y),
@@ -1248,6 +1547,71 @@ package body FLTK.Widgets is
end Draw_Label;
+ procedure Draw_Backdrop
+ (This : in out Widget) is
+ begin
+ fl_widget_draw_backdrop (This.Void_Ptr);
+ end Draw_Backdrop;
+
+
+ procedure Draw_Box
+ (This : in out Widget) is
+ begin
+ fl_widget_draw_box (This.Void_Ptr);
+ end Draw_Box;
+
+
+ procedure Draw_Box
+ (This : in out Widget;
+ Kind : in Box_Kind;
+ Hue : in Color) is
+ begin
+ fl_widget_draw_box2
+ (This.Void_Ptr,
+ Box_Kind'Pos (Kind),
+ Interfaces.C.unsigned (Hue));
+ end Draw_Box;
+
+
+ procedure Draw_Box
+ (This : in out Widget;
+ Kind : in Box_Kind;
+ X, Y, W, H : in Integer;
+ Hue : in Color) is
+ begin
+ fl_widget_draw_box3
+ (This.Void_Ptr,
+ Box_Kind'Pos (Kind),
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.unsigned (Hue));
+ end Draw_Box;
+
+
+ procedure Draw_Focus
+ (This : in out Widget) is
+ begin
+ fl_widget_draw_focus (This.Void_Ptr);
+ end Draw_Focus;
+
+
+ procedure Draw_Focus
+ (This : in out Widget;
+ Kind : in Box_Kind;
+ X, Y, W, H : in Integer) is
+ begin
+ fl_widget_draw_focus2
+ (This.Void_Ptr,
+ Box_Kind'Pos (Kind),
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Draw_Focus;
+
+
procedure Redraw
(This : in out Widget) is
begin
@@ -1284,5 +1648,15 @@ package body FLTK.Widgets is
end Handle;
+
+
+ function Uses_Accents_Menu
+ (This : in Widget)
+ return Boolean is
+ begin
+ return fl_widget_use_accents_menu (This.Void_Ptr) /= 0;
+ end Uses_Accents_Menu;
+
+
end FLTK.Widgets;
--
cgit