Changeset 147
- Timestamp:
- Nov 12, 2017, 4:29:53 PM (7 years ago)
- Location:
- trunk
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Languages/xtactics.cs.po
r145 r147 621 621 msgstr "Člověk" 622 622 623 #: ugame.scannotsetplayerstartcells624 msgid "Cannot choose start cell for player"625 msgstr "Nelze vybrat počáteční buňky hráčů."626 627 623 #: ugame.scomputer 628 624 msgctxt "ugame.scomputer" -
trunk/Languages/xtactics.po
r145 r147 599 599 msgstr "" 600 600 601 #: ugame.scannotsetplayerstartcells602 msgid "Cannot choose start cell for player"603 msgstr ""604 605 601 #: ugame.scomputer 606 602 msgctxt "ugame.scomputer" -
trunk/UGame.pas
r146 r147 58 58 NeighborsId: array of Integer; 59 59 Neighbors: TCells; 60 Mark: Boolean; 60 Mark: Boolean; // Temporary value 61 Weight: Integer; // Temporary value 61 62 Links: TCellLinks; 63 function NeighboringToVoid: Boolean; 62 64 procedure AreaExtend; 63 65 procedure FixRefId; … … 84 86 procedure FixRefId; 85 87 function FindById(Id: Integer): TCell; 88 procedure GetCellsWithWeight(List: TCells; Low, High: Integer); 86 89 procedure LoadFromNode(Node: TDOMNode); 87 90 procedure SaveToNode(Node: TDOMNode); 88 91 procedure ClearMark; 92 procedure ClearWeight; 89 93 end; 90 94 … … 418 422 procedure InitClients; 419 423 procedure SelectPlayerStartCell(Player: TPlayer); 424 procedure CalculatePlayersDistance; 425 procedure PropagatePlayerDistance(List: TCells); 420 426 public 421 427 Players: TPlayers; … … 488 494 SHuman = 'Human'; 489 495 SComputer = 'Computer'; 490 SCannotSetPlayerStartCells = 'Cannot choose start cell for player';491 496 SWrongFileFormat = 'Wrong file format'; 492 497 SUnfinishedBattle = 'Unfinished battle'; … … 774 779 procedure TMapArea.GetBorderCells(List: TCells); 775 780 var 776 I: Integer; 777 J: Integer; 778 NeighVoidCount: Integer; 781 Cell: TCell; 779 782 begin 780 783 List.Clear; 781 782 784 Map.Cells.ClearMark; 783 784 for I := 0 to Cells.Count - 1 do 785 with TCell(Cells[I]) do begin 786 NeighVoidCount := 0; 787 for J := 0 to Neighbors.Count - 1 do 788 with TCell(Neighbors[J]) do 789 if (Terrain = ttVoid) then Inc(NeighVoidCount); 790 791 if (NeighVoidCount > 0) and (Area = Self) and (not Mark) then begin 792 List.Add(TCell(Self.Cells[I])); 793 Mark := True; 794 end; 785 for Cell in Cells do begin 786 if Cell.NeighboringToVoid and (Cell.Area = Self) and (not Cell.Mark) then begin 787 List.Add(Cell); 788 Cell.Mark := True; 789 end; 795 790 end; 796 791 end; … … 1065 1060 end; 1066 1061 1062 procedure TCells.GetCellsWithWeight(List: TCells; Low, High: Integer); 1063 var 1064 Cell: TCell; 1065 begin 1066 List.Clear; 1067 for Cell in Self do 1068 if (Cell.Terrain <> ttVoid) and (Cell.Weight >= Low) and 1069 (Cell.Weight <= High) then List.Add(Cell); 1070 end; 1071 1067 1072 procedure TCells.LoadFromNode(Node: TDOMNode); 1068 1073 var … … 1096 1101 procedure TCells.ClearMark; 1097 1102 var 1098 I: Integer; 1099 begin 1100 for I := 0 to Count - 1 do 1101 TCell(Items[I]).Mark := False; 1103 Cell: TCell; 1104 begin 1105 for Cell in Self do Cell.Mark := False; 1106 end; 1107 1108 procedure TCells.ClearWeight; 1109 var 1110 Cell: TCell; 1111 begin 1112 for Cell in Self do Cell.Weight := 0; 1102 1113 end; 1103 1114 … … 1674 1685 end; 1675 1686 1687 function TCell.NeighboringToVoid: Boolean; 1688 var 1689 NeighVoidCount: Integer; 1690 NeighborCell: TCell; 1691 begin 1692 NeighVoidCount := 0; 1693 for NeighborCell in Neighbors do 1694 if (NeighborCell.Terrain = ttVoid) then Inc(NeighVoidCount); 1695 Result := NeighVoidCount > 0; 1696 end; 1697 1676 1698 procedure TCell.SetArea(AValue: TMapArea); 1677 1699 begin … … 1684 1706 procedure TCell.AreaExtend; 1685 1707 var 1686 I: Integer; 1687 begin 1688 for I := 0 to Neighbors.Count - 1 do 1689 with TCell(Neighbors[I]) do 1690 if (Terrain <> ttVoid) and (not Assigned(Area)) then begin 1691 Area := Self.Area; 1692 AreaExtend; 1708 NeighborCell: TCell; 1709 begin 1710 for NeighborCell in Neighbors do 1711 if (NeighborCell.Terrain <> ttVoid) and (not Assigned(NeighborCell.Area)) then begin 1712 NeighborCell.Area := Area; 1713 NeighborCell.AreaExtend; 1693 1714 end; 1694 1715 end; … … 1702 1723 Neighbors.Count := Length(NeighborsId); 1703 1724 for I := 0 to Length(NeighborsId) - 1 do begin 1704 1725 Neighbors[I] := Map.Cells.FindById(NeighborsId[I]); 1705 1726 end; 1706 1727 end; … … 2751 2772 FoundCell2 := SearchDifferentCellArea(List, FoundCell1.Area, TMapArea(Map.Areas[I])); 2752 2773 if Assigned(FoundCell2) then begin 2753 // Check if link not existsalready2774 // Check if link doesn't exist already 2754 2775 if not Assigned(FoundCell1.Links.FindByCells(FoundCell1, FoundCell2)) then begin 2755 2776 NewLink := TCellLink.Create; … … 2788 2809 with TCell(Map.Cells[C]) do 2789 2810 if (Terrain <> ttVoid) and (not Assigned(Area)) then begin 2790 NewArea := TMapArea (Map.Areas[Map.Areas.Add(TMapArea.Create)]);2811 NewArea := TMapArea.Create; 2791 2812 NewArea.Id := Map.Areas.Count; 2792 2813 NewArea.Map := Map; 2814 Map.Areas.Add(NewArea); 2793 2815 Area := NewArea; 2794 2816 AreaExtend; … … 2820 2842 procedure TGame.SelectPlayerStartCell(Player: TPlayer); 2821 2843 var 2822 Counter: Integer; 2844 LongestDistance: Integer; 2845 Cell: TCell; 2846 List: TCells; 2823 2847 begin 2824 2848 with Player do begin 2825 // Try to obtain start cell for each player 2826 StartCell := nil; 2827 Counter := 0; 2828 while not Assigned(StartCell) or Assigned(StartCell.Player) or 2829 (StartCell.Terrain = ttVoid) do begin 2830 StartCell := TCell(Map.Cells[Random(Map.Cells.Count)]); 2831 Inc(Counter); 2832 if Counter > 100 then 2833 raise Exception.Create(SCannotSetPlayerStartCells); 2834 end; 2835 end; 2849 Map.Cells.ClearMark; 2850 Map.Cells.ClearWeight; 2851 CalculatePlayersDistance; 2852 2853 // Calculate longest distance 2854 LongestDistance := 0; 2855 for Cell in Map.Cells do 2856 if (Cell.Terrain <> ttVoid) and (Cell.Weight > LongestDistance) then 2857 LongestDistance := Cell.Weight; 2858 2859 List := TCells.Create; 2860 List.FreeObjects := False; 2861 Map.Cells.GetCellsWithWeight(List, Round(LongestDistance * 0.6), Round(LongestDistance * 0.8)); 2862 StartCell := List[Random(List.Count)]; 2863 FreeAndNil(List); 2864 end; 2865 end; 2866 2867 procedure TGame.CalculatePlayersDistance; 2868 var 2869 Player: TPlayer; 2870 List: TCells; 2871 begin 2872 for Player in Players do 2873 if Assigned(Player.StartCell) then begin 2874 Player.StartCell.Weight := 1; 2875 Player.StartCell.Mark := True; 2876 List := TCells.Create; 2877 List.FreeObjects := False; 2878 List.Add(Player.StartCell); 2879 PropagatePlayerDistance(List); 2880 FreeAndNil(List); 2881 end; 2882 end; 2883 2884 procedure TGame.PropagatePlayerDistance(List: TCells); 2885 var 2886 NeighborCell: TCell; 2887 NeighborList: TCells; 2888 Cell: TCell; 2889 begin 2890 NeighborList := TCells.Create; 2891 NeighborList.FreeObjects := False; 2892 2893 for Cell in List do begin 2894 for NeighborCell in Cell.Neighbors do begin 2895 if (NeighborCell.Terrain <> ttVoid) and 2896 ((not NeighborCell.Mark) or (NeighborCell.Weight > Cell.Weight + 1)) then begin 2897 NeighborCell.Weight := Cell.Weight + 1; 2898 NeighborCell.Mark := True; 2899 NeighborList.Add(NeighborCell); 2900 end; 2901 end; 2902 end; 2903 if NeighborList.Count > 0 then 2904 PropagatePlayerDistance(NeighborList); 2905 FreeAndNil(NeighborList); 2836 2906 end; 2837 2907 … … 3149 3219 C: Integer; 3150 3220 LastAreaCount: Integer; 3221 Player: TPlayer; 3151 3222 begin 3152 3223 FileName := SNewGameFile; … … 3177 3248 end; 3178 3249 3179 for I := 0 to Players.Count - 1 do 3180 with TPlayer(Players[I]) do begin 3250 for Player in Players do Player.StartCell := nil; 3251 I := 0; 3252 for Player in Players do 3253 with Player do begin 3181 3254 Clear; 3182 3255 PlayerMap.Update; 3183 3256 if (Map.Size.X > 0) and (Map.Size.Y > 0) then begin 3184 SelectPlayerStartCell( TPlayer(Players[I]));3257 SelectPlayerStartCell(Player); 3185 3258 if SymetricMap and (I = 1) then 3186 3259 StartCell := TCell(Map.Cells[Map.Cells.Count - 1 - Map.Cells.IndexOf(TPlayer(Players[0]).StartCell)]); 3187 3260 3188 3261 StartCell.Terrain := ttCity; 3189 StartCell.Player := TPlayer(Players[I]);3190 StartCell.Power := TPlayer(Players[I]).StartUnits;3262 StartCell.Player := Player; 3263 StartCell.Power := Player.StartUnits; 3191 3264 end; 3192 3265 PlayerMap.CheckVisibility; 3266 Inc(I); 3193 3267 end; 3194 3268 if Players.Count > 0 then CurrentPlayer := TPlayer(Players[0]) -
trunk/xtactics.lpi
r145 r147 277 277 <StackChecks Value="True"/> 278 278 </Checks> 279 <VerifyObjMethodCallValidity Value="True"/> 279 280 </CodeGeneration> 280 281 <Linking>
Note:
See TracChangeset
for help on using the changeset viewer.