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