diff options
| -rw-r--r-- | adapad.gpr | 4 | ||||
| -rw-r--r-- | src/adapad.adb | 1 | ||||
| -rw-r--r-- | src/fltk_binding/c_fl_text_display.cpp | 46 | ||||
| -rw-r--r-- | src/fltk_binding/c_fl_text_display.h | 22 | ||||
| -rw-r--r-- | src/fltk_binding/fltk-widget-group-text_display.adb | 151 | ||||
| -rw-r--r-- | src/fltk_binding/fltk-widget-group-text_display.ads | 58 | ||||
| -rw-r--r-- | src/fltk_binding/fltk-widget-group.adb | 16 | ||||
| -rw-r--r-- | src/fltk_binding/fltk-widget-group.ads | 12 | ||||
| -rw-r--r-- | src/fltk_binding/fltk-widget.ads | 3 |
9 files changed, 299 insertions, 14 deletions
@@ -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) |