[Gtkada-wrapper-devel] SF.net SVN: gtkada-wrapper: [14] trunk
Brought to you by:
bechir_zalila
Menu
▾
▴
[Gtkada-wrapper-devel] SF.net SVN: gtkada-wrapper: [14] trunk
|
From: <bec...@us...> - 2006-11-26 22:41:09
|
Revision: 14
http://svn.sourceforge.net/gtkada-wrapper/?rev=14&view=rev
Author: bechir_zalila
Date: 2006-11-26 14:41:08 -0800 (Sun, 26 Nov 2006)
Log Message:
-----------
* Fixed the color problem. Now, we use a color table. Predefined
colors are allocated at the beginning of theis table. Possible
user custom color may be allocated during the execution of the
program.
Modified Paths:
--------------
trunk/TODO
trunk/src/gtkada_wrapper.adb
trunk/src/gtkada_wrapper.ads
Modified: trunk/TODO
===================================================================
--- trunk/TODO 2006-11-26 20:30:23 UTC (rev 13)
+++ trunk/TODO 2006-11-26 22:41:08 UTC (rev 14)
@@ -1,5 +1,4 @@
/src:
- * Solve the color problem
* Implement custom colors
* Implement Text area
* Remove the Idle loop
Modified: trunk/src/gtkada_wrapper.adb
===================================================================
--- trunk/src/gtkada_wrapper.adb 2006-11-26 20:30:23 UTC (rev 13)
+++ trunk/src/gtkada_wrapper.adb 2006-11-26 22:41:08 UTC (rev 14)
@@ -6,6 +6,8 @@
with Ada.Numerics.Elementary_Functions; use Ada.Numerics.Elementary_Functions;
with Unchecked_Deallocation;
+with GNAT.Table;
+
with Glib; use Glib;
with Gdk.Color; use Gdk.Color;
@@ -29,6 +31,8 @@
with Protected_Queue;
+pragma Debug_Policy (Ignore); -- 'Ignore' Or 'Check'
+
package body Gtkada_Wrapper is
procedure O (Message : String) renames Ada.Text_IO.Put_Line;
@@ -61,9 +65,6 @@
-- This is the main loop that handle the user commands. It is
-- registered as an "Idle" function of the main window
- function Image (C : Color_Type) return String;
- -- For debugging purpose
-
function To_Gdk_Color (C : Color_Type) return Gdk_Color;
pragma Inline (To_Gdk_Color);
-- Convert user colors to GDK colors
@@ -75,6 +76,10 @@
Y_End : Float);
-- Draw a line with the current graphic properties
+ procedure Allocate_Predefined_Colors;
+ -- Allocate the predefined colors. This is necessary for them to
+ -- be valid.
+
----------------------
-- Global Variables --
----------------------
@@ -102,10 +107,6 @@
Fill_Color : Color_Type := White;
-- Properties of the virtual brush
- pragma Warnings (Off, Brush_X);
- pragma Warnings (Off, Brush_Y);
- pragma Warnings (Off, Angle);
-
VBox : Gtk_Vbox;
-- The immediate container of the windows
@@ -120,34 +121,11 @@
Pixmap : Gdk_Pixmap;
-- Pixmap usefult when rafreshing the drawing area
- N_Colors : constant := 13;
+ package Color_Table is new GNAT.Table
+ (Gdk_Color, Color_Type, 1, 20, 10);
+ -- The table of colors. Predefined colors are allocated at the
+ -- beginning of the table. User colors are allocated after.
- Color_Table : Gdk_Color_Array (1 .. N_Colors);
- -- FIXME: Why does colors have to be declared at library level and
- -- allocated?
-
- type RGB_Fields is record
- R : Guint16;
- G : Guint16;
- B : Guint16;
- end record;
-
- RGB_Vals : constant array (Color_Type range 1 .. Color_Type (N_Colors))
- of RGB_Fields :=
- (Black => (0, 0, 0),
- Red => (65535, 0, 0),
- Green => (0, 65535, 0),
- Yellow => (65535, 65535, 0),
- Blue => (0, 0, 65535),
- Magenta => (65535, 0, 65535),
- Cyan => (0, 65535, 65535),
- Dark_Gray => (19789, 19789, 19789),
- Orange => (65535, 42405, 0),
- Pink => (65535, 49344, 52171),
- Gray => (32767, 32767, 32767),
- Light_Gray => (46003, 46003, 46003),
- White => (65535, 65535, 65535));
-
-- User_Task : Task_Id := Null_Task_ID; -- Task that sets up world.
-- Pixmap : Gdk_Pixmap; -- Pixmap used as backing store.
-- Pausing : Boolean := False;
@@ -474,21 +452,9 @@
Cap_Style => Cap_Round,
Join_Style => Join_Round);
- -- Allocate colors
+ -- Allocate predefined colors
- declare
- Success : Boolean_Array (1 .. N_Colors);
- N_Failed : Gint;
- begin
- Alloc_Colors
- (Colormap => Gtk.Widget.Get_Default_Colormap,
- Colors => Color_Table,
- Writeable => False,
- Best_Match => True,
- Success => Success,
- Result => N_Failed);
- pragma Assert (N_Failed = 0);
- end;
+ Allocate_Predefined_Colors;
Set_Foreground (Graphic_Context, To_Gdk_Color (Line_Color));
Set_Background (Graphic_Context, To_Gdk_Color (Fill_Color));
@@ -500,6 +466,52 @@
end Main_Window_Type;
+ --------------------------------
+ -- Allocate_Predefined_Colors --
+ --------------------------------
+
+ procedure Allocate_Predefined_Colors is
+ procedure Allocate_Predefined_Color
+ (Col : Color_Type;
+ R : Guint16;
+ G : Guint16;
+ B : Guint16);
+ -- Allocate a predefined color and insert it in its predefined
+ -- position in the color table.
+
+ -------------------------------
+ -- Allocate_Predefined_Color --
+ -------------------------------
+
+ procedure Allocate_Predefined_Color
+ (Col : Color_Type;
+ R : Guint16;
+ G : Guint16;
+ B : Guint16)
+ is
+ Gdk_Col : Gdk_Color;
+ begin
+ Set_Rgb (Gdk_Col, R, G, B);
+ Alloc (Colormap => Gtk.Widget.Get_Default_Colormap,
+ Color => Gdk_Col);
+ Color_Table.Set_Item (Col, Gdk_Col);
+ end Allocate_Predefined_Color;
+ begin
+ Allocate_Predefined_Color (Black, 0, 0, 0);
+ Allocate_Predefined_Color (Red, 65535, 0, 0);
+ Allocate_Predefined_Color (Green, 0, 65535, 0);
+ Allocate_Predefined_Color (Yellow, 65535, 65535, 0);
+ Allocate_Predefined_Color (Blue, 0, 0, 65535);
+ Allocate_Predefined_Color (Magenta, 65535, 0, 65535);
+ Allocate_Predefined_Color (Cyan, 0, 65535, 65535);
+ Allocate_Predefined_Color (Dark_Gray, 19789, 19789, 19789);
+ Allocate_Predefined_Color (Orange, 65535, 42405, 0);
+ Allocate_Predefined_Color (Pink, 65535, 49344, 52171);
+ Allocate_Predefined_Color (Gray, 32767, 32767, 32767);
+ Allocate_Predefined_Color (Light_Gray, 46003, 46003, 46003);
+ Allocate_Predefined_Color (White, 65535, 65535, 65535);
+ end Allocate_Predefined_Colors;
+
------------------------------
-- Assert_Main_Window_Exits --
------------------------------
@@ -741,8 +753,9 @@
begin
pragma Debug (O ("Do_Fill_Color: begin"));
Fill_Color := Cmd.Color;
- -- Set_Background (Graphic_Context, To_Gdk_Color (Fill_Color));
- pragma Debug (O ("Fill color changed to" & Image (Fill_Color)));
+ Set_Background (Graphic_Context, To_Gdk_Color (Fill_Color));
+ pragma Debug (O ("Fill color changed to" &
+ To_String (Color_Table.Table (Fill_Color))));
pragma Debug (O ("Do_Fill_Color: end"));
end Do_Fill_Color;
@@ -847,7 +860,8 @@
pragma Debug (O ("Do_Line_Color: begin"));
Line_Color := Cmd.Color;
Set_Foreground (Graphic_Context, To_Gdk_Color (Line_Color));
- pragma Debug (O ("Line color changed to " & Image (Line_Color)));
+ pragma Debug (O ("Line color changed to "
+ & To_String (Color_Table.Table (Line_Color))));
pragma Debug (O ("Do_Line_Color: done"));
end Do_Line_Color;
@@ -1234,37 +1248,6 @@
return Thickness;
end Get_Thickness;
- -----------
- -- Image --
- -----------
-
- function Image (C : Color_Type) return String is
- function Image (I : Guint16) return String;
- -- Return the image of I without the heading space
-
- -----------
- -- Image --
- -----------
-
- function Image (I : Guint16) return String is
- Img : constant String := Guint16'Image (I);
- begin
- if Img (Img'First) = ' ' then
- return Img (Img'First + 1 .. Img'Last);
- else
- return Img;
- end if;
- end Image;
-
- RGB_Col : constant RGB_Fields := RGB_Vals (C);
-
- begin
- return "("
- & Image (RGB_Col.R) & ", "
- & Image (RGB_Col.G) & ", "
- & Image (RGB_Col.B) & ")";
- end Image;
-
------------------
-- Insert_Image --
------------------
@@ -1468,7 +1451,7 @@
end if;
end if;
- -- Mark a small delay to not hav 100% of CPU occupied
+ -- Mark a small delay to not have 100% of CPU occupied
delay 0.001;
@@ -1568,10 +1551,13 @@
---------
function RGB (R : Integer; G : Integer; B : Integer) return Color_Type is
+ Gdk_Col : Gdk_Color;
begin
- -- FIXME
- raise Program_Error with "Not Yet Implemented";
- return 1;
+ Color_Table.Increment_Last;
+ Set_Rgb (Gdk_Col, Guint16 (R), Guint16 (G), Guint16 (B));
+ Alloc (Colormap => Gtk.Widget.Get_Default_Colormap,
+ Color => Gdk_Col);
+ return Color_Table.Last;
end RGB;
------------
@@ -1681,7 +1667,7 @@
function To_Gdk_Color (C : Color_Type) return Gdk_Color is
begin
- return Color_Table (Positive (C));
+ return Color_Table.Table (C);
end To_Gdk_Color;
end Gtkada_Wrapper;
Modified: trunk/src/gtkada_wrapper.ads
===================================================================
--- trunk/src/gtkada_wrapper.ads 2006-11-26 20:30:23 UTC (rev 13)
+++ trunk/src/gtkada_wrapper.ads 2006-11-26 22:41:08 UTC (rev 14)
@@ -220,8 +220,6 @@
private
- type Single_Color is mod 256;
-
type Color_Type is new Positive;
Black : constant Color_Type := 1;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
