Changeset 298 for trunk/UPlayer.pas
- Timestamp:
- Jul 10, 2019, 5:35:15 PM (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/UPlayer.pas
r297 r298 122 122 procedure GetValue(Index: Integer; out Value); override; 123 123 procedure SetValue(Index: Integer; var Value); override; 124 function GetReferenceList(Index: Integer): TItemList; override; 124 125 class function GetClassSysName: string; override; 126 class function GetClassName: string; override; 125 127 function IsAllowedMoveTarget(CellFrom, CellTo: TPlayerCell): Boolean; 126 128 procedure ReduceMovesPower; … … 139 141 procedure LoadFromNode(Node: TDOMNode); override; 140 142 procedure SaveToNode(Node: TDOMNode); override; 141 constructor Create; 143 constructor Create; override; 142 144 destructor Destroy; override; 143 145 procedure Assign(Source: TItem); override; … … 153 155 { TPlayers } 154 156 155 TPlayers = class(T FPGObjectList<TPlayer>)157 TPlayers = class(TItemList) 156 158 public 157 159 Game: TObject; //TGame; 158 NewId: Integer; 159 function FindById(Id: Integer): TPlayer; 160 class function GetItemClass: TItemClass; override; 160 161 procedure New(Name: string; Color: TColor; Mode: TPlayerMode); 161 function GetNewId: Integer; 162 procedure LoadFromNode(Node: TDOMNode); 163 procedure SaveToNode(Node: TDOMNode); 164 constructor Create(FreeObjects: Boolean = True); 162 function CreateItem(Name: string = ''): TItem; override; 165 163 function GetFirstHuman: TPlayer; 166 procedure Assign(Source: TPlayers);167 164 procedure LoadConfig(Config: TXmlConfig; Path: string); 168 165 procedure SaveConfig(Config: TXmlConfig; Path: string); … … 216 213 SDefenderPowerPositive = 'Defender power have to be higher then or equal to 0.'; 217 214 SUnfinishedBattle = 'Unfinished battle'; 215 SLow = 'Low'; 216 SMedium = 'Medium'; 217 SHigh = 'High'; 218 SHuman = 'Human'; 219 SComputer = 'Computer'; 220 SNation = 'Nation'; 221 SMode = 'Mode'; 222 SColor = 'Color'; 223 SAgressivity = 'Agressivity'; 224 SStartUnits = 'Start units'; 225 SDefensive = 'Defensive'; 218 226 219 227 function ComparePointer(const Item1, Item2: Integer): Integer; … … 497 505 function TPlayers.GetAliveCount: Integer; 498 506 var 499 Player: TPlayer;507 I: Integer; 500 508 begin 501 509 Result := 0; 502 for Player in Selfdo503 if Player.IsAlive then Inc(Result);510 for I := 0 to Count - 1 do 511 if TPlayer(Items[I]).IsAlive then Inc(Result); 504 512 end; 505 513 506 514 procedure TPlayers.GetAlivePlayers(Players: TPlayers); 507 515 var 508 Player: TPlayer;516 I: Integer; 509 517 begin 510 518 Players.Clear; 511 for Player in Self do 512 if Player.IsAlive then Players.Add(Player); 513 end; 514 515 function TPlayers.FindById(Id: Integer): TPlayer; 519 for I := 0 to Count - 1 do 520 if TPlayer(Items[I]).IsAlive then Players.Add(TPlayer(Items[I])); 521 end; 522 523 class function TPlayers.GetItemClass: TItemClass; 524 begin 525 Result := TPlayer; 526 end; 527 528 procedure TPlayers.New(Name: string; Color: TColor; Mode: TPlayerMode); 529 begin 530 AddItem(Name); 531 TPlayer(Last).Color := Color; 532 TPlayer(Last).Mode := Mode; 533 if Mode = pmComputer then 534 TPlayer(Last).Agressivity := caMedium; 535 end; 536 537 function TPlayers.CreateItem(Name: string): TItem; 538 begin 539 Result := inherited; 540 TPlayer(Result).Game := Game; 541 end; 542 543 function TPlayers.GetFirstHuman: TPlayer; 516 544 var 517 545 I: Integer; 518 546 begin 519 547 I := 0; 520 while (I < Count) and ( Items[I].Id <> Id) do Inc(I);521 if I < Count then Result := Items[I]548 while (I < Count) and (TPlayer(Items[I]).Mode <> pmHuman) do Inc(I); 549 if I < Count then Result := TPlayer(Items[I]) 522 550 else Result := nil; 523 end;524 525 procedure TPlayers.New(Name: string; Color: TColor; Mode: TPlayerMode);526 var527 NewPlayer: TPlayer;528 begin529 NewPlayer := TPlayer.Create;530 NewPlayer.Game := Game;531 NewPlayer.Name := Name;532 NewPlayer.Color := Color;533 NewPlayer.Mode := Mode;534 NewPlayer.Id := GetNewId;535 if Mode = pmComputer then536 NewPlayer.Agressivity := caMedium;537 Add(NewPlayer);538 end;539 540 function TPlayers.GetNewId: Integer;541 begin542 Result := NewId;543 Inc(NewId);544 end;545 546 procedure TPlayers.LoadFromNode(Node: TDOMNode);547 var548 Node2: TDOMNode;549 NewPlayer: TPlayer;550 begin551 Count := 0;552 Node2 := Node.FirstChild;553 while Assigned(Node2) and (Node2.NodeName = 'Player') do begin554 NewPlayer := TPlayer.Create;555 NewPlayer.Game := Game;556 NewPlayer.LoadFromNode(Node2);557 Add(NewPlayer);558 Node2 := Node2.NextSibling;559 end;560 end;561 562 procedure TPlayers.SaveToNode(Node: TDOMNode);563 var564 I: Integer;565 NewNode: TDOMNode;566 begin567 for I := 0 to Count - 1 do begin;568 NewNode := Node.OwnerDocument.CreateElement('Player');569 Node.AppendChild(NewNode);570 Items[I].SaveToNode(NewNode);571 end;572 end;573 574 constructor TPlayers.Create(FreeObjects: Boolean = True);575 begin576 inherited;577 NewId := 1;578 end;579 580 function TPlayers.GetFirstHuman: TPlayer;581 var582 I: Integer;583 begin584 I := 0;585 while (I < Count) and (Items[I].Mode <> pmHuman) do Inc(I);586 if I < Count then Result := Items[I]587 else Result := nil;588 end;589 590 procedure TPlayers.Assign(Source: TPlayers);591 var592 I: Integer;593 begin594 while Count > Source.Count do595 Delete(Count - 1);596 while Count < Source.Count do597 Add(TPlayer.Create);598 for I := 0 to Count - 1 do begin599 Items[I].Assign(Source[I]);600 Items[I].Game := Game;601 end;602 NewId := Source.NewId;603 551 end; 604 552 … … 615 563 Count := NewCount; 616 564 for I := 0 to Count - 1 do begin 617 Items[I] := TPlayer.Create; 618 Items[I].Id := GetNewId; 619 Items[I].Game := Game; 620 Items[I].LoadConfig(Config, Path + '/Player' + IntToStr(I)); 565 Items[I] := CreateItem; 566 TPlayer(Items[I]).LoadConfig(Config, Path + '/Player' + IntToStr(I)); 621 567 end; 622 568 end; … … 629 575 begin 630 576 for I := 0 to Count - 1 do 631 Items[I].SaveConfig(Config, Path + '/Player' + IntToStr(I));577 TPlayer(Items[I]).SaveConfig(Config, Path + '/Player' + IntToStr(I)); 632 578 with Config do begin 633 579 SetValue(DOMString(Path + '/Count'), Count); … … 637 583 function TPlayers.GetAlivePlayers: TPlayerArray; 638 584 var 639 Player: TPlayer;585 I: Integer; 640 586 begin 641 587 SetLength(Result, 0); 642 for Player in Selfdo643 if Player.IsAlive then begin588 for I := 0 to Count - 1 do 589 if TPlayer(Items[I]).IsAlive then begin 644 590 SetLength(Result, Length(Result) + 1); 645 Result[Length(Result) - 1] := Player;591 Result[Length(Result) - 1] := TPlayer(Items[I]); 646 592 end; 647 593 end; … … 649 595 function TPlayers.GetAlivePlayersWithCities: TPlayerArray; 650 596 var 651 Player: TPlayer;597 I: Integer; 652 598 begin 653 599 SetLength(Result, 0); 654 for Player in Selfdo655 if Player.TotalCities > 0 then begin600 for I := 0 to Count - 1 do 601 if TPlayer(Items[I]).TotalCities > 0 then begin 656 602 SetLength(Result, Length(Result) + 1); 657 Result[Length(Result) - 1] := Player;603 Result[Length(Result) - 1] := TPlayer(Items[I]); 658 604 end; 659 605 end; … … 803 749 NewNode: TDOMNode; 804 750 begin 805 Id := ReadInteger(Node, 'Id', 0); 806 Name := ReadString(Node, 'Name', ''); 807 Color := ReadInteger(Node, 'Color', clSilver); 808 Mode := TPlayerMode(ReadInteger(Node, 'Mode', Integer(pmHuman))); 751 inherited; 809 752 StartCell := TGame(FGame).Map.Cells.FindById(ReadInteger(Node, 'StartCell', 0)); 810 StartUnits := ReadInteger(Node, 'StartUnits', 0);811 Agressivity := TComputerAgressivity(ReadInteger(Node, 'Agressivity', Integer(caMedium)));812 Defensive := ReadBoolean(Node, 'Defensive', False);813 753 814 754 with Node do begin … … 834 774 NewNode: TDOMNode; 835 775 begin 836 WriteInteger(Node, 'Id', Id); 837 WriteString(Node, 'Name', Name); 838 WriteInteger(Node, 'Color', Color); 839 WriteInteger(Node, 'Mode', Integer(Mode)); 776 inherited; 840 777 WriteInteger(Node, 'StartCell', StartCell.Id); 841 WriteInteger(Node, 'StartUnits', StartUnits);842 WriteInteger(Node, 'Agressivity', Integer(Agressivity));843 WriteBoolean(Node, 'Defensive', Defensive);844 778 845 779 with Node do begin … … 862 796 constructor TPlayer.Create; 863 797 begin 798 inherited; 864 799 Units := TUnits.Create(False); 865 800 Moves := TUnitMoves.Create; … … 879 814 FreeAndNil(Moves); 880 815 FreeAndNil(Units); 881 inherited Destroy;816 inherited; 882 817 end; 883 818 884 819 procedure TPlayer.Assign(Source: TItem); 885 820 begin 886 Id := Source.Id; 887 Name := Source.Name; 888 Color := TPlayer(Source).Color; 889 Mode := TPlayer(Source).Mode; 890 Game := TPlayer(Source).Game; 821 inherited; 822 //Game := TPlayer(Source).Game; 891 823 TotalCells := TPlayer(Source).TotalCells; 892 824 TotalUnits := TPlayer(Source).TotalUnits; … … 894 826 TotalDiscovered := TPlayer(Source).TotalDiscovered; 895 827 TotalWinObjectiveCells := TPlayer(Source).TotalWinObjectiveCells; 896 StartUnits := TPlayer(Source).StartUnits;897 828 StartCell := TPlayer(Source).StartCell; 898 Agressivity := TPlayer(Source).Agressivity;899 Defensive := TPlayer(Source).Defensive;900 Nation := TPlayer(Source).Nation;901 829 end; 902 830 … … 1266 1194 1267 1195 class function TPlayer.GetFields: TItemFields; 1196 var 1197 Field: TItemField; 1268 1198 begin 1269 1199 Result := inherited; 1270 Result.AddField(2, 'Color', 'Color', dtColor); 1271 Result.AddField(3, 'Mode', 'Mode', dtInteger); 1272 Result.AddField(4, 'StartUnits', 'StartUnits', dtInteger); 1273 Result.AddField(5, 'Agressivity', 'Agressivity', dtInteger); 1274 Result.AddField(6, 'Defensive', 'Defensive', dtBoolean); 1200 Field := Result.AddField(2, 'Nation', SNation, dtReference); 1201 Field := Result.AddField(3, 'Mode', SMode, dtEnumeration); 1202 Field.EnumStates.Add(SHuman); 1203 Field.EnumStates.Add(SComputer); 1204 Result.AddField(4, 'Color', SColor, dtColor); 1205 Field := Result.AddField(5, 'Agressivity', SAgressivity, dtEnumeration); 1206 Field.EnumStates.Add(SLow); 1207 Field.EnumStates.Add(SMedium); 1208 Field.EnumStates.Add(SHigh); 1209 Result.AddField(6, 'Defensive', SDefensive, dtBoolean); 1210 Result.AddField(7, 'StartUnits', SStartUnits, dtInteger); 1275 1211 end; 1276 1212 1277 1213 procedure TPlayer.GetValue(Index: Integer; out Value); 1278 1214 begin 1279 inherited GetValue(Index, Value); 1215 if Index = 1 then string(Value) := Name 1216 else if Index = 2 then TNation(Value) := Nation 1217 else if Index = 3 then TPlayerMode(Value) := Mode 1218 else if Index = 4 then TColor(Value) := Color 1219 else if Index = 5 then TComputerAgressivity(Value) := Agressivity 1220 else if Index = 6 then Boolean(Value) := Defensive 1221 else if Index = 7 then Integer(Value) := StartUnits 1222 else inherited; 1280 1223 end; 1281 1224 1282 1225 procedure TPlayer.SetValue(Index: Integer; var Value); 1283 1226 begin 1284 inherited SetValue(Index, Value); 1227 if Index = 1 then Name := string(Value) 1228 else if Index = 2 then Nation := TNation(Value) 1229 else if Index = 3 then Mode := TPlayerMode(Value) 1230 else if Index = 4 then Color := TColor(Value) 1231 else if Index = 5 then Agressivity := TComputerAgressivity(Value) 1232 else if Index = 6 then Defensive := Boolean(Value) 1233 else if Index = 7 then StartUnits := Integer(Value) 1234 else inherited; 1235 end; 1236 1237 function TPlayer.GetReferenceList(Index: Integer): TItemList; 1238 begin 1239 if Index = 2 then Result := TGame(Game).GameSystem.Nations 1240 else Result := nil; 1285 1241 end; 1286 1242 … … 1288 1244 begin 1289 1245 Result := 'Player'; 1246 end; 1247 1248 class function TPlayer.GetClassName: string; 1249 begin 1250 Result := SPlayer; 1290 1251 end; 1291 1252
Note:
See TracChangeset
for help on using the changeset viewer.