------------------------------------------------------------------------------
--               GtkAda - Ada95 binding for the Gimp Toolkit                --
--                                                                          --
--                     Copyright (C) 2010-2018, AdaCore                     --
--                                                                          --
-- This library is free software;  you can redistribute it and/or modify it --
-- under terms of the  GNU General Public License  as published by the Free --
-- Software  Foundation;  either version 3,  or (at your  option) any later --
-- version. This library is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.                            --
--                                                                          --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception,   --
-- version 3.1, as published by the Free Software Foundation.               --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Text_IO;         use Ada.Text_IO;

with Glib;                use Glib;
with Glib.Main;           use Glib.Main;

with Gtk;                 use Gtk;
with Gtk.Alignment;       use Gtk.Alignment;
with Gtk.Assistant;       use Gtk.Assistant;
with Gtk.Bin;             use Gtk.Bin;
with Gtk.Box;             use Gtk.Box;
with Gtk.Button;          use Gtk.Button;
with Gtk.Check_Button;    use Gtk.Check_Button;
with Gtk.Enums;           use Gtk.Enums;
with Gtk.Frame;           use Gtk.Frame;
with Gtk.Handlers;        use Gtk.Handlers;
with Gtk.Label;           use Gtk.Label;
with Gtk.Progress_Bar;    use Gtk.Progress_Bar;
with Gtk.Radio_Button;    use Gtk.Radio_Button;
with Gtk.Stock;           use Gtk.Stock;
with Gtk.Toggle_Button;   use Gtk.Toggle_Button;
with Gtk.Widget;          use Gtk.Widget;

with Common;              use Common;

package body Create_Assistant is

   -----------------
   -- Local Types --
   -----------------

   type Page_Data_Record is record
      Assistant : Gtk_Assistant;
      Page      : Gtk_Vbox;
   end record;
   type Page_Data is access Page_Data_Record;
   --  User data for Check_Button_Page_Data_Cb callback package.

   type Assistant_Type is
     (Simple, Generous, Nonlinear, Looping, Full_Featured);
   All_Assistants : array (Assistant_Type) of Gtk_Assistant :=
     (others => null);
   --  For every assistant type, we toggle assistants on and off on
   --  each main window button click.  In order to do this we need
   --  to keep track of all assistants that we bring up.

   -------------------------------------
   -- Callback Package Instantiations --
   -------------------------------------

   package Time_Cb is new Glib.Main.Generic_Sources (Gtk_Assistant);
   package Assistant_Cb is new Handlers.Callback (Gtk_Assistant_Record);
   package Check_Button_Widget_Cb is new Handlers.User_Callback
     (Gtk_Check_Button_Record, Gtk_Widget);
   package Check_Button_Page_Data_Cb is new Handlers.User_Callback
     (Gtk_Check_Button_Record, Page_Data);
   package Radio_Button_Char_Cb is new Handlers.User_Callback
     (Gtk_Radio_Button_Record, Character);
   package Forward_Page_Functions is new Set_Forward_Page_Func_User_Data
     (Gtk_Assistant);
   use Forward_Page_Functions;

   ----------
   -- Help --
   ----------

   function Help return String is
   begin
      return "a @bGtk_Assistant@B is a kind of @bGtk_Window@B that is used"
        & " to guide users through multi-step operations, and appears as a"
        & " dialog with multiple stages.  An application might use this type"
        & " of functionality to create wizards.";
   end Help;

   -----------------------
   -- Complete_Callback --
   -----------------------

   procedure Complete_Callback
     (Check : access Gtk_Check_Button_Record'Class;
      Data  : Page_Data)
   is
      Complete : Boolean;
   begin
      Complete := Get_Active (Check);
      Set_Page_Complete (Data.Assistant, Data.Page, Complete);
   end Complete_Callback;

   ------------------------------
   -- Add_Completion_Test_Page --
   ------------------------------

   function Add_Completion_Test_Page
     (Assistant : Gtk_Assistant;
      Text      : String;
      Visible   : Boolean;
      Complete  : Boolean)
     return Gtk_Vbox
   is
      Page   : Gtk_Vbox;
      Check  : Gtk_Check_Button;
      Label1 : Gtk_Label;
      Data   : constant Page_Data := new Page_Data_Record;
      Tmp    : Gint;
      pragma Warnings (Off, Tmp);
   begin
      Gtk_New_Vbox (Page);
      Gtk_New (Check, "Complete");
      Gtk_New (Label1, Text);

      Add (Page, Label1);
      Add (Page, Check);

      Set_Active (Check, Complete);

      Data.Assistant := Assistant;
      Data.Page := Page;
      Check_Button_Page_Data_Cb.Connect
        (Check, "toggled", Complete_Callback'Access, Data);

      if Visible then
         Show_All (Page);
      end if;

      Tmp := Append_Page (Assistant, Page);
      Set_Page_Title (Assistant, Page, Text);
      Set_Page_Complete (Assistant, Page, Complete);

      return Page;
   end Add_Completion_Test_Page;

   ---------------------
   -- Cancel_Callback --
   ---------------------

   procedure Cancel_Callback
      (Assistant : access Gtk_Assistant_Record'Class) is
   begin
      Put_Line ("cancel");
      Hide (Assistant);
   end Cancel_Callback;

   --------------------
   -- Close_Callback --
   --------------------

   procedure Close_Callback
      (Assistant : access Gtk_Assistant_Record'Class) is
   begin
      Put_Line ("close");
      Hide (Assistant);
   end Close_Callback;

   --------------------
   -- Apply_Callback --
   --------------------

   procedure Apply_Callback
      (Assistant : access Gtk_Assistant_Record'Class)
   is
      pragma Unreferenced (Assistant);
   begin
      Put_Line ("apply");
   end Apply_Callback;

   ----------------------
   -- Progress_Timeout --
   ----------------------

   function Progress_Timeout (Assistant : Gtk_Assistant) return Boolean is
      Page_Num : constant Gint := Get_Current_Page (Assistant);
      Page     : constant Gtk_Bin :=
                   Gtk_Bin (Get_Nth_Page (Assistant, Page_Num));
      Progress : constant Gtk_Progress_Bar :=
                   Gtk_Progress_Bar (Get_Child (Page));

      Value    : Gdouble;
   begin
      Value := Get_Fraction (Progress);
      Value := Value + 0.1;
      Set_Fraction (Progress, Value);

      if Value >= 1.0 then
         Set_Page_Complete (Assistant, Page, True);
         return False;
      end if;

      return True;
   end Progress_Timeout;

   ----------------------
   -- Prepare_Callback --
   ----------------------

   procedure Prepare_Callback
     (Assistant : access Gtk_Assistant_Record'Class)
   is
      Page : constant Gtk_Widget :=
        Get_Nth_Page (Assistant, Get_Current_Page (Assistant));
   begin
      if Page.all in Gtk_Label_Record'Class then
         Put_Line ("prepare: " & Get_Text (Gtk_Label (Page)));

      elsif Get_Page_Type (Assistant, Page) = Gtk_Assistant_Page_Progress then
         declare
            Progress : constant Gtk_Progress_Bar :=
                       Gtk_Progress_Bar (Get_Child (Gtk_Alignment (Page)));
            Timer    : G_Source_Id;
            pragma Warnings (Off, Timer);
         begin
            Set_Page_Complete (Assistant, Page, False);
            Set_Fraction (Progress, 0.0);
            Timer := Time_Cb.Timeout_Add
              (300, Progress_Timeout'Access, Gtk_Assistant (Assistant));
         end;

      else
         Put_Line ("prepare: " & Gint'Image (Get_Current_Page (Assistant)));
      end if;
   end Prepare_Callback;

   -----------------------------
   -- Create_Simple_Assistant --
   -----------------------------

   procedure Create_Simple_Assistant
     (Widget : access Gtk_Button_Record'Class)
   is
      pragma Warnings (Off, Widget);
      Assistant : Gtk_Assistant renames All_Assistants (Simple);
      Page      : Gtk_Label;
      Page_Num  : Gint;
      pragma Warnings (Off, Page_Num);
   begin
      if Assistant = null then
         Gtk_New (Assistant);
         Set_Default_Size (Assistant, 400, 300);

         Assistant_Cb.Connect (Assistant, "cancel",  Cancel_Callback'Access);
         Assistant_Cb.Connect (Assistant, "close",   Close_Callback'Access);
         Assistant_Cb.Connect (Assistant, "apply",   Apply_Callback'Access);
         Assistant_Cb.Connect (Assistant, "prepare", Prepare_Callback'Access);

         Gtk_New (Page, "Page 1");
         Show (Page);
         Page_Num := Append_Page (Assistant, Page);
         Set_Page_Title (Assistant, Page, "Page 1");
         Set_Page_Complete (Assistant, Page, True);

         Gtk_New (Page, "Page 2");
         Show (Page);
         Page_Num := Append_Page (Assistant, Page);
         Set_Page_Title (Assistant, Page, "Page 2");
         Set_Page_Type (Assistant, Page, Gtk_Assistant_Page_Confirm);
         Set_Page_Complete (Assistant, Page, True);
      end if;

      if not Assistant.Get_Visible then
         Show (Assistant);
      else
         Destroy (Assistant);
         Assistant := null;
      end if;
   end Create_Simple_Assistant;

   ----------------------
   -- Visible_Callback --
   ----------------------

   procedure Visible_Callback
     (Check : access Gtk_Check_Button_Record'Class;
      Page  : Gtk_Widget)
   is
      Visible : constant Boolean := Get_Active (Check);
   begin
      if Visible then
         Show (Page);
      else
         Hide (Page);
      end if;
   end Visible_Callback;

   -------------------------------
   -- Create_Generous_Assistant --
   -------------------------------

   procedure Create_Generous_Assistant
     (Widget : access Gtk_Button_Record'Class)
   is
      pragma Unreferenced (Widget);
      Assistant : Gtk_Assistant renames All_Assistants (Generous);
   begin
      if Assistant = null then
         Gtk_New (Assistant);
         Set_Default_Size (Assistant, 400, 300);

         Assistant_Cb.Connect (Assistant, "cancel",  Cancel_Callback'Access);
         Assistant_Cb.Connect (Assistant, "close",   Close_Callback'Access);
         Assistant_Cb.Connect (Assistant, "apply",   Apply_Callback'Access);
         Assistant_Cb.Connect (Assistant, "prepare", Prepare_Callback'Access);

         declare
            Tmp                    : Gint;
            Label1                 : Gtk_Label;
            Content_Page,
            More_Content_Page,
            Even_More_Content_Page : Gtk_Vbox;
            Check                  : Gtk_Check_Button;
            Alignment1             : Gtk_Alignment;
            Progress_Bar1          : Gtk_Progress_Bar;
            pragma Warnings (Off, Tmp);
            pragma Warnings (Off, Even_More_Content_Page);
         begin
            Gtk_New (Label1, "Introduction");
            Show (Label1);
            Tmp := Append_Page (Assistant, Label1);
            Set_Page_Title (Assistant, Label1, "Introduction");
            Set_Page_Type (Assistant, Label1, Gtk_Assistant_Page_Intro);
            Set_Page_Complete (Assistant, Label1, True);

            Content_Page := Add_Completion_Test_Page
              (Assistant, "Content", True, False);
            More_Content_Page := Add_Completion_Test_Page
              (Assistant, "More Content", True, True);

            Gtk_New (Check, "Next page visible");
            Set_Active (Check, True);
            Check_Button_Widget_Cb.Connect
              (Check, "toggled",
               Check_Button_Widget_Cb.To_Marshaller (Visible_Callback'Access),
               Gtk_Widget (More_Content_Page));
            Show (Check);
            Add (Content_Page, Check);

            Even_More_Content_Page := Add_Completion_Test_Page
              (Assistant, "Even More Content", True, True);

            Gtk_New (Label1, "Confirmation");
            Show (Label1);
            Tmp := Append_Page (Assistant, Label1);
            Set_Page_Title (Assistant, Label1, "Confirmation");
            Set_Page_Type (Assistant, Label1, Gtk_Assistant_Page_Confirm);
            Set_Page_Complete (Assistant, Label1, True);

            Gtk_New (Alignment1, 0.5, 0.5, 0.9, 0.0);
            Gtk_New (Progress_Bar1);
            Add (Alignment1, Progress_Bar1);
            Show_All (Alignment1);
            Tmp := Append_Page (Assistant, Alignment1);
            Set_Page_Title (Assistant, Alignment1, "Progress");
            Set_Page_Type (Assistant, Alignment1, Gtk_Assistant_Page_Progress);

            Gtk_New (Label1, "Summary");
            Show (Label1);
            Tmp := Append_Page (Assistant, Label1);
            Set_Page_Title (Assistant, Label1, "Summary");
            Set_Page_Type (Assistant, Label1, Gtk_Assistant_Page_Summary);
            Set_Page_Complete (Assistant, Label1, True);
         end;

      end if;

      if not Assistant.Get_Visible then
         Show (Assistant);
      else
         Destroy (Assistant);
         Assistant := null;
      end if;
   end Create_Generous_Assistant;

   -------------------
   -- Select_Branch --
   -------------------

   Selected_Branch : Character := 'A';

   procedure Select_Branch
     (Button : access Gtk_Radio_Button_Record'Class;
      Branch : Character)
   is
      pragma Unreferenced (Button);
   begin
      Selected_Branch := Branch;
   end Select_Branch;

   --------------------------------------
   -- Nonlinear_Assistant_Forward_Page --
   --------------------------------------

   function Nonlinear_Assistant_Forward_Page
     (Current_Page : Gint) return Gint is
   begin
      case Current_Page is
         when 0 =>
            case Selected_Branch is
               when 'A' => return 1;
               when 'B' => return 2;
               when others => return -1;
            end case;
         when 1 | 2 =>
            return 3;
         when others =>
            return -1;
      end case;
   end Nonlinear_Assistant_Forward_Page;

   --------------------------------
   -- Create_Nonlinear_Assistant --
   --------------------------------

   procedure Create_Nonlinear_Assistant
     (Widget : access Gtk_Button_Record'Class)
   is
      Assistant    : Gtk_Assistant renames All_Assistants (Nonlinear);
      Page         : Gtk_Vbox;
      Label        : Gtk_Label;
      Radio_Button : Gtk_Radio_Button;
      Tmp          : Gint;
      pragma Unreferenced (Widget);
      pragma Warnings (Off, Tmp);
   begin
      if Assistant = null then
         Gtk_New (Assistant);
         Set_Default_Size (Assistant, 400, 300);

         Assistant_Cb.Connect (Assistant, "cancel",  Cancel_Callback'Access);
         Assistant_Cb.Connect (Assistant, "close",   Close_Callback'Access);
         Assistant_Cb.Connect (Assistant, "apply",   Apply_Callback'Access);
         Assistant_Cb.Connect (Assistant, "prepare", Prepare_Callback'Access);

         Assistant.Set_Forward_Page_Func
           (Nonlinear_Assistant_Forward_Page'Access);

         Gtk_New_Vbox (Page, False, 6);

         Gtk_New (Radio_Button, Label => "branch A");
         Pack_Start (Page, Radio_Button, False, False, 0);
         Radio_Button_Char_Cb.Connect
           (Radio_Button, "toggled", Select_Branch'Access, 'A');
         Set_Active (Radio_Button, True);

         Gtk_New (Radio_Button, Radio_Button, "branch B");
         Pack_Start (Page, Radio_Button, False, False, 0);
         Radio_Button_Char_Cb.Connect
           (Radio_Button, "toggled", Select_Branch'Access, 'B');

         Show_All (Page);
         Tmp := Append_Page (Assistant, Page);
         Set_Page_Title (Assistant, Page, "Page 1");
         Set_Page_Complete (Assistant, Page, True);

         Gtk_New (Label, "Page 2A");
         Show (Label);
         Tmp := Append_Page (Assistant, Label);
         Set_Page_Title (Assistant, Label, "Page 2A");
         Set_Page_Complete (Assistant, Label, True);

         Gtk_New (Label, "Page 2B");
         Show (Label);
         Tmp := Append_Page (Assistant, Label);
         Set_Page_Title (Assistant, Label, "Page 2B");
         Set_Page_Complete (Assistant, Label, True);

         Gtk_New (Label, "Confirmation");
         Show (Label);
         Tmp := Append_Page (Assistant, Label);
         Set_Page_Title (Assistant, Label, "Confirmation");
         Set_Page_Type (Assistant, Label, Gtk_Assistant_Page_Confirm);
         Set_Page_Complete (Assistant, Label, True);
      end if;

      if not Assistant.Get_Visible then
         Show (Assistant);
      else
         Destroy (Assistant);
         Assistant := null;
      end if;
   end Create_Nonlinear_Assistant;

   ------------------------------------
   -- Looping_Assistant_Forward_Page --
   ------------------------------------

   function Looping_Assistant_Forward_Page
     (Current_Page : Gint;
      Assistant    : Gtk_Assistant)
      return Gint
   is
   begin
      case Current_Page is
         when 0 .. 2 =>
            return Current_Page + 1;
         when 3 =>
            declare
               Loop_Toggle_Button : constant Gtk_Toggle_Button :=
                 Gtk_Toggle_Button (Get_Nth_Page (Assistant, Current_Page));
               Should_Loop : constant Boolean :=
                 Get_Active (Loop_Toggle_Button);
            begin
               if Should_Loop then
                  return 0;
               else
                  return 4;
               end if;
            end;
         when others =>
            return -1;
      end case;
   end Looping_Assistant_Forward_Page;

   ------------------------------
   -- Create_Looping_Assistant --
   ------------------------------

   procedure Create_Looping_Assistant
     (Widget : access Gtk_Button_Record'Class)
   is
      Assistant    : Gtk_Assistant renames All_Assistants (Looping);
      Label        : Gtk_Label;
      Check_Button : Gtk_Check_Button;
      Tmp          : Gint;
      pragma Unreferenced (Widget);
      pragma Warnings (Off, Tmp);
   begin
      if Assistant = null then
         Gtk_New (Assistant);
         Set_Default_Size (Assistant, 400, 300);

         Assistant_Cb.Connect (Assistant, "cancel",  Cancel_Callback'Access);
         Assistant_Cb.Connect (Assistant, "close",   Close_Callback'Access);
         Assistant_Cb.Connect (Assistant, "apply",   Apply_Callback'Access);
         Assistant_Cb.Connect (Assistant, "prepare", Prepare_Callback'Access);

         Forward_Page_Functions.Set_Forward_Page_Func
           (Assistant, Looping_Assistant_Forward_Page'Access, Assistant);

         Gtk_New (Label, "Introduction");
         Show (Label);
         Tmp := Append_Page (Assistant, Label);
         Set_Page_Title (Assistant, Label, "Introduction");
         Set_Page_Type (Assistant, Label, Gtk_Assistant_Page_Intro);
         Set_Page_Complete (Assistant, Label, True);

         Gtk_New (Label, "Content");
         Show (Label);
         Tmp := Append_Page (Assistant, Label);
         Set_Page_Title (Assistant, Label, "Content");
         Set_Page_Complete (Assistant, Label, True);

         Gtk_New (Label, "More content");
         Show (Label);
         Tmp := Append_Page (Assistant, Label);
         Set_Page_Title (Assistant, Label, "More content");
         Set_Page_Complete (Assistant, Label, True);

         Gtk_New (Check_Button, "Loop?");
         Show (Check_Button);
         Tmp := Append_Page (Assistant, Check_Button);
         Set_Page_Title (Assistant, Check_Button, "Loop?");
         Set_Page_Complete (Assistant, Check_Button, True);

         Gtk_New (Label, "Confirmation");
         Show (Label);
         Tmp := Append_Page (Assistant, Label);
         Set_Page_Title (Assistant, Label, "Confirmation");
         Set_Page_Type (Assistant, Label, Gtk_Assistant_Page_Confirm);
         Set_Page_Complete (Assistant, Label, True);
      end if;

      if not Assistant.Get_Visible then
         Show (Assistant);
      else
         Destroy (Assistant);
         Assistant := null;
      end if;
   end Create_Looping_Assistant;

   ------------------------------------
   -- Create_Full_Featured_Assistant --
   ------------------------------------

   procedure Create_Full_Featured_Assistant
     (Widget : access Gtk_Button_Record'Class)
   is
      Assistant : Gtk_Assistant renames All_Assistants (Full_Featured);
      Button    : Gtk_Button;
      Label     : Gtk_Label;
      Tmp       : Gint;
      pragma Unreferenced (Widget);
      pragma Warnings (Off, Tmp);
   begin
      if Assistant = null then
         Gtk_New (Assistant);
         Set_Default_Size (Assistant, 400, 300);

         Gtk_New_From_Stock (Button, Stock_Stop);
         Show (Button);
         Add_Action_Widget (Assistant, Button);

         Assistant_Cb.Connect (Assistant, "cancel",  Cancel_Callback'Access);
         Assistant_Cb.Connect (Assistant, "close",   Close_Callback'Access);
         Assistant_Cb.Connect (Assistant, "apply",   Apply_Callback'Access);
         Assistant_Cb.Connect (Assistant, "prepare", Prepare_Callback'Access);

         Gtk_New (Label, "Page 1");
         Show (Label);
         Tmp := Append_Page (Assistant, Label);
         Set_Page_Title (Assistant, Label, "Page 1");
         Set_Page_Complete (Assistant, Label, True);

         Gtk_New (Label, "Invisible page");
         Tmp := Append_Page (Assistant, Label);

         Gtk_New (Label, "Page 3");
         Show (Label);
         Tmp := Append_Page (Assistant, Label);
         Set_Page_Title (Assistant, Label, "Page 3");
         Set_Page_Type (Assistant, Label, Gtk_Assistant_Page_Confirm);
         Set_Page_Complete (Assistant, Label, True);
      end if;

      if not Assistant.Get_Visible then
         Show (Assistant);
      else
         Destroy (Assistant);
         Assistant := null;
      end if;
   end Create_Full_Featured_Assistant;

   ---------
   -- Run --
   ---------

   procedure Run (Frame : access Gtk.Frame.Gtk_Frame_Record'Class) is
      Box1 : Gtk_Box;

      ---------
      -- Add --
      ---------

      procedure Add
        (Description : String;
         Callback    : Button_Handler.Simple_Handler)
      is
         Button : Gtk_Button;
      begin
         Gtk_New (Button, Description);
         Button_Handler.Connect (Button, "clicked", Callback);
         Pack_Start
           (Box1, Button, Expand => False, Fill => False, Padding => 10);
      end Add;

   begin
      Set_Label (Frame, "Assistant");

      Gtk_New_Vbox (Box1);
      Add (Frame, Box1);

      Add ("Simple Assistant",        Create_Simple_Assistant'Access);
      Add ("Generous Assistant",      Create_Generous_Assistant'Access);
      Add ("Nonlinear Assistant",     Create_Nonlinear_Assistant'Access);
      Add ("Looping Assistant",       Create_Looping_Assistant'Access);
      Add ("Full Featured Assistant", Create_Full_Featured_Assistant'Access);

      Show_All (Frame);
   end Run;

end Create_Assistant;
