From d513fd809229d6d48bd061e494b08cafbbcc6f9c 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 --- src/adapad.adb | 10 ++++------ src/editors.adb | 18 +++++------------- src/editors.ads | 24 ++++++++---------------- src/fltk_binding/c_fl_group.cpp | 9 ++++----- src/fltk_binding/c_fl_group.h | 1 - src/fltk_binding/c_fl_widget.cpp | 10 ++++++++++ src/fltk_binding/c_fl_widget.h | 2 ++ src/fltk_binding/fltk-widgets-groups.adb | 5 ----- src/fltk_binding/fltk-widgets.adb | 31 +++++++++++++++++++++++++++++++ src/fltk_binding/fltk-widgets.ads | 10 ++++++++++ src/fltk_binding/fltk.adb | 11 +++++++++++ src/fltk_binding/fltk.ads | 11 ++++++++++- 12 files changed, 95 insertions(+), 47 deletions(-) diff --git a/src/adapad.adb b/src/adapad.adb index cf5b02e..340403e 100644 --- a/src/adapad.adb +++ b/src/adapad.adb @@ -3,24 +3,22 @@ with FLTK; with Editors; use Editors; -with FLTK.Widgets.Groups.Windows.Double; -use FLTK.Widgets.Groups.Windows.Double; -with Ada.Text_IO; use Ada.Text_IO; +with FLTK.Text_Buffers; +use FLTK.Text_Buffers; function AdaPad return Integer is - --Pad : Double_Window := Create (0, 0, 640, 400, "AdaPad"); Pad : Editor_Window := Create (0, 0, 640, 400, "AdaPad"); + Buffer : Text_Buffer := Create; begin - Put_Line ("About to show"); + Pad.Set_Buffer (Buffer); Pad.Show; - Put_Line ("About to run"); return FLTK.Run; diff --git a/src/editors.adb b/src/editors.adb index 1ce7a92..3cdfa5f 100644 --- a/src/editors.adb +++ b/src/editors.adb @@ -1,8 +1,5 @@ -with FLTK.Widgets.Groups.Windows.Double; - - package body Editors is @@ -11,16 +8,11 @@ package body Editors is Label_Text : in String) return Editor_Window is begin - return FLTK.Widgets.Groups.Windows.Double.Create (0, 0, 640, 400, "AdaPad"); - --return This : Editor_Window do - --This.Replace_Dialog := FLTK.Widgets.Groups.Windows.Create (300, 105, "Replace"); - --This.Replace_Find := Create (70, 10, 200, 25, "Find:"); - --This.Replace_With := Create (70, 40, 200, 25, "Replace:"); - --This.Replace_All := Create (10, 70, 90, 25, "Replace All"); - --This.Replace_Next := Create (105, 70, 120, 25, "Replace Next"); - --This.Replace_Cancel := Create (230, 70, 60, 25, "Cancel"); - --This.The_Editor := Create (0, 30, 640, 370, Label_Text); - --end return; + return This : Editor_Window := + (Double_Window'(Create (X, Y, W, H, Label_Text)) with + The_Editor => Text_Editor'(Create (0, 30, 640, 370, ""))) do + This.Add (This.The_Editor); + end return; end Create; diff --git a/src/editors.ads b/src/editors.ads index 41e6b07..9dde658 100644 --- a/src/editors.ads +++ b/src/editors.ads @@ -1,15 +1,7 @@ -with FLTK.Widgets.Groups.Windows; -use FLTK.Widgets.Groups.Windows; with FLTK.Widgets.Groups.Windows.Double; use FLTK.Widgets.Groups.Windows.Double; -with FLTK.Widgets.Inputs; -use FLTK.Widgets.Inputs; -with FLTK.Widgets.Buttons; -use FLTK.Widgets.Buttons; -with FLTK.Widgets.Buttons.Enter; -use FLTK.Widgets.Buttons.Enter; with FLTK.Widgets.Groups.Text_Displays.Text_Editors; use FLTK.Widgets.Groups.Text_Displays.Text_Editors; with FLTK.Text_Buffers; @@ -48,14 +40,14 @@ private type Editor_Window is new Double_Window with record - --Replace_Dialog : Window; - --Replace_Find : Input; - --Replace_With : Input; - --Replace_All : Button; - --Replace_Next : Enter_Button; - --Replace_Cancel : Button; - - The_Editor : Text_Editor := FLTK.Widgets.Groups.Text_Displays.Text_Editors.Create (0, 30, 640, 370, "AdaPad"); + -- Replace_Dialog : Window; + -- Replace_Find : Input; + -- Replace_With : Input; + -- Replace_All : Button; + -- Replace_Next : Enter_Button; + -- Replace_Cancel : Button; + + The_Editor : Text_Editor := Text_Editor'(Create (0, 30, 640, 370, "AdaPad")); end record; diff --git a/src/fltk_binding/c_fl_group.cpp b/src/fltk_binding/c_fl_group.cpp index c227169..58cb6f3 100644 --- a/src/fltk_binding/c_fl_group.cpp +++ b/src/fltk_binding/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/src/fltk_binding/c_fl_group.h b/src/fltk_binding/c_fl_group.h index d75641e..ccd00e7 100644 --- a/src/fltk_binding/c_fl_group.h +++ b/src/fltk_binding/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/src/fltk_binding/c_fl_widget.cpp b/src/fltk_binding/c_fl_widget.cpp index 53c14c8..9acc52f 100644 --- a/src/fltk_binding/c_fl_widget.cpp +++ b/src/fltk_binding/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/src/fltk_binding/c_fl_widget.h b/src/fltk_binding/c_fl_widget.h index 423e66c..bfca2a1 100644 --- a/src/fltk_binding/c_fl_widget.h +++ b/src/fltk_binding/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/src/fltk_binding/fltk-widgets-groups.adb b/src/fltk_binding/fltk-widgets-groups.adb index b515cc5..2f38541 100644 --- a/src/fltk_binding/fltk-widgets-groups.adb +++ b/src/fltk_binding/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/src/fltk_binding/fltk-widgets.adb b/src/fltk_binding/fltk-widgets.adb index 39ffb66..cffd3f7 100644 --- a/src/fltk_binding/fltk-widgets.adb +++ b/src/fltk_binding/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/src/fltk_binding/fltk-widgets.ads b/src/fltk_binding/fltk-widgets.ads index 9910dee..8108a5d 100644 --- a/src/fltk_binding/fltk-widgets.ads +++ b/src/fltk_binding/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/src/fltk_binding/fltk.adb b/src/fltk_binding/fltk.adb index cc2d407..aacb58b 100644 --- a/src/fltk_binding/fltk.adb +++ b/src/fltk_binding/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/src/fltk_binding/fltk.ads b/src/fltk_binding/fltk.ads index c1844a6..fab93e0 100644 --- a/src/fltk_binding/fltk.ads +++ b/src/fltk_binding/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