Some more bindings

9 files changed, 299 insertions, 14 deletions

diff --git a/adapad.gpr b/adapad.gpr
index cef942e..a4efd08 100644
--- a/adapad.gpr
+++ b/adapad.gpr
@@ -1,5 +1,9 @@
 
 
+--  goal is for executable to be no more than 90-100kB
+--  when dynamically linked, to match leafpad
+
+
 project AdaPad is
 
 
diff --git a/src/adapad.adb b/src/adapad.adb
index a2fe4c5..271b77d 100644
--- a/src/adapad.adb
+++ b/src/adapad.adb
@@ -3,6 +3,7 @@
 --  with Editor;
 with FLTK.Widget.Group.Window.Double;
 with FLTK.Widget.Box;
+with FLTK.Widget.Group.Text_Display;
 with FLTK.Enums; use FLTK.Enums;
 
 
diff --git a/src/fltk_binding/c_fl_text_display.cpp b/src/fltk_binding/c_fl_text_display.cpp
new file mode 100644
index 0000000..72fd5c9
--- /dev/null
+++ b/src/fltk_binding/c_fl_text_display.cpp
@@ -0,0 +1,46 @@
+
+
+#include <FL/Fl_Text_Display.H>
+#include "c_fl_text_display.h"
+
+
+my_fl_text_display new_fl_text_display(int x, int y, int w, int h, char *  label) {
+    Fl_Text_Display *text = new Fl_Text_Display(x, y, w, h, label);
+    return text;
+}
+
+
+void free_fl_text_display(my_fl_text_display td) {
+    delete reinterpret_cast<Fl_Text_Display*>(td);
+}
+
+
+int fl_text_display_get_text_color(my_fl_text_display td) {
+    return reinterpret_cast<Fl_Text_Display*>(td)->textcolor();
+}
+
+
+void fl_text_display_set_text_color(my_fl_text_display td, int c) {
+    reinterpret_cast<Fl_Text_Display*>(td)->textcolor(static_cast<Fl_Color>(c));
+}
+
+
+int fl_text_display_get_text_font(my_fl_text_display td) {
+    return reinterpret_cast<Fl_Text_Display*>(td)->textfont();
+}
+
+
+void fl_text_display_set_text_font(my_fl_text_display td, int f) {
+    reinterpret_cast<Fl_Text_Display*>(td)->textfont(static_cast<Fl_Font>(f));
+}
+
+
+int fl_text_display_get_text_size(my_fl_text_display td) {
+    return reinterpret_cast<Fl_Text_Display*>(td)->textsize();
+}
+
+
+void fl_text_display_set_text_size(my_fl_text_display td, int s) {
+    reinterpret_cast<Fl_Text_Display*>(td)->textsize(static_cast<Fl_Fontsize>(s));
+}
+
diff --git a/src/fltk_binding/c_fl_text_display.h b/src/fltk_binding/c_fl_text_display.h
new file mode 100644
index 0000000..57812d2
--- /dev/null
+++ b/src/fltk_binding/c_fl_text_display.h
@@ -0,0 +1,22 @@
+
+
+#ifndef FL_TEXT_DISPLAY_GUARD
+#define FL_TEXT_DISPLAY_GUARD
+
+
+typedef void* my_fl_text_display;
+
+
+extern "C" my_fl_text_display new_fl_text_display(int x, int y, int w, int h, char * label);
+extern "C" void free_fl_text_display(my_fl_text_display td);
+
+extern "C" int fl_text_display_get_text_color(my_fl_text_display td);
+extern "C" void fl_text_display_set_text_color(my_fl_text_display td, int c);
+extern "C" int fl_text_display_get_text_font(my_fl_text_display td);
+extern "C" void fl_text_display_set_text_font(my_fl_text_display td, int f);
+extern "C" int fl_text_display_get_text_size(my_fl_text_display td);
+extern "C" void fl_text_display_set_text_size(my_fl_text_display td, int s);
+
+
+#endif
+
diff --git a/src/fltk_binding/fltk-widget-group-text_display.adb b/src/fltk_binding/fltk-widget-group-text_display.adb
new file mode 100644
index 0000000..e558d9a
--- /dev/null
+++ b/src/fltk_binding/fltk-widget-group-text_display.adb
@@ -0,0 +1,151 @@
+
+
+with Interfaces.C;
+with System;
+use type System.Address;
+
+
+package body FLTK.Widget.Group.Text_Display is
+
+
+    function new_fl_text_display
+           (X, Y, W, H : in Interfaces.C.int;
+            L          : in Interfaces.C.char_array)
+        return System.Address;
+    pragma Import (C, new_fl_text_display, "new_fl_text_display");
+
+    procedure free_fl_text_display
+           (TD : in System.Address);
+    pragma Import (C, free_fl_text_display, "free_fl_text_display");
+
+    function fl_text_display_get_text_color
+           (TD : in System.Address)
+        return Interfaces.C.int;
+    pragma Import (C, fl_text_display_get_text_color, "fl_text_display_get_text_color");
+
+    procedure fl_text_display_set_text_color
+           (TD : in System.Address;
+            C  : in Interfaces.C.int);
+    pragma Import (C, fl_text_display_set_text_color, "fl_text_display_set_text_color");
+
+    function fl_text_display_get_text_font
+           (TD : in System.Address)
+        return Interfaces.C.int;
+    pragma Import (C, fl_text_display_get_text_font, "fl_text_display_get_text_font");
+
+    procedure fl_text_display_set_text_font
+           (TD : in System.Address;
+            F  : in Interfaces.C.int);
+    pragma Import (C, fl_text_display_set_text_font, "fl_text_display_set_text_font");
+
+    function fl_text_display_get_text_size
+           (TD : in System.Address)
+        return Interfaces.C.int;
+    pragma Import (C, fl_text_display_get_text_size, "fl_text_display_get_text_size");
+
+    procedure fl_text_display_set_text_size
+           (TD : in System.Address;
+            S  : in Interfaces.C.int);
+    pragma Import (C, fl_text_display_set_text_size, "fl_text_display_set_text_size");
+
+
+
+
+    procedure fl_group_end
+           (G : in System.Address);
+    pragma Import (C, fl_group_end, "fl_group_end");
+
+
+
+
+    procedure Finalize (This : in out Text_Display_Type) is
+    begin
+        if (This.Void_Ptr /= System.Null_Address) then
+            free_fl_text_display (This.Void_Ptr);
+        end if;
+    end Finalize;
+
+
+
+
+    function Create
+           (X, Y, W, H : in Integer;
+            Label      : in String)
+        return Text_Display_Type is
+
+        VP : System.Address;
+
+    begin
+        VP := new_fl_text_display
+                   (Interfaces.C.int (X),
+                    Interfaces.C.int (Y),
+                    Interfaces.C.int (W),
+                    Interfaces.C.int (H),
+                    Interfaces.C.To_C (Label));
+        fl_group_end (VP);
+        return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP);
+    end Create;
+
+
+
+
+    function Get_Text_Color
+           (TD : in Text_Display_Type)
+        return Color is
+    begin
+        return Color (fl_text_display_get_text_color (TD.Void_Ptr));
+    end Get_Text_Color;
+
+
+
+
+    procedure Set_Text_Color
+           (TD : in Text_Display_Type;
+            C : in Color) is
+    begin
+        fl_text_display_set_text_color (TD.Void_Ptr, Interfaces.C.int (C));
+    end Set_Text_Color;
+
+
+
+
+    function Get_Text_Font
+           (TD : in Text_Display_Type)
+        return Font_Kind is
+    begin
+        return Font_Kind'Val (fl_text_display_get_text_font (TD.Void_Ptr));
+    end Get_Text_Font;
+
+
+
+
+    procedure Set_Text_Font
+           (TD : in Text_Display_Type;
+            F : in Font_Kind) is
+    begin
+        fl_text_display_set_text_font (TD.Void_Ptr, Font_Kind'Pos (F));
+    end Set_Text_Font;
+
+
+
+
+    function Get_Text_Size
+           (TD : in Text_Display_Type)
+        return Font_Size is
+    begin
+        return Font_Size (fl_text_display_get_text_size (TD.Void_Ptr));
+    end Get_Text_Size;
+
+
+
+
+    procedure Set_Text_Size
+           (TD : in Text_Display_Type;
+            S : in Font_Size) is
+    begin
+        fl_text_display_set_text_size (TD.Void_Ptr, Interfaces.C.int (S));
+    end Set_Text_Size;
+
+
+end FLTK.Widget.Group.Text_Display;
+
diff --git a/src/fltk_binding/fltk-widget-group-text_display.ads b/src/fltk_binding/fltk-widget-group-text_display.ads
new file mode 100644
index 0000000..adbbeb4
--- /dev/null
+++ b/src/fltk_binding/fltk-widget-group-text_display.ads
@@ -0,0 +1,58 @@
+
+
+with FLTK.Enums; use FLTK.Enums;
+
+
+package FLTK.Widget.Group.Text_Display is
+
+
+    type Text_Display_Type is new Group_Type with private;
+
+
+    function Create
+           (X, Y, W, H : in Integer;
+            Label      : in String)
+        return Text_Display_Type;
+
+
+    function Get_Text_Color
+           (TD : in Text_Display_Type)
+        return Color;
+
+
+    procedure Set_Text_Color
+           (TD : in Text_Display_Type;
+            C : in Color);
+
+
+    function Get_Text_Font
+           (TD : in Text_Display_Type)
+        return Font_Kind;
+
+
+    procedure Set_Text_Font
+           (TD : in Text_Display_Type;
+            F : in Font_Kind);
+
+
+    function Get_Text_Size
+           (TD : in Text_Display_Type)
+        return Font_Size;
+
+
+    procedure Set_Text_Size
+           (TD : in Text_Display_Type;
+            S : in Font_Size);
+
+
+private
+
+
+    type Text_Display_Type is new Group_Type with null record;
+
+
+    overriding procedure Finalize (This : in out Text_Display_Type);
+
+
+end FLTK.Widget.Group.Text_Display;
+
diff --git a/src/fltk_binding/fltk-widget-group.adb b/src/fltk_binding/fltk-widget-group.adb
index b6db1f9..76414b7 100644
--- a/src/fltk_binding/fltk-widget-group.adb
+++ b/src/fltk_binding/fltk-widget-group.adb
@@ -63,8 +63,8 @@ package body FLTK.Widget.Group is
 
 
     function Create
-           (X, Y, W, H : Integer;
-            Label      : String)
+           (X, Y, W, H : in Integer;
+            Label      : in String)
         return Group_Type is
 
         VP : System.Address;
@@ -84,7 +84,7 @@ package body FLTK.Widget.Group is
 
 
     procedure Add
-           (This : Group_Type;
+           (This : Group_Type'Class;
             Item : Widget_Type'Class) is
     begin
         fl_group_add (This.Void_Ptr, Item.Void_Ptr);
@@ -94,7 +94,7 @@ package body FLTK.Widget.Group is
 
 
     procedure Clear
-           (This : Group_Type) is
+           (This : Group_Type'Class) is
     begin
         fl_group_clear (This.Void_Ptr);
     end Clear;
@@ -103,7 +103,7 @@ package body FLTK.Widget.Group is
 
 
     function Find
-           (This : Group_Type;
+           (This : Group_Type'Class;
             Item : Widget_Type'Class)
         return Index is
     begin
@@ -114,7 +114,7 @@ package body FLTK.Widget.Group is
 
 
     procedure Insert
-           (This  : Group_Type;
+           (This  : Group_Type'Class;
             Item  : Widget_Type'Class;
             Place : Index) is
     begin
@@ -128,7 +128,7 @@ package body FLTK.Widget.Group is
 
 
     procedure Remove
-           (This : Group_Type;
+           (This : Group_Type'Class;
             Item : Widget_Type'Class) is
     begin
         fl_group_remove (This.Void_Ptr, Item.Void_Ptr);
@@ -138,7 +138,7 @@ package body FLTK.Widget.Group is
 
 
     procedure Remove
-           (This  : Group_Type;
+           (This  : Group_Type'Class;
             Place : Index) is
     begin
         fl_group_remove2 (This.Void_Ptr, Interfaces.C.int (Place));
diff --git a/src/fltk_binding/fltk-widget-group.ads b/src/fltk_binding/fltk-widget-group.ads
index 689d798..d71f76c 100644
--- a/src/fltk_binding/fltk-widget-group.ads
+++ b/src/fltk_binding/fltk-widget-group.ads
@@ -14,33 +14,33 @@ package FLTK.Widget.Group is
 
 
     procedure Add
-           (This : Group_Type;
+           (This : Group_Type'Class;
             Item : Widget_Type'Class);
 
 
     procedure Clear
-           (This : Group_Type);
+           (This : Group_Type'Class);
 
 
     function Find
-           (This : Group_Type;
+           (This : Group_Type'Class;
             Item : Widget_Type'Class)
         return Index;
 
 
     procedure Insert
-           (This  : Group_Type;
+           (This  : Group_Type'Class;
             Item  : Widget_Type'Class;
             Place : Index);
 
 
     procedure Remove
-           (This : Group_Type;
+           (This : Group_Type'Class;
             Item : Widget_Type'Class);
 
 
     procedure Remove
-           (This  : Group_Type;
+           (This  : Group_Type'Class;
             Place : Index);
 
 
diff --git a/src/fltk_binding/fltk-widget.ads b/src/fltk_binding/fltk-widget.ads
index a8b2b27..ef4650e 100644
--- a/src/fltk_binding/fltk-widget.ads
+++ b/src/fltk_binding/fltk-widget.ads
@@ -15,6 +15,9 @@ package FLTK.Widget is
     Normal_Size : constant Font_Size := 14;
 
 
+    type Color is new Natural;
+
+
     function Create
            (X, Y, W, H : in Integer;
             Label      : in String)