Changeset 23 for trunk/UGame.pas

Timestamp:

Mar 2, 2014, 11:27:14 PM (11 years ago)

Author:

chronos

Message:

• Modified: Calculation of player visible frame is now handled by TView class.
• Fixed: Set proper max power on existing player move update.

File:

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

trunk/UGame.pas

@@ -10 +10 @@
 const
   DefaultPlayerStartUnits = 5;
+  CellMulX = 1.12;
+  CellMulY = 1.292;
 
 type
@@ -44 +46 @@
   end;
 
+  { TView }
+
+  TView = class
+  private
+    FDestRect: TRect;
+    FZoom: Double;
+    procedure SetDestRect(AValue: TRect);
+    procedure SetZoom(AValue: Double);
+  public
+    SourceRect: TRect;
+    constructor Create;
+    destructor Destroy; override;
+    function CanvasToCellPos(Pos: TPoint): TPoint;
+    function CellToCanvasPos(Pos: TPoint): TPoint;
+    function CanvasToCellRect(Pos: TRect): TRect;
+    function CellToCanvasRect(Pos: TRect): TRect;
+    property DestRect: TRect read FDestRect write SetDestRect;
+    property Zoom: Double read FZoom write SetZoom;
+  end;
+
   { THexMap }
 
@@ -55 +77 @@
     DefaultCellSize: TPoint;
     Cells: array of array of TCell;
-    function PosToCell(Pos: TPoint; Rect: TRect; Zoom: Double): TCell;
-    function CellToPos(Cell: TCell; Rect: TRect; Zoom: Double): TPoint;
+    function PosToCell(Pos: TPoint; View: TView): TCell;
+    function CellToPos(Cell: TCell; View: TView): TPoint;
     function GetHexagonPolygon(Pos: TPoint; HexSize: TPoint): TPointArray;
-    procedure Paint(Canvas: TCanvas; Rect: TRect; Zoom: Double; SelectedCell: TCell);
+    procedure Paint(Canvas: TCanvas; View: TView; SelectedCell: TCell; FocusedCell: TCell);
     constructor Create;
     destructor Destroy; override;
@@ -68 +90 @@
   end;
 
+
   TPlayerMode = (pmHuman, pmComputer);
 
@@ -75 +98 @@
     Game: TGame;
     Name: string;
-    CellPos: TPoint;
-    ViewSize: TPoint;
     Color: TColor;
-    ViewZoom: Double;
+    View: TView;
     SelectedCell: TCell;
+    FocusedCell: TCell;
     Mode: TPlayerMode;
     TotalUnits: Integer;
     TotalCells: Integer;
     StartUnits: Integer;
-    function CanvasToCellPos(Pos: TPoint): TPoint;
-    function CellToCanvasPos(Pos: TPoint): TPoint;
-    function CanvasToCellRect(Pos: TRect): TRect;
-    function CellToCanvasRect(Pos: TRect): TRect;
     procedure ComputerTurn;
     procedure SelectCell(Pos: TPoint);
     procedure Paint(PaintBox: TPaintBox);
     constructor Create;
+    destructor Destroy; override;
     procedure Assign(Source: TPlayer);
   end;
@@ -108 +127 @@
   { TGame }
 
-  TMoveEvent = procedure(CellFrom, CellTo: TCell; var CountOnce, CountRepeat: Integer) of object;
+  TMoveEvent = procedure(CellFrom, CellTo: TCell; var CountOnce, CountRepeat: Integer;
+    Update: Boolean) of object;
   TWinEvent = procedure(Player: TPlayer) of object;
 
@@ -153 +173 @@
 end;
 
+function RectEquals(A, B: TRect): Boolean;
+begin
+  Result := (A.Left = B.Left) and (A.Top = B.Top) and
+    (A.Right = B.Right) and (A.Bottom = B.Bottom);
+end;
+
 function PtInPoly(const Points: array of TPoint; Pos: TPoint): Boolean;
 var
@@ -193 +219 @@
 end;
 
+{ TView }
+
+procedure TView.SetZoom(AValue: Double);
+begin
+  if FZoom = AValue then Exit;
+  FZoom := AValue;
+  SourceRect := Bounds(SourceRect.Left, SourceRect.Top,
+    Trunc((DestRect.Right - DestRect.Left) / Zoom),
+    Trunc((DestRect.Bottom - DestRect.Top) / Zoom));
+end;
+
+procedure TView.SetDestRect(AValue: TRect);
+begin
+  if RectEquals(FDestRect, AValue) then Exit;
+  FDestRect := AValue;
+  SourceRect := Bounds(SourceRect.Left, SourceRect.Top,
+    Trunc((DestRect.Right - DestRect.Left) / Zoom),
+    Trunc((DestRect.Bottom - DestRect.Top) / Zoom));
+end;
+
+constructor TView.Create;
+begin
+  Zoom := 1;
+end;
+
+destructor TView.Destroy;
+begin
+  inherited Destroy;
+end;
+
 { TCell }
 
@@ -228 +284 @@
 { TPlayer }
 
-function TPlayer.CanvasToCellPos(Pos: TPoint): TPoint;
-begin
-  Result := Point(Trunc(Pos.X / ViewZoom + CellPos.X),
-    Trunc(Pos.Y / ViewZoom + CellPos.Y));
-end;
-
-function TPlayer.CellToCanvasPos(Pos: TPoint): TPoint;
-begin
-  Result := Point(Trunc((Pos.X - CellPos.X) * ViewZoom),
-    Trunc((Pos.Y - CellPos.Y) * ViewZoom));
-end;
-
-function TPlayer.CanvasToCellRect(Pos: TRect): TRect;
+function TView.CanvasToCellPos(Pos: TPoint): TPoint;
+begin
+  Result := Point(Trunc(Pos.X / Zoom + SourceRect.Left),
+    Trunc(Pos.Y / Zoom + SourceRect.Top));
+end;
+
+function TView.CellToCanvasPos(Pos: TPoint): TPoint;
+begin
+  Result := Point(Trunc((Pos.X - SourceRect.Left) * Zoom),
+    Trunc((Pos.Y - SourceRect.Top) * Zoom));
+end;
+
+function TView.CanvasToCellRect(Pos: TRect): TRect;
 begin
   Result.TopLeft := CanvasToCellPos(Pos.TopLeft);
@@ -246 +302 @@
 end;
 
-function TPlayer.CellToCanvasRect(Pos: TRect): TRect;
+function TView.CellToCanvasRect(Pos: TRect): TRect;
 begin
   Result.TopLeft := CellToCanvasPos(Pos.TopLeft);
@@ -263 +319 @@
   BottomRight: TPoint;
 begin
-  NewSelectedCell := Game.Map.PosToCell(CanvasToCellPos(Pos), CanvasToCellRect(Bounds(0, 0, ViewSize.X, ViewSize.Y)), ViewZoom);
+  NewSelectedCell := Game.Map.PosToCell(View.CanvasToCellPos(Pos), View);
   if Assigned(NewSelectedCell) then begin
     if Assigned(SelectedCell) and IsCellsNeighbor(NewSelectedCell, SelectedCell) then begin
@@ -279 +335 @@
 procedure TPlayer.Paint(PaintBox: TPaintBox);
 begin
-  Game.Map.Paint(PaintBox.Canvas, CanvasToCellRect(Bounds(0, 0, ViewSize.X, ViewSize.Y)), ViewZoom, SelectedCell);
+  Game.Map.Paint(PaintBox.Canvas, View, SelectedCell, FocusedCell);
 end;
 
 constructor TPlayer.Create;
 begin
-  ViewZoom := 1;
+  View := TView.Create;
   SelectedCell := nil;
+  FocusedCell := nil;
   StartUnits := DefaultPlayerStartUnits;
+end;
+
+destructor TPlayer.Destroy;
+begin
+  FreeAndNil(View);
+  inherited Destroy;
 end;
 
@@ -299 +362 @@
   StartUnits := Source.StartUnits;
   SelectedCell := Source.SelectedCell;
-  ViewZoom := Source.ViewZoom;
+  View.Zoom := Source.View.Zoom;
 end;
 
@@ -352 +415 @@
     CountOnce := TMove(Moves[I]).CountOnce;
     CountRepeat := TMove(Moves[I]).CountRepeat;
+    if Assigned(FOnMove) then FOnMove(CellFrom, CellTo, CountOnce, CountRepeat, True);
   end else begin
     CountOnce := CellFrom.Power;
     CountRepeat := 0;
-  end;
-  if Assigned(FOnMove) then FOnMove(CellFrom, CellTo, CountOnce, CountRepeat);
+    if Assigned(FOnMove) then FOnMove(CellFrom, CellTo, CountOnce, CountRepeat, False);
+  end;
   if I < Moves.Count then begin
     // Already have such move
@@ -362 +426 @@
       else begin
         TMove(Moves[I]).CountOnce := CountOnce;
-        TMove(Moves[I]).CountOnce := CountOnce;
+        TMove(Moves[I]).CountRepeat := CountRepeat;
       end;
   end else begin
@@ -451 +515 @@
   Map := THexMap.Create;
   Map.Game := Self;
-  Map.Size := Point(2, 2);
+  Map.Size := Point(20, 20);
   Moves := TObjectList.Create;
 end;
@@ -490 +554 @@
       StartCell.Power := TPlayer(Players[I]).StartUnits;
     end;
-    ViewZoom := 1;
+    View.Zoom := 1;
     // Center board
-    CellPos := Point(Trunc(Map.GetPixelSize.X div 2 - ViewSize.X div 2 / ViewZoom),
-      Trunc(Map.GetPixelSize.Y div 2 - ViewSize.Y div 2 / ViewZoom));
+    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));
   end;
   CurrentPlayer := TPlayer(Players[0]);
@@ -538 +602 @@
 end;
 
-function THexMap.PosToCell(Pos: TPoint; Rect: TRect; Zoom: Double): TCell;
+function THexMap.PosToCell(Pos: TPoint; View: TView): TCell;
 var
   CX, CY: Integer;
@@ -546 +610 @@
   Points: array of TPoint;
 begin
-  // TODO: This is implemented as simple sequence lookup. It needs some faster algorithm
+  // TODO: This is implemented as simple sequence lookup. Needs some faster algorithm
   Result := nil;
-  CellSize := FloatPoint(DefaultCellSize.X / 1.15 * Zoom, DefaultCellSize.Y / 1.35 * Zoom);
-  HexSize := FloatPoint(DefaultCellSize.X * Zoom, DefaultCellSize.Y * Zoom);
-    for CY := Trunc(Rect.Top / CellSize.Y) to Trunc(Rect.Bottom / CellSize.Y) + 1 do
-    for CX := Trunc(Rect.Left / CellSize.X) to Trunc(Rect.Right / CellSize.X) + 1 do begin
-      X := CX - Trunc(Rect.Left / CellSize.X);
-      Y := CY - Trunc(Rect.Top / CellSize.Y);
+  CellSize := FloatPoint(DefaultCellSize.X / CellMulX, DefaultCellSize.Y / CellMulY);
+  HexSize := FloatPoint(DefaultCellSize.X, DefaultCellSize.Y);
+  with View do
+    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
+      X := CX;
+      Y := CY;
       if (CY and 1) = 1 then begin
         X := X + 0.5;
@@ -560 +625 @@
       if (CX >= 0) and (CY >= 0) and (CY < Size.Y) and (CX < Size.X) then
       if Cells[CY, CX].Terrain = ttNormal then begin
-        Points := GetHexagonPolygon(Point(Trunc(X * CellSize.X - Frac(Rect.Left / CellSize.X) * CellSize.X),
-          Trunc(Y * CellSize.Y - Frac(Rect.Top / CellSize.Y) * CellSize.Y)), Point(Trunc(HexSize.X), Trunc(HexSize.Y)));
+        Points := GetHexagonPolygon(Point(Trunc(X * CellSize.X - Frac(SourceRect.Left / CellSize.X) * CellSize.X),
+          Trunc(Y * CellSize.Y - Frac(SourceRect.Top / CellSize.Y) * CellSize.Y)),
+          Point(Trunc(HexSize.X), Trunc(HexSize.Y)));
         if PtInPoly(Points, Pos) then begin
           Result := Cells[CY, CX];
@@ -570 +636 @@
 end;
 
-function THexMap.CellToPos(Cell: TCell; Rect: TRect; Zoom: Double): TPoint;
+function THexMap.CellToPos(Cell: TCell; View: TView): TPoint;
 var
   CX, CY: Integer;
@@ -578 +644 @@
   Points: array of TPoint;
 begin
-  CellSize := FloatPoint(DefaultCellSize.X / 1.15 * Zoom, DefaultCellSize.Y / 1.35 * Zoom);
-  HexSize := FloatPoint(DefaultCellSize.X * Zoom, DefaultCellSize.Y * Zoom);
-  X := Cell.Pos.X - Trunc(Rect.Left / CellSize.X);
-  Y := Cell.Pos.Y - Trunc(Rect.Top / CellSize.Y);
+  with View do begin
+  CellSize := FloatPoint(DefaultCellSize.X / CellMulX * View.Zoom, DefaultCellSize.Y / CellMulY * View.Zoom);
+  HexSize := FloatPoint(DefaultCellSize.X * View.Zoom, DefaultCellSize.Y * View.Zoom);
+  X := Cell.Pos.X - Trunc(SourceRect.Left / CellSize.X);
+  Y := Cell.Pos.Y - Trunc(SourceRect.Top / CellSize.Y);
   if (Cell.Pos.Y and 1) = 1 then begin
     X := X + 0.5;
@@ -587 +654 @@
   end;
 
-  Result.X := Trunc(X * CellSize.X - Frac(Rect.Left / CellSize.X) * CellSize.X);
-  Result.Y := Trunc(Y * CellSize.Y - Frac(Rect.Top / CellSize.Y) * CellSize.Y);
-end;
-
-
-procedure THexMap.Paint(Canvas: TCanvas; Rect: TRect; Zoom: Double; SelectedCell: TCell);
+  Result.X := Trunc(X * CellSize.X - Frac(SourceRect.Left / CellSize.X) * CellSize.X);
+  Result.Y := Trunc(Y * CellSize.Y - Frac(SourceRect.Top / CellSize.Y) * CellSize.Y);
+  end;
+end;
+
+
+procedure THexMap.Paint(Canvas: TCanvas; View: TView; SelectedCell: TCell; FocusedCell: TCell);
 var
   CX, CY: Integer;
   X, Y: Double;
+  CellSizeZoomed: TFloatPoint;
+  CellSize: TFloatPoint;
   HexSize: TFloatPoint;
-  CellSize: TFloatPoint;
   I: Integer;
   Points: array of TPoint;
@@ -608 +677 @@
 begin
   with Canvas do begin
+    if Assigned(FocusedCell) and (FocusedCell = TCell(Cells[CY, CX])) then begin
+      Pen.Color := clYellow;
+      Pen.Style := psSolid;
+    end else begin
+      Pen.Color := clBlack;
+      Pen.Style := psClear;
+    end;
     Points := GetHexagonPolygon(Point(Trunc(X), Trunc(Y)), Point(Trunc(HexSize.X), Trunc(HexSize.Y)));
     Polygon(Points);
+    Pen.Style := psSolid;
     Font.Color := clWhite;
-    Font.Size := Trunc(12 * Zoom);
+    Font.Size := Trunc(12 * View.Zoom);
     TextOut(Round(X) - TextWidth(Text) div 2, Round(Y) - TextHeight(Text) div 2, Text);
   end;
@@ -617 +694 @@
 
 begin
-  CellSize := FloatPoint(DefaultCellSize.X / 1.15 * Zoom, DefaultCellSize.Y / 1.35 * Zoom);
-  HexSize := FloatPoint(DefaultCellSize.X * Zoom, DefaultCellSize.Y * Zoom);
-  with Canvas do try
+  CellSize := FloatPoint(DefaultCellSize.X / CellMulX, DefaultCellSize.Y / CellMulY);
+  HexSize := FloatPoint(DefaultCellSize.X * View.Zoom, DefaultCellSize.Y * View.Zoom);
+  CellSizeZoomed := FloatPoint(CellSize.X * View.Zoom, CellSize.Y * View.Zoom);
+  with Canvas, View do try
     Lock;
     ClearCellMoves;
@@ -629 +707 @@
     end;
 
-    for CY := Trunc(Rect.Top / CellSize.Y) to Trunc(Rect.Bottom / CellSize.Y) + 1 do
-    for CX := Trunc(Rect.Left / CellSize.X) to Trunc(Rect.Right / CellSize.X) + 1 do begin
-      X := CX - Trunc(Rect.Left / CellSize.X);
-      Y := CY - Trunc(Rect.Top / CellSize.Y);
+    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
+      X := CX - Trunc(SourceRect.Left / CellSize.X);
+      Y := CY - Trunc(SourceRect.Top / CellSize.Y);
       if (CY and 1) = 1 then begin
         X := X + 0.5;
@@ -644 +722 @@
             else Brush.Color := Cell.GetColor;
           Pen.Color := clBlack;
-          PaintHexagon(X * CellSize.X - Frac(Rect.Left / CellSize.X) * CellSize.X,
-            Y * CellSize.Y - Frac(Rect.Top / CellSize.Y) * CellSize.Y, IntToStr(Cell.GetAvialPower));
+          PaintHexagon(X * CellSizeZoomed.X - Frac(SourceRect.Left / CellSize.X) * CellSizeZoomed.X,
+            Y * CellSizeZoomed.Y - Frac(SourceRect.Top / CellSize.Y) * CellSizeZoomed.Y, IntToStr(Cell.GetAvialPower));
           // Draw arrows
           Pen.Color := clCream;
           for I := 0 to Cell.MovesFrom.Count - 1 do begin
-            PosFrom := CellToPos(Cell, Rect, Zoom);
-            PosTo := CellToPos(TMove(Cell.MovesFrom[I]).CellTo, Rect, Zoom);
+            PosFrom := CellToPos(Cell, View);
+            PosTo := CellToPos(TMove(Cell.MovesFrom[I]).CellTo, View);
             Line(Trunc(PosFrom.X + (PosTo.X - PosFrom.X) / 4),
               Trunc(PosFrom.Y + (PosTo.Y - PosFrom.Y) / 4),