From f8fc211b41dbfa43f9cace75ffdc1d43c0ab8114 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Wed, 21 Sep 2016 17:20:32 +1000 Subject: Started constructing Find/Replace/About windows --- src/adapad.adb | 36 +++++++++-- src/editor_windows.adb | 132 ++++++++++++++++++++++++++++++++++++++ src/editor_windows.ads | 84 ++++++++++++++++++++++++ src/fltk_binding/c_fl_widget.cpp | 32 +++++++++ src/fltk_binding/c_fl_widget.h | 8 +++ src/fltk_binding/fltk-widgets.adb | 96 +++++++++++++++++++++++++++ src/fltk_binding/fltk-widgets.ads | 9 +++ 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(w)->callback(reinterpret_cast(cb)); } + + + +int fl_widget_get_x(WIDGET w) { + return reinterpret_cast(w)->x(); +} + + +int fl_widget_get_y(WIDGET w) { + return reinterpret_cast(w)->y(); +} + + +int fl_widget_get_w(WIDGET w) { + return reinterpret_cast(w)->w(); +} + + +int fl_widget_get_h(WIDGET w) { + return reinterpret_cast(w)->h(); +} + + +void fl_widget_size(WIDGET w, int d, int h) { + reinterpret_cast(w)->size(d, h); +} + + +void fl_widget_position(WIDGET w, int x, int y) { + reinterpret_cast(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 -- cgit