diff options
Diffstat (limited to 'src/editor_windows.adb')
| -rw-r--r-- | src/editor_windows.adb | 538 |
1 files changed, 0 insertions, 538 deletions
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; - |