1-----------------------------------------------------------------------
2--          GtkAda - Ada95 binding for the Gimp Toolkit              --
3--                                                                   --
4--                     Copyright (C) 1998-1999                       --
5--        Emmanuel Briot, Joel Brobecker and Arnaud Charlet          --
6--                Copyright (C) 2000-2013, AdaCore                   --
7--                                                                   --
8-- This library is free software; you can redistribute it and/or     --
9-- modify it under the terms of the GNU General Public               --
10-- License as published by the Free Software Foundation; either      --
11-- version 2 of the License, or (at your option) any later version.  --
12--                                                                   --
13-- This library is distributed in the hope that it will be useful,   --
14-- but WITHOUT ANY WARRANTY; without even the implied warranty of    --
15-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU --
16-- General Public License for more details.                          --
17--                                                                   --
18-- You should have received a copy of the GNU General Public         --
19-- License along with this library; if not, write to the             --
20-- Free Software Foundation, Inc., 59 Temple Place - Suite 330,      --
21-- Boston, MA 02111-1307, USA.                                       --
22--                                                                   --
23-- As a special exception, if other files instantiate generics from  --
24-- this unit, or you link this unit with other files to produce an   --
25-- executable, this  unit  does not  by itself cause  the resulting  --
26-- executable to be covered by the GNU General Public License. This  --
27-- exception does not however invalidate any other reasons why the   --
28-- executable file  might be covered by the  GNU Public License.     --
29-----------------------------------------------------------------------
30
31with Gdk;                         use Gdk;
32with Gdk.Color;                   use Gdk.Color;
33with Gtk;                         use Gtk;
34with Glib;                        use Glib;
35with Glib.Properties;
36with Gtk.Color_Selection;         use Gtk.Color_Selection;
37with Gtk.Color_Selection_Dialog;  use Gtk.Color_Selection_Dialog;
38with Gtk.Enums;
39with Gtk.Handlers;
40with Gtk.Settings;                use Gtk.Settings;
41with Common;                      use Common;
42with Ada.Text_IO;                 use Ada.Text_IO;
43with Gtk.Widget;                  use Gtk.Widget;
44
45package body Create_Color_Selection is
46
47   type Gtk_Color_Dialog_Access is access all Gtk_Color_Selection_Dialog;
48   package Destroy_Dialog_Cb is new Handlers.User_Callback
49     (Gtk_Color_Selection_Dialog_Record, Gtk_Color_Dialog_Access);
50
51   Dialog : aliased Gtk_Color_Selection_Dialog;
52
53   package Color_Sel_Cb is new Handlers.Callback
54     (Gtk_Color_Selection_Dialog_Record);
55
56   procedure Destroy_Dialog
57     (Win : access Gtk_Color_Selection_Dialog_Record'Class;
58      Ptr : Gtk_Color_Dialog_Access);
59   --  Called when the dialog is destroyed
60
61   procedure On_Palette_Changed
62     (Screen : Gdk.Gdk_Screen; Colors : Gdk.Color.Gdk_Color_Array);
63   --  Called when the palette is changed
64
65   ----------
66   -- Help --
67   ----------
68
69   function Help return String is
70   begin
71      return "This widget provides an easy way to select new colors."
72        & " This is a very specific widget, and most applications won't"
73        & " need it. There are two versions, one with a dialog, and one"
74        & " without.";
75   end Help;
76
77   --------------------
78   -- Destroy_Dialog --
79   --------------------
80
81   procedure Destroy_Dialog
82     (Win : access Gtk_Color_Selection_Dialog_Record'Class;
83      Ptr : Gtk_Color_Dialog_Access)
84   is
85      pragma Warnings (Off, Win);
86   begin
87      Ptr.all := null;
88   end Destroy_Dialog;
89
90   ------------------
91   -- Close_Window --
92   ------------------
93
94   procedure Close_Window (Win : access Gtk.Widget.Gtk_Widget_Record'Class) is
95   begin
96      Destroy (Win);
97   end Close_Window;
98
99   ------------------------
100   -- On_Palette_Changed --
101   ------------------------
102
103   procedure On_Palette_Changed
104     (Screen : Gdk.Gdk_Screen; Colors : Gdk.Color.Gdk_Color_Array)
105   is
106      pragma Unreferenced (Screen);
107      Str : constant String := Palette_To_String (Colors);
108   begin
109      Put_Line ("Palette has changed: ");
110      Put_Line ("Palette=" & Str);
111
112      Glib.Properties.Set_Property
113        (Get_Default, Gtk_Color_Palette,
114         Palette_To_String (Colors));
115   end On_Palette_Changed;
116
117   --------------
118   -- Color_Ok --
119   --------------
120
121   procedure Color_Ok
122     (Dialog : access Gtk_Color_Selection_Dialog_Record'Class)
123   is
124      Color : Gdk_Color;
125   begin
126      Get_Current_Color (Get_Colorsel (Dialog), Color);
127
128      Put_Line ("Selected color is: ");
129      Put ("Red=" & Guint16'Image (Red (Color)));
130      Put (" Green=" & Guint16'Image (Green (Color)));
131      Put (" Blue=" & Guint16'Image (Blue (Color)));
132      Put_Line (" Alpha="
133           & Guint16'Image (Get_Current_Alpha (Get_Colorsel (Dialog))));
134   end Color_Ok;
135
136   ---------
137   -- Run --
138   ---------
139
140   procedure Run (Frame : access Gtk_Frame_Record'Class) is
141      pragma Warnings (Off, Frame);
142      Old : Gtk_Color_Selection_Change_Palette_With_Screen_Func;
143      pragma Unreferenced (Old);
144   begin
145      if Dialog = null then
146         Gtk_New (Dialog, Title => "Color Selection Dialog");
147         Set_Position (Dialog, Enums.Win_Pos_Mouse);
148
149         Set_Has_Palette (Get_Colorsel (Dialog), True);
150         Set_Has_Opacity_Control (Get_Colorsel (Dialog), True);
151         Old :=
152           Set_Change_Palette_With_Screen_Hook (On_Palette_Changed'Access);
153
154         Destroy_Dialog_Cb.Connect
155           (Dialog, "destroy",
156            Destroy_Dialog_Cb.To_Marshaller (Destroy_Dialog'Access),
157            Dialog'Access);
158
159         Color_Sel_Cb.Object_Connect
160           (Get_OK_Button (Dialog),
161            "clicked",
162            Color_Sel_Cb.To_Marshaller (Color_Ok'Access),
163            Slot_Object => Dialog);
164         Widget_Handler.Object_Connect
165           (Get_Cancel_Button (Dialog),
166            "clicked",
167            Widget_Handler.To_Marshaller (Close_Window'Access),
168            Slot_Object => Dialog);
169         Show (Dialog);
170      else
171         Destroy (Dialog);
172      end if;
173   end Run;
174
175end Create_Color_Selection;
176