summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/fltk-widgets-boxes.adb14
-rw-r--r--src/fltk-widgets-boxes.ads6
-rw-r--r--src/fltk-widgets-buttons-enter.adb14
-rw-r--r--src/fltk-widgets-buttons-enter.ads6
-rw-r--r--src/fltk-widgets-buttons-light-check.adb14
-rw-r--r--src/fltk-widgets-buttons-light-check.ads6
-rw-r--r--src/fltk-widgets-buttons-light-radio.adb14
-rw-r--r--src/fltk-widgets-buttons-light-radio.ads6
-rw-r--r--src/fltk-widgets-buttons-light-round-radio.adb14
-rw-r--r--src/fltk-widgets-buttons-light-round-radio.ads6
-rw-r--r--src/fltk-widgets-buttons-light-round.adb14
-rw-r--r--src/fltk-widgets-buttons-light-round.ads6
-rw-r--r--src/fltk-widgets-buttons-light.adb14
-rw-r--r--src/fltk-widgets-buttons-light.ads6
-rw-r--r--src/fltk-widgets-buttons-radio.adb14
-rw-r--r--src/fltk-widgets-buttons-radio.ads6
-rw-r--r--src/fltk-widgets-buttons-repeat.adb14
-rw-r--r--src/fltk-widgets-buttons-repeat.ads6
-rw-r--r--src/fltk-widgets-buttons-toggle.adb14
-rw-r--r--src/fltk-widgets-buttons-toggle.ads6
-rw-r--r--src/fltk-widgets-buttons.adb14
-rw-r--r--src/fltk-widgets-buttons.ads8
-rw-r--r--src/fltk-widgets-charts.adb14
-rw-r--r--src/fltk-widgets-charts.ads10
-rw-r--r--src/fltk-widgets-clocks-updated-round.adb14
-rw-r--r--src/fltk-widgets-clocks-updated-round.ads6
-rw-r--r--src/fltk-widgets-clocks-updated.adb19
-rw-r--r--src/fltk-widgets-clocks-updated.ads6
-rw-r--r--src/fltk-widgets-clocks.adb14
-rw-r--r--src/fltk-widgets-clocks.ads8
-rw-r--r--src/fltk-widgets-groups-browsers.adb60
-rw-r--r--src/fltk-widgets-groups-browsers.ads18
-rw-r--r--src/fltk-widgets-groups-color_choosers.adb15
-rw-r--r--src/fltk-widgets-groups-color_choosers.ads11
-rw-r--r--src/fltk-widgets-groups-help_views.adb14
-rw-r--r--src/fltk-widgets-groups-help_views.ads6
-rw-r--r--src/fltk-widgets-groups-input_choices.adb60
-rw-r--r--src/fltk-widgets-groups-input_choices.ads19
-rw-r--r--src/fltk-widgets-groups-packed.adb15
-rw-r--r--src/fltk-widgets-groups-packed.ads7
-rw-r--r--src/fltk-widgets-groups-scrolls.adb15
-rw-r--r--src/fltk-widgets-groups-scrolls.ads9
-rw-r--r--src/fltk-widgets-groups-spinners.adb15
-rw-r--r--src/fltk-widgets-groups-spinners.ads8
-rw-r--r--src/fltk-widgets-groups-tabbed.adb15
-rw-r--r--src/fltk-widgets-groups-tabbed.ads8
-rw-r--r--src/fltk-widgets-groups-text_displays-text_editors.adb88
-rw-r--r--src/fltk-widgets-groups-text_displays-text_editors.ads30
-rw-r--r--src/fltk-widgets-groups-text_displays.adb15
-rw-r--r--src/fltk-widgets-groups-text_displays.ads21
-rw-r--r--src/fltk-widgets-groups-tiled.adb15
-rw-r--r--src/fltk-widgets-groups-tiled.ads7
-rw-r--r--src/fltk-widgets-groups-windows-double-overlay.adb21
-rw-r--r--src/fltk-widgets-groups-windows-double-overlay.ads8
-rw-r--r--src/fltk-widgets-groups-windows-double.adb21
-rw-r--r--src/fltk-widgets-groups-windows-double.ads7
-rw-r--r--src/fltk-widgets-groups-windows-opengl.adb21
-rw-r--r--src/fltk-widgets-groups-windows-opengl.ads10
-rw-r--r--src/fltk-widgets-groups-windows-single-menu.adb21
-rw-r--r--src/fltk-widgets-groups-windows-single-menu.ads8
-rw-r--r--src/fltk-widgets-groups-windows-single.adb21
-rw-r--r--src/fltk-widgets-groups-windows-single.ads7
-rw-r--r--src/fltk-widgets-groups-windows.adb21
-rw-r--r--src/fltk-widgets-groups-windows.ads14
-rw-r--r--src/fltk-widgets-groups-wizards.adb15
-rw-r--r--src/fltk-widgets-groups-wizards.ads8
-rw-r--r--src/fltk-widgets-groups.adb24
-rw-r--r--src/fltk-widgets-groups.ads22
-rw-r--r--src/fltk-widgets-inputs-file.adb14
-rw-r--r--src/fltk-widgets-inputs-file.ads8
-rw-r--r--src/fltk-widgets-inputs-float.adb14
-rw-r--r--src/fltk-widgets-inputs-float.ads7
-rw-r--r--src/fltk-widgets-inputs-integer.adb14
-rw-r--r--src/fltk-widgets-inputs-integer.ads7
-rw-r--r--src/fltk-widgets-inputs-multiline.adb14
-rw-r--r--src/fltk-widgets-inputs-multiline.ads6
-rw-r--r--src/fltk-widgets-inputs-outputs-multiline.adb14
-rw-r--r--src/fltk-widgets-inputs-outputs-multiline.ads6
-rw-r--r--src/fltk-widgets-inputs-outputs.adb14
-rw-r--r--src/fltk-widgets-inputs-outputs.ads6
-rw-r--r--src/fltk-widgets-inputs-secret.adb14
-rw-r--r--src/fltk-widgets-inputs-secret.ads6
-rw-r--r--src/fltk-widgets-inputs.adb14
-rw-r--r--src/fltk-widgets-inputs.ads17
-rw-r--r--src/fltk-widgets-menus-choices.adb12
-rw-r--r--src/fltk-widgets-menus-choices.ads7
-rw-r--r--src/fltk-widgets-menus-menu_bars.adb14
-rw-r--r--src/fltk-widgets-menus-menu_bars.ads6
-rw-r--r--src/fltk-widgets-menus-menu_buttons.adb14
-rw-r--r--src/fltk-widgets-menus-menu_buttons.ads7
-rw-r--r--src/fltk-widgets-menus.adb15
-rw-r--r--src/fltk-widgets-menus.ads16
-rw-r--r--src/fltk-widgets-progress_bars.adb14
-rw-r--r--src/fltk-widgets-progress_bars.ads7
-rw-r--r--src/fltk-widgets-valuators-adjusters.adb14
-rw-r--r--src/fltk-widgets-valuators-adjusters.ads7
-rw-r--r--src/fltk-widgets-valuators-counters-simple.adb14
-rw-r--r--src/fltk-widgets-valuators-counters-simple.ads6
-rw-r--r--src/fltk-widgets-valuators-counters.adb14
-rw-r--r--src/fltk-widgets-valuators-counters.ads8
-rw-r--r--src/fltk-widgets-valuators-dials-fill.adb14
-rw-r--r--src/fltk-widgets-valuators-dials-fill.ads6
-rw-r--r--src/fltk-widgets-valuators-dials-line.adb14
-rw-r--r--src/fltk-widgets-valuators-dials-line.ads6
-rw-r--r--src/fltk-widgets-valuators-dials.adb14
-rw-r--r--src/fltk-widgets-valuators-dials.ads8
-rw-r--r--src/fltk-widgets-valuators-rollers.adb14
-rw-r--r--src/fltk-widgets-valuators-rollers.ads6
-rw-r--r--src/fltk-widgets-valuators-sliders-fill.adb14
-rw-r--r--src/fltk-widgets-valuators-sliders-fill.ads6
-rw-r--r--src/fltk-widgets-valuators-sliders-hor_fill.adb14
-rw-r--r--src/fltk-widgets-valuators-sliders-hor_fill.ads6
-rw-r--r--src/fltk-widgets-valuators-sliders-hor_nice.adb14
-rw-r--r--src/fltk-widgets-valuators-sliders-hor_nice.ads6
-rw-r--r--src/fltk-widgets-valuators-sliders-horizontal.adb14
-rw-r--r--src/fltk-widgets-valuators-sliders-horizontal.ads6
-rw-r--r--src/fltk-widgets-valuators-sliders-nice.adb14
-rw-r--r--src/fltk-widgets-valuators-sliders-nice.ads6
-rw-r--r--src/fltk-widgets-valuators-sliders-scrollbars.adb14
-rw-r--r--src/fltk-widgets-valuators-sliders-scrollbars.ads7
-rw-r--r--src/fltk-widgets-valuators-sliders-value-horizontal.adb14
-rw-r--r--src/fltk-widgets-valuators-sliders-value-horizontal.ads6
-rw-r--r--src/fltk-widgets-valuators-sliders-value.adb14
-rw-r--r--src/fltk-widgets-valuators-sliders-value.ads7
-rw-r--r--src/fltk-widgets-valuators-sliders.adb14
-rw-r--r--src/fltk-widgets-valuators-sliders.ads7
-rw-r--r--src/fltk-widgets-valuators-value_inputs.adb41
-rw-r--r--src/fltk-widgets-valuators-value_inputs.ads20
-rw-r--r--src/fltk-widgets-valuators-value_outputs.adb14
-rw-r--r--src/fltk-widgets-valuators-value_outputs.ads8
-rw-r--r--src/fltk-widgets-valuators.adb14
-rw-r--r--src/fltk-widgets-valuators.ads8
-rw-r--r--src/fltk-widgets.adb17
-rw-r--r--src/fltk-widgets.ads5
-rw-r--r--src/fltk.ads3
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;