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_display.cpp46
-rw-r--r--src/fltk_binding/c_fl_text_display.h22
-rw-r--r--src/fltk_binding/fltk-widget-group-text_display.adb151
-rw-r--r--src/fltk_binding/fltk-widget-group-text_display.ads58
-rw-r--r--src/fltk_binding/fltk-widget-group.adb16
-rw-r--r--src/fltk_binding/fltk-widget-group.ads12
-rw-r--r--src/fltk_binding/fltk-widget.ads3
7 files changed, 294 insertions, 14 deletions
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)
generated by cgit (git 2.30.0) at 2024-12-23 08:57:22 +0000