diff options
135 files changed, 1134 insertions, 644 deletions
diff --git a/src/fltk-widgets-boxes.adb b/src/fltk-widgets-boxes.adb index dbd8395..56c7007 100644 --- a/src/fltk-widgets-boxes.adb +++ b/src/fltk-widgets-boxes.adb @@ -72,6 +72,15 @@ package body FLTK.Widgets.Boxes is + procedure Extra_Init + (This : in out Box; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Widget (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -86,12 +95,9 @@ package body FLTK.Widgets.Boxes is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); box_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); box_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-boxes.ads b/src/fltk-widgets-boxes.ads index 5e54815..c04fe0e 100644 --- a/src/fltk-widgets-boxes.ads +++ b/src/fltk-widgets-boxes.ads @@ -44,7 +44,11 @@ private overriding procedure Finalize (This : in out Box); - + procedure Extra_Init + (This : in out Box; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Draw); diff --git a/src/fltk-widgets-buttons-enter.adb b/src/fltk-widgets-buttons-enter.adb index 5a02d10..f738461 100644 --- a/src/fltk-widgets-buttons-enter.adb +++ b/src/fltk-widgets-buttons-enter.adb @@ -70,6 +70,15 @@ package body FLTK.Widgets.Buttons.Enter is + procedure Extra_Init + (This : in out Enter_Button; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Button (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -84,14 +93,11 @@ package body FLTK.Widgets.Buttons.Enter is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); return_button_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); return_button_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-buttons-enter.ads b/src/fltk-widgets-buttons-enter.ads index 6ad882f..807697a 100644 --- a/src/fltk-widgets-buttons-enter.ads +++ b/src/fltk-widgets-buttons-enter.ads @@ -47,7 +47,11 @@ private overriding procedure Finalize (This : in out Enter_Button); - + procedure Extra_Init + (This : in out Enter_Button; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Draw); diff --git a/src/fltk-widgets-buttons-light-check.adb b/src/fltk-widgets-buttons-light-check.adb index 7ef4912..135eaca 100644 --- a/src/fltk-widgets-buttons-light-check.adb +++ b/src/fltk-widgets-buttons-light-check.adb @@ -70,6 +70,15 @@ package body FLTK.Widgets.Buttons.Light.Check is + procedure Extra_Init + (This : in out Check_Button; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Light_Button (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -84,14 +93,11 @@ package body FLTK.Widgets.Buttons.Light.Check is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); check_button_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); check_button_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-buttons-light-check.ads b/src/fltk-widgets-buttons-light-check.ads index 966b9ed..bd1b1ee 100644 --- a/src/fltk-widgets-buttons-light-check.ads +++ b/src/fltk-widgets-buttons-light-check.ads @@ -44,7 +44,11 @@ private overriding procedure Finalize (This : in out Check_Button); - + procedure Extra_Init + (This : in out Check_Button; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Draw); diff --git a/src/fltk-widgets-buttons-light-radio.adb b/src/fltk-widgets-buttons-light-radio.adb index ae5dbca..0701054 100644 --- a/src/fltk-widgets-buttons-light-radio.adb +++ b/src/fltk-widgets-buttons-light-radio.adb @@ -70,6 +70,15 @@ package body FLTK.Widgets.Buttons.Light.Radio is + procedure Extra_Init + (This : in out Radio_Light_Button; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Light_Button (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -84,14 +93,11 @@ package body FLTK.Widgets.Buttons.Light.Radio is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); radio_light_button_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); radio_light_button_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-buttons-light-radio.ads b/src/fltk-widgets-buttons-light-radio.ads index b12fe60..639e623 100644 --- a/src/fltk-widgets-buttons-light-radio.ads +++ b/src/fltk-widgets-buttons-light-radio.ads @@ -44,7 +44,11 @@ private overriding procedure Finalize (This : in out Radio_Light_Button); - + procedure Extra_Init + (This : in out Radio_Light_Button; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Draw); diff --git a/src/fltk-widgets-buttons-light-round-radio.adb b/src/fltk-widgets-buttons-light-round-radio.adb index 3f77fcb..4dbe7d9 100644 --- a/src/fltk-widgets-buttons-light-round-radio.adb +++ b/src/fltk-widgets-buttons-light-round-radio.adb @@ -70,6 +70,15 @@ package body FLTK.Widgets.Buttons.Light.Round.Radio is + procedure Extra_Init + (This : in out Radio_Round_Button; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Round_Button (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -84,14 +93,11 @@ package body FLTK.Widgets.Buttons.Light.Round.Radio is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); radio_round_button_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); radio_round_button_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-buttons-light-round-radio.ads b/src/fltk-widgets-buttons-light-round-radio.ads index 4271829..54d0172 100644 --- a/src/fltk-widgets-buttons-light-round-radio.ads +++ b/src/fltk-widgets-buttons-light-round-radio.ads @@ -44,7 +44,11 @@ private overriding procedure Finalize (This : in out Radio_Round_Button); - + procedure Extra_Init + (This : in out Radio_Round_Button; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Draw); diff --git a/src/fltk-widgets-buttons-light-round.adb b/src/fltk-widgets-buttons-light-round.adb index e1faddb..9c120d4 100644 --- a/src/fltk-widgets-buttons-light-round.adb +++ b/src/fltk-widgets-buttons-light-round.adb @@ -70,6 +70,15 @@ package body FLTK.Widgets.Buttons.Light.Round is + procedure Extra_Init + (This : in out Round_Button; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Light_Button (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -84,14 +93,11 @@ package body FLTK.Widgets.Buttons.Light.Round is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); round_button_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); round_button_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-buttons-light-round.ads b/src/fltk-widgets-buttons-light-round.ads index 17d5d36..ab54b81 100644 --- a/src/fltk-widgets-buttons-light-round.ads +++ b/src/fltk-widgets-buttons-light-round.ads @@ -44,7 +44,11 @@ private overriding procedure Finalize (This : in out Round_Button); - + procedure Extra_Init + (This : in out Round_Button; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Draw); diff --git a/src/fltk-widgets-buttons-light.adb b/src/fltk-widgets-buttons-light.adb index 02950fd..4e74c74 100644 --- a/src/fltk-widgets-buttons-light.adb +++ b/src/fltk-widgets-buttons-light.adb @@ -70,6 +70,15 @@ package body FLTK.Widgets.Buttons.Light is + procedure Extra_Init + (This : in out Light_Button; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Button (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -84,14 +93,11 @@ package body FLTK.Widgets.Buttons.Light is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); light_button_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); light_button_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-buttons-light.ads b/src/fltk-widgets-buttons-light.ads index 17adaab..b7be94f 100644 --- a/src/fltk-widgets-buttons-light.ads +++ b/src/fltk-widgets-buttons-light.ads @@ -44,7 +44,11 @@ private overriding procedure Finalize (This : in out Light_Button); - + procedure Extra_Init + (This : in out Light_Button; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Draw); diff --git a/src/fltk-widgets-buttons-radio.adb b/src/fltk-widgets-buttons-radio.adb index 55a7856..f75d95c 100644 --- a/src/fltk-widgets-buttons-radio.adb +++ b/src/fltk-widgets-buttons-radio.adb @@ -70,6 +70,15 @@ package body FLTK.Widgets.Buttons.Radio is + procedure Extra_Init + (This : in out Radio_Button; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Button (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -84,14 +93,11 @@ package body FLTK.Widgets.Buttons.Radio is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); radio_button_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); radio_button_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-buttons-radio.ads b/src/fltk-widgets-buttons-radio.ads index c068524..08816bd 100644 --- a/src/fltk-widgets-buttons-radio.ads +++ b/src/fltk-widgets-buttons-radio.ads @@ -44,7 +44,11 @@ private overriding procedure Finalize (This : in out Radio_Button); - + procedure Extra_Init + (This : in out Radio_Button; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Draw); diff --git a/src/fltk-widgets-buttons-repeat.adb b/src/fltk-widgets-buttons-repeat.adb index e58493f..e61786f 100644 --- a/src/fltk-widgets-buttons-repeat.adb +++ b/src/fltk-widgets-buttons-repeat.adb @@ -70,6 +70,15 @@ package body FLTK.Widgets.Buttons.Repeat is + procedure Extra_Init + (This : in out Repeat_Button; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Button (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -84,14 +93,11 @@ package body FLTK.Widgets.Buttons.Repeat is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); repeat_button_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); repeat_button_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-buttons-repeat.ads b/src/fltk-widgets-buttons-repeat.ads index fbb7186..e2b440d 100644 --- a/src/fltk-widgets-buttons-repeat.ads +++ b/src/fltk-widgets-buttons-repeat.ads @@ -44,7 +44,11 @@ private overriding procedure Finalize (This : in out Repeat_Button); - + procedure Extra_Init + (This : in out Repeat_Button; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Draw); diff --git a/src/fltk-widgets-buttons-toggle.adb b/src/fltk-widgets-buttons-toggle.adb index d2b7240..44c6a80 100644 --- a/src/fltk-widgets-buttons-toggle.adb +++ b/src/fltk-widgets-buttons-toggle.adb @@ -70,6 +70,15 @@ package body FLTK.Widgets.Buttons.Toggle is + procedure Extra_Init + (This : in out Toggle_Button; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Button (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -84,14 +93,11 @@ package body FLTK.Widgets.Buttons.Toggle is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); toggle_button_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); toggle_button_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-buttons-toggle.ads b/src/fltk-widgets-buttons-toggle.ads index 260cab0..a4e775d 100644 --- a/src/fltk-widgets-buttons-toggle.ads +++ b/src/fltk-widgets-buttons-toggle.ads @@ -44,7 +44,11 @@ private overriding procedure Finalize (This : in out Toggle_Button); - + procedure Extra_Init + (This : in out Toggle_Button; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Draw); diff --git a/src/fltk-widgets-buttons.adb b/src/fltk-widgets-buttons.adb index 232a2b8..81bf3a8 100644 --- a/src/fltk-widgets-buttons.adb +++ b/src/fltk-widgets-buttons.adb @@ -117,6 +117,15 @@ package body FLTK.Widgets.Buttons is + procedure Extra_Init + (This : in out Button; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Widget (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -131,12 +140,9 @@ package body FLTK.Widgets.Buttons is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); button_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); button_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-buttons.ads b/src/fltk-widgets-buttons.ads index 59f8403..5365bd6 100644 --- a/src/fltk-widgets-buttons.ads +++ b/src/fltk-widgets-buttons.ads @@ -79,16 +79,22 @@ private overriding procedure Finalize (This : in out Button); - + procedure Extra_Init + (This : in out Button; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Get_State); pragma Inline (Set_State); pragma Inline (Set_Only); + pragma Inline (Get_Down_Box); pragma Inline (Set_Down_Box); pragma Inline (Get_Shortcut); pragma Inline (Set_Shortcut); + pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-charts.adb b/src/fltk-widgets-charts.adb index e183e2f..6754910 100644 --- a/src/fltk-widgets-charts.adb +++ b/src/fltk-widgets-charts.adb @@ -201,6 +201,15 @@ package body FLTK.Widgets.Charts is + procedure Extra_Init + (This : in out Chart; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Widget (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -215,12 +224,9 @@ package body FLTK.Widgets.Charts is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); chart_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); chart_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-charts.ads b/src/fltk-widgets-charts.ads index cf4ee47..409090f 100644 --- a/src/fltk-widgets-charts.ads +++ b/src/fltk-widgets-charts.ads @@ -135,7 +135,11 @@ private overriding procedure Finalize (This : in out Chart); - + procedure Extra_Init + (This : in out Chart; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Add); @@ -143,7 +147,6 @@ private pragma Inline (Replace); pragma Inline (Clear); - pragma Inline (Will_Autosize); pragma Inline (Set_Autosize); pragma Inline (Get_Bounds); @@ -152,7 +155,6 @@ private pragma Inline (Set_Maximum_Size); pragma Inline (Get_Size); - pragma Inline (Get_Text_Color); pragma Inline (Set_Text_Color); pragma Inline (Get_Text_Font); @@ -160,10 +162,8 @@ private pragma Inline (Get_Text_Size); pragma Inline (Set_Text_Size); - pragma Inline (Resize); - pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-clocks-updated-round.adb b/src/fltk-widgets-clocks-updated-round.adb index 8747a80..96acf8a 100644 --- a/src/fltk-widgets-clocks-updated-round.adb +++ b/src/fltk-widgets-clocks-updated-round.adb @@ -76,6 +76,15 @@ package body FLTK.Widgets.Clocks.Updated.Round is + procedure Extra_Init + (This : in out Round_Clock; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Updated_Clock (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -90,14 +99,11 @@ package body FLTK.Widgets.Clocks.Updated.Round is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); round_clock_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); round_clock_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-clocks-updated-round.ads b/src/fltk-widgets-clocks-updated-round.ads index 2f18a1d..efd0417 100644 --- a/src/fltk-widgets-clocks-updated-round.ads +++ b/src/fltk-widgets-clocks-updated-round.ads @@ -48,7 +48,11 @@ private overriding procedure Finalize (This : in out Round_Clock); - + procedure Extra_Init + (This : in out Round_Clock; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Draw); diff --git a/src/fltk-widgets-clocks-updated.adb b/src/fltk-widgets-clocks-updated.adb index 0024cc0..b9eabea 100644 --- a/src/fltk-widgets-clocks-updated.adb +++ b/src/fltk-widgets-clocks-updated.adb @@ -84,6 +84,15 @@ package body FLTK.Widgets.Clocks.Updated is + procedure Extra_Init + (This : in out Updated_Clock; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Clock (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -98,12 +107,9 @@ package body FLTK.Widgets.Clocks.Updated is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); clock_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); clock_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; @@ -122,12 +128,9 @@ package body FLTK.Widgets.Clocks.Updated is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); clock_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); clock_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-clocks-updated.ads b/src/fltk-widgets-clocks-updated.ads index 31caabd..a4662c0 100644 --- a/src/fltk-widgets-clocks-updated.ads +++ b/src/fltk-widgets-clocks-updated.ads @@ -54,7 +54,11 @@ private overriding procedure Finalize (This : in out Updated_Clock); - + procedure Extra_Init + (This : in out Updated_Clock; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Draw); diff --git a/src/fltk-widgets-clocks.adb b/src/fltk-widgets-clocks.adb index c96d1f2..8c9e785 100644 --- a/src/fltk-widgets-clocks.adb +++ b/src/fltk-widgets-clocks.adb @@ -118,6 +118,15 @@ package body FLTK.Widgets.Clocks is + procedure Extra_Init + (This : in out Clock; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Widget (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -132,14 +141,11 @@ package body FLTK.Widgets.Clocks is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); clock_output_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); clock_output_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-clocks.ads b/src/fltk-widgets-clocks.ads index 42a10f1..36782b3 100644 --- a/src/fltk-widgets-clocks.ads +++ b/src/fltk-widgets-clocks.ads @@ -86,18 +86,20 @@ private overriding procedure Finalize (This : in out Clock); - + procedure Extra_Init + (This : in out Clock; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Get_Hour); pragma Inline (Get_Minute); pragma Inline (Get_Second); - pragma Inline (Get_Time); pragma Inline (Set_Time); - pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-groups-browsers.adb b/src/fltk-widgets-groups-browsers.adb index 9c2ca3d..48d2265 100644 --- a/src/fltk-widgets-groups-browsers.adb +++ b/src/fltk-widgets-groups-browsers.adb @@ -45,6 +45,21 @@ package body FLTK.Widgets.Groups.Browsers is + function fl_abstract_browser_hscrollbar + (B : in Storage.Integer_Address) + return Storage.Integer_Address; + pragma Import (C, fl_abstract_browser_hscrollbar, "fl_abstract_browser_hscrollbar"); + pragma Inline (fl_abstract_browser_hscrollbar); + + function fl_abstract_browser_scrollbar + (B : in Storage.Integer_Address) + return Storage.Integer_Address; + pragma Import (C, fl_abstract_browser_scrollbar, "fl_abstract_browser_scrollbar"); + pragma Inline (fl_abstract_browser_scrollbar); + + + + function fl_abstract_browser_select (B, I : in Storage.Integer_Address; V, C : in Interfaces.C.int) @@ -643,6 +658,33 @@ package body FLTK.Widgets.Groups.Browsers is -- Abstract Browser API -- --------------------------- + procedure Extra_Init + (This : in out Abstract_Browser; + X, Y, W, H : in Integer; + Text : in String) is + begin + Widget (This.Horizon).Void_Ptr := fl_abstract_browser_hscrollbar (This.Void_Ptr); + Widget (This.Horizon).Needs_Dealloc := False; + Extra_Init + (Widget (This.Horizon), + This.Horizon.Get_X, + This.Horizon.Get_Y, + This.Horizon.Get_W, + This.Horizon.Get_H, + This.Horizon.Get_Label); + Widget (This.Vertigo).Void_Ptr := fl_abstract_browser_scrollbar (This.Void_Ptr); + Widget (This.Vertigo).Needs_Dealloc := False; + Extra_Init + (Widget (This.Vertigo), + This.Vertigo.Get_X, + This.Vertigo.Get_Y, + This.Vertigo.Get_W, + This.Vertigo.Get_H, + This.Vertigo.Get_Label); + Extra_Init (Group (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -657,23 +699,7 @@ package body FLTK.Widgets.Groups.Browsers is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); - - Wrapper (This.Horizon).Void_Ptr := fl_abstract_browser_hscrollbar (This.Void_Ptr); - Wrapper (This.Horizon).Needs_Dealloc := False; - fl_widget_set_user_data - (Wrapper (This.Horizon).Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This.Horizon'Unchecked_Access))); - - Wrapper (This.Vertigo).Void_Ptr := fl_abstract_browser_scrollbar (This.Void_Ptr); - Wrapper (This.Vertigo).Needs_Dealloc := False; - fl_widget_set_user_data - (Wrapper (This.Vertigo).Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This.Vertigo'Unchecked_Access))); - - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); + Extra_Init (This, X, Y, W, H, Text); end return; end Create; diff --git a/src/fltk-widgets-groups-browsers.ads b/src/fltk-widgets-groups-browsers.ads index c93506f..00aabc8 100644 --- a/src/fltk-widgets-groups-browsers.ads +++ b/src/fltk-widgets-groups-browsers.ads @@ -345,6 +345,11 @@ private overriding procedure Finalize (This : in out Abstract_Browser); + procedure Extra_Init + (This : in out Abstract_Browser; + X, Y, W, H : in Integer; + Text : in String); + pragma Assert (Item_Cursor'Size = Storage.Integer_Address'Size, @@ -420,19 +425,6 @@ private pragma Inline (Handle); - function fl_abstract_browser_hscrollbar - (B : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_abstract_browser_hscrollbar, "fl_abstract_browser_hscrollbar"); - pragma Inline (fl_abstract_browser_hscrollbar); - - function fl_abstract_browser_scrollbar - (B : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_abstract_browser_scrollbar, "fl_abstract_browser_scrollbar"); - pragma Inline (fl_abstract_browser_scrollbar); - - -- Needed to ensure chars_ptr storage is properly cleaned up type Item_Text_Hook_Final_Controller is new Ada.Finalization.Controlled with null record; diff --git a/src/fltk-widgets-groups-color_choosers.adb b/src/fltk-widgets-groups-color_choosers.adb index c3fcd7a..c66ae1a 100644 --- a/src/fltk-widgets-groups-color_choosers.adb +++ b/src/fltk-widgets-groups-color_choosers.adb @@ -161,6 +161,15 @@ package body FLTK.Widgets.Groups.Color_Choosers is + procedure Extra_Init + (This : in out Color_Chooser; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Group (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -175,15 +184,11 @@ package body FLTK.Widgets.Groups.Color_Choosers is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); color_chooser_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); color_chooser_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-groups-color_choosers.ads b/src/fltk-widgets-groups-color_choosers.ads index 7dcfbb4..580c31a 100644 --- a/src/fltk-widgets-groups-color_choosers.ads +++ b/src/fltk-widgets-groups-color_choosers.ads @@ -118,7 +118,11 @@ private overriding procedure Finalize (This : in out Color_Chooser); - + procedure Extra_Init + (This : in out Color_Chooser; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Get_Red); @@ -126,25 +130,20 @@ private pragma Inline (Get_Blue); pragma Inline (Set_RGB); - pragma Inline (Get_Hue); pragma Inline (Get_Saturation); pragma Inline (Get_Value); pragma Inline (Set_HSV); - pragma Inline (HSV_To_RGB); pragma Inline (RGB_To_HSV); - pragma Inline (Color_Was_Changed); pragma Inline (Clear_Changed); - pragma Inline (Get_Mode); pragma Inline (Set_Mode); - pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-groups-help_views.adb b/src/fltk-widgets-groups-help_views.adb index 0250b15..385e0eb 100644 --- a/src/fltk-widgets-groups-help_views.adb +++ b/src/fltk-widgets-groups-help_views.adb @@ -288,6 +288,15 @@ package body FLTK.Widgets.Groups.Help_Views is -- Help_View API -- --------------------- + procedure Extra_Init + (This : in out Help_View; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Group (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -302,13 +311,10 @@ package body FLTK.Widgets.Groups.Help_Views is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); help_view_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); help_view_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_help_view_link (This.Void_Ptr, Storage.To_Integer (Link_Callback_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-groups-help_views.ads b/src/fltk-widgets-groups-help_views.ads index 9c4a0ae..ce24ef1 100644 --- a/src/fltk-widgets-groups-help_views.ads +++ b/src/fltk-widgets-groups-help_views.ads @@ -182,6 +182,12 @@ private overriding procedure Finalize (This : in out Help_View); + procedure Extra_Init + (This : in out Help_View; + X, Y, W, H : in Integer; + Text : in String) + with Inline; + pragma Inline (Clear_Selection); pragma Inline (Select_All); diff --git a/src/fltk-widgets-groups-input_choices.adb b/src/fltk-widgets-groups-input_choices.adb index 495ad82..41994dc 100644 --- a/src/fltk-widgets-groups-input_choices.adb +++ b/src/fltk-widgets-groups-input_choices.adb @@ -6,7 +6,6 @@ with - Ada.Unchecked_Deallocation, Interfaces.C.Strings; use type @@ -169,14 +168,6 @@ package body FLTK.Widgets.Groups.Input_Choices is - procedure Free is new Ada.Unchecked_Deallocation - (INP.Input, Input_Access); - procedure Free is new Ada.Unchecked_Deallocation - (MB.Menu_Button, Menu_Button_Access); - - - - procedure Finalize (This : in out Input_Choice) is begin @@ -185,14 +176,37 @@ package body FLTK.Widgets.Groups.Input_Choices is then Group (This).Clear; free_fl_input_choice (This.Void_Ptr); - Free (This.My_Input); - Free (This.My_Menu_Button); This.Void_Ptr := Null_Pointer; end if; Finalize (Group (This)); end Finalize; + procedure Extra_Init + (This : in out Input_Choice; + X, Y, W, H : in Integer; + Text : in String) is + begin + Wrapper (This.My_Input).Void_Ptr := fl_input_choice_input (This.Void_Ptr); + Wrapper (This.My_Input).Needs_Dealloc := False; + Extra_Init + (Widget (This.My_Input), + This.My_Input.Get_X, + This.My_Input.Get_Y, + This.My_Input.Get_W, + This.My_Input.Get_H, + This.My_Input.Get_Label); + Wrapper (This.My_Menu_Button).Void_Ptr := fl_input_choice_menubutton (This.Void_Ptr); + Wrapper (This.My_Menu_Button).Needs_Dealloc := False; + Extra_Init + (Widget (This.My_Menu_Button), + This.My_Menu_Button.Get_X, + This.My_Menu_Button.Get_Y, + This.My_Menu_Button.Get_W, + This.My_Menu_Button.Get_H, + This.My_Menu_Button.Get_Label); + Extra_Init (Group (This), X, Y, W, H, Text); + end Extra_Init; package body Forge is @@ -209,25 +223,11 @@ package body FLTK.Widgets.Groups.Input_Choices is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); input_choice_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); input_choice_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - - This.My_Input := new INP.Input; - Wrapper (This.My_Input.all).Void_Ptr := - fl_input_choice_input (This.Void_Ptr); - Wrapper (This.My_Input.all).Needs_Dealloc := False; - - This.My_Menu_Button := new MB.Menu_Button; - Wrapper (This.My_Menu_Button.all).Void_Ptr := - fl_input_choice_menubutton (This.Void_Ptr); - Wrapper (This.My_Menu_Button.all).Needs_Dealloc := False; end return; end Create; @@ -238,17 +238,17 @@ package body FLTK.Widgets.Groups.Input_Choices is function Input (This : in out Input_Choice) - return INP.Input_Reference is + return FLTK.Widgets.Inputs.Input_Reference is begin - return (Data => This.My_Input); + return (Data => This.My_Input'Unchecked_Access); end Input; function Menu_Button (This : in out Input_Choice) - return MB.Menu_Button_Reference is + return FLTK.Widgets.Menus.Menu_Buttons.Menu_Button_Reference is begin - return (Data => This.My_Menu_Button); + return (Data => This.My_Menu_Button'Unchecked_Access); end Menu_Button; diff --git a/src/fltk-widgets-groups-input_choices.ads b/src/fltk-widgets-groups-input_choices.ads index 5468450..1cc2f2f 100644 --- a/src/fltk-widgets-groups-input_choices.ads +++ b/src/fltk-widgets-groups-input_choices.ads @@ -120,29 +120,23 @@ package FLTK.Widgets.Groups.Input_Choices is private - package INP renames FLTK.Widgets.Inputs; - package MB renames FLTK.Widgets.Menus.Menu_Buttons; - - - type Input_Access is access INP.Input; - type Menu_Button_Access is access MB.Menu_Button; - - type Input_Choice is new Group with record - My_Input : Input_Access; - My_Menu_Button : Menu_Button_Access; + My_Input : aliased Inputs.Input; + My_Menu_Button : aliased Menus.Menu_Buttons.Menu_Button; end record; overriding procedure Finalize (This : in out Input_Choice); - + procedure Extra_Init + (This : in out Input_Choice; + X, Y, W, H : in Integer; + Text : in String); pragma Inline (Input); pragma Inline (Menu_Button); - pragma Inline (Has_Changed); pragma Inline (Clear_Changed); pragma Inline (Get_Down_Box); @@ -157,7 +151,6 @@ private pragma Inline (Set_Input); pragma Inline (Set_Item); - pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-groups-packed.adb b/src/fltk-widgets-groups-packed.adb index 204f17a..1a40889 100644 --- a/src/fltk-widgets-groups-packed.adb +++ b/src/fltk-widgets-groups-packed.adb @@ -86,6 +86,15 @@ package body FLTK.Widgets.Groups.Packed is + procedure Extra_Init + (This : in out Packed_Group; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Group (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -100,13 +109,9 @@ package body FLTK.Widgets.Groups.Packed is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); pack_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); pack_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-groups-packed.ads b/src/fltk-widgets-groups-packed.ads index 28f52f5..e09f5aa 100644 --- a/src/fltk-widgets-groups-packed.ads +++ b/src/fltk-widgets-groups-packed.ads @@ -55,13 +55,16 @@ private overriding procedure Finalize (This : in out Packed_Group); - + procedure Extra_Init + (This : in out Packed_Group; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Get_Spacing); pragma Inline (Set_Spacing); - pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-groups-scrolls.adb b/src/fltk-widgets-groups-scrolls.adb index 7f91325..5ae90f4 100644 --- a/src/fltk-widgets-groups-scrolls.adb +++ b/src/fltk-widgets-groups-scrolls.adb @@ -121,6 +121,15 @@ package body FLTK.Widgets.Groups.Scrolls is + procedure Extra_Init + (This : in out Scroll; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Group (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -135,13 +144,9 @@ package body FLTK.Widgets.Groups.Scrolls is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); scroll_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); scroll_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-groups-scrolls.ads b/src/fltk-widgets-groups-scrolls.ads index 1e7a20e..0c34e2e 100644 --- a/src/fltk-widgets-groups-scrolls.ads +++ b/src/fltk-widgets-groups-scrolls.ads @@ -91,22 +91,23 @@ private overriding procedure Finalize (This : in out Scroll); - + procedure Extra_Init + (This : in out Scroll; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Clear); - pragma Inline (Scroll_To); pragma Inline (Set_Type); - pragma Inline (Get_Scrollbar_Size); pragma Inline (Set_Scrollbar_Size); pragma Inline (Get_Scroll_X); pragma Inline (Get_Scroll_Y); - pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-groups-spinners.adb b/src/fltk-widgets-groups-spinners.adb index ca7cb70..3366c71 100644 --- a/src/fltk-widgets-groups-spinners.adb +++ b/src/fltk-widgets-groups-spinners.adb @@ -207,6 +207,15 @@ package body FLTK.Widgets.Groups.Spinners is + procedure Extra_Init + (This : in out Spinner; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Group (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -221,13 +230,9 @@ package body FLTK.Widgets.Groups.Spinners is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); spinner_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); spinner_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-groups-spinners.ads b/src/fltk-widgets-groups-spinners.ads index 5e7bc16..245df12 100644 --- a/src/fltk-widgets-groups-spinners.ads +++ b/src/fltk-widgets-groups-spinners.ads @@ -140,7 +140,11 @@ private overriding procedure Finalize (This : in out Spinner); - + procedure Extra_Init + (This : in out Spinner; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Get_Background_Color); @@ -154,7 +158,6 @@ private pragma Inline (Get_Text_Size); pragma Inline (Set_Text_Size); - pragma Inline (Get_Minimum); pragma Inline (Set_Minimum); pragma Inline (Get_Maximum); @@ -167,7 +170,6 @@ private pragma Inline (Get_Value); pragma Inline (Set_Value); - pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-groups-tabbed.adb b/src/fltk-widgets-groups-tabbed.adb index 00f1b96..c206c26 100644 --- a/src/fltk-widgets-groups-tabbed.adb +++ b/src/fltk-widgets-groups-tabbed.adb @@ -113,6 +113,15 @@ package body FLTK.Widgets.Groups.Tabbed is + procedure Extra_Init + (This : in out Tabbed_Group; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Group (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -127,13 +136,9 @@ package body FLTK.Widgets.Groups.Tabbed is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); tabs_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); tabs_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-groups-tabbed.ads b/src/fltk-widgets-groups-tabbed.ads index 1bed444..15c8fd0 100644 --- a/src/fltk-widgets-groups-tabbed.ads +++ b/src/fltk-widgets-groups-tabbed.ads @@ -76,19 +76,21 @@ private overriding procedure Finalize (This : in out Tabbed_Group); - + procedure Extra_Init + (This : in out Tabbed_Group; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Get_Client_Area); - pragma Inline (Get_Push); pragma Inline (Set_Push); pragma Inline (Get_Visible); pragma Inline (Set_Visible); pragma Inline (Get_Which); - pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-groups-text_displays-text_editors.adb b/src/fltk-widgets-groups-text_displays-text_editors.adb index c15cefa..0653c89 100644 --- a/src/fltk-widgets-groups-text_displays-text_editors.adb +++ b/src/fltk-widgets-groups-text_displays-text_editors.adb @@ -431,6 +431,50 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is -- (Escape_Key, -1)); + procedure Extra_Init + (This : in out Text_Editor; + X, Y, W, H : in Integer; + Text : in String) is + begin + -- change things over so key bindings are all handled from the Ada side + This.Bindings := Binding_Vectors.Empty_Vector; + for B of Default_Key_Bindings loop + This.Bindings.Append (B); + end loop; + This.Default_Func := Default'Access; + + -- remove these loops and uncomment subsequent "remove_all_key_bindings" + -- when FLTK keybindings fixed + -- for B of To_Remove_List loop + -- fl_text_editor_remove_key_binding + -- (This.Void_Ptr, + -- Interfaces.C.int (B.Press), + -- B.Modif * 65536); + -- end loop; + -- for B of To_Remove_Weird loop + -- fl_text_editor_remove_key_binding + -- (This.Void_Ptr, + -- Interfaces.C.int (B.Press), + -- B.Modif); + -- end loop; + fl_text_editor_remove_all_key_bindings (This.Void_Ptr); + + fl_text_editor_set_default_key_function + (This.Void_Ptr, Storage.To_Integer (Key_Func_Hook'Address)); + + -- this is irritatingly required due to how FLTK handles certain keys + -- for B of Default_Key_Bindings loop + -- -- remove this conditional once FLTK keybindings fixed + -- if B.Key.Modcode = Mod_None then + -- fl_text_editor_add_key_binding + -- (This.Void_Ptr, + -- Interfaces.C.int (B.Key.Keycode), + -- Interfaces.C.int (B.Key.Modcode) * 65536, + -- Key_Func_Hook'Address); + -- end if; + -- end loop; + Extra_Init (Text_Display (This), X, Y, W, H, Text); + end Extra_Init; package body Forge is @@ -449,53 +493,11 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); text_editor_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); text_editor_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - - -- change things over so key bindings are all handled from the Ada side - This.Bindings := Binding_Vectors.Empty_Vector; - for B of Default_Key_Bindings loop - This.Bindings.Append (B); - end loop; - This.Default_Func := Default'Access; - - -- remove these loops and uncomment subsequent "remove_all_key_bindings" - -- when FLTK keybindings fixed - -- for B of To_Remove_List loop - -- fl_text_editor_remove_key_binding - -- (This.Void_Ptr, - -- Interfaces.C.int (B.Press), - -- B.Modif * 65536); - -- end loop; - -- for B of To_Remove_Weird loop - -- fl_text_editor_remove_key_binding - -- (This.Void_Ptr, - -- Interfaces.C.int (B.Press), - -- B.Modif); - -- end loop; - fl_text_editor_remove_all_key_bindings (This.Void_Ptr); - - fl_text_editor_set_default_key_function - (This.Void_Ptr, Storage.To_Integer (Key_Func_Hook'Address)); - - -- this is irritatingly required due to how FLTK handles certain keys - -- for B of Default_Key_Bindings loop - -- -- remove this conditional once FLTK keybindings fixed - -- if B.Key.Modcode = Mod_None then - -- fl_text_editor_add_key_binding - -- (This.Void_Ptr, - -- Interfaces.C.int (B.Key.Keycode), - -- Interfaces.C.int (B.Key.Modcode) * 65536, - -- Key_Func_Hook'Address); - -- end if; - -- end loop; end return; end Create; diff --git a/src/fltk-widgets-groups-text_displays-text_editors.ads b/src/fltk-widgets-groups-text_displays-text_editors.ads index 18a3f38..67ea0e7 100644 --- a/src/fltk-widgets-groups-text_displays-text_editors.ads +++ b/src/fltk-widgets-groups-text_displays-text_editors.ads @@ -336,18 +336,18 @@ private (Index_Type => Positive, Element_Type => Key_Binding); - - - type Text_Editor is new Text_Display with - record - Bindings : Binding_Vectors.Vector; - Default_Func : Default_Key_Func; - end record; + type Text_Editor is new Text_Display with record + Bindings : Binding_Vectors.Vector; + Default_Func : Default_Key_Func; + end record; overriding procedure Finalize (This : in out Text_Editor); - + procedure Extra_Init + (This : in out Text_Editor; + X, Y, W, H : in Integer; + Text : in String); function Key_Func_Hook @@ -357,16 +357,11 @@ private pragma Convention (C, Key_Func_Hook); - - package Editor_Convert is new System.Address_To_Access_Conversions (Text_Editor'Class); - - pragma Inline (Default); - pragma Inline (Undo); pragma Inline (Cut); pragma Inline (Copy); @@ -374,13 +369,11 @@ private pragma Inline (Delete); pragma Inline (Select_All); - pragma Inline (KF_Backspace); pragma Inline (KF_Insert); pragma Inline (KF_Enter); pragma Inline (KF_Ignore); - pragma Inline (KF_Home); pragma Inline (KF_End); pragma Inline (KF_Page_Down); @@ -390,7 +383,6 @@ private pragma Inline (KF_Right); pragma Inline (KF_Up); - pragma Inline (KF_Shift_Home); pragma Inline (KF_Shift_End); pragma Inline (KF_Shift_Page_Down); @@ -400,7 +392,6 @@ private pragma Inline (KF_Shift_Right); pragma Inline (KF_Shift_Up); - pragma Inline (KF_Ctrl_Home); pragma Inline (KF_Ctrl_End); pragma Inline (KF_Ctrl_Page_Down); @@ -410,7 +401,6 @@ private pragma Inline (KF_Ctrl_Right); pragma Inline (KF_Ctrl_Up); - pragma Inline (KF_Ctrl_Shift_Home); pragma Inline (KF_Ctrl_Shift_End); pragma Inline (KF_Ctrl_Shift_Page_Down); @@ -420,21 +410,17 @@ private pragma Inline (KF_Ctrl_Shift_Right); pragma Inline (KF_Ctrl_Shift_Up); - pragma Inline (Add_Key_Binding); pragma Inline (Remove_All_Key_Bindings); pragma Inline (Get_Default_Key_Function); pragma Inline (Set_Default_Key_Function); - pragma Inline (Get_Insert_Mode); pragma Inline (Set_Insert_Mode); - -- pragma Inline (Get_Tab_Nav_Mode); -- pragma Inline (Set_Tab_Nav_Mode); - pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-groups-text_displays.adb b/src/fltk-widgets-groups-text_displays.adb index 7a9863f..d818490 100644 --- a/src/fltk-widgets-groups-text_displays.adb +++ b/src/fltk-widgets-groups-text_displays.adb @@ -483,6 +483,15 @@ package body FLTK.Widgets.Groups.Text_Displays is + procedure Extra_Init + (This : in out Text_Display; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Group (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -497,15 +506,11 @@ package body FLTK.Widgets.Groups.Text_Displays is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); text_display_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); text_display_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-groups-text_displays.ads b/src/fltk-widgets-groups-text_displays.ads index 80feb1c..775acbe 100644 --- a/src/fltk-widgets-groups-text_displays.ads +++ b/src/fltk-widgets-groups-text_displays.ads @@ -370,14 +370,16 @@ private overriding procedure Finalize (This : in out Text_Display); - + procedure Extra_Init + (This : in out Text_Display; + X, Y, W, H : in Integer; + Text : in String) + with Inline; package Text_Display_Convert is new System.Address_To_Access_Conversions (Text_Display'Class); - - -- Adds some basic reference counting on the C side to help ensure any Text_Buffers -- do not get deallocated before all Text_Displays they might be attached to. procedure upref_fl_text_buffer @@ -391,28 +393,22 @@ private pragma Inline (free_fl_text_buffer); - - pragma Inline (Get_Buffer); pragma Inline (Set_Buffer); - pragma Inline (Highlight_Data); - pragma Inline (Col_To_X); pragma Inline (X_To_Col); pragma Inline (In_Selection); pragma Inline (Position_To_XY); - pragma Inline (Get_Cursor_Color); pragma Inline (Set_Cursor_Color); pragma Inline (Set_Cursor_Style); pragma Inline (Hide_Cursor); pragma Inline (Show_Cursor); - pragma Inline (Get_Text_Color); pragma Inline (Set_Text_Color); pragma Inline (Get_Text_Font); @@ -420,28 +416,24 @@ private pragma Inline (Get_Text_Size); pragma Inline (Set_Text_Size); - pragma Inline (Insert_Text); pragma Inline (Overstrike); pragma Inline (Get_Insert_Position); pragma Inline (Set_Insert_Position); pragma Inline (Show_Insert_Position); - pragma Inline (Word_Start); pragma Inline (Word_End); pragma Inline (Next_Word); pragma Inline (Previous_Word); pragma Inline (Set_Wrap_Mode); - pragma Inline (Line_Start); pragma Inline (Line_End); pragma Inline (Count_Lines); pragma Inline (Skip_Lines); pragma Inline (Rewind_Lines); - pragma Inline (Get_Linenumber_Alignment); pragma Inline (Set_Linenumber_Alignment); pragma Inline (Get_Linenumber_Back_Color); @@ -455,20 +447,17 @@ private pragma Inline (Get_Linenumber_Width); pragma Inline (Set_Linenumber_Width); - pragma Inline (Move_Down); pragma Inline (Move_Left); pragma Inline (Move_Right); pragma Inline (Move_Up); - pragma Inline (Scroll_To); pragma Inline (Get_Scrollbar_Alignment); pragma Inline (Set_Scrollbar_Alignment); pragma Inline (Get_Scrollbar_Width); pragma Inline (Set_Scrollbar_Width); - pragma Inline (Redisplay_Range); pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-groups-tiled.adb b/src/fltk-widgets-groups-tiled.adb index 5e8eef2..ea4b70d 100644 --- a/src/fltk-widgets-groups-tiled.adb +++ b/src/fltk-widgets-groups-tiled.adb @@ -80,6 +80,15 @@ package body FLTK.Widgets.Groups.Tiled is + procedure Extra_Init + (This : in out Tiled_Group; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Group (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -94,13 +103,9 @@ package body FLTK.Widgets.Groups.Tiled is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); tile_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); tile_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-groups-tiled.ads b/src/fltk-widgets-groups-tiled.ads index c4d61e8..07954aa 100644 --- a/src/fltk-widgets-groups-tiled.ads +++ b/src/fltk-widgets-groups-tiled.ads @@ -52,12 +52,15 @@ private overriding procedure Finalize (This : in out Tiled_Group); - + procedure Extra_Init + (This : in out Tiled_Group; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Position); - pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-groups-windows-double-overlay.adb b/src/fltk-widgets-groups-windows-double-overlay.adb index 7d3e830..382ab50 100644 --- a/src/fltk-widgets-groups-windows-double-overlay.adb +++ b/src/fltk-widgets-groups-windows-double-overlay.adb @@ -140,6 +140,15 @@ package body FLTK.Widgets.Groups.Windows.Double.Overlay is -- Constructors -- -------------------- + procedure Extra_Init + (This : in out Overlay_Window; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Double_Window (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -154,17 +163,13 @@ package body FLTK.Widgets.Groups.Windows.Double.Overlay is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); overlay_window_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); overlay_window_set_draw_overlay_hook (This.Void_Ptr, Storage.To_Integer (Draw_Overlay_Hook'Address)); overlay_window_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; @@ -179,17 +184,13 @@ package body FLTK.Widgets.Groups.Windows.Double.Overlay is (Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, This.Get_X, This.Get_Y, W, H, Text); overlay_window_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); overlay_window_set_draw_overlay_hook (This.Void_Ptr, Storage.To_Integer (Draw_Overlay_Hook'Address)); overlay_window_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-groups-windows-double-overlay.ads b/src/fltk-widgets-groups-windows-double-overlay.ads index b78be04..e04e5a5 100644 --- a/src/fltk-widgets-groups-windows-double-overlay.ads +++ b/src/fltk-widgets-groups-windows-double-overlay.ads @@ -94,17 +94,19 @@ private overriding procedure Finalize (This : in out Overlay_Window); - + procedure Extra_Init + (This : in out Overlay_Window; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Show); pragma Inline (Hide); pragma Inline (Flush); - pragma Inline (Can_Do_Overlay); - pragma Inline (Draw); pragma Inline (Redraw_Overlay); pragma Inline (Handle); diff --git a/src/fltk-widgets-groups-windows-double.adb b/src/fltk-widgets-groups-windows-double.adb index aa8d45b..b8562f1 100644 --- a/src/fltk-widgets-groups-windows-double.adb +++ b/src/fltk-widgets-groups-windows-double.adb @@ -96,6 +96,15 @@ package body FLTK.Widgets.Groups.Windows.Double is + procedure Extra_Init + (This : in out Double_Window; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Window (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -110,15 +119,11 @@ package body FLTK.Widgets.Groups.Windows.Double is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); double_window_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); double_window_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; @@ -133,15 +138,11 @@ package body FLTK.Widgets.Groups.Windows.Double is (Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, This.Get_X, This.Get_Y, W, H, Text); double_window_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); double_window_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-groups-windows-double.ads b/src/fltk-widgets-groups-windows-double.ads index a6c5635..cd16a1f 100644 --- a/src/fltk-widgets-groups-windows-double.ads +++ b/src/fltk-widgets-groups-windows-double.ads @@ -60,14 +60,17 @@ private overriding procedure Finalize (This : in out Double_Window); - + procedure Extra_Init + (This : in out Double_Window; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Show); pragma Inline (Hide); pragma Inline (Flush); - pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-groups-windows-opengl.adb b/src/fltk-widgets-groups-windows-opengl.adb index 53579c2..9ea1ed3 100644 --- a/src/fltk-widgets-groups-windows-opengl.adb +++ b/src/fltk-widgets-groups-windows-opengl.adb @@ -230,6 +230,15 @@ package body FLTK.Widgets.Groups.Windows.OpenGL is -- Constructors -- -------------------- + procedure Extra_Init + (This : in out GL_Window; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Window (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -244,13 +253,9 @@ package body FLTK.Widgets.Groups.Windows.OpenGL is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); gl_window_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); gl_window_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; @@ -265,13 +270,9 @@ package body FLTK.Widgets.Groups.Windows.OpenGL is (Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, This.Get_X, This.Get_Y, W, H, Text); gl_window_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); gl_window_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-groups-windows-opengl.ads b/src/fltk-widgets-groups-windows-opengl.ads index 32603e0..9a60f03 100644 --- a/src/fltk-widgets-groups-windows-opengl.ads +++ b/src/fltk-widgets-groups-windows-opengl.ads @@ -198,6 +198,12 @@ private overriding procedure Finalize (This : in out GL_Window); + procedure Extra_Init + (This : in out GL_Window; + X, Y, W, H : in Integer; + Text : in String) + with Inline; + for Mode_Mask use record Index at 0 range 0 .. 0; @@ -223,18 +229,15 @@ private pragma Inline (Hide_Overlay); pragma Inline (Flush); - pragma Inline (Pixel_H); pragma Inline (Pixel_W); pragma Inline (Pixels_Per_Unit); - pragma Inline (Get_Mode); pragma Inline (Set_Mode); pragma Inline (Can_Do); pragma Inline (Can_Do_Overlay); - pragma Inline (Get_Context); pragma Inline (Set_Context); pragma Inline (Get_Context_Valid); @@ -244,7 +247,6 @@ private pragma Inline (Make_Current); pragma Inline (Make_Overlay_Current); - pragma Inline (Ortho); pragma Inline (Redraw_Overlay); pragma Inline (Swap_Buffers); diff --git a/src/fltk-widgets-groups-windows-single-menu.adb b/src/fltk-widgets-groups-windows-single-menu.adb index c707f97..d1249e7 100644 --- a/src/fltk-widgets-groups-windows-single-menu.adb +++ b/src/fltk-widgets-groups-windows-single-menu.adb @@ -119,6 +119,15 @@ package body FLTK.Widgets.Groups.Windows.Single.Menu is + procedure Extra_Init + (This : in out Menu_Window; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Single_Window (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -133,15 +142,11 @@ package body FLTK.Widgets.Groups.Windows.Single.Menu is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); menu_window_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); menu_window_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; @@ -156,15 +161,11 @@ package body FLTK.Widgets.Groups.Windows.Single.Menu is (Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, This.Get_X, This.Get_Y, W, H, Text); menu_window_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); menu_window_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-groups-windows-single-menu.ads b/src/fltk-widgets-groups-windows-single-menu.ads index 4d5e95a..0b66490 100644 --- a/src/fltk-widgets-groups-windows-single-menu.ads +++ b/src/fltk-widgets-groups-windows-single-menu.ads @@ -72,18 +72,20 @@ private overriding procedure Finalize (This : in out Menu_Window); - + procedure Extra_Init + (This : in out Menu_Window; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Show); pragma Inline (Hide); pragma Inline (Flush); - pragma Inline (Is_Overlay); pragma Inline (Set_Overlay); - pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-groups-windows-single.adb b/src/fltk-widgets-groups-windows-single.adb index c991366..14618b9 100644 --- a/src/fltk-widgets-groups-windows-single.adb +++ b/src/fltk-widgets-groups-windows-single.adb @@ -91,6 +91,15 @@ package body FLTK.Widgets.Groups.Windows.Single is + procedure Extra_Init + (This : in out Single_Window; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Window (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -105,15 +114,11 @@ package body FLTK.Widgets.Groups.Windows.Single is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); single_window_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); single_window_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; @@ -128,15 +133,11 @@ package body FLTK.Widgets.Groups.Windows.Single is (Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, This.Get_X, This.Get_Y, W, H, Text); single_window_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); single_window_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-groups-windows-single.ads b/src/fltk-widgets-groups-windows-single.ads index 227463d..6e1e1e1 100644 --- a/src/fltk-widgets-groups-windows-single.ads +++ b/src/fltk-widgets-groups-windows-single.ads @@ -58,13 +58,16 @@ private overriding procedure Finalize (This : in out Single_Window); - + procedure Extra_Init + (This : in out Single_Window; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Show); pragma Inline (Flush); - pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-groups-windows.adb b/src/fltk-widgets-groups-windows.adb index fc8bf9a..d7cc362 100644 --- a/src/fltk-widgets-groups-windows.adb +++ b/src/fltk-widgets-groups-windows.adb @@ -316,6 +316,15 @@ package body FLTK.Widgets.Groups.Windows is + procedure Extra_Init + (This : in out Window; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Group (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -330,13 +339,9 @@ package body FLTK.Widgets.Groups.Windows is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); window_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); window_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; @@ -351,13 +356,9 @@ package body FLTK.Widgets.Groups.Windows is (Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, This.Get_X, This.Get_Y, W, H, Text); window_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); window_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-groups-windows.ads b/src/fltk-widgets-groups-windows.ads index f7d2a26..27fa02d 100644 --- a/src/fltk-widgets-groups-windows.ads +++ b/src/fltk-widgets-groups-windows.ads @@ -218,7 +218,11 @@ private overriding procedure Finalize (This : in out Window); - + procedure Extra_Init + (This : in out Window; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Show); @@ -230,13 +234,11 @@ private pragma Inline (Last_Made_Current); pragma Inline (Free_Position); - pragma Inline (Is_Fullscreen); pragma Inline (Fullscreen_On); pragma Inline (Fullscreen_Off); pragma Inline (Fullscreen_Screens); - pragma Inline (Set_Icon); pragma Inline (Set_Default_Icon); pragma Inline (Get_Icon_Label); @@ -244,7 +246,6 @@ private pragma Inline (Set_Cursor); pragma Inline (Set_Default_Cursor); - pragma Inline (Get_Border_State); pragma Inline (Set_Border_State); pragma Inline (Is_Override); @@ -252,26 +253,21 @@ private pragma Inline (Get_Modal_State); pragma Inline (Set_Modal_State); - pragma Inline (Get_Label); pragma Inline (Set_Label); pragma Inline (Hotspot); pragma Inline (Set_Size_Range); pragma Inline (Shape); - pragma Inline (Get_X_Root); pragma Inline (Get_Y_Root); pragma Inline (Get_Decorated_W); pragma Inline (Get_Decorated_H); - pragma Inline (Draw); pragma Inline (Handle); - - Last_Current : access Window'Class := null; diff --git a/src/fltk-widgets-groups-wizards.adb b/src/fltk-widgets-groups-wizards.adb index 83b9538..d776b71 100644 --- a/src/fltk-widgets-groups-wizards.adb +++ b/src/fltk-widgets-groups-wizards.adb @@ -98,6 +98,15 @@ package body FLTK.Widgets.Groups.Wizards is + procedure Extra_Init + (This : in out Wizard; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Group (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -112,13 +121,9 @@ package body FLTK.Widgets.Groups.Wizards is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); wizard_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); wizard_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-groups-wizards.ads b/src/fltk-widgets-groups-wizards.ads index 4716550..5034d7c 100644 --- a/src/fltk-widgets-groups-wizards.ads +++ b/src/fltk-widgets-groups-wizards.ads @@ -64,17 +64,19 @@ private overriding procedure Finalize (This : in out Wizard); - + procedure Extra_Init + (This : in out Wizard; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Next); pragma Inline (Prev); - pragma Inline (Get_Visible); pragma Inline (Set_Visible); - pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-groups.adb b/src/fltk-widgets-groups.adb index 5ab1f5f..3f07083 100644 --- a/src/fltk-widgets-groups.adb +++ b/src/fltk-widgets-groups.adb @@ -44,6 +44,14 @@ package body FLTK.Widgets.Groups is + procedure fl_group_end + (G : in Storage.Integer_Address); + pragma Import (C, fl_group_end, "fl_group_end"); + pragma Inline (fl_group_end); + + + + procedure fl_group_add (G, W : in Storage.Integer_Address); pragma Import (C, fl_group_add, "fl_group_add"); @@ -174,6 +182,16 @@ package body FLTK.Widgets.Groups is + procedure Extra_Init + (This : in out Group; + X, Y, W, H : in Integer; + Text : in String) is + begin + fl_group_end (This.Void_Ptr); + Extra_Init (Widget (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -188,13 +206,9 @@ package body FLTK.Widgets.Groups is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); group_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); group_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-groups.ads b/src/fltk-widgets-groups.ads index 85f8d54..38991b1 100644 --- a/src/fltk-widgets-groups.ads +++ b/src/fltk-widgets-groups.ads @@ -167,16 +167,12 @@ private overriding procedure Finalize (This : in out Group); - package Group_Convert is new System.Address_To_Access_Conversions (Group); - - - - - procedure fl_group_end - (G : in Storage.Integer_Address); - pragma Import (C, fl_group_end, "fl_group_end"); - + procedure Extra_Init + (This : in out Group; + X, Y, W, H : in Integer; + Text : in String); + package Group_Convert is new System.Address_To_Access_Conversions (Group); type Cursor is record @@ -207,36 +203,28 @@ private return Cursor; - - pragma Inline (Add); pragma Inline (Insert); pragma Inline (Remove); pragma Inline (Clear); - pragma Inline (Has_Child); pragma Inline (Child); pragma Inline (Find); pragma Inline (Number_Of_Children); - pragma Inline (Iterate); - -- pragma Inline (Get_Clip_Mode); -- pragma Inline (Set_Clip_Mode); - pragma Inline (Get_Resizable); pragma Inline (Set_Resizable); pragma Inline (Reset_Initial_Sizes); - pragma Inline (Get_Current); pragma Inline (Set_Current); - pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-inputs-file.adb b/src/fltk-widgets-inputs-file.adb index 9d13a5e..b445eeb 100644 --- a/src/fltk-widgets-inputs-file.adb +++ b/src/fltk-widgets-inputs-file.adb @@ -117,6 +117,15 @@ package body FLTK.Widgets.Inputs.File is + procedure Extra_Init + (This : in out File_Input; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Input (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -131,14 +140,11 @@ package body FLTK.Widgets.Inputs.File is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); file_input_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); file_input_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-inputs-file.ads b/src/fltk-widgets-inputs-file.ads index dec4555..0b493d7 100644 --- a/src/fltk-widgets-inputs-file.ads +++ b/src/fltk-widgets-inputs-file.ads @@ -74,7 +74,11 @@ private overriding procedure Finalize (This : in out File_Input); - + procedure Extra_Init + (This : in out File_Input; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Get_Down_Box); @@ -82,11 +86,9 @@ private pragma Inline (Get_Error_Color); pragma Inline (Set_Error_Color); - pragma Inline (Get_Value); pragma Inline (Set_Value); - pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-inputs-float.adb b/src/fltk-widgets-inputs-float.adb index 35af743..71bcb39 100644 --- a/src/fltk-widgets-inputs-float.adb +++ b/src/fltk-widgets-inputs-float.adb @@ -74,6 +74,15 @@ package body FLTK.Widgets.Inputs.Float is + procedure Extra_Init + (This : in out Float_Input; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Input (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -88,14 +97,11 @@ package body FLTK.Widgets.Inputs.Float is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); float_input_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); float_input_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-inputs-float.ads b/src/fltk-widgets-inputs-float.ads index 11cf33e..67ddd8b 100644 --- a/src/fltk-widgets-inputs-float.ads +++ b/src/fltk-widgets-inputs-float.ads @@ -51,12 +51,15 @@ private overriding procedure Finalize (This : in out Float_Input); - + procedure Extra_Init + (This : in out Float_Input; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Get_Value); - pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-inputs-integer.adb b/src/fltk-widgets-inputs-integer.adb index f22d968..1d2c307 100644 --- a/src/fltk-widgets-inputs-integer.adb +++ b/src/fltk-widgets-inputs-integer.adb @@ -74,6 +74,15 @@ package body FLTK.Widgets.Inputs.Integer is + procedure Extra_Init + (This : in out Integer_Input; + X, Y, W, H : in Standard.Integer; + Text : in String) is + begin + Extra_Init (Input (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -88,12 +97,9 @@ package body FLTK.Widgets.Inputs.Integer is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); int_input_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); int_input_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-inputs-integer.ads b/src/fltk-widgets-inputs-integer.ads index b5d723e..57dec17 100644 --- a/src/fltk-widgets-inputs-integer.ads +++ b/src/fltk-widgets-inputs-integer.ads @@ -51,12 +51,15 @@ private overriding procedure Finalize (This : in out Integer_Input); - + procedure Extra_Init + (This : in out Integer_Input; + X, Y, W, H : in Standard.Integer; + Text : in String) + with Inline; pragma Inline (Get_Value); - pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-inputs-multiline.adb b/src/fltk-widgets-inputs-multiline.adb index 41c9e66..9a0b075 100644 --- a/src/fltk-widgets-inputs-multiline.adb +++ b/src/fltk-widgets-inputs-multiline.adb @@ -70,6 +70,15 @@ package body FLTK.Widgets.Inputs.Multiline is + procedure Extra_Init + (This : in out Multiline_Input; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Input (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -84,14 +93,11 @@ package body FLTK.Widgets.Inputs.Multiline is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); multiline_input_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); multiline_input_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-inputs-multiline.ads b/src/fltk-widgets-inputs-multiline.ads index c89e52f..6198af7 100644 --- a/src/fltk-widgets-inputs-multiline.ads +++ b/src/fltk-widgets-inputs-multiline.ads @@ -44,7 +44,11 @@ private overriding procedure Finalize (This : in out Multiline_Input); - + procedure Extra_Init + (This : in out Multiline_Input; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Draw); diff --git a/src/fltk-widgets-inputs-outputs-multiline.adb b/src/fltk-widgets-inputs-outputs-multiline.adb index 1782cdb..d5333e7 100644 --- a/src/fltk-widgets-inputs-outputs-multiline.adb +++ b/src/fltk-widgets-inputs-outputs-multiline.adb @@ -70,6 +70,15 @@ package body FLTK.Widgets.Inputs.Outputs.Multiline is + procedure Extra_Init + (This : in out Multiline_Output; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Output (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -84,14 +93,11 @@ package body FLTK.Widgets.Inputs.Outputs.Multiline is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); multiline_output_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); multiline_output_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-inputs-outputs-multiline.ads b/src/fltk-widgets-inputs-outputs-multiline.ads index 78e8ce0..b339397 100644 --- a/src/fltk-widgets-inputs-outputs-multiline.ads +++ b/src/fltk-widgets-inputs-outputs-multiline.ads @@ -44,7 +44,11 @@ private overriding procedure Finalize (This : in out Multiline_Output); - + procedure Extra_Init + (This : in out Multiline_Output; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Draw); diff --git a/src/fltk-widgets-inputs-outputs.adb b/src/fltk-widgets-inputs-outputs.adb index 736a86b..9ed0e1b 100644 --- a/src/fltk-widgets-inputs-outputs.adb +++ b/src/fltk-widgets-inputs-outputs.adb @@ -70,6 +70,15 @@ package body FLTK.Widgets.Inputs.Outputs is + procedure Extra_Init + (This : in out Output; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Input (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -84,12 +93,9 @@ package body FLTK.Widgets.Inputs.Outputs is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); output_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); output_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-inputs-outputs.ads b/src/fltk-widgets-inputs-outputs.ads index 7075d2c..456b3fe 100644 --- a/src/fltk-widgets-inputs-outputs.ads +++ b/src/fltk-widgets-inputs-outputs.ads @@ -44,7 +44,11 @@ private overriding procedure Finalize (This : in out Output); - + procedure Extra_Init + (This : in out Output; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Draw); diff --git a/src/fltk-widgets-inputs-secret.adb b/src/fltk-widgets-inputs-secret.adb index 8b08147..7fe2a39 100644 --- a/src/fltk-widgets-inputs-secret.adb +++ b/src/fltk-widgets-inputs-secret.adb @@ -70,6 +70,15 @@ package body FLTK.Widgets.Inputs.Secret is + procedure Extra_Init + (This : in out Secret_Input; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Input (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -84,14 +93,11 @@ package body FLTK.Widgets.Inputs.Secret is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); secret_input_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); secret_input_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-inputs-secret.ads b/src/fltk-widgets-inputs-secret.ads index 852fa25..62bed26 100644 --- a/src/fltk-widgets-inputs-secret.ads +++ b/src/fltk-widgets-inputs-secret.ads @@ -44,7 +44,11 @@ private overriding procedure Finalize (This : in out Secret_Input); - + procedure Extra_Init + (This : in out Secret_Input; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Draw); diff --git a/src/fltk-widgets-inputs.adb b/src/fltk-widgets-inputs.adb index 50296fd..fdcdab8 100644 --- a/src/fltk-widgets-inputs.adb +++ b/src/fltk-widgets-inputs.adb @@ -325,6 +325,15 @@ package body FLTK.Widgets.Inputs is + procedure Extra_Init + (This : in out Input; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Widget (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -339,12 +348,9 @@ package body FLTK.Widgets.Inputs is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); input_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); input_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-inputs.ads b/src/fltk-widgets-inputs.ads index a4c31b6..296ca94 100644 --- a/src/fltk-widgets-inputs.ads +++ b/src/fltk-widgets-inputs.ads @@ -237,7 +237,11 @@ private overriding procedure Finalize (This : in out Input); - + procedure Extra_Init + (This : in out Input; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Copy); @@ -245,7 +249,6 @@ private pragma Inline (Copy_Cuts); pragma Inline (Undo); - pragma Inline (Has_Changed); pragma Inline (Clear_Changed); pragma Inline (Is_Readonly); @@ -255,7 +258,6 @@ private pragma Inline (Is_Wrap); pragma Inline (Set_Wrap); - pragma Inline (Get_Input_Type); pragma Inline (Get_Shortcut_Key); pragma Inline (Set_Shortcut_Key); @@ -264,19 +266,16 @@ private pragma Inline (Get_Position); pragma Inline (Set_Position); - pragma Inline (Index); pragma Inline (Insert); pragma Inline (Replace); pragma Inline (Get_Value); pragma Inline (Set_Value); - pragma Inline (Get_Maximum_Size); pragma Inline (Set_Maximum_Size); pragma Inline (Size); - pragma Inline (Get_Cursor_Color); pragma Inline (Set_Cursor_Color); pragma Inline (Get_Text_Color); @@ -286,16 +285,12 @@ private pragma Inline (Get_Text_Size); pragma Inline (Set_Text_Size); - pragma Inline (Resize); - pragma Inline (Draw); pragma Inline (Handle); - - Input_Kind_Values : array (Input_Kind) of Interfaces.C.int := (Normal_Kind => 0, Float_Kind => 1, @@ -306,8 +301,6 @@ private Wrap_Kind => 16); - - function fl_input_get_value (F : in Storage.Integer_Address) return Interfaces.C.Strings.chars_ptr; diff --git a/src/fltk-widgets-menus-choices.adb b/src/fltk-widgets-menus-choices.adb index 72a7dae..b306c9b 100644 --- a/src/fltk-widgets-menus-choices.adb +++ b/src/fltk-widgets-menus-choices.adb @@ -97,6 +97,13 @@ package body FLTK.Widgets.Menus.Choices is end Finalize; + procedure Extra_Init + (This : in out Choice; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Menu (This), X, Y, W, H, Text); + end Extra_Init; package body Forge is @@ -113,12 +120,9 @@ package body FLTK.Widgets.Menus.Choices is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); choice_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); choice_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-menus-choices.ads b/src/fltk-widgets-menus-choices.ads index b69b33b..fbab109 100644 --- a/src/fltk-widgets-menus-choices.ads +++ b/src/fltk-widgets-menus-choices.ads @@ -63,14 +63,17 @@ private overriding procedure Finalize (This : in out Choice); - + procedure Extra_Init + (This : in out Choice; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Chosen); pragma Inline (Chosen_Index); pragma Inline (Set_Chosen); - pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-menus-menu_bars.adb b/src/fltk-widgets-menus-menu_bars.adb index d5193e2..52279cd 100644 --- a/src/fltk-widgets-menus-menu_bars.adb +++ b/src/fltk-widgets-menus-menu_bars.adb @@ -70,6 +70,15 @@ package body FLTK.Widgets.Menus.Menu_Bars is + procedure Extra_Init + (This : in out Menu_Bar; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Menu (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -84,12 +93,9 @@ package body FLTK.Widgets.Menus.Menu_Bars is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); menu_bar_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); menu_bar_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-menus-menu_bars.ads b/src/fltk-widgets-menus-menu_bars.ads index b79def3..aa856eb 100644 --- a/src/fltk-widgets-menus-menu_bars.ads +++ b/src/fltk-widgets-menus-menu_bars.ads @@ -44,7 +44,11 @@ private overriding procedure Finalize (This : in out Menu_Bar); - + procedure Extra_Init + (This : in out Menu_Bar; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Draw); diff --git a/src/fltk-widgets-menus-menu_buttons.adb b/src/fltk-widgets-menus-menu_buttons.adb index bd4f17a..2d6f305 100644 --- a/src/fltk-widgets-menus-menu_buttons.adb +++ b/src/fltk-widgets-menus-menu_buttons.adb @@ -93,6 +93,15 @@ package body FLTK.Widgets.Menus.Menu_Buttons is + procedure Extra_Init + (This : in out Menu_Button; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Menu (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -107,14 +116,11 @@ package body FLTK.Widgets.Menus.Menu_Buttons is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); menu_button_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); menu_button_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-menus-menu_buttons.ads b/src/fltk-widgets-menus-menu_buttons.ads index 737fe70..e520484 100644 --- a/src/fltk-widgets-menus-menu_buttons.ads +++ b/src/fltk-widgets-menus-menu_buttons.ads @@ -63,13 +63,16 @@ private overriding procedure Finalize (This : in out Menu_Button); - + procedure Extra_Init + (This : in out Menu_Button; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Set_Popup_Kind); pragma Inline (Popup); - pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-menus.adb b/src/fltk-widgets-menus.adb index 14996c3..f35d53c 100644 --- a/src/fltk-widgets-menus.adb +++ b/src/fltk-widgets-menus.adb @@ -299,6 +299,15 @@ package body FLTK.Widgets.Menus is + procedure Extra_Init + (This : in out Menu; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Widget (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -313,13 +322,9 @@ package body FLTK.Widgets.Menus is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); menu_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); menu_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - This.My_Items := Item_Vectors.Empty_Vector; - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-menus.ads b/src/fltk-widgets-menus.ads index 5a25790..bc72bef 100644 --- a/src/fltk-widgets-menus.ads +++ b/src/fltk-widgets-menus.ads @@ -256,15 +256,17 @@ private overriding procedure Finalize (This : in out Menu); - + procedure Extra_Init + (This : in out Menu; + X, Y, W, H : in Integer; + Text : in String) + with Inline; procedure Item_Hook (M, U : in Storage.Integer_Address); pragma Convention (C, Item_Hook); - - type Cursor is record My_Container : access Menu; My_Index : Index'Base := Index'First; @@ -293,24 +295,19 @@ private return Cursor; - - pragma Inline (Has_Item); pragma Inline (Item); pragma Inline (Find_Item); pragma Inline (Find_Index); pragma Inline (Number_Of_Items); - pragma Inline (Iterate); - pragma Inline (Chosen); pragma Inline (Chosen_Label); pragma Inline (Chosen_Index); pragma Inline (Set_Chosen); - pragma Inline (Get_Text_Color); pragma Inline (Set_Text_Color); pragma Inline (Get_Text_Font); @@ -318,17 +315,14 @@ private pragma Inline (Get_Text_Size); pragma Inline (Set_Text_Size); - pragma Inline (Get_Down_Box); pragma Inline (Set_Down_Box); pragma Inline (Make_Global); pragma Inline (Measure_Item); - pragma Inline (Popup); pragma Inline (Pulldown); - pragma Inline (Draw); pragma Inline (Draw_Item); pragma Inline (Handle); diff --git a/src/fltk-widgets-progress_bars.adb b/src/fltk-widgets-progress_bars.adb index 50575d7..2c36a12 100644 --- a/src/fltk-widgets-progress_bars.adb +++ b/src/fltk-widgets-progress_bars.adb @@ -109,6 +109,15 @@ package body FLTK.Widgets.Progress_Bars is + procedure Extra_Init + (This : in out Progress_Bar; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Widget (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -123,12 +132,9 @@ package body FLTK.Widgets.Progress_Bars is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); progress_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); progress_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-progress_bars.ads b/src/fltk-widgets-progress_bars.ads index aa43835..0476f8a 100644 --- a/src/fltk-widgets-progress_bars.ads +++ b/src/fltk-widgets-progress_bars.ads @@ -71,7 +71,11 @@ private overriding procedure Finalize (This : in out Progress_Bar); - + procedure Extra_Init + (This : in out Progress_Bar; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Get_Minimum); @@ -81,7 +85,6 @@ private pragma Inline (Get_Value); pragma Inline (Set_Value); - pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-valuators-adjusters.adb b/src/fltk-widgets-valuators-adjusters.adb index 5cd4ea9..0a1e4c5 100644 --- a/src/fltk-widgets-valuators-adjusters.adb +++ b/src/fltk-widgets-valuators-adjusters.adb @@ -89,6 +89,15 @@ package body FLTK.Widgets.Valuators.Adjusters is + procedure Extra_Init + (This : in out Adjuster; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Valuator (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -103,12 +112,9 @@ package body FLTK.Widgets.Valuators.Adjusters is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); adjuster_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); adjuster_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-valuators-adjusters.ads b/src/fltk-widgets-valuators-adjusters.ads index 35b05b4..635571c 100644 --- a/src/fltk-widgets-valuators-adjusters.ads +++ b/src/fltk-widgets-valuators-adjusters.ads @@ -55,13 +55,16 @@ private overriding procedure Finalize (This : in out Adjuster); - + procedure Extra_Init + (This : in out Adjuster; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Is_Soft); pragma Inline (Set_Soft); - pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-valuators-counters-simple.adb b/src/fltk-widgets-valuators-counters-simple.adb index ead6d50..05a9eba 100644 --- a/src/fltk-widgets-valuators-counters-simple.adb +++ b/src/fltk-widgets-valuators-counters-simple.adb @@ -70,6 +70,15 @@ package body FLTK.Widgets.Valuators.Counters.Simple is + procedure Extra_Init + (This : in out Simple_Counter; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Counter (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -84,14 +93,11 @@ package body FLTK.Widgets.Valuators.Counters.Simple is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); simple_counter_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); simple_counter_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-valuators-counters-simple.ads b/src/fltk-widgets-valuators-counters-simple.ads index ddf5260..dffdff8 100644 --- a/src/fltk-widgets-valuators-counters-simple.ads +++ b/src/fltk-widgets-valuators-counters-simple.ads @@ -44,7 +44,11 @@ private overriding procedure Finalize (This : in out Simple_Counter); - + procedure Extra_Init + (This : in out Simple_Counter; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Draw); diff --git a/src/fltk-widgets-valuators-counters.adb b/src/fltk-widgets-valuators-counters.adb index 3dcfa7a..a31e389 100644 --- a/src/fltk-widgets-valuators-counters.adb +++ b/src/fltk-widgets-valuators-counters.adb @@ -130,6 +130,15 @@ package body FLTK.Widgets.Valuators.Counters is + procedure Extra_Init + (This : in out Counter; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Valuator (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -144,12 +153,9 @@ package body FLTK.Widgets.Valuators.Counters is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); counter_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); counter_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-valuators-counters.ads b/src/fltk-widgets-valuators-counters.ads index d68cf8a..1ba4f5e 100644 --- a/src/fltk-widgets-valuators-counters.ads +++ b/src/fltk-widgets-valuators-counters.ads @@ -94,7 +94,11 @@ private overriding procedure Finalize (This : in out Counter); - + procedure Extra_Init + (This : in out Counter; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Get_Step); @@ -102,7 +106,6 @@ private pragma Inline (Get_Long_Step); pragma Inline (Set_Long_Step); - pragma Inline (Get_Text_Color); pragma Inline (Set_Text_Color); pragma Inline (Get_Text_Font); @@ -110,7 +113,6 @@ private pragma Inline (Get_Text_Size); pragma Inline (Set_Text_Size); - pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-valuators-dials-fill.adb b/src/fltk-widgets-valuators-dials-fill.adb index 881b1f8..aa55025 100644 --- a/src/fltk-widgets-valuators-dials-fill.adb +++ b/src/fltk-widgets-valuators-dials-fill.adb @@ -70,6 +70,15 @@ package body FLTK.Widgets.Valuators.Dials.Fill is + procedure Extra_Init + (This : in out Fill_Dial; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Dial (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -84,12 +93,9 @@ package body FLTK.Widgets.Valuators.Dials.Fill is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); fill_dial_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); fill_dial_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-valuators-dials-fill.ads b/src/fltk-widgets-valuators-dials-fill.ads index 11d1fe7..a029c13 100644 --- a/src/fltk-widgets-valuators-dials-fill.ads +++ b/src/fltk-widgets-valuators-dials-fill.ads @@ -44,7 +44,11 @@ private overriding procedure Finalize (This : in out Fill_Dial); - + procedure Extra_Init + (This : in out Fill_Dial; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Draw); diff --git a/src/fltk-widgets-valuators-dials-line.adb b/src/fltk-widgets-valuators-dials-line.adb index 847ba44..01e8c44 100644 --- a/src/fltk-widgets-valuators-dials-line.adb +++ b/src/fltk-widgets-valuators-dials-line.adb @@ -70,6 +70,15 @@ package body FLTK.Widgets.Valuators.Dials.Line is + procedure Extra_Init + (This : in out Line_Dial; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Dial (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -84,12 +93,9 @@ package body FLTK.Widgets.Valuators.Dials.Line is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); line_dial_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); line_dial_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-valuators-dials-line.ads b/src/fltk-widgets-valuators-dials-line.ads index 766161f..ac23efa 100644 --- a/src/fltk-widgets-valuators-dials-line.ads +++ b/src/fltk-widgets-valuators-dials-line.ads @@ -44,7 +44,11 @@ private overriding procedure Finalize (This : in out Line_Dial); - + procedure Extra_Init + (This : in out Line_Dial; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Draw); diff --git a/src/fltk-widgets-valuators-dials.adb b/src/fltk-widgets-valuators-dials.adb index 1ceac87..f3cdf87 100644 --- a/src/fltk-widgets-valuators-dials.adb +++ b/src/fltk-widgets-valuators-dials.adb @@ -118,6 +118,15 @@ package body FLTK.Widgets.Valuators.Dials is + procedure Extra_Init + (This : in out Dial; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Valuator (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -132,12 +141,9 @@ package body FLTK.Widgets.Valuators.Dials is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); dial_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); dial_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-valuators-dials.ads b/src/fltk-widgets-valuators-dials.ads index f520867..cc149a7 100644 --- a/src/fltk-widgets-valuators-dials.ads +++ b/src/fltk-widgets-valuators-dials.ads @@ -84,19 +84,21 @@ private overriding procedure Finalize (This : in out Dial); - + procedure Extra_Init + (This : in out Dial; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Get_Dial_Type); - pragma Inline (Get_First_Angle); pragma Inline (Set_First_Angle); pragma Inline (Get_Second_Angle); pragma Inline (Set_Second_Angle); pragma Inline (Set_Angles); - pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-valuators-rollers.adb b/src/fltk-widgets-valuators-rollers.adb index 44e48a5..d8f68e7 100644 --- a/src/fltk-widgets-valuators-rollers.adb +++ b/src/fltk-widgets-valuators-rollers.adb @@ -70,6 +70,15 @@ package body FLTK.Widgets.Valuators.Rollers is + procedure Extra_Init + (This : in out Roller; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Valuator (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -84,12 +93,9 @@ package body FLTK.Widgets.Valuators.Rollers is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); roller_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); roller_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-valuators-rollers.ads b/src/fltk-widgets-valuators-rollers.ads index 0a1af9a..44dff6a 100644 --- a/src/fltk-widgets-valuators-rollers.ads +++ b/src/fltk-widgets-valuators-rollers.ads @@ -44,7 +44,11 @@ private overriding procedure Finalize (This : in out Roller); - + procedure Extra_Init + (This : in out Roller; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Draw); diff --git a/src/fltk-widgets-valuators-sliders-fill.adb b/src/fltk-widgets-valuators-sliders-fill.adb index 6fb3993..eb2d7dc 100644 --- a/src/fltk-widgets-valuators-sliders-fill.adb +++ b/src/fltk-widgets-valuators-sliders-fill.adb @@ -70,6 +70,15 @@ package body FLTK.Widgets.Valuators.Sliders.Fill is + procedure Extra_Init + (This : in out Fill_Slider; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Slider (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -84,14 +93,11 @@ package body FLTK.Widgets.Valuators.Sliders.Fill is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); fill_slider_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); fill_slider_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-valuators-sliders-fill.ads b/src/fltk-widgets-valuators-sliders-fill.ads index 6301468..48e5475 100644 --- a/src/fltk-widgets-valuators-sliders-fill.ads +++ b/src/fltk-widgets-valuators-sliders-fill.ads @@ -44,7 +44,11 @@ private overriding procedure Finalize (This : in out Fill_Slider); - + procedure Extra_Init + (This : in out Fill_Slider; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Draw); diff --git a/src/fltk-widgets-valuators-sliders-hor_fill.adb b/src/fltk-widgets-valuators-sliders-hor_fill.adb index 07a162b..953adaf 100644 --- a/src/fltk-widgets-valuators-sliders-hor_fill.adb +++ b/src/fltk-widgets-valuators-sliders-hor_fill.adb @@ -70,6 +70,15 @@ package body FLTK.Widgets.Valuators.Sliders.Hor_Fill is + procedure Extra_Init + (This : in out Hor_Fill_Slider; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Slider (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -84,14 +93,11 @@ package body FLTK.Widgets.Valuators.Sliders.Hor_Fill is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); hor_fill_slider_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); hor_fill_slider_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-valuators-sliders-hor_fill.ads b/src/fltk-widgets-valuators-sliders-hor_fill.ads index 877bdb9..ec28cd4 100644 --- a/src/fltk-widgets-valuators-sliders-hor_fill.ads +++ b/src/fltk-widgets-valuators-sliders-hor_fill.ads @@ -44,7 +44,11 @@ private overriding procedure Finalize (This : in out Hor_Fill_Slider); - + procedure Extra_Init + (This : in out Hor_Fill_Slider; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Draw); diff --git a/src/fltk-widgets-valuators-sliders-hor_nice.adb b/src/fltk-widgets-valuators-sliders-hor_nice.adb index 50cd844..ec84990 100644 --- a/src/fltk-widgets-valuators-sliders-hor_nice.adb +++ b/src/fltk-widgets-valuators-sliders-hor_nice.adb @@ -70,6 +70,15 @@ package body FLTK.Widgets.Valuators.Sliders.Hor_Nice is + procedure Extra_Init + (This : in out Hor_Nice_Slider; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Slider (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -84,14 +93,11 @@ package body FLTK.Widgets.Valuators.Sliders.Hor_Nice is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); hor_nice_slider_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); hor_nice_slider_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-valuators-sliders-hor_nice.ads b/src/fltk-widgets-valuators-sliders-hor_nice.ads index 60b2ae8..54cfa36 100644 --- a/src/fltk-widgets-valuators-sliders-hor_nice.ads +++ b/src/fltk-widgets-valuators-sliders-hor_nice.ads @@ -44,7 +44,11 @@ private overriding procedure Finalize (This : in out Hor_Nice_Slider); - + procedure Extra_Init + (This : in out Hor_Nice_Slider; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Draw); diff --git a/src/fltk-widgets-valuators-sliders-horizontal.adb b/src/fltk-widgets-valuators-sliders-horizontal.adb index 3212a77..9d8797a 100644 --- a/src/fltk-widgets-valuators-sliders-horizontal.adb +++ b/src/fltk-widgets-valuators-sliders-horizontal.adb @@ -70,6 +70,15 @@ package body FLTK.Widgets.Valuators.Sliders.Horizontal is + procedure Extra_Init + (This : in out Horizontal_Slider; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Slider (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -84,14 +93,11 @@ package body FLTK.Widgets.Valuators.Sliders.Horizontal is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); horizontal_slider_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); horizontal_slider_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-valuators-sliders-horizontal.ads b/src/fltk-widgets-valuators-sliders-horizontal.ads index 38c49c2..82cf222 100644 --- a/src/fltk-widgets-valuators-sliders-horizontal.ads +++ b/src/fltk-widgets-valuators-sliders-horizontal.ads @@ -44,7 +44,11 @@ private overriding procedure Finalize (This : in out Horizontal_Slider); - + procedure Extra_Init + (This : in out Horizontal_Slider; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Draw); diff --git a/src/fltk-widgets-valuators-sliders-nice.adb b/src/fltk-widgets-valuators-sliders-nice.adb index f62e38c..f032c22 100644 --- a/src/fltk-widgets-valuators-sliders-nice.adb +++ b/src/fltk-widgets-valuators-sliders-nice.adb @@ -70,6 +70,15 @@ package body FLTK.Widgets.Valuators.Sliders.Nice is + procedure Extra_Init + (This : in out Nice_Slider; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Slider (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -84,14 +93,11 @@ package body FLTK.Widgets.Valuators.Sliders.Nice is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); nice_slider_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); nice_slider_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-valuators-sliders-nice.ads b/src/fltk-widgets-valuators-sliders-nice.ads index 454b8d2..60354e6 100644 --- a/src/fltk-widgets-valuators-sliders-nice.ads +++ b/src/fltk-widgets-valuators-sliders-nice.ads @@ -44,7 +44,11 @@ private overriding procedure Finalize (This : in out Nice_Slider); - + procedure Extra_Init + (This : in out Nice_Slider; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Draw); diff --git a/src/fltk-widgets-valuators-sliders-scrollbars.adb b/src/fltk-widgets-valuators-sliders-scrollbars.adb index f9b576f..4342a98 100644 --- a/src/fltk-widgets-valuators-sliders-scrollbars.adb +++ b/src/fltk-widgets-valuators-sliders-scrollbars.adb @@ -103,6 +103,15 @@ package body FLTK.Widgets.Valuators.Sliders.Scrollbars is + procedure Extra_Init + (This : in out Scrollbar; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Slider (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -117,12 +126,9 @@ package body FLTK.Widgets.Valuators.Sliders.Scrollbars is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); scrollbar_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); scrollbar_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-valuators-sliders-scrollbars.ads b/src/fltk-widgets-valuators-sliders-scrollbars.ads index 544b2f4..42d84b9 100644 --- a/src/fltk-widgets-valuators-sliders-scrollbars.ads +++ b/src/fltk-widgets-valuators-sliders-scrollbars.ads @@ -70,7 +70,11 @@ private overriding procedure Finalize (This : in out Scrollbar); - + procedure Extra_Init + (This : in out Scrollbar; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Get_Line_Size); @@ -79,7 +83,6 @@ private pragma Inline (Set_Position); pragma Inline (Set_All); - pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-valuators-sliders-value-horizontal.adb b/src/fltk-widgets-valuators-sliders-value-horizontal.adb index 2133f8c..7aeb803 100644 --- a/src/fltk-widgets-valuators-sliders-value-horizontal.adb +++ b/src/fltk-widgets-valuators-sliders-value-horizontal.adb @@ -70,6 +70,15 @@ package body FLTK.Widgets.Valuators.Sliders.Value.Horizontal is + procedure Extra_Init + (This : in out Hor_Value_Slider; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Value_Slider (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -84,14 +93,11 @@ package body FLTK.Widgets.Valuators.Sliders.Value.Horizontal is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); hor_value_slider_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); hor_value_slider_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-valuators-sliders-value-horizontal.ads b/src/fltk-widgets-valuators-sliders-value-horizontal.ads index bc0926c..fdea4b5 100644 --- a/src/fltk-widgets-valuators-sliders-value-horizontal.ads +++ b/src/fltk-widgets-valuators-sliders-value-horizontal.ads @@ -44,7 +44,11 @@ private overriding procedure Finalize (This : in out Hor_Value_Slider); - + procedure Extra_Init + (This : in out Hor_Value_Slider; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Draw); diff --git a/src/fltk-widgets-valuators-sliders-value.adb b/src/fltk-widgets-valuators-sliders-value.adb index 53254ff..f6c1902 100644 --- a/src/fltk-widgets-valuators-sliders-value.adb +++ b/src/fltk-widgets-valuators-sliders-value.adb @@ -109,6 +109,15 @@ package body FLTK.Widgets.Valuators.Sliders.Value is + procedure Extra_Init + (This : in out Value_Slider; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Slider (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -123,14 +132,11 @@ package body FLTK.Widgets.Valuators.Sliders.Value is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); value_slider_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); value_slider_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-valuators-sliders-value.ads b/src/fltk-widgets-valuators-sliders-value.ads index 2f86fc0..5e48bbf 100644 --- a/src/fltk-widgets-valuators-sliders-value.ads +++ b/src/fltk-widgets-valuators-sliders-value.ads @@ -71,7 +71,11 @@ private overriding procedure Finalize (This : in out Value_Slider); - + procedure Extra_Init + (This : in out Value_Slider; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Get_Text_Color); @@ -81,7 +85,6 @@ private pragma Inline (Get_Text_Size); pragma Inline (Set_Text_Size); - pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-valuators-sliders.adb b/src/fltk-widgets-valuators-sliders.adb index b43c221..a5674f0 100644 --- a/src/fltk-widgets-valuators-sliders.adb +++ b/src/fltk-widgets-valuators-sliders.adb @@ -125,6 +125,15 @@ package body FLTK.Widgets.Valuators.Sliders is + procedure Extra_Init + (This : in out Slider; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Valuator (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -139,12 +148,9 @@ package body FLTK.Widgets.Valuators.Sliders is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); slider_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); slider_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-valuators-sliders.ads b/src/fltk-widgets-valuators-sliders.ads index 9b198c9..a1d52db 100644 --- a/src/fltk-widgets-valuators-sliders.ads +++ b/src/fltk-widgets-valuators-sliders.ads @@ -94,7 +94,11 @@ private overriding procedure Finalize (This : in out Slider); - + procedure Extra_Init + (This : in out Slider; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Get_Slider_Type); @@ -105,7 +109,6 @@ private pragma Inline (Set_Slide_Size); pragma Inline (Set_Scrollvalue); - pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-valuators-value_inputs.adb b/src/fltk-widgets-valuators-value_inputs.adb index a126f98..4897013 100644 --- a/src/fltk-widgets-valuators-value_inputs.adb +++ b/src/fltk-widgets-valuators-value_inputs.adb @@ -6,7 +6,6 @@ with - Ada.Unchecked_Deallocation, Interfaces.C.Strings; use type @@ -153,12 +152,6 @@ package body FLTK.Widgets.Valuators.Value_Inputs is - procedure Free is new Ada.Unchecked_Deallocation - (INP.Input, Input_Access); - - - - procedure Finalize (This : in out Value_Input) is begin @@ -166,7 +159,6 @@ package body FLTK.Widgets.Valuators.Value_Inputs is This in Value_Input'Class then free_fl_value_input (This.Void_Ptr); - Free (This.My_Input); This.Void_Ptr := Null_Pointer; end if; Finalize (Valuator (This)); @@ -175,6 +167,25 @@ package body FLTK.Widgets.Valuators.Value_Inputs is + procedure Extra_Init + (This : in out Value_Input; + X, Y, W, H : in Integer; + Text : in String) is + begin + Wrapper (This.My_Input).Void_Ptr := + fl_value_input_get_input (This.Void_Ptr); + Wrapper (This.My_Input).Needs_Dealloc := False; + Extra_Init -- Would be better to call Extra_Init for Inputs here, but alas + (Widget (This.My_Input), + This.My_Input.Get_X, + This.My_Input.Get_Y, + This.My_Input.Get_W, + This.My_Input.Get_H, + This.My_Input.Get_Label); + Extra_Init (Valuator (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -189,19 +200,11 @@ package body FLTK.Widgets.Valuators.Value_Inputs is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); value_input_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); value_input_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - - This.My_Input := new INP.Input; - Wrapper (This.My_Input.all).Void_Ptr := - fl_value_input_get_input (This.Void_Ptr); - Wrapper (This.My_Input.all).Needs_Dealloc := False; end return; end Create; @@ -211,10 +214,10 @@ package body FLTK.Widgets.Valuators.Value_Inputs is function Input - (This : in Value_Input) + (This : in out Value_Input) return FLTK.Widgets.Inputs.Input_Reference is begin - return (Data => This.My_Input); + return (Data => This.My_Input'Unchecked_Access); end Input; diff --git a/src/fltk-widgets-valuators-value_inputs.ads b/src/fltk-widgets-valuators-value_inputs.ads index 663a88d..8c45026 100644 --- a/src/fltk-widgets-valuators-value_inputs.ads +++ b/src/fltk-widgets-valuators-value_inputs.ads @@ -33,7 +33,7 @@ package FLTK.Widgets.Valuators.Value_Inputs is function Input - (This : in Value_Input) + (This : in out Value_Input) return FLTK.Widgets.Inputs.Input_Reference; @@ -111,37 +111,30 @@ package FLTK.Widgets.Valuators.Value_Inputs is private - package INP renames FLTK.Widgets.Inputs; - - - type Input_Access is access INP.Input; - - type Value_Input is new Valuator with record - My_Input : Input_Access; + My_Input : aliased Inputs.Input; end record; overriding procedure Finalize (This : in out Value_Input); - + procedure Extra_Init + (This : in out Value_Input; + X, Y, W, H : in Integer; + Text : in String); pragma Inline (Input); - pragma Inline (Get_Cursor_Color); pragma Inline (Set_Cursor_Color); - pragma Inline (Get_Shortcut); pragma Inline (Set_Shortcut); - pragma Inline (Is_Soft); pragma Inline (Set_Soft); - pragma Inline (Get_Text_Color); pragma Inline (Set_Text_Color); pragma Inline (Get_Text_Font); @@ -149,7 +142,6 @@ private pragma Inline (Get_Text_Size); pragma Inline (Set_Text_Size); - pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-valuators-value_outputs.adb b/src/fltk-widgets-valuators-value_outputs.adb index 86ecf89..970d7e1 100644 --- a/src/fltk-widgets-valuators-value_outputs.adb +++ b/src/fltk-widgets-valuators-value_outputs.adb @@ -128,6 +128,15 @@ package body FLTK.Widgets.Valuators.Value_Outputs is + procedure Extra_Init + (This : in out Value_Output; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Valuator (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -142,14 +151,11 @@ package body FLTK.Widgets.Valuators.Value_Outputs is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); value_output_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); value_output_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-valuators-value_outputs.ads b/src/fltk-widgets-valuators-value_outputs.ads index 7b2d9cd..1220a79 100644 --- a/src/fltk-widgets-valuators-value_outputs.ads +++ b/src/fltk-widgets-valuators-value_outputs.ads @@ -82,13 +82,16 @@ private overriding procedure Finalize (This : in out Value_Output); - + procedure Extra_Init + (This : in out Value_Output; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Is_Soft); pragma Inline (Set_Soft); - pragma Inline (Get_Text_Color); pragma Inline (Set_Text_Color); pragma Inline (Get_Text_Font); @@ -96,7 +99,6 @@ private pragma Inline (Get_Text_Size); pragma Inline (Set_Text_Size); - pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-valuators.adb b/src/fltk-widgets-valuators.adb index 4ea6880..d20faef 100644 --- a/src/fltk-widgets-valuators.adb +++ b/src/fltk-widgets-valuators.adb @@ -159,6 +159,15 @@ package body FLTK.Widgets.Valuators is + procedure Extra_Init + (This : in out Valuator; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Widget (This), X, Y, W, H, Text); + end Extra_Init; + + package body Forge is function Create @@ -173,12 +182,9 @@ package body FLTK.Widgets.Valuators is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); valuator_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); valuator_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-valuators.ads b/src/fltk-widgets-valuators.ads index 126d9a2..6d12cd0 100644 --- a/src/fltk-widgets-valuators.ads +++ b/src/fltk-widgets-valuators.ads @@ -107,14 +107,17 @@ private overriding procedure Finalize (This : in out Valuator); - + procedure Extra_Init + (This : in out Valuator; + X, Y, W, H : in Integer; + Text : in String) + with Inline; pragma Inline (Clamp); pragma Inline (Round); pragma Inline (Increment); - pragma Inline (Get_Minimum); pragma Inline (Set_Minimum); pragma Inline (Get_Maximum); @@ -127,7 +130,6 @@ private pragma Inline (Set_Precision); pragma Inline (Set_Range); - pragma Inline (Handle); diff --git a/src/fltk-widgets.adb b/src/fltk-widgets.adb index 2f78677..31fc6b5 100644 --- a/src/fltk-widgets.adb +++ b/src/fltk-widgets.adb @@ -515,6 +515,18 @@ package body FLTK.Widgets is + procedure Extra_Init + (This : in out Widget; + X, Y, W, H : in Integer; + Text : in String) is + begin + fl_widget_set_user_data + (This.Void_Ptr, + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); + end Extra_Init; + + package body Forge is function Create @@ -529,12 +541,9 @@ package body FLTK.Widgets is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + Extra_Init (This, X, Y, W, H, Text); widget_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); widget_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets.ads b/src/fltk-widgets.ads index 9964bda..e0ab7a3 100644 --- a/src/fltk-widgets.ads +++ b/src/fltk-widgets.ads @@ -361,6 +361,11 @@ private overriding procedure Finalize (This : in out Widget); + procedure Extra_Init + (This : in out Widget; + X, Y, W, H : in Integer; + Text : in String); + diff --git a/src/fltk.ads b/src/fltk.ads index ec6012f..e686934 100644 --- a/src/fltk.ads +++ b/src/fltk.ads @@ -394,6 +394,9 @@ private + -- Note: This has to be Limited because otherwise the various init subprograms + -- wouldn't work, the widget callbacks wouldn't work, deallocation would be + -- a mess, really just all sorts of problems. type Wrapper is new Ada.Finalization.Limited_Controlled with record Void_Ptr : Storage.Integer_Address; |