Changeset 404

Timestamp:

Jan 6, 2025, 10:21:08 PM (45 hours ago)

Author:

chronos

Message:

• Fixed: Crash on cyclic map new move creation.
• Modified: TView class moved into separate unit.

Location:

trunk

Files:

• ClientGUI.pas (modified) (3 diffs)
• Forms/FormClient.pas (modified) (7 diffs)
• Languages/xtactics.cs.po (modified) (3 diffs)
• Languages/xtactics.pot (modified) (2 diffs)
• View.pas (added)
• xtactics.lpi (modified) (2 diffs)
• xtactics.lpr (modified) (1 diff)

trunk/ClientGUI.pas

@@ -5 +5 @@
 uses
   Types, Classes, SysUtils, Graphics, GameClient, Player, Map, Game, Geometry,
-  Math;
+  Math, View;
 
 type
-  { TView }
-
-  TView = class
-  private
-    FDestRect: TRect;
-    FZoom: Double;
-    procedure SetDestRect(AValue: TRect);
-    procedure SetZoom(AValue: Double);
-  public
-    Game: TObject; // TGame;
-    SourceRect: TRect;
-    FocusedCell: TPlayerCell;
-    SelectedCell: TPlayerCell;
-    procedure Clear;
-    function IsCellVisible(Cell: TCell): Boolean;
-    constructor Create;
-    destructor Destroy; override;
-    procedure SelectCell(Pos: TPoint; Player: TPlayer; ShiftState: TShiftState);
-    procedure CenterMap;
-    procedure CenterPlayerCity(Player: TPlayer);
-    procedure ZoomAll;
-    function CanvasToCellPos(Pos: TPoint): TPoint;
-    function CellToCanvasPos(Pos: TPoint): TPoint;
-    function CellToCanvasPosF(Pos: TPointF): TPointF;
-    function CanvasToCellRect(Pos: TRect): TRect;
-    function CellToCanvasRect(Pos: TRect): TRect;
-    function CellToCanvasRectF(Pos: TRectF): TRectF;
-    procedure Assign(Source: TView);
-    property DestRect: TRect read FDestRect write SetDestRect;
-    property Zoom: Double read FZoom write SetZoom;
-  end;
-
   { TClientGUI }
 
@@ -73 +41 @@
 
 resourcestring
-  SZeroZoomNotAlowed = 'Zero zoom not allowed';
   SWrongArrowAngle = 'Wrong arrow angle %s';
 
@@ -521 +488 @@
 end;
 
-{ TView }
-
-procedure TView.SetZoom(AValue: Double);
-begin
-  if FZoom = AValue then Exit;
-  if AValue = 0 then
-    raise Exception.Create(SZeroZoomNotAlowed);
-  FZoom := AValue;
-  SourceRect := TRect.CreateBounds(TPoint.Create(Trunc(SourceRect.P1.X + SourceRect.Size.X div 2 - DestRect.Size.X / Zoom / 2),
-    Trunc(SourceRect.P1.Y +  SourceRect.Size.Y div 2 - DestRect.Size.Y / Zoom / 2)),
-    TPoint.Create(Trunc(DestRect.Size.X / Zoom),
-    Trunc(DestRect.Size.Y / Zoom)));
-end;
-
-procedure TView.Clear;
-begin
-  FocusedCell := nil;
-  SelectedCell := nil;
-end;
-
-procedure TView.SetDestRect(AValue: TRect);
-var
-  Diff: TPoint;
-begin
-  if FDestRect = AValue then Exit;
-  Diff := TPoint.Create(Trunc(DestRect.Size.X / Zoom - AValue.Size.X / Zoom) div 2,
-    Trunc(DestRect.Size.Y / Zoom - AValue.Size.Y / Zoom) div 2);
-  FDestRect := AValue;
-  SourceRect := TRect.CreateBounds(TPoint.Create(SourceRect.P1.X + Diff.X, SourceRect.P1.Y + Diff.Y),
-    TPoint.Create(Trunc(DestRect.Size.X / Zoom),
-    Trunc(DestRect.Size.Y / Zoom)));
-end;
-
-constructor TView.Create;
-begin
-  Zoom := 1.5;
-  Clear;
-end;
-
-destructor TView.Destroy;
-begin
-  inherited;
-end;
-
-function TView.CanvasToCellPos(Pos: TPoint): TPoint;
-begin
-  Result := TPoint.Create(Trunc((Pos.X - DestRect.P1.X) / Zoom + SourceRect.P1.X),
-    Trunc((Pos.Y - DestRect.P1.Y) / Zoom + SourceRect.P1.Y));
-end;
-
-function TView.CellToCanvasPos(Pos: TPoint): TPoint;
-begin
-  Result := TPoint.Create(Trunc((Pos.X - SourceRect.P1.X) * Zoom) + DestRect.P1.X,
-    Trunc((Pos.Y - SourceRect.P1.Y) * Zoom) + DestRect.P1.Y);
-end;
-
-function TView.CellToCanvasPosF(Pos: TPointF): TPointF;
-begin
-  Result := TPointF.Create((Pos.X - SourceRect.P1.X) * Zoom + DestRect.P1.X,
-    (Pos.Y - SourceRect.P1.Y) * Zoom + DestRect.P1.Y);
-end;
-
-function TView.CanvasToCellRect(Pos: TRect): TRect;
-begin
-  Result.P1 := CanvasToCellPos(Pos.P1);
-  Result.P2 := CanvasToCellPos(Pos.P2);
-end;
-
-function TView.CellToCanvasRect(Pos: TRect): TRect;
-begin
-  Result.P1 := CellToCanvasPos(Pos.P1);
-  Result.P2 := CellToCanvasPos(Pos.P2);
-end;
-
-function TView.CellToCanvasRectF(Pos: TRectF): TRectF;
-begin
-  Result.P1 := CellToCanvasPosF(Pos.P1);
-  Result.P2 := CellToCanvasPosF(Pos.P2);
-end;
-
-procedure TView.Assign(Source: TView);
-begin
-  SourceRect := Source.SourceRect;
-  FDestRect := Source.DestRect;
-  FZoom := Source.Zoom;
-  SelectedCell := Source.SelectedCell;
-  FocusedCell := Source.FocusedCell;
-end;
-
-procedure TView.SelectCell(Pos: TPoint; Player: TPlayer; ShiftState: TShiftState);
-var
-  NewSelectedCell: TPlayerCell;
-  UnitMove: TUnitMove;
-  I: Integer;
-  CellPos: TPoint;
-  R: TRect;
-begin
-  if TGame(Game).Map.Cyclic then begin
-    R := CellToCanvasRect(TGame(Game).Map.PixelRect);
-    CellPos := TPoint.Create(
-      ModNeg(Pos.X - R.P1.X, R.Size.X) + R.P1.X,
-      ModNeg(Pos.Y - R.P1.Y, R.Size.Y) + R.P1.Y
-    );
-    NewSelectedCell := Player.PlayerMap.PosToCell(
-      CanvasToCellPos(CellPos));
-  end else begin
-    NewSelectedCell := Player.PlayerMap.PosToCell(
-      CanvasToCellPos(Pos));
-  end;
-  if Assigned(NewSelectedCell) then begin
-    if Assigned(SelectedCell) and (NewSelectedCell <> SelectedCell) and
-    TGame(Game).CurrentPlayer.IsAllowedMoveTarget(SelectedCell, NewSelectedCell) then begin
-      if ssShift in ShiftState then begin
-        // Make maximum unit move without confirmation dialog
-        for I := SelectedCell.MovesFrom.Count - 1 downto 0 do begin
-          Player.Moves.Remove(SelectedCell.MovesFrom[I]);
-        end;
-        TGame(Game).CurrentPlayer.SetMove(SelectedCell, NewSelectedCell, SelectedCell.MapCell.OneUnit.Power, False);
-        SelectedCell := nil;
-      end else
-      if ssCtrl in ShiftState then begin
-        // If CTRL key pressed then storno all moved from selected cell and
-        // move all power to new selected cell
-        for I := SelectedCell.MovesFrom.Count - 1 downto 0 do
-          Player.Moves.Remove(SelectedCell.MovesFrom[I]);
-        UnitMove := TGame(Game).CurrentPlayer.SetMove(SelectedCell, NewSelectedCell, SelectedCell.MapCell.OneUnit.Power, False);
-        if Assigned(UnitMove) then
-          UnitMove.CountRepeat := TGame(Player.Game).Map.MaxPower;
-        if NewSelectedCell.MapCell.Player = Player then SelectedCell := NewSelectedCell
-          else SelectedCell := nil;
-      end else begin
-        TGame(Game).CurrentPlayer.SetMove(SelectedCell, NewSelectedCell, SelectedCell.MapCell.OneUnit.Power);
-        SelectedCell := nil;
-      end;
-    end else
-    if not Assigned(SelectedCell) and (NewSelectedCell <> SelectedCell) and (NewSelectedCell.MapCell.Player = Player) then begin
-      SelectedCell := NewSelectedCell
-    end else
-    if (NewSelectedCell = SelectedCell) and (NewSelectedCell.MapCell.Player = Player) then begin
-      SelectedCell := nil;
-    end;
-  end;
-end;
-
-procedure TView.CenterMap;
-var
-  MapRect: TRect;
-begin
-  MapRect := TGame(Game).Map.PixelRect;
-  SourceRect := TRect.CreateBounds(TPoint.Create(MapRect.P1.X + MapRect.Size.X div 2 - SourceRect.Size.X div 2,
-    MapRect.P1.Y + MapRect.Size.Y div 2 - SourceRect.Size.Y div 2),
-    TPoint.Create(SourceRect.Size.X,
-    SourceRect.Size.Y));
-end;
-
-procedure TView.CenterPlayerCity(Player: TPlayer);
-begin
-  SourceRect := TRect.CreateBounds(TPoint.Create(Player.StartCell.PosPx.X - SourceRect.Size.X div 2,
-    Player.StartCell.PosPx.Y - SourceRect.Size.Y div 2),
-    TPoint.Create(SourceRect.Size.X,
-    SourceRect.Size.Y));
-end;
-
-procedure TView.ZoomAll;
-var
-  Factor: TPointF;
-  MapRect: TRect;
-  NewZoom: Single;
-begin
-  MapRect := TGame(Game).Map.CalculatePixelRect;
-  Factor := TPointF.Create(DestRect.Size.X / MapRect.Size.X,
-    DestRect.Size.Y / MapRect.Size.Y);
-  if Factor.X < Factor.Y then NewZoom := Factor.X
-    else NewZoom := Factor.Y;
-  if NewZoom = 0 then NewZoom := 1;
-  Zoom := NewZoom * 0.9;
-  CenterMap;
-end;
-
-function TView.IsCellVisible(Cell: TCell): Boolean;
-var
-  RectPolygon: TRect;
-begin
-  RectPolygon := CellToCanvasRect(Cell.Polygon.GetRect);
-  Result := (
-    (RectPolygon.P1.X < DestRect.Size.X) and
-    (RectPolygon.P2.X > 0) and
-    (RectPolygon.P1.Y < DestRect.Size.Y) and
-    (RectPolygon.P2.Y > 0)
-  );
-end;
-
 end.
 

trunk/Forms/FormClient.pas

@@ -7 +7 @@
   Game, LCLType, Menus, ActnList, ComCtrls, dateutils, XMLConf, DOM, Math,
   Geometry, GameClient, GameProtocol, Threading, Player, ClientGUI, FormEx,
-  Generics.Collections;
+  Generics.Collections, View;
 
 const
@@ -75 +75 @@
     FClient: TClientGUI;
     TempBitmap: TBitmap;
+    TempView: TView;
     StartMousePoint: TPoint;
     StartViewPoint: TPoint;
@@ -186 +187 @@
   CountP: TPoint;
   X, Y: Integer;
-  TempView: TView;
 begin
   DrawStart := Now;
@@ -205 +205 @@
 
       if Game.CyclicMap then begin
-        TempView := TView.Create;
         TempView.Game := Game;
         //R := View.CellToCanvasRect(TRect.Create(Game.Map.Cells.First.PosPx,
@@ -278 +277 @@
           end;
         end;
-        TempView.Free;
         for Y := 0 to CountP.Y do begin
           for X := 0 to CountP.X do begin
@@ -432 +430 @@
   //DoubleBuffered := True;
   TempBitmap := TBitmap.Create;
+  TempView := TView.Create;
   TimerPeriod := 0;
   LastTimerTime := Now;
@@ -518 +517 @@
 begin
   Client := nil;
-  TempBitmap.Free;
+  FreeAndNil(TempBitmap);
+  FreeAndNil(TempView);
 end;
 

trunk/Languages/xtactics.cs.po

@@ -10 +10 @@
 "Content-Type: text/plain; charset=UTF-8\n"
 "Content-Transfer-Encoding: 8bit\n"
-"X-Generator: Poedit 3.5\n"
+"X-Generator: Poedit 3.4.2\n"
 
 #: building.sbonusattack
@@ -62 +62 @@
 msgid "Wrong arrow angle %s"
 msgstr "Nesprávný úhel šipky %s"
-
-#: clientgui.szerozoomnotalowed
-msgctxt "clientgui.szerozoomnotalowed"
-msgid "Zero zoom not allowed"
-msgstr "Nulové přiblížení není povoleno"
 
 #: core.sendgame
@@ -1258 +1253 @@
 msgstr "Dohled"
 
+#: view.szerozoomnotalowed
+msgctxt "view.szerozoomnotalowed"
+msgid "Zero zoom not allowed"
+msgstr "Nulové přiblížení není povoleno"

trunk/Languages/xtactics.pot

@@ -51 +51 @@
 msgctxt "clientgui.swrongarrowangle"
 msgid "Wrong arrow angle %s"
-msgstr ""
-
-#: clientgui.szerozoomnotalowed
-msgctxt "clientgui.szerozoomnotalowed"
-msgid "Zero zoom not allowed"
 msgstr ""
 
@@ -1221 +1216 @@
 msgstr ""
 
+#: view.szerozoomnotalowed
+msgctxt "view.szerozoomnotalowed"
+msgid "Zero zoom not allowed"
+msgstr ""
+

trunk/xtactics.lpi

@@ -114 +114 @@
       </Item7>
     </RequiredPackages>
-    <Units Count="36">
+    <Units Count="37">
       <Unit0>
         <Filename Value="xtactics.lpr"/>
@@ -301 +301 @@
         <IsPartOfProject Value="True"/>
       </Unit35>
+      <Unit36>
+        <Filename Value="View.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit36>
     </Units>
   </ProjectOptions>

trunk/xtactics.lpr

@@ -9 +9 @@
   { you can add units after this },
   SysUtils, FormMain, CoolStreaming, Tests, TurnStats, UnitKind,
-  PinConnectionPackage;
+  PinConnectionPackage, View;
 
 {$R *.res}