[Gtkada-wrapper-devel] SF.net SVN: gtkada-wrapper: [6] trunk/src
Brought to you by:
bechir_zalila
Menu
▾
▴
[Gtkada-wrapper-devel] SF.net SVN: gtkada-wrapper: [6] trunk/src
|
From: <bec...@us...> - 2006-11-25 01:58:11
|
Revision: 6
http://svn.sourceforge.net/gtkada-wrapper/?rev=6&view=rev
Author: bechir_zalila
Date: 2006-11-24 17:58:11 -0800 (Fri, 24 Nov 2006)
Log Message:
-----------
* Now the stub compiles. Added athe action a dn command types that
list the possible user commands.
Modified Paths:
--------------
trunk/src/Makefile.am
trunk/src/gtkada_wrapper.adb
trunk/src/gtkada_wrapper.ads
Added Paths:
-----------
trunk/src/libs/
trunk/src/objects/
Modified: trunk/src/Makefile.am
===================================================================
--- trunk/src/Makefile.am 2006-11-25 00:18:45 UTC (rev 5)
+++ trunk/src/Makefile.am 2006-11-25 01:58:11 UTC (rev 6)
@@ -14,6 +14,9 @@
all-local:
$(GNATMAKE) -P $(PROJECT_FILE) $(GNATFLAGS)
+clean-local:
+ $(GNATCLEAN) -P $(PROJECT_FILE) $(GNATFLAGS)
+
install-data-local:
$(INSTALL) -d $(DESTDIR)$(headers_dir)
$(INSTALL) -d $(DESTDIR)$(ali_dir)
@@ -25,4 +28,4 @@
done
for f in $(srcdir)/libs/lib*; do \
$(INSTALL) -m 444 $$f $(DESTDIR)$(libdir); \
- done
\ No newline at end of file
+ done
Modified: trunk/src/gtkada_wrapper.adb
===================================================================
--- trunk/src/gtkada_wrapper.adb 2006-11-25 00:18:45 UTC (rev 5)
+++ trunk/src/gtkada_wrapper.adb 2006-11-25 01:58:11 UTC (rev 6)
@@ -1,24 +1,156 @@
+with Unchecked_Deallocation;
+
package body Gtkada_Wrapper is
- -----------------------
- -- Clear_Main_Window --
- -----------------------
+ -- The actions the user can do
- procedure Clear_Main_Window is
+ type Action_Kind is
+ (A_None,
+ A_Clear_Drawing_Area,
+ A_Line_Color,
+ A_Fill_Color,
+ A_Thickness,
+ A_Angle,
+ A_Rotate,
+ A_Jump_With_Length,
+ A_Jump_With_End,
+ A_Line_With_Length,
+ A_Line_With_End,
+ A_Line_With_Start_Length,
+ A_Line_With_Start_End,
+ A_Spot,
+ A_Image,
+ A_Text,
+ A_Rafresh,
+ A_Get_Mouse_Pointer,
+ A_Clear_Text_Area,
+ A_Put_String,
+ A_Put_Character,
+ A_New_Line,
+ A_Put_Line_String,
+ A_Put_Line_Character,
+ A_Get_String,
+ A_Get_Line_String,
+ A_Get_Immediate_Character);
+
+ type String_Ptr is access all String;
+ procedure Free is new Unchecked_Deallocation (String, String_Ptr);
+ pragma Unreferenced (Free);
+
+ -- The command data
+
+ type Command (Action : Action_Kind) is record
+ case Action is
+ when A_None
+ | A_Clear_Drawing_Area
+ | A_Rafresh
+ | A_Clear_Text_Area
+ | A_Get_String
+ | A_Get_Line_String
+ | A_Get_Immediate_Character =>
+ null;
+
+ when A_Line_Color | A_Fill_Color =>
+ Color : Color_Type;
+
+ when A_Thickness =>
+ Thickness : Float;
+
+ when A_Angle | A_Rotate =>
+ Angle : Float;
+
+ when A_Jump_With_End
+ | A_Line_With_End
+ | A_Line_With_Start_End
+ | A_Jump_With_Length
+ | A_Line_With_Length
+ | A_Line_With_Start_Length =>
+
+ X_Start : Float;
+ Y_Start : Float;
+
+ case Action is
+ when A_Jump_With_End
+ | A_Line_With_End
+ | A_Line_With_Start_End =>
+ X_End : Float;
+ Y_End : Float;
+
+ when A_Jump_With_Length
+ | A_Line_With_Length
+ | A_Line_With_Start_Length =>
+ Distance : Float;
+
+ when others =>
+ null;
+ end case;
+
+ when A_Spot =>
+ Diameter : Float;
+
+ when A_Image | A_Text =>
+ X_Justify : X_Justification_Type;
+ Y_Justify : Y_Justification_Type;
+
+ case Action is
+ when A_Image =>
+ File_Name : String_Ptr;
+ Scale : Float;
+
+ when A_Text =>
+ Text : String_Ptr;
+ Size : Float;
+
+ when others =>
+ null;
+ end case;
+
+ when A_Get_Mouse_Pointer =>
+ X : Float;
+ Y : Float;
+ Button : Natural;
+
+ when A_New_Line =>
+ N_Lines : Positive;
+
+ when A_Put_String | A_Put_Line_String =>
+ Str : String_Ptr;
+
+ when A_Put_Character | A_Put_Line_Character =>
+ Char : Character;
+ end case;
+ end record;
+ pragma Unreferenced (Command);
+
+ ------------------------
+ -- Clear_Drawing_Area --
+ ------------------------
+
+ procedure Clear_Drawing_Area is
begin
null;
- end Clear_Main_Window;
+ end Clear_Drawing_Area;
+ ---------------------
+ -- Clear_Text_Area --
+ ---------------------
+
+ procedure Clear_Text_Area is
+ begin
+ null;
+ end Clear_Text_Area;
+
------------------------
-- Create_Main_Window --
------------------------
procedure Create_Main_Window
- (X_Max : Float := 512.0;
- Y_Max : Float := 512.0;
- Text_Area : Boolean := False;
+ (X_Max : Float := 512.0;
+ Y_Max : Float := 512.0;
+ Text_Area : Boolean := False;
Drawing_Area : Boolean := True)
is
+ pragma Unreferenced (X_Max, Y_Max, Text_Area, Drawing_Area);
begin
null;
end Create_Main_Window;
@@ -38,7 +170,7 @@
function Get return String is
begin
- return Get;
+ return "";
end Get;
---------------
@@ -47,7 +179,7 @@
function Get_Angle return Float is
begin
- return Get_Angle;
+ return 0.0;
end Get_Angle;
--------------------
@@ -56,7 +188,7 @@
function Get_Fill_Color return Color_Type is
begin
- return Get_Fill_Color;
+ return Black;
end Get_Fill_Color;
-------------------
@@ -64,6 +196,7 @@
-------------------
procedure Get_Immediate (Item : out Character) is
+ pragma Unreferenced (Item);
begin
null;
end Get_Immediate;
@@ -74,7 +207,7 @@
function Get_Line return String is
begin
- return Get_Line;
+ return "";
end Get_Line;
--------------------
@@ -83,7 +216,7 @@
function Get_Line_Color return Color_Type is
begin
- return Get_Line_Color;
+ return Black;
end Get_Line_Color;
-----------------------
@@ -95,6 +228,7 @@
Y : out Float;
Button : out Natural)
is
+ pragma Unreferenced (X, Y, Button);
begin
null;
end Get_Mouse_Pointer;
@@ -104,6 +238,7 @@
------------------
procedure Get_Position (X : out Float; Y : out Float) is
+ pragma Unreferenced (X, Y);
begin
null;
end Get_Position;
@@ -114,7 +249,7 @@
function Get_Thickness return Float is
begin
- return Get_Thickness;
+ return 0.0;
end Get_Thickness;
------------------
@@ -127,6 +262,7 @@
X_Justification : X_Justification_Type := Center;
Y_Justification : Y_Justification_Type := Center)
is
+ pragma Unreferenced (File_Name, Scale, X_Justification, Y_Justification);
begin
null;
end Insert_Image;
@@ -141,6 +277,7 @@
X_Justification : X_Justification_Type := Center;
Y_Justification : Y_Justification_Type := Center)
is
+ pragma Unreferenced (Text, Size, X_Justification, Y_Justification);
begin
null;
end Insert_Text;
@@ -150,6 +287,7 @@
----------
procedure Jump (Distance : Float) is
+ pragma Unreferenced (Distance);
begin
null;
end Jump;
@@ -159,6 +297,7 @@
----------
procedure Jump (X : Float; Y : Float) is
+ pragma Unreferenced (X, Y);
begin
null;
end Jump;
@@ -168,6 +307,7 @@
----------
procedure Line (Distance : Float) is
+ pragma Unreferenced (Distance);
begin
null;
end Line;
@@ -177,6 +317,7 @@
----------
procedure Line (X : Float; Y : Float) is
+ pragma Unreferenced (X, Y);
begin
null;
end Line;
@@ -190,6 +331,7 @@
Y_Start : Float;
Distance : Float)
is
+ pragma Unreferenced (X_Start, Y_Start, Distance);
begin
null;
end Line;
@@ -204,6 +346,7 @@
X_End : Float;
Y_End : Float)
is
+ pragma Unreferenced (X_Start, Y_Start, X_End, Y_End);
begin
null;
end Line;
@@ -213,6 +356,7 @@
--------------
procedure New_Line (Spacing : Positive := 1) is
+ pragma Unreferenced (Spacing);
begin
null;
end New_Line;
@@ -222,6 +366,7 @@
---------
procedure Put (Item : String) is
+ pragma Unreferenced (Item);
begin
null;
end Put;
@@ -231,6 +376,7 @@
---------
procedure Put (Item : Character) is
+ pragma Unreferenced (Item);
begin
null;
end Put;
@@ -240,6 +386,7 @@
--------------
procedure Put_Line (Item : String) is
+ pragma Unreferenced (Item);
begin
null;
end Put_Line;
@@ -249,6 +396,7 @@
--------------
procedure Put_Line (Item : Character) is
+ pragma Unreferenced (Item);
begin
null;
end Put_Line;
@@ -268,7 +416,9 @@
function RGB (R : Integer; G : Integer; B : Integer) return Color_Type is
begin
- return RGB (R, G, B);
+ return Color_Type'(R => Single_Color (R mod 256),
+ G => Single_Color (G mod 256),
+ B => Single_Color (B mod 256));
end RGB;
------------
@@ -276,6 +426,7 @@
------------
procedure Rotate (Angle : Float) is
+ pragma Unreferenced (Angle);
begin
null;
end Rotate;
@@ -285,6 +436,7 @@
---------------
procedure Set_Angle (Angle : Float) is
+ pragma Unreferenced (Angle);
begin
null;
end Set_Angle;
@@ -294,6 +446,7 @@
--------------------
procedure Set_Fill_Color (C : Color_Type) is
+ pragma Unreferenced (C);
begin
null;
end Set_Fill_Color;
@@ -303,6 +456,7 @@
--------------------
procedure Set_Line_Color (C : Color_Type) is
+ pragma Unreferenced (C);
begin
null;
end Set_Line_Color;
@@ -312,6 +466,7 @@
------------------
procedure Set_Position (X : Float; Y : Float) is
+ pragma Unreferenced (X, Y);
begin
null;
end Set_Position;
@@ -321,6 +476,7 @@
-------------------
procedure Set_Thickness (T : Float) is
+ pragma Unreferenced (T);
begin
null;
end Set_Thickness;
@@ -330,6 +486,7 @@
----------
procedure Spot (Radius : Float := 4.0) is
+ pragma Unreferenced (Radius);
begin
null;
end Spot;
Modified: trunk/src/gtkada_wrapper.ads
===================================================================
--- trunk/src/gtkada_wrapper.ads 2006-11-25 00:18:45 UTC (rev 5)
+++ trunk/src/gtkada_wrapper.ads 2006-11-25 01:58:11 UTC (rev 6)
@@ -12,9 +12,9 @@
package Gtkada_Wrapper is
procedure Create_Main_Window
- (X_Max : Float := 512.0;
- Y_Max : Float := 512.0;
- Text_Area : Boolean := False;
+ (X_Max : Float := 512.0;
+ Y_Max : Float := 512.0;
+ Text_Area : Boolean := False;
Drawing_Area : Boolean := True);
-- Creates the main window of the application. X_Max and Y_Max
-- represent respectively the width and the height of each one of
@@ -23,11 +23,6 @@
-- parts. Note that at least one of these two flags has to be set
-- to true.
- procedure Clear_Main_Window;
- -- Clear the main window. If the drwing area exists, then it will
- -- be ``blanked''. If the text area exist then all text will be
- -- erased.
-
procedure Destroy_Main_Window;
-- Close and destroy the main window
@@ -72,6 +67,9 @@
White : constant Color_Type;
-- Predefined colors
+ procedure Clear_Drawing_Area;
+ -- If the drwing area exists, then it will be ``blanked''
+
procedure Set_Line_Color (C : Color_Type);
-- Set the line color of the virtual brush to C
@@ -183,6 +181,9 @@
-- Text Area Specific Routines --
---------------------------------
+ procedure Clear_Text_Area;
+ -- If the text area exist then all text will be erased.
+
procedure Put (Item : String);
-- Type the given text on the current cursor position of the text
-- area.
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
