diff options
| -rw-r--r-- | src/adapad.adb | 20 | ||||
| -rw-r--r-- | src/editor_windows.adb | 538 | ||||
| -rw-r--r-- | src/editor_windows.ads | 229 | ||||
| -rw-r--r-- | src/windows-about.adb | 99 | ||||
| -rw-r--r-- | src/windows-about.ads | 43 | ||||
| -rw-r--r-- | src/windows-editor.adb | 172 | ||||
| -rw-r--r-- | src/windows-editor.ads | 91 | ||||
| -rw-r--r-- | src/windows-find.adb | 130 | ||||
| -rw-r--r-- | src/windows-find.ads | 64 | ||||
| -rw-r--r-- | src/windows-replace.adb | 143 | ||||
| -rw-r--r-- | src/windows-replace.ads | 64 | ||||
| -rw-r--r-- | src/windows.adb | 44 | ||||
| -rw-r--r-- | src/windows.ads | 28 | ||||
| -rw-r--r-- | to_do.txt | 1 |
14 files changed, 889 insertions, 777 deletions
diff --git a/src/adapad.adb b/src/adapad.adb index ee0941a..943a49c 100644 --- a/src/adapad.adb +++ b/src/adapad.adb @@ -6,7 +6,10 @@ with FLTK.Widgets.Menus; with FLTK.Widgets.Groups.Windows; with FLTK.Text_Buffers; with FLTK.Popups; -with Editor_Windows; +with Windows.Editor; +with Windows.About; +with Windows.Find; +with Windows.Replace; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; @@ -18,7 +21,6 @@ function Adapad return Integer is package WN renames FLTK.Widgets.Groups.Windows; package TB renames FLTK.Text_Buffers; package D renames FLTK.Popups; - package ED renames Editor_Windows; @@ -38,11 +40,11 @@ function Adapad return Integer is -- global state of the text editor - Editor : ED.Editor_Window := ED.Create (800, 500); - Buffer : TB.Text_Buffer := TB.Create; - About : ED.About_Window := ED.Create; - Find : ED.Find_Window := ED.Create; - Replace : ED.Replace_Window := ED.Create; + Editor : Windows.Editor.Editor_Window := Windows.Editor.Create (800, 500); + Buffer : TB.Text_Buffer := TB.Create; + About : Windows.About.About_Window := Windows.About.Create; + Find : Windows.Find.Find_Window := Windows.Find.Create; + Replace : Windows.Replace.Replace_Window := Windows.Replace.Create; Changed : Boolean := False; Filename : Unbounded_String := To_Unbounded_String (0); @@ -278,7 +280,7 @@ function Adapad return Integer is -- callbacks for the find/replace windows - type Do_Find_Callback is new Editor_Windows.Find_Callback with null record; + type Do_Find_Callback is new Windows.Find.Find_Callback with null record; Do_Find_CB : aliased Do_Find_Callback; overriding procedure Call @@ -302,7 +304,7 @@ function Adapad return Integer is - type Do_Replace_Callback is new Editor_Windows.Replace_Callback with null record; + type Do_Replace_Callback is new Windows.Replace.Replace_Callback with null record; Do_Replace_CB : aliased Do_Replace_Callback; overriding procedure Call diff --git a/src/editor_windows.adb b/src/editor_windows.adb deleted file mode 100644 index d70ee71..0000000 --- a/src/editor_windows.adb +++ /dev/null @@ -1,538 +0,0 @@ - - -with FLTK.Enums; use FLTK.Enums; -with FLTK.Widgets; -with FLTK.Widgets.Groups; -with FLTK.Widgets.Groups.Windows; -with FLTK.Widgets.Groups.Windows.Double; -with FLTK.Widgets.Groups.Text_Displays.Text_Editors; -with FLTK.Widgets.Menus; -with FLTK.Widgets.Menus.Menu_Bars; -with FLTK.Widgets.Boxes; -with FLTK.Widgets.Inputs; -with FLTK.Widgets.Buttons; -with FLTK.Widgets.Buttons.Enter; -with FLTK.Widgets.Buttons.Light.Check; -with FLTK.Images.RGB.PNG; -with FLTK.Text_Buffers; -use type FLTK.Widgets.Buttons.State; - - -package body Editor_Windows is - - - package W renames FLTK.Widgets; - package G renames FLTK.Widgets.Groups; - package WN renames FLTK.Widgets.Groups.Windows; - package WD renames FLTK.Widgets.Groups.Windows.Double; - package TE renames FLTK.Widgets.Groups.Text_Displays.Text_Editors; - package MB renames FLTK.Widgets.Menus.Menu_Bars; - package BX renames FLTK.Widgets.Boxes; - package IP renames FLTK.Widgets.Inputs; - package BU renames FLTK.Widgets.Buttons; - package EN renames FLTK.Widgets.Buttons.Enter; - package LC renames FLTK.Widgets.Buttons.Light.Check; - package PN renames FLTK.Images.RGB.PNG; - - - - - Logo : PN.PNG_Image := PN.Create ("logo.png"); - - - - - -- Editor_Window functions and procedures - - function Create - (X, Y, W, H : in Integer; - Label_Text : in String) - return Editor_Window - is - Width : Integer := Min_Editor_Width; - Height : Integer := Min_Editor_Height; - Menu_Height : Integer := 22; - begin - if Width < W then - Width := W; - end if; - - if Height < H then - Height := H; - end if; - - return This : Editor_Window := - (WD.Double_Window'(WD.Create (X, Y, Width, Height, Label_Text)) with - - Editor => TE.Text_Editor'(TE.Create - (0, Menu_Height, Width, Height - Menu_Height, "")), - Bar => MB.Menu_Bar'(MB.Create - (0, 0, Width, Menu_Height, ""))) do - - This.Add (This.Editor); - This.Add (This.Bar); - This.Bar.Set_Box (No_Box); - This.Editor.Set_Text_Font (Courier); - This.Set_Resizable (This.Editor); - This.Set_Size_Range (Min_Editor_Width, Min_Editor_Height); - This.Set_Icon (Logo); - end return; - end Create; - - - - - function Create - (W, H : in Integer) - return Editor_Window is - begin - return Create (0, 0, W, H, "(Untitled)"); - end Create; - - - - - function Get_Buffer - (This : in Editor_Window) - return FLTK.Text_Buffers.Text_Buffer_Cursor is - begin - return This.Editor.Get_Buffer; - end Get_Buffer; - - - - - procedure Set_Buffer - (This : in out Editor_Window; - Buff : in out FLTK.Text_Buffers.Text_Buffer) is - begin - This.Editor.Set_Buffer (Buff); - end Set_Buffer; - - - - - function Get_Menu - (This : in out Editor_Window) - return FLTK.Widgets.Menus.Menu_Cursor is - begin - return Ref : FLTK.Widgets.Menus.Menu_Cursor (This.Bar'Access); - end Get_Menu; - - - - - procedure Undo - (This : in out Editor_Window) is - begin - This.Editor.Undo; - end Undo; - - - - - procedure Cut - (This : in out Editor_Window) is - begin - This.Editor.Cut; - end Cut; - - - - - procedure Copy - (This : in out Editor_Window) is - begin - This.Editor.Copy; - end Copy; - - - - - procedure Paste - (This : in out Editor_Window) is - begin - This.Editor.Paste; - end Paste; - - - - - procedure Delete - (This : in out Editor_Window) is - begin - This.Editor.Delete; - end Delete; - - - - - function Get_Insert_Position - (This : in Editor_Window) - return Natural is - begin - return This.Editor.Get_Insert_Position; - end Get_Insert_Position; - - - - - procedure Set_Insert_Position - (This : in out Editor_Window; - Pos : in Natural) is - begin - This.Editor.Set_Insert_Position (Pos); - end Set_Insert_Position; - - - - - procedure Show_Insert_Position - (This : in out Editor_Window) is - begin - This.Editor.Show_Insert_Position; - end Show_Insert_Position; - - - - - -- 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 W.Widget'Class) - is - P : access G.Group'Class; - begin - if Item in WN.Window'Class then - WN.Window (Item).Hide; - else - P := Item.Parent; - loop - if P = null then - return; - end if; - exit when P.all in WN.Window'Class; - P := P.Parent; - end loop; - WN.Window (P.all).Hide; - end if; - end Call; - - - - - -- About_Window functions and procedures - - function Create - return About_Window - is - My_Width : Integer := 350; - My_Height : Integer := 250; - - Logo_Line : Integer := 30; - Logo_Width : Integer := 50; - Logo_Height : Integer := 50; - - Button_Width : Integer := 140; - Button_Height : Integer := 40; - - Heading_Line : Integer := 90; - Blurb_Line : Integer := 132; - Author_Line : Integer := 157; - Button_Line : Integer := 190; - - Heading_Size : Integer := 22; - Text_Size : Integer := 12; - - Heading_Text : String := "Adapad 0.5"; - Blurb_Text : String := "FLTK based simple text editor written in Ada"; - Author_Text : String := "Programmed by Jed Barber"; - begin - return This : About_Window := - (WD.Double_Window'(WD.Create (0, 0, My_Width, My_Height, "About Adapad")) with - - Picture => BX.Box'(BX.Create - ((My_Width - Logo_Width) / 2, - Logo_Line, Logo_Width, Logo_Height, "")), - Heading => BX.Box'(BX.Create - (0, Heading_Line, My_Width, Heading_Size, Heading_Text)), - Blurb => BX.Box'(BX.Create - (0, Blurb_Line, My_Width, Text_Size, Blurb_Text)), - Author => BX.Box'(BX.Create - (0, Author_Line, My_Width, Text_Size, Author_Text)), - Dismiss => EN.Enter_Button'(EN.Create - ((My_Width - Button_Width) / 2, - Button_Line, Button_Width, Button_Height, "Close"))) do - - This.Add (This.Picture); - This.Picture.Set_Image (Logo); - This.Add (This.Heading); - This.Heading.Set_Label_Size (W.Font_Size (Heading_Size)); - This.Add (This.Blurb); - This.Add (This.Author); - This.Add (This.Dismiss); - This.Dismiss.Set_Callback (Hide_CB'Access); - - This.Set_Callback (Hide_CB'Access); - This.Set_Icon (Logo); - This.Set_Modal; - end return; - end Create; - - - - - function Create - (X, Y, W, H : in Integer; - Label_Text : in String) - return About_Window is - begin - return Create; - end Create; - - - - - function Create - (W, H : in Integer) - return About_Window is - begin - return Create; - end Create; - - - - - -- Find_Window functions and procedures - - Find_M : aliased Find_Marshaller; - - overriding procedure Call - (This : in Find_Marshaller; - Item : in out W.Widget'Class) - is - type Find_Window_Access is access all Find_Window; - Dialog : access Find_Window := Find_Window_Access (Item.Parent); - begin - if Dialog.Callback /= null then - Dialog.Callback.Call - (Dialog.Find_What.Get_Value, - Dialog.Match_Case.Get_State = BU.On); - end if; - end Call; - - - - - function Create - return Find_Window - is - My_Width : Integer := 350; - My_Height : Integer := 130; - - Button_Width : Integer := 140; - Button_Height : Integer := 40; - - Input_Line : Integer := 10; - Case_Line : Integer := 50; - Button_Line : Integer := 80; - - Input_Width : Integer := 240; - Input_Height : Integer := 25; - Input_Margin_Right : Integer := 10; - - Check_Width : Integer := 100; - Check_Height : Integer := 20; - Case_Margin_Left : Integer := 50; - - Text_Size : Integer := 12; - begin - return This : Find_Window := - (WD.Double_Window'(WD.Create (0, 0, My_Width, My_Height, "Find")) with - - Find_What => IP.Input'(IP.Create - (My_Width - Input_Width - Input_Margin_Right, - Input_Line, Input_Width, Input_Height, "Find what:")), - Match_Case => LC.Check_Button'(LC.Create - (Case_Margin_Left, Case_Line, Check_Width, Check_Height, "Match case")), - Cancel => BU.Button'(BU.Create - ((My_Width - 2 * Button_Width) / 3, - Button_Line, Button_Width, Button_Height, "Cancel")), - Start => EN.Enter_Button'(EN.Create - ((My_Width - 2 * Button_Width) * 2 / 3 + Button_Width, - Button_Line, Button_Width, Button_Height, "Find")), - - Callback => null) do - - This.Add (This.Find_What); - This.Add (This.Match_Case); - This.Add (This.Cancel); - This.Cancel.Set_Callback (Hide_CB'Access); - This.Add (This.Start); - This.Start.Set_Callback (Find_M'Access); - - This.Set_Callback (Hide_CB'Access); - This.Set_Icon (Logo); - This.Set_Modal; - end return; - end Create; - - - - - function Create - (X, Y, W, H : in Integer; - Label_Text : in String) - return Find_Window is - begin - return Create; - end Create; - - - - - function Create - (W, H : in Integer) - return Find_Window is - begin - return Create; - end Create; - - - - - procedure Set_Find_Callback - (This : in out Find_Window; - Func : not null access Find_Callback'Class) is - begin - This.Callback := Func; - end Set_Find_Callback; - - - - - -- Replace_Window functions and procedures - - Replace_M : aliased Replace_Marshaller; - - overriding procedure Call - (This : in Replace_Marshaller; - Item : in out W.Widget'Class) - is - type Replace_Window_Access is access all Replace_Window; - Dialog : access Replace_Window := Replace_Window_Access (Item.Parent); - begin - if Dialog.Callback /= null then - Dialog.Callback.Call - (Dialog.Find_What.Get_Value, - Dialog.Replace_With.Get_Value, - Dialog.Match_Case.Get_State = BU.On, - Dialog.Replace_All.Get_State = BU.On); - end if; - end Call; - - - - - function Create - return Replace_Window - is - My_Width : Integer := 350; - My_Height : Integer := 180; - - Button_Width : Integer := 140; - Button_Height : Integer := 40; - - Find_Line : Integer := 10; - Replace_Line : Integer := 40; - Match_Line : Integer := 80; - Rep_All_Line : Integer := 100; - Button_Line : Integer := 130; - - Input_Width : Integer := 220; - Input_Height : Integer := 25; - Input_Margin_Right : Integer := 10; - - Check_Width : Integer := 100; - Check_Height : Integer := 20; - Check_Margin_Left : Integer := 50; - - Text_Size : Integer := 12; - begin - return This : Replace_Window := - (WD.Double_Window'(WD.Create (0, 0, My_Width, My_Height, "Replace")) with - - Find_What => IP.Input'(IP.Create - (My_Width - Input_Width - Input_Margin_Right, - Find_Line, Input_Width, Input_Height, "Find what:")), - Replace_With => IP.Input'(IP.Create - (My_Width - Input_Width - Input_Margin_Right, - Replace_Line, Input_Width, Input_Height, "Replace with:")), - Match_Case => LC.Check_Button'(LC.Create - (Check_Margin_Left, Match_Line, - Check_Width, Check_Height, "Match case")), - Replace_All => LC.Check_Button'(LC.Create - (Check_Margin_Left, Rep_All_Line, - Check_Width, Check_Height, "Replace all")), - Cancel => BU.Button'(BU.Create - ((My_Width - 2 * Button_Width) / 3, - Button_Line, Button_Width, Button_Height, "Cancel")), - Start => EN.Enter_Button'(EN.Create - ((My_Width - 2 * Button_Width) * 2 / 3 + Button_Width, - Button_Line, Button_Width, Button_Height, "Replace")), - - Callback => null) do - - This.Add (This.Find_What); - This.Add (This.Replace_With); - This.Add (This.Match_Case); - This.Add (This.Replace_All); - This.Add (This.Cancel); - This.Cancel.Set_Callback (Hide_CB'Access); - This.Add (This.Start); - This.Start.Set_Callback (Replace_M'Access); - - This.Set_Callback (Hide_CB'Access); - This.Set_Icon (Logo); - This.Set_Modal; - end return; - end Create; - - - - - function Create - (X, Y, W, H : in Integer; - Label_Text : in String) - return Replace_Window is - begin - return Create; - end Create; - - - - - function Create - (W, H : in Integer) - return Replace_Window is - begin - return Create; - end Create; - - - - - procedure Set_Replace_Callback - (This : in out Replace_Window; - Func : not null access Replace_Callback'Class) is - begin - This.Callback := Func; - end Set_Replace_Callback; - - -end Editor_Windows; - diff --git a/src/editor_windows.ads b/src/editor_windows.ads deleted file mode 100644 index 39ca7a5..0000000 --- a/src/editor_windows.ads +++ /dev/null @@ -1,229 +0,0 @@ - - -with FLTK.Widgets.Groups.Windows.Double; -with FLTK.Widgets.Menus; -with FLTK.Text_Buffers; -private with FLTK.Widgets; -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.Inputs; -private with FLTK.Widgets.Buttons; -private with FLTK.Widgets.Buttons.Enter; -private with FLTK.Widgets.Buttons.Light.Check; - - -package Editor_Windows is - - - type Editor_Window is new FLTK.Widgets.Groups.Windows.Double.Double_Window with private; - - - Min_Editor_Height : Integer := 60; - Min_Editor_Width : Integer := 300; - - - function Create - (X, Y, W, H : in Integer; - Label_Text : in String) - return Editor_Window; - - - function Create - (W, H : in Integer) - return Editor_Window; - - - function Get_Buffer - (This : in Editor_Window) - return FLTK.Text_Buffers.Text_Buffer_Cursor; - - - procedure Set_Buffer - (This : in out Editor_Window; - Buff : in out FLTK.Text_Buffers.Text_Buffer); - - - function Get_Menu - (This : in out Editor_Window) - return FLTK.Widgets.Menus.Menu_Cursor; - - - procedure Undo - (This : in out Editor_Window); - - - procedure Cut - (This : in out Editor_Window); - - - procedure Copy - (This : in out Editor_Window); - - - procedure Paste - (This : in out Editor_Window); - - - procedure Delete - (This : in out Editor_Window); - - - function Get_Insert_Position - (This : in Editor_Window) - return Natural; - - - procedure Set_Insert_Position - (This : in out Editor_Window; - Pos : in Natural); - - - procedure Show_Insert_Position - (This : in out Editor_Window); - - - - - type About_Window is new FLTK.Widgets.Groups.Windows.Double.Double_Window with private; - - - function Create - return About_Window; - - - 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 FLTK.Widgets.Groups.Windows.Double.Double_Window with private; - - - type Find_Callback is interface; - procedure Call - (This : in Find_Callback; - Item : in String; - Match_Case : in Boolean) is abstract; - - - function Create - return Find_Window; - - - 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 Set_Find_Callback - (This : in out Find_Window; - Func : not null access Find_Callback'Class); - - - - - type Replace_Window is new FLTK.Widgets.Groups.Windows.Double.Double_Window with private; - - - type Replace_Callback is interface; - procedure Call - (This : in Replace_Callback; - Item, Replace_With : in String; - Match_Case, Rep_All : in Boolean) is abstract; - - - function Create - return Replace_Window; - - - 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 Set_Replace_Callback - (This : in out Replace_Window; - Func : not null access Replace_Callback'Class); - - -private - - - type Editor_Window is new FLTK.Widgets.Groups.Windows.Double.Double_Window with - record - Bar : aliased FLTK.Widgets.Menus.Menu_Bars.Menu_Bar; - Editor : FLTK.Widgets.Groups.Text_Displays.Text_Editors.Text_Editor; - end record; - - - type Hide_Callback is new FLTK.Widgets.Widget_Callback with null record; - overriding procedure Call - (This : in Hide_Callback; - Item : in out FLTK.Widgets.Widget'Class); - - - type About_Window is new FLTK.Widgets.Groups.Windows.Double.Double_Window with - record - Picture : FLTK.Widgets.Boxes.Box; - Heading : FLTK.Widgets.Boxes.Box; - Blurb : FLTK.Widgets.Boxes.Box; - Author : FLTK.Widgets.Boxes.Box; - Dismiss : FLTK.Widgets.Buttons.Enter.Enter_Button; - end record; - - - type Find_Marshaller is new FLTK.Widgets.Widget_Callback with null record; - overriding procedure Call - (This : in Find_Marshaller; - Item : in out FLTK.Widgets.Widget'Class); - - - type Find_Window is new FLTK.Widgets.Groups.Windows.Double.Double_Window with - record - Find_What : FLTK.Widgets.Inputs.Input; - Match_Case : FLTK.Widgets.Buttons.Light.Check.Check_Button; - Cancel : FLTK.Widgets.Buttons.Button; - Start : FLTK.Widgets.Buttons.Enter.Enter_Button; - Callback : access Find_Callback'Class; - end record; - - - type Replace_Marshaller is new FLTK.Widgets.Widget_Callback with null record; - overriding procedure Call - (This : in Replace_Marshaller; - Item : in out FLTK.Widgets.Widget'Class); - - - type Replace_Window is new FLTK.Widgets.Groups.Windows.Double.Double_Window with - record - Find_What, Replace_With : FLTK.Widgets.Inputs.Input; - Match_Case, Replace_All : FLTK.Widgets.Buttons.Light.Check.Check_Button; - Cancel : FLTK.Widgets.Buttons.Button; - Start : FLTK.Widgets.Buttons.Enter.Enter_Button; - Callback : access Replace_Callback'Class; - end record; - - -end Editor_Windows; - diff --git a/src/windows-about.adb b/src/windows-about.adb new file mode 100644 index 0000000..a0845b8 --- /dev/null +++ b/src/windows-about.adb @@ -0,0 +1,99 @@ + + +with FLTK.Widgets; +with FLTK.Widgets.Groups.Windows.Double; +with FLTK.Widgets.Boxes; +with FLTK.Widgets.Buttons.Enter; + + +package body Windows.About is + + + package W renames FLTK.Widgets; + package WD renames FLTK.Widgets.Groups.Windows.Double; + package BX renames FLTK.Widgets.Boxes; + package EN renames FLTK.Widgets.Buttons.Enter; + + + + + function Create + return About_Window + is + My_Width : Integer := 350; + My_Height : Integer := 250; + + Logo_Line : Integer := 30; + Logo_Width : Integer := 50; + Logo_Height : Integer := 50; + + Button_Width : Integer := 140; + Button_Height : Integer := 40; + + Heading_Line : Integer := 90; + Blurb_Line : Integer := 132; + Author_Line : Integer := 157; + Button_Line : Integer := 190; + + Heading_Size : Integer := 22; + Text_Size : Integer := 12; + + Heading_Text : String := "Adapad 0.5"; + Blurb_Text : String := "FLTK based simple text editor written in Ada"; + Author_Text : String := "Programmed by Jed Barber"; + begin + return This : About_Window := + (WD.Double_Window'(WD.Create (0, 0, My_Width, My_Height, "About Adapad")) with + + Picture => BX.Box'(BX.Create + ((My_Width - Logo_Width) / 2, + Logo_Line, Logo_Width, Logo_Height, "")), + Heading => BX.Box'(BX.Create + (0, Heading_Line, My_Width, Heading_Size, Heading_Text)), + Blurb => BX.Box'(BX.Create + (0, Blurb_Line, My_Width, Text_Size, Blurb_Text)), + Author => BX.Box'(BX.Create + (0, Author_Line, My_Width, Text_Size, Author_Text)), + Dismiss => EN.Enter_Button'(EN.Create + ((My_Width - Button_Width) / 2, + Button_Line, Button_Width, Button_Height, "Close"))) do + + This.Add (This.Picture); + This.Picture.Set_Image (Logo); + This.Add (This.Heading); + This.Heading.Set_Label_Size (W.Font_Size (Heading_Size)); + This.Add (This.Blurb); + This.Add (This.Author); + This.Add (This.Dismiss); + This.Dismiss.Set_Callback (Hide_CB'Access); + + This.Set_Callback (Hide_CB'Access); + This.Set_Icon (Logo); + This.Set_Modal; + end return; + end Create; + + + + + function Create + (X, Y, W, H : in Integer; + Label_Text : in String) + return About_Window is + begin + return Create; + end Create; + + + + + function Create + (W, H : in Integer) + return About_Window is + begin + return Create; + end Create; + + +end Windows.About; + diff --git a/src/windows-about.ads b/src/windows-about.ads new file mode 100644 index 0000000..9396825 --- /dev/null +++ b/src/windows-about.ads @@ -0,0 +1,43 @@ + + +with FLTK.Widgets.Groups.Windows.Double; +private with FLTK.Widgets.Boxes; +private with FLTK.Widgets.Buttons.Enter; + + +package Windows.About is + + + type About_Window is new FLTK.Widgets.Groups.Windows.Double.Double_Window with private; + + + function Create + return About_Window; + + + function Create + (X, Y, W, H : in Integer; + Label_Text : in String) + return About_Window; + + + function Create + (W, H : in Integer) + return About_Window; + + +private + + + type About_Window is new FLTK.Widgets.Groups.Windows.Double.Double_Window with + record + Picture : FLTK.Widgets.Boxes.Box; + Heading : FLTK.Widgets.Boxes.Box; + Blurb : FLTK.Widgets.Boxes.Box; + Author : FLTK.Widgets.Boxes.Box; + Dismiss : FLTK.Widgets.Buttons.Enter.Enter_Button; + end record; + + +end Windows.About; + diff --git a/src/windows-editor.adb b/src/windows-editor.adb new file mode 100644 index 0000000..7f303fe --- /dev/null +++ b/src/windows-editor.adb @@ -0,0 +1,172 @@ + + +with FLTK.Enums; use FLTK.Enums; +with FLTK.Widgets.Groups.Windows.Double; +with FLTK.Widgets.Groups.Text_Displays.Text_Editors; +with FLTK.Widgets.Menus; +with FLTK.Widgets.Menus.Menu_Bars; +with FLTK.Text_Buffers; + + +package body Windows.Editor is + + + package WD renames FLTK.Widgets.Groups.Windows.Double; + package TE renames FLTK.Widgets.Groups.Text_Displays.Text_Editors; + package MB renames FLTK.Widgets.Menus.Menu_Bars; + + + + + function Create + (X, Y, W, H : in Integer; + Label_Text : in String) + return Editor_Window + is + Width : Integer := Min_Editor_Width; + Height : Integer := Min_Editor_Height; + Menu_Height : Integer := 22; + begin + if Width < W then + Width := W; + end if; + + if Height < H then + Height := H; + end if; + + return This : Editor_Window := + (WD.Double_Window'(WD.Create (X, Y, Width, Height, Label_Text)) with + + Editor => TE.Text_Editor'(TE.Create + (0, Menu_Height, Width, Height - Menu_Height, "")), + Bar => MB.Menu_Bar'(MB.Create + (0, 0, Width, Menu_Height, ""))) do + + This.Add (This.Editor); + This.Add (This.Bar); + This.Bar.Set_Box (No_Box); + This.Editor.Set_Text_Font (Courier); + This.Set_Resizable (This.Editor); + This.Set_Size_Range (Min_Editor_Width, Min_Editor_Height); + This.Set_Icon (Logo); + end return; + end Create; + + + + + function Create + (W, H : in Integer) + return Editor_Window is + begin + return Create (0, 0, W, H, "(Untitled)"); + end Create; + + + + + function Get_Buffer + (This : in Editor_Window) + return FLTK.Text_Buffers.Text_Buffer_Cursor is + begin + return This.Editor.Get_Buffer; + end Get_Buffer; + + + + + procedure Set_Buffer + (This : in out Editor_Window; + Buff : in out FLTK.Text_Buffers.Text_Buffer) is + begin + This.Editor.Set_Buffer (Buff); + end Set_Buffer; + + + + + function Get_Menu + (This : in out Editor_Window) + return FLTK.Widgets.Menus.Menu_Cursor is + begin + return Ref : FLTK.Widgets.Menus.Menu_Cursor (This.Bar'Access); + end Get_Menu; + + + + + procedure Undo + (This : in out Editor_Window) is + begin + This.Editor.Undo; + end Undo; + + + + + procedure Cut + (This : in out Editor_Window) is + begin + This.Editor.Cut; + end Cut; + + + + + procedure Copy + (This : in out Editor_Window) is + begin + This.Editor.Copy; + end Copy; + + + + + procedure Paste + (This : in out Editor_Window) is + begin + This.Editor.Paste; + end Paste; + + + + + procedure Delete + (This : in out Editor_Window) is + begin + This.Editor.Delete; + end Delete; + + + + + function Get_Insert_Position + (This : in Editor_Window) + return Natural is + begin + return This.Editor.Get_Insert_Position; + end Get_Insert_Position; + + + + + procedure Set_Insert_Position + (This : in out Editor_Window; + Pos : in Natural) is + begin + This.Editor.Set_Insert_Position (Pos); + end Set_Insert_Position; + + + + + procedure Show_Insert_Position + (This : in out Editor_Window) is + begin + This.Editor.Show_Insert_Position; + end Show_Insert_Position; + + +end Windows.Editor; + diff --git a/src/windows-editor.ads b/src/windows-editor.ads new file mode 100644 index 0000000..a1afdad --- /dev/null +++ b/src/windows-editor.ads @@ -0,0 +1,91 @@ + + +with FLTK.Widgets.Groups.Windows.Double; +with FLTK.Widgets.Menus; +with FLTK.Text_Buffers; +private with FLTK.Widgets.Groups.Text_Displays.Text_Editors; +private with FLTK.Widgets.Menus.Menu_Bars; + + +package Windows.Editor is + + + type Editor_Window is new FLTK.Widgets.Groups.Windows.Double.Double_Window with private; + + + Min_Editor_Height : Integer := 60; + Min_Editor_Width : Integer := 300; + + + function Create + (X, Y, W, H : in Integer; + Label_Text : in String) + return Editor_Window; + + + function Create + (W, H : in Integer) + return Editor_Window; + + + function Get_Buffer + (This : in Editor_Window) + return FLTK.Text_Buffers.Text_Buffer_Cursor; + + + procedure Set_Buffer + (This : in out Editor_Window; + Buff : in out FLTK.Text_Buffers.Text_Buffer); + + + function Get_Menu + (This : in out Editor_Window) + return FLTK.Widgets.Menus.Menu_Cursor; + + + procedure Undo + (This : in out Editor_Window); + + + procedure Cut + (This : in out Editor_Window); + + + procedure Copy + (This : in out Editor_Window); + + + procedure Paste + (This : in out Editor_Window); + + + procedure Delete + (This : in out Editor_Window); + + + function Get_Insert_Position + (This : in Editor_Window) + return Natural; + + + procedure Set_Insert_Position + (This : in out Editor_Window; + Pos : in Natural); + + + procedure Show_Insert_Position + (This : in out Editor_Window); + + +private + + + type Editor_Window is new FLTK.Widgets.Groups.Windows.Double.Double_Window with + record + Bar : aliased FLTK.Widgets.Menus.Menu_Bars.Menu_Bar; + Editor : FLTK.Widgets.Groups.Text_Displays.Text_Editors.Text_Editor; + end record; + + +end Windows.Editor; + diff --git a/src/windows-find.adb b/src/windows-find.adb new file mode 100644 index 0000000..4adc2ac --- /dev/null +++ b/src/windows-find.adb @@ -0,0 +1,130 @@ + + +with FLTK.Widgets; +with FLTK.Widgets.Groups.Windows.Double; +with FLTK.Widgets.Inputs; +with FLTK.Widgets.Buttons; +with FLTK.Widgets.Buttons.Enter; +with FLTK.Widgets.Buttons.Light.Check; + + +package body Windows.Find is + + + package W renames FLTK.Widgets; + package WD renames FLTK.Widgets.Groups.Windows.Double; + package IP renames FLTK.Widgets.Inputs; + package BU renames FLTK.Widgets.Buttons; + package EN renames FLTK.Widgets.Buttons.Enter; + package LC renames FLTK.Widgets.Buttons.Light.Check; + + + + + Find_M : aliased Find_Marshaller; + + overriding procedure Call + (This : in Find_Marshaller; + Item : in out W.Widget'Class) + is + use type BU.State; + type Find_Window_Access is access all Find_Window; + Dialog : access Find_Window := Find_Window_Access (Item.Parent); + begin + if Dialog.Callback /= null then + Dialog.Callback.Call + (Dialog.Find_What.Get_Value, + Dialog.Match_Case.Get_State = BU.On); + end if; + end Call; + + + + + function Create + return Find_Window + is + My_Width : Integer := 350; + My_Height : Integer := 130; + + Button_Width : Integer := 140; + Button_Height : Integer := 40; + + Input_Line : Integer := 10; + Case_Line : Integer := 50; + Button_Line : Integer := 80; + + Input_Width : Integer := 240; + Input_Height : Integer := 25; + Input_Margin_Right : Integer := 10; + + Check_Width : Integer := 100; + Check_Height : Integer := 20; + Case_Margin_Left : Integer := 50; + + Text_Size : Integer := 12; + begin + return This : Find_Window := + (WD.Double_Window'(WD.Create (0, 0, My_Width, My_Height, "Find")) with + + Find_What => IP.Input'(IP.Create + (My_Width - Input_Width - Input_Margin_Right, + Input_Line, Input_Width, Input_Height, "Find what:")), + Match_Case => LC.Check_Button'(LC.Create + (Case_Margin_Left, Case_Line, Check_Width, Check_Height, "Match case")), + Cancel => BU.Button'(BU.Create + ((My_Width - 2 * Button_Width) / 3, + Button_Line, Button_Width, Button_Height, "Cancel")), + Start => EN.Enter_Button'(EN.Create + ((My_Width - 2 * Button_Width) * 2 / 3 + Button_Width, + Button_Line, Button_Width, Button_Height, "Find")), + + Callback => null) do + + This.Add (This.Find_What); + This.Add (This.Match_Case); + This.Add (This.Cancel); + This.Cancel.Set_Callback (Hide_CB'Access); + This.Add (This.Start); + This.Start.Set_Callback (Find_M'Access); + + This.Set_Callback (Hide_CB'Access); + This.Set_Icon (Logo); + This.Set_Modal; + end return; + end Create; + + + + + function Create + (X, Y, W, H : in Integer; + Label_Text : in String) + return Find_Window is + begin + return Create; + end Create; + + + + + function Create + (W, H : in Integer) + return Find_Window is + begin + return Create; + end Create; + + + + + procedure Set_Find_Callback + (This : in out Find_Window; + Func : not null access Find_Callback'Class) is + begin + This.Callback := Func; + end Set_Find_Callback; + + +end Windows.Find; + diff --git a/src/windows-find.ads b/src/windows-find.ads new file mode 100644 index 0000000..b22c8aa --- /dev/null +++ b/src/windows-find.ads @@ -0,0 +1,64 @@ + + +with FLTK.Widgets.Groups.Windows.Double; +with FLTK.Widgets; -- this cannot be made private and I don't know why +private with FLTK.Widgets.Inputs; +private with FLTK.Widgets.Buttons; +private with FLTK.Widgets.Buttons.Enter; +private with FLTK.Widgets.Buttons.Light.Check; + + +package Windows.Find is + + + type Find_Window is new FLTK.Widgets.Groups.Windows.Double.Double_Window with private; + + + type Find_Callback is interface; + procedure Call + (This : in Find_Callback; + Item : in String; + Match_Case : in Boolean) is abstract; + + + function Create + return Find_Window; + + + 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 Set_Find_Callback + (This : in out Find_Window; + Func : not null access Find_Callback'Class); + + +private + + + type Find_Marshaller is new FLTK.Widgets.Widget_Callback with null record; + overriding procedure Call + (This : in Find_Marshaller; + Item : in out FLTK.Widgets.Widget'Class); + + + type Find_Window is new FLTK.Widgets.Groups.Windows.Double.Double_Window with + record + Find_What : FLTK.Widgets.Inputs.Input; + Match_Case : FLTK.Widgets.Buttons.Light.Check.Check_Button; + Cancel : FLTK.Widgets.Buttons.Button; + Start : FLTK.Widgets.Buttons.Enter.Enter_Button; + Callback : access Find_Callback'Class; + end record; + + +end Windows.Find; + diff --git a/src/windows-replace.adb b/src/windows-replace.adb new file mode 100644 index 0000000..5db325a --- /dev/null +++ b/src/windows-replace.adb @@ -0,0 +1,143 @@ + + +with FLTK.Widgets; +with FLTK.Widgets.Groups.Windows.Double; +with FLTK.Widgets.Inputs; +with FLTK.Widgets.Buttons; +with FLTK.Widgets.Buttons.Enter; +with FLTK.Widgets.Buttons.Light.Check; + + +package body Windows.Replace is + + + package W renames FLTK.Widgets; + package WD renames FLTK.Widgets.Groups.Windows.Double; + package IP renames FLTK.Widgets.Inputs; + package BU renames FLTK.Widgets.Buttons; + package EN renames FLTK.Widgets.Buttons.Enter; + package LC renames FLTK.Widgets.Buttons.Light.Check; + + + + + Replace_M : aliased Replace_Marshaller; + + overriding procedure Call + (This : in Replace_Marshaller; + Item : in out W.Widget'Class) + is + use type BU.State; + type Replace_Window_Access is access all Replace_Window; + Dialog : access Replace_Window := Replace_Window_Access (Item.Parent); + begin + if Dialog.Callback /= null then + Dialog.Callback.Call + (Dialog.Find_What.Get_Value, + Dialog.Replace_With.Get_Value, + Dialog.Match_Case.Get_State = BU.On, + Dialog.Replace_All.Get_State = BU.On); + end if; + end Call; + + + + + function Create + return Replace_Window + is + My_Width : Integer := 350; + My_Height : Integer := 180; + + Button_Width : Integer := 140; + Button_Height : Integer := 40; + + Find_Line : Integer := 10; + Replace_Line : Integer := 40; + Match_Line : Integer := 80; + Rep_All_Line : Integer := 100; + Button_Line : Integer := 130; + + Input_Width : Integer := 220; + Input_Height : Integer := 25; + Input_Margin_Right : Integer := 10; + + Check_Width : Integer := 100; + Check_Height : Integer := 20; + Check_Margin_Left : Integer := 50; + + Text_Size : Integer := 12; + begin + return This : Replace_Window := + (WD.Double_Window'(WD.Create (0, 0, My_Width, My_Height, "Replace")) with + + Find_What => IP.Input'(IP.Create + (My_Width - Input_Width - Input_Margin_Right, + Find_Line, Input_Width, Input_Height, "Find what:")), + Replace_With => IP.Input'(IP.Create + (My_Width - Input_Width - Input_Margin_Right, + Replace_Line, Input_Width, Input_Height, "Replace with:")), + Match_Case => LC.Check_Button'(LC.Create + (Check_Margin_Left, Match_Line, + Check_Width, Check_Height, "Match case")), + Replace_All => LC.Check_Button'(LC.Create + (Check_Margin_Left, Rep_All_Line, + Check_Width, Check_Height, "Replace all")), + Cancel => BU.Button'(BU.Create + ((My_Width - 2 * Button_Width) / 3, + Button_Line, Button_Width, Button_Height, "Cancel")), + Start => EN.Enter_Button'(EN.Create + ((My_Width - 2 * Button_Width) * 2 / 3 + Button_Width, + Button_Line, Button_Width, Button_Height, "Replace")), + + Callback => null) do + + This.Add (This.Find_What); + This.Add (This.Replace_With); + This.Add (This.Match_Case); + This.Add (This.Replace_All); + This.Add (This.Cancel); + This.Cancel.Set_Callback (Hide_CB'Access); + This.Add (This.Start); + This.Start.Set_Callback (Replace_M'Access); + + This.Set_Callback (Hide_CB'Access); + This.Set_Icon (Logo); + This.Set_Modal; + end return; + end Create; + + + + + function Create + (X, Y, W, H : in Integer; + Label_Text : in String) + return Replace_Window is + begin + return Create; + end Create; + + + + + function Create + (W, H : in Integer) + return Replace_Window is + begin + return Create; + end Create; + + + + + procedure Set_Replace_Callback + (This : in out Replace_Window; + Func : not null access Replace_Callback'Class) is + begin + This.Callback := Func; + end Set_Replace_Callback; + + +end Windows.Replace; + diff --git a/src/windows-replace.ads b/src/windows-replace.ads new file mode 100644 index 0000000..ef5106b --- /dev/null +++ b/src/windows-replace.ads @@ -0,0 +1,64 @@ + + +with FLTK.Widgets.Groups.Windows.Double; +with FLTK.Widgets; -- this cannot be made private and I don't know why +private with FLTK.Widgets.Inputs; +private with FLTK.Widgets.Buttons; +private with FLTK.Widgets.Buttons.Enter; +private with FLTK.Widgets.Buttons.Light.Check; + + +package Windows.Replace is + + + type Replace_Window is new FLTK.Widgets.Groups.Windows.Double.Double_Window with private; + + + type Replace_Callback is interface; + procedure Call + (This : in Replace_Callback; + Item, Replace_With : in String; + Match_Case, Rep_All : in Boolean) is abstract; + + + function Create + return Replace_Window; + + + 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 Set_Replace_Callback + (This : in out Replace_Window; + Func : not null access Replace_Callback'Class); + + +private + + + type Replace_Marshaller is new FLTK.Widgets.Widget_Callback with null record; + overriding procedure Call + (This : in Replace_Marshaller; + Item : in out FLTK.Widgets.Widget'Class); + + + type Replace_Window is new FLTK.Widgets.Groups.Windows.Double.Double_Window with + record + Find_What, Replace_With : FLTK.Widgets.Inputs.Input; + Match_Case, Replace_All : FLTK.Widgets.Buttons.Light.Check.Check_Button; + Cancel : FLTK.Widgets.Buttons.Button; + Start : FLTK.Widgets.Buttons.Enter.Enter_Button; + Callback : access Replace_Callback'Class; + end record; + + +end Windows.Replace; + diff --git a/src/windows.adb b/src/windows.adb new file mode 100644 index 0000000..646ffb4 --- /dev/null +++ b/src/windows.adb @@ -0,0 +1,44 @@ + + +with FLTK.Widgets; +with FLTK.Widgets.Groups; +with FLTK.Widgets.Groups.Windows; + + +package body Windows is + + + package W renames FLTK.Widgets; + package G renames FLTK.Widgets.Groups; + package WN renames FLTK.Widgets.Groups.Windows; + + + + + -- used to hide about/find/replace/etc windows instead + -- of constantly creating and destroying them + + overriding procedure Call + (This : in Hide_Callback; + Item : in out W.Widget'Class) + is + P : access G.Group'Class; + begin + if Item in WN.Window'Class then + WN.Window (Item).Hide; + else + P := Item.Parent; + loop + if P = null then + return; + end if; + exit when P.all in WN.Window'Class; + P := P.Parent; + end loop; + WN.Window (P.all).Hide; + end if; + end Call; + + +end Windows; + diff --git a/src/windows.ads b/src/windows.ads new file mode 100644 index 0000000..3144bba --- /dev/null +++ b/src/windows.ads @@ -0,0 +1,28 @@ + + +with FLTK.Images.RGB.PNG; +private with FLTK.Widgets; + + +package Windows is + + + Logo : FLTK.Images.RGB.PNG.PNG_Image := FLTK.Images.RGB.PNG.Create ("logo.png"); + + +private + + + type Hide_Callback is new FLTK.Widgets.Widget_Callback with null record; + + + overriding procedure Call + (This : in Hide_Callback; + Item : in out FLTK.Widgets.Widget'Class); + + + Hide_CB : aliased Hide_Callback; + + +end Windows; + @@ -2,7 +2,6 @@ To Do: -- put find/replace/about in their own packages - change build to be dynamically linked - remove the need for unchecked_access callbacks - improve find, replace, undo/redo |