Changeset 202
- Timestamp:
- May 17, 2018, 5:41:47 PM (6 years ago)
- Location:
- trunk
- Files:
-
- 2 added
- 12 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Forms/UFormClient.lfm
r180 r202 13 13 OnKeyUp = FormKeyUp 14 14 OnShow = FormShow 15 LCLVersion = '1.8. 0.6'15 LCLVersion = '1.8.2.0' 16 16 WindowState = wsMaximized 17 17 object StatusBar1: TStatusBar … … 48 48 Left = 1 49 49 Top = 2 50 Action = Core.AGameEndTurn50 Action = AGameEndTurn 51 51 end 52 52 object ToolButton6: TToolButton … … 128 128 OnExecute = AStatusBarVisibleExecute 129 129 end 130 object AGameEndTurn: TAction 131 Caption = 'End turn' 132 ImageIndex = 0 133 OnExecute = AGameEndTurnExecute 134 end 130 135 end 131 136 object PopupMenuToolbar: TPopupMenu -
trunk/Forms/UFormClient.pas
r185 r202 7 7 uses 8 8 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, 9 UGame, LCLType, Menus, ActnList, ComCtrls, dateutils, XMLConf, DOM, 10 UGeometry, UGameClient ;9 UGame, LCLType, Menus, ActnList, ComCtrls, dateutils, XMLConf, DOM, UCommPin, 10 UGeometry, UGameClient, UGameProtocol; 11 11 12 12 const … … 19 19 20 20 TFormClient = class(TForm) 21 AGameEndTurn: TAction; 21 22 AStatusBarVisible: TAction; 22 23 AToolBarVisible: TAction; … … 37 38 ToolButton8: TToolButton; 38 39 ToolButton9: TToolButton; 40 procedure AGameEndTurnExecute(Sender: TObject); 39 41 procedure AStatusBarVisibleExecute(Sender: TObject); 40 42 procedure AToolBarBigIconsExecute(Sender: TObject); … … 196 198 Caption := NewCaption; 197 199 Drawing := False; 200 AGameEndTurn.Enabled := Core.Game.Running; 198 201 end; 199 202 end; … … 299 302 AStatusBarVisible.Checked := not AStatusBarVisible.Checked; 300 303 ReloadView; 304 end; 305 306 procedure TFormClient.AGameEndTurnExecute(Sender: TObject); 307 var 308 P: TGameProtocolClient; 309 P2: TCommPin; 310 begin 311 P := Client.Protocol; 312 P2 := P.Pin; 313 Client.Protocol.TurnEnd; 301 314 end; 302 315 -
trunk/Languages/xtactics.cs.po
r198 r202 151 151 msgid "Chat:" 152 152 msgstr "Pokec:" 153 154 #: tformclient.agameendturn.caption 155 #, fuzzy 156 msgctxt "tformclient.agameendturn.caption" 157 msgid "End turn" 158 msgstr "Ukončit tah" 153 159 154 160 #: tformclient.astatusbarvisible.caption -
trunk/Languages/xtactics.po
r198 r202 140 140 #: tformchat.label1.caption 141 141 msgid "Chat:" 142 msgstr "" 143 144 #: tformclient.agameendturn.caption 145 msgctxt "tformclient.agameendturn.caption" 146 msgid "End turn" 142 147 msgstr "" 143 148 -
trunk/Packages/CoolStreaming/UVarBlockSerializer.pas
r185 r202 191 191 // Get bit length 192 192 Length := SizeOf(QWord) * BitAlignment; 193 while (( (Value shr Length) and 1) = 0) and (Length > 0) do193 while ((Value and (QWord(1) shl (Length - 1))) = 0) and (Length > 0) do 194 194 Dec(Length); 195 195 Inc(Length); -
trunk/UCore.pas
r199 r202 9 9 UGame, UApplicationInfo, UPersistentForm, UScaleDPI, UCoolTranslator, 10 10 URegistry, ULastOpenedList, Registry, Menus, UGeometry, UFormClient, 11 UGameServer, UGameClient, fgl, UServerList ;11 UGameServer, UGameClient, fgl, UServerList, UGameProtocol; 12 12 13 13 type … … 65 65 GameLoaded: Boolean; 66 66 procedure LoadRecentExecute(Sender: TObject); 67 procedure ProcessComputerTurns;68 67 procedure StartNewGame; 69 68 procedure DoPlayerChange(Sender: TObject); … … 91 90 ReopenLastFile: Boolean; 92 91 FormClients: TFPGObjectList<TFormClient>; 93 Clients: TClients;92 LocalClients: TClients; 94 93 ServerList: TServerList; 95 94 procedure Spectate(Player: TPlayer); … … 109 108 110 109 uses 111 UFormMain, UFormNew, UFormSettings, UFormAbout, 110 UFormMain, UFormNew, UFormSettings, UFormAbout, UClientAI, 112 111 UFormHelp, UFormCharts, UFormUnitMoves, UFormPlayersStats; 113 112 … … 240 239 begin 241 240 FirstHuman := Game.Players.GetFirstHuman; 242 if Assigned(FirstHuman) then FormClient.Client := Clients.SearchPlayer(FirstHuman)243 else FormClient.Client := TClient( Clients.First);241 if Assigned(FirstHuman) then FormClient.Client := LocalClients.SearchPlayer(FirstHuman) 242 else FormClient.Client := TClient(LocalClients.First); 244 243 end; 245 244 … … 275 274 end; 276 275 277 procedure TCore.ProcessComputerTurns;278 begin279 while Game.Running and (Game.CurrentPlayer.Mode <> pmHuman) do begin280 if Game.CurrentPlayer.Mode = pmComputer then begin281 Game.CurrentPlayer.Computer.Process;282 RedrawClients;283 Delay(Trunc((100 - AnimationSpeed) / 100 * 2000));284 end;285 Game.NextTurn;286 RedrawClients;287 Application.ProcessMessages;288 Sleep(1);289 end;290 end;291 292 276 procedure TCore.AGameEndTurnExecute(Sender: TObject); 293 277 begin 294 Game.Next Turn;278 Game.NextPlayer; 295 279 RedrawClients; 296 ProcessComputerTurns;297 280 UpdateActions; 298 281 end; … … 399 382 begin 400 383 Server := TServer.Create; 401 Clients := TClients.Create;384 LocalClients := TClients.Create; 402 385 GameSettings := TGame.Create; 403 386 Game := TGame.Create; … … 407 390 Game.OnPlayerChange := DoPlayerChange; 408 391 Server.Game := Game; 409 Clients.Game := Game;392 LocalClients.Game := Game; 410 393 StoredDimension := TControlDimension.Create; 411 394 XMLConfig1.Filename := GetAppConfigDir(False) + 'Config.xml'; … … 424 407 FreeAndNil(StoredDimension); 425 408 FreeAndNil(Server); 426 FreeAndNil( Clients);409 FreeAndNil(LocalClients); 427 410 FreeAndNil(Game); 428 411 FreeAndNil(GameSettings); … … 448 431 Game.LoadFromFile(FileName); 449 432 Server.InitClients; 450 451 // Create local clients for human players 433 Server.Active := True; 434 435 // Create local LocalClients for human players 452 436 for Player in Game.Players do 453 437 with Player do 454 438 if Mode = pmHuman then begin 455 NewClient := Clients.New(Name);439 NewClient := LocalClients.New(Name); 456 440 NewClient.ControlPlayer := Player; 457 441 NewClient.View.Clear; 458 442 NewClient.View.Zoom := 1; 443 NewClient.LocalServer := Server; 444 NewClient.ConnectType := ctLocal; 445 NewClient.Active := True; 459 446 if Assigned(NewClient.ControlPlayer.StartCell) then 460 447 NewClient.View.CenterPlayerCity(NewClient.ControlPlayer) 461 448 else NewClient.View.CenterMap; 449 end else 450 if Mode = pmComputer then begin 451 NewClient := TComputer.Create; 452 NewClient.Game := Game; 453 NewClient.Name := Name; 454 LocalClients.Add(NewClient); 455 NewClient.ControlPlayer := Player; 456 NewClient.LocalServer := Server; 457 NewClient.ConnectType := ctLocal; 458 NewClient.Active := True; 462 459 end; 463 460 … … 493 490 begin 494 491 Form := TFormClient.Create(nil); 495 Form.Client := Clients.New(SSpectator);492 Form.Client := LocalClients.New(SSpectator); 496 493 //Form.Client.Form := Form; 497 494 //Form.Client.ControlPlayer := Player; … … 505 502 NewClient: TClient; 506 503 Player: TPlayer; 504 ServerClient: TServerClient; 507 505 begin 508 506 Game.New; 509 507 Server.InitClients; 510 511 // Create local clients for human players 508 Server.Active := True; 509 510 // Create local LocalClients for human players 512 511 for Player in Game.Players do 513 512 with Player do 514 513 if Mode = pmHuman then begin 515 NewClient := Clients.New(Name);514 NewClient := LocalClients.New(Name); 516 515 NewClient.ControlPlayer := Player; 517 516 NewClient.View.Clear; 518 517 NewClient.View.Zoom := 1; 518 NewClient.LocalServer := Server; 519 NewClient.ConnectType := ctLocal; 520 NewClient.Active := True; 519 521 if Assigned(NewClient.ControlPlayer.StartCell) then 520 522 NewClient.View.CenterPlayerCity(NewClient.ControlPlayer) 521 523 else NewClient.View.CenterMap; 524 end else 525 if Mode = pmComputer then begin 526 NewClient := TComputer.Create; 527 NewClient.Game := Game; 528 NewClient.Name := Name; 529 LocalClients.Add(NewClient); 530 NewClient.ControlPlayer := Player; 531 NewClient.LocalServer := Server; 532 NewClient.ConnectType := ctLocal; 533 NewClient.Active := True; 522 534 end; 523 535 … … 528 540 RedrawClients; 529 541 UpdateOtherForms; 530 ProcessComputerTurns;531 542 UpdateActions; 543 ServerClient := Server.Clients.SearchByPlayer(Game.CurrentPlayer); 544 if Assigned(ServerClient) then ServerClient.TurnStart 545 else raise Exception.Create('Server client for current player not found.'); 532 546 end; 533 547 … … 535 549 var 536 550 PlayerClient: TClient; 551 ServerClient: TServerClient; 537 552 begin 538 553 if Assigned(Game.CurrentPlayer) then begin 539 PlayerClient := Clients.SearchPlayer(Game.CurrentPlayer);554 PlayerClient := LocalClients.SearchPlayer(Game.CurrentPlayer); 540 555 if Assigned(PlayerClient) then FormClient.Client := PlayerClient; 556 557 ServerClient := Server.Clients.SearchByPlayer(Game.CurrentPlayer); 558 if Assigned(ServerClient) then ServerClient.TurnStart; 541 559 end; 542 560 UpdateOtherForms; -
trunk/UGame.pas
r199 r202 290 290 TPlayerMode = (pmHuman, pmComputer); 291 291 TComputerAgressivity = (caLow, caMedium, caHigh); 292 TComputer = class;293 292 TUnitMove = class; 294 293 … … 310 309 procedure CheckCounterMove(Move: TUnitMove); 311 310 procedure SetMode(AValue: TPlayerMode); 312 function SetMove(CellFrom, CellTo: TCell; Power: Integer; Confirmation: Boolean = True): TUnitMove;313 311 procedure UpdateRepeatMoves; 314 312 procedure RemoveEmptyUnitMoves; … … 328 326 TurnStats: TGameTurnStats; 329 327 Moves: TUnitMoves; 330 Computer: TComputer;328 function SetMove(CellFrom, CellTo: TCell; Power: Integer; Confirmation: Boolean = True): TUnitMove; 331 329 procedure Reset; 332 330 function IsAlive: Boolean; … … 343 341 property Mode: TPlayerMode read FMode write SetMode; 344 342 property OnMove: TMoveEvent read FOnMove write FOnMove; 345 end;346 347 { TComputer }348 349 TComputer = class350 Game: TGame;351 //Targets: TFPGObjectList<TPlayer>;352 CellProcessDirection: Boolean;353 Player: TPlayer;354 procedure AttackNeutral;355 procedure AttackPlayers;356 procedure InnerMoves;357 procedure IncreaseMoves;358 procedure Process;359 procedure FallBack;360 function AttackersCount(Cell: TCell): Integer;361 343 end; 362 344 … … 474 456 procedure SaveToFile(FileName: string); 475 457 procedure ComputePlayerStats; 476 procedure Next Turn;458 procedure NextPlayer; 477 459 procedure CheckWinObjective; 478 460 constructor Create; … … 502 484 503 485 procedure InitStrings; 486 function CellCompare(const Item1, Item2: TCell): Integer; 487 function CellCompareDescending(const Item1, Item2: TCell): Integer; 504 488 505 489 resourcestring … … 2096 2080 FGame := AValue; 2097 2081 Moves.Game := AValue; 2098 Computer.Game := AValue;2099 2082 end; 2100 2083 … … 2187 2170 PlayerMap.Player := Self; 2188 2171 TurnStats := TGameTurnStats.Create; 2189 Computer := TComputer.Create;2190 Computer.Player := Self;2191 2172 end; 2192 2173 … … 2194 2175 begin 2195 2176 //Client := nil; 2196 FreeAndNil(Computer);2197 2177 FreeAndNil(TurnStats); 2198 2178 FreeAndNil(PlayerMap); … … 2214 2194 Agressivity := Source.Agressivity; 2215 2195 Defensive := Source.Defensive; 2216 Computer.Game := Source.Computer.Game;2217 Computer.CellProcessDirection := Source.Computer.CellProcessDirection;2218 2196 end; 2219 2197 … … 2301 2279 else if Item1.Power < Item2.Power then Result := 1 2302 2280 else Result := 0; 2303 end;2304 2305 { TComputer }2306 2307 procedure TComputer.AttackNeutral;2308 var2309 AllCells: TCells;2310 TotalPower: Integer;2311 AttackPower: Integer;2312 TotalAttackPower: Integer;2313 CanAttack: Integer;2314 TargetCells: TCells;2315 Cell: TCell;2316 NeighborCell: TCell;2317 const2318 AttackDiff = 1;2319 begin2320 AllCells := Game.Map.Cells;2321 TargetCells := TCells.Create;2322 TargetCells.FreeObjects := False;2323 2324 // Get list of all attack target cells2325 for Cell in AllCells do2326 with Cell do begin2327 if (Terrain <> ttVoid) and (Player = nil) then begin2328 CanAttack := 0;2329 for NeighborCell in Neighbors do2330 if NeighborCell.Player = Game.CurrentPlayer then begin2331 Inc(CanAttack);2332 end;2333 if CanAttack > 0 then TargetCells.Add(Cell);2334 end;2335 end;2336 2337 // Sort ascending to attack cells with lower power first2338 // Low power cells are better for expanding our teritorry2339 TargetCells.Sort(CellCompare);2340 2341 for Cell in TargetCells do2342 with Cell do begin2343 // Attack to not owned cell yet2344 // Count own possible power2345 TotalPower := 0;2346 for NeighborCell in Neighbors do2347 if NeighborCell.Player = Game.CurrentPlayer then2348 TotalPower := TotalPower + NeighborCell.GetAvialPower;2349 2350 // Attack if target is weaker2351 if TotalPower >= (Power + AttackDiff) then begin2352 TotalAttackPower := 0;2353 for NeighborCell in Neighbors do2354 if NeighborCell.Player = Game.CurrentPlayer then begin2355 // Use only necessary power2356 AttackPower := Power - TotalAttackPower + AttackDiff;2357 if NeighborCell.GetAvialPower < AttackPower then2358 AttackPower := NeighborCell.GetAvialPower;2359 Self.Player.SetMove(NeighborCell, Cell, AttackPower, False);2360 TotalAttackPower := TotalAttackPower + AttackPower;2361 end;2362 end;2363 end;2364 2365 FreeAndNil(TargetCells);2366 end;2367 2368 procedure TComputer.AttackPlayers;2369 var2370 AllCells: TCells;2371 TotalPower: Integer;2372 AttackPower: Integer;2373 TotalAttackPower: Integer;2374 CanAttack: Integer;2375 TargetCells: TCells;2376 TargetCell: TCell;2377 NeighborCell: TCell;2378 begin2379 if Player.Defensive then Exit;2380 2381 AllCells := Game.Map.Cells;2382 TargetCells := TCells.Create;2383 TargetCells.FreeObjects := False;2384 2385 // Get list of all attack target cells2386 for TargetCell in AllCells do begin2387 if (TargetCell.Terrain <> ttVoid) and (TargetCell.Player <> Player) and2388 (TargetCell.Player <> nil) then begin2389 CanAttack := 0;2390 for NeighborCell in TargetCell.Neighbors do2391 if NeighborCell.Player = Player then begin2392 Inc(CanAttack);2393 end;2394 if CanAttack > 0 then TargetCells.Add(TargetCell);2395 end;2396 end;2397 2398 // Sort descending to attack cells with higher power first2399 // Higher power enemy cells can grow faster and is more dangerous2400 TargetCells.Sort(CellCompareDescending);2401 2402 for TargetCell in TargetCells do begin2403 // Attack to not owned cell yet2404 // Count own possible power2405 TotalPower := 0;2406 for NeighborCell in TargetCell.Neighbors do2407 if NeighborCell.Player = Player then begin2408 TotalPower := TotalPower + NeighborCell.GetAvialPower;2409 end;2410 // Attack if target is weaker2411 if Game.AttackProbability(TotalPower, TargetCell.Power) >=2412 ComputerAggroProbability[Player.Agressivity] then begin2413 // Try to limit total attacking power to necessary minimum2414 while Game.AttackProbability(TotalPower - 1, TargetCell.Power) >=2415 ComputerAggroProbability[Player.Agressivity] do2416 Dec(TotalPower);2417 2418 // Collect required attack units from our cells2419 TotalAttackPower := 0;2420 for NeighborCell in TargetCell.Neighbors do2421 if NeighborCell.Player = Player then begin2422 // Use only necessary power2423 AttackPower := TotalPower - TotalAttackPower;2424 if NeighborCell.GetAvialPower < AttackPower then2425 AttackPower := NeighborCell.GetAvialPower;2426 Self.Player.SetMove(NeighborCell, TargetCell, AttackPower, False);2427 TotalAttackPower := TotalAttackPower + AttackPower;2428 if TotalAttackPower >= TotalPower then Break;2429 end;2430 end;2431 end;2432 2433 FreeAndNil(TargetCells);2434 end;2435 2436 procedure TComputer.InnerMoves;2437 var2438 AllCells: TCells;2439 I, J: Integer;2440 C: Integer;2441 CanAttack: Integer;2442 TargetCells: TCells;2443 NewTargetCells: TCells;2444 Cells2: TCells;2445 MovedPower: Integer;2446 begin2447 // We need to move available power to borders to be available for attacks2448 // or defense2449 AllCells := Game.Map.Cells;2450 TargetCells := TCells.Create;2451 TargetCells.FreeObjects := False;2452 NewTargetCells := TCells.Create;2453 NewTargetCells.FreeObjects := False;2454 2455 // Get list of all enemy border cells2456 for C := 0 to AllCells.Count - 1 do2457 with AllCells[C] do begin2458 if (Player <> Game.CurrentPlayer) and (Player <> nil) and (Terrain <> ttVoid) then begin2459 CanAttack := 0;2460 for I := 0 to Neighbors.Count - 1 do2461 if ((Neighbors[I].Player = Game.CurrentPlayer) or2462 (Neighbors[I].Player = nil)) and (Neighbors[I].Terrain <> ttVoid) then begin2463 Inc(CanAttack);2464 end;2465 if CanAttack > 0 then TargetCells.Add(AllCells[C]);2466 end;2467 end;2468 2469 if CellProcessDirection then begin2470 // Reverse array2471 for I := 0 to (TargetCells.Count div 2) - 1 do2472 TargetCells.Exchange(I, TargetCells.Count - 1 - I);2473 end;2474 2475 Game.Map.Cells.ClearMark;2476 2477 while TargetCells.Count > 0 do begin2478 // Set mark for selected border cells2479 for C := 0 to TargetCells.Count - 1 do2480 TargetCells[C].Mark := True;2481 2482 // Move all power from unmarked cells and mark them2483 NewTargetCells.Count := 0;2484 for C := 0 to TargetCells.Count - 1 do2485 with TargetCells[C] do begin2486 for I := 0 to Neighbors.Count - 1 do begin2487 if (Neighbors[I].Terrain <> ttVoid) and (not Neighbors[I].Mark) then begin2488 if (TargetCells[C].Player = Game.CurrentPlayer) and2489 (Neighbors[I].Player = Game.CurrentPlayer) then begin2490 // Do not take units from front line2491 Cells2 := Neighbors[I].Neighbors;2492 CanAttack := 0;2493 for J := 0 to Cells2.Count - 1 do2494 if ((Cells2[J].Player <> Game.CurrentPlayer) or (Cells2[J].Player = nil))2495 and (Cells2[J].Terrain <> ttVoid) then begin2496 Inc(CanAttack);2497 end;2498 if CanAttack = 0 then begin2499 MovedPower := Neighbors[I].GetAvialPower;2500 if (TargetCells[C].GetAvialPower + TargetCells[C].GetAttackPower + MovedPower) > Game.Map.MaxPower then2501 MovedPower := Game.Map.MaxPower - TargetCells[C].GetAvialPower - TargetCells[C].GetAttackPower;2502 Player.SetMove(Neighbors[I], TargetCells[C], MovedPower, False);2503 end;2504 end;2505 Neighbors[I].Mark := True;2506 NewTargetCells.Add(Neighbors[I]);2507 end;2508 end;2509 end;2510 2511 // Use source cells NewTargetCells as new TargetCells2512 FreeAndNil(TargetCells);2513 TargetCells := NewTargetCells;2514 NewTargetCells := TCells.Create;2515 NewTargetCells.FreeObjects := False;2516 end;2517 2518 FreeAndNil(TargetCells);2519 FreeAndNil(NewTargetCells);2520 end;2521 2522 procedure TComputer.IncreaseMoves;2523 var2524 Move: TUnitMove;2525 AvailPower: Integer;2526 begin2527 // If available power remains then use all for existed unit moves2528 for Move in Player.Moves do2529 with Move do begin2530 if CellFrom.GetAvialPower > 0 then begin2531 AvailPower := CellFrom.GetAvialPower;2532 CountOnce := CountOnce + Min(AvailPower div CellFrom.MovesFrom.Count, AvailPower);2533 end;2534 end;2535 end;2536 2537 procedure TComputer.Process;2538 begin2539 AttackPlayers;2540 AttackNeutral;2541 InnerMoves;2542 IncreaseMoves;2543 //FallBack;2544 CellProcessDirection := not CellProcessDirection;2545 end;2546 2547 procedure TComputer.FallBack;2548 var2549 C: Integer;2550 I: Integer;2551 AllCells: TCells;2552 BorderCells: TCells;2553 EnemyPower: Integer;2554 begin2555 BorderCells := TCells.Create;2556 BorderCells.FreeObjects := False;2557 AllCells := Game.Map.Cells;2558 2559 // Get list of border cells2560 for C := 0 to AllCells.Count - 1 do2561 with AllCells[C] do begin2562 if (Terrain <> ttVoid) and (Player = Game.CurrentPlayer) then begin2563 if AttackersCount(AllCells[C]) > 0 then2564 BorderCells.Add(AllCells[C]);2565 end;2566 end;2567 2568 // Move all units back to inner area from weak border cells2569 for C := 0 to BorderCells.Count - 1 do2570 with BorderCells[C] do begin2571 // Calculate enemy power2572 // TODO: Do not sum different enemy power to one value2573 EnemyPower := 0;2574 for I := 0 to Neighbors.Count - 1 do2575 if (Neighbors[I].Player <> Game.CurrentPlayer) and (Neighbors[I].Player <> nil) then begin2576 Inc(EnemyPower, Neighbors[I].Power);2577 end;2578 if EnemyPower > (GetAvialPower + GetAttackPower) then begin2579 // Fallback2580 for I := MovesTo.Count - 1 downto 0 do2581 Player.Moves.Remove(MovesTo[I]);2582 for I := 0 to Neighbors.Count - 1 do2583 if (Neighbors[I].Player = Player) and (AttackersCount(Neighbors[I]) = 0) then begin2584 Player.SetMove(BorderCells[C], Neighbors[I], GetAvialPower, False);2585 Break;2586 end;2587 end;2588 end;2589 2590 FreeAndNil(BorderCells);2591 end;2592 2593 function TComputer.AttackersCount(Cell: TCell): Integer;2594 var2595 I: Integer;2596 begin2597 Result := 0;2598 for I := 0 to Cell.Neighbors.Count - 1 do2599 if (Cell.Neighbors[I].Player <> Game.CurrentPlayer) and2600 (Cell.Neighbors[I].Player <> nil) then begin2601 Inc(Result);2602 end;2603 2281 end; 2604 2282 … … 3457 3135 end; 3458 3136 3459 procedure TGame.Next Turn;3137 procedure TGame.NextPlayer; 3460 3138 var 3461 3139 PrevPlayer: TPlayer; 3462 3140 begin 3463 // TODO CurrentPlayer.View.SelectedCell := nil;3141 // Finalize current player 3464 3142 CurrentPlayer.MoveAll; 3465 3143 Map.Grow(CurrentPlayer); 3466 3144 CurrentPlayer.UpdateRepeatMoves; 3467 3145 ComputePlayerStats; 3146 3147 // Select new player 3468 3148 PrevPlayer := CurrentPlayer; 3469 3149 // Skip dead players … … 3482 3162 CurrentPlayer.PlayerMap.CheckVisibility; 3483 3163 CurrentPlayer.ReduceMovesPower; 3484 // For computers take view from previous human3485 //if CurrentPlayer.Mode = pmComputer then CurrentPlayer.View.Assign(PrevPlayer.View);3486 3164 if Assigned(FOnChange) then 3487 3165 FOnChange(Self); -
trunk/UGameClient.pas
r185 r202 6 6 7 7 uses 8 Classes, SysUtils, UGame, Forms, fgl, UGameProtocol ;8 Classes, SysUtils, UGame, Forms, fgl, UGameProtocol, UGameServer; 9 9 10 10 type 11 TClientConnectType = (ctLocal, ctNetwork); 12 11 13 { TClient } 12 14 13 15 TClient = class 14 16 private 17 FActive: Boolean; 15 18 FForm: TForm; 16 19 FGame: TGame; … … 19 22 FOnReceive: TCommandEvent; 20 23 FOnMove: TMoveEvent; 24 procedure SetActive(AValue: Boolean); 21 25 procedure SetControlPlayer(AValue: TPlayer); 22 26 procedure SetForm(AValue: TForm); … … 24 28 procedure PlayerMove(CellFrom, CellTo: TCell; var CountOnce, CountRepeat: Integer; 25 29 Update: Boolean; var Confirm: Boolean); 26 procedure ReceiveCmd(Command: TCommand; DataOut, DataIn: TStream); 30 protected 31 procedure ReceiveCmd(Command: TCommand; DataOut, DataIn: TStream); virtual; 32 procedure DoTurnStart(Sender: TObject); virtual; 27 33 public 28 34 Name: string; 29 35 View: TView; 36 LocalServer: TServer; 37 RemoteAddress: string; 38 RemotePort: Word; 39 ConnectType: TClientConnectType; 30 40 Protocol: TGameProtocolClient; 31 41 procedure DoChange; … … 38 48 property OnReceive: TCommandEvent read FOnReceive write FOnReceive; 39 49 property OnChange: TNotifyEvent read FOnChange write FOnChange; 50 property Active: Boolean read FActive write SetActive; 40 51 end; 41 52 … … 107 118 end; 108 119 120 procedure TClient.DoTurnStart(Sender: TObject); 121 begin 122 123 end; 124 109 125 procedure TClient.SetControlPlayer(AValue: TPlayer); 110 126 begin … … 115 131 if Assigned(FControlPlayer) then begin 116 132 FControlPlayer.OnMove := PlayerMove; 133 end; 134 end; 135 136 procedure TClient.SetActive(AValue: Boolean); 137 var 138 ServerClient: TServerClient; 139 begin 140 if FActive = AValue then Exit; 141 FActive := AValue; 142 if FActive then begin 143 case ConnectType of 144 ctLocal: if LocalServer.Active then begin 145 ServerClient := LocalServer.GetNewServerClient; 146 ServerClient.Player := ControlPlayer; 147 ServerClient.Protocol.Pin.Connect(Protocol.Pin); 148 end else raise Exception.Create('Local server is not active'); 149 //ctNetwork: ; 150 end; 151 end else begin 152 Protocol.Pin.Disconnect; 117 153 end; 118 154 end; … … 129 165 View := TView.Create; 130 166 Protocol := TGameProtocolClient.Create; 167 Protocol.OnTurnStart := DoTurnStart; 131 168 end; 132 169 -
trunk/UGameProtocol.pas
r185 r202 22 22 FOnGameEnd: TNotifyEvent; 23 23 FOnGameStart: TNotifyEvent; 24 FOnTurnStart: TNotifyEvent; 24 25 procedure Receive(Sender: TCommPin; Stream: TListByte); 26 procedure SendCmd(Command: TCommand); 25 27 public 26 28 Pin: TCommPin; 29 procedure TurnEnd; 27 30 procedure SendMessage(Text: string); 28 31 constructor Create; … … 32 35 property OnGameEnd: TNotifyEvent read FOnGameEnd 33 36 write FOnGameEnd; 37 property OnTurnStart: TNotifyEvent read FOnTurnStart 38 write FOnTurnStart; 34 39 end; 35 40 … … 41 46 private 42 47 FOnSendMessage: TSendMessageEvent; 48 FOnTurnEnd: TNotifyEvent; 43 49 procedure Receive(Sender: TCommPin; Stream: TListByte); 50 procedure SendCmd(Command: TCommand); 44 51 public 45 52 Pin: TCommPin; … … 48 55 procedure GameStart; 49 56 procedure GameEnd; 57 procedure TurnStart; 50 58 property OnSendMessage: TSendMessageEvent read FOnSendMessage 51 59 write FOnSendMessage; 60 property OnTurnEnd: TNotifyEvent read FOnTurnEnd 61 write FOnTurnEnd; 52 62 end; 53 63 … … 69 79 if Command = Integer(cmdTextMessage) then begin 70 80 if Assigned(FOnSendMessage) then FOnSendMessage(Data.ReadVarString); 81 end else 82 if Command = Integer(cmdTurnEnd) then begin 83 if Assigned(FOnTurnEnd) then FOnTurnEnd(Self); 71 84 end; 72 85 finally … … 75 88 end; 76 89 77 constructor TGameProtocolServer.Create; 78 begin 79 Pin := TCommPin.Create; 80 Pin.OnReceive := Receive; 81 end; 82 83 destructor TGameProtocolServer.Destroy; 84 begin 85 Pin.Free; 86 inherited Destroy; 87 end; 88 89 procedure TGameProtocolServer.GameStart; 90 procedure TGameProtocolServer.SendCmd(Command: TCommand); 90 91 var 91 92 Data: TVarBlockSerializer; … … 95 96 Data2 := TListByte.Create; 96 97 try 97 Data.WriteVarUInt(Integer( cmdGameStart));98 Data.WriteVarUInt(Integer(Command)); 98 99 Data.Stream.Position := 0; 99 100 Data.ReadVarList(Data2); … … 105 106 end; 106 107 108 constructor TGameProtocolServer.Create; 109 begin 110 Pin := TCommPin.Create; 111 Pin.OnReceive := Receive; 112 end; 113 114 destructor TGameProtocolServer.Destroy; 115 begin 116 Pin.Free; 117 inherited Destroy; 118 end; 119 120 procedure TGameProtocolServer.GameStart; 121 begin 122 SendCmd(cmdGameStart); 123 end; 124 107 125 procedure TGameProtocolServer.GameEnd; 108 var 109 Data: TVarBlockSerializer; 110 Data2: TListByte; 111 begin 112 Data := TVarBlockSerializer.Create; 113 Data2 := TListByte.Create; 114 try 115 Data.WriteVarUInt(Integer(cmdGameEnd)); 116 Data.Stream.Position := 0; 117 Data.ReadVarList(Data2); 118 Pin.Send(Data2); 119 finally 120 Data2.Free; 121 Data.Free; 122 end; 126 begin 127 SendCmd(cmdGameEnd); 128 end; 129 130 procedure TGameProtocolServer.TurnStart; 131 begin 132 SendCmd(cmdTurnStart); 123 133 end; 124 134 … … 131 141 begin 132 142 Data := TVarBlockSerializer.Create; 133 Data. ReadVarList(Stream);143 Data.WriteVarList(Stream); 134 144 Data.Stream.Position := 0; 135 145 Command := Data.ReadVarSInt; … … 140 150 if Command = Integer(cmdGameEnd) then begin 141 151 if Assigned(FOnGameEnd) then FOnGameEnd(Self); 152 end else 153 if Command = Integer(cmdTurnStart) then begin 154 if Assigned(FOnTurnStart) then FOnTurnStart(Self); 142 155 end; 143 156 finally 144 157 Data.Free; 145 158 end; 159 end; 160 161 procedure TGameProtocolClient.SendCmd(Command: TCommand); 162 var 163 Data: TVarBlockSerializer; 164 Data2: TListByte; 165 begin 166 Data := TVarBlockSerializer.Create; 167 Data2 := TListByte.Create; 168 try 169 Data.WriteVarUInt(Integer(Command)); 170 Data.Stream.Position := 0; 171 Data.ReadVarList(Data2); 172 Pin.Send(Data2); 173 finally 174 Data2.Free; 175 Data.Free; 176 end; 177 end; 178 179 procedure TGameProtocolClient.TurnEnd; 180 begin 181 SendCmd(cmdTurnEnd); 146 182 end; 147 183 -
trunk/UGameServer.pas
r199 r202 6 6 7 7 uses 8 Classes, SysUtils, UGame, DOM, XMLConf, fgl, 9 UGameProtocol; 8 Classes, SysUtils, UGame, DOM, XMLConf, fgl, UGameProtocol; 10 9 11 10 type … … 18 17 FOnReceiveCmd: TCommandEvent; 19 18 procedure ReceiveCmd(Command: TCommand; DataOut, DataIn: TStream); 19 procedure DoTurnEnd(Sender: TObject); 20 20 public 21 21 Game: TGame; 22 22 Protocol: TGameProtocolServer; 23 Player: TPlayer; 23 24 procedure DoChange; 24 25 procedure SendCmd(Command: TCommand; DataOut, DataIn: TStream); 26 procedure TurnStart; 25 27 property OnReceiveCmd: TCommandEvent read FOnReceiveCmd write 26 28 FOnReceiveCmd; … … 29 31 end; 30 32 33 { TServerClients } 34 31 35 TServerClients = class(TFPGObjectList<TServerClient>) 32 36 Game: TGame; 37 function SearchByPlayer(Player: TPlayer): TServerClient; 33 38 end; 34 39 … … 51 56 RemoteNetworkAddress: string; 52 57 RemoteNetworkPort: Word; 58 function GetNewServerClient: TServerClient; 53 59 procedure LoadConfig(Config: TXmlConfig; Path: string); 54 60 procedure SaveConfig(Config: TXmlConfig; Path: string); … … 67 73 implementation 68 74 75 { TServerClients } 76 77 function TServerClients.SearchByPlayer(Player: TPlayer): TServerClient; 78 var 79 I: Integer; 80 begin 81 I := 0; 82 while (I < Count) and (Items[I].Player <> Player) do Inc(I); 83 if I < Count then Result := Items[I] 84 else Result := nil; 85 end; 86 69 87 { TServerClient } 70 88 … … 79 97 end; 80 98 99 procedure TServerClient.TurnStart; 100 begin 101 Protocol.TurnStart; 102 end; 103 81 104 constructor TServerClient.Create; 82 105 begin 83 106 Protocol := TGameProtocolServer.Create; 107 Protocol.OnTurnEnd := DoTurnEnd; 84 108 end; 85 109 … … 94 118 if Assigned(FOnReceiveCmd) then 95 119 FOnReceiveCmd(Command, DataOut, DataIn); 120 end; 121 122 procedure TServerClient.DoTurnEnd(Sender: TObject); 123 begin 124 if Game.Running then Game.NextPlayer; 96 125 end; 97 126 … … 153 182 end; 154 183 155 procedure TServer.DoChange ;184 procedure TServer.DoChange(Sender: TObject); 156 185 var 157 186 Client: TServerClient; … … 169 198 //TODO View.Clear; 170 199 end; 200 end; 201 202 function TServer.GetNewServerClient: TServerClient; 203 begin 204 Result := TServerClient.Create; 205 Clients.Add(Result); 171 206 end; 172 207 -
trunk/xtactics.lpi
r199 r202 104 104 </Item7> 105 105 </RequiredPackages> 106 <Units Count="2 5">106 <Units Count="27"> 107 107 <Unit0> 108 108 <Filename Value="xtactics.lpr"/> … … 247 247 <ResourceBaseClass Value="Form"/> 248 248 </Unit24> 249 <Unit25> 250 <Filename Value="UClientAI.pas"/> 251 <IsPartOfProject Value="True"/> 252 </Unit25> 253 <Unit26> 254 <Filename Value="UGameConnection.pas"/> 255 <IsPartOfProject Value="True"/> 256 </Unit26> 249 257 </Units> 250 258 </ProjectOptions> … … 280 288 <Debugging> 281 289 <UseHeaptrc Value="True"/> 282 <UseExternalDbgSyms Value="True"/>283 290 </Debugging> 284 291 <Options> -
trunk/xtactics.lpr
r199 r202 11 11 CoolTranslator, TemplateGenerics 12 12 { you can add units after this }, 13 SysUtils, UFormMain, CoolStreaming, UFormServer ;13 SysUtils, UFormMain, CoolStreaming, UFormServer, UClientAI, UGameConnection; 14 14 15 15 {$R *.res} … … 32 32 Application.CreateForm(TCore, Core); 33 33 Application.CreateForm(TFormMain, FormMain); 34 Application.CreateForm(TFormServer, FormServer);35 34 Application.Run; 36 35 end.
Note:
See TracChangeset
for help on using the changeset viewer.