diff options
Diffstat (limited to 'src')
32 files changed, 881 insertions, 1332 deletions
diff --git a/src/fltk-widgets-boxes.adb b/src/fltk-widgets-boxes.adb index a2d2335..95b8c85 100644 --- a/src/fltk-widgets-boxes.adb +++ b/src/fltk-widgets-boxes.adb @@ -16,15 +16,6 @@ package body FLTK.Widgets.Boxes is (W, H : in System.Address); pragma Import (C, box_set_handle_hook, "box_set_handle_hook"); - procedure fl_box_draw - (W : in System.Address); - pragma Import (C, fl_box_draw, "fl_box_draw"); - - function fl_box_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_box_handle, "fl_box_handle"); function new_fl_box (X, Y, W, H : in Interfaces.C.int; @@ -37,42 +28,15 @@ package body FLTK.Widgets.Boxes is pragma Import (C, free_fl_box, "free_fl_box"); + procedure fl_box_draw + (W : in System.Address); + pragma Import (C, fl_box_draw, "fl_box_draw"); - - procedure Draw_Hook (U : in System.Address); - pragma Convention (C, Draw_Hook); - - procedure Draw_Hook - (U : in System.Address) - is - package Box_Convert is new System.Address_To_Access_Conversions (Box'Class); - - Ada_Box : access Box'Class := - Box_Convert.To_Pointer (U); - begin - Ada_Box.Draw; - end Draw_Hook; - - - - - procedure Draw - (This : in out Box) is - begin - fl_box_draw (This.Void_Ptr); - end Draw; - - - - - function Handle - (This : in out Box; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_box_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; + function fl_box_handle + (W : in System.Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_box_handle, "fl_box_handle"); @@ -113,5 +77,26 @@ package body FLTK.Widgets.Boxes is end Create; + + + procedure Draw + (This : in out Box) is + begin + fl_box_draw (This.Void_Ptr); + end Draw; + + + + + function Handle + (This : in out Box; + Event : in Event_Kind) + return Event_Outcome is + begin + return Event_Outcome'Val + (fl_box_handle (This.Void_Ptr, Event_Kind'Pos (Event))); + end Handle; + + end FLTK.Widgets.Boxes; diff --git a/src/fltk-widgets-buttons-enter.adb b/src/fltk-widgets-buttons-enter.adb index a1f36f6..94ac313 100644 --- a/src/fltk-widgets-buttons-enter.adb +++ b/src/fltk-widgets-buttons-enter.adb @@ -16,15 +16,6 @@ package body FLTK.Widgets.Buttons.Enter is (W, H : in System.Address); pragma Import (C, return_button_set_handle_hook, "return_button_set_handle_hook"); - procedure fl_return_button_draw - (W : in System.Address); - pragma Import (C, fl_return_button_draw, "fl_return_button_draw"); - - function fl_return_button_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_return_button_handle, "fl_return_button_handle"); function new_fl_return_button (X, Y, W, H : in Interfaces.C.int; @@ -37,43 +28,15 @@ package body FLTK.Widgets.Buttons.Enter is pragma Import (C, free_fl_return_button, "free_fl_return_button"); + procedure fl_return_button_draw + (W : in System.Address); + pragma Import (C, fl_return_button_draw, "fl_return_button_draw"); - - procedure Draw_Hook (U : in System.Address); - pragma Convention (C, Draw_Hook); - - procedure Draw_Hook - (U : in System.Address) - is - package Enter_Button_Convert is new - System.Address_To_Access_Conversions (Enter_Button'Class); - - Ada_Enter_Button : access Enter_Button'Class := - Enter_Button_Convert.To_Pointer (U); - begin - Ada_Enter_Button.Draw; - end Draw_Hook; - - - - - procedure Draw - (This : in out Enter_Button) is - begin - fl_return_button_draw (This.Void_Ptr); - end Draw; - - - - - function Handle - (This : in out Enter_Button; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_return_button_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; + function fl_return_button_handle + (W : in System.Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_return_button_handle, "fl_return_button_handle"); @@ -114,5 +77,26 @@ package body FLTK.Widgets.Buttons.Enter is end Create; + + + procedure Draw + (This : in out Enter_Button) is + begin + fl_return_button_draw (This.Void_Ptr); + end Draw; + + + + + function Handle + (This : in out Enter_Button; + Event : in Event_Kind) + return Event_Outcome is + begin + return Event_Outcome'Val + (fl_return_button_handle (This.Void_Ptr, Event_Kind'Pos (Event))); + end Handle; + + end FLTK.Widgets.Buttons.Enter; diff --git a/src/fltk-widgets-buttons-light-check.adb b/src/fltk-widgets-buttons-light-check.adb index 8db7533..e0e25b4 100644 --- a/src/fltk-widgets-buttons-light-check.adb +++ b/src/fltk-widgets-buttons-light-check.adb @@ -16,15 +16,6 @@ package body FLTK.Widgets.Buttons.Light.Check is (W, H : in System.Address); pragma Import (C, check_button_set_handle_hook, "check_button_set_handle_hook"); - procedure fl_check_button_draw - (W : in System.Address); - pragma Import (C, fl_check_button_draw, "fl_check_button_draw"); - - function fl_check_button_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_check_button_handle, "fl_check_button_handle"); function new_fl_check_button (X, Y, W, H : in Interfaces.C.int; @@ -37,43 +28,15 @@ package body FLTK.Widgets.Buttons.Light.Check is pragma Import (C, free_fl_check_button, "free_fl_check_button"); + procedure fl_check_button_draw + (W : in System.Address); + pragma Import (C, fl_check_button_draw, "fl_check_button_draw"); - - procedure Draw_Hook (U : in System.Address); - pragma Convention (C, Draw_Hook); - - procedure Draw_Hook - (U : in System.Address) - is - package Check_Button_Convert is new - System.Address_To_Access_Conversions (Check_Button'Class); - - Ada_Check_Button : access Check_Button'Class := - Check_Button_Convert.To_Pointer (U); - begin - Ada_Check_Button.Draw; - end Draw_Hook; - - - - - procedure Draw - (This : in out Check_Button) is - begin - fl_check_button_draw (This.Void_Ptr); - end Draw; - - - - - function Handle - (This : in out Check_Button; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_check_button_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; + function fl_check_button_handle + (W : in System.Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_check_button_handle, "fl_check_button_handle"); @@ -114,5 +77,26 @@ package body FLTK.Widgets.Buttons.Light.Check is end Create; + + + procedure Draw + (This : in out Check_Button) is + begin + fl_check_button_draw (This.Void_Ptr); + end Draw; + + + + + function Handle + (This : in out Check_Button; + Event : in Event_Kind) + return Event_Outcome is + begin + return Event_Outcome'Val + (fl_check_button_handle (This.Void_Ptr, Event_Kind'Pos (Event))); + end Handle; + + end FLTK.Widgets.Buttons.Light.Check; diff --git a/src/fltk-widgets-buttons-light-radio.adb b/src/fltk-widgets-buttons-light-radio.adb index 7ff4e43..8da2958 100644 --- a/src/fltk-widgets-buttons-light-radio.adb +++ b/src/fltk-widgets-buttons-light-radio.adb @@ -16,15 +16,6 @@ package body FLTK.Widgets.Buttons.Light.Radio is (W, H : in System.Address); pragma Import (C, radio_light_button_set_handle_hook, "radio_light_button_set_handle_hook"); - procedure fl_radio_light_button_draw - (W : in System.Address); - pragma Import (C, fl_radio_light_button_draw, "fl_radio_light_button_draw"); - - function fl_radio_light_button_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_radio_light_button_handle, "fl_radio_light_button_handle"); function new_fl_radio_light_button (X, Y, W, H : in Interfaces.C.int; @@ -37,43 +28,15 @@ package body FLTK.Widgets.Buttons.Light.Radio is pragma Import (C, free_fl_radio_light_button, "free_fl_radio_light_button"); + procedure fl_radio_light_button_draw + (W : in System.Address); + pragma Import (C, fl_radio_light_button_draw, "fl_radio_light_button_draw"); - - procedure Draw_Hook (U : in System.Address); - pragma Convention (C, Draw_Hook); - - procedure Draw_Hook - (U : in System.Address) - is - package Radio_Light_Button_Convert is new - System.Address_To_Access_Conversions (Radio_Light_Button'Class); - - Ada_Radio_Light_Button : access Radio_Light_Button'Class := - Radio_Light_Button_Convert.To_Pointer (U); - begin - Ada_Radio_Light_Button.Draw; - end Draw_Hook; - - - - - procedure Draw - (This : in out Radio_Light_Button) is - begin - fl_radio_light_button_draw (This.Void_Ptr); - end Draw; - - - - - function Handle - (This : in out Radio_Light_Button; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_radio_light_button_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; + function fl_radio_light_button_handle + (W : in System.Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_radio_light_button_handle, "fl_radio_light_button_handle"); @@ -114,5 +77,26 @@ package body FLTK.Widgets.Buttons.Light.Radio is end Create; + + + procedure Draw + (This : in out Radio_Light_Button) is + begin + fl_radio_light_button_draw (This.Void_Ptr); + end Draw; + + + + + function Handle + (This : in out Radio_Light_Button; + Event : in Event_Kind) + return Event_Outcome is + begin + return Event_Outcome'Val + (fl_radio_light_button_handle (This.Void_Ptr, Event_Kind'Pos (Event))); + end Handle; + + end FLTK.Widgets.Buttons.Light.Radio; diff --git a/src/fltk-widgets-buttons-light-round-radio.adb b/src/fltk-widgets-buttons-light-round-radio.adb index eeaee2b..58d92e4 100644 --- a/src/fltk-widgets-buttons-light-round-radio.adb +++ b/src/fltk-widgets-buttons-light-round-radio.adb @@ -16,15 +16,6 @@ package body FLTK.Widgets.Buttons.Light.Round.Radio is (W, H : in System.Address); pragma Import (C, radio_round_button_set_handle_hook, "radio_round_button_set_handle_hook"); - procedure fl_radio_round_button_draw - (W : in System.Address); - pragma Import (C, fl_radio_round_button_draw, "fl_radio_round_button_draw"); - - function fl_radio_round_button_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_radio_round_button_handle, "fl_radio_round_button_handle"); function new_fl_radio_round_button (X, Y, W, H : in Interfaces.C.int; @@ -37,43 +28,15 @@ package body FLTK.Widgets.Buttons.Light.Round.Radio is pragma Import (C, free_fl_radio_round_button, "free_fl_radio_round_button"); + procedure fl_radio_round_button_draw + (W : in System.Address); + pragma Import (C, fl_radio_round_button_draw, "fl_radio_round_button_draw"); - - procedure Draw_Hook (U : in System.Address); - pragma Convention (C, Draw_Hook); - - procedure Draw_Hook - (U : in System.Address) - is - package Radio_Round_Button_Convert is new - System.Address_To_Access_Conversions (Radio_Round_Button'Class); - - Ada_Radio_Round_Button : access Radio_Round_Button'Class := - Radio_Round_Button_Convert.To_Pointer (U); - begin - Ada_Radio_Round_Button.Draw; - end Draw_Hook; - - - - - procedure Draw - (This : in out Radio_Round_Button) is - begin - fl_radio_round_button_draw (This.Void_Ptr); - end Draw; - - - - - function Handle - (This : in out Radio_Round_Button; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_radio_round_button_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; + function fl_radio_round_button_handle + (W : in System.Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_radio_round_button_handle, "fl_radio_round_button_handle"); @@ -114,5 +77,26 @@ package body FLTK.Widgets.Buttons.Light.Round.Radio is end Create; + + + procedure Draw + (This : in out Radio_Round_Button) is + begin + fl_radio_round_button_draw (This.Void_Ptr); + end Draw; + + + + + function Handle + (This : in out Radio_Round_Button; + Event : in Event_Kind) + return Event_Outcome is + begin + return Event_Outcome'Val + (fl_radio_round_button_handle (This.Void_Ptr, Event_Kind'Pos (Event))); + end Handle; + + end FLTK.Widgets.Buttons.Light.Round.Radio; diff --git a/src/fltk-widgets-buttons-light-round.adb b/src/fltk-widgets-buttons-light-round.adb index c13bb43..d047603 100644 --- a/src/fltk-widgets-buttons-light-round.adb +++ b/src/fltk-widgets-buttons-light-round.adb @@ -16,15 +16,6 @@ package body FLTK.Widgets.Buttons.Light.Round is (W, H : in System.Address); pragma Import (C, round_button_set_handle_hook, "round_button_set_handle_hook"); - procedure fl_round_button_draw - (W : in System.Address); - pragma Import (C, fl_round_button_draw, "fl_round_button_draw"); - - function fl_round_button_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_round_button_handle, "fl_round_button_handle"); function new_fl_round_button (X, Y, W, H : in Interfaces.C.int; @@ -37,43 +28,15 @@ package body FLTK.Widgets.Buttons.Light.Round is pragma Import (C, free_fl_round_button, "free_fl_round_button"); + procedure fl_round_button_draw + (W : in System.Address); + pragma Import (C, fl_round_button_draw, "fl_round_button_draw"); - - procedure Draw_Hook (U : in System.Address); - pragma Convention (C, Draw_Hook); - - procedure Draw_Hook - (U : in System.Address) - is - package Round_Button_Convert is new - System.Address_To_Access_Conversions (Round_Button'Class); - - Ada_Round_Button : access Round_Button'Class := - Round_Button_Convert.To_Pointer (U); - begin - Ada_Round_Button.Draw; - end Draw_Hook; - - - - - procedure Draw - (This : in out Round_Button) is - begin - fl_round_button_draw (This.Void_Ptr); - end Draw; - - - - - function Handle - (This : in out Round_Button; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_round_button_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; + function fl_round_button_handle + (W : in System.Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_round_button_handle, "fl_round_button_handle"); @@ -114,5 +77,26 @@ package body FLTK.Widgets.Buttons.Light.Round is end Create; + + + procedure Draw + (This : in out Round_Button) is + begin + fl_round_button_draw (This.Void_Ptr); + end Draw; + + + + + function Handle + (This : in out Round_Button; + Event : in Event_Kind) + return Event_Outcome is + begin + return Event_Outcome'Val + (fl_round_button_handle (This.Void_Ptr, Event_Kind'Pos (Event))); + end Handle; + + end FLTK.Widgets.Buttons.Light.Round; diff --git a/src/fltk-widgets-buttons-light.adb b/src/fltk-widgets-buttons-light.adb index e8adf8b..de88e85 100644 --- a/src/fltk-widgets-buttons-light.adb +++ b/src/fltk-widgets-buttons-light.adb @@ -16,15 +16,6 @@ package body FLTK.Widgets.Buttons.Light is (W, H : in System.Address); pragma Import (C, light_button_set_handle_hook, "light_button_set_handle_hook"); - procedure fl_light_button_draw - (W : in System.Address); - pragma Import (C, fl_light_button_draw, "fl_light_button_draw"); - - function fl_light_button_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_light_button_handle, "fl_light_button_handle"); function new_fl_light_button (X, Y, W, H : in Interfaces.C.int; @@ -37,43 +28,15 @@ package body FLTK.Widgets.Buttons.Light is pragma Import (C, free_fl_light_button, "free_fl_light_button"); + procedure fl_light_button_draw + (W : in System.Address); + pragma Import (C, fl_light_button_draw, "fl_light_button_draw"); - - procedure Draw_Hook (U : in System.Address); - pragma Convention (C, Draw_Hook); - - procedure Draw_Hook - (U : in System.Address) - is - package Light_Button_Convert is new - System.Address_To_Access_Conversions (Light_Button'Class); - - Ada_Light_Button : access Light_Button'Class := - Light_Button_Convert.To_Pointer (U); - begin - Ada_Light_Button.Draw; - end Draw_Hook; - - - - - procedure Draw - (This : in out Light_Button) is - begin - fl_light_button_draw (This.Void_Ptr); - end Draw; - - - - - function Handle - (This : in out Light_Button; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_light_button_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; + function fl_light_button_handle + (W : in System.Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_light_button_handle, "fl_light_button_handle"); @@ -114,5 +77,26 @@ package body FLTK.Widgets.Buttons.Light is end Create; + + + procedure Draw + (This : in out Light_Button) is + begin + fl_light_button_draw (This.Void_Ptr); + end Draw; + + + + + function Handle + (This : in out Light_Button; + Event : in Event_Kind) + return Event_Outcome is + begin + return Event_Outcome'Val + (fl_light_button_handle (This.Void_Ptr, Event_Kind'Pos (Event))); + end Handle; + + end FLTK.Widgets.Buttons.Light; diff --git a/src/fltk-widgets-buttons-radio.adb b/src/fltk-widgets-buttons-radio.adb index a60ce19..2a9849c 100644 --- a/src/fltk-widgets-buttons-radio.adb +++ b/src/fltk-widgets-buttons-radio.adb @@ -16,15 +16,6 @@ package body FLTK.Widgets.Buttons.Radio is (W, H : in System.Address); pragma Import (C, radio_button_set_handle_hook, "radio_button_set_handle_hook"); - procedure fl_radio_button_draw - (W : in System.Address); - pragma Import (C, fl_radio_button_draw, "fl_radio_button_draw"); - - function fl_radio_button_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_radio_button_handle, "fl_radio_button_handle"); function new_fl_radio_button (X, Y, W, H : in Interfaces.C.int; @@ -37,43 +28,15 @@ package body FLTK.Widgets.Buttons.Radio is pragma Import (C, free_fl_radio_button, "free_fl_radio_button"); + procedure fl_radio_button_draw + (W : in System.Address); + pragma Import (C, fl_radio_button_draw, "fl_radio_button_draw"); - - procedure Draw_Hook (U : in System.Address); - pragma Convention (C, Draw_Hook); - - procedure Draw_Hook - (U : in System.Address) - is - package Radio_Button_Convert is new - System.Address_To_Access_Conversions (Radio_Button'Class); - - Ada_Radio_Button : access Radio_Button'Class := - Radio_Button_Convert.To_Pointer (U); - begin - Ada_Radio_Button.Draw; - end Draw_Hook; - - - - - procedure Draw - (This : in out Radio_Button) is - begin - fl_radio_button_draw (This.Void_Ptr); - end Draw; - - - - - function Handle - (This : in out Radio_Button; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_radio_button_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; + function fl_radio_button_handle + (W : in System.Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_radio_button_handle, "fl_radio_button_handle"); @@ -114,5 +77,26 @@ package body FLTK.Widgets.Buttons.Radio is end Create; + + + procedure Draw + (This : in out Radio_Button) is + begin + fl_radio_button_draw (This.Void_Ptr); + end Draw; + + + + + function Handle + (This : in out Radio_Button; + Event : in Event_Kind) + return Event_Outcome is + begin + return Event_Outcome'Val + (fl_radio_button_handle (This.Void_Ptr, Event_Kind'Pos (Event))); + end Handle; + + end FLTK.Widgets.Buttons.Radio; diff --git a/src/fltk-widgets-buttons-repeat.adb b/src/fltk-widgets-buttons-repeat.adb index cbc3594..02c391c 100644 --- a/src/fltk-widgets-buttons-repeat.adb +++ b/src/fltk-widgets-buttons-repeat.adb @@ -16,15 +16,6 @@ package body FLTK.Widgets.Buttons.Repeat is (W, H : in System.Address); pragma Import (C, repeat_button_set_handle_hook, "repeat_button_set_handle_hook"); - procedure fl_repeat_button_draw - (W : in System.Address); - pragma Import (C, fl_repeat_button_draw, "fl_repeat_button_draw"); - - function fl_repeat_button_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_repeat_button_handle, "fl_repeat_button_handle"); function new_fl_repeat_button (X, Y, W, H : in Interfaces.C.int; @@ -37,43 +28,15 @@ package body FLTK.Widgets.Buttons.Repeat is pragma Import (C, free_fl_repeat_button, "free_fl_repeat_button"); + procedure fl_repeat_button_draw + (W : in System.Address); + pragma Import (C, fl_repeat_button_draw, "fl_repeat_button_draw"); - - procedure Draw_Hook (U : in System.Address); - pragma Convention (C, Draw_Hook); - - procedure Draw_Hook - (U : in System.Address) - is - package Repeat_Button_Convert is new - System.Address_To_Access_Conversions (Repeat_Button'Class); - - Ada_Repeat_Button : access Repeat_Button'Class := - Repeat_Button_Convert.To_Pointer (U); - begin - Ada_Repeat_Button.Draw; - end Draw_Hook; - - - - - procedure Draw - (This : in out Repeat_Button) is - begin - fl_repeat_button_draw (This.Void_Ptr); - end Draw; - - - - - function Handle - (This : in out Repeat_Button; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_repeat_button_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; + function fl_repeat_button_handle + (W : in System.Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_repeat_button_handle, "fl_repeat_button_handle"); @@ -114,5 +77,26 @@ package body FLTK.Widgets.Buttons.Repeat is end Create; + + + procedure Draw + (This : in out Repeat_Button) is + begin + fl_repeat_button_draw (This.Void_Ptr); + end Draw; + + + + + function Handle + (This : in out Repeat_Button; + Event : in Event_Kind) + return Event_Outcome is + begin + return Event_Outcome'Val + (fl_repeat_button_handle (This.Void_Ptr, Event_Kind'Pos (Event))); + end Handle; + + end FLTK.Widgets.Buttons.Repeat; diff --git a/src/fltk-widgets-buttons-toggle.adb b/src/fltk-widgets-buttons-toggle.adb index 0c2cf69..2734077 100644 --- a/src/fltk-widgets-buttons-toggle.adb +++ b/src/fltk-widgets-buttons-toggle.adb @@ -16,15 +16,6 @@ package body FLTK.Widgets.Buttons.Toggle is (W, H : in System.Address); pragma Import (C, toggle_button_set_handle_hook, "toggle_button_set_handle_hook"); - procedure fl_toggle_button_draw - (W : in System.Address); - pragma Import (C, fl_toggle_button_draw, "fl_toggle_button_draw"); - - function fl_toggle_button_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_toggle_button_handle, "fl_toggle_button_handle"); function new_fl_toggle_button (X, Y, W, H : in Interfaces.C.int; @@ -37,43 +28,15 @@ package body FLTK.Widgets.Buttons.Toggle is pragma Import (C, free_fl_toggle_button, "free_fl_toggle_button"); + procedure fl_toggle_button_draw + (W : in System.Address); + pragma Import (C, fl_toggle_button_draw, "fl_toggle_button_draw"); - - procedure Draw_Hook (U : in System.Address); - pragma Convention (C, Draw_Hook); - - procedure Draw_Hook - (U : in System.Address) - is - package Toggle_Button_Convert is new - System.Address_To_Access_Conversions (Toggle_Button'Class); - - Ada_Toggle_Button : access Toggle_Button'Class := - Toggle_Button_Convert.To_Pointer (U); - begin - Ada_Toggle_Button.Draw; - end Draw_Hook; - - - - - procedure Draw - (This : in out Toggle_Button) is - begin - fl_toggle_button_draw (This.Void_Ptr); - end Draw; - - - - - function Handle - (This : in out Toggle_Button; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_toggle_button_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; + function fl_toggle_button_handle + (W : in System.Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_toggle_button_handle, "fl_toggle_button_handle"); @@ -114,5 +77,26 @@ package body FLTK.Widgets.Buttons.Toggle is end Create; + + + procedure Draw + (This : in out Toggle_Button) is + begin + fl_toggle_button_draw (This.Void_Ptr); + end Draw; + + + + + function Handle + (This : in out Toggle_Button; + Event : in Event_Kind) + return Event_Outcome is + begin + return Event_Outcome'Val + (fl_toggle_button_handle (This.Void_Ptr, Event_Kind'Pos (Event))); + end Handle; + + end FLTK.Widgets.Buttons.Toggle; diff --git a/src/fltk-widgets-buttons.adb b/src/fltk-widgets-buttons.adb index aa9e7f3..15e4982 100644 --- a/src/fltk-widgets-buttons.adb +++ b/src/fltk-widgets-buttons.adb @@ -16,15 +16,6 @@ package body FLTK.Widgets.Buttons is (W, H : in System.Address); pragma Import (C, button_set_handle_hook, "button_set_handle_hook"); - procedure fl_button_draw - (W : in System.Address); - pragma Import (C, fl_button_draw, "fl_button_draw"); - - function fl_button_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_button_handle, "fl_button_handle"); function new_fl_button (X, Y, W, H : in Interfaces.C.int; @@ -36,6 +27,7 @@ package body FLTK.Widgets.Buttons is (B : in System.Address); pragma Import (C, free_fl_button, "free_fl_button"); + function fl_button_get_state (B : in System.Address) return Interfaces.C.int; @@ -50,43 +42,15 @@ package body FLTK.Widgets.Buttons is (B : in System.Address); pragma Import (C, fl_button_set_only, "fl_button_set_only"); + procedure fl_button_draw + (W : in System.Address); + pragma Import (C, fl_button_draw, "fl_button_draw"); - - - procedure Draw_Hook (U : in System.Address); - pragma Convention (C, Draw_Hook); - - procedure Draw_Hook - (U : in System.Address) - is - package Button_Convert is new System.Address_To_Access_Conversions (Button'Class); - - Ada_Button : access Button'Class := - Button_Convert.To_Pointer (U); - begin - Ada_Button.Draw; - end Draw_Hook; - - - - - procedure Draw - (This : in out Button) is - begin - fl_button_draw (This.Void_Ptr); - end Draw; - - - - - function Handle - (This : in out Button; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_button_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; + function fl_button_handle + (W : in System.Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_button_handle, "fl_button_handle"); @@ -156,5 +120,26 @@ package body FLTK.Widgets.Buttons is end Set_Only; + + + procedure Draw + (This : in out Button) is + begin + fl_button_draw (This.Void_Ptr); + end Draw; + + + + + function Handle + (This : in out Button; + Event : in Event_Kind) + return Event_Outcome is + begin + return Event_Outcome'Val + (fl_button_handle (This.Void_Ptr, Event_Kind'Pos (Event))); + end Handle; + + end FLTK.Widgets.Buttons; diff --git a/src/fltk-widgets-groups-text_displays-text_editors.adb b/src/fltk-widgets-groups-text_displays-text_editors.adb index afe4dd4..a541833 100644 --- a/src/fltk-widgets-groups-text_displays-text_editors.adb +++ b/src/fltk-widgets-groups-text_displays-text_editors.adb @@ -16,15 +16,6 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is (W, H : in System.Address); pragma Import (C, text_editor_set_handle_hook, "text_editor_set_handle_hook"); - procedure fl_text_editor_draw - (W : in System.Address); - pragma Import (C, fl_text_editor_draw, "fl_text_editor_draw"); - - function fl_text_editor_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_editor_handle, "fl_text_editor_handle"); function new_fl_text_editor (X, Y, W, H : in Interfaces.C.int; @@ -36,6 +27,7 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is (TE : in System.Address); pragma Import (C, free_fl_text_editor, "free_fl_text_editor"); + procedure fl_text_editor_undo (TE : in System.Address); pragma Import (C, fl_text_editor_undo, "fl_text_editor_undo"); @@ -62,44 +54,15 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is M : in Interfaces.C.unsigned_long); pragma Import (C, fl_text_editor_remove_key_binding, "fl_text_editor_remove_key_binding"); + procedure fl_text_editor_draw + (W : in System.Address); + pragma Import (C, fl_text_editor_draw, "fl_text_editor_draw"); - - - procedure Draw_Hook (U : in System.Address); - pragma Convention (C, Draw_Hook); - - procedure Draw_Hook - (U : in System.Address) - is - package Text_Editor_Convert is new - System.Address_To_Access_Conversions (Text_Editor'Class); - - Ada_Text_Editor : access Text_Editor'Class := - Text_Editor_Convert.To_Pointer (U); - begin - Ada_Text_Editor.Draw; - end Draw_Hook; - - - - - procedure Draw - (This : in out Text_Editor) is - begin - fl_text_editor_draw (This.Void_Ptr); - end Draw; - - - - - function Handle - (This : in out Text_Editor; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_text_editor_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; + function fl_text_editor_handle + (W : in System.Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_editor_handle, "fl_text_editor_handle"); @@ -202,5 +165,26 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is end Remove_Key_Binding; + + + procedure Draw + (This : in out Text_Editor) is + begin + fl_text_editor_draw (This.Void_Ptr); + end Draw; + + + + + function Handle + (This : in out Text_Editor; + Event : in Event_Kind) + return Event_Outcome is + begin + return Event_Outcome'Val + (fl_text_editor_handle (This.Void_Ptr, Event_Kind'Pos (Event))); + end Handle; + + end FLTK.Widgets.Groups.Text_Displays.Text_Editors; diff --git a/src/fltk-widgets-groups-text_displays.adb b/src/fltk-widgets-groups-text_displays.adb index e805ff5..27324c2 100644 --- a/src/fltk-widgets-groups-text_displays.adb +++ b/src/fltk-widgets-groups-text_displays.adb @@ -17,15 +17,6 @@ package body FLTK.Widgets.Groups.Text_Displays is (W, H : in System.Address); pragma Import (C, text_display_set_handle_hook, "text_display_set_handle_hook"); - procedure fl_text_display_draw - (W : in System.Address); - pragma Import (C, fl_text_display_draw, "fl_text_display_draw"); - - function fl_text_display_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_display_handle, "fl_text_display_handle"); function new_fl_text_display (X, Y, W, H : in Interfaces.C.int; @@ -37,6 +28,7 @@ package body FLTK.Widgets.Groups.Text_Displays is (TD : in System.Address); pragma Import (C, free_fl_text_display, "free_fl_text_display"); + function fl_text_display_get_buffer (TD : in System.Address) return System.Address; @@ -120,44 +112,15 @@ package body FLTK.Widgets.Groups.Text_Displays is W : in Interfaces.C.int); pragma Import (C, fl_text_display_linenumber_width, "fl_text_display_linenumber_width"); + procedure fl_text_display_draw + (W : in System.Address); + pragma Import (C, fl_text_display_draw, "fl_text_display_draw"); - - - procedure Draw_Hook (U : in System.Address); - pragma Convention (C, Draw_Hook); - - procedure Draw_Hook - (U : in System.Address) - is - package Text_Display_Convert is new - System.Address_To_Access_Conversions (Text_Display'Class); - - Ada_Text_Display : access Text_Display'Class := - Text_Display_Convert.To_Pointer (U); - begin - Ada_Text_Display.Draw; - end Draw_Hook; - - - - - procedure Draw - (This : in out Text_Display) is - begin - fl_text_display_draw (This.Void_Ptr); - end Draw; - - - - - function Handle - (This : in out Text_Display; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_text_display_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; + function fl_text_display_handle + (W : in System.Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_display_handle, "fl_text_display_handle"); @@ -384,5 +347,26 @@ package body FLTK.Widgets.Groups.Text_Displays is end Set_Linenumber_Width; + + + procedure Draw + (This : in out Text_Display) is + begin + fl_text_display_draw (This.Void_Ptr); + end Draw; + + + + + function Handle + (This : in out Text_Display; + Event : in Event_Kind) + return Event_Outcome is + begin + return Event_Outcome'Val + (fl_text_display_handle (This.Void_Ptr, Event_Kind'Pos (Event))); + end Handle; + + end FLTK.Widgets.Groups.Text_Displays; diff --git a/src/fltk-widgets-groups-windows-double.adb b/src/fltk-widgets-groups-windows-double.adb index c81ffc9..c24ada1 100644 --- a/src/fltk-widgets-groups-windows-double.adb +++ b/src/fltk-widgets-groups-windows-double.adb @@ -16,15 +16,6 @@ package body FLTK.Widgets.Groups.Windows.Double is (W, H : in System.Address); pragma Import (C, double_window_set_handle_hook, "double_window_set_handle_hook"); - procedure fl_double_window_draw - (W : in System.Address); - pragma Import (C, fl_double_window_draw, "fl_double_window_draw"); - - function fl_double_window_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_double_window_handle, "fl_double_window_handle"); function new_fl_double_window (X, Y, W, H : in Interfaces.C.int; @@ -41,6 +32,7 @@ package body FLTK.Widgets.Groups.Windows.Double is (W : in System.Address); pragma Import (C, free_fl_double_window, "free_fl_double_window"); + procedure fl_double_window_show (W : in System.Address); pragma Import (C, fl_double_window_show, "fl_double_window_show"); @@ -49,44 +41,15 @@ package body FLTK.Widgets.Groups.Windows.Double is (W : in System.Address); pragma Import (C, fl_double_window_hide, "fl_double_window_hide"); + procedure fl_double_window_draw + (W : in System.Address); + pragma Import (C, fl_double_window_draw, "fl_double_window_draw"); - - - procedure Draw_Hook (U : in System.Address); - pragma Convention (C, Draw_Hook); - - procedure Draw_Hook - (U : in System.Address) - is - package Double_Window_Convert is new - System.Address_To_Access_Conversions (Double_Window'Class); - - Ada_Window : access Double_Window'Class := - Double_Window_Convert.To_Pointer (U); - begin - Ada_Window.Draw; - end Draw_Hook; - - - - - procedure Draw - (This : in out Double_Window) is - begin - fl_double_window_draw (This.Void_Ptr); - end Draw; - - - - - function Handle - (This : in out Double_Window; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_double_window_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; + function fl_double_window_handle + (W : in System.Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_double_window_handle, "fl_double_window_handle"); @@ -166,5 +129,26 @@ package body FLTK.Widgets.Groups.Windows.Double is end Hide; + + + procedure Draw + (This : in out Double_Window) is + begin + fl_double_window_draw (This.Void_Ptr); + end Draw; + + + + + function Handle + (This : in out Double_Window; + Event : in Event_Kind) + return Event_Outcome is + begin + return Event_Outcome'Val + (fl_double_window_handle (This.Void_Ptr, Event_Kind'Pos (Event))); + end Handle; + + end FLTK.Widgets.Groups.Windows.Double; diff --git a/src/fltk-widgets-groups-windows-single-menu.adb b/src/fltk-widgets-groups-windows-single-menu.adb index 6c0a5ef..bebc9a2 100644 --- a/src/fltk-widgets-groups-windows-single-menu.adb +++ b/src/fltk-widgets-groups-windows-single-menu.adb @@ -17,15 +17,6 @@ package body FLTK.Widgets.Groups.Windows.Single.Menu is (W, H : in System.Address); pragma Import (C, menu_window_set_handle_hook, "menu_window_set_handle_hook"); - procedure fl_menu_window_draw - (W : in System.Address); - pragma Import (C, fl_menu_window_draw, "fl_menu_window_draw"); - - function fl_menu_window_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_menu_window_handle, "fl_menu_window_handle"); function new_fl_menu_window (X, Y, W, H : in Interfaces.C.int; @@ -42,6 +33,7 @@ package body FLTK.Widgets.Groups.Windows.Single.Menu is (M : in System.Address); pragma Import (C, free_fl_menu_window, "free_fl_menu_window"); + procedure fl_menu_window_show (M : in System.Address); pragma Import (C, fl_menu_window_show, "fl_menu_window_show"); @@ -67,44 +59,15 @@ package body FLTK.Widgets.Groups.Windows.Single.Menu is return Interfaces.C.unsigned; pragma Import (C, fl_menu_window_overlay, "fl_menu_window_overlay"); + procedure fl_menu_window_draw + (W : in System.Address); + pragma Import (C, fl_menu_window_draw, "fl_menu_window_draw"); - - - procedure Draw_Hook (U : in System.Address); - pragma Convention (C, Draw_Hook); - - procedure Draw_Hook - (U : in System.Address) - is - package Menu_Window_Convert is new - System.Address_To_Access_Conversions (Menu_Window'Class); - - Ada_Window : access Menu_Window'Class := - Menu_Window_Convert.To_Pointer (U); - begin - Ada_Window.Draw; - end Draw_Hook; - - - - - procedure Draw - (This : in out Menu_Window) is - begin - fl_menu_window_draw (This.Void_Ptr); - end Draw; - - - - - function Handle - (This : in out Menu_Window; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_menu_window_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; + function fl_menu_window_handle + (W : in System.Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_menu_window_handle, "fl_menu_window_handle"); @@ -216,5 +179,26 @@ package body FLTK.Widgets.Groups.Windows.Single.Menu is end Set_Overlay; + + + procedure Draw + (This : in out Menu_Window) is + begin + fl_menu_window_draw (This.Void_Ptr); + end Draw; + + + + + function Handle + (This : in out Menu_Window; + Event : in Event_Kind) + return Event_Outcome is + begin + return Event_Outcome'Val + (fl_menu_window_handle (This.Void_Ptr, Event_Kind'Pos (Event))); + end Handle; + + end FLTK.Widgets.Groups.Windows.Single.Menu; diff --git a/src/fltk-widgets-groups-windows-single.adb b/src/fltk-widgets-groups-windows-single.adb index 76d6dac..0416983 100644 --- a/src/fltk-widgets-groups-windows-single.adb +++ b/src/fltk-widgets-groups-windows-single.adb @@ -16,15 +16,6 @@ package body FLTK.Widgets.Groups.Windows.Single is (W, H : in System.Address); pragma Import (C, single_window_set_handle_hook, "single_window_set_handle_hook"); - procedure fl_single_window_draw - (W : in System.Address); - pragma Import (C, fl_single_window_draw, "fl_single_window_draw"); - - function fl_single_window_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_single_window_handle, "fl_single_window_handle"); function new_fl_single_window (X, Y, W, H : in Interfaces.C.int; @@ -41,6 +32,7 @@ package body FLTK.Widgets.Groups.Windows.Single is (S : in System.Address); pragma Import (C, free_fl_single_window, "free_fl_single_window"); + procedure fl_single_window_show (S : in System.Address); pragma Import (C, fl_single_window_show, "fl_single_window_show"); @@ -49,44 +41,15 @@ package body FLTK.Widgets.Groups.Windows.Single is (S : in System.Address); pragma Import (C, fl_single_window_flush, "fl_single_window_flush"); + procedure fl_single_window_draw + (W : in System.Address); + pragma Import (C, fl_single_window_draw, "fl_single_window_draw"); - - - procedure Draw_Hook (U : in System.Address); - pragma Convention (C, Draw_Hook); - - procedure Draw_Hook - (U : in System.Address) - is - package Single_Window_Convert is new - System.Address_To_Access_Conversions (Single_Window'Class); - - Ada_Window : access Single_Window'Class := - Single_Window_Convert.To_Pointer (U); - begin - Ada_Window.Draw; - end Draw_Hook; - - - - - procedure Draw - (This : in out Single_Window) is - begin - fl_single_window_draw (This.Void_Ptr); - end Draw; - - - - - function Handle - (This : in out Single_Window; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_single_window_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; + function fl_single_window_handle + (W : in System.Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_single_window_handle, "fl_single_window_handle"); @@ -166,5 +129,26 @@ package body FLTK.Widgets.Groups.Windows.Single is end Flush; + + + procedure Draw + (This : in out Single_Window) is + begin + fl_single_window_draw (This.Void_Ptr); + end Draw; + + + + + function Handle + (This : in out Single_Window; + Event : in Event_Kind) + return Event_Outcome is + begin + return Event_Outcome'Val + (fl_single_window_handle (This.Void_Ptr, Event_Kind'Pos (Event))); + end Handle; + + end FLTK.Widgets.Groups.Windows.Single; diff --git a/src/fltk-widgets-groups-windows.adb b/src/fltk-widgets-groups-windows.adb index f92a3a5..130b87a 100644 --- a/src/fltk-widgets-groups-windows.adb +++ b/src/fltk-widgets-groups-windows.adb @@ -17,15 +17,6 @@ package body FLTK.Widgets.Groups.Windows is (W, H : in System.Address); pragma Import (C, window_set_handle_hook, "window_set_handle_hook"); - procedure fl_window_draw - (W : in System.Address); - pragma Import (C, fl_window_draw, "fl_window_draw"); - - function fl_window_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_window_handle, "fl_window_handle"); function new_fl_window (X, Y, W, H : in Interfaces.C.int; @@ -42,6 +33,7 @@ package body FLTK.Widgets.Groups.Windows is (W : in System.Address); pragma Import (C, free_fl_window, "free_fl_window"); + procedure fl_window_show (W : in System.Address); pragma Import (C, fl_window_show, "fl_window_show"); @@ -72,43 +64,15 @@ package body FLTK.Widgets.Groups.Windows is (W : in System.Address); pragma Import (C, fl_window_set_non_modal, "fl_window_set_non_modal"); + procedure fl_window_draw + (W : in System.Address); + pragma Import (C, fl_window_draw, "fl_window_draw"); - - - procedure Draw_Hook (U : in System.Address); - pragma Convention (C, Draw_Hook); - - procedure Draw_Hook - (U : in System.Address) - is - package Window_Convert is new System.Address_To_Access_Conversions (Window'Class); - - Ada_Window : access Window'Class := - Window_Convert.To_Pointer (U); - begin - Ada_Window.Draw; - end Draw_Hook; - - - - - procedure Draw - (This : in out Window) is - begin - fl_window_draw (This.Void_Ptr); - end Draw; - - - - - function Handle - (This : in out Window; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_window_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; + function fl_window_handle + (W : in System.Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_window_handle, "fl_window_handle"); @@ -248,5 +212,26 @@ package body FLTK.Widgets.Groups.Windows is end Set_Non_Modal; + + + procedure Draw + (This : in out Window) is + begin + fl_window_draw (This.Void_Ptr); + end Draw; + + + + + function Handle + (This : in out Window; + Event : in Event_Kind) + return Event_Outcome is + begin + return Event_Outcome'Val + (fl_window_handle (This.Void_Ptr, Event_Kind'Pos (Event))); + end Handle; + + end FLTK.Widgets.Groups.Windows; diff --git a/src/fltk-widgets-groups.adb b/src/fltk-widgets-groups.adb index b61b5be..e580323 100644 --- a/src/fltk-widgets-groups.adb +++ b/src/fltk-widgets-groups.adb @@ -16,15 +16,6 @@ package body FLTK.Widgets.Groups is (W, H : in System.Address); pragma Import (C, group_set_handle_hook, "group_set_handle_hook"); - procedure fl_group_draw - (W : in System.Address); - pragma Import (C, fl_group_draw, "fl_group_draw"); - - function fl_group_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_group_handle, "fl_group_handle"); function new_fl_group (X, Y, W, H : in Interfaces.C.int; @@ -36,6 +27,7 @@ package body FLTK.Widgets.Groups is (G : in System.Address); pragma Import (C, free_fl_group, "free_fl_group"); + procedure fl_group_add (G, W : in System.Address); pragma Import (C, fl_group_add, "fl_group_add"); @@ -74,43 +66,15 @@ package body FLTK.Widgets.Groups is (G, W : in System.Address); pragma Import (C, fl_group_resizable, "fl_group_resizable"); + procedure fl_group_draw + (W : in System.Address); + pragma Import (C, fl_group_draw, "fl_group_draw"); - - - procedure Draw_Hook (U : in System.Address); - pragma Convention (C, Draw_Hook); - - procedure Draw_Hook - (U : in System.Address) - is - package Group_Convert is new System.Address_To_Access_Conversions (Group'Class); - - Ada_Group : access Group'Class := - Group_Convert.To_Pointer (U); - begin - Ada_Group.Draw; - end Draw_Hook; - - - - - procedure Draw - (This : in out Group) is - begin - fl_group_draw (This.Void_Ptr); - end Draw; - - - - - function Handle - (This : in out Group; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_group_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; + function fl_group_handle + (W : in System.Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_group_handle, "fl_group_handle"); @@ -257,5 +221,26 @@ package body FLTK.Widgets.Groups is end Set_Resizable; + + + procedure Draw + (This : in out Group) is + begin + fl_group_draw (This.Void_Ptr); + end Draw; + + + + + function Handle + (This : in out Group; + Event : in Event_Kind) + return Event_Outcome is + begin + return Event_Outcome'Val + (fl_group_handle (This.Void_Ptr, Event_Kind'Pos (Event))); + end Handle; + + end FLTK.Widgets.Groups; diff --git a/src/fltk-widgets-inputs-file.adb b/src/fltk-widgets-inputs-file.adb index cecc74e..187ec8d 100644 --- a/src/fltk-widgets-inputs-file.adb +++ b/src/fltk-widgets-inputs-file.adb @@ -16,15 +16,6 @@ package body FLTK.Widgets.Inputs.File is (W, H : in System.Address); pragma Import (C, file_input_set_handle_hook, "file_input_set_handle_hook"); - procedure fl_file_input_draw - (W : in System.Address); - pragma Import (C, fl_file_input_draw, "fl_file_input_draw"); - - function fl_file_input_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_file_input_handle, "fl_file_input_handle"); function new_fl_file_input (X, Y, W, H : in Interfaces.C.int; @@ -37,43 +28,15 @@ package body FLTK.Widgets.Inputs.File is pragma Import (C, free_fl_file_input, "free_fl_file_input"); + procedure fl_file_input_draw + (W : in System.Address); + pragma Import (C, fl_file_input_draw, "fl_file_input_draw"); - - procedure Draw_Hook (U : in System.Address); - pragma Convention (C, Draw_Hook); - - procedure Draw_Hook - (U : in System.Address) - is - package File_Input_Convert is new - System.Address_To_Access_Conversions (File_Input'Class); - - Ada_Input : access File_Input'Class := - File_Input_Convert.To_Pointer (U); - begin - Ada_Input.Draw; - end Draw_Hook; - - - - - procedure Draw - (This : in out File_Input) is - begin - fl_file_input_draw (This.Void_Ptr); - end Draw; - - - - - function Handle - (This : in out File_Input; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_file_input_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; + function fl_file_input_handle + (W : in System.Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_file_input_handle, "fl_file_input_handle"); @@ -114,5 +77,26 @@ package body FLTK.Widgets.Inputs.File is end Create; + + + procedure Draw + (This : in out File_Input) is + begin + fl_file_input_draw (This.Void_Ptr); + end Draw; + + + + + function Handle + (This : in out File_Input; + Event : in Event_Kind) + return Event_Outcome is + begin + return Event_Outcome'Val + (fl_file_input_handle (This.Void_Ptr, Event_Kind'Pos (Event))); + end Handle; + + end FLTK.Widgets.Inputs.File; diff --git a/src/fltk-widgets-inputs-float.adb b/src/fltk-widgets-inputs-float.adb index 782f8d9..6115939 100644 --- a/src/fltk-widgets-inputs-float.adb +++ b/src/fltk-widgets-inputs-float.adb @@ -16,15 +16,6 @@ package body FLTK.Widgets.Inputs.Float is (W, H : in System.Address); pragma Import (C, float_input_set_handle_hook, "float_input_set_handle_hook"); - procedure fl_float_input_draw - (W : in System.Address); - pragma Import (C, fl_float_input_draw, "fl_float_input_draw"); - - function fl_float_input_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_float_input_handle, "fl_float_input_handle"); function new_fl_float_input (X, Y, W, H : in Interfaces.C.int; @@ -37,43 +28,15 @@ package body FLTK.Widgets.Inputs.Float is pragma Import (C, free_fl_float_input, "free_fl_float_input"); + procedure fl_float_input_draw + (W : in System.Address); + pragma Import (C, fl_float_input_draw, "fl_float_input_draw"); - - procedure Draw_Hook (U : in System.Address); - pragma Convention (C, Draw_Hook); - - procedure Draw_Hook - (U : in System.Address) - is - package Float_Input_Convert is new - System.Address_To_Access_Conversions (Float_Input'Class); - - Ada_Input : access Float_Input'Class := - Float_Input_Convert.To_Pointer (U); - begin - Ada_Input.Draw; - end Draw_Hook; - - - - - procedure Draw - (This : in out Float_Input) is - begin - fl_float_input_draw (This.Void_Ptr); - end Draw; - - - - - function Handle - (This : in out Float_Input; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_float_input_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; + function fl_float_input_handle + (W : in System.Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_float_input_handle, "fl_float_input_handle"); @@ -125,5 +88,26 @@ package body FLTK.Widgets.Inputs.Float is end Get_Value; + + + procedure Draw + (This : in out Float_Input) is + begin + fl_float_input_draw (This.Void_Ptr); + end Draw; + + + + + function Handle + (This : in out Float_Input; + Event : in Event_Kind) + return Event_Outcome is + begin + return Event_Outcome'Val + (fl_float_input_handle (This.Void_Ptr, Event_Kind'Pos (Event))); + end Handle; + + end FLTK.Widgets.Inputs.Float; diff --git a/src/fltk-widgets-inputs-integer.adb b/src/fltk-widgets-inputs-integer.adb index 5e2eb40..f0fb7b9 100644 --- a/src/fltk-widgets-inputs-integer.adb +++ b/src/fltk-widgets-inputs-integer.adb @@ -16,15 +16,6 @@ package body FLTK.Widgets.Inputs.Integer is (W, H : in System.Address); pragma Import (C, int_input_set_handle_hook, "int_input_set_handle_hook"); - procedure fl_int_input_draw - (W : in System.Address); - pragma Import (C, fl_int_input_draw, "fl_int_input_draw"); - - function fl_int_input_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_int_input_handle, "fl_int_input_handle"); function new_fl_int_input (X, Y, W, H : in Interfaces.C.int; @@ -37,43 +28,15 @@ package body FLTK.Widgets.Inputs.Integer is pragma Import (C, free_fl_int_input, "free_fl_int_input"); + procedure fl_int_input_draw + (W : in System.Address); + pragma Import (C, fl_int_input_draw, "fl_int_input_draw"); - - procedure Draw_Hook (U : in System.Address); - pragma Convention (C, Draw_Hook); - - procedure Draw_Hook - (U : in System.Address) - is - package Integer_Input_Convert is new - System.Address_To_Access_Conversions (Integer_Input'Class); - - Ada_Input : access Integer_Input'Class := - Integer_Input_Convert.To_Pointer (U); - begin - Ada_Input.Draw; - end Draw_Hook; - - - - - procedure Draw - (This : in out Integer_Input) is - begin - fl_int_input_draw (This.Void_Ptr); - end Draw; - - - - - function Handle - (This : in out Integer_Input; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_int_input_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; + function fl_int_input_handle + (W : in System.Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_int_input_handle, "fl_int_input_handle"); @@ -125,5 +88,26 @@ package body FLTK.Widgets.Inputs.Integer is end Get_Value; + + + procedure Draw + (This : in out Integer_Input) is + begin + fl_int_input_draw (This.Void_Ptr); + end Draw; + + + + + function Handle + (This : in out Integer_Input; + Event : in Event_Kind) + return Event_Outcome is + begin + return Event_Outcome'Val + (fl_int_input_handle (This.Void_Ptr, Event_Kind'Pos (Event))); + end Handle; + + end FLTK.Widgets.Inputs.Integer; diff --git a/src/fltk-widgets-inputs-multiline.adb b/src/fltk-widgets-inputs-multiline.adb index 55bec80..957af65 100644 --- a/src/fltk-widgets-inputs-multiline.adb +++ b/src/fltk-widgets-inputs-multiline.adb @@ -16,15 +16,6 @@ package body FLTK.Widgets.Inputs.Multiline is (W, H : in System.Address); pragma Import (C, multiline_input_set_handle_hook, "multiline_input_set_handle_hook"); - procedure fl_multiline_input_draw - (W : in System.Address); - pragma Import (C, fl_multiline_input_draw, "fl_multiline_input_draw"); - - function fl_multiline_input_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_multiline_input_handle, "fl_multiline_input_handle"); function new_fl_multiline_input (X, Y, W, H : in Interfaces.C.int; @@ -37,43 +28,15 @@ package body FLTK.Widgets.Inputs.Multiline is pragma Import (C, free_fl_multiline_input, "free_fl_multiline_input"); + procedure fl_multiline_input_draw + (W : in System.Address); + pragma Import (C, fl_multiline_input_draw, "fl_multiline_input_draw"); - - procedure Draw_Hook (U : in System.Address); - pragma Convention (C, Draw_Hook); - - procedure Draw_Hook - (U : in System.Address) - is - package Multi_Input_Convert is new - System.Address_To_Access_Conversions (Multiline_Input'Class); - - Ada_Input : access Multiline_Input'Class := - Multi_Input_Convert.To_Pointer (U); - begin - Ada_Input.Draw; - end Draw_Hook; - - - - - procedure Draw - (This : in out Multiline_Input) is - begin - fl_multiline_input_draw (This.Void_Ptr); - end Draw; - - - - - function Handle - (This : in out Multiline_Input; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_multiline_input_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; + function fl_multiline_input_handle + (W : in System.Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_multiline_input_handle, "fl_multiline_input_handle"); @@ -114,5 +77,26 @@ package body FLTK.Widgets.Inputs.Multiline is end Create; + + + procedure Draw + (This : in out Multiline_Input) is + begin + fl_multiline_input_draw (This.Void_Ptr); + end Draw; + + + + + function Handle + (This : in out Multiline_Input; + Event : in Event_Kind) + return Event_Outcome is + begin + return Event_Outcome'Val + (fl_multiline_input_handle (This.Void_Ptr, Event_Kind'Pos (Event))); + end Handle; + + end FLTK.Widgets.Inputs.Multiline; diff --git a/src/fltk-widgets-inputs-outputs-multiline.adb b/src/fltk-widgets-inputs-outputs-multiline.adb index 3629571..48a0411 100644 --- a/src/fltk-widgets-inputs-outputs-multiline.adb +++ b/src/fltk-widgets-inputs-outputs-multiline.adb @@ -16,15 +16,6 @@ package body FLTK.Widgets.Inputs.Outputs.Multiline is (W, H : in System.Address); pragma Import (C, multiline_output_set_handle_hook, "multiline_output_set_handle_hook"); - procedure fl_multiline_output_draw - (W : in System.Address); - pragma Import (C, fl_multiline_output_draw, "fl_multiline_output_draw"); - - function fl_multiline_output_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_multiline_output_handle, "fl_multiline_output_handle"); function new_fl_multiline_output (X, Y, W, H : in Interfaces.C.int; @@ -37,43 +28,15 @@ package body FLTK.Widgets.Inputs.Outputs.Multiline is pragma Import (C, free_fl_multiline_output, "free_fl_multiline_output"); + procedure fl_multiline_output_draw + (W : in System.Address); + pragma Import (C, fl_multiline_output_draw, "fl_multiline_output_draw"); - - procedure Draw_Hook (U : in System.Address); - pragma Convention (C, Draw_Hook); - - procedure Draw_Hook - (U : in System.Address) - is - package Output_Convert is new - System.Address_To_Access_Conversions (Multiline_Output'Class); - - Ada_Output : access Multiline_Output'Class := - Output_Convert.To_Pointer (U); - begin - Ada_Output.Draw; - end Draw_Hook; - - - - - procedure Draw - (This : in out Multiline_Output) is - begin - fl_multiline_output_draw (This.Void_Ptr); - end Draw; - - - - - function Handle - (This : in out Multiline_Output; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_multiline_output_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; + function fl_multiline_output_handle + (W : in System.Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_multiline_output_handle, "fl_multiline_output_handle"); @@ -114,5 +77,26 @@ package body FLTK.Widgets.Inputs.Outputs.Multiline is end Create; + + + procedure Draw + (This : in out Multiline_Output) is + begin + fl_multiline_output_draw (This.Void_Ptr); + end Draw; + + + + + function Handle + (This : in out Multiline_Output; + Event : in Event_Kind) + return Event_Outcome is + begin + return Event_Outcome'Val + (fl_multiline_output_handle (This.Void_Ptr, Event_Kind'Pos (Event))); + end Handle; + + end FLTK.Widgets.Inputs.Outputs.Multiline; diff --git a/src/fltk-widgets-inputs-outputs.adb b/src/fltk-widgets-inputs-outputs.adb index 5e623ac..b1eb353 100644 --- a/src/fltk-widgets-inputs-outputs.adb +++ b/src/fltk-widgets-inputs-outputs.adb @@ -16,15 +16,6 @@ package body FLTK.Widgets.Inputs.Outputs is (W, H : in System.Address); pragma Import (C, output_set_handle_hook, "output_set_handle_hook"); - procedure fl_output_draw - (W : in System.Address); - pragma Import (C, fl_output_draw, "fl_output_draw"); - - function fl_output_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_output_handle, "fl_output_handle"); function new_fl_output (X, Y, W, H : in Interfaces.C.int; @@ -37,43 +28,15 @@ package body FLTK.Widgets.Inputs.Outputs is pragma Import (C, free_fl_output, "free_fl_output"); + procedure fl_output_draw + (W : in System.Address); + pragma Import (C, fl_output_draw, "fl_output_draw"); - - procedure Draw_Hook (U : in System.Address); - pragma Convention (C, Draw_Hook); - - procedure Draw_Hook - (U : in System.Address) - is - package Output_Convert is new - System.Address_To_Access_Conversions (Output'Class); - - Ada_Output : access Output'Class := - Output_Convert.To_Pointer (U); - begin - Ada_Output.Draw; - end Draw_Hook; - - - - - procedure Draw - (This : in out Output) is - begin - fl_output_draw (This.Void_Ptr); - end Draw; - - - - - function Handle - (This : in out Output; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_output_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; + function fl_output_handle + (W : in System.Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_output_handle, "fl_output_handle"); @@ -114,5 +77,26 @@ package body FLTK.Widgets.Inputs.Outputs is end Create; + + + procedure Draw + (This : in out Output) is + begin + fl_output_draw (This.Void_Ptr); + end Draw; + + + + + function Handle + (This : in out Output; + Event : in Event_Kind) + return Event_Outcome is + begin + return Event_Outcome'Val + (fl_output_handle (This.Void_Ptr, Event_Kind'Pos (Event))); + end Handle; + + end FLTK.Widgets.Inputs.Outputs; diff --git a/src/fltk-widgets-inputs-secret.adb b/src/fltk-widgets-inputs-secret.adb index d4c6044..eb2bec4 100644 --- a/src/fltk-widgets-inputs-secret.adb +++ b/src/fltk-widgets-inputs-secret.adb @@ -16,15 +16,6 @@ package body FLTK.Widgets.Inputs.Secret is (W, H : in System.Address); pragma Import (C, secret_input_set_handle_hook, "secret_input_set_handle_hook"); - procedure fl_secret_input_draw - (W : in System.Address); - pragma Import (C, fl_secret_input_draw, "fl_secret_input_draw"); - - function fl_secret_input_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_secret_input_handle, "fl_secret_input_handle"); function new_fl_secret_input (X, Y, W, H : in Interfaces.C.int; @@ -37,43 +28,15 @@ package body FLTK.Widgets.Inputs.Secret is pragma Import (C, free_fl_secret_input, "free_fl_secret_input"); + procedure fl_secret_input_draw + (W : in System.Address); + pragma Import (C, fl_secret_input_draw, "fl_secret_input_draw"); - - procedure Draw_Hook (U : in System.Address); - pragma Convention (C, Draw_Hook); - - procedure Draw_Hook - (U : in System.Address) - is - package Secret_Input_Convert is new - System.Address_To_Access_Conversions (Secret_Input'Class); - - Ada_Input : access Secret_Input'Class := - Secret_Input_Convert.To_Pointer (U); - begin - Ada_Input.Draw; - end Draw_Hook; - - - - - procedure Draw - (This : in out Secret_Input) is - begin - fl_secret_input_draw (This.Void_Ptr); - end Draw; - - - - - function Handle - (This : in out Secret_Input; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_secret_input_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; + function fl_secret_input_handle + (W : in System.Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_secret_input_handle, "fl_secret_input_handle"); @@ -114,5 +77,26 @@ package body FLTK.Widgets.Inputs.Secret is end Create; + + + procedure Draw + (This : in out Secret_Input) is + begin + fl_secret_input_draw (This.Void_Ptr); + end Draw; + + + + + function Handle + (This : in out Secret_Input; + Event : in Event_Kind) + return Event_Outcome is + begin + return Event_Outcome'Val + (fl_secret_input_handle (This.Void_Ptr, Event_Kind'Pos (Event))); + end Handle; + + end FLTK.Widgets.Inputs.Secret; diff --git a/src/fltk-widgets-inputs.adb b/src/fltk-widgets-inputs.adb index a6188cb..479d82e 100644 --- a/src/fltk-widgets-inputs.adb +++ b/src/fltk-widgets-inputs.adb @@ -17,15 +17,6 @@ package body FLTK.Widgets.Inputs is (W, H : in System.Address); pragma Import (C, input_set_handle_hook, "input_set_handle_hook"); - procedure fl_input_draw - (W : in System.Address); - pragma Import (C, fl_input_draw, "fl_input_draw"); - - function fl_input_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_input_handle, "fl_input_handle"); function new_fl_input (X, Y, W, H : in Interfaces.C.int; @@ -38,42 +29,15 @@ package body FLTK.Widgets.Inputs is pragma Import (C, free_fl_input, "free_fl_input"); + procedure fl_input_draw + (W : in System.Address); + pragma Import (C, fl_input_draw, "fl_input_draw"); - - procedure Draw_Hook (U : in System.Address); - pragma Convention (C, Draw_Hook); - - procedure Draw_Hook - (U : in System.Address) - is - package Input_Convert is new System.Address_To_Access_Conversions (Input'Class); - - Ada_Input : access Input'Class := - Input_Convert.To_Pointer (U); - begin - Ada_Input.Draw; - end Draw_Hook; - - - - - procedure Draw - (This : in out Input) is - begin - fl_input_draw (This.Void_Ptr); - end Draw; - - - - - function Handle - (This : in out Input; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_input_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; + function fl_input_handle + (W : in System.Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_input_handle, "fl_input_handle"); @@ -124,5 +88,26 @@ package body FLTK.Widgets.Inputs is end Get_Value; + + + procedure Draw + (This : in out Input) is + begin + fl_input_draw (This.Void_Ptr); + end Draw; + + + + + function Handle + (This : in out Input; + Event : in Event_Kind) + return Event_Outcome is + begin + return Event_Outcome'Val + (fl_input_handle (This.Void_Ptr, Event_Kind'Pos (Event))); + end Handle; + + end FLTK.Widgets.Inputs; diff --git a/src/fltk-widgets-menus-menu_bars.adb b/src/fltk-widgets-menus-menu_bars.adb index 8281ec8..f7993e1 100644 --- a/src/fltk-widgets-menus-menu_bars.adb +++ b/src/fltk-widgets-menus-menu_bars.adb @@ -16,15 +16,6 @@ package body FLTK.Widgets.Menus.Menu_Bars is (W, H : in System.Address); pragma Import (C, menu_bar_set_handle_hook, "menu_bar_set_handle_hook"); - procedure fl_menu_bar_draw - (W : in System.Address); - pragma Import (C, fl_menu_bar_draw, "fl_menu_bar_draw"); - - function fl_menu_bar_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_menu_bar_handle, "fl_menu_bar_handle"); function new_fl_menu_bar (X, Y, W, H : in Interfaces.C.int; @@ -37,43 +28,15 @@ package body FLTK.Widgets.Menus.Menu_Bars is pragma Import (C, free_fl_menu_bar, "free_fl_menu_bar"); + procedure fl_menu_bar_draw + (W : in System.Address); + pragma Import (C, fl_menu_bar_draw, "fl_menu_bar_draw"); - - procedure Draw_Hook (U : in System.Address); - pragma Convention (C, Draw_Hook); - - procedure Draw_Hook - (U : in System.Address) - is - package Menu_Bar_Convert is new - System.Address_To_Access_Conversions (Menu_Bar'Class); - - Ada_Menu_Bar : access Menu_Bar'Class := - Menu_Bar_Convert.To_Pointer (U); - begin - Ada_Menu_Bar.Draw; - end Draw_Hook; - - - - - procedure Draw - (This : in out Menu_Bar) is - begin - fl_menu_bar_draw (This.Void_Ptr); - end Draw; - - - - - function Handle - (This : in out Menu_Bar; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_menu_bar_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; + function fl_menu_bar_handle + (W : in System.Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_menu_bar_handle, "fl_menu_bar_handle"); @@ -114,5 +77,26 @@ package body FLTK.Widgets.Menus.Menu_Bars is end Create; + + + procedure Draw + (This : in out Menu_Bar) is + begin + fl_menu_bar_draw (This.Void_Ptr); + end Draw; + + + + + function Handle + (This : in out Menu_Bar; + Event : in Event_Kind) + return Event_Outcome is + begin + return Event_Outcome'Val + (fl_menu_bar_handle (This.Void_Ptr, Event_Kind'Pos (Event))); + end Handle; + + end FLTK.Widgets.Menus.Menu_Bars; diff --git a/src/fltk-widgets-menus-menu_buttons.adb b/src/fltk-widgets-menus-menu_buttons.adb index 7758650..7bdb32d 100644 --- a/src/fltk-widgets-menus-menu_buttons.adb +++ b/src/fltk-widgets-menus-menu_buttons.adb @@ -16,15 +16,6 @@ package body FLTK.Widgets.Menus.Menu_Buttons is (W, H : in System.Address); pragma Import (C, menu_button_set_handle_hook, "menu_button_set_handle_hook"); - procedure fl_menu_button_draw - (W : in System.Address); - pragma Import (C, fl_menu_button_draw, "fl_menu_button_draw"); - - function fl_menu_button_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_menu_button_handle, "fl_menu_button_handle"); function new_fl_menu_button (X, Y, W, H : in Interfaces.C.int; @@ -36,49 +27,21 @@ package body FLTK.Widgets.Menus.Menu_Buttons is (M : in System.Address); pragma Import (C, free_fl_menu_button, "free_fl_menu_button"); + procedure fl_menu_button_type (M : in System.Address; T : in Interfaces.C.unsigned); pragma Import (C, fl_menu_button_type, "fl_menu_button_type"); + procedure fl_menu_button_draw + (W : in System.Address); + pragma Import (C, fl_menu_button_draw, "fl_menu_button_draw"); - - - procedure Draw_Hook (U : in System.Address); - pragma Convention (C, Draw_Hook); - - procedure Draw_Hook - (U : in System.Address) - is - package Menu_Button_Convert is new - System.Address_To_Access_Conversions (Menu_Button'Class); - - Ada_Menu_Button : access Menu_Button'Class := - Menu_Button_Convert.To_Pointer (U); - begin - Ada_Menu_Button.Draw; - end Draw_Hook; - - - - - procedure Draw - (This : in out Menu_Button) is - begin - fl_menu_button_draw (This.Void_Ptr); - end Draw; - - - - - function Handle - (This : in out Menu_Button; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_menu_button_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; + function fl_menu_button_handle + (W : in System.Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_menu_button_handle, "fl_menu_button_handle"); @@ -129,5 +92,26 @@ package body FLTK.Widgets.Menus.Menu_Buttons is end Set_Popup_Kind; + + + procedure Draw + (This : in out Menu_Button) is + begin + fl_menu_button_draw (This.Void_Ptr); + end Draw; + + + + + function Handle + (This : in out Menu_Button; + Event : in Event_Kind) + return Event_Outcome is + begin + return Event_Outcome'Val + (fl_menu_button_handle (This.Void_Ptr, Event_Kind'Pos (Event))); + end Handle; + + end FLTK.Widgets.Menus.Menu_Buttons; diff --git a/src/fltk-widgets-menus.adb b/src/fltk-widgets-menus.adb index 140cc5b..67a2cd9 100644 --- a/src/fltk-widgets-menus.adb +++ b/src/fltk-widgets-menus.adb @@ -29,6 +29,7 @@ package body FLTK.Widgets.Menus is (W, H : in System.Address); pragma Import (C, menu_set_handle_hook, "menu_set_handle_hook"); + function new_fl_menu (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) @@ -39,6 +40,7 @@ package body FLTK.Widgets.Menus is (F : in System.Address); pragma Import (C, free_fl_menu, "free_fl_menu"); + function fl_menu_add (M : in System.Address; T : in Interfaces.C.char_array; @@ -59,6 +61,7 @@ package body FLTK.Widgets.Menus is return System.Address; pragma Import (C, fl_menu_mvalue, "fl_menu_mvalue"); + function fl_menuitem_value (MI : in System.Address) return Interfaces.C.int; @@ -75,30 +78,15 @@ package body FLTK.Widgets.Menus is - procedure Draw_Hook (U : in System.Address); - pragma Convention (C, Draw_Hook); - - procedure Draw_Hook - (U : in System.Address) + procedure Item_Hook + (M, U : in System.Address) is - package Menu_Convert is new System.Address_To_Access_Conversions (Menu'Class); - - Ada_Menu : access Menu'Class := - Menu_Convert.To_Pointer (U); - begin - Ada_Menu.Draw; - end Draw_Hook; - - - - - function Handle - (This : in out Menu; - Event : in Event_Kind) - return Event_Outcome is + Ada_Widget : access Widget'Class := + Widget_Convert.To_Pointer (fl_widget_get_user_data (M)); + Action : Widget_Callback := Callback_Convert.To_Pointer (U); begin - return Not_Handled; - end Handle; + Action.all (Ada_Widget.all); + end Item_Hook; @@ -141,22 +129,6 @@ package body FLTK.Widgets.Menus is - procedure Item_Hook (M, U : in System.Address); - pragma Convention (C, Item_Hook); - - procedure Item_Hook - (M, U : in System.Address) - is - Ada_Widget : access Widget'Class := - Widget_Convert.To_Pointer (fl_widget_get_user_data (M)); - Action : Widget_Callback := Callback_Convert.To_Pointer (U); - begin - Action.all (Ada_Widget.all); - end Item_Hook; - - - - procedure Add (This : in out Menu; Text : in String; @@ -214,6 +186,17 @@ package body FLTK.Widgets.Menus is + function Handle + (This : in out Menu; + Event : in Event_Kind) + return Event_Outcome is + begin + return Not_Handled; + end Handle; + + + + function Value (Item : in Menu_Item) return Boolean is diff --git a/src/fltk-widgets-menus.ads b/src/fltk-widgets-menus.ads index c33b947..a9f957f 100644 --- a/src/fltk-widgets-menus.ads +++ b/src/fltk-widgets-menus.ads @@ -87,6 +87,10 @@ private type Menu is new Widget with null record; + procedure Item_Hook (M, U : in System.Address); + pragma Convention (C, Item_Hook); + + overriding procedure Finalize (This : in out Menu); diff --git a/src/fltk-widgets.adb b/src/fltk-widgets.adb index 6fee044..91495e9 100644 --- a/src/fltk-widgets.adb +++ b/src/fltk-widgets.adb @@ -26,6 +26,7 @@ package body FLTK.Widgets is (W, H : in System.Address); pragma Import (C, widget_set_handle_hook, "widget_set_handle_hook"); + function new_fl_widget (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) @@ -36,6 +37,7 @@ package body FLTK.Widgets is (F : in System.Address); pragma Import (C, free_fl_widget, "free_fl_widget"); + function fl_widget_get_box (W : in System.Address) return Interfaces.C.int; @@ -132,8 +134,17 @@ package body FLTK.Widgets is - procedure Draw_Hook (U : in System.Address); - pragma Convention (C, Draw_Hook); + procedure Callback_Hook + (W, U : in System.Address) + is + Ada_Widget : access Widget'Class := + Widget_Convert.To_Pointer (U); + begin + Ada_Widget.Callback.all (Ada_Widget.all); + end Callback_Hook; + + + procedure Draw_Hook (U : in System.Address) @@ -161,17 +172,6 @@ package body FLTK.Widgets is - function Handle - (This : in out Widget; - Event : in Event_Kind) - return Event_Outcome is - begin - return Not_Handled; - end Handle; - - - - procedure Finalize (This : in out Widget) is begin @@ -326,23 +326,6 @@ package body FLTK.Widgets is - -- this is the part called by FLTK callbacks - -- note that the user data portion is a reference back to the Ada binding - procedure Callback_Hook (W, U : in System.Address); - pragma Convention (C, Callback_Hook); - - procedure Callback_Hook - (W, U : in System.Address) - is - Ada_Widget : access Widget'Class := - Widget_Convert.To_Pointer (U); - begin - Ada_Widget.Callback.all (Ada_Widget.all); - end Callback_Hook; - - - - procedure Set_Callback (This : in out Widget; Func : in Widget_Callback) is @@ -443,5 +426,16 @@ package body FLTK.Widgets is end Set_Image; + + + function Handle + (This : in out Widget; + Event : in Event_Kind) + return Event_Outcome is + begin + return Not_Handled; + end Handle; + + end FLTK.Widgets; diff --git a/src/fltk-widgets.ads b/src/fltk-widgets.ads index f724507..439b72d 100644 --- a/src/fltk-widgets.ads +++ b/src/fltk-widgets.ads @@ -152,6 +152,17 @@ private end record; + -- the user data portion should always be a reference back to the Ada binding + procedure Callback_Hook + (W, U : in System.Address); + pragma Convention (C, Callback_Hook); + + + procedure Draw_Hook + (U : in System.Address); + pragma Convention (C, Draw_Hook); + + function Handle_Hook (U : in System.Address; E : in Interfaces.C.int) |