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 ++++++++++++++++++++++++++++++++---- doc/fl_widget.html | 365 ++++++++++++++++++++++++----- doc/fl_window.html | 4 +- progress.txt | 1 - spec/fltk-widgets.ads | 250 ++++++++++++++++++-- 10 files changed, 1071 insertions(+), 158 deletions(-) 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; diff --git a/doc/fl_widget.html b/doc/fl_widget.html index 265af2c..419ab3b 100644 --- a/doc/fl_widget.html +++ b/doc/fl_widget.html @@ -51,6 +51,11 @@ Callback_Flag + + uchar + Damage_Mask + + @@ -86,6 +91,37 @@ function Create + + + + + + + + + + + + + + + + + + +
Static Functions and Procedures
+static void default_callback(Fl_Widget *cb, void *d);
+
+procedure Default_Callback
+       (This : in out Widget'Class);
+
+static unsigned int label_shortcut(const char *t);
+
Marked as internal use only.
+static int test_shortcut(const char *, const bool require_alt=false);
+
Marked as internal use only.
+ + + @@ -93,14 +129,14 @@ function Create - + - + @@ -161,35 +197,35 @@ procedure Set_Alignment - + - + - + - + - + @@ -229,12 +265,13 @@ function Get_Callback - + - + @@ -267,9 +304,8 @@ function Has_Changed void clear_active(); @@ -278,9 +314,8 @@ procedure Set_Active void clear_changed(); @@ -288,7 +323,11 @@ procedure Set_Changed - + @@ -296,9 +335,8 @@ void clear_damage(uchar c=0); void clear_output(); @@ -307,9 +345,8 @@ procedure Set_Output_Only void clear_visible(); @@ -318,9 +355,8 @@ procedure Set_Visible void clear_visible_focus(); @@ -350,21 +386,25 @@ procedure Set_Background_Color - + - + - + @@ -409,6 +449,10 @@ uchar damage() const; function Is_Damaged (This : in Widget) return Boolean; + +function Get_Damage + (This : in Widget) + return Damage_Mask; @@ -417,9 +461,9 @@ function Is_Damaged void damage(uchar c); @@ -428,9 +472,9 @@ procedure Set_Damaged void damage(uchar c, int x, int y, int w, int h); @@ -439,7 +483,7 @@ procedure Set_Damaged - + @@ -455,6 +499,7 @@ procedure Deactivate - - - - - + @@ -516,9 +561,9 @@ void draw_label(int, int, int, int, Fl_Align) const; @@ -549,12 +594,16 @@ function Handle - + - + @@ -610,14 +661,21 @@ function Get_Label - + - + @@ -745,7 +803,7 @@ function Parent - + @@ -783,7 +841,11 @@ procedure Redraw_Label - + @@ -812,42 +874,60 @@ procedure Set_Selection_Color - + - + - + - + - + - + @@ -887,7 +967,7 @@ function Takes_Events - + @@ -905,7 +985,9 @@ function Get_Tooltip - + @@ -925,8 +1007,8 @@ Fl_Window * top_window_offset(int &xoff, int &yoff) const; @@ -935,35 +1017,41 @@ function Top_Window_Offset - + - + - + - + - + @@ -981,7 +1069,11 @@ function Is_Visible - + @@ -1075,6 +1167,151 @@ function Get_Y
Functions and Procedures
 void _clear_fullscreen();
 Marked as internal use only. 
 void _set_fullscreen();
 Marked as internal use only. 
 long argument() const;
 Intentionally left unbound. 
 void argument(long v);
 Intentionally left unbound. 
 virtual class Fl_Gl_Window * as_gl_window();
 Use runtime tag checks and view conversions instead. 
 virtual Fl_Group * as_group();
Use runtime tag checks and view conversions insteadUse runtime tag checks and view conversions instead. 
 virtual Fl_Window * as_window();
Use runtime tag checks and view conversions insteadUse runtime tag checks and view conversions instead. 
 void callback(Fl_Callback *cb, void *p);
 Use callback(Fl_Callback *cb) / Set_Callback instead. 
 void callback(Fl_Callback *cb);
+
 void callback(Fl_Callback0 *cb);
 
@@ -248,7 +285,7 @@ procedure Set_Callback
 
 void callback(Fl_Callback1 *cb, long p=0);
 Use callback(Fl_Callback *cb) / Set_Callback instead. 
-procedure Set_Active
-       (This : in out Widget;
-        To   : in     Boolean);
+procedure Clear_Active
+       (This : in out Widget);
 
-procedure Set_Changed
-       (This : in out Widget;
-        To   : in     Boolean);
+procedure Clear_Changed
+       (This : in out Widget);
 
 void clear_damage(uchar c=0);
 
+procedure Clear_Damage
+       (This : in out Widget;
+        Mask : in     Damage_Mask := Damage_None);
+
 
-procedure Set_Output_Only
-       (This : in out Widget;
-        To   : in     Boolean);
+procedure Clear_Output_Only
+       (This : in out Widget);
 
-procedure Set_Visible
-       (This : in out Widget;
-        To   : in     Boolean);
+procedure Clear_Visible
+       (This : in out Widget);
 
-procedure Set_Visible_Focus
-       (This : in out Widget;
-        To   : in     Boolean);
+procedure Clear_Visible_Focus
+       (This : in out Widget);
 
 void color(Fl_Color bg, Fl_Color sel);
 
+procedure Set_Colors
+       (This      : in out Widget;
+        Back, Sel : in     Color);
+
 
 Fl_Color color2() const;
 Deprecated, use selection_color / Get_Selection_Color instead. 
 void color2(unsigned a);
 Deprecated, use selection_color / Set_Selection_Color instead. 
-procedure Set_Damaged
+procedure Set_Damage
        (This : in out Widget;
-        To   : in     Boolean);
+        Mask : in     Damage_Mask);
 
-procedure Set_Damaged
+procedure Set_Damage
        (This       : in out Widget;
-        To         : in     Boolean;
+        Mask       : in     Damage_Mask;
         X, Y, W, H : in     Integer);
 
 int damage_resize(int, int, int, int);
 Marked as internal use only. 
 Fl_Image * deimage();
+
 const Fl_Image * deimage() const;
 
@@ -467,6 +512,7 @@ function Get_Inactive_Image
   
 void deimage(Fl_Image *img);
+
 void deimage(Fl_Image &img);
 
@@ -489,15 +535,14 @@ procedure Do_Callback
   
 void do_callback(Fl_Widget *o, long arg);
-
 
 void do_callback(Fl_Widget *o, void *arg=0);
 
+procedure Do_Callback
+       (This  : in     Widget;
+        Using : in out Widget);
+
 
 procedure Draw_Label
-       (This       : in Widget;
-        X, Y, W, H : in Integer;
-        Align      : in Alignment);
+       (This       : in out Widget;
+        X, Y, W, H : in     Integer;
+        Align      : in     Alignment);
 
 virtual void hide();
See void clear_visible();
+procedure Hide
+       (This : in out Widget);
+
 
 Fl_Image * image();
+
 const Fl_Image * image() const;
 
@@ -567,6 +616,7 @@ function Get_Image
   
 void image(Fl_Image *img);
+
 void image(Fl_Image &img);
 
@@ -592,7 +642,8 @@ function Inside
 
 int is_label_copied() const;
 Due to the marshalling between String and char * this +would always return true, so left unbound. 
 void label(const char *text);
See void copy_label(const char *new_label);Due to the marshalling between String and char * using +this method would be pointless, so its functionality is +subsumed by copy_label / Set_Label. 
 void label(Fl_Labeltype a, const char *b);
 
+procedure Set_Label
+       (This : in out Widget;
+        Kind : in     Label_Kind;
+        Text : in     String);
+
 
 void parent(Fl_Group *p);
 Marked as internal use only. 
 virtual void resize(int x, int y, int w, int h);
 
+procedure Resize
+       (This       : in out Widget;
+        X, Y, W, H : in     Integer);
+
 
 void set_active();
See void clear_active();
+procedure Set_Active
+       (This : in out Widget);
+
 
 void set_changed();
See void clear_changed();
+procedure Set_Changed
+       (This : in out Widget);
+
 
 void set_output();
See void clear_output();
+procedure Set_Output_Only
+       (This : in out Widget);
+
 
 void set_visible();
See void clear_visible();
+procedure Set_Visible
+       (This : in out Widget);
+
 
 void set_visible_focus();
See void clear_visible_focus();
+procedure Set_Visible_Focus
+       (This : in out Widget);
+
 
 virtual void show();
 
+procedure Show
+       (This : in out Widget);
+
 
 int test_shortcut();
 Marked as internal use only. 
 void tooltip(const char *text);
See void copy_tooltip(const char *text);Due to the marshalling between String and char * using +this method would be pointless, so its functionality is +subsumed by copy_tooltip / Set_Tooltip. 
 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;
 
 uchar type() const;
 See Get_Kind subprograms in Fl_Counter, Fl_Dial, Fl_Input_, +Fl_Pack, Fl_Scroll, Fl_Slider, Fl_Spinner. 
 void type(uchar t);
 See Set_Kind subprograms in Fl_Counter, Fl_Dial, Fl_Input_, +Fl_Pack, Fl_Scroll, Fl_Slider, Fl_Spinner. 
 int use_accents_menu();
 
+function Uses_Accents_Menu
+       (This : in Widget)
+    return Boolean;
+
 
 void * user_data() const;
 Used internally by the binding. 
 void user_data(void *v);
 Used internally by the binding. 
 void visible_focus(int v);
See void clear_visible_focus();
+procedure Set_Visible_Focus
+       (This : in out Widget;
+        To   : in     Boolean);
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Protected Functions and Procedures
+void clear_flag(unsigned int c);
+
Intentionally left unbound.
+void draw_backdrop() const;
+
+procedure Draw_Backdrop
+       (This : in out Widget);
+
+void draw_box() const;
+
+procedure Draw_Box
+       (This : in out Widget);
+
+void draw_box(Fl_Boxtype t, Fl_Color c) const;
+
+procedure Draw_Box
+       (This : in out Widget;
+        Kind : in     Box_Kind;
+        Hue  : in     Color);
+
+void draw_box(Fl_Boxtype t, int x, int y, int w, int h,
+    Fl_Color c) const;
+
+procedure Draw_Box
+       (This       : in out Widget;
+        Kind       : in     Box_Kind;
+        X, Y, W, H : in     Integer;
+        Hue        : in     Color);
+
+void draw_focus();
+
+procedure Draw_Focus
+       (This : in out Widget);
+
+void draw_focus(Fl_Boxtype t, int x, int y, int w, int h) const;
+
+procedure Draw_Focus
+       (This       : in out Widget;
+        Kind       : in     Box_Kind;
+        X, Y, W, H : in     Integer);
+
+void draw_label() const;
+
+procedure Draw_Label
+       (This : in out Widget);
+
+void draw_label(int, int, int, int) const;
+
+procedure Draw_Label
+       (This       : in out Widget;
+        X, Y, W, H : in     Integer);
+
+unsigned int flags() const;
+
Intentionally left unbound.
+void h(int v);
+
Marked as internal use only.
+void set_flag(unsigned int c);
+
Intentionally left unbound.
+void w(int v);
+
Marked as internal use only.
+void x(int v);
+
Marked as internal use only.
+void y(int v);
+
Marked as internal use only.
+ + diff --git a/doc/fl_window.html b/doc/fl_window.html index bda031e..4f246b3 100644 --- a/doc/fl_window.html +++ b/doc/fl_window.html @@ -526,8 +526,8 @@ function Get_Label 
 void label(const char *);
-Due to necessary marshalling between String and char* -using this method would be pointless, so its functionality is +Due to the marshalling between String and char * using +this method would be pointless, so its functionality is subsumed by copy_label / Set_Label. diff --git a/progress.txt b/progress.txt index 3955ded..3e0fcce 100644 --- a/progress.txt +++ b/progress.txt @@ -222,7 +222,6 @@ FLTK.Text_Buffers (a few functions, protected stuff, ensure buffer is 1-indexed) Widgets with incomplete APIs: -Widgets Widgets.Groups.Scrolls (attributes, resize, type, protected) Widgets.Groups.Text_Displays (ensure text buffer is 1-indexed) diff --git a/spec/fltk-widgets.ads b/spec/fltk-widgets.ads index 07f9b2e..06d6ebb 100644 --- a/spec/fltk-widgets.ads +++ b/spec/fltk-widgets.ads @@ -14,6 +14,7 @@ limited with private with + Ada.Unchecked_Conversion, System.Address_To_Access_Conversions, Interfaces.C, FLTK.Widget_Callback_Conversions; @@ -30,13 +31,45 @@ package FLTK.Widgets is type Widget_Callback is access procedure (Item : in out Widget'Class); - type Callback_Flag is private; + + type Callback_Flag is record + Changed : Boolean := False; + Interact : Boolean := False; + Release : Boolean := False; + Enter_Key : Boolean := False; + end record; + function "+" (Left, Right : in Callback_Flag) return Callback_Flag; - Call_Never : constant Callback_Flag; - When_Changed : constant Callback_Flag; - When_Interact : constant Callback_Flag; - When_Release : constant Callback_Flag; - When_Enter_Key : constant Callback_Flag; + + Call_Never : constant Callback_Flag; + When_Changed : constant Callback_Flag; + When_Interact : constant Callback_Flag; + When_Release : constant Callback_Flag; + When_Release_Always : constant Callback_Flag; + When_Enter_Key : constant Callback_Flag; + When_Enter_Key_Always : constant Callback_Flag; + + + type Damage_Mask is record + Child : Boolean := False; + Expose : Boolean := False; + Scroll : Boolean := False; + Overlay : Boolean := False; + User_1 : Boolean := False; + User_2 : Boolean := False; + Full : Boolean := False; + end record; + + function "+" (Left, Right : in Damage_Mask) return Damage_Mask; + + Damage_None : constant Damage_Mask; + Damage_Child : constant Damage_Mask; + Damage_Expose : constant Damage_Mask; + Damage_Scroll : constant Damage_Mask; + Damage_Overlay : constant Damage_Mask; + Damage_User_1 : constant Damage_Mask; + Damage_User_2 : constant Damage_Mask; + Damage_Full : constant Damage_Mask; @@ -73,10 +106,16 @@ package FLTK.Widgets is (This : in Widget) return Boolean; + procedure Set_Active + (This : in out Widget); + procedure Set_Active (This : in out Widget; To : in Boolean); + procedure Clear_Active + (This : in out Widget); + @@ -84,18 +123,33 @@ package FLTK.Widgets is (This : in Widget) return Boolean; + procedure Set_Changed + (This : in out Widget); + procedure Set_Changed (This : in out Widget; To : in Boolean); + procedure Clear_Changed + (This : in out Widget); + function Is_Output_Only (This : in Widget) return Boolean; + procedure Set_Output_Only + (This : in out Widget); + procedure Set_Output_Only (This : in out Widget; To : in Boolean); + procedure Clear_Output_Only + (This : in out Widget); + + + + function Is_Visible (This : in Widget) return Boolean; @@ -104,10 +158,22 @@ package FLTK.Widgets is (This : in Widget) return Boolean; + procedure Set_Visible + (This : in out Widget); + procedure Set_Visible (This : in out Widget; To : in Boolean); + procedure Clear_Visible + (This : in out Widget); + + procedure Show + (This : in out Widget); + + procedure Hide + (This : in out Widget); + @@ -115,10 +181,16 @@ package FLTK.Widgets is (This : in Widget) return Boolean; + procedure Set_Visible_Focus + (This : in out Widget); + procedure Set_Visible_Focus (This : in out Widget; To : in Boolean); + procedure Clear_Visible_Focus + (This : in out Widget); + function Take_Focus (This : in out Widget) return Boolean; @@ -146,6 +218,10 @@ package FLTK.Widgets is (This : in out Widget; To : in Color); + procedure Set_Colors + (This : in out Widget; + Back, Sel : in Color); + @@ -172,8 +248,8 @@ package FLTK.Widgets is return access FLTK.Widgets.Groups.Windows.Window'Class; 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; @@ -214,6 +290,11 @@ package FLTK.Widgets is (This : in out Widget; Text : in String); + procedure Set_Label + (This : in out Widget; + Kind : in Label_Kind; + Text : in String); + function Get_Label_Color (This : in Widget) return Color; @@ -264,6 +345,13 @@ package FLTK.Widgets is procedure Do_Callback (This : in out Widget); + procedure Do_Callback + (This : in Widget; + Using : in out Widget); + + procedure Default_Callback + (This : in out Widget'Class); + function Get_When (This : in Widget) return Callback_Flag; @@ -295,6 +383,10 @@ package FLTK.Widgets is (This : in out Widget; W, H : in Integer); + procedure Resize + (This : in out Widget; + X, Y, W, H : in Integer); + procedure Reposition (This : in out Widget; X, Y : in Integer); @@ -325,22 +417,62 @@ package FLTK.Widgets is (This : in Widget) return Boolean; - procedure Set_Damaged + function Get_Damage + (This : in Widget) + return Damage_Mask; + + procedure Set_Damage (This : in out Widget; - To : in Boolean); + Mask : in Damage_Mask); - procedure Set_Damaged + procedure Set_Damage (This : in out Widget; - To : in Boolean; + Mask : in Damage_Mask; X, Y, W, H : in Integer); + procedure Clear_Damage + (This : in out Widget; + Mask : in Damage_Mask := Damage_None); + procedure Draw (This : in out Widget); procedure Draw_Label - (This : in Widget; - X, Y, W, H : in Integer; - Align : in Alignment); + (This : in out Widget); + + procedure Draw_Label + (This : in out Widget; + X, Y, W, H : in Integer); + + procedure Draw_Label + (This : in out Widget; + X, Y, W, H : in Integer; + Align : in Alignment); + + procedure Draw_Backdrop + (This : in out Widget); + + procedure Draw_Box + (This : in out Widget); + + procedure Draw_Box + (This : in out Widget; + Kind : in Box_Kind; + Hue : in Color); + + procedure Draw_Box + (This : in out Widget; + Kind : in Box_Kind; + X, Y, W, H : in Integer; + Hue : in Color); + + procedure Draw_Focus + (This : in out Widget); + + procedure Draw_Focus + (This : in out Widget; + Kind : in Box_Kind; + X, Y, W, H : in Integer); procedure Redraw (This : in out Widget); @@ -354,6 +486,14 @@ package FLTK.Widgets is return Event_Outcome; + + + -- Only relevant to MacOS + function Uses_Accents_Menu + (This : in Widget) + return Boolean; + + private @@ -391,13 +531,62 @@ private (This : in out Widget); - type Callback_Flag is new Interfaces.C.unsigned; + for Callback_Flag use record + Changed at 0 range 0 .. 0; + Interact at 0 range 1 .. 1; + Release at 0 range 2 .. 2; + Enter_Key at 0 range 3 .. 3; + end record; + + for Callback_Flag'Size use Interfaces.C.unsigned_char'Size; + + Call_Never : constant Callback_Flag := (others => False); + When_Changed : constant Callback_Flag := (Changed => True, others => False); + When_Interact : constant Callback_Flag := (Interact => True, others => False); + When_Release : constant Callback_Flag := (Release => True, others => False); + When_Enter_Key : constant Callback_Flag := (Enter_Key => True, others => False); + + When_Release_Always : constant Callback_Flag := + (Release => True, Interact => True, others => False); + When_Enter_Key_Always : constant Callback_Flag := + (Enter_Key => True, Interact => True, others => False); - Call_Never : constant Callback_Flag := 0; - When_Changed : constant Callback_Flag := 1; - When_Interact : constant Callback_Flag := 2; - When_Release : constant Callback_Flag := 4; - When_Enter_Key : constant Callback_Flag := 8; + + for Damage_Mask use record + Child at 0 range 0 .. 0; + Expose at 0 range 1 .. 1; + Scroll at 0 range 2 .. 2; + Overlay at 0 range 3 .. 3; + User_1 at 0 range 4 .. 4; + User_2 at 0 range 5 .. 5; + -- bit 6 missing + Full at 0 range 7 .. 7; + end record; + + for Damage_Mask'Size use Interfaces.C.unsigned_char'Size; + + Damage_None : constant Damage_Mask := (others => False); + Damage_Child : constant Damage_Mask := (Child => True, others => False); + Damage_Expose : constant Damage_Mask := (Expose => True, others => False); + Damage_Scroll : constant Damage_Mask := (Scroll => True, others => False); + Damage_Overlay : constant Damage_Mask := (Overlay => True, others => False); + Damage_User_1 : constant Damage_Mask := (User_1 => True, others => False); + Damage_User_2 : constant Damage_Mask := (User_2 => True, others => False); + Damage_Full : constant Damage_Mask := (Full => True, others => False); + + + function Flag_To_UChar is new + Ada.Unchecked_Conversion (Callback_Flag, Interfaces.C.unsigned_char); + + function UChar_To_Flag is new + Ada.Unchecked_Conversion (Interfaces.C.unsigned_char, Callback_Flag); + + + function Mask_To_UChar is new + Ada.Unchecked_Conversion (Damage_Mask, Interfaces.C.unsigned_char); + + function UChar_To_Mask is new + Ada.Unchecked_Conversion (Interfaces.C.unsigned_char, Damage_Mask); -- the user data portion should always be a reference back to the Ada binding @@ -457,16 +646,24 @@ private pragma Inline (Is_Active); pragma Inline (Is_Tree_Active); pragma Inline (Set_Active); + pragma Inline (Clear_Active); pragma Inline (Has_Changed); pragma Inline (Set_Changed); + pragma Inline (Clear_Changed); pragma Inline (Is_Output_Only); pragma Inline (Set_Output_Only); + pragma Inline (Clear_Output_Only); + pragma Inline (Is_Visible); pragma Inline (Set_Visible); + pragma Inline (Clear_Visible); + pragma Inline (Show); + pragma Inline (Hide); pragma Inline (Has_Visible_Focus); pragma Inline (Set_Visible_Focus); + pragma Inline (Clear_Visible_Focus); pragma Inline (Take_Focus); pragma Inline (Takes_Events); @@ -474,6 +671,7 @@ private pragma Inline (Set_Background_Color); pragma Inline (Get_Selection_Color); pragma Inline (Set_Selection_Color); + pragma Inline (Set_Colors); pragma Inline (Parent); pragma Inline (Contains); @@ -504,6 +702,7 @@ private pragma Inline (Get_Callback); pragma Inline (Set_Callback); pragma Inline (Do_Callback); + pragma Inline (Default_Callback); pragma Inline (Get_When); pragma Inline (Set_When); @@ -520,13 +719,20 @@ private pragma Inline (Set_Inactive_Image); pragma Inline (Is_Damaged); - pragma Inline (Set_Damaged); + pragma Inline (Get_Damage); + pragma Inline (Set_Damage); pragma Inline (Draw); pragma Inline (Draw_Label); + pragma Inline (Draw_Backdrop); + pragma Inline (Draw_Box); + pragma Inline (Draw_Focus); pragma Inline (Redraw); pragma Inline (Redraw_Label); pragma Inline (Handle); + pragma Inline (Uses_Accents_Menu); + end FLTK.Widgets; + -- cgit