Permalink
Browse files

SimClientGUI adjustments

  • Loading branch information...
1 parent 312d04a commit 4a6764beb7fd1964a7ed3bdca1ce43590f300497 AlexanderC2 committed May 5, 2012
View
@@ -28,7 +28,8 @@ abstract project Common is
Dir & "../src/simclientgui",
Dir & "../src/logging",
Dir & "../src/xlib",
- Dir & "../src/win32");
+ Dir & "../src/win32",
+ Dir & "../src/simconfig");
CompilerSwitches:=();
ObjectDirectory:=Dir & "../build";
View
@@ -165,8 +165,9 @@ package body Canvas is
Y : Integer;
Color : out Color_Type) is
begin
- if (X in Canvas.Image'Range(2))
- and (Y in Canvas.Image'Range(1)) then
+ if Canvas.Image/=null and then
+ ((X in Canvas.Image'Range(2))
+ and (Y in Canvas.Image'Range(1))) then
Color:=Canvas.Image(Y,X);
else
Color:=0;
@@ -181,8 +182,9 @@ package body Canvas is
Color : Color_Type) is
begin
- if (X in Canvas.Image'Range(2))
- and (Y in Canvas.Image'Range(1)) then
+ if Canvas.Image/=null and then
+ ((X in Canvas.Image'Range(2))
+ and (Y in Canvas.Image'Range(1))) then
Canvas.Image(Y,X):=Color;
end if;
@@ -214,7 +216,7 @@ package body Canvas is
Intery : Float;
XPXL2 : Integer;
YPXL2 : Integer;
- Order : Boolean:=True;
+ Order : Boolean:=False;
procedure SPixel
(X : Integer;
@@ -264,7 +266,7 @@ package body Canvas is
Swap(XPos1,YPos1);
Swap(XPos2,YPos2);
Swap(DeltaX,DeltaY);
- Order:=False;
+ Order:=True;
end if;
if XPos2<XPos1 then
Swap(XPos1,XPos2);
@@ -436,7 +438,8 @@ package body Canvas is
DrawY : Integer;
begin
- if (X<0)
+ if (Canvas.Image=null)
+ or (X<0)
or (X>=Canvas.ContentWidth) then
return;
end if;
View
@@ -41,6 +41,7 @@ package Canvas is
ContentHeight : Integer;
ContentWidth : Integer;
end record;
+ type Canvas_Access is access all Canvas_Type;
type Canvas_ClassAccess is access all Canvas_Type'Class;
procedure Initialize
View
@@ -18,7 +18,7 @@
-------------------------------------------------------------------------------
pragma Ada_2005;
-with Ada.Text_IO; use Ada.Text_IO;
+--with Ada.Text_IO; use Ada.Text_IO;
package body GUI.Combobox is
@@ -56,9 +56,12 @@ package body GUI.Combobox is
if Index not in -1..Integer(Item.Choices.Length) then
raise IndexOutOfRange;
end if;
- Put("SetIndex");
- New_Line;
- Item.Index:=Index;
+ if Index/=Item.Index then
+ Item.Index:=Index;
+ if Item.OnSelect/=null then
+ Item.OnSelect(Item.CallBackObject);
+ end if;
+ end if;
end SetIndex;
---------------------------------------------------------------------------
View
@@ -31,65 +31,74 @@ with Canvas;
with GUI.Basics; use GUI.Basics;
-package GUI.Combobox is
+package GUI.ComboBox is
IndexOutOfRange : Exception;
- type Combobox_Type is new Object_Type with private;
- type Combobox_Access is access all Combobox_Type;
- type Combobox_ClassAccess is access all Combobox_Type'Class;
+ type OnSelect_Access is
+ access procedure
+ (CallBackObject : AnyObject_ClassAccess);
+
+ type ComboBox_Public is new Object_Type with
+ record
+ OnSelect : OnSelect_Access:=null;
+ end record;
+
+ type ComboBox_Type is new ComboBox_Public with private;
+ type ComboBox_Access is access all Combobox_Type;
+ type ComboBox_ClassAccess is access all Combobox_Type'Class;
overriding
procedure Free
- (Item : access Combobox_Type);
+ (Item : access ComboBox_Type);
overriding
procedure Initialize
- (Item : access Combobox_Type;
+ (Item : access ComboBox_Type;
Parent : Object_ClassAccess);
procedure SetIndex
- (Item : access Combobox_Type;
+ (Item : access ComboBox_Type;
Index : Integer);
function GetIndex
- (Item : access Combobox_Type)
+ (Item : access ComboBox_Type)
return Integer;
procedure AddEntry
- (Item : access Combobox_Type;
+ (Item : access ComboBox_Type;
String : Unbounded_String;
Color : Canvas.Color_Type);
function GetSelectedEntryString
- (Item : access Combobox_Type)
+ (Item : access ComboBox_Type)
return Unbounded_String;
procedure GetSelectedEntry
- (Item : access Combobox_Type;
+ (Item : access ComboBox_Type;
String : out Unbounded_String;
Color : out Canvas.Color_Type);
function GetEntries
- (Item : access Combobox_Type)
+ (Item : access ComboBox_Type)
return GUI.Basics.StringAndColorList_Pack.List;
function GetEntryCount
(Item : access ComboBox_Type)
return Integer;
---------------------------------------------------------------------------
- type Combobox_Constructor is
+ type ComboBox_Constructor is
access function
(Parent : GUI.Object_ClassAccess)
return Combobox_ClassAccess;
private
- type Combobox_Type is new Object_Type with
+ type ComboBox_Type is new ComboBox_Public with
record
Choices : GUI.Basics.StringAndColorList_Pack.List;
Index : Integer;
end record;
-end GUI.Combobox;
+end GUI.ComboBox;
View
@@ -33,4 +33,8 @@ package GUI.Edit is
(Parent : Object_ClassAccess)
return Edit_ClassAccess;
+ procedure SetText
+ (Item : access Edit_Type;
+ Text : Unbounded_String) is abstract;
+
end GUI.Edit;
View
@@ -34,6 +34,7 @@ with GUI.CheckBox;
with GUI.RadioButton;
with GUI.Edit;
with GUI.GroupBox;
+with GUI.Label;
package GUI.Themes is
@@ -51,6 +52,7 @@ package GUI.Themes is
NewRadioButton : GUI.RadioButton.RadioButton_Constructor := null;
NewEdit : GUI.Edit.Edit_Constructor := null;
NewGroupBox : GUI.GroupBox.GroupBox_Constructor := null;
+ NewLabel : GUI.Label.Label_Constructor := null;
end record;
package Implementations is new Config.Implementations
View
@@ -946,6 +946,8 @@ package body GUI is
Canvas.Object.Canvasse:=Canvas.Next;
end if;
+ Standard.Canvas.Canvas_Access(Canvas).Finalize;
+
end Finalize;
---------------------------------------------------------------------------
@@ -991,6 +993,9 @@ package body GUI is
-- TODO: This is not enough, there can be referenced through containers
-- be left which MUST be removed too
+ Put("Free Object:");
+ Put(Item.all'Address);
+ New_Line;
if Item.Context.Priv.FocusObject=Object_ClassAccess(Item) then
ClearFocusTree(Object_ClassAccess(Item));
end if;
@@ -1013,7 +1018,7 @@ package body GUI is
end loop;
end;
- -- Free all Canvasse
+ -- Free all Canvases
declare
Canvas : Canvas_ClassAccess;
NextCanvas : Canvas_ClassAccess;
@@ -1022,7 +1027,7 @@ package body GUI is
while Canvas/=null loop
NextCanvas:=Canvas.Next;
- Free(Canvas);
+ FreeCanvas(Canvas);
Canvas:=NextCanvas;
end loop;
end;
@@ -79,6 +79,7 @@ package body YellowBlue.Combobox is
use type Fonts.Font_ClassAccess;
begin
+
if Item.Font/=null then
Fonts.Release(Item.Font);
end if;
@@ -323,8 +324,6 @@ package body YellowBlue.Combobox is
(Item : access Combobox_Type;
Index : Integer) is
begin
- Put("Set Index of Combobox");
- New_Line;
GUI.Combobox.Combobox_Access(Item).SetIndex(Index);
DrawCanvas(Item);
end SetIndex;
@@ -29,7 +29,7 @@ with GUIMouse; use GUIMouse;
with GUIKeys; use GUIKeys;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
-with Ada.Text_IO; use Ada.Text_IO;
+--with Ada.Text_IO; use Ada.Text_IO;
package body YellowBlue.Edit is
@@ -74,6 +74,15 @@ package body YellowBlue.Edit is
X : Integer;
Y : Integer)
return Boolean;
+
+ overriding
+ procedure SetText
+ (Item : access Edit_Type;
+ Text : Unbounded_String);
+
+ overriding
+ procedure Free
+ (Item : access Edit_Type);
---------------------------------------------------------------------------
procedure DrawCanvases
@@ -114,6 +123,15 @@ package body YellowBlue.Edit is
end DrawCanvases;
---------------------------------------------------------------------------
+ procedure Free
+ (Item : access Edit_Type) is
+ begin
+ Item.Text.Clear;
+ Fonts.Release(Item.Font);
+ GUI.Edit.Edit_Access(Item).Free;
+ end Free;
+ ---------------------------------------------------------------------------
+
function MouseDown
(Item : access Edit_Type;
Button : MouseButton_Enum;
@@ -190,7 +208,6 @@ package body YellowBlue.Edit is
Chars : Unbounded_String)
return Boolean is
begin
- Put("Token");
Item.CursorPosition:=Item.CursorPosition
+Item.Text.Insert
(Position => Item.CursorPosition,
@@ -209,6 +226,20 @@ package body YellowBlue.Edit is
end Resize;
---------------------------------------------------------------------------
+ procedure SetText
+ (Item : access Edit_Type;
+ Text : Unbounded_String) is
+ begin
+ Item.Text.Initialize
+ (String => Text,
+ Color => TextColor,
+ Font => Item.Font);
+ Item.CursorPosition:=1;
+ MakeCursorVisible(Item);
+ DrawCanvases(Item);
+ end SetText;
+ ---------------------------------------------------------------------------
+
function NewEdit
(Parent : GUI.Object_ClassAccess)
return GUI.Edit.Edit_ClassAccess is
@@ -224,7 +255,7 @@ package body YellowBlue.Edit is
Size => 18,
Attributes => Fonts.NoAttributes);
NewEdit.Text.Initialize
- (String => U("Test"),
+ (String => U(""),
Color => TextColor,
Font => NewEdit.Font);
NewEdit.CursorCanvas:=NewEdit.NewCanvas
@@ -53,6 +53,17 @@ package body YellowBlue.GroupBox is
(Item : access GroupBox_Type;
Caption : Unbounded_String);
+ overriding
+ procedure Free
+ (Item : access GroupBox_Type);
+ ---------------------------------------------------------------------------
+
+ procedure Free
+ (Item : access GroupBox_Type) is
+ begin
+ Fonts.Release(Item.Font);
+ GUI.GroupBox.GroupBox_Access(Item).Free;
+ end Free;
---------------------------------------------------------------------------
procedure SetAllBounds
@@ -35,6 +35,7 @@ package body YellowBlue.ListBox is
FrameColor : constant Canvas.Color_Type:=16#FFFFFF00#;
FrameWidth : constant Integer:=1;
BorderWidth : constant Integer:=2;
+ FillColor : constant Canvas.Color_Type:=16#FF0000FF#;
type ListBox_Type is new GUI.ListBox.ListBox_Type with
record
@@ -44,6 +45,7 @@ package body YellowBlue.ListBox is
LeftFrame : GUI.Canvas_ClassAccess:=null;
TopFrame : GUI.Canvas_ClassAccess:=null;
BottomFrame : GUI.Canvas_ClassAccess:=null;
+ FillCanvas : GUI.Canvas_ClassAccess:=null;
end record;
type ListBox_Access is access all ListBox_Type;
@@ -317,6 +319,22 @@ package body YellowBlue.ListBox is
NewListBox.VerticalScrollbar.CallBackObject:=AnyObject_ClassAccess(NewListBox);
NewListBox.VerticalScrollbar.OnPositionChange:=ScrollPositionChange'Access;
+ NewListBox.FillCanvas:=NewListBox.NewCanvas
+ (Height => 1,
+ Width => 1);
+ NewListBox.FillCanvas.Clear(FillColor);
+ NewListBox.FillCanvas.SetBounds
+ (Top => 0,
+ Left => 0,
+ Height => Bounds.Height,
+ Width => Bounds.Width-YellowBlue.VerticalScrollBar.VerticalScrollBarWidth,
+ Visible => True);
+ NewListBox.FillCanvas.SetAnchors
+ (Top => True,
+ Left => True,
+ Right => True,
+ Bottom => True);
+
return GUI.ListBox.ListBox_ClassAccess(NewListBox);
end NewListBox;
Oops, something went wrong.

0 comments on commit 4a6764b

Please sign in to comment.