diff options
Diffstat (limited to 'src/fltk_binding')
27 files changed, 229 insertions, 22 deletions
diff --git a/src/fltk_binding/c_fl_text_buffer.cpp b/src/fltk_binding/c_fl_text_buffer.cpp new file mode 100644 index 0000000..791e0ab --- /dev/null +++ b/src/fltk_binding/c_fl_text_buffer.cpp @@ -0,0 +1,16 @@ + + +#include <FL/Fl_Text_Buffer.H> +#include "c_fl_text_buffer.h" + + +TEXTBUFFER new_fl_text_buffer(int rs, int pgs) { + Fl_Text_Buffer *tb = new Fl_Text_Buffer(rs, pgs); + return tb; +} + + +void free_fl_text_buffer(TEXTBUFFER tb) { + delete reinterpret_cast<Fl_Text_Buffer*>(tb); +} + diff --git a/src/fltk_binding/c_fl_text_buffer.h b/src/fltk_binding/c_fl_text_buffer.h new file mode 100644 index 0000000..23daa03 --- /dev/null +++ b/src/fltk_binding/c_fl_text_buffer.h @@ -0,0 +1,15 @@ + + +#ifndef FL_TEXT_BUFFER_GUARD +#define FL_TEXT_BUFFER_GUARD + + +typedef void* TEXTBUFFER; + + +extern "C" TEXTBUFFER new_fl_text_buffer(int rs, int pgs); +extern "C" void free_fl_text_buffer(TEXTBUFFER tb); + + +#endif + diff --git a/src/fltk_binding/c_fl_text_display.cpp b/src/fltk_binding/c_fl_text_display.cpp index 95d5727..c45e778 100644 --- a/src/fltk_binding/c_fl_text_display.cpp +++ b/src/fltk_binding/c_fl_text_display.cpp @@ -1,7 +1,9 @@ #include <FL/Fl_Text_Display.H> +#include <FL/Fl_Text_Buffer.H> #include "c_fl_text_display.h" +#include "c_fl_text_buffer.h" TEXTDISPLAY new_fl_text_display(int x, int y, int w, int h, char* label) { @@ -15,6 +17,18 @@ void free_fl_text_display(TEXTDISPLAY td) { } +// this actually never gets called, since an access to the text_buffer +// object is stored on the Ada side of things +TEXTBUFFER fl_text_display_get_buffer(TEXTDISPLAY td) { + return reinterpret_cast<Fl_Text_Display*>(td)->buffer(); +} + + +void fl_text_display_set_buffer(TEXTDISPLAY td, TEXTBUFFER tb) { + reinterpret_cast<Fl_Text_Display*>(td)->buffer(reinterpret_cast<Fl_Text_Buffer*>(tb)); +} + + int fl_text_display_get_text_color(TEXTDISPLAY td) { return reinterpret_cast<Fl_Text_Display*>(td)->textcolor(); } diff --git a/src/fltk_binding/c_fl_text_display.h b/src/fltk_binding/c_fl_text_display.h index 2c1019f..dba1706 100644 --- a/src/fltk_binding/c_fl_text_display.h +++ b/src/fltk_binding/c_fl_text_display.h @@ -3,6 +3,8 @@ #ifndef FL_TEXT_DISPLAY_GUARD #define FL_TEXT_DISPLAY_GUARD +#include "c_fl_text_buffer.h" + typedef void* TEXTDISPLAY; @@ -10,6 +12,8 @@ typedef void* TEXTDISPLAY; extern "C" TEXTDISPLAY new_fl_text_display(int x, int y, int w, int h, char* label); extern "C" void free_fl_text_display(TEXTDISPLAY td); +extern "C" TEXTBUFFER fl_text_display_get_buffer(TEXTDISPLAY td); +extern "C" void fl_text_display_set_buffer(TEXTDISPLAY td, TEXTBUFFER tb); extern "C" int fl_text_display_get_text_color(TEXTDISPLAY td); extern "C" void fl_text_display_set_text_color(TEXTDISPLAY td, int c); extern "C" int fl_text_display_get_text_font(TEXTDISPLAY td); diff --git a/src/fltk_binding/fltk-text_buffers.adb b/src/fltk_binding/fltk-text_buffers.adb new file mode 100644 index 0000000..12a6a73 --- /dev/null +++ b/src/fltk_binding/fltk-text_buffers.adb @@ -0,0 +1,50 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Text_Buffers is + + + function new_fl_text_buffer + (RS, PGS : in Interfaces.C.int) + return System.Address; + pragma Import (C, new_fl_text_buffer, "new_fl_text_buffer"); + + procedure free_fl_text_buffer + (TB : in System.Address); + pragma Import (C, free_fl_text_buffer, "free_fl_text_buffer"); + + + + + procedure Finalize + (This : in out Text_Buffer) is + begin + if (This.Void_Ptr /= System.Null_Address) then + free_fl_text_buffer (This.Void_Ptr); + end if; + end Finalize; + + + + + function Create + (Requested_Size : in Natural := 0; + Preferred_Gap_Size : in Natural := 1024) + return Text_Buffer is + + VP : System.Address; + + begin + VP := new_fl_text_buffer + (Interfaces.C.int (Requested_Size), + Interfaces.C.int (Preferred_Gap_Size)); + return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); + end Create; + + +end FLTK.Text_Buffers; + diff --git a/src/fltk_binding/fltk-text_buffers.ads b/src/fltk_binding/fltk-text_buffers.ads new file mode 100644 index 0000000..902c978 --- /dev/null +++ b/src/fltk_binding/fltk-text_buffers.ads @@ -0,0 +1,27 @@ + + +package FLTK.Text_Buffers is + + + type Text_Buffer is new Wrapper with private; + type Text_Buffer_Access is access all Text_Buffer; + + + function Create + (Requested_Size : in Natural := 0; + Preferred_Gap_Size : in Natural := 1024) + return Text_Buffer; + + +private + + + type Text_Buffer is new Wrapper with null record; + + + overriding procedure Finalize + (This : in out Text_Buffer); + + +end FLTK.Text_Buffers; + diff --git a/src/fltk_binding/fltk-widgets-boxes.ads b/src/fltk_binding/fltk-widgets-boxes.ads index 2f1c78e..e8a7b83 100644 --- a/src/fltk_binding/fltk-widgets-boxes.ads +++ b/src/fltk_binding/fltk-widgets-boxes.ads @@ -4,6 +4,7 @@ package FLTK.Widgets.Boxes is type Box is new Widget with private; + type Box_Access is access all Box; function Create diff --git a/src/fltk_binding/fltk-widgets-buttons-enter.ads b/src/fltk_binding/fltk-widgets-buttons-enter.ads index 302e1bb..9e5abf6 100644 --- a/src/fltk_binding/fltk-widgets-buttons-enter.ads +++ b/src/fltk_binding/fltk-widgets-buttons-enter.ads @@ -5,6 +5,7 @@ package FLTK.Widgets.Buttons.Enter is type Enter_Button is new Button with private; + type Enter_Button_Access is access all Enter_Button; function Create diff --git a/src/fltk_binding/fltk-widgets-buttons-light-check.ads b/src/fltk_binding/fltk-widgets-buttons-light-check.ads index cdf9b18..68e5c17 100644 --- a/src/fltk_binding/fltk-widgets-buttons-light-check.ads +++ b/src/fltk_binding/fltk-widgets-buttons-light-check.ads @@ -4,6 +4,7 @@ package FLTK.Widgets.Buttons.Light.Check is type Check_Button is new Light_Button with private; + type Check_Button_Access is access all Check_Button; function Create diff --git a/src/fltk_binding/fltk-widgets-buttons-light-radio.ads b/src/fltk_binding/fltk-widgets-buttons-light-radio.ads index df7195f..072ff33 100644 --- a/src/fltk_binding/fltk-widgets-buttons-light-radio.ads +++ b/src/fltk_binding/fltk-widgets-buttons-light-radio.ads @@ -4,6 +4,7 @@ package FLTK.Widgets.Buttons.Light.Radio is type Radio_Light_Button is new Light_Button with private; + type Radio_Light_Button_Access is access all Radio_Light_Button; function Create diff --git a/src/fltk_binding/fltk-widgets-buttons-light-round-radio.ads b/src/fltk_binding/fltk-widgets-buttons-light-round-radio.ads index 3889d49..7d21ad7 100644 --- a/src/fltk_binding/fltk-widgets-buttons-light-round-radio.ads +++ b/src/fltk_binding/fltk-widgets-buttons-light-round-radio.ads @@ -4,6 +4,7 @@ package FLTK.Widgets.Buttons.Light.Round.Radio is type Radio_Round_Button is new Round_Button with private; + type Radio_Round_Button_Access is access all Radio_Round_Button; function Create diff --git a/src/fltk_binding/fltk-widgets-buttons-light-round.ads b/src/fltk_binding/fltk-widgets-buttons-light-round.ads index 5e1e1f7..0209d4b 100644 --- a/src/fltk_binding/fltk-widgets-buttons-light-round.ads +++ b/src/fltk_binding/fltk-widgets-buttons-light-round.ads @@ -4,6 +4,7 @@ package FLTK.Widgets.Buttons.Light.Round is type Round_Button is new Light_Button with private; + type Round_Button_Access is access all Round_Button; function Create diff --git a/src/fltk_binding/fltk-widgets-buttons-light.ads b/src/fltk_binding/fltk-widgets-buttons-light.ads index 5a2c48a..a3a11b3 100644 --- a/src/fltk_binding/fltk-widgets-buttons-light.ads +++ b/src/fltk_binding/fltk-widgets-buttons-light.ads @@ -4,6 +4,7 @@ package FLTK.Widgets.Buttons.Light is type Light_Button is new Button with private; + type Light_Button_Access is access all Light_Button; function Create diff --git a/src/fltk_binding/fltk-widgets-buttons-radio.ads b/src/fltk_binding/fltk-widgets-buttons-radio.ads index 49e8259..55a9725 100644 --- a/src/fltk_binding/fltk-widgets-buttons-radio.ads +++ b/src/fltk_binding/fltk-widgets-buttons-radio.ads @@ -4,6 +4,7 @@ package FLTK.Widgets.Buttons.Radio is type Radio_Button is new Button with private; + type Radio_Button_Access is access all Radio_Button; function Create diff --git a/src/fltk_binding/fltk-widgets-buttons-repeat.ads b/src/fltk_binding/fltk-widgets-buttons-repeat.ads index baac3f4..0334bcd 100644 --- a/src/fltk_binding/fltk-widgets-buttons-repeat.ads +++ b/src/fltk_binding/fltk-widgets-buttons-repeat.ads @@ -4,6 +4,7 @@ package FLTK.Widgets.Buttons.Repeat is type Repeat_Button is new Button with private; + type Repeat_Button_Access is access all Repeat_Button; function Create diff --git a/src/fltk_binding/fltk-widgets-buttons-toggle.ads b/src/fltk_binding/fltk-widgets-buttons-toggle.ads index ce6e36b..f472dee 100644 --- a/src/fltk_binding/fltk-widgets-buttons-toggle.ads +++ b/src/fltk_binding/fltk-widgets-buttons-toggle.ads @@ -4,6 +4,7 @@ package FLTK.Widgets.Buttons.Toggle is type Toggle_Button is new Button with private; + type Toggle_Button_Access is access all Toggle_Button; function Create diff --git a/src/fltk_binding/fltk-widgets-buttons.ads b/src/fltk_binding/fltk-widgets-buttons.ads index 8469bcc..42f6e8b 100644 --- a/src/fltk_binding/fltk-widgets-buttons.ads +++ b/src/fltk_binding/fltk-widgets-buttons.ads @@ -4,6 +4,9 @@ package FLTK.Widgets.Buttons is type Button is new Widget with private; + type Button_Access is access all Button; + + type State is (On, Off); diff --git a/src/fltk_binding/fltk-widgets-groups-text_displays.adb b/src/fltk_binding/fltk-widgets-groups-text_displays.adb index ccee7c5..e39355f 100644 --- a/src/fltk_binding/fltk-widgets-groups-text_displays.adb +++ b/src/fltk_binding/fltk-widgets-groups-text_displays.adb @@ -18,6 +18,15 @@ 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; + pragma Import (C, fl_text_display_get_buffer, "fl_text_display_get_buffer"); + + procedure fl_text_display_set_buffer + (TD, TB : in System.Address); + pragma Import (C, fl_text_display_set_buffer, "fl_text_display_set_buffer"); + function fl_text_display_get_text_color (TD : in System.Address) return Interfaces.C.int; @@ -84,12 +93,33 @@ package body FLTK.Widgets.Groups.Text_Displays is Interfaces.C.int (H), Interfaces.C.To_C (Label)); fl_group_end (VP); - return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); + return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP, Buffer => null); end Create; + function Get_Buffer + (TD : in Text_Display'Class) + return Text_Buffer_Access is + begin + return TD.Buffer; + end Get_Buffer; + + + + + procedure Set_Buffer + (TD : in out Text_Display'Class; + TB : in Text_Buffer_Access) is + begin + fl_text_display_set_buffer (TD.Void_Ptr, Wrapper (TB.all).Void_Ptr); + TD.Buffer := TB; + end Set_Buffer; + + + + function Get_Text_Color (TD : in Text_Display'Class) return Color is diff --git a/src/fltk_binding/fltk-widgets-groups-text_displays.ads b/src/fltk_binding/fltk-widgets-groups-text_displays.ads index bc50ae1..3481258 100644 --- a/src/fltk_binding/fltk-widgets-groups-text_displays.ads +++ b/src/fltk_binding/fltk-widgets-groups-text_displays.ads @@ -1,5 +1,6 @@ +with FLTK.Text_Buffers; use FLTK.Text_Buffers; with FLTK.Enums; use FLTK.Enums; @@ -7,6 +8,7 @@ package FLTK.Widgets.Groups.Text_Displays is type Text_Display is new Group with private; + type Text_Display_Access is access all Text_Display; function Create @@ -15,6 +17,16 @@ package FLTK.Widgets.Groups.Text_Displays is return Text_Display; + function Get_Buffer + (TD : in Text_Display'Class) + return Text_Buffer_Access; + + + procedure Set_Buffer + (TD : in out Text_Display'Class; + TB : in Text_Buffer_Access); + + function Get_Text_Color (TD : in Text_Display'Class) return Color; @@ -48,7 +60,10 @@ package FLTK.Widgets.Groups.Text_Displays is private - type Text_Display is new Group with null record; + type Text_Display is new Group with + record + Buffer : Text_Buffer_Access; + end record; overriding procedure Finalize diff --git a/src/fltk_binding/fltk-widgets-groups-windows-double.ads b/src/fltk_binding/fltk-widgets-groups-windows-double.ads index a276e48..5e93da1 100644 --- a/src/fltk_binding/fltk-widgets-groups-windows-double.ads +++ b/src/fltk_binding/fltk-widgets-groups-windows-double.ads @@ -4,6 +4,7 @@ package FLTK.Widgets.Groups.Windows.Double is type Double_Window is new Window with private; + type Double_Window_Access is access all Double_Window; function Create diff --git a/src/fltk_binding/fltk-widgets-groups-windows.ads b/src/fltk_binding/fltk-widgets-groups-windows.ads index 8c0f1e4..714d6dd 100644 --- a/src/fltk_binding/fltk-widgets-groups-windows.ads +++ b/src/fltk_binding/fltk-widgets-groups-windows.ads @@ -4,6 +4,7 @@ package FLTK.Widgets.Groups.Windows is type Window is new Group with private; + type Window_Access is access all Window; function Create diff --git a/src/fltk_binding/fltk-widgets-groups.ads b/src/fltk_binding/fltk-widgets-groups.ads index 61a2a6e..2c245a0 100644 --- a/src/fltk_binding/fltk-widgets-groups.ads +++ b/src/fltk_binding/fltk-widgets-groups.ads @@ -4,6 +4,9 @@ package FLTK.Widgets.Groups is type Group is new Widget with private; + type Group_Access is access all Group; + + type Index is new Integer; diff --git a/src/fltk_binding/fltk-widgets-inputs.ads b/src/fltk_binding/fltk-widgets-inputs.ads index 82a6915..b0b8ca8 100644 --- a/src/fltk_binding/fltk-widgets-inputs.ads +++ b/src/fltk_binding/fltk-widgets-inputs.ads @@ -4,6 +4,7 @@ package FLTK.Widgets.Inputs is type Input is new Widget with private; + type Input_Access is access all Input; function Create diff --git a/src/fltk_binding/fltk-widgets.adb b/src/fltk_binding/fltk-widgets.adb index ff46bb5..5529a6d 100644 --- a/src/fltk_binding/fltk-widgets.adb +++ b/src/fltk_binding/fltk-widgets.adb @@ -50,15 +50,6 @@ package body FLTK.Widgets is - procedure Initialize - (This : in out Widget) is - begin - This.Void_Ptr := System.Null_Address; - end Initialize; - - - - function Get_Box (W : in Widget'Class) return Box_Kind is diff --git a/src/fltk_binding/fltk-widgets.ads b/src/fltk_binding/fltk-widgets.ads index de9afdb..9c696ed 100644 --- a/src/fltk_binding/fltk-widgets.ads +++ b/src/fltk_binding/fltk-widgets.ads @@ -1,14 +1,13 @@ with FLTK.Enums; use FLTK.Enums; -with Ada.Finalization; -private with System; package FLTK.Widgets is - type Widget is abstract new Ada.Finalization.Limited_Controlled with private; + type Widget is abstract new Wrapper with private; + type Widget_Access is access all Widget; type Font_Size is new Natural; @@ -67,14 +66,7 @@ package FLTK.Widgets is private - type Widget is abstract new Ada.Finalization.Limited_Controlled with - record - Void_Ptr : System.Address; - end record; - - - overriding procedure Initialize - (This : in out Widget); + type Widget is abstract new Wrapper with null record; end FLTK.Widgets; diff --git a/src/fltk_binding/fltk.adb b/src/fltk_binding/fltk.adb index 674a54a..cc2d407 100644 --- a/src/fltk_binding/fltk.adb +++ b/src/fltk_binding/fltk.adb @@ -1,6 +1,7 @@ with Interfaces.C; +with System; package body FLTK is @@ -10,11 +11,22 @@ package body FLTK is pragma Import (C, fl_run, "fl_run"); + + function Run return Integer is begin return Integer (fl_run); end Run; + + + procedure Initialize + (This : in out Wrapper) is + begin + This.Void_Ptr := System.Null_Address; + end Initialize; + + end FLTK; diff --git a/src/fltk_binding/fltk.ads b/src/fltk_binding/fltk.ads index 33363df..51f05c1 100644 --- a/src/fltk_binding/fltk.ads +++ b/src/fltk_binding/fltk.ads @@ -1,10 +1,32 @@ +with Ada.Finalization; +private with System; + + package FLTK is function Run return Integer; + -- ugly implementation thing; never use this + -- just ignore the hand moving behind the curtain here + type Wrapper is abstract new Ada.Finalization.Limited_Controlled with private; + + +private + + + type Wrapper is abstract new Ada.Finalization.Limited_Controlled with + record + Void_Ptr : System.Address; + end record; + + + overriding procedure Initialize + (This : in out Wrapper); + + end FLTK; |