Changeset 64 for trunk/UGame.pas
- Timestamp:
- Sep 26, 2014, 9:01:50 PM (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/UGame.pas
r62 r64 7 7 uses 8 8 Classes, SysUtils, ExtCtrls, Graphics, Contnrs, XMLConf, XMLRead, XMLWrite, 9 DOM, Math ;9 DOM, Math, FileUtil, UXMLUtils; 10 10 11 11 const … … 23 23 TPlayer = class; 24 24 TView = class; 25 TUnitMoves = class; 25 26 26 27 TFloatPoint = record … … 39 40 procedure SetPower(AValue: Integer); 40 41 public 42 Id: Integer; 41 43 PosPx: TPoint; 42 44 Polygon: TPointArray; 43 45 Terrain: TTerrainType; 44 46 Player: TPlayer; 45 MovesFrom: T ObjectList; // TList<TMove>46 MovesTo: T ObjectList; // TList<TMove>47 MovesFrom: TUnitMoves; 48 MovesTo: TUnitMoves; 47 49 Neighbors: TObjectList; // TList<TCell> 48 50 procedure Assign(Source: TCell); … … 106 108 procedure LoadFromFile(FileName: string); virtual; 107 109 procedure SaveToFile(FileName: string); virtual; 110 procedure LoadFromNode(Node: TDOMNode); 111 procedure SaveToNode(Node: TDOMNode); 108 112 function PosToCell(Pos: TPoint; View: TView): TCell; virtual; 109 113 function CellToPos(Cell: TCell): TPoint; virtual; … … 173 177 procedure SetGame(AValue: TGame); 174 178 public 179 Id: Integer; 175 180 Name: string; 176 181 Color: TColor; … … 181 186 TotalCities: Integer; 182 187 StartUnits: Integer; 188 procedure LoadFromNode(Node: TDOMNode); 189 procedure SaveToNode(Node: TDOMNode); 183 190 procedure ComputerTurn; 184 191 procedure Paint(PaintBox: TPaintBox); … … 191 198 TPlayerArray = array of TPlayer; 192 199 200 { TPlayers } 201 193 202 TPlayers = class(TObjectList) 194 203 procedure LoadFromNode(Node: TDOMNode); 204 procedure SaveToNode(Node: TDOMNode); 195 205 end; 196 206 … … 207 217 CountOnce: Integer; 208 218 CountRepeat: Integer; 219 procedure LoadFromNode(Node: TDOMNode); 220 procedure SaveToNode(Node: TDOMNode); 209 221 constructor Create; 210 222 destructor Destroy; override; 211 223 property CellFrom: TCell read FCellFrom write SetCellFrom; 212 224 property CellTo: TCell read FCellTo write SetCellTo; 225 end; 226 227 { TUnitMoves } 228 229 TUnitMoves = class(TObjectList) 230 procedure LoadFromNode(Node: TDOMNode); 231 procedure SaveToNode(Node: TDOMNode); 213 232 end; 214 233 … … 248 267 CityPercentage: Integer; 249 268 CurrentPlayer: TPlayer; 250 Moves: T ObjectList; // TList<TUnitMove>269 Moves: TUnitMoves; 251 270 TurnCounter: Integer; 252 271 WinObjective: TWinObjective; … … 254 273 StayAliveForDefinedTurns: Integer; 255 274 MaxNeutralUnits: Integer; 275 FileName: string; 256 276 function AttackProbability(AttackCount, DefendCount, Depth: Integer): Double; 257 277 procedure SaveConfig(Config: TXmlConfig; Path: string); 258 278 procedure LoadConfig(Config: TXmlConfig; Path: string); 279 procedure LoadFromFile(FileName: string); 280 procedure SaveToFile(FileName: string); 259 281 procedure ComputePlayerStats; 260 282 function GetAlivePlayers: TPlayerArray; … … 292 314 SComputer = 'Computer'; 293 315 SCannotSetPlayerStartCells = 'Cannot choose start cell for player'; 316 SWrongFileFormat = 'Wrong file format'; 294 317 SUnfinishedBattle = 'Unfinished battle'; 318 SNewGameFile = 'New game.xtg'; 295 319 296 320 procedure InitStrings; … … 354 378 if Y < Result.Top then 355 379 Result.Top := Y; 380 end; 381 end; 382 383 { TPlayers } 384 385 procedure TPlayers.LoadFromNode(Node: TDOMNode); 386 begin 387 388 end; 389 390 procedure TPlayers.SaveToNode(Node: TDOMNode); 391 var 392 I: Integer; 393 NewNode: TDOMNode; 394 begin 395 for I := 0 to Count - 1 do begin; 396 NewNode := Node.OwnerDocument.CreateElement('Player'); 397 Node.AppendChild(NewNode); 398 TPlayer(Items[I]).SaveToNode(NewNode); 399 end; 400 end; 401 402 { TUnitMoves } 403 404 procedure TUnitMoves.LoadFromNode(Node: TDOMNode); 405 begin 406 407 end; 408 409 procedure TUnitMoves.SaveToNode(Node: TDOMNode); 410 var 411 I: Integer; 412 NewNode: TDOMNode; 413 begin 414 for I := 0 to Count - 1 do begin; 415 NewNode := Node.OwnerDocument.CreateElement('UnitMove'); 416 Node.AppendChild(NewNode); 417 TUnitMove(Items[I]).SaveToNode(NewNode); 356 418 end; 357 419 end; … … 595 657 end; 596 658 659 procedure TMap.LoadFromNode(Node: TDOMNode); 660 begin 661 DefaultCellSize.X := ReadInteger(Node, 'DefaultCellSizeX', 1); 662 DefaultCellSize.Y := ReadInteger(Node, 'DefaultCellSizeY', 1); 663 MaxPower := ReadInteger(Node, 'MaxPower', 99); 664 end; 665 666 procedure TMap.SaveToNode(Node: TDOMNode); 667 var 668 NewNode: TDOMNode; 669 NewNode2: TDOMNode; 670 I: Integer; 671 begin 672 WriteInteger(Node, 'DefaultCellSizeX', DefaultCellSize.X); 673 WriteInteger(Node, 'DefaultCellSizeY', DefaultCellSize.Y); 674 WriteInteger(Node, 'MaxPower', MaxPower); 675 NewNode := Node.OwnerDocument.CreateElement('Cells'); 676 Node.AppendChild(NewNode); 677 for I := 0 to Cells.Count - 1 do 678 with TCell(Cells[I]) do begin 679 NewNode2 := Node.OwnerDocument.CreateElement('Cell'); 680 NewNode.AppendChild(NewNode2); 681 WriteInteger(NewNode2, 'Id', I); 682 WriteInteger(NewNode2, 'Power', Power); 683 WriteInteger(NewNode2, 'Terrain', Integer(Terrain)); 684 WriteInteger(NewNode2, 'PosX', PosPx.X); 685 WriteInteger(NewNode2, 'PosY', PosPx.Y); 686 end; 687 end; 688 597 689 function TMap.PosToCell(Pos: TPoint; View: TView): TCell; 598 690 var … … 792 884 end; 793 885 886 procedure TUnitMove.LoadFromNode(Node: TDOMNode); 887 begin 888 CountOnce := ReadInteger(Node, 'CountOnce', 0); 889 CountRepeat := ReadInteger(Node, 'CountRepeat', 0); 890 //CellFrom := ReadInteger(Node, 'CellFrom', 0); 891 //CellTo := ReadInteger(Node, 'CellTo', 0); 892 end; 893 894 procedure TUnitMove.SaveToNode(Node: TDOMNode); 895 begin 896 WriteInteger(Node, 'CountOnce', CountOnce); 897 WriteInteger(Node, 'CountRepeat', CountRepeat); 898 WriteInteger(Node, 'CellFrom', CellFrom.Id); 899 WriteInteger(Node, 'CellTo', CellTo.Id); 900 end; 901 794 902 constructor TUnitMove.Create; 795 903 begin … … 917 1025 Neighbors := TObjectList.Create; 918 1026 Neighbors.OwnsObjects := False; 919 MovesFrom := T ObjectList.Create;1027 MovesFrom := TUnitMoves.Create; 920 1028 MovesFrom.OwnsObjects := False; 921 MovesTo := T ObjectList.Create;1029 MovesTo := TUnitMoves.Create; 922 1030 MovesTo.OwnsObjects := False; 923 1031 end; … … 977 1085 FGame := AValue; 978 1086 View.Game := Game; 1087 end; 1088 1089 procedure TPlayer.LoadFromNode(Node: TDOMNode); 1090 begin 1091 Id := ReadInteger(Node, 'Id', 0); 1092 Name := ReadString(Node, 'Name', ''); 1093 Color := ReadInteger(Node, 'Color', clSilver); 1094 Mode := TPlayerMode(ReadInteger(Node, 'Mode', Integer(pmHuman))); 1095 end; 1096 1097 procedure TPlayer.SaveToNode(Node: TDOMNode); 1098 begin 1099 WriteInteger(Node, 'Id', Id); 1100 WriteString(Node, 'Name', Name); 1101 WriteInteger(Node, 'Color', Color); 1102 WriteInteger(Node, 'Mode', Integer(Mode)); 979 1103 end; 980 1104 … … 1349 1473 begin 1350 1474 I := 0; 1351 while (I < Moves.Count) and ((TUnitMove(Moves[I]).CellTo <> Move.CellFrom) and1475 while (I < Moves.Count) and ((TUnitMove(Moves[I]).CellTo <> Move.CellFrom) or 1352 1476 (TUnitMove(Moves[I]).CellFrom <> Move.CellTo)) do Inc(I); 1353 1477 if I < Moves.Count then CounterMove := TUnitMove(Moves[I]) … … 1390 1514 GrowCells := TGrowCells(GetValue(Path + '/GrowCells', Integer(gcPlayerAll))); 1391 1515 WinObjective := TWinObjective(GetValue(Path + '/WinObjective', Integer(woDefeatAllOponents))); 1516 end; 1517 end; 1518 1519 procedure TGame.LoadFromFile(FileName: string); 1520 var 1521 NewNode: TDOMNode; 1522 Value: Integer; 1523 Doc: TXMLDocument; 1524 Dump: TStringList; 1525 RootNode: TDOMNode; 1526 begin 1527 Self.FileName := FileName; 1528 ReadXMLFile(Doc, UTF8Decode(FileName)); 1529 with Doc do try 1530 if Doc.DocumentElement.NodeName <> 'XtacticsGame' then 1531 raise Exception.Create(SWrongFileFormat); 1532 RootNode := Doc.DocumentElement; 1533 with RootNode do begin 1534 VoidEnabled := ReadBoolean(RootNode, 'VoidEnabled', False); 1535 VoidPercentage := ReadInteger(RootNode, 'VoidPercentage', 0); 1536 MaxNeutralUnits := ReadInteger(RootNode, 'MaxNeutralUnits', 3); 1537 GrowCells := TGrowCells(ReadInteger(RootNode, 'GrowCells', Integer(gcNone))); 1538 GrowAmount := TGrowAmount(ReadInteger(RootNode, 'GrowAmount', Integer(gaByOne))); 1539 CityEnabled := ReadBoolean(RootNode, 'CityEnabled', False); 1540 CityPercentage := ReadInteger(RootNode, 'CityPercentage', 0); 1541 TurnCounter := ReadInteger(RootNode, 'TurnCounter', 0); 1542 WinObjective := TWinObjective(ReadInteger(RootNode, 'WinObjective', Integer(woDefeatAllOponents))); 1543 ReadInteger(RootNode, 'StayAliveForDefinedTurns', StayAliveForDefinedTurns); 1544 1545 NewNode := FindNode('Map'); 1546 if Assigned(NewNode) then 1547 Map.LoadFromNode(NewNode); 1548 1549 NewNode := FindNode('Players'); 1550 if Assigned(NewNode) then 1551 Players.LoadFromNode(NewNode); 1552 1553 NewNode := FindNode('UnitMoves'); 1554 if Assigned(NewNode) then 1555 Moves.LoadFromNode(NewNode); 1556 end; 1557 finally 1558 Doc.Free; 1559 end; 1560 end; 1561 1562 procedure TGame.SaveToFile(FileName: string); 1563 var 1564 NewNode: TDOMNode; 1565 NewNode2: TDOMNode; 1566 Doc: TXMLDocument; 1567 RootNode: TDOMNode; 1568 I: Integer; 1569 begin 1570 Self.FileName := FileName; 1571 Doc := TXMLDocument.Create; 1572 with Doc do try 1573 RootNode := CreateElement('XtacticsGame'); 1574 AppendChild(RootNode); 1575 with RootNode do begin 1576 WriteBoolean(RootNode, 'VoidEnabled', VoidEnabled); 1577 WriteInteger(RootNode, 'VoidPercentage', VoidPercentage); 1578 WriteInteger(RootNode, 'MaxNeutralUnits', MaxNeutralUnits); 1579 WriteInteger(RootNode, 'GrowCells', Integer(GrowCells)); 1580 WriteInteger(RootNode, 'GrowAmount', Integer(GrowAmount)); 1581 WriteBoolean(RootNode, 'CityEnabled', CityEnabled); 1582 WriteInteger(RootNode, 'CityPercentage', CityPercentage); 1583 WriteInteger(RootNode, 'TurnCounter', TurnCounter); 1584 WriteInteger(RootNode, 'WinObjective', Integer(WinObjective)); 1585 WriteInteger(RootNode, 'StayAliveForDefinedTurns', StayAliveForDefinedTurns); 1586 1587 NewNode := OwnerDocument.CreateElement('Map'); 1588 AppendChild(NewNode); 1589 Map.SaveToNode(NewNode); 1590 1591 NewNode := OwnerDocument.CreateElement('Players'); 1592 AppendChild(NewNode); 1593 for I := 0 to Players.Count - 1 do begin; 1594 NewNode2 := OwnerDocument.CreateElement('Player'); 1595 NewNode.AppendChild(NewNode2); 1596 TPlayer(Players[I]).SaveToNode(NewNode2); 1597 end; 1598 1599 NewNode := OwnerDocument.CreateElement('UnitMoves'); 1600 AppendChild(NewNode); 1601 Moves.SaveToNode(NewNode); 1602 end; 1603 ForceDirectoriesUTF8(ExtractFileDir(FileName)); 1604 WriteXMLFile(Doc, UTF8Decode(FileName)); 1605 finally 1606 Doc.Free; 1392 1607 end; 1393 1608 end; … … 1484 1699 Player: TPlayer; 1485 1700 begin 1486 Moves := T ObjectList.Create;1701 Moves := TUnitMoves.Create; 1487 1702 Map := TMap.Create; 1488 1703 Players := TPlayers.Create; … … 1528 1743 C: Integer; 1529 1744 begin 1745 FileName := SNewGameFile; 1530 1746 TurnCounter := 1; 1531 1747 Moves.Clear;
Note:
See TracChangeset
for help on using the changeset viewer.