diff options
| -rw-r--r-- | doc/fl_input_choice.html | 6 | ||||
| -rw-r--r-- | doc/fl_value_input.html | 4 | ||||
| -rw-r--r-- | src/c_fl_button.cpp | 15 | ||||
| -rw-r--r-- | src/c_fl_button.h | 9 | ||||
| -rw-r--r-- | src/c_fl_check_button.cpp | 16 | ||||
| -rw-r--r-- | src/c_fl_check_button.h | 8 | ||||
| -rw-r--r-- | src/c_fl_input.cpp | 15 | ||||
| -rw-r--r-- | src/c_fl_input.h | 5 | ||||
| -rw-r--r-- | src/c_fl_menu_button.cpp | 16 | ||||
| -rw-r--r-- | src/c_fl_menu_button.h | 10 | ||||
| -rw-r--r-- | src/c_fl_scrollbar.cpp | 15 | ||||
| -rw-r--r-- | src/c_fl_scrollbar.h | 10 | ||||
| -rw-r--r-- | src/fltk-file_choosers.adb | 68 | ||||
| -rw-r--r-- | src/fltk-widgets-buttons-light-check.adb | 58 | ||||
| -rw-r--r-- | src/fltk-widgets-buttons.adb | 58 | ||||
| -rw-r--r-- | src/fltk-widgets-groups-browsers.adb | 48 | ||||
| -rw-r--r-- | src/fltk-widgets-groups-input_choices.adb | 87 | ||||
| -rw-r--r-- | src/fltk-widgets-groups-input_choices.ads | 14 | ||||
| -rw-r--r-- | src/fltk-widgets-inputs-text.adb | 40 | ||||
| -rw-r--r-- | src/fltk-widgets-menus-menu_buttons.adb | 58 | ||||
| -rw-r--r-- | src/fltk-widgets-valuators-sliders-scrollbars.adb | 56 | ||||
| -rw-r--r-- | src/fltk-widgets-valuators-value_inputs.adb | 52 | ||||
| -rw-r--r-- | src/fltk-widgets-valuators-value_inputs.ads | 10 | ||||
| -rw-r--r-- | src/fltk-widgets.ads | 3 |
24 files changed, 578 insertions, 103 deletions
diff --git a/doc/fl_input_choice.html b/doc/fl_input_choice.html index 4391b30..ebd1d9c 100644 --- a/doc/fl_input_choice.html +++ b/doc/fl_input_choice.html @@ -143,9 +143,9 @@ function Handle Fl_Input * input(); </pre></td> <td><pre> -function Input +function Text_Field (This : in out Input_Choice) - return FLTK.Widgets.Inputs.Input_Reference; + return FLTK.Widgets.Inputs.Text.Text_Input_Reference; </pre></td> </tr> @@ -168,7 +168,7 @@ void menu(const Fl_Menu_Item *m); Fl_Menu_Button * menubutton(); </pre></td> <td><pre> -function Menu_Button +function Button_Menu (This : in out Input_Choice) return FLTK.Widgets.Menus.Menu_Buttons.Menu_Button_Reference; </pre></td> diff --git a/doc/fl_value_input.html b/doc/fl_value_input.html index 0f25dd4..3f84cee 100644 --- a/doc/fl_value_input.html +++ b/doc/fl_value_input.html @@ -109,9 +109,9 @@ function Handle Fl_Input input; </pre></td> <td><pre> -function Input +function Text_Field (This : in Value_Input) - return FLTK.Widgets.Inputs.Input_Reference; + return FLTK.Widgets.Inputs.Text.Text_Input_Reference; </pre></td> </tr> diff --git a/src/c_fl_button.cpp b/src/c_fl_button.cpp index 083c869..07d5c64 100644 --- a/src/c_fl_button.cpp +++ b/src/c_fl_button.cpp @@ -11,6 +11,21 @@ +// Telprot stopovers + +extern "C" void button_extra_init_hook(void * aobj, int x, int y, int w, int h, const char * l); +void fl_button_extra_init(void * adaobj, int x, int y, int w, int h, const char * label) { + button_extra_init_hook(adaobj, x, y, w, h, label); +} + +extern "C" void button_extra_final_hook(void * aobj); +void fl_button_extra_final(void * adaobj) { + button_extra_final_hook(adaobj); +} + + + + class My_Button : public Fl_Button { public: using Fl_Button::Fl_Button; diff --git a/src/c_fl_button.h b/src/c_fl_button.h index d943841..9c3ecad 100644 --- a/src/c_fl_button.h +++ b/src/c_fl_button.h @@ -8,27 +8,23 @@ #define FL_BUTTON_GUARD +extern "C" void fl_button_extra_init(void * adaobj, int x, int y, int w, int h, const char * label); +extern "C" void fl_button_extra_final(void * adaobj); typedef void* BUTTON; - - extern "C" void button_set_draw_hook(BUTTON b, void * d); extern "C" void fl_button_draw(BUTTON b); extern "C" void button_set_handle_hook(BUTTON b, void * h); extern "C" int fl_button_handle(BUTTON b, int e); - - extern "C" BUTTON new_fl_button(int x, int y, int w, int h, char* label); extern "C" void free_fl_button(BUTTON b); - - extern "C" int fl_button_get_state(BUTTON b); extern "C" void fl_button_set_state(BUTTON b, int s); extern "C" void fl_button_set_only(BUTTON b); @@ -42,3 +38,4 @@ extern "C" void fl_button_set_shortcut(BUTTON b, int k); #endif + diff --git a/src/c_fl_check_button.cpp b/src/c_fl_check_button.cpp index ca8d6f3..964c889 100644 --- a/src/c_fl_check_button.cpp +++ b/src/c_fl_check_button.cpp @@ -11,6 +11,22 @@ +// Telprot stopovers + +extern "C" void check_button_extra_init_hook + (void * aobj, int x, int y, int w, int h, const char * l); +void fl_check_button_extra_init (void * adaobj, int x, int y, int w, int h, const char * label) { + check_button_extra_init_hook(adaobj, x, y, w, h, label); +} + +extern "C" void check_button_extra_final_hook(void * aobj); +void fl_check_button_extra_final(void * adaobj) { + check_button_extra_final_hook(adaobj); +} + + + + class My_Check_Button : public Fl_Check_Button { public: using Fl_Check_Button::Fl_Check_Button; diff --git a/src/c_fl_check_button.h b/src/c_fl_check_button.h index c1b6ef0..2c25387 100644 --- a/src/c_fl_check_button.h +++ b/src/c_fl_check_button.h @@ -8,24 +8,24 @@ #define FL_CHECK_BUTTON_GUARD +extern "C" void fl_check_button_extra_init + (void * adaobj, int x, int y, int w, int h, const char * label); +extern "C" void fl_check_button_extra_final(void * adaobj); typedef void* CHECKBUTTON; - - extern "C" void check_button_set_draw_hook(CHECKBUTTON b, void * d); extern "C" void fl_check_button_draw(CHECKBUTTON b); extern "C" void check_button_set_handle_hook(CHECKBUTTON b, void * h); extern "C" int fl_check_button_handle(CHECKBUTTON b, int e); - - extern "C" CHECKBUTTON new_fl_check_button(int x, int y, int w, int h, char* label); extern "C" void free_fl_check_button(CHECKBUTTON b); #endif + diff --git a/src/c_fl_input.cpp b/src/c_fl_input.cpp index daccda0..c66b46d 100644 --- a/src/c_fl_input.cpp +++ b/src/c_fl_input.cpp @@ -10,6 +10,21 @@ +// Telprot stopovers + +extern "C" void text_input_extra_init_hook(void * aobj, int x, int y, int w, int h, const char * l); +void fl_text_input_extra_init(void * adaobj, int x, int y, int w, int h, const char * label) { + text_input_extra_init_hook(adaobj, x, y, w, h, label); +} + +extern "C" void text_input_extra_final_hook(void * aobj); +void fl_text_input_extra_final(void * adaobj) { + text_input_extra_final_hook(adaobj); +} + + + + // Exports from Ada extern "C" void widget_draw_hook(void * ud); diff --git a/src/c_fl_input.h b/src/c_fl_input.h index 6af00e8..06a8a0c 100644 --- a/src/c_fl_input.h +++ b/src/c_fl_input.h @@ -8,6 +8,11 @@ #define FL_TEXT_INPUT_GUARD +extern "C" void fl_text_input_extra_init + (void * adaobj, int x, int y, int w, int h, const char * label); +extern "C" void fl_text_input_extra_final(void * adaobj); + + typedef void* TEXTINPUT; diff --git a/src/c_fl_menu_button.cpp b/src/c_fl_menu_button.cpp index bc85ac9..fd78df4 100644 --- a/src/c_fl_menu_button.cpp +++ b/src/c_fl_menu_button.cpp @@ -11,6 +11,22 @@ +// Telprot stopovers + +extern "C" void menu_button_extra_init_hook + (void * aobj, int x, int y, int w, int h, const char * l); +void fl_menu_button_extra_init(void * adaobj, int x, int y, int w, int h, const char * label) { + menu_button_extra_init_hook(adaobj, x, y, w, h, label); +} + +extern "C" void menu_button_extra_final_hook(void * aobj); +void fl_menu_button_extra_final(void * adaobj) { + menu_button_extra_final_hook(adaobj); +} + + + + class My_Menu_Button : public Fl_Menu_Button { public: using Fl_Menu_Button::Fl_Menu_Button; diff --git a/src/c_fl_menu_button.h b/src/c_fl_menu_button.h index 95f8477..513f6b0 100644 --- a/src/c_fl_menu_button.h +++ b/src/c_fl_menu_button.h @@ -8,30 +8,28 @@ #define FL_MENU_BUTTON_GUARD +extern "C" void fl_menu_button_extra_init + (void * adaobj, int x, int y, int w, int h, const char * label); +extern "C" void fl_menu_button_extra_final(void * adaobj); typedef void* MENUBUTTON; - - extern "C" void menu_button_set_draw_hook(MENUBUTTON m, void * d); extern "C" void fl_menu_button_draw(MENUBUTTON m); extern "C" void menu_button_set_handle_hook(MENUBUTTON m, void * h); extern "C" int fl_menu_button_handle(MENUBUTTON m, int e); - - extern "C" MENUBUTTON new_fl_menu_button(int x, int y, int w, int h, char* label); extern "C" void free_fl_menu_button(MENUBUTTON m); - - extern "C" void fl_menu_button_type(MENUBUTTON m, unsigned int t); extern "C" const void * fl_menu_button_popup(MENUBUTTON m); #endif + diff --git a/src/c_fl_scrollbar.cpp b/src/c_fl_scrollbar.cpp index f6dfde3..848d83f 100644 --- a/src/c_fl_scrollbar.cpp +++ b/src/c_fl_scrollbar.cpp @@ -11,6 +11,21 @@ +// Telprot stopovers + +extern "C" void scrollbar_extra_init_hook(void * aobj, int x, int y, int w, int h, const char * l); +void fl_scrollbar_extra_init (void * adaobj, int x, int y, int w, int h, const char * label) { + scrollbar_extra_init_hook(adaobj, x, y, w, h, label); +} + +extern "C" void scrollbar_extra_final_hook(void * aobj); +void fl_scrollbar_extra_final(void * adaobj) { + scrollbar_extra_final_hook(adaobj); +} + + + + class My_Scrollbar : public Fl_Scrollbar { public: using Fl_Scrollbar::Fl_Scrollbar; diff --git a/src/c_fl_scrollbar.h b/src/c_fl_scrollbar.h index 85aac59..6f82143 100644 --- a/src/c_fl_scrollbar.h +++ b/src/c_fl_scrollbar.h @@ -8,27 +8,24 @@ #define FL_SCROLLBAR_GUARD +extern "C" void fl_scrollbar_extra_init + (void * adaobj, int x, int y, int w, int h, const char * label); +extern "C" void fl_scrollbar_extra_final(void * adaobj); typedef void* SCROLLBAR; - - extern "C" void scrollbar_set_draw_hook(SCROLLBAR s, void * d); extern "C" void fl_scrollbar_draw(SCROLLBAR s); extern "C" void scrollbar_set_handle_hook(SCROLLBAR s, void * h); extern "C" int fl_scrollbar_handle(SCROLLBAR s, int e); - - extern "C" SCROLLBAR new_fl_scrollbar(int x, int y, int w, int h, char* label); extern "C" void free_fl_scrollbar(SCROLLBAR s); - - extern "C" int fl_scrollbar_get_linesize(SCROLLBAR s); extern "C" void fl_scrollbar_set_linesize(SCROLLBAR s, int t); extern "C" int fl_scrollbar_get_value(SCROLLBAR s); @@ -38,3 +35,4 @@ extern "C" void fl_scrollbar_set_value2(SCROLLBAR s, int p, int w, int f, int t) #endif + diff --git a/src/fltk-file_choosers.adb b/src/fltk-file_choosers.adb index db9768c..07c10b1 100644 --- a/src/fltk-file_choosers.adb +++ b/src/fltk-file_choosers.adb @@ -509,11 +509,28 @@ package body FLTK.File_Choosers is -- Destructors -- ------------------- + -- Releasing carrier pigeon + procedure fl_button_extra_final + (Ada_Obj : in Storage.Integer_Address); + pragma Import (C, fl_button_extra_final, "fl_button_extra_final"); + pragma Inline (fl_button_extra_final); + + + -- Entering wormhole + procedure fl_check_button_extra_final + (Ada_Obj : in Storage.Integer_Address); + pragma Import (C, fl_check_button_extra_final, "fl_check_button_extra_final"); + pragma Inline (fl_check_button_extra_final); + + procedure Extra_Final (This : in out File_Chooser) is use Interfaces.C.Strings; begin + fl_button_extra_final (Storage.To_Integer (This.New_Butt'Address)); + fl_check_button_extra_final (Storage.To_Integer (This.Preview_Butt'Address)); + fl_check_button_extra_final (Storage.To_Integer (This.Hidden_Butt'Address)); Free (This.My_Label); Free (This.My_OK_Label); end Extra_Final; @@ -558,24 +575,57 @@ package body FLTK.File_Choosers is -- Constructors -- -------------------- + -- Bypassing border checkpoints + procedure fl_button_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_button_extra_init, "fl_button_extra_init"); + pragma Inline (fl_button_extra_init); + + + -- Refracting off language boundaries + procedure fl_check_button_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_check_button_extra_init, "fl_check_button_extra_init"); + pragma Inline (fl_check_button_extra_init); + + procedure Extra_Init (This : in out File_Chooser) is begin Wrapper (This.New_Butt).Void_Ptr := fl_file_chooser_newbutton (This.Void_Ptr); Wrapper (This.New_Butt).Needs_Dealloc := False; - fl_widget_set_user_data - (Wrapper (This.New_Butt).Void_Ptr, - Storage.To_Integer (This.New_Butt'Address)); + fl_button_extra_init + (Storage.To_Integer (This.New_Butt'Address), + Interfaces.C.int (This.New_Butt.Get_X), + Interfaces.C.int (This.New_Butt.Get_Y), + Interfaces.C.int (This.New_Butt.Get_W), + Interfaces.C.int (This.New_Butt.Get_H), + Interfaces.C.To_C (This.New_Butt.Get_Label)); + Wrapper (This.Preview_Butt).Void_Ptr := fl_file_chooser_previewbutton (This.Void_Ptr); Wrapper (This.Preview_Butt).Needs_Dealloc := False; - fl_widget_set_user_data - (Wrapper (This.Preview_Butt).Void_Ptr, - Storage.To_Integer (This.Preview_Butt'Address)); + fl_check_button_extra_init + (Storage.To_Integer (This.Preview_Butt'Address), + Interfaces.C.int (This.Preview_Butt.Get_X), + Interfaces.C.int (This.Preview_Butt.Get_Y), + Interfaces.C.int (This.Preview_Butt.Get_W), + Interfaces.C.int (This.Preview_Butt.Get_H), + Interfaces.C.To_C (This.Preview_Butt.Get_Label)); + Wrapper (This.Hidden_Butt).Void_Ptr := fl_file_chooser_showhiddenbutton (This.Void_Ptr); Wrapper (This.Hidden_Butt).Needs_Dealloc := False; - fl_widget_set_user_data - (Wrapper (This.Hidden_Butt).Void_Ptr, - Storage.To_Integer (This.Hidden_Butt'Address)); + fl_check_button_extra_init + (Storage.To_Integer (This.Hidden_Butt'Address), + Interfaces.C.int (This.Hidden_Butt.Get_X), + Interfaces.C.int (This.Hidden_Butt.Get_Y), + Interfaces.C.int (This.Hidden_Butt.Get_W), + Interfaces.C.int (This.Hidden_Butt.Get_H), + Interfaces.C.To_C (This.Hidden_Butt.Get_Label)); + fl_file_chooser_set_user_data (This.Void_Ptr, Storage.To_Integer (This'Address)); diff --git a/src/fltk-widgets-buttons-light-check.adb b/src/fltk-widgets-buttons-light-check.adb index d6a7ef7..d1596e0 100644 --- a/src/fltk-widgets-buttons-light-check.adb +++ b/src/fltk-widgets-buttons-light-check.adb @@ -6,12 +6,16 @@ with - Interfaces.C; + Interfaces.C.Strings; package body FLTK.Widgets.Buttons.Light.Check is + ------------------------ + -- Functions From C -- + ------------------------ + procedure check_button_set_draw_hook (W, D : in Storage.Integer_Address); pragma Import (C, check_button_set_draw_hook, "check_button_set_draw_hook"); @@ -55,6 +59,26 @@ package body FLTK.Widgets.Buttons.Light.Check is + ------------------- + -- Destructors -- + ------------------- + + -- Round the world and home again, that's the sailor's way! + procedure check_button_extra_final_hook + (Ada_Obj : in Storage.Integer_Address); + pragma Export (C, check_button_extra_final_hook, "check_button_extra_final_hook"); + + procedure check_button_extra_final_hook + (Ada_Obj : in Storage.Integer_Address) + is + My_Check_Button : Check_Button; + for My_Check_Button'Address use Storage.To_Address (Ada_Obj); + pragma Import (Ada, My_Check_Button); + begin + Extra_Final (My_Check_Button); + end check_button_extra_final_hook; + + procedure Extra_Final (This : in out Check_Button) is begin @@ -75,6 +99,34 @@ package body FLTK.Widgets.Buttons.Light.Check is + -------------------- + -- Constructors -- + -------------------- + + -- Arrived at the flip side + procedure check_button_extra_init_hook + (Ada_Obj : Storage.Integer_Address; + X, Y, W, H : in Interfaces.C.int; + C_Str : in Interfaces.C.Strings.chars_ptr); + pragma Export (C, check_button_extra_init_hook, "check_button_extra_init_hook"); + + procedure check_button_extra_init_hook + (Ada_Obj : in Storage.Integer_Address; + X, Y, W, H : in Interfaces.C.int; + C_Str : in Interfaces.C.Strings.chars_ptr) + is + My_Check_Button : Check_Button; + for My_Check_Button'Address use Storage.To_Address (Ada_Obj); + pragma Import (Ada, My_Check_Button); + begin + Extra_Init + (My_Check_Button, + Integer (X), Integer (Y), + Integer (W), Integer (H), + Interfaces.C.Strings.Value (C_Str)); + end check_button_extra_init_hook; + + procedure Extra_Init (This : in out Check_Button; X, Y, W, H : in Integer; @@ -111,6 +163,10 @@ package body FLTK.Widgets.Buttons.Light.Check is + ----------------------- + -- API Subprograms -- + ----------------------- + procedure Draw (This : in out Check_Button) is begin diff --git a/src/fltk-widgets-buttons.adb b/src/fltk-widgets-buttons.adb index 64f351a..e0b5120 100644 --- a/src/fltk-widgets-buttons.adb +++ b/src/fltk-widgets-buttons.adb @@ -6,12 +6,16 @@ with - Interfaces.C; + Interfaces.C.Strings; package body FLTK.Widgets.Buttons is + ------------------------ + -- Functions From C -- + ------------------------ + procedure button_set_draw_hook (W, D : in Storage.Integer_Address); pragma Import (C, button_set_draw_hook, "button_set_draw_hook"); @@ -102,6 +106,26 @@ package body FLTK.Widgets.Buttons is + ------------------- + -- Destructors -- + ------------------- + + -- Clipper route successfully navigated + procedure button_extra_final_hook + (Ada_Obj : in Storage.Integer_Address); + pragma Export (C, button_extra_final_hook, "button_extra_final_hook"); + + procedure button_extra_final_hook + (Ada_Obj : in Storage.Integer_Address) + is + My_Button : Button; + for My_Button'Address use Storage.To_Address (Ada_Obj); + pragma Import (Ada, My_Button); + begin + Extra_Final (My_Button); + end button_extra_final_hook; + + procedure Extra_Final (This : in out Button) is begin @@ -122,6 +146,34 @@ package body FLTK.Widgets.Buttons is + -------------------- + -- Constructors -- + -------------------- + + -- Mobius strip traversal complete + procedure button_extra_init_hook + (Ada_Obj : in Storage.Integer_Address; + X, Y, W, H : in Interfaces.C.int; + C_Str : in Interfaces.C.Strings.chars_ptr); + pragma Export (C, button_extra_init_hook, "button_extra_init_hook"); + + procedure button_extra_init_hook + (Ada_Obj : in Storage.Integer_Address; + X, Y, W, H : in Interfaces.C.int; + C_Str : in Interfaces.C.Strings.chars_ptr) + is + My_Button : Button; + for My_Button'Address use Storage.To_Address (Ada_Obj); + pragma Import (Ada, My_Button); + begin + Extra_Init + (My_Button, + Integer (X), Integer (Y), + Integer (W), Integer (H), + Interfaces.C.Strings.Value (C_Str)); + end button_extra_init_hook; + + procedure Extra_Init (This : in out Button; X, Y, W, H : in Integer; @@ -156,6 +208,10 @@ package body FLTK.Widgets.Buttons is + ----------------------- + -- API Subprograms -- + ----------------------- + function Get_State (This : in Button) return State is diff --git a/src/fltk-widgets-groups-browsers.adb b/src/fltk-widgets-groups-browsers.adb index 360c4f5..0c65653 100644 --- a/src/fltk-widgets-groups-browsers.adb +++ b/src/fltk-widgets-groups-browsers.adb @@ -626,11 +626,18 @@ package body FLTK.Widgets.Groups.Browsers is -- Destructors -- ------------------- + -- Preparing to use morse code + procedure fl_scrollbar_extra_final + (Ada_Obj : in Storage.Integer_Address); + pragma Import (C, fl_scrollbar_extra_final, "fl_scrollbar_extra_final"); + pragma Inline (fl_scrollbar_extra_final); + + procedure Extra_Final (This : in out Browser) is begin - Extra_Final (Widget (This.Horizon)); - Extra_Final (Widget (This.Vertigo)); + fl_scrollbar_extra_final (Storage.To_Integer (This.Horizon'Address)); + fl_scrollbar_extra_final (Storage.To_Integer (This.Vertigo'Address)); Extra_Final (Group (This)); for Index in This.Text_Store'Range loop Interfaces.C.Strings.Free (This.Text_Store (Index)); @@ -655,6 +662,15 @@ package body FLTK.Widgets.Groups.Browsers is -- Constructors -- -------------------- + -- Boarding the Titanic... + procedure fl_scrollbar_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_scrollbar_extra_init, "fl_scrollbar_extra_init"); + pragma Inline (fl_scrollbar_extra_init); + + procedure Extra_Init (This : in out Browser; X, Y, W, H : in Integer; @@ -662,22 +678,22 @@ package body FLTK.Widgets.Groups.Browsers 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); + fl_scrollbar_extra_init + (Storage.To_Integer (This.Horizon'Address), + Interfaces.C.int (This.Horizon.Get_X), + Interfaces.C.int (This.Horizon.Get_Y), + Interfaces.C.int (This.Horizon.Get_W), + Interfaces.C.int (This.Horizon.Get_H), + Interfaces.C.To_C (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); + fl_scrollbar_extra_init + (Storage.To_Integer (This.Vertigo'Address), + Interfaces.C.int (This.Vertigo.Get_X), + Interfaces.C.int (This.Vertigo.Get_Y), + Interfaces.C.int (This.Vertigo.Get_W), + Interfaces.C.int (This.Vertigo.Get_H), + Interfaces.C.To_C (This.Vertigo.Get_Label)); Extra_Init (Group (This), X, Y, W, H, Text); end Extra_Init; diff --git a/src/fltk-widgets-groups-input_choices.adb b/src/fltk-widgets-groups-input_choices.adb index 6f36a31..b321dd2 100644 --- a/src/fltk-widgets-groups-input_choices.adb +++ b/src/fltk-widgets-groups-input_choices.adb @@ -17,6 +17,10 @@ use type package body FLTK.Widgets.Groups.Input_Choices is + ------------------------ + -- Functions From C -- + ------------------------ + procedure input_choice_set_draw_hook (W, D : in Storage.Integer_Address); pragma Import (C, input_choice_set_draw_hook, "input_choice_set_draw_hook"); @@ -168,14 +172,33 @@ package body FLTK.Widgets.Groups.Input_Choices is + ------------------- + -- Destructors -- + ------------------- + + -- Resorting to smoke signals + procedure fl_text_input_extra_final + (Ada_Obj : in Storage.Integer_Address); + pragma Import (C, fl_text_input_extra_final, "fl_text_input_extra_final"); + pragma Inline (fl_text_input_extra_final); + + + -- Message in a bottle + procedure fl_menu_button_extra_final + (Ada_Obj : in Storage.Integer_Address); + pragma Import (C, fl_menu_button_extra_final, "fl_menu_button_extra_final"); + pragma Inline (fl_menu_button_extra_final); + + procedure Extra_Final (This : in out Input_Choice) is begin - Extra_Final (Widget (This.My_Input)); - Extra_Final (Widget (This.My_Menu_Button)); + fl_text_input_extra_final (Storage.To_Integer (This.My_Input'Address)); + fl_menu_button_extra_final (Storage.To_Integer (This.My_Menu_Button'Address)); Extra_Final (Group (This)); end Extra_Final; + procedure Finalize (This : in out Input_Choice) is begin @@ -189,6 +212,28 @@ package body FLTK.Widgets.Groups.Input_Choices is + -------------------- + -- Constructors -- + -------------------- + + -- Translocation initiating... + procedure fl_text_input_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_text_input_extra_init, "fl_text_input_extra_init"); + pragma Inline (fl_text_input_extra_init); + + + -- Crossing the streams + procedure fl_menu_button_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_menu_button_extra_init, "fl_menu_button_extra_init"); + pragma Inline (fl_menu_button_extra_init); + + procedure Extra_Init (This : in out Input_Choice; X, Y, W, H : in Integer; @@ -196,22 +241,22 @@ package body FLTK.Widgets.Groups.Input_Choices 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); + fl_text_input_extra_init + (Storage.To_Integer (This.My_Input'Address), + Interfaces.C.int (This.My_Input.Get_X), + Interfaces.C.int (This.My_Input.Get_Y), + Interfaces.C.int (This.My_Input.Get_W), + Interfaces.C.int (This.My_Input.Get_H), + Interfaces.C.To_C (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); + fl_menu_button_extra_init + (Storage.To_Integer (This.My_Menu_Button'Address), + Interfaces.C.int (This.My_Menu_Button.Get_X), + Interfaces.C.int (This.My_Menu_Button.Get_Y), + Interfaces.C.int (This.My_Menu_Button.Get_W), + Interfaces.C.int (This.My_Menu_Button.Get_H), + Interfaces.C.To_C (This.My_Menu_Button.Get_Label)); Extra_Init (Group (This), X, Y, W, H, Text); end Extra_Init; @@ -243,20 +288,20 @@ package body FLTK.Widgets.Groups.Input_Choices is - function Input + function Text_Field (This : in out Input_Choice) - return FLTK.Widgets.Inputs.Input_Reference is + return FLTK.Widgets.Inputs.Text.Text_Input_Reference is begin return (Data => This.My_Input'Unchecked_Access); - end Input; + end Text_Field; - function Menu_Button + function Button_Menu (This : in out Input_Choice) return FLTK.Widgets.Menus.Menu_Buttons.Menu_Button_Reference is begin return (Data => This.My_Menu_Button'Unchecked_Access); - end Menu_Button; + end Button_Menu; diff --git a/src/fltk-widgets-groups-input_choices.ads b/src/fltk-widgets-groups-input_choices.ads index 0ffc8d9..656fc3a 100644 --- a/src/fltk-widgets-groups-input_choices.ads +++ b/src/fltk-widgets-groups-input_choices.ads @@ -6,7 +6,7 @@ with - FLTK.Widgets.Inputs, + FLTK.Widgets.Inputs.Text, FLTK.Widgets.Menus.Menu_Buttons; @@ -33,11 +33,11 @@ package FLTK.Widgets.Groups.Input_Choices is - function Input + function Text_Field (This : in out Input_Choice) - return FLTK.Widgets.Inputs.Input_Reference; + return FLTK.Widgets.Inputs.Text.Text_Input_Reference; - function Menu_Button + function Button_Menu (This : in out Input_Choice) return FLTK.Widgets.Menus.Menu_Buttons.Menu_Button_Reference; @@ -121,7 +121,7 @@ private type Input_Choice is new Group with record - My_Input : aliased Inputs.Input; + My_Input : aliased Inputs.Text.Text_Input; My_Menu_Button : aliased Menus.Menu_Buttons.Menu_Button; end record; @@ -137,8 +137,8 @@ private (This : in out Input_Choice); - pragma Inline (Input); - pragma Inline (Menu_Button); + pragma Inline (Text_Field); + pragma Inline (Button_Menu); pragma Inline (Has_Changed); pragma Inline (Clear_Changed); diff --git a/src/fltk-widgets-inputs-text.adb b/src/fltk-widgets-inputs-text.adb index 64e2e0f..e9b9545 100644 --- a/src/fltk-widgets-inputs-text.adb +++ b/src/fltk-widgets-inputs-text.adb @@ -50,6 +50,22 @@ package body FLTK.Widgets.Inputs.Text is -- Destructors -- ------------------- + -- Message received, every zig will take off + procedure text_input_extra_final_hook + (Ada_Obj : in Storage.Integer_Address); + pragma Export (C, text_input_extra_final_hook, "text_input_extra_final_hook"); + + procedure text_input_extra_final_hook + (Ada_Obj : in Storage.Integer_Address) + is + My_Text_Input : Text_Input; + for My_Text_Input'Address use Storage.To_Address (Ada_Obj); + pragma Import (Ada, My_Text_Input); + begin + Extra_Final (My_Text_Input); + end text_input_extra_final_hook; + + procedure Extra_Final (This : in out Text_Input) is begin @@ -74,6 +90,30 @@ package body FLTK.Widgets.Inputs.Text is -- Constructors -- -------------------- + -- Last stop, everyone out! + procedure text_input_extra_init_hook + (Ada_Obj : in Storage.Integer_Address; + X, Y, W, H : in Interfaces.C.int; + C_Str : in Interfaces.C.Strings.chars_ptr); + pragma Export (C, text_input_extra_init_hook, "text_input_extra_init_hook"); + + procedure text_input_extra_init_hook + (Ada_Obj : in Storage.Integer_Address; + X, Y, W, H : in Interfaces.C.int; + C_Str : in Interfaces.C.Strings.chars_ptr) + is + My_Text_Input : Text_Input; + for My_Text_Input'Address use Storage.To_Address (Ada_Obj); + pragma Import (Ada, My_Text_Input); + begin + Extra_Init + (My_Text_Input, + Integer (X), Integer (Y), + Integer (W), Integer (H), + Interfaces.C.Strings.Value (C_Str)); + end text_input_extra_init_hook; + + procedure Extra_Init (This : in out Text_Input; X, Y, W, H : in Integer; diff --git a/src/fltk-widgets-menus-menu_buttons.adb b/src/fltk-widgets-menus-menu_buttons.adb index 9a15d8b..95ebb8b 100644 --- a/src/fltk-widgets-menus-menu_buttons.adb +++ b/src/fltk-widgets-menus-menu_buttons.adb @@ -6,12 +6,16 @@ with - Interfaces.C; + Interfaces.C.Strings; package body FLTK.Widgets.Menus.Menu_Buttons is + ------------------------ + -- Functions From C -- + ------------------------ + procedure menu_button_set_draw_hook (W, D : in Storage.Integer_Address); pragma Import (C, menu_button_set_draw_hook, "menu_button_set_draw_hook"); @@ -76,6 +80,26 @@ package body FLTK.Widgets.Menus.Menu_Buttons is + ------------------- + -- Destructors -- + ------------------- + + -- More magic + procedure menu_button_extra_final_hook + (Ada_Obj : in Storage.Integer_Address); + pragma Export (C, menu_button_extra_final_hook, "menu_button_extra_final_hook"); + + procedure menu_button_extra_final_hook + (Ada_Obj : in Storage.Integer_Address) + is + My_Menu_Button : Menu_Button; + for My_Menu_Button'Address use Storage.To_Address (Ada_Obj); + pragma Import (Ada, My_Menu_Button); + begin + Extra_Final (My_Menu_Button); + end menu_button_extra_final_hook; + + procedure Extra_Final (This : in out Menu_Button) is begin @@ -96,6 +120,34 @@ package body FLTK.Widgets.Menus.Menu_Buttons is + -------------------- + -- Constructors -- + -------------------- + + -- Long distance telephone call receival + procedure menu_button_extra_init_hook + (Ada_Obj : in Storage.Integer_Address; + X, Y, W, H : in Interfaces.C.int; + C_Str : in Interfaces.C.Strings.chars_ptr); + pragma Export (C, menu_button_extra_init_hook, "menu_button_extra_init_hook"); + + procedure menu_button_extra_init_hook + (Ada_Obj : in Storage.Integer_Address; + X, Y, W, H : in Interfaces.C.int; + C_Str : in Interfaces.C.Strings.chars_ptr) + is + My_Menu_Button : Menu_Button; + for My_Menu_Button'Address use Storage.To_Address (Ada_Obj); + pragma Import (Ada, My_Menu_Button); + begin + Extra_Init + (My_Menu_Button, + Integer (X), Integer (Y), + Integer (W), Integer (H), + Interfaces.C.Strings.Value (C_Str)); + end menu_button_extra_init_hook; + + procedure Extra_Init (This : in out Menu_Button; X, Y, W, H : in Integer; @@ -132,6 +184,10 @@ package body FLTK.Widgets.Menus.Menu_Buttons is + ----------------------- + -- API Subprograms -- + ----------------------- + procedure Set_Popup_Kind (This : in out Menu_Button; Pop : in Popup_Buttons) is diff --git a/src/fltk-widgets-valuators-sliders-scrollbars.adb b/src/fltk-widgets-valuators-sliders-scrollbars.adb index 2afca08..84a0cc6 100644 --- a/src/fltk-widgets-valuators-sliders-scrollbars.adb +++ b/src/fltk-widgets-valuators-sliders-scrollbars.adb @@ -12,6 +12,10 @@ with package body FLTK.Widgets.Valuators.Sliders.Scrollbars is + ------------------------ + -- Functions From C -- + ------------------------ + procedure scrollbar_set_draw_hook (W, D : in Storage.Integer_Address); pragma Import (C, scrollbar_set_draw_hook, "scrollbar_set_draw_hook"); @@ -88,6 +92,26 @@ package body FLTK.Widgets.Valuators.Sliders.Scrollbars is + ------------------- + -- Destructors -- + ------------------- + + -- End of the line + procedure scrollbar_extra_final_hook + (Ada_Obj : in Storage.Integer_Address); + pragma Export (C, scrollbar_extra_final_hook, "scrollbar_extra_final_hook"); + + procedure scrollbar_extra_final_hook + (Ada_Obj : in Storage.Integer_Address) + is + My_Scrollbar : Scrollbar; + for My_Scrollbar'Address use Storage.To_Address (Ada_Obj); + pragma Import (Ada, My_Scrollbar); + begin + Extra_Final (My_Scrollbar); + end scrollbar_extra_final_hook; + + procedure Extra_Final (This : in out Scrollbar) is begin @@ -108,6 +132,34 @@ package body FLTK.Widgets.Valuators.Sliders.Scrollbars is + -------------------- + -- Constructors -- + -------------------- + + -- Radio signal successfully intercepted + procedure scrollbar_extra_init_hook + (Ada_Obj : in Storage.Integer_Address; + X, Y, W, H : in Interfaces.C.int; + C_Str : in Interfaces.C.Strings.chars_ptr); + pragma Export (C, scrollbar_extra_init_hook, "scrollbar_extra_init_hook"); + + procedure scrollbar_extra_init_hook + (Ada_Obj : in Storage.Integer_Address; + X, Y, W, H : in Interfaces.C.int; + C_Str : in Interfaces.C.Strings.chars_ptr) + is + My_Scrollbar : Scrollbar; + for My_Scrollbar'Address use Storage.To_Address (Ada_Obj); + pragma Import (Ada, My_Scrollbar); + begin + Extra_Init + (My_Scrollbar, + Integer (X), Integer (Y), + Integer (W), Integer (H), + Interfaces.C.Strings.Value (C_Str)); + end scrollbar_extra_init_hook; + + procedure Extra_Init (This : in out Scrollbar; X, Y, W, H : in Integer; @@ -142,6 +194,10 @@ package body FLTK.Widgets.Valuators.Sliders.Scrollbars is + ----------------------- + -- API Subprograms -- + ----------------------- + function Get_Line_Size (This : in Scrollbar) return Natural is diff --git a/src/fltk-widgets-valuators-value_inputs.adb b/src/fltk-widgets-valuators-value_inputs.adb index 62cd320..fbb2e0a 100644 --- a/src/fltk-widgets-valuators-value_inputs.adb +++ b/src/fltk-widgets-valuators-value_inputs.adb @@ -16,6 +16,10 @@ use type package body FLTK.Widgets.Valuators.Value_Inputs is + ------------------------ + -- Functions From C -- + ------------------------ + procedure value_input_set_draw_hook (W, D : in Storage.Integer_Address); pragma Import (C, value_input_set_draw_hook, "value_input_set_draw_hook"); @@ -152,9 +156,21 @@ package body FLTK.Widgets.Valuators.Value_Inputs is + ------------------- + -- Destructors -- + ------------------- + + -- Making a long distance telephone call + procedure fl_text_input_extra_final + (Ada_Obj : in Storage.Integer_Address); + pragma Import (C, fl_text_input_extra_final, "fl_text_input_extra_final"); + pragma Inline (fl_text_input_extra_final); + + procedure Extra_Final (This : in out Value_Input) is begin + fl_text_input_extra_final (Storage.To_Integer (This.My_Input'Address)); Extra_Final (Valuator (This)); end Extra_Final; @@ -172,21 +188,33 @@ package body FLTK.Widgets.Valuators.Value_Inputs is + -------------------- + -- Constructors -- + -------------------- + + -- Black magic, don't try this at home kids + procedure fl_text_input_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_text_input_extra_init, "fl_text_input_extra_init"); + pragma Inline (fl_text_input_extra_init); + + 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).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); + fl_text_input_extra_init + (Storage.To_Integer (This.My_Input'Address), + Interfaces.C.int (This.My_Input.Get_X), + Interfaces.C.int (This.My_Input.Get_Y), + Interfaces.C.int (This.My_Input.Get_W), + Interfaces.C.int (This.My_Input.Get_H), + Interfaces.C.To_C (This.My_Input.Get_Label)); Extra_Init (Valuator (This), X, Y, W, H, Text); end Extra_Init; @@ -218,12 +246,12 @@ package body FLTK.Widgets.Valuators.Value_Inputs is - function Input + function Text_Field (This : in out Value_Input) - return FLTK.Widgets.Inputs.Input_Reference is + return FLTK.Widgets.Inputs.Text.Text_Input_Reference is begin return (Data => This.My_Input'Unchecked_Access); - end Input; + end Text_Field; diff --git a/src/fltk-widgets-valuators-value_inputs.ads b/src/fltk-widgets-valuators-value_inputs.ads index 861086b..10a5824 100644 --- a/src/fltk-widgets-valuators-value_inputs.ads +++ b/src/fltk-widgets-valuators-value_inputs.ads @@ -6,7 +6,7 @@ with - FLTK.Widgets.Inputs; + FLTK.Widgets.Inputs.Text; package FLTK.Widgets.Valuators.Value_Inputs is @@ -32,9 +32,9 @@ package FLTK.Widgets.Valuators.Value_Inputs is - function Input + function Text_Field (This : in out Value_Input) - return FLTK.Widgets.Inputs.Input_Reference; + return FLTK.Widgets.Inputs.Text.Text_Input_Reference; @@ -112,7 +112,7 @@ private type Value_Input is new Valuator with record - My_Input : aliased Inputs.Input; + My_Input : aliased Inputs.Text.Text_Input; end record; overriding procedure Finalize @@ -128,7 +128,7 @@ private with Inline; - pragma Inline (Input); + pragma Inline (Text_Field); pragma Inline (Get_Cursor_Color); pragma Inline (Set_Cursor_Color); diff --git a/src/fltk-widgets.ads b/src/fltk-widgets.ads index 46e5733..3381e6e 100644 --- a/src/fltk-widgets.ads +++ b/src/fltk-widgets.ads @@ -367,12 +367,9 @@ private (This : in out Widget); -- Widgets that might cause problems for this setup in the future: - -- Valuators.Value_Inputs (has an internal Input) -- Menus (gets various Menu_Items added to it) -- Groups.Text_Displays (gets a Text_Buffer attached) -- Groups.Text_Displays.Text_Editors (also gets a Text_Buffer attached) - -- Groups.Input_Choices (has an internal Input and Menu_Button) - -- Groups.Browsers (has two internal Scrollbars) -- If weird Init/Final errors start mysteriously occuring then check there first. -- Extra_Init functionality is also duplicated in FLTK.File_Choosers |