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, Height : Integer; begin if W < 300 then Width := 300; else Width := W; end if; if H < 60 then Height := 60; else Height := H; end if; return This : Editor_Window := (Double_Window'(Create (X, Y, Width, Height, Label_Text)) with Editor => Text_Editor'(Create (0, 30, Width, Height - 30, "")), Bar => Menu_Bar'(Create (0, 0, Width, 30, ""))) do This.Add (This.Editor); This.Add (This.Bar); This.Editor.Set_Text_Font (Courier); 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 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;