From d9b29d2242b7384f4a9a0e7b424dd54fd9fcb740 Mon Sep 17 00:00:00 2001 From: Jedidiah Barber 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(t)->do_callback(static_cast(x), r, c); } -void fl_table_when(TABLE t, unsigned int w) { +void fl_table_when(TABLE t, unsigned char w) { static_cast(t)->when(static_cast(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(w)->clear_output(); } + + + int fl_widget_visible(WIDGET w) { return static_cast(w)->visible(); } @@ -147,6 +152,14 @@ void fl_widget_clear_visible(WIDGET w) { static_cast(w)->clear_visible(); } +void fl_widget_show(WIDGET w) { + static_cast(w)->show(); +} + +void fl_widget_hide(WIDGET w) { + static_cast(w)->hide(); +} + @@ -154,10 +167,18 @@ int fl_widget_get_visible_focus(WIDGET w) { return static_cast(w)->visible_focus(); } +void fl_widget_set_visible_focus2(WIDGET w) { + static_cast(w)->set_visible_focus(); +} + void fl_widget_set_visible_focus(WIDGET w, int f) { static_cast(w)->visible_focus(f); } +void fl_widget_clear_visible_focus(WIDGET w) { + static_cast(w)->clear_visible_focus(); +} + int fl_widget_take_focus(WIDGET w) { return static_cast(w)->take_focus(); } @@ -185,6 +206,10 @@ void fl_widget_set_selection_color(WIDGET w, unsigned int c) { static_cast(w)->selection_color(c); } +void fl_widget_set_colors(WIDGET w, unsigned int b, unsigned int s) { + static_cast(w)->color(b, s); +} + @@ -293,11 +318,15 @@ void fl_widget_set_callback(WIDGET w, void * cb) { static_cast(w)->callback(reinterpret_cast(cb)); } -unsigned int fl_widget_get_when(WIDGET w) { +void fl_widget_default_callback(WIDGET w, void * ud) { + Fl_Widget::default_callback(static_cast(w), ud); +} + +unsigned char fl_widget_get_when(WIDGET w) { return static_cast(w)->when(); } -void fl_widget_set_when(WIDGET w, unsigned int c) { +void fl_widget_set_when(WIDGET w, unsigned char c) { static_cast(w)->when(c); } @@ -324,6 +353,10 @@ void fl_widget_size(WIDGET w, int d, int h) { static_cast(w)->size(d, h); } +void fl_widget_resize(WIDGET o, int x, int y, int w, int h) { + static_cast(o)->resize(x, y, w, h); +} + void fl_widget_position(WIDGET w, int x, int y) { static_cast(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(w)->damage(); } -void fl_widget_set_damage(WIDGET w, int t) { - if (t != 0) { - static_cast(w)->damage(0xff); - } else { - static_cast(w)->damage(0x00); - } +void fl_widget_set_damage(WIDGET w, unsigned char m) { + static_cast(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(w)->damage(0xff,x,y,d,h); - } else { - static_cast(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(w)->damage(m, x, y, d, h); +} + +void fl_widget_clear_damage(WIDGET w, unsigned char m) { + static_cast(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(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(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(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(w)->draw_label(x, y, d, h, a); +} + +void fl_widget_draw_backdrop(WIDGET w) { + (static_cast(w)->*(&Friend_Widget::draw_backdrop))(); +} + +void fl_widget_draw_box(WIDGET w) { + void (Fl_Widget::*mydraw)(void) const = &Friend_Widget::draw_box; + (static_cast(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(w)->*mydraw)(static_cast(k), static_cast(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(o)->*mydraw) + (static_cast(k), x, y, w, h, static_cast(c)); +} + +void fl_widget_draw_focus(WIDGET w) { + void (Fl_Widget::*mydraw)(void) = &Friend_Widget::draw_focus; + (static_cast(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(o)->*mydraw)(static_cast(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(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