Changeset 36 for trunk/UCore.pas

Timestamp:

Jan 1, 2018, 8:57:03 PM (7 years ago)

Author:

chronos

Message:

• Added: Remember players configuration in XML config file between application runs.

File:

• trunk/UCore.pas (modified) (20 diffs)

trunk/UCore.pas

@@ -8 +8 @@
   Dialogs, Classes, SysUtils, Graphics, SpecializedMatrix, SpecializedList,
   IntfGraphics, FPImage, LCLType, SpecializedBitmap, GraphType, Math, URectangle,
-  Syncobjs, UThreading, Forms, DateUtils, UAudioSystem, UAudioSystemMPlayer;
+  Syncobjs, UThreading, Forms, DateUtils, UAudioSystem, UAudioSystemMPlayer,
+  XMLConf, DOM;
 
 const
@@ -63 +64 @@
     Image: TMatrixByte;
     Mask: TMatrixByte;
+    procedure Assign(Source: TTank);
     constructor Create;
     destructor Destroy; override;
+  end;
+
+  { TTanks }
+
+  TTanks = class(TListObject)
+    procedure Assign(Source: TTanks);
   end;
 
@@ -109 +117 @@
     Name: string;
     Keys: TPlayerKeys;
-    Tanks: TListObject; // TListObject<TTank>
+    Tanks: TTanks;
     Bullets: TListObject; // TListObject<TBullet>
     LastShootTime: TDateTime;
@@ -133 +141 @@
     destructor Destroy; override;
     procedure Assign(Source: TPlayer);
+    procedure LoadConfig(Config: TXMLConfig; Path: string);
+    procedure SaveConfig(Config: TXMLConfig; Path: string);
     property Exploded: Boolean read FExploded write SetExploded;
   end;
@@ -139 +149 @@
 
   TPlayers = class(TListObject)
+    Engine: TEngine;
     procedure Assign(Players: TPlayers);
+    procedure LoadConfig(Config: TXMLConfig; Path: string);
+    procedure SaveConfig(Config: TXMLConfig; Path: string);
   end;
 
@@ -212 +225 @@
     procedure DoDrawToBitmap;
     procedure InitPlayerPool;
+    procedure InitPlayers;
   public
     Keyboard: TKeyboard;
@@ -232 +246 @@
     procedure NewGame;
     procedure NewRound;
+    procedure LoadConfig(Config: TXMLConfig; Path: string);
+    procedure SaveConfig(Config: TXMLConfig; Path: string);
     property Bitmap: TBitmap read FBitmap write SetBitmap;
     property Active: Boolean read FActive write SetActive;
@@ -267 +283 @@
 end;
 
+{ TTanks }
+
+procedure TTanks.Assign(Source: TTanks);
+var
+  I: Integer;
+begin
+  Clear;
+  Count := Source.Count;
+  for I := 0 to Count - 1 do begin
+    Items[I] := TTank.Create;
+    TTank(Items[I]).Assign(TTank(Source.Items[I]));
+  end;
+end;
+
 { TPlayers }
 
@@ -279 +309 @@
 end;
 
+procedure TPlayers.SaveConfig(Config: TXMLConfig; Path: string);
+var
+  I: Integer;
+begin
+  Config.SetValue(DOMString(Path + '/Count'), Count);
+  for I := 0 to Count - 1 do
+    TPlayer(Items[I]).SaveConfig(Config, Path + '/Player' + IntToStr(I));
+end;
+
+procedure TPlayers.LoadConfig(Config: TXMLConfig; Path: string);
+var
+  I: Integer;
+begin
+  Clear;
+  Count := Config.GetValue(DOMString(Path + '/Count'), 0);
+  for I := 0 to Count - 1 do begin
+    Items[I] := TPlayer.Create;
+    TPlayer(Items[I]).Engine := Engine;
+    TPlayer(Items[I]).Id := I;
+    TPlayer(Items[I]).LoadConfig(Config, Path + '/Player' + IntToStr(I));
+  end;
+end;
+
 { TSystemThread }
 
@@ -319 +372 @@
 { TTank }
 
+procedure TTank.Assign(Source: TTank);
+begin
+  Image.Assign(Source.Image);
+  Mask.Assign(Source.Mask);
+end;
+
 constructor TTank.Create;
 begin
@@ -327 +386 @@
 destructor TTank.Destroy;
 begin
-  Mask.Free;
-  Image.Free;
+  FreeAndNil(Mask);
+  FreeAndNil(Image);
   inherited Destroy;
 end;
@@ -694 +753 @@
 destructor TWorld.Destroy;
 begin
-  Surface.Free;
-  Matter.Free;
+  FreeAndNil(Surface);
+  FreeAndNil(Matter);
   inherited Destroy;
 end;
@@ -1186 +1245 @@
 constructor TPlayer.Create;
 begin
-  Tanks := TListObject.Create;
+  Tanks := TTanks.Create;
   Bullets := TListObject.Create;
   House := TRectangle.Create;
@@ -1194 +1253 @@
 destructor TPlayer.Destroy;
 begin
-  ScreenFrame.Free;
-  House.Free;
-  Bullets.Free;
-  Tanks.Free;
+  FreeAndNil(ScreenFrame);
+  FreeAndNil(House);
+  FreeAndNil(Bullets);
+  FreeAndNil(Tanks);
   inherited Destroy;
 end;
@@ -1203 +1262 @@
 procedure TPlayer.Assign(Source: TPlayer);
 begin
+  Engine := Source.Engine;
+  Id := Source.Id;
   Keys := Source.Keys;
   Color := Source.Color;
@@ -1211 +1272 @@
   Position := Source.Position;
   Score := Source.Score;
+  Tanks.Assign(Source.Tanks);
+end;
+
+procedure TPlayer.LoadConfig(Config: TXMLConfig; Path: string);
+begin
+  with Config do begin
+    Self.Name := GetValue(DOMString(Path + '/Name'), '');
+    Color := GetValue(DOMString(Path + '/Color'), 0);
+    Enabled := GetValue(DOMString(Path + '/Enabled'), False);
+    Keys.Left := GetValue(DOMString(Path + '/Keys/Left'), 0);
+    Keys.Right := GetValue(DOMString(Path + '/Keys/Right'), 0);
+    Keys.Down := GetValue(DOMString(Path + '/Keys/Down'), 0);
+    Keys.Up := GetValue(DOMString(Path + '/Keys/Up'), 0);
+    Keys.Shoot := GetValue(DOMString(Path + '/Keys/Shoot'), 0);
+  end;
+  InitTanks;
+end;
+
+procedure TPlayer.SaveConfig(Config: TXMLConfig; Path: string);
+begin
+  with Config do begin
+    SetValue(DOMString(Path + '/Name'), Self.Name);
+    SetValue(DOMString(Path + '/Color'), Color);
+    SetValue(DOMString(Path + '/Enabled'), Enabled);
+    SetValue(DOMString(Path + '/Keys/Left'), Keys.Left);
+    SetValue(DOMString(Path + '/Keys/Right'), Keys.Right);
+    SetValue(DOMString(Path + '/Keys/Down'), Keys.Down);
+    SetValue(DOMString(Path + '/Keys/Up'), Keys.Up);
+    SetValue(DOMString(Path + '/Keys/Shoot'), Keys.Shoot);
+  end;
 end;
 
@@ -1517 +1608 @@
 end;
 
+procedure TEngine.InitPlayers;
+var
+  I: Integer;
+  NewPlayer: TPlayer;
+begin
+  Players.Clear;
+  for I := 0 to PlayerPool.Count - 1 do
+  with TPlayer(PlayerPool[I]) do
+  if Enabled then begin
+    NewPlayer := TPlayer.Create;
+    NewPlayer.Assign(TPlayer(PlayerPool[I]));
+    Players.Add(NewPlayer);
+    Score := 0;
+  end;
+end;
+
 procedure TEngine.CheckGameEnd;
 var
@@ -1573 +1680 @@
   IntfImage := TLazIntfImage.Create(1, 1);
   PlayerPool := TPlayers.Create;
+  PlayerPool.Engine := Self;
   Players := TPlayers.Create;
-  Players.OwnsObjects := False;
+  Players.Engine := Self;
   Keyboard := TKeyboard.Create;
   World := TWorld.Create;
@@ -1651 +1759 @@
 begin
   Active := False;
-  Players.Clear;
-  for I := 0 to PlayerPool.Count - 1 do
-  with TPlayer(PlayerPool[I]) do
-  if Enabled then begin
-    Players.Add(PlayerPool[I]);
-    Score := 0;
-  end;
+  InitPlayers;
   ResizePlayerFrames;
   CurrentRound := 0;
@@ -1681 +1783 @@
 end;
 
+procedure TEngine.LoadConfig(Config: TXMLConfig; Path: string);
+begin
+  PlayerPool.LoadConfig(Config, Path + '/Players');
+end;
+
+procedure TEngine.SaveConfig(Config: TXMLConfig; Path: string);
+begin
+  PlayerPool.SaveConfig(Config, Path + '/Players');
+end;
+
 end.