From 6aa9475d598065081866913bb86a049a6d2d0c1a Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Mon, 18 Jul 2016 15:58:30 +1000 Subject: Decided on widget init problem, started on rudimentary editor appearance --- c_fl_group.cpp | 9 ++++----- c_fl_group.h | 1 - c_fl_widget.cpp | 10 ++++++++++ c_fl_widget.h | 2 ++ fltk-widgets-groups.adb | 5 ----- fltk-widgets.adb | 31 +++++++++++++++++++++++++++++++ fltk-widgets.ads | 10 ++++++++++ fltk.adb | 11 +++++++++++ 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(g)->end(); } + + void fl_group_add(GROUP g, WIDGET item) { reinterpret_cast(g)->add(reinterpret_cast(item)); } @@ -32,11 +36,6 @@ void fl_group_clear(GROUP g) { } -int fl_group_find(GROUP g, WIDGET item) { - return reinterpret_cast(g)->find(reinterpret_cast(item)); -} - - void fl_group_insert(GROUP g, WIDGET item, int place) { reinterpret_cast(g)->insert(*(reinterpret_cast(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(w)->label(); +} + + +void fl_widget_set_label(WIDGET w, const char* t) { + reinterpret_cast(w)->copy_label(t); +} + + int fl_widget_get_label_font(WIDGET w) { return reinterpret_cast(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; diff --git a/fltk.adb b/fltk.adb index cc2d407..aacb58b 100644 --- a/fltk.adb +++ b/fltk.adb @@ -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 diff --git a/fltk.ads b/fltk.ads index c1844a6..fab93e0 100644 --- a/fltk.ads +++ b/fltk.ads @@ -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 -- cgit