Text buffers, access types and line lengths

28 files changed, 230 insertions, 23 deletions

diff --git a/adapad.gpr b/adapad.gpr
index a4efd08..c5128a4 100644
--- a/adapad.gpr
+++ b/adapad.gpr
@@ -22,7 +22,7 @@ project AdaPad is
 
 
     package Compiler is
-        for Default_Switches("Ada") use ("-gnaty4aAbcefhiklmnprt");
+        for Default_Switches("Ada") use ("-gnaty4aAbcefhiklM99nprt");
         for Default_Switches("C++") use ("-Wall","-Wextra");
     end Compiler;
 
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;