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) 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 := (Double_Window'(Create (X, Y, Width, Height, Label_Text)) with Editor => Text_Editor'(Create (0, Menu_Height, Width, Height - Menu_Height, "")), Bar => Menu_Bar'(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); 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 Text_Buffer_Cursor is begin return This.Editor.Get_Buffer; end Get_Buffer; procedure Set_Buffer (This : in out Editor_Window; Buff : in out Text_Buffer) is begin This.Editor.Set_Buffer (Buff); end Set_Buffer; function Get_Menu (This : in out Editor_Window) return Menu_Cursor is begin return Ref : 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; -- 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 -- -- this is an ugly hack -- -- it only works because the Item will either be the About/Find/Replace window -- directly or it'll be a close/cancel button in said window -- -- need to figure out how to properly loop up via Widget Parent method -- if Item in Window'Class then Window (Item).Hide; else Window (Item.Parent.Data.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; 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 := (Double_Window'(Create (0, 0, My_Width, My_Height, "About Adapad")) with Heading => Box'(Create (0, Heading_Line, My_Width, Heading_Size, Heading_Text)), Blurb => Box'(Create (0, Blurb_Line, My_Width, Text_Size, Blurb_Text)), Author => Box'(Create (0, Author_Line, My_Width, Text_Size, Author_Text)), Dismiss => Enter_Button'(Create ((My_Width - Button_Width) / 2, Button_Line, Button_Width, Button_Height, "Close"))) do This.Add (This.Heading); This.Heading.Set_Label_Size (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); 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 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 := (Double_Window'(Create (0, 0, My_Width, My_Height, "Find")) with Find_What => Input'(Create (My_Width - Input_Width - Input_Margin_Right, Input_Line, Input_Width, Input_Height, "Find what:")), Match_Case => Check_Button'(Create (Case_Margin_Left, Case_Line, Check_Width, Check_Height, "Match case")), Cancel => Button'(Create ((My_Width - 2 * Button_Width) / 3, Button_Line, Button_Width, Button_Height, "Cancel")), Start => Enter_Button'(Create ((My_Width - 2 * Button_Width) * 2 / 3 + Button_Width, Button_Line, Button_Width, Button_Height, "Find"))) 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.Set_Callback (Hide_CB'Access); 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_Function (This : in out Find_Window; Func : access procedure (Item : in String)) is begin null; end Set_Function; -- Replace_Window functions and procedures 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 := (Double_Window'(Create (0, 0, My_Width, My_Height, "Replace")) with Find_What => Input'(Create (My_Width - Input_Width - Input_Margin_Right, Find_Line, Input_Width, Input_Height, "Find what:")), Replace_With => Input'(Create (My_Width - Input_Width - Input_Margin_Right, Replace_Line, Input_Width, Input_Height, "Replace with:")), Match_Case => Check_Button'(Create (Check_Margin_Left, Match_Line, Check_Width, Check_Height, "Match case")), Replace_All => Check_Button'(Create (Check_Margin_Left, Rep_All_Line, Check_Width, Check_Height, "Replace all")), Cancel => Button'(Create ((My_Width - 2 * Button_Width) / 3, Button_Line, Button_Width, Button_Height, "Cancel")), Start => Enter_Button'(Create ((My_Width - 2 * Button_Width) * 2 / 3 + Button_Width, Button_Line, Button_Width, Button_Height, "Replace"))) 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.Set_Callback (Hide_CB'Access); 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_Function (This : in out Replace_Window; Func : access procedure (Item : in String)) is begin null; end Set_Function; end Editor_Windows;