~ubuntu-branches/ubuntu/intrepid/libgtkada2/intrepid

« back to all changes in this revision

Viewing changes to src/gtk-color_selection.adb

  • Committer: Bazaar Package Importer
  • Author(s): Luca Falavigna
  • Date: 2008-08-11 09:46:51 UTC
  • mfrom: (6.1.1 squeeze)
  • Revision ID: james.westby@ubuntu.com-20080811094651-9mjd6acwa98ffw5c
Tags: 2.12.0-2ubuntu1
Add lpia to supported architectures.

Show diffs side-by-side

added added

removed removed

Lines of Context:
2
2
--               GtkAda - Ada95 binding for Gtk+/Gnome               --
3
3
--                                                                   --
4
4
--   Copyright (C) 1998-2000 E. Briot, J. Brobecker and A. Charlet   --
 
5
--                 Copyright (C) 2000-2008, AdaCore                  --
5
6
--                                                                   --
6
7
-- This library is free software; you can redistribute it and/or     --
7
8
-- modify it under the terms of the GNU General Public               --
21
21
--                                                                   --
22
22
-----------------------------------------------------------------------
23
23
 
24
 
with Ada.Unchecked_Conversion;
 
24
with Gtkada.C;             use Gtkada.C;
25
25
with System;
26
26
with Gdk.Color;            use Gdk.Color;
27
27
with Interfaces.C.Strings; use Interfaces.C.Strings;
28
28
 
 
29
with Glib.Type_Conversion_Hooks;
 
30
 
29
31
package body Gtk.Color_Selection is
30
32
 
 
33
   package Type_Conversion is new Glib.Type_Conversion_Hooks.Hook_Registrator
 
34
     (Get_Type'Access, Gtk_Color_Selection_Record);
 
35
   pragma Warnings (Off, Type_Conversion);
 
36
   package Color_Arrays is new Gtkada.C.Unbounded_Arrays
 
37
     (Gdk.Color.Gdk_Color, Gdk.Color.Null_Color, Natural,
 
38
      Gdk.Color.Gdk_Color_Array);
 
39
 
31
40
   Global_Palette_With_Screen_Hook :
32
41
     Gtk_Color_Selection_Change_Palette_With_Screen_Func := null;
33
42
 
36
45
   pragma Convention (C, Palette_Hook_Proxy);
37
46
   --  Proxy for the Palette_With_Screen_Hook
38
47
 
39
 
   type Big_Color_Array is array (Natural) of Gdk_Color;
40
 
   pragma Convention (C, Big_Color_Array);
41
 
   type Big_Color_Array_Access is access Big_Color_Array;
42
 
 
43
 
   function Convert is new Ada.Unchecked_Conversion
44
 
     (System.Address, Big_Color_Array_Access);
45
 
 
46
48
   ---------------
47
49
   -- Get_Color --
48
50
   ---------------
334
336
   -------------------------
335
337
 
336
338
   function Palette_From_String (Str : String) return Gdk_Color_Array is
 
339
      use Color_Arrays;
337
340
      function Internal
338
 
        (Str : String; Colors : access System.Address; N : access Gint)
 
341
        (Str : String;
 
342
         Colors : access Unbounded_Array_Access; N : access Gint)
339
343
         return Gboolean;
340
344
      pragma Import (C, Internal, "gtk_color_selection_palette_from_string");
341
345
 
342
346
      N      : aliased Gint;
343
 
      Result : aliased System.Address;
 
347
      Output : aliased Unbounded_Array_Access;
344
348
   begin
345
 
      if Internal (Str & ASCII.NUL, Result'Access, N'Access) = 0 then
346
 
         return (1 .. 0 => Null_Color);
347
 
      else
348
 
         declare
349
 
            Res    : constant Big_Color_Array_Access := Convert (Result);
350
 
            Output : Gdk_Color_Array (1 .. Natural (N));
351
 
         begin
352
 
            for O in Output'Range loop
353
 
               Output (O) := Res (O - 1);
354
 
            end loop;
355
 
            return Output;
356
 
         end;
 
349
      if Internal (Str & ASCII.NUL, Output'Access, N'Access) = 0 then
 
350
         Output := null;
357
351
      end if;
 
352
 
 
353
      declare
 
354
         Result : constant Gdk_Color_Array := To_Array (Output, Integer (N));
 
355
      begin
 
356
         G_Free (Output);
 
357
         return Result;
 
358
      end;
358
359
   end Palette_From_String;
359
360
 
360
361
   -----------------------
389
390
   procedure Palette_Hook_Proxy
390
391
     (Screen : Gdk_Screen; Colors : System.Address; N_Colors : Gint)
391
392
   is
392
 
      Res    : constant Big_Color_Array_Access := Convert (Colors);
393
 
      Output : Gdk_Color_Array (1 .. Natural (N_Colors));
 
393
      Output : constant Gdk_Color_Array := Color_Arrays.To_Array
 
394
        (Color_Arrays.Convert (Colors), Integer (N_Colors));
394
395
   begin
395
 
      for O in Output'Range loop
396
 
         Output (O) := Res (O - 1);
397
 
      end loop;
398
396
      Global_Palette_With_Screen_Hook (Screen, Output);
399
397
   end Palette_Hook_Proxy;
400
398
 
424
422
      return Old;
425
423
   end Set_Change_Palette_With_Screen_Hook;
426
424
 
427
 
 
428
425
end Gtk.Color_Selection;