summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJedidiah Barber <contact@jedbarber.id.au>2025-01-16 12:17:46 +1300
committerJedidiah Barber <contact@jedbarber.id.au>2025-01-16 12:17:46 +1300
commitba1719013e5bab82a2accb4aadfd8451c3ebc931 (patch)
tree0ce67b8257b0ed05e50704ec6a808aac0659816b /src
parent106316bcedec72c5380a7544c27be6a5c117e57a (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.cpp8
-rw-r--r--src/c_fl_choice.h4
-rw-r--r--src/c_fl_menu.cpp8
-rw-r--r--src/c_fl_menu.h4
-rw-r--r--src/c_fl_menu_button.cpp4
-rw-r--r--src/c_fl_menu_button.h1
-rw-r--r--src/fltk-widgets-menus-choices.adb42
-rw-r--r--src/fltk-widgets-menus-choices.ads21
-rw-r--r--src/fltk-widgets-menus-menu_buttons.adb24
-rw-r--r--src/fltk-widgets-menus-menu_buttons.ads7
-rw-r--r--src/fltk-widgets-menus.adb33
-rw-r--r--src/fltk-widgets-menus.ads16
-rw-r--r--src/fltk-widgets.ads13
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);