summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/adapad.adb36
-rw-r--r--src/editor_windows.adb132
-rw-r--r--src/editor_windows.ads84
-rw-r--r--src/fltk_binding/c_fl_widget.cpp32
-rw-r--r--src/fltk_binding/c_fl_widget.h8
-rw-r--r--src/fltk_binding/fltk-widgets.adb96
-rw-r--r--src/fltk_binding/fltk-widgets.ads9
7 files changed, 391 insertions, 6 deletions
diff --git a/src/adapad.adb b/src/adapad.adb
index 48ca844..d1f895f 100644
--- a/src/adapad.adb
+++ b/src/adapad.adb
@@ -11,6 +11,8 @@ with FLTK.Widgets.Menus;
use FLTK.Widgets.Menus;
with FLTK.Popups;
use FLTK.Popups;
+with FLTK.Widgets.Groups.Windows;
+use FLTK.Widgets.Groups.Windows;
with Ada.Strings.Unbounded;
use Ada.Strings.Unbounded;
@@ -29,16 +31,20 @@ function AdaPad return Integer is
procedure Do_Save_As;
procedure Load_File (Name : in String);
procedure Save_File (Name : in String);
+ procedure Centre (Win : in out Window'Class);
-- global state of the text editor
- Editor : aliased Editor_Window := Create (0, 0, 640, 400, "(Untitled)");
- Buffer : aliased Text_Buffer := Create;
+ Editor : Editor_Window := Create (0, 0, 640, 400, "(Untitled)");
+ Buffer : Text_Buffer := Create;
+ About : About_Window := Create (250, 200);
+ Find : Find_Window := Create (200, 100);
+ Replace : Replace_Window := Create (200, 100);
- Changed : Boolean := False;
+ Changed : Boolean := False;
Filename : Unbounded_String := To_Unbounded_String (0);
@@ -118,6 +124,7 @@ function AdaPad return Integer is
Item : in out Widget'Class) is
begin
if not Safe_To_Discard then return; end if;
+ About.Hide;
Editor.Hide;
end Call;
@@ -209,7 +216,9 @@ function AdaPad return Integer is
(This : in Find_Callback;
Item : in out Widget'Class) is
begin
- Ada.Text_IO.Put_Line ("Find callback executed.");
+ Centre (Find);
+ Find.Reset;
+ Find.Show;
end Call;
@@ -222,7 +231,9 @@ function AdaPad return Integer is
(This : in Replace_Callback;
Item : in out Widget'Class) is
begin
- Ada.Text_IO.Put_Line ("Replace callback executed.");
+ Centre (Replace);
+ Replace.Reset;
+ Replace.Show;
end Call;
@@ -235,7 +246,8 @@ function AdaPad return Integer is
(This : in About_Callback;
Item : in out Widget'Class) is
begin
- Ada.Text_IO.Put_Line ("About callback executed.");
+ Centre (About);
+ About.Show;
end Call;
@@ -353,6 +365,18 @@ function AdaPad return Integer is
end Save_File;
+
+
+ procedure Centre (Win : in out Window'Class) is
+ Middle_X : Integer := Editor.Get_X + Editor.Get_W / 2;
+ Middle_Y : Integer := Editor.Get_Y + Editor.Get_H / 2;
+ begin
+ Win.Reposition
+ (Middle_X - Win.Get_W / 2,
+ Middle_Y - Win.Get_H / 2);
+ end Centre;
+
+
begin
diff --git a/src/editor_windows.adb b/src/editor_windows.adb
index 7fdf744..4fdf2ae 100644
--- a/src/editor_windows.adb
+++ b/src/editor_windows.adb
@@ -2,11 +2,17 @@
with FLTK.Enums;
use FLTK.Enums;
+with FLTK.Widgets;
+use FLTK.Widgets;
+with FLTK.Widgets.Groups.Windows;
+use FLTK.Widgets.Groups.Windows;
package body Editor_Windows is
+ -- Editor_Window functions and procedures
+
function Create
(X, Y, W, H : in Integer;
Label_Text : in String)
@@ -114,5 +120,131 @@ package body Editor_Windows is
end Delete;
+
+
+ -- used to hide about/find/replace/etc windows instead
+ -- of constantly creating and destroying them
+
+ Hide_CB : aliased Hide_Callback;
+
+ overriding procedure Call
+ (This : in Hide_Callback;
+ Item : in out Widget'Class) is
+ begin
+ if Item in Window'Class then
+ Window (Item).Hide;
+ end if;
+ end Call;
+
+
+
+
+ -- About_Window functions and procedures
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Label_Text : in String)
+ return About_Window is
+
+ Heading_Text : String := "AdaPad 0.9";
+ Blurb_Text : String := "FLTK based simple text editor written in Ada";
+ Author_Text : String := "Written by Jed Barber";
+
+ begin
+ return This : About_Window :=
+ (Double_Window'(Create (X, Y, W, H, Label_Text)) with
+ Heading => Box'(Create (0, Y * 7 / 16, W, H / 8, Heading_Text)),
+ Blurb => Box'(Create (0, Y * 10 / 16, W, H / 8, Blurb_Text)),
+ Author => Box'(Create (0, Y * 12 / 16, W, H / 8, Author_Text))) do
+ This.Add (This.Heading);
+ This.Add (This.Blurb);
+ This.Add (This.Author);
+ This.Set_Callback (Hide_CB'Access);
+ end return;
+ end Create;
+
+
+
+
+ function Create
+ (W, H : in Integer)
+ return About_Window is
+ begin
+ return Create (0, 0, W, H, "About AdaPad");
+ end Create;
+
+
+
+
+ -- Find_Window functions and procedures
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Label_Text : in String)
+ return Find_Window is
+ begin
+ return This : Find_Window :=
+ (Double_Window'(Create (X, Y, W, H, Label_Text)) with
+ Placeholder => 0) do
+ This.Set_Callback (Hide_CB'Access);
+ end return;
+ end Create;
+
+
+
+
+ function Create
+ (W, H : in Integer)
+ return Find_Window is
+ begin
+ return Create (0, 0, W, H, "Find");
+ end Create;
+
+
+
+
+ procedure Reset
+ (This : in out Find_Window) is
+ begin
+ null;
+ end Reset;
+
+
+
+
+ -- Replace_Window functions and procedures
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Label_Text : in String)
+ return Replace_Window is
+ begin
+ return This : Replace_Window :=
+ (Double_Window'(Create (X, Y, W, H, Label_Text)) with
+ Placeholder => 0) do
+ This.Set_Callback (Hide_CB'Access);
+ end return;
+ end Create;
+
+
+
+
+ function Create
+ (W, H : in Integer)
+ return Replace_Window is
+ begin
+ return Create (0, 0, W, H, "Replace");
+ end Create;
+
+
+
+
+ procedure Reset
+ (This : in out Replace_Window) is
+ begin
+ null;
+ end Reset;
+
+
end Editor_Windows;
diff --git a/src/editor_windows.ads b/src/editor_windows.ads
index 3fefd4f..9665b02 100644
--- a/src/editor_windows.ads
+++ b/src/editor_windows.ads
@@ -8,6 +8,8 @@ with FLTK.Text_Buffers;
use FLTK.Text_Buffers;
private with FLTK.Widgets.Groups.Text_Displays.Text_Editors;
private with FLTK.Widgets.Menus.Menu_Bars;
+private with FLTK.Widgets.Boxes;
+private with FLTK.Widgets;
package Editor_Windows is
@@ -49,11 +51,67 @@ package Editor_Windows is
procedure Delete (This : in out Editor_Window);
+
+
+ type About_Window is new Double_Window with private;
+
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Label_Text : in String)
+ return About_Window;
+
+
+ function Create
+ (W, H : in Integer)
+ return About_Window;
+
+
+
+
+ type Find_Window is new Double_Window with private;
+
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Label_Text : in String)
+ return Find_Window;
+
+
+ function Create
+ (W, H : in Integer)
+ return Find_Window;
+
+
+ procedure Reset (This : in out Find_Window);
+
+
+
+
+ type Replace_Window is new Double_Window with private;
+
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Label_Text : in String)
+ return Replace_Window;
+
+
+ function Create
+ (W, H : in Integer)
+ return Replace_Window;
+
+
+ procedure Reset (This : in out Replace_Window);
+
+
private
use FLTK.Widgets.Groups.Text_Displays.Text_Editors;
use FLTK.Widgets.Menus.Menu_Bars;
+ use FLTK.Widgets.Boxes;
+ use FLTK.Widgets;
type Editor_Window is new Double_Window with
@@ -63,5 +121,31 @@ private
end record;
+ type Hide_Callback is new Widget_Callback with null record;
+ overriding procedure Call
+ (This : in Hide_Callback;
+ Item : in out Widget'Class);
+
+
+ type About_Window is new Double_Window with
+ record
+ Heading : Box;
+ Blurb : Box;
+ Author : Box;
+ end record;
+
+
+ type Find_Window is new Double_Window with
+ record
+ Placeholder : Integer;
+ end record;
+
+
+ type Replace_Window is new Double_Window with
+ record
+ Placeholder : Integer;
+ end record;
+
+
end Editor_Windows;
diff --git a/src/fltk_binding/c_fl_widget.cpp b/src/fltk_binding/c_fl_widget.cpp
index f700c54..9dea7ee 100644
--- a/src/fltk_binding/c_fl_widget.cpp
+++ b/src/fltk_binding/c_fl_widget.cpp
@@ -79,3 +79,35 @@ void fl_widget_set_callback(WIDGET w, void * cb) {
reinterpret_cast<Fl_Widget*>(w)->callback(reinterpret_cast<Fl_Callback_p>(cb));
}
+
+
+
+int fl_widget_get_x(WIDGET w) {
+ return reinterpret_cast<Fl_Widget*>(w)->x();
+}
+
+
+int fl_widget_get_y(WIDGET w) {
+ return reinterpret_cast<Fl_Widget*>(w)->y();
+}
+
+
+int fl_widget_get_w(WIDGET w) {
+ return reinterpret_cast<Fl_Widget*>(w)->w();
+}
+
+
+int fl_widget_get_h(WIDGET w) {
+ return reinterpret_cast<Fl_Widget*>(w)->h();
+}
+
+
+void fl_widget_size(WIDGET w, int d, int h) {
+ reinterpret_cast<Fl_Widget*>(w)->size(d, h);
+}
+
+
+void fl_widget_position(WIDGET w, int x, int y) {
+ reinterpret_cast<Fl_Widget*>(w)->position(x, y);
+}
+
diff --git a/src/fltk_binding/c_fl_widget.h b/src/fltk_binding/c_fl_widget.h
index 3b2561e..a9379f6 100644
--- a/src/fltk_binding/c_fl_widget.h
+++ b/src/fltk_binding/c_fl_widget.h
@@ -27,5 +27,13 @@ extern "C" void * fl_widget_get_parent(WIDGET w);
extern "C" void fl_widget_set_callback(WIDGET w, void * cb);
+extern "C" int fl_widget_get_x(WIDGET w);
+extern "C" int fl_widget_get_y(WIDGET w);
+extern "C" int fl_widget_get_w(WIDGET w);
+extern "C" int fl_widget_get_h(WIDGET w);
+extern "C" void fl_widget_size(WIDGET w, int d, int h);
+extern "C" void fl_widget_position(WIDGET w, int x, int y);
+
+
#endif
diff --git a/src/fltk_binding/fltk-widgets.adb b/src/fltk_binding/fltk-widgets.adb
index 3e27cb7..5ec090d 100644
--- a/src/fltk_binding/fltk-widgets.adb
+++ b/src/fltk_binding/fltk-widgets.adb
@@ -75,6 +75,36 @@ package body FLTK.Widgets is
(W, C : in System.Address);
pragma Import (C, fl_widget_set_callback, "fl_widget_set_callback");
+ function fl_widget_get_x
+ (W : in System.Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_widget_get_x, "fl_widget_get_x");
+
+ function fl_widget_get_y
+ (W : in System.Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_widget_get_y, "fl_widget_get_y");
+
+ function fl_widget_get_w
+ (W : in System.Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_widget_get_w, "fl_widget_get_w");
+
+ function fl_widget_get_h
+ (W : in System.Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_widget_get_h, "fl_widget_get_h");
+
+ procedure fl_widget_size
+ (W : in System.Address;
+ D, H : in Interfaces.C.int);
+ pragma Import (C, fl_widget_size, "fl_widget_size");
+
+ procedure fl_widget_position
+ (W : in System.Address;
+ X, Y : in Interfaces.C.int);
+ pragma Import (C, fl_widget_position, "fl_widget_position");
+
@@ -223,5 +253,71 @@ package body FLTK.Widgets is
end Set_Callback;
+
+
+ function Get_X
+ (This : in Widget)
+ return Integer is
+ begin
+ return Integer (fl_widget_get_x (This.Void_Ptr));
+ end Get_X;
+
+
+
+
+ function Get_Y
+ (This : in Widget)
+ return Integer is
+ begin
+ return Integer (fl_widget_get_y (This.Void_Ptr));
+ end Get_Y;
+
+
+
+
+ function Get_W
+ (This : in Widget)
+ return Integer is
+ begin
+ return Integer (fl_widget_get_w (This.Void_Ptr));
+ end Get_W;
+
+
+
+
+ function Get_H
+ (This : in Widget)
+ return Integer is
+ begin
+ return Integer (fl_widget_get_h (This.Void_Ptr));
+ end Get_H;
+
+
+
+
+ procedure Resize
+ (This : in out Widget;
+ W, H : in Integer) is
+ begin
+ fl_widget_size
+ (This.Void_Ptr,
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Resize;
+
+
+
+
+ procedure Reposition
+ (This : in out Widget;
+ X, Y : in Integer) is
+ begin
+ fl_widget_position
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y));
+ end Reposition;
+
+
end FLTK.Widgets;
diff --git a/src/fltk_binding/fltk-widgets.ads b/src/fltk_binding/fltk-widgets.ads
index 0a123bf..c0f89c1 100644
--- a/src/fltk_binding/fltk-widgets.ads
+++ b/src/fltk_binding/fltk-widgets.ads
@@ -96,6 +96,15 @@ package FLTK.Widgets is
Func : not null access Widget_Callback'Class);
+ function Get_X (This : in Widget) return Integer;
+ function Get_Y (This : in Widget) return Integer;
+ function Get_W (This : in Widget) return Integer;
+ function Get_H (This : in Widget) return Integer;
+
+
+ procedure Resize (This : in out Widget; W, H : in Integer);
+ procedure Reposition (This : in out Widget; X, Y : in Integer);
+
private
generated by cgit (git 2.30.0) at 2024-12-22 18:16:53 +0000