Changeset 273


Ignore:
Timestamp:
Jan 30, 2019, 8:08:44 AM (6 years ago)
Author:
chronos
Message:
  • Added: Show units shape to see in which cell units are placed.
  • Fixed: Do not place units with zero power in zero power cells.
  • Fixed: Better checks of cell power if cell is without unit.
Location:
trunk
Files:
12 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UFormClient.pas

    r269 r273  
    347347    FClient.OnNextPlayer := DoNextPlayer;
    348348    FClient.View.DestRect := TRect.CreateBounds(TPoint.Create(0, 0), TPoint.Create(PaintBox1.Width, PaintBox1.Height));
    349     FClient.ShowCellGrid := Core.ShowCellGrid;
     349    FClient.CellGridVisible := Core.CellGridVisible;
     350    FClient.UnitShapeVisible := Core.UnitShapeVisible;
    350351  end;
    351352  Redraw;

  • trunk/Forms/UFormMain.lfm

    r268 r273  
    149149        Action = AMapGridVisible
    150150      end
     151      object MenuItem34: TMenuItem
     152        Action = AUnitShapeVisible
     153      end
     154      object MenuItem35: TMenuItem
     155        Caption = '-'
     156      end
    151157      object MenuItem21: TMenuItem
    152158        Action = AToolBarVisible
    … …  
    225231      OnExecute = AMapGridVisibleExecute
    226232    end
     233    object AUnitShapeVisible: TAction
     234      Caption = 'Unit shape visible'
     235      OnExecute = AUnitShapeVisibleExecute
     236    end
    227237  end
    228238  object PopupMenuToolbar: TPopupMenu

  • trunk/Forms/UFormMain.pas

    r268 r273  
    1818
    1919  TFormMain = class(TForm)
     20    AUnitShapeVisible: TAction;
    2021    AMapGridVisible: TAction;
    2122    AStatusBarVisible: TAction;
    … …  
    4950    MenuItem32: TMenuItem;
    5051    MenuItem33: TMenuItem;
     52    MenuItem34: TMenuItem;
     53    MenuItem35: TMenuItem;
    5154    MenuItemDebug: TMenuItem;
    5255    MenuItem31: TMenuItem;
    … …  
    7679    procedure AToolBarBigIconsExecute(Sender: TObject);
    7780    procedure AToolBarVisibleExecute(Sender: TObject);
     81    procedure AUnitShapeVisibleExecute(Sender: TObject);
    7882    procedure FormActivate(Sender: TObject);
    7983    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    … …  
    201205end;
    202206
     207procedure TFormMain.AUnitShapeVisibleExecute(Sender: TObject);
     208begin
     209  AUnitShapeVisible.Checked := not AUnitShapeVisible.Checked;
     210  UpdateClientForms;
     211end;
     212
    203213procedure TFormMain.FormActivate(Sender: TObject);
    204214begin
    … …  
    220230  Core.PersistentForm.Save(Self);
    221231  SaveConfig(Core.XMLConfig1, 'FormMain');
    222   Core.ShowCellGrid := AMapGridVisible.Checked;
     232  Core.CellGridVisible := AMapGridVisible.Checked;
     233  Core.UnitShapeVisible := AUnitShapeVisible.Checked;
    223234  Core.Done;
    224235end;
    … …  
    244255  FormClient.AStatusBarVisible.Checked := AStatusBarVisible.Checked;
    245256  FormClient.AStatusBarVisible.Update;
    246   Core.ShowCellGrid := AMapGridVisible.Checked;
    247   if Assigned(FormClient.Client) then
    248     FormClient.Client.ShowCellGrid := Core.ShowCellGrid;
     257  Core.CellGridVisible := AMapGridVisible.Checked;
     258  Core.UnitShapeVisible := AUnitShapeVisible.Checked;
     259  if Assigned(FormClient.Client) then begin
     260    FormClient.Client.CellGridVisible := Core.CellGridVisible;
     261    FormClient.Client.UnitShapeVisible := Core.UnitShapeVisible;
     262  end;
    249263  FormClient.Redraw;
    250264  for I := 0 to Core.FormClients.Count - 1 do begin
    … …  
    255269    Core.FormClients[I].AStatusBarVisible.Checked := AStatusBarVisible.Checked;
    256270    Core.FormClients[I].AStatusBarVisible.Update;
    257     if Assigned(Core.FormClients[I].Client) then
    258       Core.FormClients[I].Client.ShowCellGrid := Core.ShowCellGrid;
     271    if Assigned(Core.FormClients[I].Client) then begin
     272      Core.FormClients[I].Client.CellGridVisible := Core.CellGridVisible;
     273      Core.FormClients[I].Client.UnitShapeVisible := Core.UnitShapeVisible;
     274    end;
    259275    Core.FormClients[I].Redraw;
    260276  end;
    … …  
    265281  if not FormShown then begin
    266282    Core.LoadConfig;
    267     AMapGridVisible.Checked := Core.ShowCellGrid;
     283    AMapGridVisible.Checked := Core.CellGridVisible;
     284    AUnitShapeVisible.Checked := Core.UnitShapeVisible;
    268285    Core.ScaleDPI;
    269286    Core.PersistentForm.Load(Self, True);

  • trunk/Forms/UFormNew.lfm

    r270 r273  
    2121    Top = 4
    2222    Width = 806
    23     ActivePage = TabSheetMap
     23    ActivePage = TabSheetRules
    2424    Align = alClient
    2525    BorderSpacing.Around = 4
    26     TabIndex = 2
     26    TabIndex = 3
    2727    TabOrder = 0
    2828    OnChange = PageControl1Change
    … …  
    326326        object ComboBoxGridType: TComboBox
    327327          Left = 146
    328           Height = 38
     328          Height = 42
    329329          Top = 104
    330330          Width = 208
    … …  
    343343        object ComboBoxMapShape: TComboBox
    344344          Left = 146
    345           Height = 38
     345          Height = 42
    346346          Top = 144
    347347          Width = 208
    … …  
    546546      object Panel4: TPanel
    547547        Left = 0
    548         Height = 655
     548        Height = 652
    549549        Top = 0
    550         Width = 739
     550        Width = 796
    551551        Align = alClient
    552552        BevelOuter = bvNone
    553         ClientHeight = 655
    554         ClientWidth = 739
     553        ClientHeight = 652
     554        ClientWidth = 796
    555555        TabOrder = 0
    556556        object RadioGroupGrowCells: TRadioGroup
    … …  
    587587        object ComboBoxWinObjective: TComboBox
    588588          Left = 224
    589           Height = 38
     589          Height = 42
    590590          Top = 244
    591591          Width = 328
    … …  
    635635          Height = 78
    636636          Top = 290
    637           Width = 716
     637          Width = 773
    638638          ActivePage = TabSheetCaptureEntireMap
    639639          Anchors = [akTop, akLeft, akRight]
    … …  
    647647          object TabSheetCaptureCells: TTabSheet
    648648            ClientHeight = 74
    649             ClientWidth = 712
     649            ClientWidth = 763
    650650            object Label14: TLabel
    651651              Left = 8
    … …  
    669669          object TabSheetStayAliveTurns: TTabSheet
    670670            ClientHeight = 74
    671             ClientWidth = 712
     671            ClientWidth = 763
    672672            object Label13: TLabel
    673673              Left = 8

  • trunk/Forms/UFormNew.pas

    r271 r273  
    417417  Client.View.ZoomAll;
    418418  //Client.ControlPlayer := GamePreview.Players.First;
    419   Client.ShowCellGrid := True;
     419  Client.CellGridVisible := True;
    420420  Bitmap.Canvas.Brush.Color := MapBackgroundColor; //clBackground; //PaintBox1.GetColorResolvingParent;
    421421  Bitmap.Canvas.FillRect(0, 0, Bitmap.Width, Bitmap.Height);

  • trunk/Languages/xtactics.cs.po

    r272 r273  
    247247msgid "Toolbar visible"
    248248msgstr "Viditelný nástrojový panel"
     249
     250#: tformmain.aunitshapevisible.caption
     251msgid "Unit shape visible"
     252msgstr "Obrys jednotek viditelný"
    249253
    250254#: tformmain.caption

  • trunk/Languages/xtactics.po

    r272 r273  
    236236msgctxt "tformmain.atoolbarvisible.caption"
    237237msgid "Toolbar visible"
     238msgstr ""
     239
     240#: tformmain.aunitshapevisible.caption
     241msgid "Unit shape visible"
    238242msgstr ""
    239243

  • trunk/UClientAI.pas

    r265 r273  
    111111  TargetCell: TPlayerCell;
    112112  NeighborCell: TPlayerCell;
     113  DefendCount: Integer;
    113114begin
    114115if ControlPlayer.Defensive then Exit;
    … …  
    144145      end;
    145146      // Attack if target is weaker
    146       if Game.AttackProbability(TotalPower, TargetCell.MapCell.OneUnit.Power) >=
     147      if Assigned(TargetCell.MapCell.OneUnit) then
     148        DefendCount := TargetCell.MapCell.OneUnit.Power
     149        else DefendCount := 0;
     150      if Game.AttackProbability(TotalPower, DefendCount) >=
    147151        ComputerAggroProbability[ControlPlayer.Agressivity] then begin
    148152        // Try to limit total attacking power to necessary minimum
    149         while Game.AttackProbability(TotalPower - 1, TargetCell.MapCell.OneUnit.Power) >=
     153        while Game.AttackProbability(TotalPower - 1, DefendCount) >=
    150154          ComputerAggroProbability[ControlPlayer.Agressivity] do
    151155          Dec(TotalPower);

  • trunk/UClientGUI.pas

    r270 r273  
    4949  public
    5050    View: TView;
    51     ShowCellGrid: Boolean;
     51    CellGridVisible: Boolean;
     52    UnitShapeVisible: Boolean;
    5253    procedure DrawArrow(Canvas: TCanvas; Pos: TPoint; Angle: Double;
    5354      Text: string; View: TView);
    … …  
    110111  Points: array of Classes.TPoint;
    111112  TextSize: TSize;
     113  R: Integer;
    112114begin
    113115  if Cell.MapCell.Extra = etObjectiveTarget then begin
    … …  
    118120    //Pen.Style := psClear;
    119121    Pen.Style := psSolid;
    120     if ShowCellGrid then begin
     122    if CellGridVisible then begin
    121123      Pen.Color := clBlack;
    122124      Pen.Width := Round(2 * View.Zoom);
    … …  
    144146        Round(TextPos.Y) - TextSize.cy div 2, Text, False);
    145147    end;
     148    if UnitShapeVisible and Assigned(Cell.MapCell.OneUnit) then begin
     149      TextPos := View.CellToCanvasPos(Pos);
     150      R := Trunc(70 * View.Zoom);
     151      Pen.Color := clWhite;
     152      Pen.Style := psSolid;
     153      Pen.Width := Round(10 * View.Zoom);
     154      Brush.Style := bsClear;
     155      TCanvasEx.Ellipse(Canvas, TRect.Create(
     156        TPoint.Create(TextPos.X - R, TextPos.Y - R),
     157        TPoint.Create(TextPos.X + R, TextPos.Y + R)
     158      ));
     159    end;
    146160  end;
    147161end;
    … …  
    154168  Points: array of Classes.TPoint;
    155169  TextSize: TSize;
     170  R: Integer;
    156171begin
    157172  if Cell.Extra = etObjectiveTarget then begin
    … …  
    188203
    189204    // Show cell text
    190     if (Cell.OneUnit.Power <> 0) or (Cell.Extra = etObjectiveTarget) then begin
     205    if Assigned(Cell.OneUnit) and (Cell.OneUnit.Power <> 0) or
     206      (Cell.Extra = etObjectiveTarget) then begin
    191207      Pen.Style := psSolid;
    192208      Font.Color := clWhite;
    … …  
    197213      TCanvasEx.TextOutEx(Canvas, Round(TextPos.X) - TextSize.cx div 2,
    198214        Round(TextPos.Y) - TextSize.cy div 2, Text, False);
     215    end;
     216    if UnitShapeVisible and Assigned(Cell.OneUnit) then begin
     217      TextPos := View.CellToCanvasPos(Pos);
     218      R := Trunc(70 * View.Zoom);
     219      Pen.Color := clWhite;
     220      Pen.Style := psSolid;
     221      Pen.Width := Round(10 * View.Zoom);
     222      Brush.Style := bsClear;
     223      TCanvasEx.Ellipse(Canvas, TRect.Create(
     224        TPoint.Create(TextPos.X - R, TextPos.Y - R),
     225        TPoint.Create(TextPos.X + R, TextPos.Y + R)
     226      ));
    199227    end;
    200228  end;

  • trunk/UCore.pas

    r268 r273  
    9595    DevelMode: Boolean;
    9696    AnimationSpeed: Integer;
    97     ShowCellGrid: Boolean;
     97    CellGridVisible: Boolean;
     98    UnitShapeVisible: Boolean;
    9899    AutoSaveEnabled: Boolean;
    99100    ReopenLastFile: Boolean;
    … …  
    203204  ScaleDPI1.AutoDetect := XMLConfig1.GetValue('DPIAuto', True);
    204205  FormNewTabIndex := XMLConfig1.GetValue('FormNewTabIndex', 0);
    205   ShowCellGrid := XMLConfig1.GetValue('ShowCellGrid', True);
     206  CellGridVisible := XMLConfig1.GetValue('CellGridVisible', True);
     207  UnitShapeVisible := XMLConfig1.GetValue('UnitShapeVisible', False);
    206208end;
    207209
    … …  
    219221  XMLConfig1.SetValue('DPIAuto', ScaleDPI1.AutoDetect);
    220222  XMLConfig1.SetValue('FormNewTabIndex', FormNewTabIndex);
    221   XMLConfig1.SetValue('ShowCellGrid', ShowCellGrid);
     223  XMLConfig1.SetValue('CellGridVisible', CellGridVisible);
     224  XMLConfig1.SetValue('UnitShapeVisible', UnitShapeVisible);
    222225end;
    223226

  • trunk/UGame.pas

    r271 r273  
    2424    class procedure PolygonEx(Canvas: TCanvas; const Points: array of Classes.TPoint; Winding: Boolean);
    2525    class procedure PolyLineEx(Canvas: TCanvas; const Points: array of Classes.TPoint);
     26    class procedure Ellipse(Canvas: TCanvas; const ARect: TRect);
    2627  end;
    2728
    … …  
    191192end;
    192193
     194class procedure TCanvasEx.Ellipse(Canvas: TCanvas; const ARect: TRect);
     195begin
     196  LCLIntf.Ellipse(Canvas.Handle, ARect.P1.X, ARect.P1.Y, ARect.P2.X, ARect.P2.Y);
     197end;
     198
    193199{ TGame }
    194200
    … …  
    289295var
    290296  Cell: TCell;
     297  NewPower: Integer;
    291298begin
    292299  // Randomize map terrain
    … …  
    296303    (Map.IsOutsideShape(PosPx)) then Terrain := ttVoid
    297304      else Terrain := ttNormal;
    298     if not Assigned(OneUnit) then
    299       OneUnit := Units.AddNew(GameSystem.UnitKinds[0], Random(MaxNeutralUnits + 1));
     305    NewPower := Random(MaxNeutralUnits + 1);
     306    if (NewPower > 0) and not Assigned(OneUnit) then begin
     307      OneUnit := Units.AddNew(GameSystem.UnitKinds[0], NewPower);
     308    end;
    300309    Player := nil;
    301310  end;
    … …  
    512521    SetValue(DOMString(Path + '/StayAliveForDefinedTurns'), StayAliveForDefinedTurns);
    513522    SetValue(DOMString(Path + '/SpecialCaptureCellCount'), SpecialCaptureCellCount);
     523    SetValue(DOMString(Path + '/MaxNeutralUnits'), MaxNeutralUnits);
     524    SetValue(DOMString(Path + '/MaxPower'), MaxPower);
    514525    Players.SaveConfig(Config, Path + '/Players');
    515526  end;
    … …  
    548559    StayAliveForDefinedTurns := GetValue(DOMString(Path + '/StayAliveForDefinedTurns'), 20);
    549560    SpecialCaptureCellCount := GetValue(DOMString(Path + '/SpecialCaptureCellCount'), 1);
     561    MaxNeutralUnits := GetValue(DOMString(Path + '/MaxNeutralUnits'), 5);
     562    MaxPower := GetValue(DOMString(Path + '/MaxPower'), 99);
    550563    Players.LoadConfig(Config, Path + '/Players');
    551564  end;
    … …  
    730743  CurrentPlayer.Grow;
    731744  CurrentPlayer.UpdateEmptyCellsNeutral;
     745  CurrentPlayer.RemoveEmptyUnits;
    732746  CurrentPlayer.UpdateRepeatMoves;
    733747  ComputePlayerStats;

  • trunk/UPlayer.pas

    r265 r273  
    122122    procedure ReduceMovesPower;
    123123    procedure RemoveInvalidMoves;
     124    procedure RemoveEmptyUnits;
    124125    procedure UpdateRepeatMoves;
    125126    procedure UpdateEmptyCellsNeutral;
    … …  
    10591060    if Moves[I].CellFrom.MapCell.Player <> Self then
    10601061      Moves.Delete(I);
     1062end;
     1063
     1064procedure TPlayer.RemoveEmptyUnits;
     1065var
     1066  I: Integer;
     1067  OneUnit: TUnit;
     1068begin
     1069  for I := 0 to PlayerMap.Cells.Count - 1 do
     1070  with TPlayerCell(PlayerMap.Cells[I]) do begin
     1071    if Assigned(MapCell.OneUnit) and (MapCell.OneUnit.Power = 0) then begin
     1072      OneUnit := MapCell.OneUnit;
     1073      MapCell.OneUnit := nil;
     1074      Units.Remove(OneUnit);
     1075    end;
     1076  end;
    10611077end;
    10621078
    … …  
    11541170  for I := 0 to PlayerMap.Cells.Count - 1 do
    11551171  with TPlayerCell(PlayerMap.Cells[I]) do begin
    1156     if MapCell.OneUnit.Power = 0 then MapCell.Player := nil;
     1172    if Assigned(MapCell.OneUnit) and (MapCell.OneUnit.Power = 0) then
     1173      MapCell.Player := nil;
    11571174  end;
    11581175end;
Note: See TracChangeset for help on using the changeset viewer.