-------------------------------------------------------------------
--           RAPID - RAPID ADA PORTABLE INTERFACE DESIGNER         
--           MCC GUI PACKAGE LIBRARY                               
--           Copyright (C) 1999 Martin C. Carlisle.                
--                                                                 
-- RAPID 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 2,  or (at your
-- option) any later version.  RAPID 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
-- distributed with RAPID; see file COPYING.  If not, write to the 
-- Free Software Foundation,  59 Temple Place - Suite 330,  Boston, 
-- MA 02111-1307, USA.                                                 
--                                                                     
-- As a special exception, if other files instantiate generics from
-- this unit, or you link this unit with other files to produce an 
-- executable, this unit does not by itself cause the resulting 
-- executable to be covered by the GNU General Public License.  
-- This exception does not however invalidate any other reasons 
-- why the executable file might be covered by the GNU Public 
-- License.  This exception does not apply to executables which
-- are GUI design tools, or that could act as a replacement
-- for RAPID.
------------------------------------------------------------------------------
with glib; use glib;
with Gdk.Color;
with Gdk.Cursor;
with Gdk.Event;
with Gdk.Main;
with Gdk.Types;
use type Gdk.Types.Gdk_Event_Type;
with Gdk.Window;
with Mcc.Gui.Container.Frame;
with Mcc.Gui.Container.Window;
with Mcc.Gui.Window_Peer;
with Mcc.Gtk_Signals;
with Gtk.Enums;
with Gtk.Frame;
with Gtk.Main;
with Gtk.Object;
with Gtk.Signal;
with Gtk.Style;
with Gtk.Widget;
with Gtk.Window;
with Peer.Frame;
with Peer.Style;
with ada.text_io;
with System;
with Ada.Unchecked_Conversion;
package body Mcc.Gui is
   package Mcc_Object_Callback is new Mcc.Gtk_Signals.Event_Object_Callback_Return(
      Base_Type    => Sized_Object);

   function Mcc_Key_Callback(
      Widget : System.Address;
      Event  : System.Address; 
      Obj : access Sized_Object) return Glib.Guint;
   pragma Convention(C, Mcc_Key_Callback);
   function Mcc_Key_Callback(
      Widget : System.Address;
      Event  : System.Address; 
      Obj : access Sized_Object) return Glib.Guint is
      Gdk_Key_Event : Gdk.Event.Gdk_Event_Key;
      Mcc_Key_Event : Key_Event;
      Event_Type    : Gdk.Types.Gdk_Event_Type;
      function Convert is new Ada.Unchecked_Conversion(
         System.Address,Gdk.Event.Gdk_Event_Key);
   begin
      if Obj.Key_Handler /= null then
         Gdk_Key_Event := Convert(Event);
         Event_Type := Gdk.Event.Get_Event_Type(Gdk_Key_Event);
         Mcc_Key_Event.Key := 
            Key_Type(Gdk.Event.Get_Key_Val(Gdk_Key_Event));
         if Event_Type = Gdk.Types.Key_Press then
            Mcc_Key_Event.Action := Press;
         elsif Event_Type = Gdk.Types.Key_Release then
            Mcc_Key_Event.Action := Release;
         else
            -- not sure what this is, but get out now!
            return 1;
         end if;
         Obj.Key_Handler.all(Obj.all,
            Event => Mcc_Key_Event);
      end if;
      return 1; -- don't keep processing, or else window gets it too!
   end Mcc_Key_Callback;

   function Mcc_Mouse_Callback(
      Widget : System.Address;
      Event  : System.Address; 
      Obj : access Sized_Object) return Glib.Guint;
   pragma Convention(C, Mcc_Mouse_Callback);
   
   procedure Get_Pointer(
      Window : in Gdk.Window.Gdk_Window;
      X      : out Integer;
      Y      : out Integer) is
      Xint, Yint : Glib.Gint;
      Mask   : Gdk.Types.Gdk_Modifier_Type;
      Result : Gdk.Window.Gdk_Window;
   begin
      Gdk.Window.Get_Pointer(
        Window,Xint,Yint,Mask,Result); 
      X := Integer(Xint);
      Y := Integer(Yint);
   end Get_Pointer;
   
   procedure Gdk_Pointer_Grab(
      Window : in Gdk.Window.Gdk_Window;
      Relative : in Boolean;
      Mask : in Gdk.Types.Gdk_Event_Mask) is
      Result : Boolean;
   begin
      Result := Gdk.Main.Pointer_Grab(
         Window       => Window,
         Owner_Events => relative,
         Event_Mask   => mask,
         Time         => 0);
   end Gdk_Pointer_Grab;
   
   -- try to avoid duplication of mouse events
   Last_Mouse_Event : Mouse_Event;
   -- Since pointer grab is strange, try this
   Pressed_Window : Gdk.Window.Gdk_Window;
   First_Press    : Boolean := True;
   function Mcc_Mouse_Callback(
      Widget : System.Address;
      Event  : System.Address; 
      Obj : access Sized_Object) return Glib.Guint is
      Gdk_Mouse_Event : Gdk.Event.Gdk_Event_Button;
      Mcc_Mouse_Event : Mouse_Event;
      function Convert is new Ada.Unchecked_Conversion(
         System.Address,Gdk.Event.Gdk_Event_Button);
      Event_Type    : Gdk.Types.Gdk_Event_Type;
      Button : Glib.Guint;
      procedure Which_Button is
      -- now figure out which button is pressed
      -- In GtkAda 1.2.4, this raises an exception in 
      -- the none case, b/c it's not really a Gdk_Mouse_Event
      -- on 1.3.3 you get something other than 1..3 returned
      begin
         Button := Gdk.Event.Get_Button(Gdk_Mouse_Event);
         case Button is
            when 1..3 =>
               Mcc_Mouse_Event.Button := 
                 Mouse_Button'Val(Gdk.Event.Get_Button(Gdk_Mouse_Event));
            when others =>
               Mcc_Mouse_Event.Button := None;
         end case;
      exception when others =>
         Mcc_Mouse_Event.Button := None;
      end Which_Button;
      use type Gdk.Types.Gdk_Event_Mask;
   begin
      if Obj.Mouse_Handler /= null then
         Gdk_Mouse_Event := Convert(Event);
         Event_Type := Gdk.Event.Get_Event_Type(Gdk_Mouse_Event);
         -- First figure out what kind of mouse event happened
         if Event_Type = Gdk.Types.Button_Press then
            Mcc_Mouse_Event.Action := Press;
            Which_Button;
         elsif Event_Type = Gdk.Types.Gdk_2Button_Press then
            Mcc_Mouse_Event.Action := Double_Click;
            Which_Button;
         elsif Event_Type = Gdk.Types.Button_Release then
            Mcc_Mouse_Event.Action := Release;
            Which_Button;
         elsif Event_Type = Gdk.Types.Motion_Notify then
            declare
               Modifier : Gdk.Types.Gdk_Modifier_Type;
               use Gdk.Types;
            begin
               Modifier := Gdk.Event.Get_State(Gdk_Mouse_Event);
               if (Modifier and Button1_Mask) > 0 then
                  Mcc_Mouse_Event.Button := Left;
               elsif (Modifier and Button2_Mask) > 0 then
                  Mcc_Mouse_Event.Button := Middle;
               elsif (Modifier and Button3_Mask) > 0 then
                  Mcc_Mouse_Event.Button := Right;
               else
                  Mcc_Mouse_Event.Button := None;
               end if;
            end;
            Mcc_Mouse_Event.Action := Move;
         else
            -- not sure what this is, but get out now!
            return 1;
         end if;
         Mcc_Mouse_Event.X := Integer(Gdk.Event.Get_X(Gdk_Mouse_Event));
         Mcc_Mouse_Event.Y := Integer(Gdk.Event.Get_Y(Gdk_Mouse_Event));
         if Mcc_Mouse_Event.Action = Press then
            if First_Press then
               Pressed_Window := Gdk.Event.Get_Window(Gdk_Mouse_Event);
               Gtk.Main.Grab_Add(Gtk.Widget.Gtk_Widget(Obj.My_Peer));
               Gdk_Pointer_Grab(
                  Pressed_Window,
                  True,
                  Gdk.Types.Button_Release_Mask +
                  Gdk.Types.Button_Motion_Mask);
               First_Press := False;
            end if;
         elsif Mcc_Mouse_Event.Action = Move and 
            Mcc_Mouse_Event.Button /= None then
            declare
               X,Y : Integer;
            begin
               Get_Pointer(Pressed_Window,X,Y);
               Mcc_Mouse_Event.X := X;
               Mcc_Mouse_Event.Y := Y;
            end;
         elsif Mcc_Mouse_Event.Action = Release then
            First_Press := True;
            Gtk.Main.Grab_Remove(Gtk.Widget.Gtk_Widget(Obj.My_Peer));
            Gdk.Main.Pointer_Ungrab(0);
         end if;
         -- debugging
         if Mcc_Mouse_Event /= Last_Mouse_Event then
            -- Call the Mouse handler routine
            Obj.Mouse_Handler.all(Obj.all,
               Event => Mcc_Mouse_Event);
            Last_Mouse_Event := Mcc_Mouse_Event;
         end if;
      end if;
      return 1; -- don't keep processing, or else window gets it too!
   end Mcc_Mouse_Callback;
   ----------
   -- Bell --
   ----------

   procedure Bell is
   begin
      Gdk.Main.Beep;
   end Bell;

   -------------
   -- Destroy --
   -------------

   procedure Destroy (Obj : in Object) is
      procedure Destroy_Window(Obj : in Mcc.Gui.Container.Window.Window'Class) is
         Ptr : Mcc.Gui.Object_Pointer :=
            Obj'Unrestricted_Access;
      begin
         -- recall that the Window actually points to the fixed container,
         -- whose parent is the Gtk_Window
         -- it is totally unclear to me why I look up destroy here,
         -- but bound to delete_event, but it seems to work this way.
         --x:=Mcc.Gtk_Signals.Gtk_Signal_Lookup(
         --      "destroy", 
         --      Gtk.Fixed.Get_Parent(Gtk.Fixed.Gtk_Fixed (Obj.My_Peer)));
         Gtk.Signal.Handlers_Destroy(
            Mcc.Gui.Window_Peer.Get_Window(Obj));
         Gtk.Widget.Destroy(Mcc.Gui.Window_Peer.Get_Window(Obj));
         Ptr.My_Peer := null;
      end Destroy_Window;
   begin
      --This if statement makes sure that the Obj.My_Peer pointer is pointing to something in the
      --   Object class, which includes all classes in Gtk.  It keeps an exception being 
      --   raised if another subclass of root_type is used, but this would have to be done
      --   outside of gtk or if gtk implements another class besides gtk object.
      if Object'Class(Obj) in Mcc.Gui.Container.Window.Main_Window'Class then
         Destroy_Window(
            Mcc.Gui.Container.Window.Window'Class(Object'Class(Obj)));
         Gtk.Main.Main_Quit;
      elsif Object'Class(Obj) in Mcc.Gui.Container.Frame.Frame'Class then
         Gtk.Frame.Destroy(Peer.Frame.Mcc_Frame(Obj.My_Peer).Frame);
      elsif Object'Class(Obj) in Mcc.Gui.Container.Window.Window'Class then
         Destroy_Window(
            Mcc.Gui.Container.Window.Window'Class(Object'Class(Obj)));
      elsif Obj.My_Peer.all in Gtk.Object.Gtk_Object_Record'class then
         Gtk.Object.Destroy(gtk.Object.Gtk_Object(Obj.My_Peer));
      end if;
   end Destroy;

   ----------------------
   -- Get_Key_Listener --
   ----------------------

   function Get_Key_Listener
     (Obj : in Sized_Object'Class)
      return Key_Listener
   is
   begin
      return Obj.Key_Handler;
   end Get_Key_Listener;

   ------------------------
   -- Get_Mouse_Listener --
   ------------------------

   function Get_Mouse_Listener
     (Obj : in Sized_Object'Class)
      return Mouse_Listener
   is
   begin
      return Obj.Mouse_Handler;
   end Get_Mouse_Listener;

   --------------
   -- Get_Peer --
   --------------

   function Get_Peer (Obj : in Object) return Peer.Peer is
   begin
      return Obj.My_Peer;
   end Get_Peer;

   ------------------------------------------------
   -- procedure Get_Screen_Dimensions
   --
   -- get the current width and height of the screen
   ------------------------------------------------
   procedure Get_Screen_Dimensions(
      Width  : out Integer;
      Height : out Integer) is
   begin
      null;
   end Get_Screen_Dimensions;
   
   ------------------------------------------------
   -- procedure Get_Size
   --
   -- get the Width and Height of an Object
   ------------------------------------------------
   procedure Get_Size(
      Obj    : in     Sized_Object;
      Width  :    out Integer;
      Height :    out Integer) is
   begin
      null;
   end Get_Size;
   


   ----------
   -- Move --
   ----------

   procedure Move
     (Obj : in out Sized_Object;
      X   : in     Integer;
      Y   : in     Integer)
   is
   begin
      if Sized_Object'Class(Obj) in Mcc.Gui.Container.Window.Window'Class then
         Gtk.Widget.Set_UPosition (
           Widget => Mcc.Gui.Window_Peer.Get_Window(
              Mcc.Gui.Container.Window.Window'Class(Object'Class(Obj))),       
             X  => GInt(X),
             Y  => GInt(Y));
      elsif Sized_Object'Class(Obj) in Mcc.Gui.Container.Frame.Frame'Class then
         Gtk.Frame.Set_UPosition(
           Widget => Peer.Frame.Mcc_Frame(Obj.My_Peer).Frame,
             X  => GInt(X),
             Y  => GInt(Y));
      else
         Gtk.Widget.Set_UPosition (Widget => gtk.widget.Gtk_Widget(Obj.My_Peer), 
             X  => GInt(X),
             Y  => GInt(Y));
      end if;
   end Move;

   ------------
   -- Resize --
   ------------

   procedure Resize
     (Obj    : in out Sized_Object;
      Width  : in     Integer;
      Height : in     Integer)
   is
      Real_Height : Glib.Gint;
   begin
      if Sized_Object'Class(Obj) in Mcc.Gui.Container.Window.Window'Class then
         -- by dropping to GDK, I can force this to really happen
         -- From Gtk.Window set_default_size didn't work
         -- and set_Usize set a minimum size
         if Mcc.Gui.Window_Peer.Has_Menu(
            Mcc.Gui.Container.Window.Window'Class(Object'Class(Obj))) then
            Real_Height := Gint(Height+Mcc.Gui.Window_Peer.Menubar_Height);
         else
            Real_Height := Gint(Height);
         end if;
         Gdk.Window.Resize (
           Window => Gtk.Window.Get_Window(Gtk.Window.Gtk_Window(
              Mcc.Gui.Window_Peer.Get_Window(
                 Mcc.Gui.Container.Window.Window'Class(Object'Class(Obj))))),       
           Width  => Gint (Width), 
           Height => Real_Height);
      elsif Sized_Object'Class(Obj) in Mcc.Gui.Container.Frame.Frame'Class then
         Gtk.Frame.Set_USize(
             Widget => Peer.Frame.Mcc_Frame(Obj.My_Peer).Frame,
             Width   => GInt(Width),
             Height  => GInt(Height));
      else
         Gtk.Widget.Set_USize (Widget => gtk.widget.Gtk_Widget(Obj.My_Peer), 
                               Width  => GInt(Width),
                               Height => GInt(Height));
      end if;
   end Resize;

   --------------------------
   -- Set_Background_Color --
   --------------------------

   procedure Set_Background_Color
     (Obj       : in out Sized_Object;
      New_Color : in     Color)
   is
      old_style : gtk.style.gtk_style;
      new_style : gtk.style.gtk_style;
      color     : gdk.color.gdk_color;
      colormap  : gdk.color.gdk_colormap;
      success   : boolean;
   begin
      --Set color
      -- Note RGB colors are out of 65536 possible, not 256
      gdk.color.Set_RGB(
         Color => Color,
         Red   => Glib.Gushort(New_Color.Red   * 65535/255),
         Green => Glib.Gushort(New_Color.Green * 65535/255),
         Blue  => Glib.Gushort(New_Color.Blue  * 65535/255)
         );
      gdk.color.Set_Pixel(
         Color => Color,
         Pixel => 0);
      colormap := Gdk.Color.Get_System;
      Gdk.Color.Alloc_Color(
         Colormap   => colormap,
         Color      => color,
         Writeable  => True,
         Best_Match => True,
         Success    => Success);

      --create a new_style
      Old_Style := Gtk.Widget.Get_Style(Gtk.Widget.Gtk_Widget(Obj.My_Peer));
      New_Style := Gtk.Style.Copy(Old_Style);
      
      --Change color for each of the five states
      gtk.style.Set_Background(new_style,gtk.enums.State_Normal,color); 
      gtk.style.Set_Background(new_style,gtk.enums.State_Active,color); 
      gtk.style.Set_Background(new_style,gtk.enums.State_prelight,color); 
      gtk.style.Set_Background(new_style,gtk.enums.State_selected,color); 
      gtk.style.Set_Background(new_style,gtk.enums.State_insensitive,color);
      if Sized_Object'Class(Obj) in Mcc.Gui.Container.Container'Class then
         Gtk.Widget.Set_Style (
            Widget => Gtk.Widget.Gtk_Widget(Obj.My_Peer), 
            Style  => New_Style);
      else
         Peer.Style.Set_Style_Recursively(
            widget => Gtk.Widget.Gtk_Widget(Obj.My_Peer),
            style  => new_style);
      end if;
   end Set_Background_Color;

   ----------------
   -- Set_Cursor --
   ----------------

--   type Cursor_Type is (
--      Default_Cursor, 
--      Resize_NW, 
--      Resize_N,
--      Resize_NE,
--      Resize_E,
--      Resize_SE,
--      Resize_S,
--      Resize_SW,
--      Resize_W,
--      Move_Cursor);
   Cursors : array(Cursor_Type) of Gdk.Cursor.Gdk_Cursor :=
      (others => Gdk.Cursor.Null_Cursor);
   Cursor_Types : array(Cursor_Type) of Gdk.Types.Gdk_Cursor_Type :=
      (Default_Cursor => Gdk.Types.X_Cursor,
       Resize_NW => Gdk.Types.Top_Left_Corner, 
       Resize_N => Gdk.Types.Top_Side,
       Resize_NE => Gdk.Types.Top_Right_Corner,
       Resize_E => Gdk.Types.Right_Side,
       Resize_SE => Gdk.Types.Bottom_Right_Corner,
       Resize_S => Gdk.Types.Bottom_Side,
       Resize_SW => Gdk.Types.Bottom_Left_Corner,
       Resize_W => Gdk.Types.Left_Side,
       Move_Cursor => Gdk.Types.Fleur);
   procedure Set_Cursor
     (Obj    : in Sized_Object;
      Cursor : in Cursor_Type)
   is
      use type Gdk.Cursor.Gdk_Cursor;
      Window : Gdk.Window.Gdk_Window;
   begin
      Window := Gtk.Widget.Get_Window(Gtk.Widget.Gtk_Widget(Obj.My_Peer));
      if Cursors(Cursor) = Gdk.Cursor.Null_Cursor and then
         Cursor /= Default_Cursor then
         Gdk.Cursor.Gdk_New(Cursors(Cursor),
            Cursor_Types(Cursor));
      end if;
      Gdk.Window.Set_Cursor(Window,Cursors(Cursor));
   end Set_Cursor;

   ----------------------
   -- Set_Key_Listener --
   ----------------------

   procedure Set_Key_Listener
     (Obj      : in Sized_Object_Pointer;
      Listener : in Key_Listener)
   is
      Cb_Id  : Glib.Guint;  
   begin
      if Obj.Key_Handler = null then
         if Sized_Object'Class(Obj.all) in Mcc.Gui.Container.Window.Window'Class then
            Cb_Id  := Mcc_Object_Callback.Connect(
              Obj  => 
                 Gtk.Window.Gtk_Window(
                    Mcc.Gui.Window_Peer.Get_Window(
                       Mcc.Gui.Container.Window.Window'Class(Obj.all))),
              Name => "key_press_event",                      
              Func => Mcc_Key_Callback'access,
              Slot_Object => Obj,
              After  => False);
            Cb_Id  := Mcc_Object_Callback.Connect(
              Obj  => 
                 Gtk.Window.Gtk_Window(
                    Mcc.Gui.Window_Peer.Get_Window(
                       Mcc.Gui.Container.Window.Window'Class(Obj.all))),
              Name => "key_release_event",                      
              Func => Mcc_Key_Callback'access,
              Slot_Object => Obj,
              After  => False);
         else
            Cb_Id  := Mcc_Object_Callback.Connect(
              Obj  => Gtk.Object.Gtk_Object(Obj.My_Peer), 
              Name => "key_press_event",                      
              Func => Mcc_Key_Callback'access,
              Slot_Object => Obj,
              After  => False);
            Cb_Id  := Mcc_Object_Callback.Connect(
              Obj  => Gtk.Object.Gtk_Object(Obj.My_Peer), 
              Name => "key_release_event",                      
              Func => Mcc_Key_Callback'access,
              Slot_Object => Obj,
              After  => False);
         end if;
      end if;
      Obj.Key_Handler := Listener;
   end Set_Key_Listener;

   ------------------------
   -- Set_Mouse_Listener --
   ------------------------

   procedure Set_Mouse_Listener
     (Obj      : in Sized_Object_Pointer;
      Listener : in Mouse_Listener)
   is
      Cb_Id  : Glib.Guint;  
   begin
      if Obj.Mouse_Handler = null then
         Cb_Id  := Mcc_Object_Callback.Connect(
           Obj  => Gtk.Object.Gtk_Object(Obj.My_Peer), 
           Name => "button_press_event",                      
           Func => Mcc_Mouse_Callback'access,
           Slot_Object => Obj,
           After  => False);
         Cb_Id  := Mcc_Object_Callback.Connect(
           Obj  => Gtk.Object.Gtk_Object(Obj.My_Peer), 
           Name => "motion_notify_event",                      
           Func => Mcc_Mouse_Callback'access,
           Slot_Object => Obj,
           After  => False);
         Cb_Id  := Mcc_Object_Callback.Connect(
           Obj  => Gtk.Object.Gtk_Object(Obj.My_Peer), 
           Name => "button_release_event",                      
           Func => Mcc_Mouse_Callback'access,
           Slot_Object => Obj,
           After  => False);
      end if;      
      Obj.Mouse_Handler := Listener;
   end Set_Mouse_Listener;

end Mcc.Gui;