diff options
| -rw-r--r-- | c_fl_group.cpp | 9 | ||||
| -rw-r--r-- | c_fl_group.h | 1 | ||||
| -rw-r--r-- | c_fl_widget.cpp | 10 | ||||
| -rw-r--r-- | c_fl_widget.h | 2 | ||||
| -rw-r--r-- | fltk-widgets-groups.adb | 5 | ||||
| -rw-r--r-- | fltk-widgets.adb | 31 | ||||
| -rw-r--r-- | fltk-widgets.ads | 10 | ||||
| -rw-r--r-- | fltk.adb | 11 | ||||
| -rw-r--r-- | fltk.ads | 11 |
9 files changed, 78 insertions, 12 deletions
diff --git a/c_fl_group.cpp b/c_fl_group.cpp index c227169..58cb6f3 100644 --- a/c_fl_group.cpp +++ b/c_fl_group.cpp @@ -17,11 +17,15 @@ void free_fl_group(GROUP g) { } + + void fl_group_end(GROUP g) { reinterpret_cast<Fl_Group*>(g)->end(); } + + void fl_group_add(GROUP g, WIDGET item) { reinterpret_cast<Fl_Group*>(g)->add(reinterpret_cast<Fl_Widget*>(item)); } @@ -32,11 +36,6 @@ void fl_group_clear(GROUP g) { } -int fl_group_find(GROUP g, WIDGET item) { - return reinterpret_cast<Fl_Group*>(g)->find(reinterpret_cast<Fl_Widget*>(item)); -} - - void fl_group_insert(GROUP g, WIDGET item, int place) { reinterpret_cast<Fl_Group*>(g)->insert(*(reinterpret_cast<Fl_Widget*>(item)), place); } diff --git a/c_fl_group.h b/c_fl_group.h index d75641e..ccd00e7 100644 --- a/c_fl_group.h +++ b/c_fl_group.h @@ -16,7 +16,6 @@ extern "C" void fl_group_end(GROUP g); extern "C" void fl_group_add(GROUP g, WIDGET item); extern "C" void fl_group_clear(GROUP g); -extern "C" int fl_group_find(GROUP g, WIDGET item); extern "C" void fl_group_insert(GROUP g, WIDGET item, int place); extern "C" void fl_group_remove(GROUP g, WIDGET item); extern "C" void fl_group_remove2(GROUP g, int place); diff --git a/c_fl_widget.cpp b/c_fl_widget.cpp index 53c14c8..9acc52f 100644 --- a/c_fl_widget.cpp +++ b/c_fl_widget.cpp @@ -14,6 +14,16 @@ void fl_widget_set_box(WIDGET w, int b) { } +const char* fl_widget_get_label(WIDGET w) { + return reinterpret_cast<Fl_Widget*>(w)->label(); +} + + +void fl_widget_set_label(WIDGET w, const char* t) { + reinterpret_cast<Fl_Widget*>(w)->copy_label(t); +} + + int fl_widget_get_label_font(WIDGET w) { return reinterpret_cast<Fl_Widget*>(w)->labelfont(); } diff --git a/c_fl_widget.h b/c_fl_widget.h index 423e66c..bfca2a1 100644 --- a/c_fl_widget.h +++ b/c_fl_widget.h @@ -9,6 +9,8 @@ typedef void* WIDGET; extern "C" int fl_widget_get_box(WIDGET w); extern "C" void fl_widget_set_box(WIDGET w, int b); +extern "C" const char* fl_widget_get_label(WIDGET w); +extern "C" void fl_widget_set_label(WIDGET w, const char* t); extern "C" int fl_widget_get_label_font(WIDGET w); extern "C" void fl_widget_set_label_font(WIDGET w, int f); extern "C" int fl_widget_get_label_size(WIDGET w); diff --git a/fltk-widgets-groups.adb b/fltk-widgets-groups.adb index b515cc5..2f38541 100644 --- a/fltk-widgets-groups.adb +++ b/fltk-widgets-groups.adb @@ -32,11 +32,6 @@ package body FLTK.Widgets.Groups is (G : in System.Address); pragma Import (C, fl_group_clear, "fl_group_clear"); - -- function fl_group_find - -- (G, W : in System.Address) - -- return Interfaces.C.int; - -- pragma Import (C, fl_group_find, "fl_group_find"); - procedure fl_group_insert (G, W : in System.Address; P : in Interfaces.C.int); diff --git a/fltk-widgets.adb b/fltk-widgets.adb index 39ffb66..cffd3f7 100644 --- a/fltk-widgets.adb +++ b/fltk-widgets.adb @@ -1,6 +1,7 @@ with Interfaces.C; +with Interfaces.C.Strings; with System; with FLTK.Widgets.Groups; @@ -18,6 +19,16 @@ package body FLTK.Widgets is B : in Interfaces.C.int); pragma Import (C, fl_widget_set_box, "fl_widget_set_box"); + function fl_widget_get_label + (W : in System.Address) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, fl_widget_get_label, "fl_widget_get_label"); + + procedure fl_widget_set_label + (W : in System.Address; + T : in Interfaces.C.char_array); + pragma Import (C, fl_widget_set_label, "fl_widget_set_label"); + function fl_widget_get_label_font (W : in System.Address) return Interfaces.C.int; @@ -92,6 +103,26 @@ package body FLTK.Widgets is + function Get_Label + (This : in out Widget) + return String is + begin + return Interfaces.C.Strings.Value (fl_widget_get_label (This.Void_Ptr)); + end Get_Label; + + + + + procedure Set_Label + (This : in out Widget; + Text : in String) is + begin + fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); + end Set_Label; + + + + function Get_Label_Font (This : in Widget) return Font_Kind is diff --git a/fltk-widgets.ads b/fltk-widgets.ads index 9910dee..8108a5d 100644 --- a/fltk-widgets.ads +++ b/fltk-widgets.ads @@ -43,6 +43,16 @@ package FLTK.Widgets is Box : in Box_Kind); + function Get_Label + (This : in out Widget) + return String; + + + procedure Set_Label + (This : in out Widget; + Text : in String); + + function Get_Label_Font (This : in Widget) return Font_Kind; @@ -2,6 +2,7 @@ with Interfaces.C; with System; +use type System.Address; package body FLTK is @@ -21,6 +22,16 @@ package body FLTK is + function Has_Valid_Ptr + (This : in Wrapper) + return Boolean is + begin + return This.Void_Ptr /= System.Null_Address; + end Has_Valid_Ptr; + + + + procedure Initialize (This : in out Wrapper) is begin @@ -20,10 +20,19 @@ package FLTK is private + function Has_Valid_Ptr + (This : in Wrapper) + return Boolean; + + type Wrapper is abstract new Ada.Finalization.Limited_Controlled with record Void_Ptr : System.Address; - end record; + end record + with Type_Invariant => Has_Valid_Ptr (Wrapper); + + -- unsure if the above invariant is doing what I'm after + -- oh well, something to work on overriding procedure Initialize |