[Gtkada-wrapper-devel] SF.net SVN: gtkada-wrapper: [9] trunk

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

Revision: 9
          http://svn.sourceforge.net/gtkada-wrapper/?rev=9&view=rev
Author:   bechir_zalila
Date:     2006-11-25 15:06:27 -0800 (Sat, 25 Nov 2006)

Log Message:
-----------
	* (gtkada_wrapper.ad?): Added the routines that create the main 
	windows (empty for now). Minor reformatting.
	* (examples/empty_windows): A very simple example that displays 
	an empty window.

Modified Paths:
--------------
    trunk/TODO
    trunk/examples/Makefile.am
    trunk/examples/empty_windows/Makefile.am
    trunk/src/gtkada_wrapper.adb
    trunk/src/gtkada_wrapper.ads

Added Paths:
-----------
    trunk/examples/Makefile.common
    trunk/examples/empty_windows/empty_window.adb
    trunk/examples/empty_windows/empty_window.gpr

Modified: trunk/TODO
===================================================================
--- trunk/TODO	2006-11-25 17:18:47 UTC (rev 8)
+++ trunk/TODO	2006-11-25 23:06:27 UTC (rev 9)
@@ -7,3 +7,6 @@
 /:
 	* Add a projects subdirectory that will contain the project
 	files that will be installed.
+
+/examples:
+	* Install examples
\ No newline at end of file

Modified: trunk/examples/Makefile.am
===================================================================
--- trunk/examples/Makefile.am	2006-11-25 17:18:47 UTC (rev 8)
+++ trunk/examples/Makefile.am	2006-11-25 23:06:27 UTC (rev 9)
@@ -1 +1 @@
-SRCDIRS=empty_windows
\ No newline at end of file
+SUBDIRS = empty_windows

Added: trunk/examples/Makefile.common
===================================================================
--- trunk/examples/Makefile.common	                        (rev 0)
+++ trunk/examples/Makefile.common	2006-11-25 23:06:27 UTC (rev 9)
@@ -0,0 +1,8 @@
+EXTRA_DIST = $(SOURCES) $(PROJECT_FILE);
+
+all-local:
+	$(GNATMAKE) -P $(PROJECT_FILE) $(GNATFLAGS)
+
+clean-local:
+	$(GNATCLEAN) -P $(PROJECT_FILE) $(GNATFLAGS)
+

Modified: trunk/examples/empty_windows/Makefile.am
===================================================================
--- trunk/examples/empty_windows/Makefile.am	2006-11-25 17:18:47 UTC (rev 8)
+++ trunk/examples/empty_windows/Makefile.am	2006-11-25 23:06:27 UTC (rev 9)
@@ -0,0 +1,5 @@
+include ../Makefile.common
+
+PROJECT_FILE = $(srcdir)/empty_window.gpr
+SOURCES = $(srcdir)/empty_window.adb
+

Added: trunk/examples/empty_windows/empty_window.adb
===================================================================
--- trunk/examples/empty_windows/empty_window.adb	                        (rev 0)
+++ trunk/examples/empty_windows/empty_window.adb	2006-11-25 23:06:27 UTC (rev 9)
@@ -0,0 +1,14 @@
+--  $Id$
+--  Copyright (C) 2006 Bechir Zalila <bec...@en...>
+--  See COPYING file for license
+
+--  This example, creates an empty default main window then exits
+
+with GTKAda_Wrapper; use GTKAda_Wrapper;
+
+procedure Empty_Window is
+begin
+   Create_Main_Window;
+
+   delay 5.0;
+end Empty_Window;


Property changes on: trunk/examples/empty_windows/empty_window.adb
___________________________________________________________________
Name: svn:keywords
   + Id
Name: svn:eol-style
   + native

Added: trunk/examples/empty_windows/empty_window.gpr
===================================================================
--- trunk/examples/empty_windows/empty_window.gpr	                        (rev 0)
+++ trunk/examples/empty_windows/empty_window.gpr	2006-11-25 23:06:27 UTC (rev 9)
@@ -0,0 +1,5 @@
+with "../../src/gtkada_wrapper.gpr";
+
+project Empty_Window is
+   for main use ("empty_window.adb");
+end Empty_Window;


Property changes on: trunk/examples/empty_windows/empty_window.gpr
___________________________________________________________________
Name: svn:keywords
   + Id
Name: svn:eol-style
   + native

Modified: trunk/src/gtkada_wrapper.adb
===================================================================
--- trunk/src/gtkada_wrapper.adb	2006-11-25 17:18:47 UTC (rev 8)
+++ trunk/src/gtkada_wrapper.adb	2006-11-25 23:06:27 UTC (rev 9)
@@ -4,12 +4,73 @@
 
 with Unchecked_Deallocation;
 
+with Glib;             use Glib;
+
+--  with Gdk.Window;       use Gdk.Window;
+
 with Gdk.Types;        use Gdk.Types;
+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 Protected_Queue;
 
 package body Gtkada_Wrapper is
 
+   procedure Quit (Window : access Gtk.Window.Gtk_Window_Record'Class);
+   --  Quit the main loop when the user closes the window
+
+   procedure Assert_Main_Window_Exits;
+   --  Raises an error if the Main windows does not exist
+
+   ----------------------
+   -- Global Variables --
+   ----------------------
+
+   Window : Gtk_Window;
+   --  The main window of the application
+
+   Width  : Gint;
+   Height : Gint;
+   --  Dimensions of the drawing and text areas
+
+   Brush_X : Float := 0.0;
+   Brush_Y : Float := 0.0;
+   Angle   : Float := 0.0;
+   --  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
+
+   HPaned : Gtk_Hpaned;
+   --  The container of the window components (the drawing area and
+   --  the text area).
+
+   --  User_Task : Task_Id := Null_Task_ID; -- Task that sets up world.
+   --  Pixmap : Gdk_Pixmap;           -- Pixmap used as backing store.
+   --  Pausing : Boolean := False;
+   --  Drawing_Area : Gtk_Drawing_Area;
+   --  Console : Interactive_Console;
+   --  Idle_Function_Id : Idle_Handler_Id;
+   --  Pause_Timeout_Function_Id : Timeout_Handler_Id;
+   --  Draw_Timeout_Function_Id : Timeout_Handler_Id;
+   --  Width, Height : Gint;
+   --  Gc : Gdk_Gc;
+
+   --------------
+   -- Handlers --
+   --------------
+
+   package Destroyed is new Gtk.Handlers.Callback
+     (Widget_Type => Gtk_Window_Record);
+
    --  The actions the user can do
 
    type Action_Kind is
@@ -130,7 +191,6 @@
    --  The user command queue
 
    package Command_Queue is new Protected_Queue (Command, 10000);
-   pragma Unreferenced (Command_Queue);
 
    --  The response kind
 
@@ -165,13 +225,78 @@
    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.
+
+   --  The main windows task type
+
+   task type Main_Window_Type;
+   type Main_Window_Access is access all Main_Window_Type;
+
+   --  The Main windows
+
+   Main_Window : Main_Window_Access;
+
+   ----------------------
+   -- Main_Window_Type --
+   ----------------------
+
+   task body Main_Window_Type is
+   begin
+      --  Initialize GTK
+
+      Gtk.Main.Init;
+
+      --  Setup the main windows
+
+      Gtk_New (Window, Window_Toplevel);
+      Set_Title (Window, "GTKAda Wrapper");
+      Set_Border_Width (Window, Border_Width => 5);
+
+      --  When the window is destroyed, some work has to be done
+
+      Destroyed.Connect (Window,
+                         "destroy",
+                         Destroyed.To_Marshaller (Quit'Access));
+
+      --  Create the immediate window vertical box and adding it to
+      --  the windows
+
+      Gtk_New_Vbox (VBox, Homogeneous => False, Spacing => 0);
+      Add (Window, VBox);
+
+      --  Create the horizontal paned and adding it to the box
+
+      Gtk_New_Hpaned (HPaned);
+      Pack_Start (VBox, HPaned);
+
+      --  FIXME: Create the drawing area and the text area
+
+      Show_All (Window);
+      Gtk.Main.Main;
+
+      --  FIXME: Handle exit
+
+   end Main_Window_Type;
+
+   ------------------------------
+   -- Assert_Main_Window_Exits --
+   ------------------------------
+
+   procedure Assert_Main_Window_Exits is
+   begin
+      if Main_Window = null then
+         raise Lost_Main_Windows with "The main window does not exist";
+      end if;
+   end Assert_Main_Window_Exits;
+
    ------------------------
    -- Clear_Drawing_Area --
    ------------------------
 
    procedure Clear_Drawing_Area is
    begin
-      null;
+      Assert_Main_Window_Exits;
    end Clear_Drawing_Area;
 
    ---------------------
@@ -180,7 +305,7 @@
 
    procedure Clear_Text_Area is
    begin
-      null;
+      Assert_Main_Window_Exits;
    end Clear_Text_Area;
 
    ------------------------
@@ -193,9 +318,19 @@
       Text_Area    : Boolean := False;
       Drawing_Area : Boolean := True)
    is
-      pragma Unreferenced (X_Max, Y_Max, Text_Area, Drawing_Area);
+      pragma Unreferenced (Text_Area, Drawing_Area);
    begin
-      null;
+      if Main_Window /= null then
+         raise Program_Error with "The main windows already exists";
+      end if;
+
+      Width  := Gint (X_Max);
+      Height := Gint (Y_Max);
+
+      Brush_X := Float (Width) / 2.0;
+      Brush_Y := Float (Height) / 2.0;
+
+      Main_Window := new Main_Window_Type;
    end Create_Main_Window;
 
    -------------------------
@@ -204,7 +339,8 @@
 
    procedure Destroy_Main_Window is
    begin
-      null;
+      Assert_Main_Window_Exits;
+      Command_Queue.Enqueue (Command'(Action => A_Destroy));
    end Destroy_Main_Window;
 
    ---------
@@ -213,6 +349,7 @@
 
    function Get return String is
    begin
+      Assert_Main_Window_Exits;
       return "";
    end Get;
 
@@ -222,6 +359,7 @@
 
    function Get_Angle return Float is
    begin
+      Assert_Main_Window_Exits;
       return 0.0;
    end Get_Angle;
 
@@ -231,6 +369,7 @@
 
    function Get_Fill_Color return Color_Type is
    begin
+      Assert_Main_Window_Exits;
       return Black;
    end Get_Fill_Color;
 
@@ -241,7 +380,7 @@
    procedure Get_Immediate (Item : out Character) is
       pragma Unreferenced (Item);
    begin
-      null;
+      Assert_Main_Window_Exits;
    end Get_Immediate;
 
    --------------
@@ -250,6 +389,7 @@
 
    function Get_Line return String is
    begin
+      Assert_Main_Window_Exits;
       return "";
    end Get_Line;
 
@@ -259,6 +399,7 @@
 
    function Get_Line_Color return Color_Type is
    begin
+      Assert_Main_Window_Exits;
       return Black;
    end Get_Line_Color;
 
@@ -273,7 +414,7 @@
    is
       pragma Unreferenced (X, Y, Button);
    begin
-      null;
+      Assert_Main_Window_Exits;
    end Get_Mouse_Pointer;
 
    ------------------
@@ -283,7 +424,7 @@
    procedure Get_Position (X : out Float; Y : out Float) is
       pragma Unreferenced (X, Y);
    begin
-      null;
+      Assert_Main_Window_Exits;
    end Get_Position;
 
    -------------------
@@ -292,6 +433,7 @@
 
    function Get_Thickness return Float is
    begin
+      Assert_Main_Window_Exits;
       return 0.0;
    end Get_Thickness;
 
@@ -307,7 +449,7 @@
    is
       pragma Unreferenced (File_Name, Scale, X_Justification, Y_Justification);
    begin
-      null;
+      Assert_Main_Window_Exits;
    end Insert_Image;
 
    -----------------
@@ -322,7 +464,7 @@
    is
       pragma Unreferenced (Text, Size, X_Justification, Y_Justification);
    begin
-      null;
+      Assert_Main_Window_Exits;
    end Insert_Text;
 
    ----------
@@ -332,7 +474,7 @@
    procedure Jump (Distance : Float) is
       pragma Unreferenced (Distance);
    begin
-      null;
+      Assert_Main_Window_Exits;
    end Jump;
 
    ----------
@@ -342,7 +484,7 @@
    procedure Jump (X : Float; Y : Float) is
       pragma Unreferenced (X, Y);
    begin
-      null;
+      Assert_Main_Window_Exits;
    end Jump;
 
    ----------
@@ -352,7 +494,7 @@
    procedure Line (Distance : Float) is
       pragma Unreferenced (Distance);
    begin
-      null;
+      Assert_Main_Window_Exits;
    end Line;
 
    ----------
@@ -362,7 +504,7 @@
    procedure Line (X : Float; Y : Float) is
       pragma Unreferenced (X, Y);
    begin
-      null;
+      Assert_Main_Window_Exits;
    end Line;
 
    ----------
@@ -376,7 +518,7 @@
    is
       pragma Unreferenced (X_Start, Y_Start, Distance);
    begin
-      null;
+      Assert_Main_Window_Exits;
    end Line;
 
    ----------
@@ -391,7 +533,7 @@
    is
       pragma Unreferenced (X_Start, Y_Start, X_End, Y_End);
    begin
-      null;
+      Assert_Main_Window_Exits;
    end Line;
 
    --------------
@@ -401,7 +543,7 @@
    procedure New_Line (Spacing : Positive := 1) is
       pragma Unreferenced (Spacing);
    begin
-      null;
+      Assert_Main_Window_Exits;
    end New_Line;
 
    ---------
@@ -411,7 +553,7 @@
    procedure Put (Item : String) is
       pragma Unreferenced (Item);
    begin
-      null;
+      Assert_Main_Window_Exits;
    end Put;
 
    ---------
@@ -421,7 +563,7 @@
    procedure Put (Item : Character) is
       pragma Unreferenced (Item);
    begin
-      null;
+      Assert_Main_Window_Exits;
    end Put;
 
    --------------
@@ -431,7 +573,7 @@
    procedure Put_Line (Item : String) is
       pragma Unreferenced (Item);
    begin
-      null;
+      Assert_Main_Window_Exits;
    end Put_Line;
 
    --------------
@@ -441,16 +583,26 @@
    procedure Put_Line (Item : Character) is
       pragma Unreferenced (Item);
    begin
-      null;
+      Assert_Main_Window_Exits;
    end Put_Line;
 
+   ----------
+   -- Quit --
+   ----------
+
+   procedure Quit (Window : access Gtk.Window.Gtk_Window_Record'Class) is
+      pragma Unreferenced (Window);
+   begin
+      Gtk.Main.Main_Quit;
+   end Quit;
+
    -------------
    -- Rafresh --
    -------------
 
    procedure Rafresh is
    begin
-      null;
+      Assert_Main_Window_Exits;
    end Rafresh;
 
    ---------
@@ -471,7 +623,7 @@
    procedure Rotate (Angle : Float) is
       pragma Unreferenced (Angle);
    begin
-      null;
+      Assert_Main_Window_Exits;
    end Rotate;
 
    ---------------
@@ -481,7 +633,7 @@
    procedure Set_Angle (Angle : Float) is
       pragma Unreferenced (Angle);
    begin
-      null;
+      Assert_Main_Window_Exits;
    end Set_Angle;
 
    --------------------
@@ -491,7 +643,7 @@
    procedure Set_Fill_Color (C : Color_Type) is
       pragma Unreferenced (C);
    begin
-      null;
+      Assert_Main_Window_Exits;
    end Set_Fill_Color;
 
    --------------------
@@ -501,7 +653,7 @@
    procedure Set_Line_Color (C : Color_Type) is
       pragma Unreferenced (C);
    begin
-      null;
+      Assert_Main_Window_Exits;
    end Set_Line_Color;
 
    ------------------
@@ -511,7 +663,7 @@
    procedure Set_Position (X : Float; Y : Float) is
       pragma Unreferenced (X, Y);
    begin
-      null;
+      Assert_Main_Window_Exits;
    end Set_Position;
 
    -------------------
@@ -521,7 +673,7 @@
    procedure Set_Thickness (T : Float) is
       pragma Unreferenced (T);
    begin
-      null;
+      Assert_Main_Window_Exits;
    end Set_Thickness;
 
    ----------
@@ -531,7 +683,7 @@
    procedure Spot (Radius : Float := 4.0) is
       pragma Unreferenced (Radius);
    begin
-      null;
+      Assert_Main_Window_Exits;
    end Spot;
 
 end Gtkada_Wrapper;

Modified: trunk/src/gtkada_wrapper.ads
===================================================================
--- trunk/src/gtkada_wrapper.ads	2006-11-25 17:18:47 UTC (rev 8)
+++ trunk/src/gtkada_wrapper.ads	2006-11-25 23:06:27 UTC (rev 9)
@@ -12,6 +12,10 @@
 
 package Gtkada_Wrapper is
 
+   Lost_Main_Windows : exception;
+   --  This exception is raised if the user tries to manipulate the
+   --  windows before creating it or after destroying it.
+
    procedure Create_Main_Window
      (X_Max        : Float   := 512.0;
       Y_Max        : Float   := 512.0;


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