summaryrefslogtreecommitdiff
path: root/src/fltk_binding
diff options
context:
space:
mode:
Diffstat (limited to 'src/fltk_binding')
-rw-r--r--src/fltk_binding/c_fl_text_buffer.cpp16
-rw-r--r--src/fltk_binding/c_fl_text_buffer.h15
-rw-r--r--src/fltk_binding/c_fl_text_display.cpp14
-rw-r--r--src/fltk_binding/c_fl_text_display.h4
-rw-r--r--src/fltk_binding/fltk-text_buffers.adb50
-rw-r--r--src/fltk_binding/fltk-text_buffers.ads27
-rw-r--r--src/fltk_binding/fltk-widgets-boxes.ads1
-rw-r--r--src/fltk_binding/fltk-widgets-buttons-enter.ads1
-rw-r--r--src/fltk_binding/fltk-widgets-buttons-light-check.ads1
-rw-r--r--src/fltk_binding/fltk-widgets-buttons-light-radio.ads1
-rw-r--r--src/fltk_binding/fltk-widgets-buttons-light-round-radio.ads1
-rw-r--r--src/fltk_binding/fltk-widgets-buttons-light-round.ads1
-rw-r--r--src/fltk_binding/fltk-widgets-buttons-light.ads1
-rw-r--r--src/fltk_binding/fltk-widgets-buttons-radio.ads1
-rw-r--r--src/fltk_binding/fltk-widgets-buttons-repeat.ads1
-rw-r--r--src/fltk_binding/fltk-widgets-buttons-toggle.ads1
-rw-r--r--src/fltk_binding/fltk-widgets-buttons.ads3
-rw-r--r--src/fltk_binding/fltk-widgets-groups-text_displays.adb32
-rw-r--r--src/fltk_binding/fltk-widgets-groups-text_displays.ads17
-rw-r--r--src/fltk_binding/fltk-widgets-groups-windows-double.ads1
-rw-r--r--src/fltk_binding/fltk-widgets-groups-windows.ads1
-rw-r--r--src/fltk_binding/fltk-widgets-groups.ads3
-rw-r--r--src/fltk_binding/fltk-widgets-inputs.ads1
-rw-r--r--src/fltk_binding/fltk-widgets.adb9
-rw-r--r--src/fltk_binding/fltk-widgets.ads14
-rw-r--r--src/fltk_binding/fltk.adb12
-rw-r--r--src/fltk_binding/fltk.ads22
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;