[Gtkada-wrapper-devel] SF.net SVN: gtkada-wrapper: [11] trunk
Brought to you by:
bechir_zalila
Menu
▾
▴
[Gtkada-wrapper-devel] SF.net SVN: gtkada-wrapper: [11] trunk
|
From: <bec...@us...> - 2006-11-26 02:02:06
|
Revision: 11
http://svn.sourceforge.net/gtkada-wrapper/?rev=11&view=rev
Author: bechir_zalila
Date: 2006-11-25 18:02:01 -0800 (Sat, 25 Nov 2006)
Log Message:
-----------
* (gtkada_wrapper.adb): Creation of the drawing area. Addition of the
main loop function. Handling of some user commands (mouse click,
and destroy).
* (empty_window.adb): First example fully operational.
Modified Paths:
--------------
trunk/examples/empty_window/README
trunk/examples/empty_window/empty_window.adb
trunk/src/gtkada_wrapper.adb
trunk/src/gtkada_wrapper.ads
Modified: trunk/examples/empty_window/README
===================================================================
--- trunk/examples/empty_window/README 2006-11-25 23:12:11 UTC (rev 10)
+++ trunk/examples/empty_window/README 2006-11-26 02:02:01 UTC (rev 11)
@@ -1,3 +1,2 @@
This example test the creation, the display, and the destruction of a
-main windows. The main windows is destroyed when the user close it or
-clic on it.
+main windows. The main windows is destroyed when the user clicks on it.
Modified: trunk/examples/empty_window/empty_window.adb
===================================================================
--- trunk/examples/empty_window/empty_window.adb 2006-11-25 23:12:11 UTC (rev 10)
+++ trunk/examples/empty_window/empty_window.adb 2006-11-26 02:02:01 UTC (rev 11)
@@ -6,9 +6,18 @@
with GTKAda_Wrapper; use GTKAda_Wrapper;
+with Ada.Text_IO;
+
procedure Empty_Window is
+ X : Float;
+ Y : Float;
+ Button : Natural;
begin
Create_Main_Window;
-
- delay 5.0;
+ Get_Mouse_Pointer (X, Y, Button);
+ Ada.Text_IO.Put_Line ("Got Click:");
+ Ada.Text_IO.Put_Line (" X = " & X'Img);
+ Ada.Text_IO.Put_Line (" Y = " & Y'Img);
+ Ada.Text_IO.Put_Line (" Button = " & Button'Img);
+ Destroy_Main_Window;
end Empty_Window;
Modified: trunk/src/gtkada_wrapper.adb
===================================================================
--- trunk/src/gtkada_wrapper.adb 2006-11-25 23:12:11 UTC (rev 10)
+++ trunk/src/gtkada_wrapper.adb 2006-11-26 02:02:01 UTC (rev 11)
@@ -2,19 +2,26 @@
-- Copyright (C) 2006 Bechir Zalila <bec...@en...>
-- See COPYING file for license
+with Ada.Text_IO;
with Unchecked_Deallocation;
with Glib; use Glib;
--- with Gdk.Window; use Gdk.Window;
+with Gdk.Types; use Gdk.Types;
+with Gdk.Event; use Gdk.Event;
+with Gdk.Pixmap; use Gdk.Pixmap;
+with Gdk.Window; use Gdk.Window;
+with Gdk.Drawable; use Gdk.Drawable;
+with Gdk.Rectangle; use Gdk.Rectangle;
-with Gdk.Types; use Gdk.Types;
+with Gtk.Drawing_Area; use Gtk.Drawing_Area;
with Gtk.Window; use Gtk.Window;
with Gtk.Enums; use Gtk.Enums;
with Gtk.Box; use Gtk.Box;
with Gtk.Paned; use Gtk.Paned;
with Gtk.Main; use Gtk.Main;
with Gtk.Handlers; use Gtk.Handlers;
+with Gtk.Style; use Gtk.Style;
with Protected_Queue;
@@ -26,6 +33,27 @@
procedure Assert_Main_Window_Exits;
-- Raises an error if the Main windows does not exist
+ function Configure_Event
+ (Drawing_Area : access Gtk_Drawing_Area_Record'Class)
+ return Boolean;
+ -- Handler for the "configure_event" signal of the drawing area
+
+ function Expose_Event
+ (Drawing_Area : access Gtk_Drawing_Area_Record'Class;
+ Event : Gdk.Event.Gdk_Event)
+ return Boolean;
+ -- Handler for the "expose_event" signal of the drawing area
+
+ function Button_Press_Event
+ (Drawing_Area : access Gtk_Drawing_Area_Record'Class;
+ Event : Gdk.Event.Gdk_Event)
+ return Boolean;
+ -- Handler for the "button_press_event" signal of the drawing area
+
+ function Main_Loop return Boolean;
+ -- This is the main loop that handle the user commands. It is
+ -- registered as an "Idle" function of the main window
+
----------------------
-- Global Variables --
----------------------
@@ -33,6 +61,14 @@
Window : Gtk_Window;
-- The main window of the application
+ Have_Drawing_Area : Boolean;
+ Have_Text_Area : Boolean;
+ -- Properties of the main window
+
+ Main_Loop_Id : Idle_Handler_Id;
+ pragma Unreferenced (Main_Loop_Id);
+ -- Id of the main loop function
+
Width : Gint;
Height : Gint;
-- Dimensions of the drawing and text areas
@@ -53,6 +89,12 @@
-- The container of the window components (the drawing area and
-- the text area).
+ Drawing_Area : Gtk_Drawing_Area;
+ -- The drawing area of the main window
+
+ Pixmap : Gdk_Pixmap;
+ -- Pixmap usefult when rafreshing the drawing area
+
-- User_Task : Task_Id := Null_Task_ID; -- Task that sets up world.
-- Pixmap : Gdk_Pixmap; -- Pixmap used as backing store.
-- Pausing : Boolean := False;
@@ -64,13 +106,19 @@
-- Width, Height : Gint;
-- Gc : Gdk_Gc;
- --------------
- -- Handlers --
- --------------
+ --------------------
+ -- Event Handlers --
+ --------------------
- package Destroyed is new Gtk.Handlers.Callback
+ package Main_Window_Handlers is new Gtk.Handlers.Callback
(Widget_Type => Gtk_Window_Record);
+ -- Handler management of the main window
+ package Drawing_Area_Handlers is new Gtk.Handlers.Return_Callback
+ (Widget_Type => Gtk_Drawing_Area_Record,
+ Return_Type => Boolean);
+ -- Handler management of the drawing area
+
-- The actions the user can do
type Action_Kind is
@@ -188,6 +236,36 @@
end case;
end record;
+ -- For each action, we declare a subprogram that does the job
+
+ procedure Do_Destroy (Cmd : Command);
+ procedure Do_Clear_Drawing_Area (Cmd : Command);
+ procedure Do_Line_Color (Cmd : Command);
+ procedure Do_Fill_Color (Cmd : Command);
+ procedure Do_Thickness (Cmd : Command);
+ procedure Do_Angle (Cmd : Command);
+ procedure Do_Rotate (Cmd : Command);
+ procedure Do_Jump_With_Length (Cmd : Command);
+ procedure Do_Jump_With_End (Cmd : Command);
+ procedure Do_Line_With_Length (Cmd : Command);
+ procedure Do_Line_With_End (Cmd : Command);
+ procedure Do_Line_With_Start_Length (Cmd : Command);
+ procedure Do_Line_With_Start_End (Cmd : Command);
+ procedure Do_Spot (Cmd : Command);
+ procedure Do_Image (Cmd : Command);
+ procedure Do_Text (Cmd : Command);
+ procedure Do_Rafresh (Cmd : Command);
+ procedure Do_Get_Mouse_Pointer (Cmd : Command);
+ procedure Do_Clear_Text_Area (Cmd : Command);
+ procedure Do_Put_String (Cmd : Command);
+ procedure Do_Put_Character (Cmd : Command);
+ procedure Do_New_Line (Cmd : Command);
+ procedure Do_Put_Line_String (Cmd : Command);
+ procedure Do_Put_Line_Character (Cmd : Command);
+ procedure Do_Get_String (Cmd : Command);
+ procedure Do_Get_Line_String (Cmd : Command);
+ procedure Do_Get_Immediate_Character (Cmd : Command);
+
-- The user command queue
package Command_Queue is new Protected_Queue (Command, 10000);
@@ -200,6 +278,10 @@
R_Console,
R_Immediate);
+ -- Current waited reponse
+
+ Current_Waited_Response : Response_Kind := R_None;
+
-- The response data
type Response (Rsp_Kind : Response_Kind := R_None) is record
@@ -223,7 +305,6 @@
-- Response queue
package Response_Queue is new Protected_Queue (Response, 10000);
- pragma Unreferenced (Response_Queue);
-- The main window is created by a task that is allocated on the
-- user demand.
@@ -255,9 +336,10 @@
-- When the window is destroyed, some work has to be done
- Destroyed.Connect (Window,
- "destroy",
- Destroyed.To_Marshaller (Quit'Access));
+ Main_Window_Handlers.Connect
+ (Window,
+ "destroy",
+ Main_Window_Handlers.To_Marshaller (Quit'Access));
-- Create the immediate window vertical box and adding it to
-- the windows
@@ -270,8 +352,52 @@
Gtk_New_Hpaned (HPaned);
Pack_Start (VBox, HPaned);
- -- FIXME: Create the drawing area and the text area
+ -- If the user requested a drawing area, create it and append
+ -- it to the paned.
+ if Have_Drawing_Area then
+ Gtk_New (Drawing_Area);
+ Size (Drawing_Area, Width, Height);
+ Pack1 (HPaned, Drawing_Area, Resize => False, Shrink => False);
+
+ -- The only user event that may trigger the drawing area are
+ -- mouse clicks and exposure evenets (to rafresh it).
+
+ Set_Events (Drawing_Area, Exposure_Mask or Button_Press_Mask);
+
+ Drawing_Area_Handlers.Connect
+ (Widget => Drawing_Area,
+ Name => "expose_event",
+ Marsh => Drawing_Area_Handlers.To_Marshaller
+ (Expose_Event'Access));
+
+ Drawing_Area_Handlers.Connect
+ (Widget => Drawing_Area,
+ Name => "button_press_event",
+ Marsh => Drawing_Area_Handlers.To_Marshaller
+ (Button_Press_Event'Access));
+
+ -- Configure event is called when the window configuration
+ -- is changed (moved, resized, became visible...)
+
+ Drawing_Area_Handlers.Connect
+ (Widget => Drawing_Area,
+ Name => "configure_event",
+ Marsh => Drawing_Area_Handlers.To_Marshaller
+ (Configure_Event'Access));
+ end if;
+
+ -- If the user requested a text area, create it and append
+ -- it to the paned.
+
+ if Have_Text_Area then
+ null;
+ end if;
+
+ -- Set the main loop function as "Idle"
+
+ Main_Loop_Id := Idle_Add (Main_Loop'Access);
+
Show_All (Window);
Gtk.Main.Main;
@@ -286,11 +412,44 @@
procedure Assert_Main_Window_Exits is
begin
if Main_Window = null then
- raise Lost_Main_Windows with "The main window does not exist";
+ raise Lost_Main_Window with "The main window does not exist";
end if;
end Assert_Main_Window_Exits;
------------------------
+ -- Button_Press_Event --
+ ------------------------
+
+ function Button_Press_Event
+ (Drawing_Area : access Gtk_Drawing_Area_Record'Class;
+ Event : Gdk.Event.Gdk_Event)
+ return Boolean
+ is
+ pragma Unreferenced (Drawing_Area);
+ begin
+ -- Do not take in consideration mouse clicks on ly if the user
+ -- asked explicitely for them
+
+ if Current_Waited_Response = R_Mouse then
+ Ada.Text_IO.Put_Line ("button_press");
+
+ -- Restore the current waited response
+
+ Current_Waited_Response := R_None;
+
+ -- Enqueue the response to the user
+
+ Response_Queue.Enqueue
+ (Response'(Rsp_Kind => R_Mouse,
+ X => Float (Get_X (Event)),
+ Y => Float (Get_Y (Event)),
+ Button => Natural (Get_Button (Event))));
+ end if;
+
+ return True;
+ end Button_Press_Event;
+
+ ------------------------
-- Clear_Drawing_Area --
------------------------
@@ -308,6 +467,63 @@
Assert_Main_Window_Exits;
end Clear_Text_Area;
+ ---------------------
+ -- Configure_Event --
+ ---------------------
+
+ function Configure_Event
+ (Drawing_Area : access Gtk_Drawing_Area_Record'Class)
+ return Boolean
+ is
+ Win : Gdk_Window;
+ New_Width : Gint;
+ New_Height : Gint;
+ New_Pixmap : Gdk_Pixmap;
+
+ use type Gdk.Gdk_Drawable;
+ begin
+ Ada.Text_IO.Put_Line ("configure");
+ Win := Get_Window (Drawing_Area);
+
+ -- Allocate a new pixmap of the reconfigured size and clear it
+ -- to white.
+
+ Get_Size (Win, New_Width, New_Height);
+ Gdk.Pixmap.Gdk_New (New_Pixmap, Win, New_Width, New_Height, -1);
+ Draw_Rectangle (New_Pixmap,
+ Get_White (Get_Style (Drawing_Area)),
+ True,
+ 0,
+ 0,
+ New_Width,
+ New_Height);
+
+ -- If there was a pixmap previously, copy the image to the new
+ -- one. Free the original.
+
+ if Pixmap /= Null_Pixmap then
+ Draw_Pixmap (New_Pixmap,
+ Get_Fg_GC (Get_Style (Drawing_Area), State_Normal),
+ Pixmap,
+ 0,
+ 0,
+ 0,
+ 0,
+ Gint'Min (Width, New_Width),
+ Gint'Min (Height, New_Height));
+
+ Gdk.Pixmap.Unref (Pixmap);
+ end if;
+
+ -- Update the drawing area properties
+
+ Pixmap := New_Pixmap;
+ Height := New_Height;
+ Width := New_Width;
+
+ return True;
+ end Configure_Event;
+
------------------------
-- Create_Main_Window --
------------------------
@@ -318,7 +534,6 @@
Text_Area : Boolean := False;
Drawing_Area : Boolean := True)
is
- pragma Unreferenced (Text_Area, Drawing_Area);
begin
if Main_Window /= null then
raise Program_Error with "The main windows already exists";
@@ -330,6 +545,9 @@
Brush_X := Float (Width) / 2.0;
Brush_Y := Float (Height) / 2.0;
+ Have_Drawing_Area := Drawing_Area;
+ Have_Text_Area := Text_Area;
+
Main_Window := new Main_Window_Type;
end Create_Main_Window;
@@ -343,6 +561,303 @@
Command_Queue.Enqueue (Command'(Action => A_Destroy));
end Destroy_Main_Window;
+ --------------
+ -- Do_Angle --
+ --------------
+
+ procedure Do_Angle (Cmd : Command) is
+ pragma Unreferenced (Cmd);
+ begin
+ null;
+ end Do_Angle;
+
+ ---------------------------
+ -- Do_Clear_Drawing_Area --
+ ---------------------------
+
+ procedure Do_Clear_Drawing_Area (Cmd : Command) is
+ pragma Unreferenced (Cmd);
+ begin
+ null;
+ end Do_Clear_Drawing_Area;
+
+ ------------------------
+ -- Do_Clear_Text_Area --
+ ------------------------
+
+ procedure Do_Clear_Text_Area (Cmd : Command) is
+ pragma Unreferenced (Cmd);
+ begin
+ null;
+ end Do_Clear_Text_Area;
+
+ ----------------
+ -- Do_Destroy --
+ ----------------
+
+ procedure Do_Destroy (Cmd : Command) is
+ pragma Unreferenced (Cmd);
+ begin
+ Quit (Window);
+ end Do_Destroy;
+
+ -------------------
+ -- Do_Fill_Color --
+ -------------------
+
+ procedure Do_Fill_Color (Cmd : Command) is
+ pragma Unreferenced (Cmd);
+ begin
+ null;
+ end Do_Fill_Color;
+
+ --------------------------------
+ -- Do_Get_Immediate_Character --
+ --------------------------------
+
+ procedure Do_Get_Immediate_Character (Cmd : Command) is
+ pragma Unreferenced (Cmd);
+ begin
+ null;
+ end Do_Get_Immediate_Character;
+
+ ------------------------
+ -- Do_Get_Line_String --
+ ------------------------
+
+ procedure Do_Get_Line_String (Cmd : Command) is
+ pragma Unreferenced (Cmd);
+ begin
+ null;
+ end Do_Get_Line_String;
+
+ --------------------------
+ -- Do_Get_Mouse_Pointer --
+ --------------------------
+
+ procedure Do_Get_Mouse_Pointer (Cmd : Command) is
+ pragma Unreferenced (Cmd);
+ begin
+ Current_Waited_Response := R_Mouse;
+ end Do_Get_Mouse_Pointer;
+
+ -------------------
+ -- Do_Get_String --
+ -------------------
+
+ procedure Do_Get_String (Cmd : Command) is
+ pragma Unreferenced (Cmd);
+ begin
+ null;
+ end Do_Get_String;
+
+ --------------
+ -- Do_Image --
+ --------------
+
+ procedure Do_Image (Cmd : Command) is
+ pragma Unreferenced (Cmd);
+ begin
+ null;
+ end Do_Image;
+
+ ----------------------
+ -- Do_Jump_With_End --
+ ----------------------
+
+ procedure Do_Jump_With_End (Cmd : Command) is
+ pragma Unreferenced (Cmd);
+ begin
+ null;
+ end Do_Jump_With_End;
+
+ -------------------------
+ -- Do_Jump_With_Length --
+ -------------------------
+
+ procedure Do_Jump_With_Length (Cmd : Command) is
+ pragma Unreferenced (Cmd);
+ begin
+ null;
+ end Do_Jump_With_Length;
+
+ -------------------
+ -- Do_Line_Color --
+ -------------------
+
+ procedure Do_Line_Color (Cmd : Command) is
+ pragma Unreferenced (Cmd);
+ begin
+ null;
+ end Do_Line_Color;
+
+ ----------------------
+ -- Do_Line_With_End --
+ ----------------------
+
+ procedure Do_Line_With_End (Cmd : Command) is
+ pragma Unreferenced (Cmd);
+ begin
+ null;
+ end Do_Line_With_End;
+
+ -------------------------
+ -- Do_Line_With_Length --
+ -------------------------
+
+ procedure Do_Line_With_Length (Cmd : Command) is
+ pragma Unreferenced (Cmd);
+ begin
+ null;
+ end Do_Line_With_Length;
+
+ ----------------------------
+ -- Do_Line_With_Start_End --
+ ----------------------------
+
+ procedure Do_Line_With_Start_End (Cmd : Command) is
+ pragma Unreferenced (Cmd);
+ begin
+ null;
+ end Do_Line_With_Start_End;
+
+ -------------------------------
+ -- Do_Line_With_Start_Length --
+ -------------------------------
+
+ procedure Do_Line_With_Start_Length (Cmd : Command) is
+ pragma Unreferenced (Cmd);
+ begin
+ null;
+ end Do_Line_With_Start_Length;
+
+ -----------------
+ -- Do_New_Line --
+ -----------------
+
+ procedure Do_New_Line (Cmd : Command) is
+ pragma Unreferenced (Cmd);
+ begin
+ null;
+ end Do_New_Line;
+
+ ----------------------
+ -- Do_Put_Character --
+ ----------------------
+
+ procedure Do_Put_Character (Cmd : Command) is
+ pragma Unreferenced (Cmd);
+ begin
+ null;
+ end Do_Put_Character;
+
+ ---------------------------
+ -- Do_Put_Line_Character --
+ ---------------------------
+
+ procedure Do_Put_Line_Character (Cmd : Command) is
+ pragma Unreferenced (Cmd);
+ begin
+ null;
+ end Do_Put_Line_Character;
+
+ ------------------------
+ -- Do_Put_Line_String --
+ ------------------------
+
+ procedure Do_Put_Line_String (Cmd : Command) is
+ pragma Unreferenced (Cmd);
+ begin
+ null;
+ end Do_Put_Line_String;
+
+ -------------------
+ -- Do_Put_String --
+ -------------------
+
+ procedure Do_Put_String (Cmd : Command) is
+ pragma Unreferenced (Cmd);
+ begin
+ null;
+ end Do_Put_String;
+
+ ----------------
+ -- Do_Rafresh --
+ ----------------
+
+ procedure Do_Rafresh (Cmd : Command) is
+ pragma Unreferenced (Cmd);
+ begin
+ null;
+ end Do_Rafresh;
+
+ ---------------
+ -- Do_Rotate --
+ ---------------
+
+ procedure Do_Rotate (Cmd : Command) is
+ pragma Unreferenced (Cmd);
+ begin
+ null;
+ end Do_Rotate;
+
+ -------------
+ -- Do_Spot --
+ -------------
+
+ procedure Do_Spot (Cmd : Command) is
+ pragma Unreferenced (Cmd);
+ begin
+ null;
+ end Do_Spot;
+
+ -------------
+ -- Do_Text --
+ -------------
+
+ procedure Do_Text (Cmd : Command) is
+ pragma Unreferenced (Cmd);
+ begin
+ null;
+ end Do_Text;
+
+ ------------------
+ -- Do_Thickness --
+ ------------------
+
+ procedure Do_Thickness (Cmd : Command) is
+ pragma Unreferenced (Cmd);
+ begin
+ null;
+ end Do_Thickness;
+
+ ------------------
+ -- Expose_Event --
+ ------------------
+
+ function Expose_Event
+ (Drawing_Area : access Gtk_Drawing_Area_Record'Class;
+ Event : Gdk.Event.Gdk_Event)
+ return Boolean
+ is
+ Area : constant Gdk_Rectangle := Get_Area (Event);
+ begin
+ Ada.Text_IO.Put_Line ("expose");
+
+ -- Restore screen from backing store pixmap
+
+ Draw_Pixmap (Get_Window (Drawing_Area),
+ Get_Fg_GC (Get_Style (Drawing_Area), State_Normal),
+ Pixmap,
+ Area.X,
+ Area.Y,
+ Area.X,
+ Area.Y,
+ Gint (Area.Width),
+ Gint (Area.Height));
+ return True;
+ end Expose_Event;
+
---------
-- Get --
---------
@@ -412,9 +927,24 @@
Y : out Float;
Button : out Natural)
is
- pragma Unreferenced (X, Y, Button);
+ Rsp : Response;
begin
Assert_Main_Window_Exits;
+ Command_Queue.Enqueue (Command'(Action => A_Get_Mouse_Pointer));
+ Rsp := Response_Queue.Dequeue;
+
+ case Rsp.Rsp_Kind is
+ when R_Mouse =>
+ X := Rsp.X;
+ Y := Rsp.Y;
+ Button := Rsp.Button;
+
+ when R_None =>
+ raise Lost_Main_Window;
+
+ when others =>
+ raise Program_Error;
+ end case;
end Get_Mouse_Pointer;
------------------
@@ -536,6 +1066,62 @@
Assert_Main_Window_Exits;
end Line;
+ -- Dispatch table
+
+ type Command_Proc_Type is access procedure (Cmd : Command);
+
+ Dispatch_Table : constant array (Action_Kind) of Command_Proc_Type :=
+ (A_Angle => Do_Angle'Access,
+ A_Clear_Drawing_Area => Do_Clear_Drawing_Area'Access,
+ A_Clear_Text_Area => Do_Clear_Text_Area'Access,
+ A_Destroy => Do_Destroy'Access,
+ A_Fill_Color => Do_Fill_Color'Access,
+ A_Get_Immediate_Character => Do_Get_Immediate_Character'Access,
+ A_Get_Line_String => Do_Get_Line_String'Access,
+ A_Get_Mouse_Pointer => Do_Get_Mouse_Pointer'Access,
+ A_Get_String => Do_Get_String'Access,
+ A_Image => Do_Image'Access,
+ A_Jump_With_End => Do_Jump_With_End'Access,
+ A_Jump_With_Length => Do_Jump_With_Length'Access,
+ A_Line_Color => Do_Line_Color'Access,
+ A_Line_With_End => Do_Line_With_End'Access,
+ A_Line_With_Length => Do_Line_With_Length'Access,
+ A_Line_With_Start_End => Do_Line_With_Start_End'Access,
+ A_Line_With_Start_Length => Do_Line_With_Start_Length'Access,
+ A_New_Line => Do_New_Line'Access,
+ A_None => null,
+ A_Put_Character => Do_Put_Character'Access,
+ A_Put_Line_Character => Do_Put_Line_Character'Access,
+ A_Put_Line_String => Do_Put_Line_String'Access,
+ A_Put_String => Do_Put_String'Access,
+ A_Rafresh => Do_Rafresh'Access,
+ A_Rotate => Do_Rotate'Access,
+ A_Spot => Do_Spot'Access,
+ A_Text => Do_Text'Access,
+ A_Thickness => Do_Thickness'Access);
+
+ ---------------
+ -- Main_Loop --
+ ---------------
+
+ function Main_Loop return Boolean is
+ Cmd : Command;
+ begin
+ if Command_Queue.Length > 0 then
+ Cmd := Command_Queue.Dequeue;
+
+ if Dispatch_Table (Cmd.Action) /= null then
+ Dispatch_Table (Cmd.Action).all (Cmd);
+ end if;
+ end if;
+
+ -- Mark a small delay to not hav 100% of CPU occupied
+
+ delay 0.001;
+
+ return True;
+ end Main_Loop;
+
--------------
-- New_Line --
--------------
Modified: trunk/src/gtkada_wrapper.ads
===================================================================
--- trunk/src/gtkada_wrapper.ads 2006-11-25 23:12:11 UTC (rev 10)
+++ trunk/src/gtkada_wrapper.ads 2006-11-26 02:02:01 UTC (rev 11)
@@ -12,7 +12,7 @@
package Gtkada_Wrapper is
- Lost_Main_Windows : exception;
+ Lost_Main_Window : exception;
-- This exception is raised if the user tries to manipulate the
-- windows before creating it or after destroying it.
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
