From d80d210d6b1418ba3e773186337c5da7ea169c4e Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Sun, 13 Apr 2025 18:48:34 +1200 Subject: Proper init of Message_Icon box, some more checks added --- body/fltk-asks.adb | 41 ++++++++++++++++++++++++++++++++++++++--- 1 file changed, 38 insertions(+), 3 deletions(-) (limited to 'body/fltk-asks.adb') diff --git a/body/fltk-asks.adb b/body/fltk-asks.adb index ee32c95..8d4f900 100644 --- a/body/fltk-asks.adb +++ b/body/fltk-asks.adb @@ -234,9 +234,9 @@ package body FLTK.Asks is - --------------- - -- Cleanup -- - --------------- + ------------------- + -- Destructors -- + ------------------- procedure Finalize (This : in out Dialog_String_Final_Controller) @@ -254,6 +254,21 @@ package body FLTK.Asks is + -------------------- + -- Constructors -- + -------------------- + + -- You can get out of a hole by digging deeper, right? + procedure fl_box_extra_init + (Ada_Obj : in Storage.Integer_Address; + X, Y, W, H : in Interfaces.C.int; + C_Str : in Interfaces.C.char_array); + pragma Import (C, fl_box_extra_init, "fl_box_extra_init"); + pragma Inline (fl_box_extra_init); + + + + ----------------------- -- API Subprograms -- ----------------------- @@ -369,6 +384,10 @@ package body FLTK.Asks is Interfaces.C.Strings.Null_Ptr); begin return Choice_Result'Val (Result); + exception + when Constraint_Error => raise Internal_FLTK_Error with + "fl_choice returned unexpected int value of " & + Interfaces.C.int'Image (Result); end Choice; @@ -384,6 +403,10 @@ package body FLTK.Asks is Interfaces.C.Strings.Null_Ptr); begin return Choice_Result'Val (Result); + exception + when Constraint_Error => raise Internal_FLTK_Error with + "fl_choice returned unexpected int value of " & + Interfaces.C.int'Image (Result); end Choice; @@ -400,6 +423,10 @@ package body FLTK.Asks is Interfaces.C.Strings.To_Chars_Ptr (Str3'Unchecked_Access)); begin return Choice_Result'Val (Result); + exception + when Constraint_Error => raise Internal_FLTK_Error with + "fl_choice returned unexpected int value of " & + Interfaces.C.int'Image (Result); end Choice; @@ -685,6 +712,14 @@ begin Wrapper (Icon_Box).Void_Ptr := fl_ask_message_icon; Wrapper (Icon_Box).Needs_Dealloc := False; + fl_box_extra_init + (Storage.To_Integer (Icon_Box'Address), + Interfaces.C.int (Icon_Box.Get_X), + Interfaces.C.int (Icon_Box.Get_Y), + Interfaces.C.int (Icon_Box.Get_W), + Interfaces.C.int (Icon_Box.Get_H), + Interfaces.C.To_C (Icon_Box.Get_Label)); + fl_ask_file_chooser_callback (Storage.To_Integer (File_Chooser_Callback_Hook'Address)); -- cgit