[Gtkada-wrapper-devel] SF.net SVN: gtkada-wrapper: [8] trunk/src

[<bec...@us...>]

Revision: 8
          http://svn.sourceforge.net/gtkada-wrapper/?rev=8&view=rev
Author:   bechir_zalila
Date:     2006-11-25 09:18:47 -0800 (Sat, 25 Nov 2006)

Log Message:
-----------
	* (protected_queue.ad?): Added a generic package for protected queues
	* (gtkada_wrapper.ad?): Added a reponse record type and instantiated
	a command queue and a response queue

Modified Paths:
--------------
    trunk/src/gtkada_wrapper.adb
    trunk/src/gtkada_wrapper.ads
    trunk/src/gtkada_wrapper.gpr

Added Paths:
-----------
    trunk/src/protected_queue.adb
    trunk/src/protected_queue.ads

Modified: trunk/src/gtkada_wrapper.adb
===================================================================
--- trunk/src/gtkada_wrapper.adb	2006-11-25 01:59:33 UTC (rev 7)
+++ trunk/src/gtkada_wrapper.adb	2006-11-25 17:18:47 UTC (rev 8)
@@ -1,11 +1,20 @@
+--  $Id$
+--  Copyright (C) 2006 Bechir Zalila <bec...@en...>
+--  See COPYING file for license
+
 with Unchecked_Deallocation;
 
+with Gdk.Types;        use Gdk.Types;
+
+with Protected_Queue;
+
 package body Gtkada_Wrapper is
 
    --  The actions the user can do
 
    type Action_Kind is
      (A_None,
+      A_Destroy,
       A_Clear_Drawing_Area,
       A_Line_Color,
       A_Fill_Color,
@@ -39,14 +48,16 @@
 
    --  The command data
 
-   type Command (Action : Action_Kind) is record
+   type Command (Action : Action_Kind := A_None) is record
       case Action is
          when A_None
+           | A_Destroy
            | A_Clear_Drawing_Area
            | A_Rafresh
            | A_Clear_Text_Area
            | A_Get_String
            | A_Get_Line_String
+           | A_Get_Mouse_Pointer
            | A_Get_Immediate_Character =>
             null;
 
@@ -105,11 +116,6 @@
                   null;
             end case;
 
-         when A_Get_Mouse_Pointer =>
-            X      : Float;
-            Y      : Float;
-            Button : Natural;
-
          when A_New_Line =>
             N_Lines : Positive;
 
@@ -120,8 +126,45 @@
             Char : Character;
       end case;
    end record;
-   pragma Unreferenced (Command);
 
+   --  The user command queue
+
+   package Command_Queue is new Protected_Queue (Command, 10000);
+   pragma Unreferenced (Command_Queue);
+
+   --  The response kind
+
+   type Response_Kind is
+     (R_None,
+      R_Mouse,
+      R_Console,
+      R_Immediate);
+
+   --  The response data
+
+   type Response (Rsp_Kind : Response_Kind := R_None) is record
+      case Rsp_Kind is
+         when R_None =>
+            null;
+
+         when R_Mouse =>
+            X      : Float;
+            Y      : Float;
+            Button : Natural;
+
+         when R_Console =>
+            Text : String_Ptr;
+
+         when R_Immediate =>
+            Key : Gdk_Key_Type;
+      end case;
+   end record;
+
+   --  Response queue
+
+   package Response_Queue is new Protected_Queue (Response, 10000);
+   pragma Unreferenced (Response_Queue);
+
    ------------------------
    -- Clear_Drawing_Area --
    ------------------------

Modified: trunk/src/gtkada_wrapper.ads
===================================================================
--- trunk/src/gtkada_wrapper.ads	2006-11-25 01:59:33 UTC (rev 7)
+++ trunk/src/gtkada_wrapper.ads	2006-11-25 17:18:47 UTC (rev 8)
@@ -1,5 +1,6 @@
 --  $Id$
---  AUTHOR: Bechir Zalila <bec...@en...>
+--  Copyright (C) 2006 Bechir Zalila <bec...@en...>
+--  See COPYING file for license
 
 --  This package provides a simplified api to build graphic Ada
 --  applications. Its purpose is to encapsulate the complexity of GTK

Modified: trunk/src/gtkada_wrapper.gpr
===================================================================
--- trunk/src/gtkada_wrapper.gpr	2006-11-25 01:59:33 UTC (rev 7)
+++ trunk/src/gtkada_wrapper.gpr	2006-11-25 17:18:47 UTC (rev 8)
@@ -1,3 +1,5 @@
+with "gtkada";
+
 project GTKAda_Wrapper is
    for Library_Kind use "static";
    for Source_Dirs use (".");

Added: trunk/src/protected_queue.adb
===================================================================
--- trunk/src/protected_queue.adb	                        (rev 0)
+++ trunk/src/protected_queue.adb	2006-11-25 17:18:47 UTC (rev 8)
@@ -0,0 +1,140 @@
+--  $Id$
+--  Copyright (C) 2006 Bechir Zalila <bec...@en...>
+--  See COPYING file for license
+
+with GNAT.Table;
+
+package body Protected_Queue is
+
+   type Waiting_Type is (To_Enqueue, To_Dequeue, To_Enqueue_Plus_Dequeue);
+   --  To choose which number of waiting task we want to get
+
+   package The_Queue is new GNAT.Table
+     (Element_Type, Natural, 1, 100, 10);
+
+   --  The protected object that ensure concurrency safety
+
+   protected The_Protected_Queue is
+      entry Enqueue (Element : Element_Type);
+      entry Dequeue (Element : out Element_Type);
+
+      function Number_Waiting
+        (To : Waiting_Type := To_Dequeue)
+        return Natural;
+
+      function Length return Natural;
+      procedure Clear;
+   end The_Protected_Queue;
+
+   protected body The_Protected_Queue is
+
+      -------------
+      -- Enqueue --
+      -------------
+
+      entry Enqueue (Element : Element_Type)
+      when The_Queue.Last < Max_Length is
+      begin
+         The_Queue.Append (Element);
+      end Enqueue;
+
+      -------------
+      -- Dequeue --
+      -------------
+
+      entry Dequeue (Element : out Element_Type)
+      when The_Queue.Last > 0 is
+      begin
+         Element := The_Queue.Table (The_Queue.Last);
+         The_Queue.Decrement_Last;
+      end Dequeue;
+
+      --------------------
+      -- Number_Waiting --
+      --------------------
+
+      function Number_Waiting
+        (To : Waiting_Type := To_Dequeue)
+        return Natural
+      is
+         Result : Natural := 0;
+      begin
+         if To = To_Enqueue or To = To_Enqueue_Plus_Dequeue then
+            Result := Result + The_Protected_Queue.Enqueue'Count;
+         end if;
+
+         if To = To_Dequeue or To = To_Enqueue_Plus_Dequeue then
+            Result := Result + The_Protected_Queue.Dequeue'Count;
+         end if;
+
+         return Result;
+      end Number_Waiting;
+
+      ------------
+      -- Length --
+      ------------
+
+      function Length return Natural is
+      begin
+         return The_Queue.Last;
+      end Length;
+
+      -----------
+      -- Clear --
+      -----------
+
+      procedure Clear is
+      begin
+         The_Queue.Free;
+         The_Queue.Init;
+      end Clear;
+   end The_Protected_Queue;
+
+   -------------
+   -- Enqueue --
+   -------------
+
+   procedure Enqueue (Element : Element_Type) is
+   begin
+      The_Protected_Queue.Enqueue (Element);
+   end Enqueue;
+
+   -------------
+   -- Dequeue --
+   -------------
+
+   function Dequeue return Element_Type is
+      Result : Element_Type;
+   begin
+      The_Protected_Queue.Dequeue (Result);
+      return Result;
+   end Dequeue;
+
+   ------------
+   -- Length --
+   ------------
+
+   function Length return Natural is
+   begin
+      return The_Protected_Queue.Length;
+   end Length;
+
+   -----------
+   -- Clear --
+   -----------
+
+   procedure Clear is
+   begin
+      The_Protected_Queue.Clear;
+   end Clear;
+
+   --------------------
+   -- Number_Waiting --
+   --------------------
+
+   function Number_Waiting return Natural is
+   begin
+      return The_Protected_Queue.Number_Waiting;
+   end Number_Waiting;
+
+end Protected_Queue;


Property changes on: trunk/src/protected_queue.adb
___________________________________________________________________
Name: svn:keywords
   + Id
Name: svn:eol-style
   + native

Added: trunk/src/protected_queue.ads
===================================================================
--- trunk/src/protected_queue.ads	                        (rev 0)
+++ trunk/src/protected_queue.ads	2006-11-25 17:18:47 UTC (rev 8)
@@ -0,0 +1,36 @@
+--  $Id$
+--  Copyright (C) 2006 Bechir Zalila <bec...@en...>
+--  See COPYING file for license
+
+--  This generic package implements a protected queue. It has to be
+--  instantiated with the queue element type and a maximal length of
+--  the queue. Each instantiation of the package creates one single
+--  queue.
+
+generic
+   type Element_Type is private;
+
+   Max_Length : Natural := 100;
+package Protected_Queue is
+   --  All the routines below are concurrency safe
+
+   procedure Enqueue (Element : Element_Type);
+   --  Put an element at the end of the queue. If the queue is full,
+   --  block until a place is freed.
+
+   function Dequeue return Element_Type;
+   --  Return the first element of the queue and remove it from the
+   --  head of the queue. If the queue is empty, bolock until an
+   --  element is put.
+
+   function Length return Natural;
+   --  Return the number of elements present in the queue
+
+   procedure Clear;
+   --  Delete all the elements of the queue
+
+   function Number_Waiting return Natural;
+   --  Return the number of tasks waiting on the queue entries
+   --  (enqueuing and dequeuing).
+
+end Protected_Queue;


Property changes on: trunk/src/protected_queue.ads
___________________________________________________________________
Name: svn:keywords
   + Id
Name: svn:eol-style
   + native


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.