Text editors, single and menu windows

16 files changed, 630 insertions, 7 deletions

diff --git a/src/adapad.adb b/src/adapad.adb
index 63ad67f..164f9c3 100644
--- a/src/adapad.adb
+++ b/src/adapad.adb
@@ -2,6 +2,7 @@
 
 --  with Editor;
 with FLTK.Widgets.Groups.Windows.Double;
+with FLTK.Widgets.Groups.Windows.Single.Menu;
 with FLTK.Widgets.Boxes;
 with FLTK.Widgets.Buttons.Enter;
 with FLTK.Widgets.Buttons.Light.Check;
@@ -11,7 +12,7 @@ with FLTK.Widgets.Buttons.Radio;
 with FLTK.Widgets.Buttons.Repeat;
 with FLTK.Widgets.Buttons.Toggle;
 with FLTK.Widgets.Inputs;
-with FLTK.Widgets.Groups.Text_Displays;
+with FLTK.Widgets.Groups.Text_Displays.Text_Editors;
 with FLTK.Enums; use FLTK.Enums;
 
 
diff --git a/src/fltk_binding/c_fl_menu_window.cpp b/src/fltk_binding/c_fl_menu_window.cpp
new file mode 100644
index 0000000..66ad6f3
--- /dev/null
+++ b/src/fltk_binding/c_fl_menu_window.cpp
@@ -0,0 +1,52 @@
+
+
+#include <FL/Fl_Menu_Window.H>
+#include "c_fl_menu_window.h"
+
+
+MENUWINDOW new_fl_menu_window(int x, int y, int w, int h, char* label) {
+    Fl_Menu_Window *m = new Fl_Menu_Window(x, y, w, h, label);
+    return m;
+}
+
+
+MENUWINDOW new_fl_menu_window2(int w, int h) {
+    Fl_Menu_Window *m = new Fl_Menu_Window(w, h);
+    return m;
+}
+
+
+void free_fl_menu_window(MENUWINDOW m) {
+    delete reinterpret_cast<Fl_Menu_Window*>(m);
+}
+
+
+void fl_menu_window_show(MENUWINDOW m) {
+    reinterpret_cast<Fl_Menu_Window*>(m)->show();
+}
+
+
+void fl_menu_window_hide(MENUWINDOW m) {
+    reinterpret_cast<Fl_Menu_Window*>(m)->hide();
+}
+
+
+void fl_menu_window_flush(MENUWINDOW m) {
+    reinterpret_cast<Fl_Menu_Window*>(m)->flush();
+}
+
+
+void fl_menu_window_set_overlay(MENUWINDOW m) {
+    reinterpret_cast<Fl_Menu_Window*>(m)->set_overlay();
+}
+
+
+void fl_menu_window_clear_overlay(MENUWINDOW m) {
+    reinterpret_cast<Fl_Menu_Window*>(m)->clear_overlay();
+}
+
+
+unsigned int fl_menu_window_overlay(MENUWINDOW m) {
+    return reinterpret_cast<Fl_Menu_Window*>(m)->overlay();
+}
+
diff --git a/src/fltk_binding/c_fl_menu_window.h b/src/fltk_binding/c_fl_menu_window.h
new file mode 100644
index 0000000..3322b29
--- /dev/null
+++ b/src/fltk_binding/c_fl_menu_window.h
@@ -0,0 +1,23 @@
+
+
+#ifndef FL_MENU_WINDOW_GUARD
+#define FL_MENU_WINDOW_GUARD
+
+
+typedef void* MENUWINDOW;
+
+
+extern "C" MENUWINDOW new_fl_menu_window(int x, int y, int w, int h, char* label);
+extern "C" MENUWINDOW new_fl_menu_window2(int w, int h);
+extern "C" void free_fl_menu_window(MENUWINDOW m);
+
+extern "C" void fl_menu_window_show(MENUWINDOW m);
+extern "C" void fl_menu_window_hide(MENUWINDOW m);
+extern "C" void fl_menu_window_flush(MENUWINDOW m);
+extern "C" void fl_menu_window_set_overlay(MENUWINDOW m);
+extern "C" void fl_menu_window_clear_overlay(MENUWINDOW m);
+extern "C" unsigned int fl_menu_window_overlay(MENUWINDOW m);
+
+
+#endif
+
diff --git a/src/fltk_binding/c_fl_single_window.cpp b/src/fltk_binding/c_fl_single_window.cpp
new file mode 100644
index 0000000..ec9a315
--- /dev/null
+++ b/src/fltk_binding/c_fl_single_window.cpp
@@ -0,0 +1,32 @@
+
+
+#include <FL/Fl_Single_Window.H>
+#include "c_fl_single_window.h"
+
+
+SINGLEWINDOW new_fl_single_window(int x, int y, int w, int h, char* label) {
+    Fl_Single_Window *sw = new Fl_Single_Window(x, y, w, h, label);
+    return sw;
+}
+
+
+SINGLEWINDOW new_fl_single_window2(int x, int y) {
+    Fl_Single_Window *sw = new Fl_Single_Window(x, y);
+    return sw;
+}
+
+
+void free_fl_single_window(SINGLEWINDOW w) {
+    delete reinterpret_cast<Fl_Single_Window*>(w);
+}
+
+
+void fl_single_window_show(SINGLEWINDOW w) {
+    reinterpret_cast<Fl_Single_Window*>(w)->show();
+}
+
+
+void fl_single_window_flush(SINGLEWINDOW w) {
+    reinterpret_cast<Fl_Single_Window*>(w)->flush();
+}
+
diff --git a/src/fltk_binding/c_fl_single_window.h b/src/fltk_binding/c_fl_single_window.h
new file mode 100644
index 0000000..96f6d5b
--- /dev/null
+++ b/src/fltk_binding/c_fl_single_window.h
@@ -0,0 +1,19 @@
+
+
+#ifndef FL_SINGLE_WINDOW_GUARD
+#define FL_SINGLE_WINDOW_GUARD
+
+
+typedef void* SINGLEWINDOW;
+
+
+extern "C" SINGLEWINDOW new_fl_single_window(int x, int y, int w, int h, char* label);
+extern "C" SINGLEWINDOW new_fl_single_window2(int x, int y);
+extern "C" void free_fl_single_window(SINGLEWINDOW w);
+
+extern "C" void fl_single_window_show(SINGLEWINDOW w);
+extern "C" void fl_single_window_flush(SINGLEWINDOW w);
+
+
+#endif
+
diff --git a/src/fltk_binding/c_fl_text_editor.cpp b/src/fltk_binding/c_fl_text_editor.cpp
new file mode 100644
index 0000000..797035e
--- /dev/null
+++ b/src/fltk_binding/c_fl_text_editor.cpp
@@ -0,0 +1,16 @@
+
+
+#include <FL/Fl_Text_Editor.H>
+#include "c_fl_text_editor.h"
+
+
+TEXTEDITOR new_fl_text_editor(int x, int y, int w, int h, char* label) {
+    Fl_Text_Editor *te = new Fl_Text_Editor(x, y, w, h, label);
+    return te;
+}
+
+
+void free_fl_text_editor(TEXTEDITOR te) {
+    delete reinterpret_cast<Fl_Text_Editor*>(te);
+}
+
diff --git a/src/fltk_binding/c_fl_text_editor.h b/src/fltk_binding/c_fl_text_editor.h
new file mode 100644
index 0000000..2eda9f3
--- /dev/null
+++ b/src/fltk_binding/c_fl_text_editor.h
@@ -0,0 +1,15 @@
+
+
+#ifndef FL_TEXT_EDITOR_GUARD
+#define FL_TEXT_EDITOR_GUARD
+
+
+typedef void* TEXTEDITOR;
+
+
+extern "C" TEXTEDITOR new_fl_text_editor(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_text_editor(TEXTEDITOR te);
+
+
+#endif
+
diff --git a/src/fltk_binding/fltk-widgets-groups-text_displays-text_editors.adb b/src/fltk_binding/fltk-widgets-groups-text_displays-text_editors.adb
new file mode 100644
index 0000000..ccf3a94
--- /dev/null
+++ b/src/fltk_binding/fltk-widgets-groups-text_displays-text_editors.adb
@@ -0,0 +1,62 @@
+
+
+with Interfaces.C;
+with System;
+use type System.Address;
+
+
+package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is
+
+
+    function new_fl_text_editor
+           (X, Y, W, H : in Interfaces.C.int;
+            Label      : in Interfaces.C.char_array)
+        return System.Address;
+    pragma Import (C, new_fl_text_editor, "new_fl_text_editor");
+
+    procedure free_fl_text_editor
+           (TE : in System.Address);
+    pragma Import (C, free_fl_text_editor, "free_fl_text_editor");
+
+
+
+
+    procedure fl_group_end
+           (TE : in System.Address);
+    pragma Import (C, fl_group_end, "fl_group_end");
+
+
+
+
+    procedure Finalize
+           (This : in out Text_Editor) is
+    begin
+        if (This.Void_Ptr /= System.Null_Address) then
+            free_fl_text_editor (This.Void_Ptr);
+        end if;
+    end Finalize;
+
+
+
+
+    function Create
+           (X, Y, W, H : in Integer;
+            Label      : in String)
+        return Text_Editor is
+
+        VP : System.Address;
+
+    begin
+        VP := new_fl_text_editor
+                   (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, Buffer => null);
+    end Create;
+
+
+end FLTK.Widgets.Groups.Text_Displays.Text_Editors;
+
diff --git a/src/fltk_binding/fltk-widgets-groups-text_displays-text_editors.ads b/src/fltk_binding/fltk-widgets-groups-text_displays-text_editors.ads
new file mode 100644
index 0000000..c29b107
--- /dev/null
+++ b/src/fltk_binding/fltk-widgets-groups-text_displays-text_editors.ads
@@ -0,0 +1,27 @@
+
+
+package FLTK.Widgets.Groups.Text_Displays.Text_Editors is
+
+
+    type Text_Editor is new Text_Display with private;
+    type Text_Editor_Access is access all Text_Editor;
+
+
+    function Create
+           (X, Y, W, H : in Integer;
+            Label      : in String)
+        return Text_Editor;
+
+
+private
+
+
+    type Text_Editor is new Text_Display with null record;
+
+
+    overriding procedure Finalize
+           (This : in out Text_Editor);
+
+
+end FLTK.Widgets.Groups.Text_Displays.Text_Editors;
+
diff --git a/src/fltk_binding/fltk-widgets-groups-text_displays.adb b/src/fltk_binding/fltk-widgets-groups-text_displays.adb
index e39355f..5907185 100644
--- a/src/fltk_binding/fltk-widgets-groups-text_displays.adb
+++ b/src/fltk_binding/fltk-widgets-groups-text_displays.adb
@@ -110,11 +110,11 @@ package body FLTK.Widgets.Groups.Text_Displays is
 
 
     procedure Set_Buffer
-           (TD : in out Text_Display'Class;
-            TB : in     Text_Buffer_Access) is
+           (TD :         in out Text_Display'Class;
+            TB : aliased in out Text_Buffer) is
     begin
-        fl_text_display_set_buffer (TD.Void_Ptr, Wrapper (TB.all).Void_Ptr);
-        TD.Buffer := TB;
+        fl_text_display_set_buffer (TD.Void_Ptr, Wrapper (TB).Void_Ptr);
+        TD.Buffer := TB'Access;
     end Set_Buffer;
 
 
diff --git a/src/fltk_binding/fltk-widgets-groups-text_displays.ads b/src/fltk_binding/fltk-widgets-groups-text_displays.ads
index 3481258..86ca8b9 100644
--- a/src/fltk_binding/fltk-widgets-groups-text_displays.ads
+++ b/src/fltk_binding/fltk-widgets-groups-text_displays.ads
@@ -23,8 +23,8 @@ package FLTK.Widgets.Groups.Text_Displays is
 
 
     procedure Set_Buffer
-           (TD : in out Text_Display'Class;
-            TB : in     Text_Buffer_Access);
+           (TD :         in out Text_Display'Class;
+            TB : aliased in out Text_Buffer);
 
 
     function Get_Text_Color
diff --git a/src/fltk_binding/fltk-widgets-groups-windows-single-menu.adb b/src/fltk_binding/fltk-widgets-groups-windows-single-menu.adb
new file mode 100644
index 0000000..dde040f
--- /dev/null
+++ b/src/fltk_binding/fltk-widgets-groups-windows-single-menu.adb
@@ -0,0 +1,164 @@
+
+
+with Interfaces.C;
+with System;
+use type System.Address;
+use type Interfaces.C.unsigned;
+
+
+package body FLTK.Widgets.Groups.Windows.Single.Menu is
+
+
+    function new_fl_menu_window
+           (X, Y, W, H : in Interfaces.C.int;
+            Label      : in Interfaces.C.char_array)
+        return System.Address;
+    pragma Import (C, new_fl_menu_window, "new_fl_menu_window");
+
+    function new_fl_menu_window2
+           (W, H : in Interfaces.C.int)
+        return System.Address;
+    pragma Import (C, new_fl_menu_window2, "new_fl_menu_window2");
+
+    procedure free_fl_menu_window
+           (M : in System.Address);
+    pragma Import (C, free_fl_menu_window, "free_fl_menu_window");
+
+    procedure fl_menu_window_show
+           (M : in System.Address);
+    pragma Import (C, fl_menu_window_show, "fl_menu_window_show");
+
+    procedure fl_menu_window_hide
+           (M : in System.Address);
+    pragma Import (C, fl_menu_window_hide, "fl_menu_window_hide");
+
+    procedure fl_menu_window_flush
+           (M : in System.Address);
+    pragma Import (C, fl_menu_window_flush, "fl_menu_window_flush");
+
+    procedure fl_menu_window_set_overlay
+           (M : in System.Address);
+    pragma Import (C, fl_menu_window_set_overlay, "fl_menu_window_set_overlay");
+
+    procedure fl_menu_window_clear_overlay
+           (M : in System.Address);
+    pragma Import (C, fl_menu_window_clear_overlay, "fl_menu_window_clear_overlay");
+
+    function fl_menu_window_overlay
+           (M : in System.Address)
+        return Interfaces.C.unsigned;
+    pragma Import (C, fl_menu_window_overlay, "fl_menu_window_overlay");
+
+
+
+
+    procedure fl_group_end
+           (G : in System.Address);
+    pragma Import (C, fl_group_end, "fl_group_end");
+
+
+
+
+    procedure Finalize
+           (This : in out Menu_Window) is
+    begin
+        if (This.Void_Ptr /= System.Null_Address) then
+            free_fl_menu_window (This.Void_Ptr);
+        end if;
+    end Finalize;
+
+
+
+
+    function Create
+           (X, Y, W, H : in Integer;
+            Label      : in String)
+        return Menu_Window is
+
+        VP : System.Address;
+
+    begin
+        VP := new_fl_menu_window
+                   (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 Create
+           (W, H : in Integer)
+        return Menu_Window is
+
+        VP : System.Address;
+
+    begin
+        VP := new_fl_menu_window2
+                   (Interfaces.C.int (W),
+                    Interfaces.C.int (H));
+        fl_group_end (VP);
+        return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP);
+    end Create;
+
+
+
+
+    procedure Show
+           (M : in Menu_Window) is
+    begin
+        fl_menu_window_show (M.Void_Ptr);
+    end Show;
+
+
+
+
+    procedure Hide
+           (M : in Menu_Window) is
+    begin
+        fl_menu_window_hide (M.Void_Ptr);
+    end Hide;
+
+
+
+
+    procedure Flush
+           (M : in out Menu_Window) is
+    begin
+        fl_menu_window_flush (M.Void_Ptr);
+    end Flush;
+
+
+
+
+    function Get_Overlay
+           (M : in Menu_Window)
+        return Boolean is
+    begin
+        if fl_menu_window_overlay (M.Void_Ptr) = 0 then
+            return False;
+        else
+            return True;
+        end if;
+    end Get_Overlay;
+
+
+
+    procedure Set_Overlay
+           (M : in out Menu_Window;
+            V : in     Boolean) is
+    begin
+        if V then
+            fl_menu_window_set_overlay (M.Void_Ptr);
+        else
+            fl_menu_window_clear_overlay (M.Void_Ptr);
+        end if;
+    end Set_Overlay;
+
+
+end FLTK.Widgets.Groups.Windows.Single.Menu;
+
diff --git a/src/fltk_binding/fltk-widgets-groups-windows-single-menu.ads b/src/fltk_binding/fltk-widgets-groups-windows-single-menu.ads
new file mode 100644
index 0000000..7e10426
--- /dev/null
+++ b/src/fltk_binding/fltk-widgets-groups-windows-single-menu.ads
@@ -0,0 +1,54 @@
+
+
+package FLTK.Widgets.Groups.Windows.Single.Menu is
+
+
+    type Menu_Window is new Single_Window with private;
+    type Menu_Window_Access is access all Menu_Window;
+
+
+    function Create
+           (X, Y, W, H : in Integer;
+            Label      : in String)
+        return Menu_Window;
+
+
+    function Create
+           (W, H : in Integer)
+        return Menu_Window;
+
+
+    procedure Show
+           (M : in Menu_Window);
+
+
+    procedure Hide
+           (M : in Menu_Window);
+
+
+    procedure Flush
+           (M : in out Menu_Window);
+
+
+    function Get_Overlay
+           (M : in Menu_Window)
+        return Boolean;
+
+
+    procedure Set_Overlay
+           (M : in out Menu_Window;
+            V : in     Boolean);
+
+
+private
+
+
+    type Menu_Window is new Single_Window with null record;
+
+
+    overriding procedure Finalize
+           (This : in out Menu_Window);
+
+
+end FLTK.Widgets.Groups.Windows.Single.Menu;
+
diff --git a/src/fltk_binding/fltk-widgets-groups-windows-single.adb b/src/fltk_binding/fltk-widgets-groups-windows-single.adb
new file mode 100644
index 0000000..e3b6f79
--- /dev/null
+++ b/src/fltk_binding/fltk-widgets-groups-windows-single.adb
@@ -0,0 +1,110 @@
+
+
+with Interfaces.C;
+with System;
+use type System.Address;
+
+
+package body FLTK.Widgets.Groups.Windows.Single is
+
+
+    function new_fl_single_window
+           (X, Y, W, H : in Interfaces.C.int;
+            Label      : in Interfaces.C.char_array)
+        return System.Address;
+    pragma Import (C, new_fl_single_window, "new_fl_single_window");
+
+    function new_fl_single_window2
+           (W, H : in Interfaces.C.int)
+        return System.Address;
+    pragma Import (C, new_fl_single_window2, "new_fl_single_window2");
+
+    procedure free_fl_single_window
+           (S : in System.Address);
+    pragma Import (C, free_fl_single_window, "free_fl_single_window");
+
+    procedure fl_single_window_show
+           (S : in System.Address);
+    pragma Import (C, fl_single_window_show, "fl_single_window_show");
+
+    procedure fl_single_window_flush
+           (S : in System.Address);
+    pragma Import (C, fl_single_window_flush, "fl_single_window_flush");
+
+
+
+
+    procedure fl_group_end
+           (G : in System.Address);
+    pragma Import (C, fl_group_end, "fl_group_end");
+
+
+
+
+    procedure Finalize
+           (This : in out Single_Window) is
+    begin
+        if (This.Void_Ptr /= System.Null_Address) then
+            free_fl_single_window (This.Void_Ptr);
+        end if;
+    end Finalize;
+
+
+
+
+    function Create
+           (X, Y, W, H : in Integer;
+            Label      : in String)
+        return Single_Window is
+
+        VP : System.Address;
+
+    begin
+        VP := new_fl_single_window
+                   (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 Create
+           (W, H : in Integer)
+        return Single_Window is
+
+        VP : System.Address;
+
+    begin
+        VP := new_fl_single_window2
+                   (Interfaces.C.int (W),
+                    Interfaces.C.int (H));
+        fl_group_end (VP);
+        return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP);
+    end Create;
+
+
+
+
+    procedure Show
+           (S : in Single_Window) is
+    begin
+        fl_single_window_show (S.Void_Ptr);
+    end Show;
+
+
+
+
+    procedure Flush
+           (S : in out Single_Window) is
+    begin
+        fl_single_window_flush (S.Void_Ptr);
+    end Flush;
+
+
+end FLTK.Widgets.Groups.Windows.Single;
+
diff --git a/src/fltk_binding/fltk-widgets-groups-windows-single.ads b/src/fltk_binding/fltk-widgets-groups-windows-single.ads
new file mode 100644
index 0000000..1587678
--- /dev/null
+++ b/src/fltk_binding/fltk-widgets-groups-windows-single.ads
@@ -0,0 +1,40 @@
+
+
+package FLTK.Widgets.Groups.Windows.Single is
+
+
+    type Single_Window is new Window with private;
+    type Single_Window_Access is access all Single_Window;
+
+
+    function Create
+           (X, Y, W, H : in Integer;
+            Label      : in String)
+        return Single_Window;
+
+
+    function Create
+           (W, H : in Integer)
+        return Single_Window;
+
+
+    procedure Show
+           (S : in Single_Window);
+
+
+    procedure Flush
+           (S : in out Single_Window);
+
+
+private
+
+
+    type Single_Window is new Window with null record;
+
+
+    overriding procedure Finalize
+           (This : in out Single_Window);
+
+
+end FLTK.Widgets.Groups.Windows.Single;
+
diff --git a/src/fltk_binding/fltk-widgets-groups.ads b/src/fltk_binding/fltk-widgets-groups.ads
index 2c245a0..d38bb54 100644
--- a/src/fltk_binding/fltk-widgets-groups.ads
+++ b/src/fltk_binding/fltk-widgets-groups.ads
@@ -1,5 +1,13 @@
 
 
+--  need to add a Vector to keep track of the children added to a group, and
+--  to change their Void_Ptrs to null addresses if Clear or Finalize are
+--  called, otherwise bad things will happen
+
+--  similarly, Widgets need to keep track of their parent so that Insert
+--  will work correctly
+
+
 package FLTK.Widgets.Groups is