Changeset 184 for trunk/UGame.pas


Ignore:
Timestamp:
Feb 12, 2018, 12:44:04 PM (7 years ago)
Author:
chronos
Message:
  • Modified: Game server and client splitted to units separate from game classes.
File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/UGame.pas

    r183 r184  
    88  Classes, SysUtils, ExtCtrls, Graphics, XMLConf, XMLRead, XMLWrite, Forms,
    99  DOM, Math, LazFileUtils, UXMLUtils, Dialogs, Types, LCLType, LCLIntf, fgl,
    10   UGeometry, UGameSocket;
     10  UGeometry;
    1111
    1212const
     
    2929  TCellLinks = class;
    3030  TMapArea = class;
    31   TClient = class;
    32   TServer = class;
    3331
    3432  TTerrainType = (ttVoid, ttNormal, ttCity);
     
    292290  TUnitMove = class;
    293291
     292  TMoveEvent = procedure(CellFrom, CellTo: TCell; var CountOnce, CountRepeat: Integer;
     293    Update: Boolean; var Confirm: Boolean) of object;
     294
    294295  { TPlayer }
    295296
    296297  TPlayer = class
    297298  private
    298     FClient: TClient;
    299299    FGame: TGame;
    300300    FMode: TPlayerMode;
    301     procedure SetClient(AValue: TClient);
     301    FOnMove: TMoveEvent;
    302302    procedure SetGame(AValue: TGame);
    303303    procedure Attack(var AttackPower, DefendPower: Integer);
     
    337337    procedure SaveConfig(Config: TXmlConfig; Path: string);
    338338    property Game: TGame read FGame write SetGame;
    339     property Client: TClient read FClient write SetClient;
    340339    property Mode: TPlayerMode read FMode write SetMode;
     340    property OnMove: TMoveEvent read FOnMove write FOnMove;
    341341  end;
    342342
     
    415415  end;
    416416
    417   TMoveEvent = procedure(CellFrom, CellTo: TCell; var CountOnce, CountRepeat: Integer;
    418     Update: Boolean; var Confirm: Boolean) of object;
    419 
    420   { TClient }
    421 
    422   TClient = class
    423   private
    424     FForm: TForm;
    425     FGame: TGame;
    426     FControlPlayer: TPlayer;
    427     FOnChange: TNotifyEvent;
    428     FOnReceive: TReceiveEvent;
    429     FOnMove: TMoveEvent;
    430     procedure SetControlPlayer(AValue: TPlayer);
    431     procedure SetForm(AValue: TForm);
    432     procedure SetGame(AValue: TGame);
    433     procedure DoChange;
    434   public
    435     Name: string;
    436     View: TView;
    437     GameSocket: TGameSocket;
    438     procedure Send(Command: TCommand; DataOut, DataIn: Pointer);
    439     constructor Create;
    440     destructor Destroy; override;
    441     property ControlPlayer: TPlayer read FControlPlayer write SetControlPlayer;
    442     property Game: TGame read FGame write SetGame;
    443     property Form: TForm read FForm write SetForm;
    444     property OnMove: TMoveEvent read FOnMove write FOnMove;
    445     property OnReceive: TReceiveEvent read FOnReceive write FOnReceive;
    446     property OnChange: TNotifyEvent read FOnChange write FOnChange;
    447   end;
    448 
    449   { TClients }
    450 
    451   TClients = class(TFPGObjectList<TClient>)
    452     Game: TGame;
    453     function New(Name: string): TClient;
    454     constructor Create(FreeObjects: Boolean = True);
    455   end;
    456 
    457   { TGame }
    458 
    459417  TMoveUpdatedEvent = procedure(UnitMove: TUnitMove) of object;
    460418
     
    466424    woSpecialCaptureCell, woStayAliveForDefinedTurns);
    467425
     426  { TGame }
     427
    468428  TGame = class
    469429  private
    470430    FMapType: TMapType;
     431    FOnChange: TNotifyEvent;
    471432    FOnMoveUpdated: TMoveUpdatedEvent;
    472433    FOnNewTurn: TNotifyEvent;
    473434    FOnPlayerChange: TNotifyEvent;
     435    FOnStart: TNotifyEvent;
    474436    FOnWin: TWinEvent;
    475437    FRunning: Boolean;
     
    485447    procedure InitDefaultPlayersSetting;
    486448  public
    487     Server: TServer;
    488449    DevelMode: Boolean;
    489450    Players: TPlayers;
     
    527488    property OnNewTurn: TNotifyEvent read FOnNewTurn write FOnNewTurn;
    528489    property OnPlayerChange: TNotifyEvent read FOnPlayerChange write FOnPlayerChange;
    529   end;
    530 
    531   TServerMode = (smLocal, smNetworkServer, smNetworkClient);
    532 
    533   { TServer }
    534 
    535   TServer = class
    536   private
    537     FActive: Boolean;
    538     FGame: TGame;
    539     FServerMode: TServerMode;
    540     procedure SetActive(AValue: Boolean);
    541     procedure SetGame(AValue: TGame);
    542     procedure SetServerMode(AValue: TServerMode);
    543     procedure DoChange;
    544   public
    545     Clients: TClients;
    546     LocalNetworkAddress: string;
    547     LocalNetworkPort: Word;
    548     RemoteNetworkAddress: string;
    549     RemoteNetworkPort: Word;
    550     GameSocket: TGameSocket;
    551     procedure LoadConfig(Config: TXmlConfig; Path: string);
    552     procedure SaveConfig(Config: TXmlConfig; Path: string);
    553     procedure InitClients;
    554     procedure Clear;
    555     constructor Create;
    556     destructor Destroy; override;
    557     property Game: TGame read FGame write SetGame;
    558     property Mode: TServerMode read FServerMode write SetServerMode;
    559     property Active: Boolean read FActive write SetActive;
     490    property OnStart: TNotifyEvent read FOnStart write FOnStart;
     491    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    560492  end;
    561493
     
    610542end;
    611543
     544function ComparePointer(const Item1, Item2: Integer): Integer;
     545begin
     546  Result := -CompareValue(Item1, Item2);
     547end;
     548
     549
    612550{ TGameTurnStat }
    613551
     
    655593    TGameTurnStat(Items[I]).SaveToNode(NewNode);
    656594  end;
    657 end;
    658 
    659 { TClients }
    660 
    661 function TClients.New(Name: string): TClient;
    662 begin
    663   Result := TClient.Create;
    664   Result.Game := Game;
    665   Result.Name := Name;
    666   Add(Result);
    667 end;
    668 
    669 constructor TClients.Create(FreeObjects: Boolean = True);
    670 begin
    671   Game := nil;
    672   inherited;
    673 end;
    674 
    675 { TClient }
    676 
    677 procedure TClient.SetGame(AValue: TGame);
    678 begin
    679   if FGame = AValue then Exit;
    680   FGame := AValue;
    681   View.Game := AValue;
    682 end;
    683 
    684 procedure TClient.DoChange;
    685 begin
    686   if Assigned(FOnChange) then
    687     FOnChange(Self);
    688 end;
    689 
    690 procedure TClient.Send(Command: TCommand; DataOut, DataIn: Pointer);
    691 begin
    692 end;
    693 
    694 procedure TClient.SetControlPlayer(AValue: TPlayer);
    695 begin
    696   if FControlPlayer = AValue then Exit;
    697   if Assigned(FControlPlayer) then
    698     FControlPlayer.FClient := nil;
    699   FControlPlayer := AValue;
    700   if Assigned(FControlPlayer) then
    701      FControlPlayer.FClient := Self;
    702 end;
    703 
    704 procedure TClient.SetForm(AValue: TForm);
    705 begin
    706   if FForm = AValue then Exit;
    707   FForm := AValue;
    708 end;
    709 
    710 constructor TClient.Create;
    711 begin
    712   View := TView.Create;
    713 end;
    714 
    715 destructor TClient.Destroy;
    716 begin
    717   ControlPlayer := nil;
    718   FreeAndNil(View);
    719   inherited Destroy;
    720595end;
    721596
     
    21622037end;
    21632038
    2164 { TPlayer }
     2039{ TView }
    21652040
    21662041function TView.CanvasToCellPos(Pos: TPoint): TPoint;
     
    21972072end;
    21982073
     2074{ TPlayer }
     2075
    21992076procedure TPlayer.SetGame(AValue: TGame);
    22002077begin
     
    22112088end;
    22122089
    2213 procedure TPlayer.SetClient(AValue: TClient);
    2214 begin
    2215   if FClient=AValue then Exit;
     2090{procedure TPlayer.SetClient(AValue: TClient);
     2091begin
     2092  if FClient = AValue then Exit;
    22162093  if Assigned(FClient) then FClient.FControlPlayer := nil;
    22172094  FClient := AValue;
    22182095  if Assigned(FClient) then FClient.FControlPlayer := Self;
    22192096end;
     2097}
    22202098
    22212099procedure TPlayer.LoadFromNode(Node: TDOMNode);
     
    22792157end;
    22802158
     2159procedure TPlayer.Paint(Canvas: TCanvas; View: TView);
     2160begin
     2161  PlayerMap.Paint(Canvas, View);
     2162end;
     2163
     2164constructor TPlayer.Create;
     2165begin
     2166  Moves := TUnitMoves.Create;
     2167  StartUnits := DefaultPlayerStartUnits;
     2168  StartCell := nil;
     2169  PlayerMap := TPlayerMap.Create;
     2170  PlayerMap.Player := Self;
     2171  TurnStats := TGameTurnStats.Create;
     2172  Computer := TComputer.Create;
     2173  Computer.Player := Self;
     2174end;
     2175
     2176destructor TPlayer.Destroy;
     2177begin
     2178  //Client := nil;
     2179  FreeAndNil(Computer);
     2180  FreeAndNil(TurnStats);
     2181  FreeAndNil(PlayerMap);
     2182  FreeAndNil(Moves);
     2183  inherited Destroy;
     2184end;
     2185
     2186procedure TPlayer.Assign(Source: TPlayer);
     2187begin
     2188  Id := Source.Id;
     2189  Name := Source.Name;
     2190  Color := Source.Color;
     2191  Mode := Source.Mode;
     2192  Game := Source.Game;
     2193  TotalCells := Source.TotalCells;
     2194  TotalUnits := Source.TotalUnits;
     2195  StartUnits := Source.StartUnits;
     2196  StartCell := Source.StartCell;
     2197  Agressivity := Source.Agressivity;
     2198  Defensive := Source.Defensive;
     2199  Computer.Game := Source.Computer.Game;
     2200  Computer.CellProcessDirection := Source.Computer.CellProcessDirection;
     2201end;
     2202
     2203procedure TPlayer.LoadConfig(Config: TXmlConfig; Path: string);
     2204begin
     2205  with Config do begin
     2206    Self.Name := string(GetValue(DOMString(Path + '/Name'), ''));
     2207    Color := TColor(GetValue(DOMString(Path + '/Color'), 0));
     2208    StartUnits := GetValue(DOMString(Path + '/StartUnits'), 5);
     2209    Mode := TPlayerMode(GetValue(DOMString(Path + '/Mode'), 0));
     2210    Defensive := GetValue(DOMString(Path + '/Defensive'), False);
     2211    Agressivity := TComputerAgressivity(GetValue(DOMString(Path + '/Agressivity'), 0));
     2212  end;
     2213end;
     2214
     2215procedure TPlayer.SaveConfig(Config: TXmlConfig; Path: string);
     2216begin
     2217  with Config do begin
     2218    SetValue(DOMString(Path + '/Name'), DOMString(Self.Name));
     2219    SetValue(DOMString(Path + '/Color'), Integer(Color));
     2220    SetValue(DOMString(Path + '/StartUnits'), StartUnits);
     2221    SetValue(DOMString(Path + '/Mode'), Integer(Mode));
     2222    SetValue(DOMString(Path + '/Defensive'), Defensive);
     2223    SetValue(DOMString(Path + '/Agressivity'), Integer(Agressivity));
     2224  end;
     2225end;
     2226
     2227procedure TPlayer.Attack(var AttackPower, DefendPower: Integer);
     2228var
     2229  AttackerDiceCount: Integer;
     2230  DefenderDiceCount: Integer;
     2231  S: string;
     2232  I: Integer;
     2233  AttackRolls: TFPGList<Integer>;
     2234  DefendRolls: TFPGList<Integer>;
     2235begin
     2236  AttackRolls := TFPGList<Integer>.Create;
     2237  DefendRolls := TFPGList<Integer>.Create;
     2238  if AttackPower < 1 then
     2239    raise Exception.Create(SAttackerPowerPositive);
     2240  if DefendPower < 0 then
     2241    raise Exception.Create(SDefenderPowerPositive);
     2242  while (AttackPower > 0) and (DefendPower > 0) do begin
     2243    // Risk game rules:
     2244    // Each side do their dice roll and compare result. Defender wins tie.
     2245    // Attacker can use three dices and defender two
     2246    AttackerDiceCount := Min(AttackPower, 3);
     2247    DefenderDiceCount := Min(DefendPower, 2);
     2248    // Roll and sort numbers
     2249    AttackRolls.Count := AttackerDiceCount;
     2250    for I := 0 to AttackerDiceCount - 1 do begin
     2251      AttackRolls[I] := Random(7);
     2252    end;
     2253    AttackRolls.Sort(ComparePointer);
     2254    S := 'Att:';
     2255    for I := 0 to AttackerDiceCount - 1 do
     2256      S := S + IntToStr(Integer(AttackRolls[I])) + ', ';
     2257    DefendRolls.Count := DefenderDiceCount;
     2258    for I := 0 to DefenderDiceCount - 1 do begin
     2259      DefendRolls[I] := Random(7);
     2260    end;
     2261    DefendRolls.Sort(ComparePointer);
     2262    S := S + ' Def:';
     2263    for I := 0 to DefenderDiceCount - 1 do
     2264      S := S + IntToStr(Integer(DefendRolls[I])) + ', ';
     2265    // Resolution
     2266    for I := 0 to Min(AttackerDiceCount, DefenderDiceCount) - 1 do
     2267      if AttackRolls[I] > DefendRolls[I] then Dec(DefendPower)
     2268      else Dec(AttackPower);
     2269  end;
     2270  FreeAndNil(AttackRolls);
     2271  FreeAndNil(DefendRolls);
     2272end;
     2273
    22812274function CellCompare(const Item1, Item2: TCell): Integer;
    22822275begin
     
    22922285  else Result := 0;
    22932286end;
     2287
     2288{ TComputer }
    22942289
    22952290procedure TComputer.AttackNeutral;
     
    23652360  NeighborCell: TCell;
    23662361begin
    2367   if Game.CurrentPlayer.Defensive then Exit;
     2362  if Player.Defensive then Exit;
    23682363
    23692364  AllCells := Game.Map.Cells;
     
    25902585  end;
    25912586end;
     2587
     2588{ TView }
    25922589
    25932590procedure TView.SelectCell(Pos: TPoint; Player: TPlayer; ShiftState: TShiftState);
     
    26502647end;
    26512648
    2652 procedure TPlayer.Paint(Canvas: TCanvas; View: TView);
    2653 begin
    2654   PlayerMap.Paint(Canvas, View);
    2655 end;
    2656 
    2657 constructor TPlayer.Create;
    2658 begin
    2659   Moves := TUnitMoves.Create;
    2660   StartUnits := DefaultPlayerStartUnits;
    2661   StartCell := nil;
    2662   PlayerMap := TPlayerMap.Create;
    2663   PlayerMap.Player := Self;
    2664   TurnStats := TGameTurnStats.Create;
    2665   Computer := TComputer.Create;
    2666   Computer.Player := Self;
    2667 end;
    2668 
    2669 destructor TPlayer.Destroy;
    2670 begin
    2671   Client := nil;
    2672   FreeAndNil(Computer);
    2673   FreeAndNil(TurnStats);
    2674   FreeAndNil(PlayerMap);
    2675   FreeAndNil(Moves);
    2676   inherited Destroy;
    2677 end;
    2678 
    2679 procedure TPlayer.Assign(Source: TPlayer);
    2680 begin
    2681   Id := Source.Id;
    2682   Name := Source.Name;
    2683   Color := Source.Color;
    2684   Mode := Source.Mode;
    2685   Game := Source.Game;
    2686   TotalCells := Source.TotalCells;
    2687   TotalUnits := Source.TotalUnits;
    2688   StartUnits := Source.StartUnits;
    2689   StartCell := Source.StartCell;
    2690   Agressivity := Source.Agressivity;
    2691   Defensive := Source.Defensive;
    2692   Computer.Game := Source.Computer.Game;
    2693   Computer.CellProcessDirection := Source.Computer.CellProcessDirection;
    2694 end;
    2695 
    2696 procedure TPlayer.LoadConfig(Config: TXmlConfig; Path: string);
    2697 begin
    2698   with Config do begin
    2699     Self.Name := string(GetValue(DOMString(Path + '/Name'), ''));
    2700     Color := TColor(GetValue(DOMString(Path + '/Color'), 0));
    2701     StartUnits := GetValue(DOMString(Path + '/StartUnits'), 5);
    2702     Mode := TPlayerMode(GetValue(DOMString(Path + '/Mode'), 0));
    2703     Defensive := GetValue(DOMString(Path + '/Defensive'), False);
    2704     Agressivity := TComputerAgressivity(GetValue(DOMString(Path + '/Agressivity'), 0));
    2705   end;
    2706 end;
    2707 
    2708 procedure TPlayer.SaveConfig(Config: TXmlConfig; Path: string);
    2709 begin
    2710   with Config do begin
    2711     SetValue(DOMString(Path + '/Name'), DOMString(Self.Name));
    2712     SetValue(DOMString(Path + '/Color'), Integer(Color));
    2713     SetValue(DOMString(Path + '/StartUnits'), StartUnits);
    2714     SetValue(DOMString(Path + '/Mode'), Integer(Mode));
    2715     SetValue(DOMString(Path + '/Defensive'), Defensive);
    2716     SetValue(DOMString(Path + '/Agressivity'), Integer(Agressivity));
    2717   end;
    2718 end;
    2719 
    27202649{ TGame }
    2721 
    2722 function ComparePointer(const Item1, Item2: Integer): Integer;
    2723 begin
    2724   Result := -CompareValue(Item1, Item2);
    2725 end;
    2726 
    2727 procedure TPlayer.Attack(var AttackPower, DefendPower: Integer);
    2728 var
    2729   AttackerDiceCount: Integer;
    2730   DefenderDiceCount: Integer;
    2731   S: string;
    2732   I: Integer;
    2733   AttackRolls: TFPGList<Integer>;
    2734   DefendRolls: TFPGList<Integer>;
    2735 begin
    2736   AttackRolls := TFPGList<Integer>.Create;
    2737   DefendRolls := TFPGList<Integer>.Create;
    2738   if AttackPower < 1 then
    2739     raise Exception.Create(SAttackerPowerPositive);
    2740   if DefendPower < 0 then
    2741     raise Exception.Create(SDefenderPowerPositive);
    2742   while (AttackPower > 0) and (DefendPower > 0) do begin
    2743     // Risk game rules:
    2744     // Each side do their dice roll and compare result. Defender wins tie.
    2745     // Attacker can use three dices and defender two
    2746     AttackerDiceCount := Min(AttackPower, 3);
    2747     DefenderDiceCount := Min(DefendPower, 2);
    2748     // Roll and sort numbers
    2749     AttackRolls.Count := AttackerDiceCount;
    2750     for I := 0 to AttackerDiceCount - 1 do begin
    2751       AttackRolls[I] := Random(7);
    2752     end;
    2753     AttackRolls.Sort(ComparePointer);
    2754     S := 'Att:';
    2755     for I := 0 to AttackerDiceCount - 1 do
    2756       S := S + IntToStr(Integer(AttackRolls[I])) + ', ';
    2757     DefendRolls.Count := DefenderDiceCount;
    2758     for I := 0 to DefenderDiceCount - 1 do begin
    2759       DefendRolls[I] := Random(7);
    2760     end;
    2761     DefendRolls.Sort(ComparePointer);
    2762     S := S + ' Def:';
    2763     for I := 0 to DefenderDiceCount - 1 do
    2764       S := S + IntToStr(Integer(DefendRolls[I])) + ', ';
    2765     // Resolution
    2766     for I := 0 to Min(AttackerDiceCount, DefenderDiceCount) - 1 do
    2767       if AttackRolls[I] > DefendRolls[I] then Dec(DefendPower)
    2768       else Dec(AttackPower);
    2769   end;
    2770   FreeAndNil(AttackRolls);
    2771   FreeAndNil(DefendRolls);
    2772 end;
    2773 
    2774 function TGame.AttackProbability(AttackCount, DefendCount: Integer): Double;
    2775 var
    2776   OA, OD: Integer;
    2777   Len: Integer;
    2778   I: Integer;
    2779 begin
    2780   if AttackCount = 0 then begin
    2781     Result := 0;
    2782     Exit;
    2783   end;
    2784   if DefendCount = 0 then begin
    2785     Result := 1;
    2786     Exit;
    2787   end;
    2788 
    2789   // Enlarge probability cache table on demand
    2790   if Length(ProbabilityMatrix) < AttackCount then begin
    2791     SetLength(ProbabilityMatrix, AttackCount);
    2792   end;
    2793   if Length(ProbabilityMatrix[AttackCount - 1]) < DefendCount then begin
    2794     Len := Length(ProbabilityMatrix[AttackCount - 1]);
    2795     SetLength(ProbabilityMatrix[AttackCount - 1], DefendCount);
    2796     for I := Len to Length(ProbabilityMatrix[AttackCount - 1]) - 1 do
    2797       ProbabilityMatrix[AttackCount - 1][I] := -1;
    2798   end;
    2799 
    2800   if ProbabilityMatrix[AttackCount - 1, DefendCount - 1] <> -1 then begin
    2801     // Use cached value
    2802     Result := ProbabilityMatrix[AttackCount - 1, DefendCount - 1];
    2803     Exit;
    2804   end else Result := 1;
    2805 
    2806   OA := Min(AttackCount, 3);
    2807   OD := Min(DefendCount, 2);
    2808 
    2809   if (OA = 1) and (OD = 1) then
    2810     Result := 0.4167 * AttackProbability(AttackCount, DefendCount - 1) +
    2811       0.5833 * AttackProbability(AttackCount - 1, DefendCount)
    2812   else if (OA = 2) and (OD = 1) then
    2813     Result := 0.5787 * AttackProbability(AttackCount, DefendCount - 1) +
    2814       0.4213 * AttackProbability(AttackCount - 1, DefendCount)
    2815   else if (OA = 3) and (OD = 1) then
    2816     Result := 0.6597 * AttackProbability(AttackCount, DefendCount - 1) +
    2817       0.3403 * AttackProbability(AttackCount - 1, DefendCount)
    2818   else if (OA = 1) and (OD = 2) then
    2819     Result := 0.2546 * AttackProbability(AttackCount, DefendCount - 1) +
    2820       0.7454 * AttackProbability(AttackCount - 1, DefendCount)
    2821   else if (OA = 2) and (OD = 2) then
    2822     Result := 0.2276 * AttackProbability(AttackCount, DefendCount - 2) +
    2823       0.4483 * AttackProbability(AttackCount - 2, DefendCount) +
    2824       0.3241 * AttackProbability(AttackCount - 1, DefendCount - 1)
    2825   else if (OA = 3) and (OD = 2) then
    2826     Result := 0.3717 * AttackProbability(AttackCount, DefendCount - 2) +
    2827       0.2926 * AttackProbability(AttackCount - 2, DefendCount) +
    2828       0.3358 * AttackProbability(AttackCount - 1, DefendCount - 1);
    2829   ProbabilityMatrix[AttackCount - 1, DefendCount - 1] := Result;
    2830 end;
    28312650
    28322651procedure TPlayer.MoveAll;
     
    28972716end;
    28982717
    2899 procedure TGame.SetMapType(AValue: TMapType);
    2900 var
    2901   OldMap: TMap;
    2902 begin
    2903   if FMapType = AValue then Exit;
    2904   OldMap := Map;
    2905   case AValue of
    2906     mtNone: Map := TMap.Create;
    2907     mtHexagon: Map := THexMap.Create;
    2908     mtSquare: Map := TSquareMap.Create;
    2909     mtTriangle: Map := TTriangleMap.Create;
    2910     mtVoronoi: Map := TVoronoiMap.Create;
    2911     else Map := TMap.Create;
    2912   end;
    2913   Map.Assign(OldMap);
    2914   FreeAndNil(OldMap);
    2915   FMapType := AValue;
    2916 end;
    2917 
    29182718function TPlayer.SetMove(CellFrom, CellTo: TCell; Power: Integer; Confirmation: Boolean = True): TUnitMove;
    29192719var
     
    29302730    CountRepeat := Result.CountRepeat;
    29312731    if (Mode = pmHuman) and Confirmation and
    2932       Assigned(Client) and Assigned(Client.FOnMove) then
    2933         Client.FOnMove(CellFrom, CellTo, CountOnce, CountRepeat, True, Confirm);
     2732      Assigned(FOnMove) then
     2733        FOnMove(CellFrom, CellTo, CountOnce, CountRepeat, True, Confirm);
    29342734  end else begin
    29352735    CountOnce := Power;
    29362736    CountRepeat := 0;
    29372737    if (Mode = pmHuman) and Confirmation and
    2938       Assigned(Client) and Assigned(Client.FOnMove) then
    2939         Client.FOnMove(CellFrom, CellTo, CountOnce, CountRepeat, False, Confirm);
     2738      Assigned(FOnMove) then
     2739        FOnMove(CellFrom, CellTo, CountOnce, CountRepeat, False, Confirm);
    29402740  end;
    29412741  if Confirm then begin
     
    29682768end;
    29692769
    2970 procedure TGame.SetRunning(AValue: Boolean);
    2971 var
    2972   I: Integer;
    2973 begin
    2974   if FRunning = AValue then Exit;
    2975   if AValue then begin
    2976     if Players.Count < 2 then raise Exception.Create(SMinimumPlayers);
    2977     FRunning := AValue;
    2978   end else begin
    2979     FRunning := AValue;
    2980     for I := 0 to Server.Clients.Count - 1 do
    2981     with TClient(Server.Clients[I]) do begin
    2982       View.Clear;
    2983     end;
    2984   end;
    2985 end;
    2986 
    29872770procedure TPlayer.UpdateRepeatMoves;
    29882771var
     
    30312814  FMode := AValue;
    30322815end;
     2816
     2817{ TMap }
    30332818
    30342819function TMap.SearchDifferentCellArea(List: TCells; SourceArea, DestArea: TMapArea): TCell;
     
    30702855  FreeAndNil(NewListVoid);
    30712856  FreeAndNil(NewList);
    3072 end;
    3073 
    3074 procedure TGame.BuildTerrain;
    3075 var
    3076   Cell: TCell;
    3077 begin
    3078   if (Map.Shape = msImage) and FileExists(MapImageFileName) and
    3079   (LoadedImageFileName <> MapImageFileName) then begin
    3080     LoadedImageFileName := MapImageFileName;
    3081     Map.Image.Picture.LoadFromFile(MapImageFileName);
    3082   end;
    3083 
    3084   // Randomize map terrain
    3085   for Cell in Map.Cells do
    3086   with Cell do begin
    3087     if (VoidEnabled and (Random < VoidPercentage / 100)) or
    3088     (Map.IsOutsideShape(PosPx)) then Terrain := ttVoid
    3089       else begin
    3090         if CityEnabled and (Random < CityPercentage / 100) then Terrain := ttCity
    3091           else Terrain := ttNormal;
    3092       end;
    3093     Power := Random(MaxNeutralUnits + 1);
    3094     Player := nil;
    3095   end;
    30962857end;
    30972858
     
    31702931end;
    31712932
    3172 procedure TServer.SetGame(AValue: TGame);
    3173 var
    3174   I: Integer;
    3175 begin
    3176   if FGame = AValue then Exit;
    3177   FGame := AValue;
    3178   for I := 0 to Clients.Count - 1 do
    3179     Clients[I].Game := FGame;
    3180   Clients.Game := Game;
    3181 end;
    3182 
    3183 procedure TServer.SetActive(AValue: Boolean);
    3184 begin
    3185   if FActive = AValue then Exit;
    3186   FActive := AValue;
    3187 end;
    3188 
    3189 procedure TServer.SetServerMode(AValue: TServerMode);
    3190 var
    3191   LastActiveState: Boolean;
    3192 begin
    3193   if FServerMode = AValue then Exit;
    3194   LastActiveState := Active;
    3195   Active := False;
    3196   FServerMode := AValue;
    3197   FreeAndNil(GameSocket);
    3198   case FServerMode of
    3199     smLocal: GameSocket := TGameSocketDirect.Create;
    3200     smNetworkServer: begin
    3201       GameSocket := TGameSocketNetworkServer.Create;
    3202       TGameSocketNetworkServer(GameSocket).TCPServer.Address := LocalNetworkAddress;
    3203       TGameSocketNetworkServer(GameSocket).TCPServer.Port := LocalNetworkPort;
    3204       //TODO TGameSocketNetworkServer(GameSocket).TCPServer.Active := True;
    3205     end;
    3206     smNetworkClient: begin
    3207       GameSocket := TGameSocketNetworkClient.Create;
    3208       if (LocalNetworkAddress = RemoteNetworkAddress) and
    3209         (LocalNetworkPort = RemoteNetworkPort) then begin
    3210           // User wants to play on its own server
    3211           GameSocket := TGameSocketNetworkServer.Create;
    3212           TGameSocketNetworkServer(GameSocket).TCPServer.Address := LocalNetworkAddress;
    3213           TGameSocketNetworkServer(GameSocket).TCPServer.Port := LocalNetworkPort;
    3214           //TODO TGameSocketNetworkServer(GameSocket).TCPServer.Active := True;
    3215         end else
    3216         begin
    3217           // Do not create socket. User wants to connect elsewhere
    3218         end;
     2933procedure TMap.Paint(Canvas: TCanvas; View: TView);
     2934var
     2935  I: Integer;
     2936  Cell: TCell;
     2937  PosFrom, PosTo: TPoint;
     2938  Angle: Double;
     2939  ArrowCenter: TPoint;
     2940  Move: TUnitMove;
     2941  CellLink: TCellLink;
     2942begin
     2943  with Canvas, View do
     2944  try
     2945    Lock;
     2946
     2947    // Draw cell links
     2948    Pen.Color := clBlack;
     2949    Pen.Style := psSolid;
     2950    Pen.Width := 3;
     2951    for CellLink in CellLinks do
     2952    with CellLink do begin
     2953      if Length(Points) >= 2 then begin
     2954        MoveTo(PointToStdPoint(View.CellToCanvasPos(Points[0])));
     2955        for I := 1 to Length(Points) - 1 do
     2956          LineTo(PointToStdPoint(View.CellToCanvasPos(Points[I])));
    32192957      end;
    3220   end;
    3221   Active := LastActiveState;
    3222 end;
    3223 
    3224 procedure TServer.DoChange;
    3225 var
    3226   Client: TClient;
    3227 begin
    3228   for Client in Clients do
    3229     Client.DoChange;
    3230 end;
    3231 
    3232 procedure TServer.LoadConfig(Config: TXmlConfig; Path: string);
    3233 begin
    3234   with Config do begin
    3235     LocalNetworkAddress := string(GetValue(DOMString(Path + '/LocalNetworkAddress'), 'localhost'));
    3236     LocalNetworkPort := GetValue(DOMString(Path + '/LocalNetworkPort'), 40009);
    3237     RemoteNetworkAddress := string(GetValue(DOMString(Path + '/RemoteNetworkAddress'), 'localhost'));
    3238     RemoteNetworkPort := GetValue(DOMString(Path + '/RemoteNetworkPort'), 40009);
    3239     Mode := TServerMode(GetValue(DOMString(Path + '/Mode'), Integer(smLocal)));
    3240   end;
    3241 end;
    3242 
    3243 procedure TServer.SaveConfig(Config: TXmlConfig; Path: string);
    3244 begin
    3245   with Config do begin
    3246     SetValue(DOMString(Path + '/LocalNetworkAddress'), DOMString(LocalNetworkAddress));
    3247     SetValue(DOMString(Path + '/LocalNetworkPort'), LocalNetworkPort);
    3248     SetValue(DOMString(Path + '/RemoteNetworkAddress'), DOMString(RemoteNetworkAddress));
    3249     SetValue(DOMString(Path + '/RemoteNetworkPort'), RemoteNetworkPort);
    3250     SetValue(DOMString(Path + '/Mode'), Integer(Mode));
    3251   end;
    3252 end;
    3253 
    3254 procedure TServer.InitClients;
    3255 var
    3256   Client: TClient;
    3257   Player: TPlayer;
    3258 begin
    3259   Clients.Clear;
    3260   Clients.New(SSpectator);
    3261 
    3262   for Player in Game.Players do
    3263   with Player do
    3264   if Mode = pmHuman then begin
    3265     Player.Client := Clients.New(Player.Name);
    3266   end;
    3267 
    3268   for Client in Clients do
    3269   with Client do begin
    3270     View.Clear;
    3271     View.Zoom := 1;
    3272     if Assigned(ControlPlayer) and Assigned(ControlPlayer.StartCell) then
    3273       View.CenterPlayerCity(ControlPlayer)
    3274       else View.CenterMap;
    3275   end;
    3276 end;
    3277 
    3278 procedure TServer.Clear;
    3279 begin
    3280   Clients.Clear;
    3281   Game.Clear;
    3282 end;
    3283 
    3284 constructor TServer.Create;
    3285 begin
    3286   FGame := nil;
    3287   Clients := TClients.Create;
    3288 end;
    3289 
    3290 destructor TServer.Destroy;
    3291 begin
    3292   FreeAndNil(Clients);
    3293   inherited Destroy;
     2958    end;
     2959
     2960    // Draw cells
     2961    for Cell in Cells do begin
     2962      if (Cell.Terrain <> ttVoid) and Cell.IsVisible(View) then begin
     2963        if Assigned(SelectedCell) and (SelectedCell = Cell) then
     2964            Brush.Color := clGreen
     2965          else if Assigned(SelectedCell) and IsCellsNeighbor(SelectedCell, Cell) then
     2966            Brush.Color := clPurple
     2967          else Brush.Color := Cell.GetColor;
     2968        //Pen.Color := clBlack;
     2969        PaintCell(Canvas, Cell.PosPx, IntToStr(Cell.GetAvialPower), View, Cell);
     2970      end;
     2971
     2972    end;
     2973
     2974    // Draw arrows
     2975    Pen.Color := clCream;
     2976    for Move in Game.CurrentPlayer.Moves do begin
     2977      PosFrom := CellToPos(Move.CellFrom);
     2978      PosTo := CellToPos(Move.CellTo);
     2979      if Move.CountRepeat > 0 then Pen.Width := 2
     2980        else Pen.Width := 1;
     2981      Angle := ArcTan((PosTo.Y - PosFrom.Y) / (PosTo.X - PosFrom.X));
     2982      if Sign(PosTo.X - PosFrom.X) = -1 then Angle := Angle + Pi;
     2983      ArrowCenter := View.CellToCanvasPos(TPoint.Create(Trunc(PosFrom.X + (PosTo.X - PosFrom.X) / 2),
     2984        Trunc(PosFrom.Y + (PosTo.Y - PosFrom.Y) / 2)));
     2985      DrawArrow(Canvas, View, ArrowCenter,
     2986        Angle, IntToStr(Move.CountOnce));
     2987    end;
     2988  finally
     2989    Unlock;
     2990  end;
     2991end;
     2992
     2993{ TGame }
     2994
     2995function TGame.AttackProbability(AttackCount, DefendCount: Integer): Double;
     2996var
     2997  OA, OD: Integer;
     2998  Len: Integer;
     2999  I: Integer;
     3000begin
     3001  if AttackCount = 0 then begin
     3002    Result := 0;
     3003    Exit;
     3004  end;
     3005  if DefendCount = 0 then begin
     3006    Result := 1;
     3007    Exit;
     3008  end;
     3009
     3010  // Enlarge probability cache table on demand
     3011  if Length(ProbabilityMatrix) < AttackCount then begin
     3012    SetLength(ProbabilityMatrix, AttackCount);
     3013  end;
     3014  if Length(ProbabilityMatrix[AttackCount - 1]) < DefendCount then begin
     3015    Len := Length(ProbabilityMatrix[AttackCount - 1]);
     3016    SetLength(ProbabilityMatrix[AttackCount - 1], DefendCount);
     3017    for I := Len to Length(ProbabilityMatrix[AttackCount - 1]) - 1 do
     3018      ProbabilityMatrix[AttackCount - 1][I] := -1;
     3019  end;
     3020
     3021  if ProbabilityMatrix[AttackCount - 1, DefendCount - 1] <> -1 then begin
     3022    // Use cached value
     3023    Result := ProbabilityMatrix[AttackCount - 1, DefendCount - 1];
     3024    Exit;
     3025  end else Result := 1;
     3026
     3027  OA := Min(AttackCount, 3);
     3028  OD := Min(DefendCount, 2);
     3029
     3030  if (OA = 1) and (OD = 1) then
     3031    Result := 0.4167 * AttackProbability(AttackCount, DefendCount - 1) +
     3032      0.5833 * AttackProbability(AttackCount - 1, DefendCount)
     3033  else if (OA = 2) and (OD = 1) then
     3034    Result := 0.5787 * AttackProbability(AttackCount, DefendCount - 1) +
     3035      0.4213 * AttackProbability(AttackCount - 1, DefendCount)
     3036  else if (OA = 3) and (OD = 1) then
     3037    Result := 0.6597 * AttackProbability(AttackCount, DefendCount - 1) +
     3038      0.3403 * AttackProbability(AttackCount - 1, DefendCount)
     3039  else if (OA = 1) and (OD = 2) then
     3040    Result := 0.2546 * AttackProbability(AttackCount, DefendCount - 1) +
     3041      0.7454 * AttackProbability(AttackCount - 1, DefendCount)
     3042  else if (OA = 2) and (OD = 2) then
     3043    Result := 0.2276 * AttackProbability(AttackCount, DefendCount - 2) +
     3044      0.4483 * AttackProbability(AttackCount - 2, DefendCount) +
     3045      0.3241 * AttackProbability(AttackCount - 1, DefendCount - 1)
     3046  else if (OA = 3) and (OD = 2) then
     3047    Result := 0.3717 * AttackProbability(AttackCount, DefendCount - 2) +
     3048      0.2926 * AttackProbability(AttackCount - 2, DefendCount) +
     3049      0.3358 * AttackProbability(AttackCount - 1, DefendCount - 1);
     3050  ProbabilityMatrix[AttackCount - 1, DefendCount - 1] := Result;
     3051end;
     3052
     3053procedure TGame.SetMapType(AValue: TMapType);
     3054var
     3055  OldMap: TMap;
     3056begin
     3057  if FMapType = AValue then Exit;
     3058  OldMap := Map;
     3059  case AValue of
     3060    mtNone: Map := TMap.Create;
     3061    mtHexagon: Map := THexMap.Create;
     3062    mtSquare: Map := TSquareMap.Create;
     3063    mtTriangle: Map := TTriangleMap.Create;
     3064    mtVoronoi: Map := TVoronoiMap.Create;
     3065    else Map := TMap.Create;
     3066  end;
     3067  Map.Assign(OldMap);
     3068  FreeAndNil(OldMap);
     3069  FMapType := AValue;
     3070end;
     3071
     3072procedure TGame.SetRunning(AValue: Boolean);
     3073begin
     3074  if FRunning = AValue then Exit;
     3075  if AValue then begin
     3076    if Players.Count < 2 then raise Exception.Create(SMinimumPlayers);
     3077    FRunning := AValue;
     3078  end else begin
     3079    FRunning := AValue;
     3080    if Assigned(FOnStart) then FOnStart(Self);
     3081  end;
     3082end;
     3083
     3084procedure TGame.BuildTerrain;
     3085var
     3086  Cell: TCell;
     3087begin
     3088  if (Map.Shape = msImage) and FileExists(MapImageFileName) and
     3089  (LoadedImageFileName <> MapImageFileName) then begin
     3090    LoadedImageFileName := MapImageFileName;
     3091    Map.Image.Picture.LoadFromFile(MapImageFileName);
     3092  end;
     3093
     3094  // Randomize map terrain
     3095  for Cell in Map.Cells do
     3096  with Cell do begin
     3097    if (VoidEnabled and (Random < VoidPercentage / 100)) or
     3098    (Map.IsOutsideShape(PosPx)) then Terrain := ttVoid
     3099      else begin
     3100        if CityEnabled and (Random < CityPercentage / 100) then Terrain := ttCity
     3101          else Terrain := ttNormal;
     3102      end;
     3103    Power := Random(MaxNeutralUnits + 1);
     3104    Player := nil;
     3105  end;
    32943106end;
    32953107
     
    35633375end;
    35643376
    3565 function TPlayers.GetAlivePlayers: TPlayerArray;
    3566 var
    3567   Player: TPlayer;
    3568 begin
    3569   SetLength(Result, 0);
    3570   for Player in Self do
    3571     if Player.IsAlive then begin
    3572       SetLength(Result, Length(Result) + 1);
    3573       Result[Length(Result) - 1] := Player;
    3574     end;
    3575 end;
    3576 
    3577 function TPlayers.GetAlivePlayersWithCities: TPlayerArray;
    3578 var
    3579   Player: TPlayer;
    3580 begin
    3581   SetLength(Result, 0);
    3582   for Player in Self do
    3583     if Player.TotalCities > 0 then begin
    3584       SetLength(Result, Length(Result) + 1);
    3585       Result[Length(Result) - 1] := Player;
    3586     end;
    3587 end;
    3588 
    35893377procedure TGame.NextTurn;
    35903378var
     
    36143402  // For computers take view from previous human
    36153403  //if CurrentPlayer.Mode = pmComputer then CurrentPlayer.View.Assign(PrevPlayer.View);
    3616   Server.DoChange;
     3404  if Assigned(FOnChange) then
     3405    FOnChange(Self);
    36173406end;
    36183407
     
    37343523end;
    37353524
    3736 procedure TMap.Paint(Canvas: TCanvas; View: TView);
    3737 var
    3738   I: Integer;
    3739   Cell: TCell;
    3740   PosFrom, PosTo: TPoint;
    3741   Angle: Double;
    3742   ArrowCenter: TPoint;
    3743   Move: TUnitMove;
    3744   CellLink: TCellLink;
    3745 begin
    3746   with Canvas, View do
    3747   try
    3748     Lock;
    3749 
    3750     // Draw cell links
    3751     Pen.Color := clBlack;
    3752     Pen.Style := psSolid;
    3753     Pen.Width := 3;
    3754     for CellLink in CellLinks do
    3755     with CellLink do begin
    3756       if Length(Points) >= 2 then begin
    3757         MoveTo(PointToStdPoint(View.CellToCanvasPos(Points[0])));
    3758         for I := 1 to Length(Points) - 1 do
    3759           LineTo(PointToStdPoint(View.CellToCanvasPos(Points[I])));
    3760       end;
    3761     end;
    3762 
    3763     // Draw cells
    3764     for Cell in Cells do begin
    3765       if (Cell.Terrain <> ttVoid) and Cell.IsVisible(View) then begin
    3766         if Assigned(SelectedCell) and (SelectedCell = Cell) then
    3767             Brush.Color := clGreen
    3768           else if Assigned(SelectedCell) and IsCellsNeighbor(SelectedCell, Cell) then
    3769             Brush.Color := clPurple
    3770           else Brush.Color := Cell.GetColor;
    3771         //Pen.Color := clBlack;
    3772         PaintCell(Canvas, Cell.PosPx, IntToStr(Cell.GetAvialPower), View, Cell);
    3773       end;
    3774 
    3775     end;
    3776 
    3777     // Draw arrows
    3778     Pen.Color := clCream;
    3779     for Move in Game.CurrentPlayer.Moves do begin
    3780       PosFrom := CellToPos(Move.CellFrom);
    3781       PosTo := CellToPos(Move.CellTo);
    3782       if Move.CountRepeat > 0 then Pen.Width := 2
    3783         else Pen.Width := 1;
    3784       Angle := ArcTan((PosTo.Y - PosFrom.Y) / (PosTo.X - PosFrom.X));
    3785       if Sign(PosTo.X - PosFrom.X) = -1 then Angle := Angle + Pi;
    3786       ArrowCenter := View.CellToCanvasPos(TPoint.Create(Trunc(PosFrom.X + (PosTo.X - PosFrom.X) / 2),
    3787         Trunc(PosFrom.Y + (PosTo.Y - PosFrom.Y) / 2)));
    3788       DrawArrow(Canvas, View, ArrowCenter,
    3789         Angle, IntToStr(Move.CountOnce));
    3790     end;
    3791   finally
    3792     Unlock;
    3793   end;
     3525{ TPlayers }
     3526
     3527function TPlayers.GetAlivePlayers: TPlayerArray;
     3528var
     3529  Player: TPlayer;
     3530begin
     3531  SetLength(Result, 0);
     3532  for Player in Self do
     3533    if Player.IsAlive then begin
     3534      SetLength(Result, Length(Result) + 1);
     3535      Result[Length(Result) - 1] := Player;
     3536    end;
     3537end;
     3538
     3539function TPlayers.GetAlivePlayersWithCities: TPlayerArray;
     3540var
     3541  Player: TPlayer;
     3542begin
     3543  SetLength(Result, 0);
     3544  for Player in Self do
     3545    if Player.TotalCities > 0 then begin
     3546      SetLength(Result, Length(Result) + 1);
     3547      Result[Length(Result) - 1] := Player;
     3548    end;
    37943549end;
    37953550
Note: See TracChangeset for help on using the changeset viewer.