SimClientGUI adjustments

gpr/common.gpr

@@ -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";

src/canvas/canvas.adb

@@ -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;

src/canvas/canvas.ads

@@ -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

src/gui/gui-combobox.adb

@@ -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;
    ---------------------------------------------------------------------------
 

src/gui/gui-combobox.ads

@@ -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;

src/gui/gui-edit.ads

@@ -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;

src/gui/gui-themes.ads

@@ -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

src/gui/gui.adb

@@ -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;

src/gui/themes/yellowblue/yellowblue-combobox.adb

@@ -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;

src/gui/themes/yellowblue/yellowblue-edit.adb

@@ -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

src/gui/themes/yellowblue/yellowblue-groupbox.adb

@@ -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

src/gui/themes/yellowblue/yellowblue-listbox.adb

@@ -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;