Changeset 42 for trunk/UGame.pas
- Timestamp:
- Mar 18, 2014, 12:16:04 AM (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/UGame.pas
r40 r42 39 39 Terrain: TTerrainType; 40 40 Player: TPlayer; 41 MovesFrom: TObjectList; 42 MovesTo: TObjectList; 41 MovesFrom: TObjectList; // TList<TMove> 42 MovesTo: TObjectList; // TList<TMove> 43 43 function GetColor: TColor; 44 44 function GetAvialPower: Integer; … … 87 87 MaxPower: Integer; 88 88 DefaultCellSize: TPoint; 89 procedure DrawArrow(Canvas: TCanvas; View: TView; Pos: TPoint; Angle: Double; Size: TPoint); 89 procedure DrawArrow(Canvas: TCanvas; View: TView; Pos: TPoint; Angle: Double; 90 Size: TPoint; Text: string); 90 91 function IsCellsNeighbor(Cell1, Cell2: TCell): Boolean; virtual; 91 92 function IsValidIndex(Index: TPoint): Boolean; virtual; … … 169 170 TotalUnits: Integer; 170 171 TotalCells: Integer; 172 TotalCities: Integer; 171 173 StartUnits: Integer; 172 174 procedure ComputerTurn; … … 184 186 end; 185 187 186 { T Move }187 188 T Move = class188 { TUnitMove } 189 190 TUnitMove = class 189 191 private 190 192 FCellFrom: TCell; … … 194 196 procedure SetCellTo(AValue: TCell); 195 197 public 196 List: TObjectList; // TList<T Move>198 List: TObjectList; // TList<TUnitMove> 197 199 CountOnce: Integer; 198 200 CountRepeat: Integer; … … 211 213 TGrowCells = (gcNone, gcPlayerCities, gcPlayerAll); 212 214 TMapType = (mtNone, mtHexagon, mtSquare); 215 TWinObjective = (woDefeatAllOponents, woDefeatAllOponentsCities, 216 woSpecialCaptureCell, woStayAliveForDefinedTurns); 213 217 214 218 TGame = class … … 235 239 CityPercentage: Integer; 236 240 CurrentPlayer: TPlayer; 237 Moves: TObjectList; // TList<T Move>241 Moves: TObjectList; // TList<TUnitMove> 238 242 TurnCounter: Integer; 243 WinObjective: TWinObjective; 244 SpecialCaptureCell: TCell; 245 StayAliveForDefinedTurns: Integer; 246 MaxNeutralUnits: Integer; 239 247 procedure SaveConfig(Config: TXmlConfig; Path: string); 240 248 procedure LoadConfig(Config: TXmlConfig; Path: string); 241 249 procedure ComputePlayerStats; 242 250 function GetAlivePlayers: TPlayerArray; 251 function GetAlivePlayersWithCities: TPlayerArray; 243 252 procedure NextTurn; 253 procedure CheckWinObjective; 244 254 constructor Create; 245 255 destructor Destroy; override; 246 256 procedure New; 257 procedure EndGame(Winner: TPlayer = nil); 247 258 property Running: Boolean read FRunning write SetRunning; 248 259 property MapType: TMapType read FMapType write SetMapType; … … 517 528 for I := 0 to Cell.MovesFrom.Count - 1 do begin 518 529 PosFrom := CellToPos(Cell); 519 PosTo := CellToPos(T Move(Cell.MovesFrom[I]).CellTo);520 if T Move(Cell.MovesFrom[I]).CountRepeat > 0 then Pen.Width := 2530 PosTo := CellToPos(TUnitMove(Cell.MovesFrom[I]).CellTo); 531 if TUnitMove(Cell.MovesFrom[I]).CountRepeat > 0 then Pen.Width := 2 521 532 else Pen.Width := 1; 522 533 Angle := ArcTan((PosTo.Y - PosFrom.Y) / (PosTo.X - PosFrom.X)); … … 524 535 DrawArrow(Canvas, View, View.CellToCanvasPos(Point(Trunc(PosFrom.X + (PosTo.X - PosFrom.X) / 3), 525 536 Trunc(PosFrom.Y + (PosTo.Y - PosFrom.Y) / 3))), 526 Angle, Point(Trunc(HexSize.X / 4), Trunc(HexSize.Y / 4))); 537 Angle, Point(Trunc(HexSize.X / 4), Trunc(HexSize.Y / 4)), 538 IntToStr(TUnitMove(Cell.MovesFrom[I]).CountOnce)); 527 539 Pen.Width := 1; 528 540 end; … … 557 569 end; 558 570 559 procedure TMap.DrawArrow(Canvas: TCanvas; View: TView; Pos: TPoint; Angle: Double; Size: TPoint); 571 procedure TMap.DrawArrow(Canvas: TCanvas; View: TView; Pos: TPoint; 572 Angle: Double; Size: TPoint; Text: string); 560 573 var 561 574 Points: array of TPoint; … … 582 595 for I := 0 to Length(Points) - 1 do 583 596 Points[I] := Point(Trunc(FPoints[I].X + Pos.X), Trunc(FPoints[I].Y + Pos.Y)); 584 Canvas.Polygon(Points); 597 with Canvas do begin 598 Polygon(Points); 599 Brush.Style := bsClear; 600 Font.Color := clBlack; 601 Font.Size := Trunc(4 * View.Zoom); 602 TextOut(Pos.X - TextWidth(Text) div 2, 603 Pos.Y - TextHeight(Text) div 2, Text); 604 Pen.Width := 1; 605 end; 585 606 end; 586 607 … … 656 677 Player.TotalCells := Player.TotalCells + 1; 657 678 Player.TotalUnits := Player.TotalUnits + Power; 679 if Terrain = ttCity then 680 Player.TotalCities := Player.TotalCities + 1; 658 681 end; 659 682 end; … … 714 737 end; 715 738 716 { T Move }717 718 procedure T Move.SetCellFrom(AValue: TCell);739 { TUnitMove } 740 741 procedure TUnitMove.SetCellFrom(AValue: TCell); 719 742 begin 720 743 if FCellFrom = AValue then Exit; … … 728 751 end; 729 752 730 procedure T Move.SetCellTo(AValue: TCell);753 procedure TUnitMove.SetCellTo(AValue: TCell); 731 754 begin 732 755 if FCellTo = AValue then Exit; … … 740 763 end; 741 764 742 constructor T Move.Create;765 constructor TUnitMove.Create; 743 766 begin 744 767 FCellFrom := nil; … … 746 769 end; 747 770 748 destructor T Move.Destroy;771 destructor TUnitMove.Destroy; 749 772 var 750 773 LastState: Boolean; … … 831 854 Result := Power; 832 855 for I := 0 to MovesFrom.Count - 1 do 833 Result := Result - T Move(MovesFrom[I]).CountOnce;856 Result := Result - TUnitMove(MovesFrom[I]).CountOnce; 834 857 if Result < 0 then Result := 0; 835 858 end; … … 849 872 begin 850 873 for I := MovesFrom.Count - 1 downto 0 do 851 T Move(MovesFrom[I]).Free;874 TUnitMove(MovesFrom[I]).Free; 852 875 FreeAndNil(MovesFrom); 853 876 for I := MovesTo.Count - 1 downto 0 do 854 T Move(MovesTo[I]).Free;877 TUnitMove(MovesTo[I]).Free; 855 878 FreeAndNil(MovesTo); 856 879 inherited Destroy; … … 1048 1071 I := 0; 1049 1072 while I < Moves.Count do 1050 with T Move(Moves[I]) do begin1073 with TUnitMove(Moves[I]) do begin 1051 1074 if CountOnce > 0 then begin 1052 1075 if CellFrom.Player = Player then begin … … 1078 1101 // Remove empty moves 1079 1102 for I := Moves.Count - 1 downto 0 do 1080 if (T Move(Moves[I]).CellFrom.Player = Player) and1081 (T Move(Moves[I]).CountOnce = 0) and (TMove(Moves[I]).CountRepeat = 0) then1103 if (TUnitMove(Moves[I]).CellFrom.Player = Player) and 1104 (TUnitMove(Moves[I]).CountOnce = 0) and (TUnitMove(Moves[I]).CountRepeat = 0) then 1082 1105 Moves.Delete(I); 1083 1106 end; … … 1088 1111 begin 1089 1112 for I := Moves.Count - 1 downto 0 do 1090 if T Move(Moves[I]).CellFrom = Cell then1113 if TUnitMove(Moves[I]).CellFrom = Cell then 1091 1114 Moves.Delete(I); 1092 1115 end; … … 1110 1133 procedure TGame.SetMove(CellFrom, CellTo: TCell; Power: Integer); 1111 1134 var 1112 NewMove: T Move;1113 OldMove: T Move;1135 NewMove: TUnitMove; 1136 OldMove: TUnitMove; 1114 1137 I: Integer; 1115 1138 CountOnce: Integer; … … 1118 1141 begin 1119 1142 I := 0; 1120 while (I < Moves.Count) and ((T Move(Moves[I]).CellFrom <> CellFrom) or1121 (T Move(Moves[I]).CellTo <> CellTo)) do Inc(I);1122 if I < Moves.Count then OldMove := T Move(Moves[I])1143 while (I < Moves.Count) and ((TUnitMove(Moves[I]).CellFrom <> CellFrom) or 1144 (TUnitMove(Moves[I]).CellTo <> CellTo)) do Inc(I); 1145 if I < Moves.Count then OldMove := TUnitMove(Moves[I]) 1123 1146 else OldMove := nil; 1124 1147 if Assigned(OldMove) then begin … … 1138 1161 if (CountOnce = 0) and (CountRepeat = 0) then Moves.Delete(I) 1139 1162 else begin 1140 T Move(Moves[I]).CountOnce := CountOnce;1141 T Move(Moves[I]).CountRepeat := CountRepeat;1163 TUnitMove(Moves[I]).CountOnce := CountOnce; 1164 TUnitMove(Moves[I]).CountRepeat := CountRepeat; 1142 1165 end; 1143 1166 end else begin 1144 1167 // Add new move 1145 1168 if (CountOnce > 0) or (CountRepeat > 0) then begin 1146 NewMove := T Move(Moves[Moves.Add(TMove.Create)]);1169 NewMove := TUnitMove(Moves[Moves.Add(TUnitMove.Create)]); 1147 1170 NewMove.List := Moves; 1148 1171 NewMove.CellFrom := CellFrom; … … 1177 1200 begin 1178 1201 for I := 0 to Moves.Count - 1 do 1179 with T Move(Moves[I]) do begin1202 with TUnitMove(Moves[I]) do begin 1180 1203 if CellFrom.Player = Player then 1181 1204 if CountRepeat <= CellFrom.GetAvialPower then … … 1197 1220 SetValue(Path + '/GrowAmount', Integer(GrowAmount)); 1198 1221 SetValue(Path + '/GrowCells', Integer(GrowCells)); 1222 SetValue(Path + '/WinObjective', Integer(WinObjective)); 1199 1223 end; 1200 1224 end; … … 1212 1236 GrowAmount := TGrowAmount(GetValue(Path + '/GrowAmount', Integer(gaBySquareRoot))); 1213 1237 GrowCells := TGrowCells(GetValue(Path + '/GrowCells', Integer(gcPlayerAll))); 1238 WinObjective := TWinObjective(GetValue(Path + '/WinObjective', Integer(woDefeatAllOponents))); 1214 1239 end; 1215 1240 end; … … 1223 1248 TotalUnits := 0; 1224 1249 TotalCells := 0; 1250 TotalCities := 0; 1225 1251 end; 1226 1252 Map.ComputePlayerStats; … … 1239 1265 end; 1240 1266 1267 function TGame.GetAlivePlayersWithCities: TPlayerArray; 1268 var 1269 I: Integer; 1270 begin 1271 SetLength(Result, 0); 1272 for I := 0 to Players.Count - 1 do 1273 if TPlayer(Players[I]).TotalCities > 0 then begin 1274 SetLength(Result, Length(Result) + 1); 1275 Result[Length(Result) - 1] := TPlayer(Players[I]); 1276 end; 1277 end; 1278 1241 1279 procedure TGame.NextTurn; 1242 1280 var 1243 1281 PrevPlayer: TPlayer; 1244 AlivePlayers: TPlayerArray;1245 1282 begin 1246 1283 MoveAll(CurrentPlayer); … … 1253 1290 until CurrentPlayer.TotalCells > 0; 1254 1291 if Players.IndexOf(CurrentPlayer) < Players.IndexOf(PrevPlayer) then Inc(TurnCounter); 1255 AlivePlayers := GetAlivePlayers; 1256 if (Length(AlivePlayers) <= 1) then begin 1257 Running := False; 1258 if Assigned(OnWin) and (Length(AlivePlayers) > 0) then OnWin(TPlayer(AlivePlayers[0])); 1259 end; 1292 CheckWinObjective; 1260 1293 UpdateRepeatMoves(CurrentPlayer); 1261 1294 // For computers take view from previous human 1262 1295 if CurrentPlayer.Mode = pmComputer then CurrentPlayer.View.Assign(PrevPlayer.View); 1296 end; 1297 1298 procedure TGame.CheckWinObjective; 1299 var 1300 AlivePlayers: TPlayerArray; 1301 Winner: TPlayer; 1302 begin 1303 Winner := nil; 1304 if WinObjective = woDefeatAllOponents then begin 1305 AlivePlayers := GetAlivePlayers; 1306 if (Length(AlivePlayers) <= 1) then begin 1307 if Length(AlivePlayers) > 0 then Winner := TPlayer(AlivePlayers[0]); 1308 EndGame(Winner); 1309 end; 1310 end else 1311 if WinObjective = woDefeatAllOponentsCities then begin 1312 AlivePlayers := GetAlivePlayersWithCities; 1313 if (Length(AlivePlayers) <= 1) then begin 1314 if Length(AlivePlayers) > 0 then Winner := TPlayer(AlivePlayers[0]); 1315 EndGame(Winner); 1316 end; 1317 end else 1318 if WinObjective = woSpecialCaptureCell then begin 1319 if Assigned(SpecialCaptureCell) and Assigned(SpecialCaptureCell.Player) then 1320 EndGame(SpecialCaptureCell.Player); 1321 end else 1322 if WinObjective = woStayAliveForDefinedTurns then begin 1323 // TODO: Not only one can win but multiple human players can survive. 1324 if TurnCounter > StayAliveForDefinedTurns then 1325 EndGame(nil); 1326 end; 1263 1327 end; 1264 1328 … … 1287 1351 VoidEnabled := True; 1288 1352 VoidPercentage := 20; 1353 MaxNeutralUnits := 4; 1289 1354 1290 1355 Map.Game := Self; … … 1320 1385 else Terrain := ttNormal; 1321 1386 end; 1322 Power := Random( 4);1387 Power := Random(MaxNeutralUnits + 1); 1323 1388 Player := nil; 1324 1389 end; … … 1336 1401 raise Exception.Create(SCannotSetPlayerStartCells); 1337 1402 end; 1338 if CityEnabled then StartCell.Terrain := ttCity 1339 else StartCell.Terrain := ttNormal; 1403 StartCell.Terrain := ttCity; 1340 1404 StartCell.Player := TPlayer(Players[I]); 1341 1405 StartCell.Power := TPlayer(Players[I]).StartUnits; … … 1345 1409 end; 1346 1410 CurrentPlayer := TPlayer(Players[0]); 1411 end; 1412 1413 procedure TGame.EndGame(Winner: TPlayer = nil); 1414 begin 1415 Running := False; 1416 if Assigned(OnWin) and Assigned(Winner) then OnWin(Winner); 1347 1417 end; 1348 1418 … … 1533 1603 PosFrom, PosTo: TPoint; 1534 1604 Angle: Double; 1605 ArrowCenter: TPoint; 1535 1606 1536 1607 procedure PaintHexagon(Pos: TPoint; Text: string); … … 1596 1667 for I := 0 to Cell.MovesFrom.Count - 1 do begin 1597 1668 PosFrom := CellToPos(Cell); 1598 PosTo := CellToPos(T Move(Cell.MovesFrom[I]).CellTo);1599 if T Move(Cell.MovesFrom[I]).CountRepeat > 0 then Pen.Width := 21669 PosTo := CellToPos(TUnitMove(Cell.MovesFrom[I]).CellTo); 1670 if TUnitMove(Cell.MovesFrom[I]).CountRepeat > 0 then Pen.Width := 2 1600 1671 else Pen.Width := 1; 1601 1672 Angle := ArcTan((PosTo.Y - PosFrom.Y) / (PosTo.X - PosFrom.X)); 1602 1673 if Sign(PosTo.X - PosFrom.X) = -1 then Angle := Angle + Pi; 1603 DrawArrow(Canvas, View, View.CellToCanvasPos(Point(Trunc(PosFrom.X + (PosTo.X - PosFrom.X) / 3), 1604 Trunc(PosFrom.Y + (PosTo.Y - PosFrom.Y) / 3))), 1605 Angle, Point(Trunc(HexSize.X / 4), Trunc(HexSize.Y / 4))); 1606 Pen.Width := 1; 1674 ArrowCenter := View.CellToCanvasPos(Point(Trunc(PosFrom.X + (PosTo.X - PosFrom.X) / 3), 1675 Trunc(PosFrom.Y + (PosTo.Y - PosFrom.Y) / 3))); 1676 DrawArrow(Canvas, View, ArrowCenter, 1677 Angle, Point(Trunc(HexSize.X / 4), Trunc(HexSize.Y / 4)), 1678 IntToStr(TUnitMove(Cell.MovesFrom[I]).CountOnce)); 1607 1679 end; 1608 1680 end;
Note:
See TracChangeset
for help on using the changeset viewer.