Changeset 35 for trunk/UGame.pas

Timestamp:

Mar 7, 2014, 11:03:30 PM (11 years ago)

Author:

chronos

Message:

• Added: Zoom all action to show entire map.
• Added: Actions Zoom in and Zoom out which keep view center.
• Fixed: Form resize now keep view center.
• Modified: Attacking is now using mutiple dice rolls system.

File:

• trunk/UGame.pas (modified) (16 diffs)

trunk/UGame.pas

@@ -66 +66 @@
     destructor Destroy; override;
     procedure SelectCell(Pos: TPoint; Player: TPlayer);
+    procedure CenterMap;
     function CanvasToCellPos(Pos: TPoint): TPoint;
     function CellToCanvasPos(Pos: TPoint): TPoint;
@@ -96 +97 @@
     procedure Grow(APlayer: TPlayer);
     procedure ComputePlayerStats;
-    function GetPixelSize: TPoint;
+    function GetPixelRect: TRect;
     property Size: TPoint read FSize write SetSize;
   end;
@@ -137 +138 @@
     FCellFrom: TCell;
     FCellTo: TCell;
+    FDestroying: Boolean;
     procedure SetCellFrom(AValue: TCell);
     procedure SetCellTo(AValue: TCell);
@@ -160 +162 @@
     FOnWin: TWinEvent;
     FRunning: Boolean;
+    procedure Attack(var AttackPower, DefendPower: Integer);
     procedure MoveAll(Player: TPlayer);
     procedure ClearMovesFromCell(Cell: TCell);
@@ -195 +198 @@
 
 procedure InitStrings;
+function FloatPoint(AX, AY: Double): TFloatPoint;
 
 
@@ -295 +299 @@
 
 destructor TMove.Destroy;
+var
+  LastState: Boolean;
 begin
   CellFrom := nil;
   CellTo := nil;
-  if Assigned(List) then
-    List.Remove(Self);
+  if Assigned(List) then begin
+    // To remove itself from list we need disable owning to not be called twice
+    try
+      LastState := List.OwnsObjects;
+      List.OwnsObjects := False;
+      List.Remove(Self);
+    finally
+      List.OwnsObjects := LastState;
+    end;
+  end;
   inherited Destroy;
 end;
@@ -306 +320 @@
 
 procedure TView.SetZoom(AValue: Double);
+var
+  OldSourceRect: TRect;
 begin
   if FZoom = AValue then Exit;
   FZoom := AValue;
-  SourceRect := Bounds(SourceRect.Left, SourceRect.Top,
+  SourceRect := Bounds(Trunc(SourceRect.Left + (SourceRect.Right - SourceRect.Left) div 2 - (DestRect.Right - DestRect.Left) / Zoom / 2),
+    Trunc(SourceRect.Top +  (SourceRect.Bottom - SourceRect.Top) div 2 - (DestRect.Bottom - DestRect.Top) / Zoom / 2),
     Trunc((DestRect.Right - DestRect.Left) / Zoom),
     Trunc((DestRect.Bottom - DestRect.Top) / Zoom));
@@ -321 +338 @@
 
 procedure TView.SetDestRect(AValue: TRect);
+var
+  Diff: TPoint;
 begin
   if RectEquals(FDestRect, AValue) then Exit;
+  Diff := Point(Trunc((DestRect.Right - DestRect.Left) / Zoom - (AValue.Right - AValue.Left) / Zoom) div 2,
+    Trunc((DestRect.Bottom - DestRect.Top) / Zoom - (AValue.Bottom - AValue.Top) / Zoom) div 2);
   FDestRect := AValue;
-  SourceRect := Bounds(SourceRect.Left, SourceRect.Top,
+  SourceRect := Bounds(SourceRect.Left + Diff.X, SourceRect.Top + Diff.Y,
     Trunc((DestRect.Right - DestRect.Left) / Zoom),
     Trunc((DestRect.Bottom - DestRect.Top) / Zoom));
@@ -360 +381 @@
 constructor TCell.Create;
 begin
+  Player := nil;
   MovesFrom := TObjectList.Create;
   MovesFrom.OwnsObjects := False;
@@ -499 +521 @@
 end;
 
+procedure TView.CenterMap;
+var
+  MapRect: TRect;
+begin
+  MapRect := Game.Map.GetPixelRect;
+  SourceRect := Bounds(MapRect.Left + (MapRect.Right - MapRect.Left) div 2 - (SourceRect.Right - SourceRect.Left) div 2,
+    MapRect.Top + (MapRect.Bottom - MapRect.Top) div 2 - (SourceRect.Bottom - SourceRect.Top) div 2,
+    SourceRect.Right - SourceRect.Left,
+    SourceRect.Bottom - SourceRect.Top);
+end;
+
 procedure TPlayer.Paint(PaintBox: TPaintBox);
 begin
@@ -530 +563 @@
 { TGame }
 
+procedure TGame.Attack(var AttackPower, DefendPower: Integer);
+var
+  AttackerRoll: Integer;
+  DefenderRoll: Integer;
+begin
+  while (AttackPower > 0) and (DefendPower > 0) do begin
+    // Earch side do dice roll and compare result. Defender wins tie
+    AttackerRoll := Random(6);
+    DefenderRoll := Random(6);
+    if AttackerRoll > DefenderRoll then Dec(DefendPower)
+      else Dec(AttackPower);
+  end;
+end;
+
 procedure TGame.MoveAll(Player: TPlayer);
 var
   I: Integer;
+  Remain: Integer;
+  AttackerPower: Integer;
+  DefenderPower: Integer;
 begin
   I := 0;
@@ -542 +592 @@
         CellTo.Power := CellTo.Power + CountOnce;
       end else begin
-        // Fight
-        //NewPower := CellTo.Power - Trunc(CountOnce / CellTo.Power);
-        if CellTo.Power > CountOnce then begin
-          // Defender wins
-          CellTo.Power := CellTo.Power - CountOnce;
-        end else begin
-          // Attacker wins
-          CellTo.Power := CountOnce - CellTo.Power;
+        AttackerPower := CountOnce;
+        DefenderPower := CellTo.Power;
+        Attack(AttackerPower, DefenderPower);
+        if DefenderPower = 0 then begin
+          // Attacker wins with possible loses
+          ClearMovesFromCell(CellTo);
           CellTo.Player := Player;
-          ClearMovesFromCell(CellTo);
-        end;
+          CellTo.Power := AttackerPower;
+        end else
+        if AttackerPower = 0 then begin
+          // Defender wins with possible loses
+          CellTo.Power := DefenderPower;
+        end else
+          raise Exception.Create('Unfinished battle');
       end;
       CellFrom.Power := CellFrom.Power - CountOnce;
@@ -764 +817 @@
     end;
     View.Zoom := 1;
-    // Center board
-    View.SourceRect.TopLeft := Point(Trunc(Map.GetPixelSize.X div 2 - (View.SourceRect.Right - View.SourceRect.Left) div 2 / View.Zoom),
-      Trunc(Map.GetPixelSize.Y div 2 - (View.SourceRect.Bottom - View.SourceRect.Top) div 2 / View.Zoom));
+    View.CenterMap;
   end;
   CurrentPlayer := TPlayer(Players[0]);
@@ -873 +924 @@
   Points: array of TPoint;
 begin
-  with View do begin
   CellSize := FloatPoint(DefaultCellSize.X / CellMulX, DefaultCellSize.Y / CellMulY);
   HexSize := FloatPoint(DefaultCellSize.X, DefaultCellSize.Y);
@@ -885 +935 @@
   Result.X := Trunc(X * CellSize.X);
   Result.Y := Trunc(Y * CellSize.Y);
-  end;
 end;
 
@@ -1008 +1057 @@
       Player.TotalCells := Player.TotalCells + 1;
       Player.TotalUnits := Player.TotalUnits + Power;
-
-    end;
-  end;
-end;
-
-function THexMap.GetPixelSize: TPoint;
-begin
-  Result := Point(Size.X * DefaultCellSize.X, Size.Y * DefaultCellSize.Y);
+    end;
+  end;
+end;
+
+function THexMap.GetPixelRect: TRect;
+begin
+  Result := Bounds(Trunc(-0.5 * DefaultCellSize.X),
+    Trunc(-0.5 * DefaultCellSize.Y),
+    Trunc((Size.X + 0.5) * DefaultCellSize.X),
+    Trunc(((Size.Y + 0.5) * 0.78) * DefaultCellSize.Y));
 end;