diff options
author | Jedidiah Barber <contact@jedbarber.id.au> | 2025-01-16 12:17:46 +1300 |
---|---|---|
committer | Jedidiah Barber <contact@jedbarber.id.au> | 2025-01-16 12:17:46 +1300 |
commit | ba1719013e5bab82a2accb4aadfd8451c3ebc931 (patch) | |
tree | 0ce67b8257b0ed05e50704ec6a808aac0659816b /src | |
parent | 106316bcedec72c5380a7544c27be6a5c117e57a (diff) |
Fixed bug in Fl_Choice binding, filled small hole in Fl_Menu_Button binding
Diffstat (limited to 'src')
-rw-r--r-- | src/c_fl_choice.cpp | 8 | ||||
-rw-r--r-- | src/c_fl_choice.h | 4 | ||||
-rw-r--r-- | src/c_fl_menu.cpp | 8 | ||||
-rw-r--r-- | src/c_fl_menu.h | 4 | ||||
-rw-r--r-- | src/c_fl_menu_button.cpp | 4 | ||||
-rw-r--r-- | src/c_fl_menu_button.h | 1 | ||||
-rw-r--r-- | src/fltk-widgets-menus-choices.adb | 42 | ||||
-rw-r--r-- | src/fltk-widgets-menus-choices.ads | 21 | ||||
-rw-r--r-- | src/fltk-widgets-menus-menu_buttons.adb | 24 | ||||
-rw-r--r-- | src/fltk-widgets-menus-menu_buttons.ads | 7 | ||||
-rw-r--r-- | src/fltk-widgets-menus.adb | 33 | ||||
-rw-r--r-- | src/fltk-widgets-menus.ads | 16 | ||||
-rw-r--r-- | src/fltk-widgets.ads | 13 |
13 files changed, 111 insertions, 74 deletions
diff --git a/src/c_fl_choice.cpp b/src/c_fl_choice.cpp index e8c8374..0b7c65c 100644 --- a/src/c_fl_choice.cpp +++ b/src/c_fl_choice.cpp @@ -60,12 +60,12 @@ int fl_choice_value(CHOICE c) { return reinterpret_cast<Fl_Choice*>(c)->value(); } -int fl_choice_set_value(CHOICE c, int p) { - return reinterpret_cast<Fl_Choice*>(c)->value(p); +int fl_choice_set_value(CHOICE c, void * i) { + return reinterpret_cast<Fl_Choice*>(c)->value(reinterpret_cast<Fl_Menu_Item*>(i)); } -int fl_choice_set_value2(CHOICE c, void * i) { - return reinterpret_cast<Fl_Choice*>(c)->value(reinterpret_cast<Fl_Menu_Item*>(i)); +int fl_choice_set_value2(CHOICE c, int p) { + return reinterpret_cast<Fl_Choice*>(c)->value(p); } diff --git a/src/c_fl_choice.h b/src/c_fl_choice.h index 5d076b1..031e67e 100644 --- a/src/c_fl_choice.h +++ b/src/c_fl_choice.h @@ -16,8 +16,8 @@ extern "C" void free_fl_choice(CHOICE b); extern "C" int fl_choice_value(CHOICE c); -extern "C" int fl_choice_set_value(CHOICE c, int p); -extern "C" int fl_choice_set_value2(CHOICE c, void * i); +extern "C" int fl_choice_set_value(CHOICE c, void * i); +extern "C" int fl_choice_set_value2(CHOICE c, int p); extern "C" void fl_choice_draw(CHOICE n); diff --git a/src/c_fl_menu.cpp b/src/c_fl_menu.cpp index 2ae9289..e42e985 100644 --- a/src/c_fl_menu.cpp +++ b/src/c_fl_menu.cpp @@ -153,12 +153,12 @@ int fl_menu_value(MENU m) { return static_cast<Fl_Menu_*>(m)->value(); } -int fl_menu_set_value(MENU m, int p) { - return static_cast<Fl_Menu_*>(m)->value(p); +int fl_menu_set_value(MENU m, void * i) { + return static_cast<Fl_Menu_*>(m)->value(static_cast<Fl_Menu_Item*>(i)); } -int fl_menu_set_value2(MENU m, void * i) { - return static_cast<Fl_Menu_*>(m)->value(static_cast<Fl_Menu_Item*>(i)); +int fl_menu_set_value2(MENU m, int p) { + return static_cast<Fl_Menu_*>(m)->value(p); } diff --git a/src/c_fl_menu.h b/src/c_fl_menu.h index 0b046bb..17ae326 100644 --- a/src/c_fl_menu.h +++ b/src/c_fl_menu.h @@ -41,8 +41,8 @@ extern "C" int fl_menu_size(MENU m); // mvalue is subsumed by value extern "C" const char * fl_menu_text(MENU m); extern "C" int fl_menu_value(MENU m); -extern "C" int fl_menu_set_value(MENU m, int p); -extern "C" int fl_menu_set_value2(MENU m, void * i); +extern "C" int fl_menu_set_value(MENU m, void * i); +extern "C" int fl_menu_set_value2(MENU m, int p); extern "C" void fl_menu_setonly(MENU m, void * mi); diff --git a/src/c_fl_menu_button.cpp b/src/c_fl_menu_button.cpp index 4a32ca6..8866b89 100644 --- a/src/c_fl_menu_button.cpp +++ b/src/c_fl_menu_button.cpp @@ -72,10 +72,6 @@ void free_fl_menu_button(MENUBUTTON m) { -void fl_menu_button_type(MENUBUTTON m, unsigned int t) { - reinterpret_cast<Fl_Menu_Button*>(m)->type(t); -} - const void * fl_menu_button_popup(MENUBUTTON m) { return reinterpret_cast<Fl_Menu_Button*>(m)->popup(); } diff --git a/src/c_fl_menu_button.h b/src/c_fl_menu_button.h index e0e2b00..d567e4f 100644 --- a/src/c_fl_menu_button.h +++ b/src/c_fl_menu_button.h @@ -20,7 +20,6 @@ extern "C" MENUBUTTON new_fl_menu_button(int x, int y, int w, int h, char* label extern "C" void free_fl_menu_button(MENUBUTTON m); -extern "C" void fl_menu_button_type(MENUBUTTON m, unsigned int t); extern "C" const void * fl_menu_button_popup(MENUBUTTON m); diff --git a/src/fltk-widgets-menus-choices.adb b/src/fltk-widgets-menus-choices.adb index f0fb03a..09c58b8 100644 --- a/src/fltk-widgets-menus-choices.adb +++ b/src/fltk-widgets-menus-choices.adb @@ -43,14 +43,14 @@ package body FLTK.Widgets.Menus.Choices is pragma Inline (fl_choice_value); function fl_choice_set_value - (M : in Storage.Integer_Address; - I : in Interfaces.C.int) + (M, I : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_choice_set_value, "fl_choice_set_value"); pragma Inline (fl_choice_set_value); function fl_choice_set_value2 - (M, I : in Storage.Integer_Address) + (M : in Storage.Integer_Address; + I : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_choice_set_value2, "fl_choice_set_value2"); pragma Inline (fl_choice_set_value2); @@ -145,14 +145,6 @@ package body FLTK.Widgets.Menus.Choices is -- API Subprograms -- ----------------------- - function Get_Chosen - (This : in Choice) - return FLTK.Menu_Items.Menu_Item_Reference is - begin - return (Data => This.My_Items.Element (This.Chosen_Index)); - end Get_Chosen; - - function Chosen_Index (This : in Choice) return Extended_Index is @@ -162,22 +154,40 @@ package body FLTK.Widgets.Menus.Choices is procedure Set_Chosen - (This : in out Choice; - Place : in Index) + (This : in out Choice; + Item : in FLTK.Menu_Items.Menu_Item) is Ignore_Ret : Interfaces.C.int; begin - Ignore_Ret := fl_choice_set_value (This.Void_Ptr, Interfaces.C.int (Place) - 1); + Ignore_Ret := fl_choice_set_value (This.Void_Ptr, Wrapper (Item).Void_Ptr); end Set_Chosen; - procedure Set_Chosen + function Set_Chosen (This : in out Choice; Item : in FLTK.Menu_Items.Menu_Item) + return Boolean is + begin + return fl_choice_set_value (This.Void_Ptr, Wrapper (Item).Void_Ptr) /= 0; + end Set_Chosen; + + + procedure Set_Chosen + (This : in out Choice; + Place : in Index) is Ignore_Ret : Interfaces.C.int; begin - Ignore_Ret := fl_choice_set_value2 (This.Void_Ptr, Wrapper (Item).Void_Ptr); + Ignore_Ret := fl_choice_set_value2 (This.Void_Ptr, Interfaces.C.int (Place) - 1); + end Set_Chosen; + + + function Set_Chosen + (This : in out Choice; + Place : in Index) + return Boolean is + begin + return fl_choice_set_value2 (This.Void_Ptr, Interfaces.C.int (Place) - 1) /= 0; end Set_Chosen; diff --git a/src/fltk-widgets-menus-choices.ads b/src/fltk-widgets-menus-choices.ads index 86ddd60..6d12fc9 100644 --- a/src/fltk-widgets-menus-choices.ads +++ b/src/fltk-widgets-menus-choices.ads @@ -27,21 +27,27 @@ package FLTK.Widgets.Menus.Choices is - function Get_Chosen - (This : in Choice) - return FLTK.Menu_Items.Menu_Item_Reference; - function Chosen_Index (This : in Choice) return Extended_Index; procedure Set_Chosen + (This : in out Choice; + Item : in FLTK.Menu_Items.Menu_Item); + + function Set_Chosen + (This : in out Choice; + Item : in FLTK.Menu_Items.Menu_Item) + return Boolean; + + procedure Set_Chosen (This : in out Choice; Place : in Index); - procedure Set_Chosen - (This : in out Choice; - Item : in FLTK.Menu_Items.Menu_Item); + function Set_Chosen + (This : in out Choice; + Place : in Index) + return Boolean; @@ -77,7 +83,6 @@ private with Inline; - pragma Inline (Chosen); pragma Inline (Chosen_Index); pragma Inline (Set_Chosen); diff --git a/src/fltk-widgets-menus-menu_buttons.adb b/src/fltk-widgets-menus-menu_buttons.adb index ae9ae75..5d56e4d 100644 --- a/src/fltk-widgets-menus-menu_buttons.adb +++ b/src/fltk-widgets-menus-menu_buttons.adb @@ -31,12 +31,6 @@ package body FLTK.Widgets.Menus.Menu_Buttons is - procedure fl_menu_button_type - (M : in Storage.Integer_Address; - T : in Interfaces.C.unsigned); - pragma Import (C, fl_menu_button_type, "fl_menu_button_type"); - pragma Inline (fl_menu_button_type); - function fl_menu_button_popup (M : in Storage.Integer_Address) return Storage.Integer_Address; @@ -179,11 +173,25 @@ package body FLTK.Widgets.Menus.Menu_Buttons is -- API Subprograms -- ----------------------- + function Get_Popup_Kind + (This : in Menu_Button) + return Popup_Buttons + is + Result : Interfaces.C.unsigned_char := fl_widget_get_type (This.Void_Ptr); + begin + return Popup_Buttons'Val (Result); + exception + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Menu_Button::type returned unexpected Popup_Buttons value of " & + Interfaces.C.unsigned_char'Image (Result); + end Get_Popup_Kind; + + procedure Set_Popup_Kind (This : in out Menu_Button; - Pop : in Popup_Buttons) is + Kind : in Popup_Buttons) is begin - fl_menu_button_type (This.Void_Ptr, Popup_Buttons'Pos (Pop)); + fl_widget_set_type (This.Void_Ptr, Popup_Buttons'Pos (Kind)); end Set_Popup_Kind; diff --git a/src/fltk-widgets-menus-menu_buttons.ads b/src/fltk-widgets-menus-menu_buttons.ads index 4ba09a3..6d866a0 100644 --- a/src/fltk-widgets-menus-menu_buttons.ads +++ b/src/fltk-widgets-menus-menu_buttons.ads @@ -35,9 +35,13 @@ package FLTK.Widgets.Menus.Menu_Buttons is + function Get_Popup_Kind + (This : in Menu_Button) + return Popup_Buttons; + procedure Set_Popup_Kind (This : in out Menu_Button; - Pop : in Popup_Buttons); + Kind : in Popup_Buttons); function Popup (This : in out Menu_Button) @@ -77,6 +81,7 @@ private with Inline; + pragma Inline (Get_Popup_Kind); pragma Inline (Set_Popup_Kind); pragma Inline (Popup); diff --git a/src/fltk-widgets-menus.adb b/src/fltk-widgets-menus.adb index efdeec5..67c5ac9 100644 --- a/src/fltk-widgets-menus.adb +++ b/src/fltk-widgets-menus.adb @@ -192,14 +192,14 @@ package body FLTK.Widgets.Menus is pragma Inline (fl_menu_value); function fl_menu_set_value - (M : in Storage.Integer_Address; - I : in Interfaces.C.int) + (M, I : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_menu_set_value, "fl_menu_set_value"); pragma Inline (fl_menu_set_value); function fl_menu_set_value2 - (M, I : in Storage.Integer_Address) + (M : in Storage.Integer_Address; + I : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_menu_set_value2, "fl_menu_set_value2"); pragma Inline (fl_menu_set_value2); @@ -1002,7 +1002,8 @@ package body FLTK.Widgets.Menus is (This : in Menu) return FLTK.Menu_Items.Menu_Item_Reference is - Place : Extended_Index := This.Chosen_Index; + Dis_This : access constant Menu'Class := This'Access; + Place : Extended_Index := Dis_This.Chosen_Index; begin if Place = No_Index then raise No_Reference_Error; @@ -1034,40 +1035,40 @@ package body FLTK.Widgets.Menus is procedure Set_Chosen - (This : in out Menu; - Place : in Index) + (This : in out Menu; + Item : in FLTK.Menu_Items.Menu_Item) is Ignore : Interfaces.C.int; begin - Ignore := fl_menu_set_value (This.Void_Ptr, Interfaces.C.int (Place) - 1); + Ignore := fl_menu_set_value (This.Void_Ptr, Wrapper (Item).Void_Ptr); end Set_Chosen; function Set_Chosen - (This : in out Menu; - Place : in Index) + (This : in out Menu; + Item : in FLTK.Menu_Items.Menu_Item) return Boolean is begin - return fl_menu_set_value (This.Void_Ptr, Interfaces.C.int (Place) - 1) /= 0; + return fl_menu_set_value (This.Void_Ptr, Wrapper (Item).Void_Ptr) /= 0; end Set_Chosen; procedure Set_Chosen - (This : in out Menu; - Item : in FLTK.Menu_Items.Menu_Item) + (This : in out Menu; + Place : in Index) is Ignore : Interfaces.C.int; begin - Ignore := fl_menu_set_value2 (This.Void_Ptr, Wrapper (Item).Void_Ptr); + Ignore := fl_menu_set_value2 (This.Void_Ptr, Interfaces.C.int (Place) - 1); end Set_Chosen; function Set_Chosen - (This : in out Menu; - Item : in FLTK.Menu_Items.Menu_Item) + (This : in out Menu; + Place : in Index) return Boolean is begin - return fl_menu_set_value2 (This.Void_Ptr, Wrapper (Item).Void_Ptr) /= 0; + return fl_menu_set_value2 (This.Void_Ptr, Interfaces.C.int (Place) - 1) /= 0; end Set_Chosen; diff --git a/src/fltk-widgets-menus.ads b/src/fltk-widgets-menus.ads index 5285414..75670b8 100644 --- a/src/fltk-widgets-menus.ads +++ b/src/fltk-widgets-menus.ads @@ -236,21 +236,21 @@ package FLTK.Widgets.Menus is return Extended_Index; procedure Set_Chosen - (This : in out Menu; - Place : in Index); + (This : in out Menu; + Item : in FLTK.Menu_Items.Menu_Item); function Set_Chosen - (This : in out Menu; - Place : in Index) + (This : in out Menu; + Item : in FLTK.Menu_Items.Menu_Item) return Boolean; procedure Set_Chosen - (This : in out Menu; - Item : in FLTK.Menu_Items.Menu_Item); + (This : in out Menu; + Place : in Index); function Set_Chosen - (This : in out Menu; - Item : in FLTK.Menu_Items.Menu_Item) + (This : in out Menu; + Place : in Index) return Boolean; diff --git a/src/fltk-widgets.ads b/src/fltk-widgets.ads index 5765196..03c3a59 100644 --- a/src/fltk-widgets.ads +++ b/src/fltk-widgets.ads @@ -433,6 +433,19 @@ private pragma Inline (fl_widget_set_label); + function fl_widget_get_type + (W : in Storage.Integer_Address) + return Interfaces.C.unsigned_char; + pragma Import (C, fl_widget_get_type, "fl_widget_get_type"); + pragma Inline (fl_widget_get_type); + + procedure fl_widget_set_type + (W : in Storage.Integer_Address; + T : in Interfaces.C.unsigned_char); + pragma Import (C, fl_widget_set_type, "fl_widget_set_type"); + pragma Inline (fl_widget_set_type); + + pragma Inline (Activate); pragma Inline (Deactivate); pragma Inline (Is_Active); |