diff options
author | Jedidiah Barber <contact@jedbarber.id.au> | 2025-01-21 00:53:56 +1300 |
---|---|---|
committer | Jedidiah Barber <contact@jedbarber.id.au> | 2025-01-21 00:53:56 +1300 |
commit | f9e453e3d456514066e8ecbed9fbac93a588a0d0 (patch) | |
tree | 06587afde830fb324d5ab7372f0f1686c4fd993a /src | |
parent | 67a43ef89ba41ac32b86cda7396c16fffaf691b3 (diff) |
Using the type method is now more consistent
Diffstat (limited to 'src')
24 files changed, 253 insertions, 174 deletions
diff --git a/src/c_fl_scroll.cpp b/src/c_fl_scroll.cpp index 59bb8c2..5fd3240 100644 --- a/src/c_fl_scroll.cpp +++ b/src/c_fl_scroll.cpp @@ -71,8 +71,12 @@ void fl_scroll_to(SCROLL s, int x, int y) { static_cast<Fl_Scroll*>(s)->scroll_to(x, y); } -void fl_scroll_set_type(SCROLL s, int t) { - static_cast<Fl_Scroll*>(s)->type(t); +int fl_scroll_xposition(SCROLL s) { + return static_cast<Fl_Scroll*>(s)->xposition(); +} + +int fl_scroll_yposition(SCROLL s) { + return static_cast<Fl_Scroll*>(s)->yposition(); } @@ -86,14 +90,6 @@ void fl_scroll_set_size(SCROLL s, int t) { static_cast<Fl_Scroll*>(s)->scrollbar_size(t); } -int fl_scroll_xposition(SCROLL s) { - return static_cast<Fl_Scroll*>(s)->xposition(); -} - -int fl_scroll_yposition(SCROLL s) { - return static_cast<Fl_Scroll*>(s)->yposition(); -} - diff --git a/src/c_fl_scroll.h b/src/c_fl_scroll.h index a6f3767..fe8674e 100644 --- a/src/c_fl_scroll.h +++ b/src/c_fl_scroll.h @@ -20,13 +20,12 @@ extern "C" void * fl_scroll_scrollbar(SCROLL s); extern "C" void fl_scroll_to(SCROLL s, int x, int y); -extern "C" void fl_scroll_set_type(SCROLL s, int t); +extern "C" int fl_scroll_xposition(SCROLL s); +extern "C" int fl_scroll_yposition(SCROLL s); extern "C" int fl_scroll_get_size(SCROLL s); extern "C" void fl_scroll_set_size(SCROLL s, int t); -extern "C" int fl_scroll_xposition(SCROLL s); -extern "C" int fl_scroll_yposition(SCROLL s); extern "C" void fl_scroll_draw(SCROLL s); diff --git a/src/c_fl_spinner.cpp b/src/c_fl_spinner.cpp index a278c84..67a5312 100644 --- a/src/c_fl_spinner.cpp +++ b/src/c_fl_spinner.cpp @@ -146,11 +146,11 @@ void fl_spinner_set_format(SPINNER n, const char * f) { static_cast<Fl_Spinner*>(n)->format(f); } -int fl_spinner_get_type(SPINNER n) { +unsigned char fl_spinner_get_type(SPINNER n) { return static_cast<Fl_Spinner*>(n)->type(); } -void fl_spinner_set_type(SPINNER n, int t) { +void fl_spinner_set_type(SPINNER n, unsigned char t) { static_cast<Fl_Spinner*>(n)->type(t); } diff --git a/src/c_fl_spinner.h b/src/c_fl_spinner.h index d92e6e1..7447c33 100644 --- a/src/c_fl_spinner.h +++ b/src/c_fl_spinner.h @@ -40,8 +40,8 @@ extern "C" void fl_spinner_set_value(SPINNER n, double t); extern "C" const char * fl_spinner_get_format(SPINNER n); extern "C" void fl_spinner_set_format(SPINNER n, const char * f); -extern "C" int fl_spinner_get_type(SPINNER n); -extern "C" void fl_spinner_set_type(SPINNER n, int t); +extern "C" unsigned char fl_spinner_get_type(SPINNER n); +extern "C" void fl_spinner_set_type(SPINNER n, unsigned char t); extern "C" void fl_spinner_resize(SPINNER n, int x, int y, int w, int h); diff --git a/src/fltk-file_choosers.adb b/src/fltk-file_choosers.adb index 3eee496..5662f8a 100644 --- a/src/fltk-file_choosers.adb +++ b/src/fltk-file_choosers.adb @@ -1118,7 +1118,7 @@ package body FLTK.File_Choosers is end Set_Text_Size; - function Get_Chooser_Kind + function Get_Kind (This : in File_Chooser) return Chooser_Kind is @@ -1127,16 +1127,18 @@ package body FLTK.File_Choosers is pragma Assert (Ret in 0 .. Chooser_Kind'Pos (Chooser_Kind'Last)); return Chooser_Kind'Val (Ret); exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Get_Chooser_Kind; + when Chk.Assertion_Error => raise Internal_FLTK_Error with + "Fl_File_Chooser::type returned unexpected int value of " & + Interfaces.C.int'Image (Ret); + end Get_Kind; - procedure Set_Chooser_Kind + procedure Set_Kind (This : in out File_Chooser; Kind : in Chooser_Kind) is begin fl_file_chooser_set_type (This.Void_Ptr, Chooser_Kind'Pos (Kind)); - end Set_Chooser_Kind; + end Set_Kind; diff --git a/src/fltk-file_choosers.ads b/src/fltk-file_choosers.ads index cea7b36..927ae04 100644 --- a/src/fltk-file_choosers.ads +++ b/src/fltk-file_choosers.ads @@ -238,11 +238,11 @@ package FLTK.File_Choosers is (This : in out File_Chooser; Size : in Font_Size); - function Get_Chooser_Kind + function Get_Kind (This : in File_Chooser) return Chooser_Kind; - procedure Set_Chooser_Kind + procedure Set_Kind (This : in out File_Chooser; Kind : in Chooser_Kind); @@ -379,7 +379,7 @@ private pragma Inline (Set_Text_Font); pragma Inline (Get_Text_Size); pragma Inline (Set_Text_Size); - pragma Inline (Set_Chooser_Kind); + pragma Inline (Set_Kind); pragma Inline (Number_Selected); pragma Inline (Get_Filter_Index); diff --git a/src/fltk-menu_items.adb b/src/fltk-menu_items.adb index 5bd2519..d68eb60 100644 --- a/src/fltk-menu_items.adb +++ b/src/fltk-menu_items.adb @@ -470,7 +470,7 @@ package body FLTK.Menu_Items is end Set_Label_Size; - function Get_Label_Type + function Get_Label_Kind (This : in Menu_Item) return Label_Kind is @@ -481,15 +481,15 @@ package body FLTK.Menu_Items is when Constraint_Error => raise Internal_FLTK_Error with "Fl_Menu_Item::labeltype returned unexpected Kind value of " & Interfaces.C.int'Image (Result); - end Get_Label_Type; + end Get_Label_Kind; - procedure Set_Label_Type + procedure Set_Label_Kind (This : in out Menu_Item; To : in Label_Kind) is begin fl_menu_item_set_labeltype (This.Void_Ptr, Label_Kind'Pos (To)); - end Set_Label_Type; + end Set_Label_Kind; diff --git a/src/fltk-menu_items.ads b/src/fltk-menu_items.ads index 5c300d3..ac80984 100644 --- a/src/fltk-menu_items.ads +++ b/src/fltk-menu_items.ads @@ -124,11 +124,11 @@ package FLTK.Menu_Items is (This : in out Menu_Item; To : in Font_Size); - function Get_Label_Type + function Get_Label_Kind (This : in Menu_Item) return Label_Kind; - procedure Set_Label_Type + procedure Set_Label_Kind (This : in out Menu_Item; To : in Label_Kind); @@ -219,8 +219,8 @@ private pragma Inline (Set_Label_Font); pragma Inline (Get_Label_Size); pragma Inline (Set_Label_Size); - pragma Inline (Get_Label_Type); - pragma Inline (Set_Label_Type); + pragma Inline (Get_Label_Kind); + pragma Inline (Set_Label_Kind); pragma Inline (Get_Shortcut); pragma Inline (Set_Shortcut); diff --git a/src/fltk-widgets-groups-packed.adb b/src/fltk-widgets-groups-packed.adb index e7b34a4..126da76 100644 --- a/src/fltk-widgets-groups-packed.adb +++ b/src/fltk-widgets-groups-packed.adb @@ -43,18 +43,6 @@ package body FLTK.Widgets.Groups.Packed is pragma Import (C, fl_pack_set_spacing, "fl_pack_set_spacing"); pragma Inline (fl_pack_set_spacing); - function fl_widget_get_type - (P : 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 - (P : 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); - @@ -173,22 +161,26 @@ package body FLTK.Widgets.Groups.Packed is end Set_Spacing; - function Get_Pack_Type + function Get_Kind (This : in Packed_Group) - return Pack_Kind is + return Pack_Kind + is + Result : Interfaces.C.unsigned_char := fl_widget_get_type (This.Void_Ptr); begin - return Pack_Kind'Val (fl_widget_get_type (This.Void_Ptr)); + return Pack_Kind'Val (Result); exception - when Constraint_Error => raise Internal_FLTK_Error; - end Get_Pack_Type; + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Pack::type returned unexpected unsigned char value of " & + Interfaces.C.unsigned_char'Image (Result); + end Get_Kind; - procedure Set_Pack_Type + procedure Set_Kind (This : in out Packed_Group; Kind : in Pack_Kind) is begin fl_widget_set_type (This.Void_Ptr, Pack_Kind'Pos (Kind)); - end Set_Pack_Type; + end Set_Kind; diff --git a/src/fltk-widgets-groups-packed.ads b/src/fltk-widgets-groups-packed.ads index 4369fe7..60a6c2a 100644 --- a/src/fltk-widgets-groups-packed.ads +++ b/src/fltk-widgets-groups-packed.ads @@ -43,11 +43,11 @@ package FLTK.Widgets.Groups.Packed is (This : in out Packed_Group; To : in Integer); - function Get_Pack_Type + function Get_Kind (This : in Packed_Group) return Pack_Kind; - procedure Set_Pack_Type + procedure Set_Kind (This : in out Packed_Group; Kind : in Pack_Kind); @@ -82,8 +82,8 @@ private pragma Inline (Get_Spacing); pragma Inline (Set_Spacing); - pragma Inline (Get_Pack_Type); - pragma Inline (Set_Pack_Type); + pragma Inline (Get_Kind); + pragma Inline (Set_Kind); pragma Inline (Draw); diff --git a/src/fltk-widgets-groups-scrolls.adb b/src/fltk-widgets-groups-scrolls.adb index 061299c..a4885dc 100644 --- a/src/fltk-widgets-groups-scrolls.adb +++ b/src/fltk-widgets-groups-scrolls.adb @@ -8,6 +8,10 @@ with Interfaces.C; +use type + + Interfaces.C.unsigned_char; + package body FLTK.Widgets.Groups.Scrolls is @@ -52,11 +56,17 @@ package body FLTK.Widgets.Groups.Scrolls is pragma Import (C, fl_scroll_to, "fl_scroll_to"); pragma Inline (fl_scroll_to); - procedure fl_scroll_set_type - (S : in Storage.Integer_Address; - T : in Interfaces.C.int); - pragma Import (C, fl_scroll_set_type, "fl_scroll_set_type"); - pragma Inline (fl_scroll_set_type); + function fl_scroll_xposition + (S : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_scroll_xposition, "fl_scroll_xposition"); + pragma Inline (fl_scroll_xposition); + + function fl_scroll_yposition + (S : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_scroll_yposition, "fl_scroll_yposition"); + pragma Inline (fl_scroll_yposition); @@ -73,18 +83,6 @@ package body FLTK.Widgets.Groups.Scrolls is pragma Import (C, fl_scroll_set_size, "fl_scroll_set_size"); pragma Inline (fl_scroll_set_size); - function fl_scroll_xposition - (S : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_scroll_xposition, "fl_scroll_xposition"); - pragma Inline (fl_scroll_xposition); - - function fl_scroll_yposition - (S : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_scroll_yposition, "fl_scroll_yposition"); - pragma Inline (fl_scroll_yposition); - @@ -269,12 +267,20 @@ package body FLTK.Widgets.Groups.Scrolls is end Scroll_To; - procedure Set_Type - (This : in out Scroll; - Mode : in Scroll_Kind) is + function Get_Scroll_X + (This : in Scroll) + return Integer is + begin + return Integer (fl_scroll_xposition (This.Void_Ptr)); + end Get_Scroll_X; + + + function Get_Scroll_Y + (This : in Scroll) + return Integer is begin - fl_scroll_set_type (This.Void_Ptr, Scroll_Kind'Pos (Mode)); - end Set_Type; + return Integer (fl_scroll_yposition (This.Void_Ptr)); + end Get_Scroll_Y; @@ -295,20 +301,26 @@ package body FLTK.Widgets.Groups.Scrolls is end Set_Scrollbar_Size; - function Get_Scroll_X + function Get_Kind (This : in Scroll) - return Integer is + return Scroll_Kind + is + Result : Interfaces.C.unsigned_char := fl_widget_get_type (This.Void_Ptr); begin - return Integer (fl_scroll_xposition (This.Void_Ptr)); - end Get_Scroll_X; + return Scroll_Kind'Val (Result - 1); + exception + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Scroll::type returned unexpected unsigned char value of " & + Interfaces.C.unsigned_char'Image (Result); + end Get_Kind; - function Get_Scroll_Y - (This : in Scroll) - return Integer is + procedure Set_Kind + (This : in out Scroll; + Mode : in Scroll_Kind) is begin - return Integer (fl_scroll_yposition (This.Void_Ptr)); - end Get_Scroll_Y; + fl_widget_set_type (This.Void_Ptr, Scroll_Kind'Pos (Mode)); + end Set_Kind; diff --git a/src/fltk-widgets-groups-scrolls.ads b/src/fltk-widgets-groups-scrolls.ads index 9f5cdd2..f4cbad0 100644 --- a/src/fltk-widgets-groups-scrolls.ads +++ b/src/fltk-widgets-groups-scrolls.ads @@ -18,13 +18,13 @@ package FLTK.Widgets.Groups.Scrolls is with Implicit_Dereference => Data; type Scroll_Kind is - (Horizontal, - Vertical, - Both, - Always_On, - Horizontal_Always, - Vertical_Always, - Both_Always); + (Horizontal, + Vertical, + Both, + Always_On, + Horizontal_Always, + Vertical_Always, + Both_Always); @@ -68,9 +68,15 @@ package FLTK.Widgets.Groups.Scrolls is (This : in out Scroll; X, Y : in Integer); - procedure Set_Type - (This : in out Scroll; - Mode : in Scroll_Kind); + -- These two functions are far too similar in name and + -- function to the Get_X and Get_Y for Widgets. + function Get_Scroll_X + (This : in Scroll) + return Integer; + + function Get_Scroll_Y + (This : in Scroll) + return Integer; @@ -83,15 +89,13 @@ package FLTK.Widgets.Groups.Scrolls is (This : in out Scroll; To : in Integer); - -- These two functions are far too similar in name and - -- function to the Get_X and Get_Y for Widgets. - function Get_Scroll_X + function Get_Kind (This : in Scroll) - return Integer; + return Scroll_Kind; - function Get_Scroll_Y - (This : in Scroll) - return Integer; + procedure Set_Kind + (This : in out Scroll; + Mode : in Scroll_Kind); @@ -130,12 +134,13 @@ private pragma Inline (Clear); pragma Inline (Scroll_To); - pragma Inline (Set_Type); + pragma Inline (Get_Scroll_X); + pragma Inline (Get_Scroll_Y); pragma Inline (Get_Scrollbar_Size); pragma Inline (Set_Scrollbar_Size); - pragma Inline (Get_Scroll_X); - pragma Inline (Get_Scroll_Y); + pragma Inline (Get_Kind); + pragma Inline (Set_Kind); pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-groups-spinners.adb b/src/fltk-widgets-groups-spinners.adb index 00293eb..d73d3e9 100644 --- a/src/fltk-widgets-groups-spinners.adb +++ b/src/fltk-widgets-groups-spinners.adb @@ -10,7 +10,7 @@ with use type - Interfaces.C.int, + Interfaces.C.unsigned_char, Interfaces.C.Strings.chars_ptr; @@ -170,13 +170,13 @@ package body FLTK.Widgets.Groups.Spinners is function fl_spinner_get_type (S : in Storage.Integer_Address) - return Interfaces.C.int; + return Interfaces.C.unsigned_char; pragma Import (C, fl_spinner_get_type, "fl_spinner_get_type"); pragma Inline (fl_spinner_get_type); procedure fl_spinner_set_type (S : in Storage.Integer_Address; - T : in Interfaces.C.int); + T : in Interfaces.C.unsigned_char); pragma Import (C, fl_spinner_set_type, "fl_spinner_set_type"); pragma Inline (fl_spinner_set_type); @@ -483,20 +483,26 @@ package body FLTK.Widgets.Groups.Spinners is end Set_Format; - function Get_Type + function Get_Kind (This : in Spinner) - return Spinner_Kind is + return Spinner_Kind + is + Result : Interfaces.C.unsigned_char := fl_spinner_get_type (This.Void_Ptr); begin - return Spinner_Kind'Val (fl_spinner_get_type (This.Void_Ptr) - 1); - end Get_Type; + return Spinner_Kind'Val (Result - 1); + exception + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Spinner::type returned unexpected unsigned char value of " & + Interfaces.C.unsigned_char'Image (Result); + end Get_Kind; - procedure Set_Type + procedure Set_Kind (This : in out Spinner; To : in Spinner_Kind) is begin fl_spinner_set_type (This.Void_Ptr, Spinner_Kind'Pos (To) + 1); - end Set_Type; + end Set_Kind; diff --git a/src/fltk-widgets-groups-spinners.ads b/src/fltk-widgets-groups-spinners.ads index 6030946..3124dc2 100644 --- a/src/fltk-widgets-groups-spinners.ads +++ b/src/fltk-widgets-groups-spinners.ads @@ -134,11 +134,11 @@ package FLTK.Widgets.Groups.Spinners is (This : in out Spinner; To : in String); - function Get_Type + function Get_Kind (This : in Spinner) return Spinner_Kind; - procedure Set_Type + procedure Set_Kind (This : in out Spinner; To : in Spinner_Kind); @@ -203,8 +203,8 @@ private pragma Inline (Get_Value); pragma Inline (Set_Value); - pragma Inline (Get_Type); - pragma Inline (Set_Type); + pragma Inline (Get_Kind); + pragma Inline (Set_Kind); pragma Inline (Resize); diff --git a/src/fltk-widgets-inputs.adb b/src/fltk-widgets-inputs.adb index 3ba8192..0d3a3fe 100644 --- a/src/fltk-widgets-inputs.adb +++ b/src/fltk-widgets-inputs.adb @@ -586,7 +586,7 @@ package body FLTK.Widgets.Inputs is - function Get_Input_Type + function Get_Kind (This : in Input) return Input_Kind is @@ -597,8 +597,8 @@ package body FLTK.Widgets.Inputs is return V; end if; end loop; - return Normal_Kind; - end Get_Input_Type; + return Normal_Field; + end Get_Kind; function Get_Shortcut_Key @@ -930,14 +930,14 @@ package body FLTK.Widgets.Inputs is package body Extra is - procedure Set_Input_Type + procedure Set_Kind (This : in out Input; To : in Input_Kind) is begin fl_input_set_input_type (This.Void_Ptr, Input_Kind_Values (To)); - end Set_Input_Type; + end Set_Kind; - pragma Inline (Set_Input_Type); + pragma Inline (Set_Kind); end Extra; diff --git a/src/fltk-widgets-inputs.ads b/src/fltk-widgets-inputs.ads index 15c9075..c7f9c17 100644 --- a/src/fltk-widgets-inputs.ads +++ b/src/fltk-widgets-inputs.ads @@ -23,8 +23,9 @@ package FLTK.Widgets.Inputs is with Implicit_Dereference => Data; type Input_Kind is - (Normal_Kind, Float_Kind, Integer_Kind, Multiline_Kind, - Secret_Kind, Readonly_Kind, Wrap_Kind); + (Normal_Field, Float_Field, Integer_Field, Multi_In_Field, + Secret_Field, Output_Field, Multi_Out_Field, Wrap_Field, + Multi_In_Wrap_Field, Multi_Out_Wrap_Field); type Clipboard_Kind is (Selection_Buffer, Cut_Paste_Board); @@ -127,7 +128,7 @@ package FLTK.Widgets.Inputs is - function Get_Input_Type + function Get_Kind (This : in Input) return Input_Kind; @@ -283,7 +284,7 @@ package FLTK.Widgets.Inputs is package Extra is - procedure Set_Input_Type + procedure Set_Kind (This : in out Input; To : in Input_Kind); @@ -324,7 +325,7 @@ private pragma Inline (Is_Wrap); pragma Inline (Set_Wrap); - pragma Inline (Get_Input_Type); + pragma Inline (Get_Kind); pragma Inline (Get_Shortcut_Key); pragma Inline (Set_Shortcut_Key); pragma Inline (Get_Mark); @@ -358,13 +359,16 @@ private Input_Kind_Values : array (Input_Kind) of Interfaces.C.int := - (Normal_Kind => 0, - Float_Kind => 1, - Integer_Kind => 2, - Multiline_Kind => 4, - Secret_Kind => 5, - Readonly_Kind => 8, - Wrap_Kind => 16); + (Normal_Field => 0, + Float_Field => 1, + Integer_Field => 2, + Multi_In_Field => 4, + Secret_Field => 5, + Output_Field => 8, + Multi_Out_Field => 12, + Wrap_Field => 16, + Multi_In_Wrap_Field => 20, + Multi_Out_Wrap_Field => 28); function fl_input_get_value diff --git a/src/fltk-widgets-valuators-counters.adb b/src/fltk-widgets-valuators-counters.adb index 619b074..e04e180 100644 --- a/src/fltk-widgets-valuators-counters.adb +++ b/src/fltk-widgets-valuators-counters.adb @@ -309,6 +309,36 @@ package body FLTK.Widgets.Valuators.Counters is end Handle; + + + function Get_Kind + (This : in out Counter) + return Counter_Kind + is + Result : Interfaces.C.unsigned_char := fl_widget_get_type (This.Void_Ptr); + begin + return Counter_Kind'Val (Result); + exception + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Counter::type returned unexpected unsigned char value of " & + Interfaces.C.unsigned_char'Image (Result); + end Get_Kind; + + + package body Extra is + + procedure Set_Kind + (This : in out Counter; + Value : in Counter_Kind) is + begin + fl_widget_set_type (This.Void_Ptr, Counter_Kind'Pos (Value)); + end Set_Kind; + + pragma Inline (Set_Kind); + + end Extra; + + end FLTK.Widgets.Valuators.Counters; diff --git a/src/fltk-widgets-valuators-counters.ads b/src/fltk-widgets-valuators-counters.ads index 2cb4462..fd3cea8 100644 --- a/src/fltk-widgets-valuators-counters.ads +++ b/src/fltk-widgets-valuators-counters.ads @@ -17,6 +17,8 @@ package FLTK.Widgets.Valuators.Counters is type Counter_Reference (Data : not null access Counter'Class) is limited null record with Implicit_Dereference => Data; + type Counter_Kind is (Normal_Counter, Simple_Counter); + @@ -97,6 +99,21 @@ package FLTK.Widgets.Valuators.Counters is return Event_Outcome; + + + function Get_Kind + (This : in out Counter) + return Counter_Kind; + + package Extra is + + procedure Set_Kind + (This : in out Counter; + Value : in Counter_Kind); + + end Extra; + + private @@ -138,6 +155,8 @@ private pragma Inline (Draw); pragma Inline (Handle); + pragma Inline (Get_Kind); + end FLTK.Widgets.Valuators.Counters; diff --git a/src/fltk-widgets-valuators-dials.adb b/src/fltk-widgets-valuators-dials.adb index 7905158..6dc9e69 100644 --- a/src/fltk-widgets-valuators-dials.adb +++ b/src/fltk-widgets-valuators-dials.adb @@ -286,26 +286,30 @@ package body FLTK.Widgets.Valuators.Dials is - function Get_Dial_Type + function Get_Kind (This : in Dial) - return Dial_Kind is + return Dial_Kind + is + Result : Interfaces.C.unsigned_char := fl_widget_get_type (This.Void_Ptr); begin - return Dial_Kind'Val (fl_widget_get_type (This.Void_Ptr)); + return Dial_Kind'Val (Result); exception - when Constraint_Error => raise Internal_FLTK_Error; - end Get_Dial_Type; + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Dial::type returned unexpected unsigned char value of " & + Interfaces.C.unsigned_char'Image (Result); + end Get_Kind; package body Extra is - procedure Set_Dial_Type + procedure Set_Kind (This : in out Dial; To : in Dial_Kind) is begin fl_widget_set_type (This.Void_Ptr, Dial_Kind'Pos (To)); - end Set_Dial_Type; + end Set_Kind; - pragma Inline (Set_Dial_Type); + pragma Inline (Set_Kind); end Extra; diff --git a/src/fltk-widgets-valuators-dials.ads b/src/fltk-widgets-valuators-dials.ads index 90fa4d4..036c6f1 100644 --- a/src/fltk-widgets-valuators-dials.ads +++ b/src/fltk-widgets-valuators-dials.ads @@ -17,7 +17,7 @@ package FLTK.Widgets.Valuators.Dials is type Dial_Reference (Data : not null access Dial'Class) is limited null record with Implicit_Dereference => Data; - type Dial_Kind is (Normal_Kind, Line_Kind, Fill_Kind); + type Dial_Kind is (Normal_Dial, Line_Dial, Fill_Dial); @@ -84,13 +84,13 @@ package FLTK.Widgets.Valuators.Dials is - function Get_Dial_Type + function Get_Kind (This : in Dial) return Dial_Kind; package Extra is - procedure Set_Dial_Type + procedure Set_Kind (This : in out Dial; To : in Dial_Kind); @@ -128,7 +128,7 @@ private pragma Inline (Draw); pragma Inline (Handle); - pragma Inline (Get_Dial_Type); + pragma Inline (Get_Kind); end FLTK.Widgets.Valuators.Dials; diff --git a/src/fltk-widgets-valuators-sliders.adb b/src/fltk-widgets-valuators-sliders.adb index 92f503f..b81729f 100644 --- a/src/fltk-widgets-valuators-sliders.adb +++ b/src/fltk-widgets-valuators-sliders.adb @@ -349,26 +349,30 @@ package body FLTK.Widgets.Valuators.Sliders is - function Get_Slider_Type + function Get_Kind (This : in Slider) - return Slider_Kind is + return Slider_Kind + is + Result : Interfaces.C.unsigned_char := fl_widget_get_type (This.Void_Ptr); begin - return Slider_Kind'Val (fl_widget_get_type (This.Void_Ptr)); + return Slider_Kind'Val (Result); exception - when Constraint_Error => raise Internal_FLTK_Error; - end Get_Slider_Type; + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Slider::type returned unexpected unsigned char value of " & + Interfaces.C.unsigned_char'Image (Result); + end Get_Kind; package body Extra is - procedure Set_Slider_Type + procedure Set_Kind (This : in out Slider; To : in Slider_Kind) is begin fl_widget_set_type (This.Void_Ptr, Slider_Kind'Pos (To)); - end Set_Slider_Type; + end Set_Kind; - pragma Inline (Set_Slider_Type); + pragma Inline (Set_Kind); end Extra; diff --git a/src/fltk-widgets-valuators-sliders.ads b/src/fltk-widgets-valuators-sliders.ads index 2307004..786a9f5 100644 --- a/src/fltk-widgets-valuators-sliders.ads +++ b/src/fltk-widgets-valuators-sliders.ads @@ -18,9 +18,9 @@ package FLTK.Widgets.Valuators.Sliders is with Implicit_Dereference => Data; type Slider_Kind is - (Vertical_Kind, Horizontal_Kind, - Vert_Fill_Kind, Hor_Fill_Kind, - Vert_Nice_Kind, Hor_Nice_Kind); + (Vertical_Slider, Horizontal_Slider, + Vertical_Fill_Slider, Horizontal_Fill_Slider, + Vertical_Nice_Slider, Horizontal_Nice_Slider); @@ -107,13 +107,13 @@ package FLTK.Widgets.Valuators.Sliders is - function Get_Slider_Type + function Get_Kind (This : in Slider) return Slider_Kind; package Extra is - procedure Set_Slider_Type + procedure Set_Kind (This : in out Slider; To : in Slider_Kind); @@ -152,7 +152,7 @@ private pragma Inline (Draw); pragma Inline (Handle); - pragma Inline (Get_Slider_Type); + pragma Inline (Get_Kind); end FLTK.Widgets.Valuators.Sliders; diff --git a/src/fltk-widgets.adb b/src/fltk-widgets.adb index fdfec81..a312641 100644 --- a/src/fltk-widgets.adb +++ b/src/fltk-widgets.adb @@ -1009,20 +1009,26 @@ package body FLTK.Widgets is end Set_Label_Size; - function Get_Label_Type + function Get_Label_Kind (This : in Widget) - return Label_Kind is + return Label_Kind + is + Result : Interfaces.C.int := fl_widget_get_labeltype (This.Void_Ptr); begin - return Label_Kind'Val (fl_widget_get_labeltype (This.Void_Ptr)); - end Get_Label_Type; + return Label_Kind'Val (Result); + exception + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Widget::labeltype returned unexpected int value of " & + Interfaces.C.int'Image (Result); + end Get_Label_Kind; - procedure Set_Label_Type + procedure Set_Label_Kind (This : in out Widget; Label : in Label_Kind) is begin fl_widget_set_labeltype (This.Void_Ptr, Label_Kind'Pos (Label)); - end Set_Label_Type; + end Set_Label_Kind; procedure Measure_Label diff --git a/src/fltk-widgets.ads b/src/fltk-widgets.ads index 64f9166..07f9b2e 100644 --- a/src/fltk-widgets.ads +++ b/src/fltk-widgets.ads @@ -238,11 +238,11 @@ package FLTK.Widgets is (This : in out Widget; Size : in Font_Size); - function Get_Label_Type + function Get_Label_Kind (This : in Widget) return Label_Kind; - procedure Set_Label_Type + procedure Set_Label_Kind (This : in out Widget; Label : in Label_Kind); @@ -497,8 +497,8 @@ private pragma Inline (Set_Label_Font); pragma Inline (Get_Label_Size); pragma Inline (Set_Label_Size); - pragma Inline (Get_Label_Type); - pragma Inline (Set_Label_Type); + pragma Inline (Get_Label_Kind); + pragma Inline (Set_Label_Kind); pragma Inline (Measure_Label); pragma Inline (Get_Callback); |