Changeset 32 for trunk

Timestamp:

Mar 4, 2014, 11:40:01 PM (11 years ago)

Author:

chronos

Message:

• Fixed: Do not update player move settings if not comfirmed by hitting Ok button.
• Modified: Automatic pairing player moves objects with CellFrom and CellTo.

Location:

trunk

Files:

• . (modified) (1 prop)
• UCore.pas (modified) (3 diffs)
• UFormMain.pas (modified) (1 diff)
• UGame.pas (modified) (16 diffs)
• xtactics.lpi (modified) (1 diff)
• xtactics.lpr (modified) (1 diff)

trunk

@@ -4 +4 @@
 xtactics.res
 xtactics.dbg
+heaptrclog.trc

@@ -4 +4 @@
 xtactics.res
 xtactics.dbg
+heaptrclog.trc

trunk/UCore.pas

@@ -30 +30 @@
     FInitialized: Boolean;
     procedure DoOnMove(CellFrom, CellTo: TCell; var CountOnce,
-      CountRepeat: Integer; Update: Boolean);
+      CountRepeat: Integer; Update: Boolean; var Confirm: Boolean);
     procedure DoOnWin(Player: TPlayer);
   public
@@ -58 +58 @@
 
 procedure TCore.DoOnMove(CellFrom, CellTo: TCell; var CountOnce,
-  CountRepeat: Integer; Update: Boolean);
+  CountRepeat: Integer; Update: Boolean; var Confirm: Boolean);
 begin
   if Update then FormMove.SpinEditOnce.MaxValue := CellFrom.GetAvialPower + CountOnce
@@ -72 +72 @@
     CountOnce := FormMove.SpinEditOnce.Value;
     CountRepeat := FormMove.SpinEditRepeat.Value;
-  end;
+    Confirm := True;
+  end else Confirm := False;
 end;
 

trunk/UFormMain.pas

@@ -187 +187 @@
     if Assigned(Cell) then begin
       Core.Game.CurrentPlayer.View.FocusedCell := Cell;
-      StatusBar1.Panels[0].Text := '[' + IntToStr(Cell.Pos.X) + ', ' + IntToStr(Cell.Pos.Y) + ']';
+      StatusBar1.Panels[0].Text := '[' + IntToStr(Cell.Pos.X) + ', ' + IntToStr(Cell.Pos.Y) + '] (' + IntToStr(Cell.MovesFrom.Count) + ', ' + IntToStr(Cell.MovesTo.Count) + ')';
     end else begin
       Core.Game.CurrentPlayer.View.FocusedCell := nil;

trunk/UGame.pas

@@ -95 +95 @@
     destructor Destroy; override;
     procedure Grow(APlayer: TPlayer);
-    procedure ClearCellMoves;
     procedure ComputePlayerStats;
     function GetPixelSize: TPoint;
@@ -132 +131 @@
   end;
 
+  { TMove }
+
   TMove = class
-    CellFrom: TCell;
-    CellTo: TCell;
+  private
+    FCellFrom: TCell;
+    FCellTo: TCell;
+    procedure SetCellFrom(AValue: TCell);
+    procedure SetCellTo(AValue: TCell);
+  public
+    List: TObjectList; // TList<TMove>
     CountOnce: Integer;
     CountRepeat: Integer;
+    constructor Create;
+    destructor Destroy; override;
+    property CellFrom: TCell read FCellFrom write SetCellFrom;
+    property CellTo: TCell read FCellTo write SetCellTo;
   end;
 
@@ -142 +152 @@
 
   TMoveEvent = procedure(CellFrom, CellTo: TCell; var CountOnce, CountRepeat: Integer;
-    Update: Boolean) of object;
+    Update: Boolean; var Confirm: Boolean) of object;
   TWinEvent = procedure(Player: TPlayer) of object;
 
@@ -179 +189 @@
   PlayerModeText: array[TPlayerMode] of string = ('Human', 'Computer');
   clOrange = $009Aff;
-  PlayerColors: array[0..7] of TColor = (clBlue, clRed, clGreen, clOrange, clPurple, clMaroon, clAqua, clFuchsia);
+  PlayerColors: array[0..7] of TColor = (clBlue, clRed, clGreen, clOrange,
+    clPurple, clMaroon, clAqua, clFuchsia);
 
 
@@ -239 +250 @@
 end;
 
+{ TMove }
+
+procedure TMove.SetCellFrom(AValue: TCell);
+begin
+  if FCellFrom = AValue then Exit;
+  if Assigned(AValue) and not Assigned(FCellFrom) then begin
+    AValue.MovesFrom.Add(Self);
+  end else
+  if not Assigned(AValue) and Assigned(FCellFrom) then begin
+    FCellFrom.MovesFrom.Remove(Self);
+  end;
+  FCellFrom := AValue;
+end;
+
+procedure TMove.SetCellTo(AValue: TCell);
+begin
+  if FCellTo = AValue then Exit;
+  if Assigned(AValue) and not Assigned(FCellTo) then begin
+    AValue.MovesTo.Add(Self);
+  end else
+  if not Assigned(AValue) and Assigned(FCellTo) then begin
+    FCellTo.MovesTo.Remove(Self);
+  end;
+  FCellTo := AValue;
+end;
+
+constructor TMove.Create;
+begin
+  FCellFrom := nil;
+  FCellTo := nil;
+end;
+
+destructor TMove.Destroy;
+begin
+  CellFrom := nil;
+  CellTo := nil;
+  if Assigned(List) then
+    List.Remove(Self);
+  inherited Destroy;
+end;
+
 { TView }
 
@@ -303 +355 @@
 
 destructor TCell.Destroy;
-begin
+var
+  I: Integer;
+begin
+  for I := MovesFrom.Count - 1 downto 0 do
+    TMove(MovesFrom[I]).Free;
   FreeAndNil(MovesFrom);
+  for I := MovesTo.Count - 1 downto 0 do
+    TMove(MovesTo[I]).Free;
   FreeAndNil(MovesTo);
   inherited Destroy;
@@ -464 +522 @@
   I: Integer;
 begin
-  for I := 0 to Moves.Count - 1 do
+  I := 0;
+  while I < Moves.Count do
   with TMove(Moves[I]) do begin
     if CellFrom.Player = Player then begin
@@ -486 +545 @@
       CountOnce := 0;
     end;
+    Inc(I);
   end;
   // Remove empty moves
   for I := Moves.Count - 1 downto 0 do
   if (TMove(Moves[I]).CellFrom.Player = Player) and
-    (TMove(Moves[I]).CountOnce = 0) and (TMove(Moves[I]).CountRepeat = 0) then begin
-    TMove(Moves[I]).CellFrom.MovesFrom.Remove(TMove(Moves[I]));
-    TMove(Moves[I]).CellTo.MovesTo.Remove(TMove(Moves[I]));
+    (TMove(Moves[I]).CountOnce = 0) and (TMove(Moves[I]).CountRepeat = 0) then
     Moves.Delete(I);
-  end;
 end;
 
@@ -501 +558 @@
   I: Integer;
 begin
-  for I := Moves.Count - 1 to 0 do
+  for I := Moves.Count - 1 downto 0 do
   if TMove(Moves[I]).CellFrom = Cell then
     Moves.Delete(I);
@@ -509 +566 @@
 var
   NewMove: TMove;
+  OldMove: TMove;
   I: Integer;
   CountOnce: Integer;
   CountRepeat: Integer;
+  Confirm: Boolean;
 begin
   I := 0;
   while (I < Moves.Count) and ((TMove(Moves[I]).CellFrom <> CellFrom) or
     (TMove(Moves[I]).CellTo <> CellTo)) do Inc(I);
-  if I < Moves.Count then begin
-    CountOnce := TMove(Moves[I]).CountOnce;
-    CountRepeat := TMove(Moves[I]).CountRepeat;
+  if I < Moves.Count then OldMove := TMove(Moves[I])
+    else OldMove := nil;
+  if Assigned(OldMove) then begin
+    CountOnce := OldMove.CountOnce;
+    CountRepeat := OldMove.CountRepeat;
     if Assigned(CurrentPlayer) and (CurrentPlayer.Mode = pmHuman) and
-      Assigned(FOnMove) then FOnMove(CellFrom, CellTo, CountOnce, CountRepeat, True);
+      Assigned(FOnMove) then FOnMove(CellFrom, CellTo, CountOnce, CountRepeat, True, Confirm);
   end else begin
     CountOnce := Power;
     CountRepeat := 0;
     if Assigned(CurrentPlayer) and (CurrentPlayer.Mode = pmHuman) and
-      Assigned(FOnMove) then FOnMove(CellFrom, CellTo, CountOnce, CountRepeat, False);
-  end;
-  if I < Moves.Count then begin
+      Assigned(FOnMove) then FOnMove(CellFrom, CellTo, CountOnce, CountRepeat, False, Confirm);
+  end;
+  if Confirm then begin
+  if Assigned(OldMove) then begin
     // Already have such move
     if (CountOnce = 0) and (CountRepeat = 0) then Moves.Delete(I)
@@ -538 +600 @@
     if (CountOnce > 0) or (CountRepeat > 0) then begin
       NewMove := TMove(Moves[Moves.Add(TMove.Create)]);
+      NewMove.List := Moves;
       NewMove.CellFrom := CellFrom;
       NewMove.CellTo := CellTo;
       NewMove.CountOnce := CountOnce;
       NewMove.CountRepeat := CountRepeat;
-      CellFrom.MovesFrom.Add(NewMove);
-      CellTo.MovesTo.Add(NewMove);
-    end;
+    end;
+  end;
   end;
 end;
@@ -630 +692 @@
   Player: TPlayer;
 begin
+  Moves := TObjectList.Create;
+  Map := THexMap.Create;
+  Players := TPlayers.Create;
+
   Randomize;
 
-  Players := TPlayers.Create;
   Player := TPlayer.Create;
   Player.Name := 'Player 1';
@@ -648 +713 @@
   VoidPercentage := 20;
 
-  Map := THexMap.Create;
   Map.Game := Self;
-  Map.Size := Point(20, 16);
-  Moves := TObjectList.Create;
+  Map.Size := Point(3, 3);
 end;
 
@@ -671 +734 @@
   TurnCounter := 1;
   Moves.Clear;
-  Map.ClearCellMoves;
   for Y := 0 to Map.Size.Y - 1 do
   for X := 0 to Map.Size.X - 1 do
@@ -859 +921 @@
   with Canvas, View do try
     Lock;
-    ClearCellMoves;
-    // Update moves in cells
-    for I := 0 to Game.Moves.Count - 1 do
-    with TMove(Game.Moves[I]) do begin
-      CellFrom.MovesFrom.Add(TMove(Game.Moves[I]));
-      CellTo.MovesTo.Add(TMove(Game.Moves[I]));
-    end;
-
     for CY := Trunc(SourceRect.Top / CellSize.Y) to Trunc(SourceRect.Bottom / CellSize.Y) + 1 do
     for CX := Trunc(SourceRect.Left / CellSize.X) to Trunc(SourceRect.Right / CellSize.X) + 1 do begin
@@ -932 +986 @@
 end;
 
-procedure THexMap.ClearCellMoves;
-var
-  X, Y: Integer;
-begin
-  for Y := 0 to Size.Y - 1 do
-  for X := 0 to Size.X - 1 do begin
-    Cells[Y, X].MovesFrom.Clear;
-    Cells[Y, X].MovesTo.Clear;
-  end;
-end;
-
 procedure THexMap.ComputePlayerStats;
 var

trunk/xtactics.lpi

@@ -168 +168 @@
         <MsgFileName Value=""/>
       </CompilerMessages>
+      <CustomOptions Value="-dDEBUG"/>
       <CompilerPath Value="$(CompPath)"/>
     </Other>

trunk/xtactics.lpr

@@ -9 +9 @@
   Interfaces, // this includes the LCL widgetset
   Forms, UFormMain, UGame, UFormNew, UFormMove, UCore, UFormPlayer
-  { you can add units after this };
+  { you can add units after this },
+  SysUtils;
 
 {$R *.res}
 
+{$IFDEF DEBUG}
+const
+  HeapTraceLog = 'heaptrclog.trc';
+{$ENDIF}
+
+
 begin
+  {$IFDEF DEBUG}
+  // Heap trace
+  DeleteFile(ExtractFilePath(ParamStr(0)) + HeapTraceLog);
+  SetHeapTraceOutput(ExtractFilePath(ParamStr(0)) + HeapTraceLog);
+  {$ENDIF}
+
   RequireDerivedFormResource := True;
   Application.Initialize;

@@ -4 +4 @@
 xtactics.res
 xtactics.dbg
+heaptrclog.trc