-------------------------------------------------------------------------------
--                                                                           --
--  Ada Interface to the X Window System and Motif(tm)/Lesstif               --
--  Copyright (c) 1996-2000 Hans-Frieder Vogt                                --
--                                                                           --
--  This program is free software; you can redistribute it and/or modify     --
--  it under the terms of the GNU General Public License as published by     --
--  the Free Software Foundation; either version 2 of the License, or        --
--  (at your option) any later version.                                      --
--                                                                           --
--  This program is distributed in the hope that it will be useful,          --
--  but WITHOUT ANY WARRANTY; without even the implied warranty of           --
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     --
--  See the GNU General Public License for more details.                     --
--                                                                           --
--  You should have received a copy of the GNU General Public License        --
--  along with this program; if not, write to the                            --
--  Free Software Foundation, Inc.,                                          --
--  59 Temple Place - Suite 330,                                             --
--  Boston, MA 02111-1307, USA.                                              --
--                                                                           --
--                                                                           --
--  X Window System is copyrighted by the X Consortium                       --
--  Motif(tm)       is copyrighted by the Open Software Foundation, Inc.     --
--                                                                           --
--                                                                           --
-------------------------------------------------------------------------------

-------------------------------------------------------------------------------
--
-- HISTORY:
-- 25.1.98 adapted to adabindx 0.5
--  26 Jan 2002 H.-F. Vogt: simplified the task (no start/stop any longer)
--                          admittedly the new method is quite brutal (abort..),
--                          but with the old method a deadlock occured that I
--                          don't understand and thus couldn't resolve
--                          So let's use this method until someone explains me
--                          how to do it in a better way
--  02 Mar 2002 H.-F. Vogt: replaced System.Unsigned_Types by Interfaces.C
--                          
--
-------------------------------------------------------------------------------

with Ada.Characters.Latin_1,
     Ada.Numerics.Generic_Elementary_Functions,
     Ada.Text_Io,
     Ada.Unchecked_Deallocation,
     Interfaces.C,
     X_Lib.Cursor,
     Xm_Widgets.Primitive.Label.Toggle_Button,
     Xm_Widgets.Manager.Bulletin_Board.Message_Box,
     Xm_Widgets.Manager.Drawing_Area;
use  Interfaces.C,
     Xm_Widgets.Primitive.Label,
     Xm_Widgets.Manager.Bulletin_Board.Message_Box;
package body Mandel_Global is

   package Real_Functions is
      new Ada.Numerics.Generic_Elementary_Functions (Real);
   use Real_Functions;

   procedure Free is
      new Ada.Unchecked_Deallocation (Calculate_Mandel, Calculate_Mandel_Access);

   -- locally needed Variables
   --
   W, H  : X_Lib.Dimension;
   Scale : Real;


   procedure Set_Size (Width, Height : in X_Lib.Dimension) is
      Tmp_Scale        : Real;
   begin
      W := Width;
      H := Height;
      Scale := (R_Max-R_Min) / Real (W);
      Tmp_Scale := (I_Max-I_Min) / Real (H);
      if Scale < Tmp_Scale then
	 Scale := Tmp_Scale;
      end if;
   end Set_Size;


   protected Output is
      procedure Put (S : in String);
      procedure Put_Line (S : in String);
   end Output;
   
   protected body Output is
      procedure Put (S : in String) is
      begin
         Ada.Text_Io.Put (S);
	 Ada.Text_Io.Flush;
      end Put;

      procedure Put_Line (S : in String) is
      begin
         Ada.Text_Io.Put_Line (S);
	 Ada.Text_Io.Flush;
      end Put_Line;
   end Output;


   protected Task_Counter is
      procedure Increment;
      procedure Decrement;
      function Current_Value return Natural;
      procedure Set_Value (Value : in Natural);
   private
      Counter : Natural := 0;
   end Task_Counter;

   protected body Task_Counter is

      procedure Actualize_Global_Status (Running : Boolean) is
      begin
	 Xm_Widgets.Primitive.Label.Toggle_Button.Xm_Toggle_Button_Set_State (Calc_Toggle, Running, False);
         if Running then
	    X_Lib.Cursor.X_Define_Cursor (Display, Xt_Window (The_Draw), Working_Cursor);
	 else
	    X_Lib.Cursor.X_Undefine_Cursor (Display, Xt_Window (The_Draw));
	 end if;
	 X_Lib.X_Flush (Display);
      end Actualize_Global_Status;

      procedure Increment is
      begin
         Counter := Counter + 1;
	 Output.Put_Line ("running tasks: " & Natural'Image (Counter));
	 if Counter = 1 then  -- must just have been switched on
            Actualize_Global_Status (True);
	 end if;
      end Increment;

      procedure Decrement is
      begin
         Counter := Counter - 1;
	 Output.Put_Line ("running tasks: " & Natural'Image (Counter));
	 if Counter < 1 then  -- must just have been switched on
            Actualize_Global_Status (False);
	 end if;
      end Decrement;

      function Current_Value return Natural is
      begin
         return Counter;
      end Current_Value;

      procedure Set_Value (Value : in Natural) is
      begin
         if Counter > 0 and then Value < 1 then
	    Actualize_Global_Status (False);
	 end if;
         if Counter < 1 and then Value > 0 then
	    Actualize_Global_Status (True);
	 end if;
         Counter := Value;
      end Set_Value;

   end Task_Counter;


   function Iteration (XR, YI : in X_Lib.Position;
                       Scale  : in Real) return Natural is
      X_Re     : constant Real := R_Min + Real (XR) * Scale;
      Y_Im     : constant Real := I_Min + Real (YI) * Scale;
      Infinity : constant := 1000.0;
      Iter     : Natural  := 0;
      X, Y     : Real     := 0.0;
      Dummy    : Real;
   begin
      loop
         Dummy := X;
	 X := X*X - Y*Y   + X_Re;
	 Y := 2.0*Dummy*Y + Y_Im;
	 Iter  := Iter + 1;
	 exit when (X*X+Y*Y > Infinity)
	   or else (Iter >= Max_Iterations);
      end loop;
      return Iter;
   end Iteration;



   task body Calculate_Mandel is
      I, J             : X_Lib.Position;
   begin
      J := X_Lib.Position (Offset);
      Task_Counter.Increment;
      loop
--	 Output.Put_Line ("task " & Our_Task_ID'Image (Task_ID) & " is working");
  	 I := 0;
	 Outer_Loop:
	 loop
	    for K in 1 .. 10 loop
	       exit Outer_Loop when I >= X_Lib.Position (W);
	       X_Lib.X_Draw_Point (Display, Pixmap,
	  	 GC_Table ((Iteration (I, J, Scale) - 1) mod
	  	      Num_Colors + 1), I, J);
	       I := I + 1;
	    end loop;
	    delay Duration'Small;
	 end loop Outer_Loop;
	 if Xt_Is_Realized (The_Draw) then
	    X_Lib.X_Copy_Area (Display, Pixmap, Xt_Window (The_Draw),
	  		       GC_Copy, 0, 0, W, H, 0, 0);
	 end if;
	 J := J + X_Lib.Position (Jump);
         if J >= X_Lib.Position (H) then
            Task_Counter.Decrement;
	    exit;
         end if;
         delay Duration'Small;
      end loop;
   end Calculate_Mandel;


   procedure Start_Calculation is
   begin
      -- first ensure that the tasks don't already exist
      --
      for I in Task_List'Range loop
         if Task_List (I) /= null then
            abort Task_List (I).all;
	    Free (Task_List (I));
            Task_List (I) := null;
	 end if;
      end loop;
      Task_Counter.Set_Value (0);
      
      for I in Task_List'Range loop
	 Task_List (I) :=
	  new Calculate_Mandel (I,
				X_Lib.Dimension (I-Task_List'First),
				X_Lib.Dimension (Num_Tasks));
      end loop;
   end Start_Calculation;


   procedure Stop_Calculation is
   begin
      for I in Task_List'Range loop
         if Task_List (I) /= null then
            Output.Put_Line ("time to stop for task " & Our_Task_ID'Image (I));
	    abort Task_List (I).all;
	    Free (Task_List (I));
	    Task_List (I) := null;
            Output.Put_Line ("task " & Our_Task_ID'Image (I) & " should have stopped now");
         end if;
      end loop;
      Task_Counter.Set_Value (0);
   end Stop_Calculation;


   procedure Initialize_Threads is
   begin
      null;
   end Initialize_Threads;


   procedure Calculate_CB (W         : in Widget;
                           Closure   : in Xt_Pointer;
                           Call_Data : in Xt_Pointer) is
   begin
      if Xm_Widgets.Primitive.Label.Toggle_Button.Xm_Toggle_Button_Get_State (Calc_Toggle) then
         Start_Calculation;
      else
         Stop_Calculation;
      end if;
   end Calculate_CB;


   procedure About_CB (W         : in Widget;
                       Closure   : in Xt_Pointer;
                       Call_Data : in Xt_Pointer) is
      use Ada.Characters.Latin_1;
      Button : Widget;
      About_Text : constant String := "Mandel -- a Mandelbrot set generator" &
                                      LF &
				      "demonstrating use of multithreaded programming" & LF &
                                      "(c)1997-2002 Hans-Frieder Vogt" &
                                      LF &
                                      "(example program for Ada binding to X and Motif(tm))";
      About_String : Xm_String;
   begin
      if About_Dialog = Null_Widget then
         About_Dialog := Xm_Create_Information_Dialog (Appshell, "about_dialog");

         About_String := Xm_String_Create_L_To_R (About_Text,
                                                  Xm_String_ISO8859_1);
         Argl := Null_Arg_List;
         Append_Set (Argl, Xm_N_Message_String, About_String);
         Xt_Set_Values (About_Dialog, Argl);
         Xm_String_Free (About_String);

         Button := Xt_Name_To_Widget (About_Dialog, Cancel_Button_Name);
         Xt_Unmanage_Child (Button);
         Button := Xt_Name_To_Widget (About_Dialog, Help_Button_Name);
         Xt_Unmanage_Child (Button);
         Xt_Manage_Child (About_Dialog);
      else
         if not Xt_Is_Managed (About_Dialog) then
            Xt_Manage_Child (About_Dialog);
         end if;
      end if;
   end About_CB;


   procedure Quit_CB (W         : in Widget;
                      Closure   : in Xt_Pointer;
                      Call_Data : in Xt_Pointer) is
   begin
      Stop_Calculation;
      Xt_App_Set_Exit_Flag (App_Con);
   end Quit_CB;


   procedure Expose_CB (W         : in Widget;
                        Closure   : in Xt_Pointer;
                        Call_Data : in Xt_Pointer) is
      use Xm_Widgets.Manager.Drawing_Area, X_Lib;
      CB_Struct : Xm_Drawing_Area_Callback_Struct_Access;
      Event     : X_Event_Pointer;
   begin
      CB_Struct := To_Callback_Struct (Call_Data);
      Event     := CB_Struct.Event;
      if Event.Ev_Type /= Expose then
         return;
      end if;

      if Xt_Is_Realized (The_Draw) then
         X_Lib.X_Copy_Area (Display, Pixmap, Xt_Window (The_Draw), GC_Copy,
                            X_Lib.Position  (Event.X_Expose.X),
                            X_Lib.Position  (Event.X_Expose.Y),
                            X_Lib.Dimension (Event.X_Expose.Width),
                            X_Lib.Dimension (Event.X_Expose.Height),
                            X_Lib.Position  (Event.X_Expose.X),
                            X_Lib.Position  (Event.X_Expose.Y));
      end if;
   end Expose_CB;


   procedure Resize_CB (W         : in Widget;
                        Closure   : in Xt_Pointer;
                        Call_Data : in Xt_Pointer) is
      use Xm_Widgets.Manager.Drawing_Area, X_Lib;
      Width, Height : X_Lib.Dimension;
   begin
      Argl := Null_Arg_List;
      Append_Get (Argl, Xm_N_Width, Width);
      Append_Get (Argl, Xm_N_Height, Height);
      Xt_Get_Values (The_Draw, Argl);

      Output.Put_Line ("Resize_CB called, new size: " &
                            X_Lib.Dimension'Image (Width) & " x " &
			    X_Lib.Dimension'Image (Height));
      if Task_Counter.Current_Value > 0 then
         Stop_Calculation;
      end if;
      X_Lib.X_Free_Pixmap (Display, Pixmap);
      Pixmap := X_Lib.X_Create_Pixmap (Display,
                          X_Lib.X_Root_Window_Of_Screen (Screen),
                          Width, Height,
                          X_Lib.X_Default_Depth_Of_Screen (Screen));
      Set_Size (Width, Height);
      --  I prefer to have my windows resized with the contents visible
      --  this leads to very frequent repaints. So don't automatically repaint
      --
--      Start_Calculation;
   end Resize_CB;


end Mandel_Global;