path: root/src/adapad.adb

with FLTK;
with Editors;
use Editors;
with FLTK.Text_Buffers;
use FLTK.Text_Buffers;
with FLTK.Widgets;
use FLTK.Widgets;
with FLTK.Widgets.Menus;
use FLTK.Widgets.Menus;


with Ada.Text_IO;


function AdaPad return Integer is


    Pad : aliased Editor_Window := Create (0, 0, 640, 400, "AdaPad");
    Buff : aliased Text_Buffer := Create;




    type Editor_Callback is abstract new Widget_Callback with
        record
            Editor : access Editor_Window := Pad'Access;
            Buffer : access Text_Buffer := Buff'Access;
        end record;




    type New_Callback is new Editor_Callback with null record;
    New_CB : aliased New_Callback;


    overriding procedure Call
           (This : in     New_Callback;
            Item : in out Widget'Class) is
    begin
        Ada.Text_IO.Put_Line ("New callback executed.");
    end Call;




    type Open_Callback is new Editor_Callback with null record;
    Open_CB : aliased Open_Callback;


    overriding procedure Call
           (This : in     Open_Callback;
            Item : in out Widget'Class) is
    begin
        Ada.Text_IO.Put_Line ("Open callback executed.");
    end Call;




    type Save_Callback is new Editor_Callback with null record;
    Save_CB : aliased Save_Callback;


    overriding procedure Call
           (This : in     Save_Callback;
            Item : in out Widget'Class) is
    begin
        Ada.Text_IO.Put_Line ("Save callback executed.");
    end Call;




    type Save_As_Callback is new Editor_Callback with null record;
    Save_As_CB : aliased Save_As_Callback;


    overriding procedure Call
           (This : in     Save_As_Callback;
            Item : in out Widget'Class) is
    begin
        Ada.Text_IO.Put_Line ("Save As callback executed.");
    end Call;




    type Quit_Callback is new Editor_Callback with null record;
    Quit_CB : aliased Quit_Callback;


    overriding procedure Call
           (This : in     Quit_Callback;
            Item : in out Widget'Class) is
    begin
        Ada.Text_IO.Put_Line ("Quit callback executed.");
    end Call;




    type Undo_Callback is new Editor_Callback with null record;
    Undo_CB : aliased Undo_Callback;


    overriding procedure Call
           (This : in     Undo_Callback;
            Item : in out Widget'Class) is
    begin
        Ada.Text_IO.Put_Line ("Undo callback executed.");
    end Call;




    type Cut_Callback is new Editor_Callback with null record;
    Cut_CB : aliased Cut_Callback;


    overriding procedure Call
           (This : in     Cut_Callback;
            Item : in out Widget'Class) is
    begin
        This.Editor.Cut;
    end Call;




    type Copy_Callback is new Editor_Callback with null record;
    Copy_CB : aliased Copy_Callback;


    overriding procedure Call
           (This : in     Copy_Callback;
            Item : in out Widget'Class) is
    begin
        This.Editor.Copy;
    end Call;




    type Paste_Callback is new Editor_Callback with null record;
    Paste_CB : aliased Paste_Callback;


    overriding procedure Call
           (This : in     Paste_Callback;
            Item : in out Widget'Class) is
    begin
        This.Editor.Paste;
    end Call;




    type Delete_Callback is new Editor_Callback with null record;
    Delete_CB : aliased Delete_Callback;


    overriding procedure Call
           (This : in     Delete_Callback;
            Item : in out Widget'Class) is
    begin
        This.Editor.Delete;
    end Call;




    type Find_Callback is new Editor_Callback with null record;
    Find_CB : aliased Find_Callback;


    overriding procedure Call
           (This : in     Find_Callback;
            Item : in out Widget'Class) is
    begin
        Ada.Text_IO.Put_Line ("Find callback executed.");
    end Call;




    type Replace_Callback is new Editor_Callback with null record;
    Replace_CB : aliased Replace_Callback;


    overriding procedure Call
           (This : in     Replace_Callback;
            Item : in out Widget'Class) is
    begin
        Ada.Text_IO.Put_Line ("Replace callback executed.");
    end Call;




    type About_Callback is new Editor_Callback with null record;
    About_CB : aliased About_Callback;


    overriding procedure Call
           (This : in     About_Callback;
            Item : in out Widget'Class) is
    begin
        Ada.Text_IO.Put_Line ("About callback executed.");
    end Call;




    type Mod_Callback is new Modify_Callback with null record;
    Mod_CB : aliased Mod_Callback;


    overriding procedure Call
           (This         : in Mod_Callback;
            Action       : in Modification;
            Place        : in Position;
            Length       : in Natural;
            Deleted_Text : in String) is
    begin
        Ada.Text_IO.Put_Line ("Modify of Type: " & Modification'Image (Action) &
                              " Place: " & Position'Image (Place) &
                              " Length: " & Integer'Image (Length));
    end Call;




    type Pre_Callback is new Predelete_Callback with null record;
    Pre_CB : aliased Pre_Callback;


    overriding procedure Call
           (This   : in Pre_Callback;
            Place  : in Position;
            Length : in Natural) is
    begin
        Ada.Text_IO.Put_Line ("Predelete at Place: " & Position'Image (Place) &
                              " Length: " & Integer'Image (Length));
    end Call;


begin


    Buff.Add_Modify_Callback (Mod_CB'Access);
    Buff.Add_Predelete_Callback (Pre_CB'Access);


    declare
        Bar : Menu_Cursor := Pad.Get_Menu;
    begin
        Bar.Add (Text => "&File", Shortcut => Mod_Alt + 'f', Flags => Flag_Submenu);
        Bar.Add ("File/&New",          New_CB'Access,      Mod_Ctrl + 'n');
        Bar.Add ("File/&Open...",      Open_CB'Access,     Mod_Ctrl + 'o');
        Bar.Add ("File/&Save",         Save_CB'Access,     Mod_Ctrl + 's');
        Bar.Add ("File/Save &As...",   Save_As_CB'Access,  Mod_Shift + Mod_Ctrl + 's');
        Bar.Add ("File/&Quit",         Quit_CB'Access,     Mod_Ctrl + 'q');

        Bar.Add (Text => "&Edit", Shortcut => Mod_Alt + 'e', Flags => Flag_Submenu);
        Bar.Add ("Edit/&Undo",         Undo_CB'Access,     Mod_Ctrl + 'z');
        Bar.Add ("Edit/Cu&t",          Cut_CB'Access,      Mod_Ctrl + 'x');
        Bar.Add ("Edit/&Copy",         Copy_CB'Access,     Mod_Ctrl + 'c');
        Bar.Add ("Edit/&Paste",        Paste_CB'Access,    Mod_Ctrl + 'v');
        Bar.Add ("Edit/&Delete",       Delete_CB'Access);

        Bar.Add (Text => "&Search", Shortcut => Mod_Alt + 's', Flags => Flag_Submenu);
        Bar.Add ("Search/&Find...",    Find_CB'Access,     Mod_Ctrl + 'f');
        Bar.Add ("Search/&Replace...", Replace_CB'Access,  Mod_Ctrl + 'h');

        Bar.Add (Text => "&Help", Shortcut => Mod_Alt + 'h', Flags => Flag_Submenu);
        Bar.Add ("Help/&About",        About_CB'Access);
    end;


    Pad.Set_Buffer (Buff);
    Pad.Show;
    return FLTK.Run;


end AdaPad;