Changeset 303 for branches/highdpi/AI/StdAI/ToolAI.pas
- Timestamp:
- Mar 9, 2021, 9:19:49 AM (4 years ago)
- File:
-
- 1 edited
-
branches/highdpi/AI/StdAI/ToolAI.pas (modified) (16 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/highdpi/AI/StdAI/ToolAI.pas
r210 r303 5 5 6 6 uses 7 {$IFDEF DEBUG}SysUtils,{$ENDIF} // necessary for debug exceptions 8 Math, 7 SysUtils, Math, 9 8 {$IFDEF DEBUG}Names,{$ENDIF} 10 Protocol, CustomAI; 11 9 Protocol, CustomAI; 12 10 13 11 type 14 TGroupTransportPlan=record15 LoadLoc, uixTransport, nLoad, TurnsEmpty, TurnsLoaded: integer;16 uixLoad: array[0..15] of integer;17 end; 18 19 20 TToolAI = class(TCustomAI)21 protected22 {$IFDEF DEBUG}DebugMap: array[0..lxmax *lymax-1] of integer;{$ENDIF}23 24 function CenterOfEmpire: integer;12 TGroupTransportPlan = record 13 LoadLoc, uixTransport, nLoad, TurnsEmpty, TurnsLoaded: integer; 14 uixLoad: array[0..15] of integer; 15 end; 16 17 18 TToolAI = class(TCustomAI) 19 protected 20 {$IFDEF DEBUG}DebugMap: array[0..lxmax * lymax - 1] of integer;{$ENDIF} 21 22 function CenterOfEmpire: integer; 25 23 // tile that is in the middle of all own cities 26 24 27 function CityTaxBalance(cix: integer; const CityReport: TCityReport): integer;25 function CityTaxBalance(cix: integer; const CityReport: TCityReport): integer; 28 26 // calculates exact difference of income and maintenance cost for a single city 29 27 // positive result = income higher than maintenance … … 31 29 // respects production and food converted to gold 32 30 // CityReport must have been prepared before 33 procedure SumCities(TaxRate: integer; var TaxSum, ScienceSum: integer);31 procedure SumCities(TaxRate: integer; var TaxSum, ScienceSum: integer); 34 32 // calculates exact total tax and science income 35 33 // tax is reduced by maintenance (so might be negative) 36 34 // luxury not supported 37 35 38 procedure OptimizeCityTiles;36 procedure OptimizeCityTiles; 39 37 // obsolete; use City_OptimizeTiles instead 40 38 41 procedure GetCityProdPotential;39 procedure GetCityProdPotential; 42 40 // calculates potential collected production resources of a city 43 41 // result: list for all cities in CityResult 44 procedure GetCityTradePotential;42 procedure GetCityTradePotential; 45 43 // calculates potential collected trade resources of a city 46 44 // result: list for all cities in CityResult 47 45 48 procedure JobAssignment_Initialize;46 procedure JobAssignment_Initialize; 49 47 // initialization, must be called first of the JobAssignment functions 50 procedure JobAssignment_AddJob(Loc, Job, Score: integer);48 procedure JobAssignment_AddJob(Loc, Job, Score: integer); 51 49 // add job for settlers with certain score 52 50 // jobs include founding cities! 53 procedure JobAssignment_AddUnit(uix: integer);51 procedure JobAssignment_AddUnit(uix: integer); 54 52 // add a settler unit to do jobs 55 procedure JobAssignment_Go;53 procedure JobAssignment_Go; 56 54 // to be called after all jobs and the settlers for them have been added 57 55 // assigns each job to one settler, moves the settlers and makes them work … … 59 57 // starting a job one turn earlier counts the same as 4 points of score 60 58 // function does not cancel jobs that are already started 61 function JobAssignment_GotJob(uix: integer): boolean;59 function JobAssignment_GotJob(uix: integer): boolean; 62 60 // can be called after JobAssignment_Go to find out whether 63 61 // a certain settler has been assigned a job to 64 62 65 procedure AnalyzeMap;63 procedure AnalyzeMap; 66 64 // calculates formations and districts 67 65 68 function CheckStep(MoveStyle, TimeBeforeStep, CrossCorner: integer; 69 var TimeAfterStep, RecoverTurns: integer; FromTile, ToTile: integer; IsCapture: boolean): integer; 66 function CheckStep(MoveStyle, TimeBeforeStep, CrossCorner: integer; 67 var TimeAfterStep, RecoverTurns: integer; FromTile, ToTile: integer; 68 IsCapture: boolean): integer; 70 69 // forecast single unit move between adjacent tiles 71 70 // format of TimeBeforeStep and TimeAfterStep: $1000*number of turns + $800-MP left … … 75 74 // CrossCorner=1 for long moves that cross the tile corner, =0 for short ones that don't 76 75 77 function GetMyMoveStyle(mix,Health: integer): integer;78 79 function Unit_MoveEx(uix,ToLoc: integer; Options: integer = 0): integer;80 81 procedure SeaTransport_BeginInitialize;82 procedure SeaTransport_EndInitialize;76 function GetMyMoveStyle(mix, Health: integer): integer; 77 78 function Unit_MoveEx(uix, ToLoc: integer; Options: integer = 0): integer; 79 80 procedure SeaTransport_BeginInitialize; 81 procedure SeaTransport_EndInitialize; 83 82 // sea transport, obligatory call order: 84 83 // 1. BeginInitialize … … 91 90 // - all transports have same capacity 92 91 // - no transport is damaged 93 procedure SeaTransport_AddLoad(uix: integer);94 procedure SeaTransport_AddTransport(uix: integer);95 procedure SeaTransport_AddDestination(Loc: integer);96 function SeaTransport_MakeGroupPlan(var TransportPlan: TGroupTransportPlan): boolean;92 procedure SeaTransport_AddLoad(uix: integer); 93 procedure SeaTransport_AddTransport(uix: integer); 94 procedure SeaTransport_AddDestination(Loc: integer); 95 function SeaTransport_MakeGroupPlan(var TransportPlan: TGroupTransportPlan): boolean; 97 96 // make plan for group of units to transport from a single loading location by a single transport 98 97 // the plan optimizes: … … 104 103 // function returns false if no more transports are possible 105 104 106 function CurrentMStrength(Domain: integer): integer;105 function CurrentMStrength(Domain: integer): integer; 107 106 end; 108 107 109 108 110 109 const 111 // no-formations 112 nfUndiscovered=-1; nfPole=-2; nfPeace=-3; 113 114 // return codes of CheckStep 115 csOk=0; 110 // no-formations 111 nfUndiscovered = -1; 112 nfPole = -2; 113 nfPeace = -3; 114 115 // return codes of CheckStep 116 csOk = 0; 116 117 // step is valid 117 118 // TimeAfterMove has been calculated 118 csForbiddenTile=1;119 csForbiddenTile = 1; 119 120 // unit can not move onto this tile 120 121 // TimeAfterMove not calculated 121 csForbiddenStep=2;122 csForbiddenStep = 2; 122 123 // (ZoC unit only) unit can not do this step because of ZoC violation 123 124 // maybe tile can be reached using another way 124 125 // TimeAfterMove not calculated 125 csCheckTerritory=3;126 csCheckTerritory = 3; 126 127 // move within other nations's territory shortly after making peace 127 128 // step is only possible if RO.Territory is the same for both tiles 128 129 // TimeAfterMove has been calculated 129 130 130 // Unit_MoveEx131 mxAdjacent=$00000001;132 133 134 var 135 nContinent, nOcean, nDistrict: integer;136 Formation: array[0..lxmax*lymax-1] of integer;131 // Unit_MoveEx 132 mxAdjacent = $00000001; 133 134 135 var 136 nContinent, nOcean, nDistrict: integer; 137 Formation: array[0..lxmax * lymax - 1] of integer; 137 138 // water: ocean index, land: continent index, sorted by size 138 139 // territory unpassable due to peace treaty divides a continent 139 District: array[0..lxmax*lymax-1] of integer;140 District: array[0..lxmax * lymax - 1] of integer; 140 141 // index of coherent own territory, sorted by size 141 CityResult: array[0..nCmax-1] of integer; 142 143 Advancedness: array[0..nAdv-1] of integer; // total number of prerequisites for each advance 142 CityResult: array[0..nCmax - 1] of integer; 143 144 Advancedness: array[0..nAdv - 1] of integer; 145 // total number of prerequisites for each advance 144 146 145 147 … … 147 149 148 150 uses 149 Pile;151 Pile; 150 152 151 153 type 152 pinteger=^integer;153 154 var 155 // for JobAssignment156 MaxScore: integer;157 TileJob,TileJobScore: array[0..lxmax*lymax-1] of byte;158 JobLocOfSettler: array[0..nUmax-1] of integer; // ToAssign = find job159 160 // for Transport161 TransportMoveStyle, TransportCapacity, nTransportLoad: integer;162 InitComplete, HaveDestinations: boolean;163 uixTransportLoad, TransportAvailable: array[0..nUmax-1] of integer;164 TurnsAfterLoad: array[0..lxmax*lymax-1] of shortint;165 166 167 procedure ReplaceD(Start, Stop: pinteger; Raider, Twix: integer);168 begin 169 while Start<>Stop do154 pinteger = ^integer; 155 156 var 157 // for JobAssignment 158 MaxScore: integer; 159 TileJob, TileJobScore: array[0..lxmax * lymax - 1] of byte; 160 JobLocOfSettler: array[0..nUmax - 1] of integer; // ToAssign = find job 161 162 // for Transport 163 TransportMoveStyle, TransportCapacity, nTransportLoad: integer; 164 InitComplete, HaveDestinations: boolean; 165 uixTransportLoad, TransportAvailable: array[0..nUmax - 1] of integer; 166 TurnsAfterLoad: array[0..lxmax * lymax - 1] of shortint; 167 168 169 procedure ReplaceD(Start, Stop: pinteger; Raider, Twix: integer); 170 begin 171 while Start <> Stop do 170 172 begin 171 if Start^=Raider then Start^:=Twix; 172 inc(Start) 173 if Start^ = Raider then 174 Start^ := Twix; 175 Inc(Start); 173 176 end; 174 177 end; … … 176 179 function NextZero(Start, Stop: pinteger; Mask: cardinal): pinteger; 177 180 begin 178 while (Start<>Stop) and (Start^ and Mask<>0) do inc(Start); 179 result:=Start; 181 while (Start <> Stop) and (Start^ and Mask <> 0) do 182 Inc(Start); 183 Result := Start; 180 184 end; 181 185 … … 183 187 function TToolAI.CenterOfEmpire: integer; 184 188 var 185 cix,Loc,x,y,sy,n: integer;186 a,su,sv: double;187 begin 188 n:=0;189 sy:=0;190 su:=0;191 sv:=0;192 for cix:=0 to RO.nCity-1 do189 cix, Loc, x, y, sy, n: integer; 190 a, su, sv: double; 191 begin 192 n := 0; 193 sy := 0; 194 su := 0; 195 sv := 0; 196 for cix := 0 to RO.nCity - 1 do 193 197 begin 194 Loc:=MyCity[cix].Loc;195 if Loc>=0 then196 begin 197 y:=Loc div G.lx;198 x:=Loc-y*G.lx;199 inc(sy,y);200 a:=2*pi*x/G.lx;201 su:=su+cos(a);202 sv:=sv+sin(a);203 inc(n);204 end; 205 end; 206 a:=arctan2(sv,su);207 x:=round(G.lx*a/(2*pi));208 while x>=G.lx do209 dec(x,G.lx);210 while x<0 do211 inc(x,G.lx);212 result:=((2*sy+n) div (2*n))*G.lx + x;198 Loc := MyCity[cix].Loc; 199 if Loc >= 0 then 200 begin 201 y := Loc div G.lx; 202 x := Loc - y * G.lx; 203 Inc(sy, y); 204 a := 2 * pi * x / G.lx; 205 su := su + cos(a); 206 sv := sv + sin(a); 207 Inc(n); 208 end; 209 end; 210 a := arctan2(sv, su); 211 x := round(G.lx * a / (2 * pi)); 212 while x >= G.lx do 213 Dec(x, G.lx); 214 while x < 0 do 215 Inc(x, G.lx); 216 Result := ((2 * sy + n) div (2 * n)) * G.lx + x; 213 217 end; 214 218 215 219 function TToolAI.CityTaxBalance(cix: integer; const CityReport: TCityReport): integer; 216 220 var 217 i: integer;218 begin 219 result:=0;220 if (CityReport.Working-CityReport.Happy<=MyCity[cix].Size shr 1) {no disorder} 221 and (MyCity[cix].Flags and chCaptured=0) then // not captured221 i: integer; 222 begin 223 Result := 0; 224 if (CityReport.Working - CityReport.Happy <= MyCity[cix].Size shr 1) {no disorder} and 225 (MyCity[cix].Flags and chCaptured = 0) then // not captured 222 226 begin 223 inc(result, CityReport.Tax);224 if (MyCity[cix].Project and (cpImp+cpIndex)=cpImp+imTrGoods)225 and (CityReport.ProdRep>CityReport.Support) then226 inc(result, CityReport.ProdRep-CityReport.Support);227 if ((RO.Government=gLybertarianism)228 or (MyCity[cix].Size>=NeedAqueductSize)229 and (CityReport.FoodRep<CityReport.Eaten+2))230 and (CityReport.FoodRep>CityReport.Eaten) then231 inc(result, CityReport.FoodRep-CityReport.Eaten);232 end;233 for i:=28 to nImp-1 do if MyCity[cix].Built[i]>0 then234 dec(result, Imp[i].Maint);227 Inc(Result, CityReport.Tax); 228 if (MyCity[cix].Project and (cpImp + cpIndex) = cpImp + imTrGoods) and 229 (CityReport.ProdRep > CityReport.Support) then 230 Inc(Result, CityReport.ProdRep - CityReport.Support); 231 if ((RO.Government = gLybertarianism) or (MyCity[cix].Size >= 232 NeedAqueductSize) and (CityReport.FoodRep < CityReport.Eaten + 2)) and 233 (CityReport.FoodRep > CityReport.Eaten) then 234 Inc(Result, CityReport.FoodRep - CityReport.Eaten); 235 end; 236 for i := 28 to nImp - 1 do 237 if MyCity[cix].Built[i] > 0 then 238 Dec(Result, Imp[i].Maint); 235 239 end; 236 240 237 241 procedure TToolAI.SumCities(TaxRate: integer; var TaxSum, ScienceSum: integer); 238 242 var 239 cix,p1: integer; 240 CityReport: TCityReport; 241 begin 242 TaxSum:=0; ScienceSum:=0; 243 if RO.Government=gAnarchy then exit; 244 for p1:=0 to nPl-1 do 245 if RO.Tribute[p1]<=RO.TributePaid[p1] then // don't rely on tribute from bankrupt nations 246 TaxSum:=TaxSum+RO.Tribute[p1]; 247 for cix:=0 to RO.nCity-1 do if MyCity[cix].Loc>=0 then 248 begin 249 City_GetHypoReport(cix,-1,TaxRate,0,CityReport); 250 if (CityReport.Working-CityReport.Happy<=MyCity[cix].Size shr 1) {no disorder} 251 and (MyCity[cix].Flags and chCaptured=0) then // not captured 252 ScienceSum:=ScienceSum+CityReport.Science; 253 TaxSum:=TaxSum+CityTaxBalance(cix, CityReport); 254 end; 243 cix, p1: integer; 244 CityReport: TCityReport; 245 begin 246 TaxSum := 0; 247 ScienceSum := 0; 248 if RO.Government = gAnarchy then 249 exit; 250 for p1 := 0 to nPl - 1 do 251 if RO.Tribute[p1] <= RO.TributePaid[p1] then 252 // don't rely on tribute from bankrupt nations 253 TaxSum := TaxSum + RO.Tribute[p1]; 254 for cix := 0 to RO.nCity - 1 do 255 if MyCity[cix].Loc >= 0 then 256 begin 257 City_GetHypoReport(cix, -1, TaxRate, 0, CityReport); 258 if (CityReport.Working - CityReport.Happy <= MyCity[cix].Size shr 259 1) {no disorder} and (MyCity[cix].Flags and chCaptured = 0) then // not captured 260 ScienceSum := ScienceSum + CityReport.Science; 261 TaxSum := TaxSum + CityTaxBalance(cix, CityReport); 262 end; 255 263 end; 256 264 … … 260 268 261 269 const 262 pctOptimize=0; pctGetProdPotential=1; pctGetTradePotential=2; 270 pctOptimize = 0; 271 pctGetProdPotential = 1; 272 pctGetTradePotential = 2; 263 273 264 274 procedure TToolAI.OptimizeCityTiles; 265 275 var 266 cix: integer; 267 begin 268 for cix:=0 to RO.nCity-1 do with MyCity[cix] do if Loc>=0 then 269 City_OptimizeTiles(cix); 276 cix: integer; 277 begin 278 for cix := 0 to RO.nCity - 1 do 279 with MyCity[cix] do 280 if Loc >= 0 then 281 City_OptimizeTiles(cix); 270 282 end; 271 283 272 284 procedure TToolAI.GetCityProdPotential; 273 285 var 274 cix: integer; 275 Advice: TCityTileAdviceData; 276 begin 277 for cix:=0 to RO.nCity-1 do with MyCity[cix] do if Loc>=0 then 278 begin 279 Advice.ResourceWeights:=rwMaxProd; 280 Server(sGetCityTileAdvice, me, cix, Advice); 281 CityResult[cix]:=Advice.CityReport.ProdRep; // considers factory, but shouldn't 282 end; 286 cix: integer; 287 Advice: TCityTileAdviceData; 288 begin 289 for cix := 0 to RO.nCity - 1 do 290 with MyCity[cix] do 291 if Loc >= 0 then 292 begin 293 Advice.ResourceWeights := rwMaxProd; 294 Server(sGetCityTileAdvice, me, cix, Advice); 295 CityResult[cix] := Advice.CityReport.ProdRep; // considers factory, but shouldn't 296 end; 283 297 end; 284 298 285 299 procedure TToolAI.GetCityTradePotential; 286 300 var 287 cix: integer; 288 Advice: TCityTileAdviceData; 289 begin 290 for cix:=0 to RO.nCity-1 do with MyCity[cix] do if Loc>=0 then 291 begin 292 Advice.ResourceWeights:=rwMaxScience; 293 Server(sGetCityTileAdvice, me, cix, Advice); 294 CityResult[cix]:=Advice.CityReport.Trade; 295 end; 301 cix: integer; 302 Advice: TCityTileAdviceData; 303 begin 304 for cix := 0 to RO.nCity - 1 do 305 with MyCity[cix] do 306 if Loc >= 0 then 307 begin 308 Advice.ResourceWeights := rwMaxScience; 309 Server(sGetCityTileAdvice, me, cix, Advice); 310 CityResult[cix] := Advice.CityReport.Trade; 311 end; 296 312 end; 297 313 … … 301 317 302 318 const 303 ToAssign=lxmax*lymax;319 ToAssign = lxmax * lymax; 304 320 305 321 procedure TToolAI.JobAssignment_Initialize; 306 322 begin 307 fillchar(JobLocOfSettler, RO.nUn*sizeof(integer), $FF); // -1308 fillchar(TileJob, MapSize, jNone);309 fillchar(TileJobScore, MapSize, 0);310 MaxScore:=0;323 fillchar(JobLocOfSettler, RO.nUn * sizeof(integer), $FF); // -1 324 fillchar(TileJob, MapSize, jNone); 325 fillchar(TileJobScore, MapSize, 0); 326 MaxScore := 0; 311 327 end; 312 328 313 329 procedure TToolAI.JobAssignment_AddJob(Loc, Job, Score: integer); 314 330 begin 315 if Score>255 then Score:=255; 316 if Score>TileJobScore[Loc] then 331 if Score > 255 then 332 Score := 255; 333 if Score > TileJobScore[Loc] then 317 334 begin 318 TileJob[Loc]:=Job; 319 TileJobScore[Loc]:=Score; 320 if Score>MaxScore then MaxScore:=Score 335 TileJob[Loc] := Job; 336 TileJobScore[Loc] := Score; 337 if Score > MaxScore then 338 MaxScore := Score; 321 339 end; 322 340 end; … … 324 342 procedure TToolAI.JobAssignment_AddUnit(uix: integer); 325 343 begin 326 assert(MyModel[MyUnit[uix].mix].Kind in [mkSettler,mkSlaves]);327 JobLocOfSettler[uix]:=ToAssign 344 assert(MyModel[MyUnit[uix].mix].Kind in [mkSettler, mkSlaves]); 345 JobLocOfSettler[uix] := ToAssign; 328 346 end; 329 347 330 348 function TToolAI.JobAssignment_GotJob(uix: integer): boolean; 331 349 begin 332 result:=JobLocOfSettler[uix]>=0;350 Result := JobLocOfSettler[uix] >= 0; 333 351 end; 334 352 335 353 procedure TToolAI.JobAssignment_Go; 336 354 const 337 DistanceScore=4;338 StepSizeByTerrain: array[0..11] of integer=339 (0, 0, 1, 2, 1, 1, 0, 1, 0, 1, 1, 2);340 //Oc-Sh-Gr-De-Pr-Tu-Ar-Sw-XX-Fo-Hi-Mo341 var 342 uix,BestScore,BestCount,BestLoc,BestJob,BestDistance,TestLoc,NextLoc,343 TestDistance,V8,TestScore,StepSize,MoveResult: integer;344 UnitsToAssign: boolean;345 Adjacent: TVicinity8Loc;346 SettlerOfJobLoc,DistToLoc: array[0..lxmax*lymax-1] of smallint;355 DistanceScore = 4; 356 StepSizeByTerrain: array[0..11] of integer = 357 (0, 0, 1, 2, 1, 1, 0, 1, 0, 1, 1, 2); 358 //Oc-Sh-Gr-De-Pr-Tu-Ar-Sw-XX-Fo-Hi-Mo 359 var 360 uix, BestScore, BestCount, BestLoc, BestJob, BestDistance, TestLoc, 361 NextLoc, TestDistance, V8, TestScore, StepSize, MoveResult: integer; 362 UnitsToAssign: boolean; 363 Adjacent: TVicinity8Loc; 364 SettlerOfJobLoc, DistToLoc: array[0..lxmax * lymax - 1] of smallint; 347 365 // DistToLoc is only defined where SettlerOfJobLoc>=0 348 TileChecked: array[0..lxmax*lymax-1] of boolean;349 begin 350 fillchar(SettlerOfJobLoc, MapSize*2, $FF); // -1351 352 // keep up jobs that are already started353 for uix:=0 to RO.nUn-1 do354 if (MyUnit[uix].Loc>=0) and (MyUnit[uix].Job>jNone) then355 begin 356 JobLocOfSettler[uix]:=MyUnit[uix].Loc;357 SettlerOfJobLoc[MyUnit[uix].Loc]:=uix;358 DistToLoc[MyUnit[uix].Loc]:=0359 end; 360 361 // assign remaining jobs to remaining settlers362 UnitsToAssign:=true;363 while UnitsToAssign do366 TileChecked: array[0..lxmax * lymax - 1] of boolean; 367 begin 368 fillchar(SettlerOfJobLoc, MapSize * 2, $FF); // -1 369 370 // keep up jobs that are already started 371 for uix := 0 to RO.nUn - 1 do 372 if (MyUnit[uix].Loc >= 0) and (MyUnit[uix].Job > jNone) then 373 begin 374 JobLocOfSettler[uix] := MyUnit[uix].Loc; 375 SettlerOfJobLoc[MyUnit[uix].Loc] := uix; 376 DistToLoc[MyUnit[uix].Loc] := 0; 377 end; 378 379 // assign remaining jobs to remaining settlers 380 UnitsToAssign := True; 381 while UnitsToAssign do 364 382 begin 365 UnitsToAssign:=false; 366 for uix:=0 to RO.nUn-1 do if JobLocOfSettler[uix]=ToAssign then 367 begin 368 BestJob:=jNone; 369 BestScore:=-999999; 370 FillChar(TileChecked,MapSize*sizeof(boolean),false); 371 Pile.Create(MapSize); 372 Pile.Put(MyUnit[uix].Loc,0); // start search for new job at current location 373 while Pile.Get(TestLoc,TestDistance) do 374 begin 375 // add surrounding tiles to queue, but only if there's a chance to beat BestScore 376 if MaxScore-DistanceScore*(TestDistance+1)>=BestScore then 383 UnitsToAssign := False; 384 for uix := 0 to RO.nUn - 1 do 385 if JobLocOfSettler[uix] = ToAssign then 386 begin 387 BestJob := jNone; 388 BestScore := -999999; 389 FillChar(TileChecked, MapSize * sizeof(boolean), False); 390 Pile.Create(MapSize); 391 Pile.Put(MyUnit[uix].Loc, 0); // start search for new job at current location 392 while Pile.Get(TestLoc, TestDistance) do 377 393 begin 378 V8_to_Loc(TestLoc,Adjacent);379 for V8:=0 to 7 do394 // add surrounding tiles to queue, but only if there's a chance to beat BestScore 395 if MaxScore - DistanceScore * (TestDistance + 1) >= BestScore then 380 396 begin 381 NextLoc:=Adjacent[V8]; 382 if (NextLoc>=0) and not TileChecked[NextLoc] 383 and (Map[NextLoc] and fTerrain<>fUNKNOWN) then 397 V8_to_Loc(TestLoc, Adjacent); 398 for V8 := 0 to 7 do 384 399 begin 385 StepSize:=StepSizeByTerrain[Map[NextLoc] and fTerrain]; 386 if (StepSize>0) // no water or arctic tile 387 and (Map[NextLoc] and (fUnit or fOwned)<>fUnit) // no foreign unit 388 and ((RO.Territory[NextLoc]<0) or (RO.Territory[NextLoc]=me)) // no foreign territory 389 and (Map[TestLoc] and Map[NextLoc] and fInEnemyZoC=0) then // move not prevented by ZoC 390 Pile.Put(NextLoc,TestDistance+StepSize) 391 // simplification, only optimal for 150 mp units in land with no roads 400 NextLoc := Adjacent[V8]; 401 if (NextLoc >= 0) and not TileChecked[NextLoc] and 402 (Map[NextLoc] and fTerrain <> fUNKNOWN) then 403 begin 404 StepSize := StepSizeByTerrain[Map[NextLoc] and fTerrain]; 405 if (StepSize > 0) // no water or arctic tile 406 and (Map[NextLoc] and (fUnit or fOwned) <> fUnit) // no foreign unit 407 and ((RO.Territory[NextLoc] < 0) or 408 (RO.Territory[NextLoc] = me)) // no foreign territory 409 and (Map[TestLoc] and Map[NextLoc] and fInEnemyZoC = 0) then 410 // move not prevented by ZoC 411 Pile.Put(NextLoc, TestDistance + StepSize); 412 // simplification, only optimal for 150 mp units in land with no roads 413 end; 414 end; 415 end; 416 417 // check tile for job 418 if (TileJob[TestLoc] > jNone) and 419 ((MyModel[MyUnit[uix].mix].Kind <> mkSlaves) or 420 (TileJob[TestLoc] <> jCity)) and 421 ((SettlerOfJobLoc[TestLoc] < 0) or (DistToLoc[TestLoc] > TestDistance)) then 422 begin 423 TestScore := integer(TileJobScore[TestLoc]) - DistanceScore * TestDistance; 424 if TestScore > BestScore then 425 BestCount := 0; 426 if TestScore >= BestScore then 427 begin 428 Inc(BestCount); 429 if random(BestCount) = 0 then 430 begin 431 BestScore := TestScore; 432 BestLoc := TestLoc; 433 BestJob := TileJob[TestLoc]; 434 BestDistance := TestDistance; 435 end; 436 end; 437 end; 438 TileChecked[TestLoc] := True; 439 end; 440 Pile.Free; 441 442 if BestJob > jNone then 443 begin // new job found for this unit 444 if SettlerOfJobLoc[BestLoc] >= 0 then 445 begin // another unit was already assigned to this job, but is not as close -- reassign that unit! 446 JobLocOfSettler[SettlerOfJobLoc[BestLoc]] := ToAssign; 447 UnitsToAssign := True; 448 end; 449 JobLocOfSettler[uix] := BestLoc; 450 SettlerOfJobLoc[BestLoc] := uix; 451 DistToLoc[BestLoc] := BestDistance; 452 end 453 else 454 JobLocOfSettler[uix] := -1; // no jobs for this settler 455 end; // for uix 456 end; 457 458 // move settlers and start new jobs 459 for uix := 0 to RO.nUn - 1 do 460 with MyUnit[uix] do 461 if (Loc >= 0) and (Job = jNone) and (JobLocOfSettler[uix] >= 0) then 462 begin 463 if Loc <> JobLocOfSettler[uix] then 464 repeat 465 MoveResult := Unit_Move(uix, JobLocOfSettler[uix]) 466 until (MoveResult < rExecuted) or (MoveResult and 467 (rLocationReached or rMoreTurns or rUnitRemoved) <> 0); 468 if (Loc = JobLocOfSettler[uix]) and (Movement >= 100) then 469 Unit_StartJob(uix, TileJob[JobLocOfSettler[uix]]); 470 end; 471 end; // JobAssignment_Go 472 473 474 //------------------------------------------------------------------------------ 475 // Map Analysis 476 477 procedure TToolAI.AnalyzeMap; 478 var 479 i, j, Loc, Loc1, V8, Count, Kind, MostIndex: integer; 480 Adjacent: TVicinity8Loc; 481 IndexOfID: array[0..lxmax * lymax - 1] of smallint; 482 IDOfIndex: array[0..lxmax * lymax div 2 - 1] of smallint; 483 begin 484 fillchar(District, MapSize * 4, $FF); 485 for Loc := 0 to MapSize - 1 do 486 if Map[Loc] and fTerrain = fUNKNOWN then 487 Formation[Loc] := nfUndiscovered 488 else if Map[Loc] and fTerrain = fArctic then 489 Formation[Loc] := nfPole 490 else if Map[Loc] and fPeace <> 0 then 491 Formation[Loc] := nfPeace 492 else 493 begin 494 Formation[Loc] := Loc; 495 V8_to_Loc(Loc, Adjacent); 496 for V8 := 0 to 7 do 497 begin 498 Loc1 := Adjacent[V8]; 499 if (Loc1 < Loc) and (Loc1 >= 0) and (Formation[Loc1] >= 0) and 500 ((Map[Loc1] and fTerrain >= fGrass) = (Map[Loc] and fTerrain >= fGrass)) then 501 if Formation[Loc] = Loc then 502 Formation[Loc] := Formation[Loc1] 503 else if Formation[Loc] < Formation[Loc1] then 504 ReplaceD(@Formation[Formation[Loc1]], @Formation[Loc + 1], 505 Formation[Loc1], Formation[Loc]) 506 else if Formation[Loc] > Formation[Loc1] then 507 ReplaceD(@Formation[Formation[Loc]], @Formation[Loc + 1], 508 Formation[Loc], Formation[Loc1]); 509 end; 510 if (RO.Territory[Loc] = me) and (Map[Loc] and fTerrain >= fGrass) then 511 begin 512 District[Loc] := Loc; 513 for V8 := 0 to 7 do 514 begin 515 Loc1 := Adjacent[V8]; 516 if (Loc1 < Loc) and (Loc1 >= 0) and (District[Loc1] >= 0) then 517 if District[Loc] = Loc then 518 District[Loc] := District[Loc1] 519 else if District[Loc] < District[Loc1] then 520 ReplaceD(@District[District[Loc1]], @District[Loc + 1], 521 District[Loc1], District[Loc]) 522 else if District[Loc] > District[Loc1] then 523 ReplaceD(@District[District[Loc]], @District[Loc + 1], 524 District[Loc], District[Loc1]); 525 end; 526 end; 527 end; 528 529 // sort continents, oceans and districts by size 530 for Kind := 0 to 2 do 531 begin 532 FillChar(IndexOfID, MapSize * 2, 0); 533 case Kind of 534 0: // continents 535 for Loc := 0 to MapSize - 1 do 536 if (Formation[Loc] >= 0) and (Map[Loc] and fTerrain >= fGrass) then 537 Inc(IndexOfID[Formation[Loc]]); 538 1: // oceans 539 for Loc := 0 to MapSize - 1 do 540 if (Formation[Loc] >= 0) and (Map[Loc] and fTerrain < fGrass) then 541 Inc(IndexOfID[Formation[Loc]]); 542 2: // districts 543 for Loc := 0 to MapSize - 1 do 544 if District[Loc] >= 0 then 545 Inc(IndexOfID[District[Loc]]); 546 end; 547 548 Count := 0; 549 for Loc := 0 to MapSize - 1 do 550 if IndexOfID[Loc] > 0 then 551 begin 552 IDOfIndex[Count] := Loc; 553 Inc(Count); 554 end; 555 for i := 0 to Count - 2 do 556 begin 557 MostIndex := i; 558 for j := i + 1 to Count - 1 do 559 if IndexOfID[IDOfIndex[j]] > IndexOfID[IDOfIndex[MostIndex]] then 560 MostIndex := j; 561 if MostIndex <> i then 562 begin 563 j := IDOfIndex[i]; 564 IDOfIndex[i] := IDOfIndex[MostIndex]; 565 IDOfIndex[MostIndex] := j; 566 end; 567 end; 568 for i := 0 to Count - 1 do 569 IndexOfID[IDOfIndex[i]] := i; 570 571 case Kind of 572 0: // continents 573 begin 574 nContinent := Count; 575 for Loc := 0 to MapSize - 1 do 576 if (Formation[Loc] >= 0) and (Map[Loc] and fTerrain >= fGrass) then 577 Formation[Loc] := IndexOfID[Formation[Loc]]; 578 end; 579 1: // oceans 580 begin 581 nOcean := Count; 582 for Loc := 0 to MapSize - 1 do 583 if (Formation[Loc] >= 0) and (Map[Loc] and fTerrain < fGrass) then 584 Formation[Loc] := IndexOfID[Formation[Loc]]; 585 end; 586 2: // districts 587 begin 588 nDistrict := Count; 589 for Loc := 0 to MapSize - 1 do 590 if District[Loc] >= 0 then 591 District[Loc] := IndexOfID[District[Loc]]; 592 end; 593 end; 594 end; 595 end; 596 597 598 //------------------------------------------------------------------------------ 599 // Path Finding 600 601 const 602 // basic move styles 603 msGround = $00000000; 604 msNoGround = $10000000; 605 msAlpine = $20000000; 606 msOver = $40000000; 607 msSpy = $50000000; 608 609 // other 610 msHostile = $08000000; 611 612 // bits: |31|30|29|28|27|26 .. 16|15|14|13|12|11|10| 9| 8| 7| 6| 5| 4| 3| 2| 1| 0| 613 // ground: | Basic |Ho| Speed | HeavyCost | RailCost | 614 // other: | Basic | 0| Speed | X X X | MaxTerrType | 615 616 function TToolAI.GetMyMoveStyle(mix, Health: integer): integer; 617 begin 618 with MyModel[mix] do 619 begin 620 Result := Speed shl 16; 621 case Domain of 622 dGround: 623 begin 624 Inc(Result, (50 + (Speed - 150) * 13 shr 7) shl 8); //HeavyCost 625 if RO.Wonder[woShinkansen].EffectiveOwner <> me then 626 Inc(Result, Speed * (4 * 1311) shr 17); // RailCost 627 if (RO.Wonder[woGardens].EffectiveOwner <> me) or 628 (Kind = mkSettler) and (Speed >= 200) then 629 Inc(Result, msHostile); 630 if Kind = mkDiplomat then 631 Inc(Result, msSpy) 632 else if Cap[mcOver] > 0 then 633 Inc(Result, msOver) 634 else if Cap[mcAlpine] > 0 then 635 Inc(Result, msAlpine) 636 else 637 Inc(Result, msGround); 638 end; 639 dSea: 640 begin 641 Result := Speed; 642 if RO.Wonder[woMagellan].EffectiveOwner = me then 643 Inc(Result, 200); 644 if Health < 100 then 645 Result := ((Result - 250) * Health div 5000) * 50 + 250; 646 Result := Result shl 16; 647 Inc(Result, msNoGround); 648 if Cap[mcNav] > 0 then 649 Inc(Result); 650 end; 651 dAir: 652 Inc(Result, msNoGround + fUNKNOWN xor 1 - 1); 653 end; 654 end; 655 end; 656 657 function TToolAI.CheckStep(MoveStyle, TimeBeforeStep, CrossCorner: integer; 658 var TimeAfterStep, RecoverTurns: integer; FromTile, ToTile: integer; 659 IsCapture: boolean): integer; 660 var 661 MoveCost, RecoverCost: integer; 662 begin 663 //IsCapture:=true; 664 assert(((FromTile and fTerrain <= fMountains) or (FromTile and 665 fTerrain = fUNKNOWN)) and ((ToTile and fTerrain <= fMountains) or 666 (ToTile and fTerrain = fUNKNOWN))); 667 // do not pass location codes for FromTile and ToTile! 668 RecoverTurns := 0; 669 if MoveStyle < msGround + $10000000 then 670 begin // common ground units 671 if (ToTile + 1) and fTerrain < fGrass + 1 then 672 Result := csForbiddenTile 673 else if (ToTile and not FromTile and fPeace = 0) and 674 (ToTile and (fUnit or fOwned) <> fUnit) and 675 (IsCapture or (ToTile and (fCity or fOwned) <> fCity)) then 676 if (FromTile and fCity <> 0) or (ToTile and (fCity or fOwned) = fCity or fOwned) or 677 (ToTile and FromTile and (fInEnemyZoc or fOwnZoCUnit) <> fInEnemyZoc) then 678 begin // ZoC is ok 679 if (ToTile and (fRR or fCity) = 0) or (FromTile and (fRR or fCity) = 0) then 680 begin // no railroad 681 if (ToTile and (fRoad or fRR or fCity) <> 0) and 682 (FromTile and (fRoad or fRR or fCity) <> 0) or 683 (FromTile and ToTile and (fRiver or fCanal) <> 0) then 684 MoveCost := 20 //move along road, river or canal 685 else 686 begin 687 case Terrain[ToTile and fTerrain].MoveCost of 688 1: MoveCost := 50; // plain terrain 689 2: MoveCost := MoveStyle shr 8 and $FF; // heavy terrain 690 else // mountains 691 begin 692 if TimeBeforeStep and $FFF + MoveStyle shr 16 and $7FF <= $800 then 693 TimeAfterStep := TimeBeforeStep and $7FFFF000 + $1800 694 else 695 TimeAfterStep := TimeBeforeStep and $7FFFF000 + $2800; 696 // must wait for next turn 697 if (MoveStyle and msHostile <> 0) and 698 ((FromTile and (fTerrain or fSpecial1) = fDesert) or 699 (FromTile and fTerrain = fArctic)) and 700 (FromTile and (fCity or fRiver or fCanal) = 0) then 701 begin 702 RecoverCost := ($800 - TimeBeforeStep and $FFF) * 5 shr 1; 703 while RecoverCost > 0 do 704 begin 705 Inc(RecoverTurns); 706 Dec(RecoverCost, MoveStyle shr 16 and $7FF); 707 end; 708 end; 709 Result := csOk; 710 if ToTile and fPeace <> 0 then 711 Result := csCheckTerritory; 712 exit; 713 end; 714 end; 715 end; 716 end 717 else 718 MoveCost := MoveStyle and $FF; //move along railroad 719 720 Inc(MoveCost, MoveCost shl CrossCorner); 721 if (MoveStyle and msHostile = 0) or 722 (ToTile and (fTerrain or fSpecial1) <> fDesert) and 723 (ToTile and fTerrain <> fArctic) or (ToTile and 724 (fCity or fRiver or fCanal) <> 0) or (ToTile and fTerImp = tiBase) then 725 RecoverCost := 0 726 else 727 RecoverCost := (MoveCost * 5) shr 1; 728 // damage from movement: MoveCost*DesertThurst/NoCityRecovery 729 if (TimeBeforeStep and $FFF + MoveCost <= $800) and 730 (TimeBeforeStep and $FFF < $800) then 731 TimeAfterStep := TimeBeforeStep + MoveCost 732 else 733 begin 734 TimeAfterStep := TimeBeforeStep and $7FFFF000 + $1800 - 735 MoveStyle shr 16 and $7FF + MoveCost; // must wait for next turn 736 if (MoveStyle and msHostile <> 0) and 737 ((FromTile and (fTerrain or fSpecial1) = fDesert) or 738 (FromTile and fTerrain = fArctic)) and 739 (FromTile and (fCity or fRiver or fCanal) = 0) and 740 (FromTile and fTerImp <> tiBase) then 741 Inc(RecoverCost, ($800 - TimeBeforeStep and $FFF) * 5 shr 1); 742 end; 743 while RecoverCost > 0 do 744 begin 745 Inc(RecoverTurns); 746 Dec(RecoverCost, MoveStyle shr 16 and $7FF); 747 end; 748 Result := csOk; 749 if ToTile and fPeace <> 0 then 750 Result := csCheckTerritory; 751 end 752 else 753 Result := csForbiddenStep // ZoC violation 754 else 755 Result := csForbiddenTile; 756 end 757 758 else if MoveStyle < msNoGround + $10000000 then 759 begin // ships and aircraft 760 if ((ToTile and fTerrain xor 1 > MoveStyle and fTerrain) and 761 (ToTile and (fCity or fCanal) = 0)) or (ToTile and not FromTile and fPeace <> 0) or 762 (ToTile and (fUnit or fOwned) = fUnit) or (ToTile and 763 (fCity or fOwned) = fCity) then 764 Result := csForbiddenTile 765 else 766 begin 767 MoveCost := 50 shl CrossCorner + 50; 768 if TimeBeforeStep and $FFF + MoveCost <= $800 then 769 TimeAfterStep := TimeBeforeStep + MoveCost 770 else 771 TimeAfterStep := TimeBeforeStep and $7FFFF000 + $1800 - 772 MoveStyle shr 16 and $7FF + MoveCost; 773 // must wait for next turn 774 Result := csOk; 775 if ToTile and fPeace <> 0 then 776 Result := csCheckTerritory; 777 end; 778 end 779 780 else if MoveStyle < msAlpine + $10000000 then 781 begin // alpine 782 if (ToTile + 1) and fTerrain < fGrass + 1 then 783 Result := csForbiddenTile 784 else if (ToTile and not FromTile and fPeace = 0) and 785 (ToTile and (fUnit or fOwned) <> fUnit) and 786 (IsCapture or (ToTile and (fCity or fOwned) <> fCity)) then 787 if (FromTile and fCity <> 0) or (ToTile and (fCity or fOwned) = fCity or fOwned) or 788 (ToTile and FromTile and (fInEnemyZoc or fOwnZoCUnit) <> fInEnemyZoc) then 789 begin 790 if (ToTile and (fRR or fCity) = 0) or (FromTile and (fRR or fCity) = 0) then 791 MoveCost := 20 // no railroad 792 else 793 MoveCost := MoveStyle and $FF; //move along railroad 794 Inc(MoveCost, MoveCost shl CrossCorner); 795 if (TimeBeforeStep and $FFF + MoveCost <= $800) and 796 (TimeBeforeStep and $FFF < $800) then 797 TimeAfterStep := TimeBeforeStep + MoveCost 798 else 799 TimeAfterStep := TimeBeforeStep and $7FFFF000 + $1800 - 800 MoveStyle shr 16 and $7FF + MoveCost; 801 // must wait for next turn 802 Result := csOk; 803 if ToTile and fPeace <> 0 then 804 Result := csCheckTerritory; 805 end 806 else 807 Result := csForbiddenStep // ZoC violation 808 else 809 Result := csForbiddenTile; 810 end 811 812 else if MoveStyle < msOver + $10000000 then 813 begin // overweight 814 if (ToTile + 1) and fTerrain < fGrass + 1 then 815 Result := csForbiddenTile 816 else if (ToTile and not FromTile and fPeace = 0) and 817 (ToTile and (fUnit or fOwned) <> fUnit) and 818 (IsCapture or (ToTile and (fCity or fOwned) <> fCity)) then 819 if (FromTile and fCity <> 0) or (ToTile and (fCity or fOwned) = fCity or fOwned) or 820 (ToTile and FromTile and (fInEnemyZoc or fOwnZoCUnit) <> fInEnemyZoc) then 821 begin 822 if (ToTile and (fRR or fCity) = 0) or (FromTile and (fRR or fCity) = 0) then 823 begin // no railroad 824 if (ToTile and (fRoad or fRR or fCity) <> 0) and 825 (FromTile and (fRoad or fRR or fCity) <> 0) or 826 (FromTile and ToTile and (fRiver or fCanal) <> 0) then 827 MoveCost := 40 //move along road, river or canal 828 else 829 begin 830 Result := csForbiddenTile; 831 exit; 832 end; 833 end 834 else 835 MoveCost := MoveStyle and $FF; //move along railroad 836 Inc(MoveCost, MoveCost shl CrossCorner); 837 if (TimeBeforeStep and $FFF + MoveCost <= $800) and 838 (TimeBeforeStep and $FFF < $800) then 839 TimeAfterStep := TimeBeforeStep + MoveCost 840 else 841 TimeAfterStep := TimeBeforeStep and $7FFFF000 + $1800 - 842 MoveStyle shr 16 and $7FF + MoveCost; 843 // must wait for next turn 844 Result := csOk; 845 if ToTile and fPeace <> 0 then 846 Result := csCheckTerritory; 847 end 848 else 849 Result := csForbiddenStep // ZoC violation 850 else 851 Result := csForbiddenTile; 852 end 853 854 else {if MoveStyle<msSpy+$10000000 then} 855 begin // spies 856 if (ToTile + 1) and fTerrain < fGrass + 1 then 857 Result := csForbiddenTile 858 else if (ToTile and (fUnit or fOwned) <> fUnit) and 859 (IsCapture or (ToTile and (fCity or fOwned) <> fCity)) then 860 begin 861 if (ToTile and (fRR or fCity) = 0) or (FromTile and (fRR or fCity) = 0) then 862 begin // no railroad 863 if (ToTile and (fRoad or fRR or fCity) <> 0) and 864 (FromTile and (fRoad or fRR or fCity) <> 0) or 865 (FromTile and ToTile and (fRiver or fCanal) <> 0) then 866 MoveCost := 20 //move along road, river or canal 867 else 868 begin 869 case Terrain[ToTile and fTerrain].MoveCost of 870 1: MoveCost := 50; // plain terrain 871 2: MoveCost := MoveStyle shr 8 and $FF; // heavy terrain 872 else // mountains 873 begin 874 if TimeBeforeStep and $FFF + MoveStyle shr 16 and $7FF <= $800 then 875 TimeAfterStep := TimeBeforeStep and $7FFFF000 + $1800 876 else 877 TimeAfterStep := TimeBeforeStep and $7FFFF000 + $2800; 878 // must wait for next turn 879 Result := csOk; 880 exit; 392 881 end; 393 882 end; 394 883 end; 395 396 // check tile for job397 if (TileJob[TestLoc]>jNone)398 and ((MyModel[MyUnit[uix].mix].Kind<>mkSlaves)399 or (TileJob[TestLoc]<>jCity))400 and ((SettlerOfJobLoc[TestLoc]<0) or (DistToLoc[TestLoc]>TestDistance)) then401 begin402 TestScore:=integer(TileJobScore[TestLoc])-DistanceScore*TestDistance;403 if TestScore>BestScore then404 BestCount:=0;405 if TestScore>=BestScore then406 begin407 inc(BestCount);408 if random(BestCount)=0 then409 begin410 BestScore:=TestScore;411 BestLoc:=TestLoc;412 BestJob:=TileJob[TestLoc];413 BestDistance:=TestDistance414 end415 end;416 end;417 TileChecked[TestLoc]:=true;418 end;419 Pile.Free;420 421 if BestJob>jNone then422 begin // new job found for this unit423 if SettlerOfJobLoc[BestLoc]>=0 then424 begin // another unit was already assigned to this job, but is not as close -- reassign that unit!425 JobLocOfSettler[SettlerOfJobLoc[BestLoc]]:=ToAssign;426 UnitsToAssign:=true;427 end;428 JobLocOfSettler[uix]:=BestLoc;429 SettlerOfJobLoc[BestLoc]:=uix;430 DistToLoc[BestLoc]:=BestDistance431 884 end 432 else JobLocOfSettler[uix]:=-1; // no jobs for this settler 433 end; // for uix 434 end; 435 436 // move settlers and start new jobs 437 for uix:=0 to RO.nUn-1 do with MyUnit[uix] do 438 if (Loc>=0) and (Job=jNone) and (JobLocOfSettler[uix]>=0) then 439 begin 440 if Loc<>JobLocOfSettler[uix] then 441 repeat 442 MoveResult:=Unit_Move(uix,JobLocOfSettler[uix]) 443 until (MoveResult<rExecuted) 444 or (MoveResult and (rLocationReached or rMoreTurns or rUnitRemoved)<>0); 445 if (Loc=JobLocOfSettler[uix]) and (Movement>=100) then 446 Unit_StartJob(uix,TileJob[JobLocOfSettler[uix]]); 447 end; 448 end; // JobAssignment_Go 449 450 451 //------------------------------------------------------------------------------ 452 // Map Analysis 453 454 procedure TToolAI.AnalyzeMap; 455 var 456 i,j,Loc,Loc1,V8,Count,Kind,MostIndex: integer; 457 Adjacent: TVicinity8Loc; 458 IndexOfID: array[0..lxmax*lymax-1] of smallint; 459 IDOfIndex: array[0..lxmax*lymax div 2 -1] of smallint; 460 begin 461 fillchar(District, MapSize*4, $FF); 462 for Loc:=0 to MapSize-1 do 463 if Map[Loc] and fTerrain=fUNKNOWN then Formation[Loc]:=nfUndiscovered 464 else if Map[Loc] and fTerrain=fArctic then Formation[Loc]:=nfPole 465 else if Map[Loc] and fPeace<>0 then Formation[Loc]:=nfPeace 466 else 467 begin 468 Formation[Loc]:=Loc; 469 V8_to_Loc(Loc, Adjacent); 470 for V8:=0 to 7 do 471 begin 472 Loc1:=Adjacent[V8]; 473 if (Loc1<Loc) and (Loc1>=0) and (Formation[Loc1]>=0) 474 and ((Map[Loc1] and fTerrain>=fGrass) = (Map[Loc] and fTerrain>=fGrass)) then 475 if Formation[Loc]=Loc then Formation[Loc]:=Formation[Loc1] 476 else if Formation[Loc]<Formation[Loc1] then 477 ReplaceD(@Formation[Formation[Loc1]],@Formation[Loc+1],Formation[Loc1],Formation[Loc]) 478 else if Formation[Loc]>Formation[Loc1] then 479 ReplaceD(@Formation[Formation[Loc]],@Formation[Loc+1],Formation[Loc],Formation[Loc1]); 480 end; 481 if (RO.Territory[Loc]=me) and (Map[Loc] and fTerrain>=fGrass) then 482 begin 483 District[Loc]:=Loc; 484 for V8:=0 to 7 do 485 begin 486 Loc1:=Adjacent[V8]; 487 if (Loc1<Loc) and (Loc1>=0) and (District[Loc1]>=0) then 488 if District[Loc]=Loc then District[Loc]:=District[Loc1] 489 else if District[Loc]<District[Loc1] then 490 ReplaceD(@District[District[Loc1]],@District[Loc+1],District[Loc1],District[Loc]) 491 else if District[Loc]>District[Loc1] then 492 ReplaceD(@District[District[Loc]],@District[Loc+1],District[Loc],District[Loc1]); 493 end 494 end 495 end; 496 497 // sort continents, oceans and districts by size 498 for Kind:=0 to 2 do 499 begin 500 FillChar(IndexOfID,MapSize*2,0); 501 case Kind of 502 0: // continents 503 for Loc:=0 to MapSize-1 do 504 if (Formation[Loc]>=0) and (Map[Loc] and fTerrain>=fGrass) then 505 inc(IndexOfID[Formation[Loc]]); 506 1: // oceans 507 for Loc:=0 to MapSize-1 do 508 if (Formation[Loc]>=0) and (Map[Loc] and fTerrain<fGrass) then 509 inc(IndexOfID[Formation[Loc]]); 510 2: // districts 511 for Loc:=0 to MapSize-1 do 512 if District[Loc]>=0 then 513 inc(IndexOfID[District[Loc]]); 514 end; 515 516 Count:=0; 517 for Loc:=0 to MapSize-1 do if IndexOfID[Loc]>0 then 518 begin 519 IDOfIndex[Count]:=Loc; 520 inc(Count); 521 end; 522 for i:=0 to Count-2 do 523 begin 524 MostIndex:=i; 525 for j:=i+1 to Count-1 do 526 if IndexOfID[IDOfIndex[j]]>IndexOfID[IDOfIndex[MostIndex]] then MostIndex:=j; 527 if MostIndex<>i then 528 begin 529 j:=IDOfIndex[i]; 530 IDOfIndex[i]:=IDOfIndex[MostIndex]; 531 IDOfIndex[MostIndex]:=j; 532 end 533 end; 534 for i:=0 to Count-1 do 535 IndexOfID[IDOfIndex[i]]:=i; 536 537 case Kind of 538 0: // continents 539 begin 540 nContinent:=Count; 541 for Loc:=0 to MapSize-1 do 542 if (Formation[Loc]>=0) and (Map[Loc] and fTerrain>=fGrass) then 543 Formation[Loc]:=IndexOfID[Formation[Loc]]; 544 end; 545 1: // oceans 546 begin 547 nOcean:=Count; 548 for Loc:=0 to MapSize-1 do 549 if (Formation[Loc]>=0) and (Map[Loc] and fTerrain<fGrass) then 550 Formation[Loc]:=IndexOfID[Formation[Loc]]; 551 end; 552 2: // districts 553 begin 554 nDistrict:=Count; 555 for Loc:=0 to MapSize-1 do 556 if District[Loc]>=0 then 557 District[Loc]:=IndexOfID[District[Loc]]; 558 end; 885 else 886 MoveCost := MoveStyle and $FF; //move along railroad 887 Inc(MoveCost, MoveCost shl CrossCorner); 888 if (TimeBeforeStep and $FFF + MoveCost <= $800) and 889 (TimeBeforeStep and $FFF < $800) then 890 TimeAfterStep := TimeBeforeStep + MoveCost 891 else 892 TimeAfterStep := TimeBeforeStep and $7FFFF000 + $1800 - 893 MoveStyle shr 16 and $7FF + MoveCost; 894 // must wait for next turn 895 Result := csOk; 559 896 end 560 end; 561 end; 562 563 564 //------------------------------------------------------------------------------ 565 // Path Finding 566 567 const 568 // basic move styles 569 msGround= $00000000; 570 msNoGround= $10000000; 571 msAlpine= $20000000; 572 msOver= $40000000; 573 msSpy= $50000000; 574 575 // other 576 msHostile= $08000000; 577 578 // bits: |31|30|29|28|27|26 .. 16|15|14|13|12|11|10| 9| 8| 7| 6| 5| 4| 3| 2| 1| 0| 579 // ground: | Basic |Ho| Speed | HeavyCost | RailCost | 580 // other: | Basic | 0| Speed | X X X | MaxTerrType | 581 582 function TToolAI.GetMyMoveStyle(mix,Health: integer): integer; 583 begin 584 with MyModel[mix] do 585 begin 586 result:=Speed shl 16; 587 case Domain of 588 dGround: 589 begin 590 inc(result, (50+(Speed-150)*13 shr 7) shl 8); //HeavyCost 591 if RO.Wonder[woShinkansen].EffectiveOwner<>me then 592 inc(result, Speed*(4*1311) shr 17); // RailCost 593 if (RO.Wonder[woGardens].EffectiveOwner<>me) 594 or (Kind=mkSettler) and (Speed>=200) then 595 inc(result, msHostile); 596 if Kind=mkDiplomat then 597 inc(result,msSpy) 598 else if Cap[mcOver]>0 then 599 inc(result,msOver) 600 else if Cap[mcAlpine]>0 then 601 inc(result,msAlpine) 602 else inc(result,msGround); 603 end; 604 dSea: 605 begin 606 result:=Speed; 607 if RO.Wonder[woMagellan].EffectiveOwner=me then inc(result,200); 608 if Health<100 then result:=((result-250)*Health div 5000)*50+250; 609 result:=result shl 16; 610 inc(result,msNoGround); 611 if Cap[mcNav]>0 then inc(result); 612 end; 613 dAir: 614 inc(result,msNoGround+fUNKNOWN xor 1 -1); 615 end; 616 end 617 end; 618 619 function TToolAI.CheckStep(MoveStyle, TimeBeforeStep, CrossCorner: integer; 620 var TimeAfterStep, RecoverTurns: integer; FromTile, ToTile: integer; IsCapture: boolean): integer; 621 var 622 MoveCost,RecoverCost: integer; 623 begin 624 //IsCapture:=true; 625 assert(((FromTile and fTerrain<=fMountains) or (FromTile and fTerrain=fUNKNOWN)) 626 and ((ToTile and fTerrain<=fMountains) or (ToTile and fTerrain=fUNKNOWN))); 627 // do not pass location codes for FromTile and ToTile! 628 RecoverTurns:=0; 629 if MoveStyle<msGround+$10000000 then 630 begin // common ground units 631 if (ToTile+1) and fTerrain<fGrass+1 then 632 result:=csForbiddenTile 633 else if (ToTile and not FromTile and fPeace=0) 634 and (ToTile and (fUnit or fOwned)<>fUnit) 635 and (IsCapture or (ToTile and (fCity or fOwned)<>fCity)) then 636 if (FromTile and fCity<>0) or (ToTile and (fCity or fOwned)=fCity or fOwned) 637 or (ToTile and FromTile and (fInEnemyZoc or fOwnZoCUnit)<>fInEnemyZoc) then 638 begin // ZoC is ok 639 if (ToTile and (fRR or fCity)=0) or (FromTile and (fRR or fCity)=0) then 640 begin // no railroad 641 if (ToTile and (fRoad or fRR or fCity)<>0) 642 and (FromTile and (fRoad or fRR or fCity)<>0) 643 or (FromTile and ToTile and (fRiver or fCanal)<>0) then 644 MoveCost:=20 //move along road, river or canal 645 else 646 begin 647 case Terrain[ToTile and fTerrain].MoveCost of 648 1: MoveCost:=50; // plain terrain 649 2: MoveCost:=MoveStyle shr 8 and $FF; // heavy terrain 650 else // mountains 651 begin 652 if TimeBeforeStep and $FFF+MoveStyle shr 16 and $7FF<=$800 then 653 TimeAfterStep:=TimeBeforeStep and $7FFFF000+$1800 654 else TimeAfterStep:=TimeBeforeStep and $7FFFF000+$2800; // must wait for next turn 655 if (MoveStyle and msHostile<>0) 656 and ((FromTile and (fTerrain or fSpecial1)=fDesert) 657 or (FromTile and fTerrain=fArctic)) 658 and (FromTile and (fCity or fRiver or fCanal)=0) then 659 begin 660 RecoverCost:=($800-TimeBeforeStep and $FFF)*5 shr 1; 661 while RecoverCost>0 do 662 begin 663 inc(RecoverTurns); 664 dec(RecoverCost, MoveStyle shr 16 and $7FF); 665 end; 666 end; 667 result:=csOk; 668 if ToTile and fPeace<>0 then 669 result:=csCheckTerritory; 670 exit 671 end; 672 end 673 end 674 end 675 else MoveCost:=MoveStyle and $FF; //move along railroad 676 677 inc(MoveCost,MoveCost shl CrossCorner); 678 if (MoveStyle and msHostile=0) 679 or (ToTile and (fTerrain or fSpecial1)<>fDesert) 680 and (ToTile and fTerrain<>fArctic) 681 or (ToTile and (fCity or fRiver or fCanal)<>0) 682 or (ToTile and fTerImp=tiBase) then 683 RecoverCost:=0 684 else RecoverCost:=(MoveCost*5) shr 1; // damage from movement: MoveCost*DesertThurst/NoCityRecovery 685 if (TimeBeforeStep and $FFF+MoveCost<=$800) and (TimeBeforeStep and $FFF<$800) then 686 TimeAfterStep:=TimeBeforeStep+MoveCost 687 else 688 begin 689 TimeAfterStep:=TimeBeforeStep and $7FFFF000+$1800-MoveStyle shr 16 and $7FF+MoveCost; // must wait for next turn 690 if (MoveStyle and msHostile<>0) 691 and ((FromTile and (fTerrain or fSpecial1)=fDesert) 692 or (FromTile and fTerrain=fArctic)) 693 and (FromTile and (fCity or fRiver or fCanal)=0) 694 and (FromTile and fTerImp<>tiBase) then 695 inc(RecoverCost, ($800-TimeBeforeStep and $FFF)*5 shr 1); 696 end; 697 while RecoverCost>0 do 698 begin 699 inc(RecoverTurns); 700 dec(RecoverCost, MoveStyle shr 16 and $7FF); 701 end; 702 result:=csOk; 703 if ToTile and fPeace<>0 then 704 result:=csCheckTerritory 705 end 706 else result:=csForbiddenStep // ZoC violation 707 else result:=csForbiddenTile 708 end 709 710 else if MoveStyle<msNoGround+$10000000 then 711 begin // ships and aircraft 712 if ((ToTile and fTerrain xor 1>MoveStyle and fTerrain) 713 and (ToTile and (fCity or fCanal)=0)) 714 or (ToTile and not FromTile and fPeace<>0) 715 or (ToTile and (fUnit or fOwned)=fUnit) 716 or (ToTile and (fCity or fOwned)=fCity) then 717 result:=csForbiddenTile 718 else 719 begin 720 MoveCost:=50 shl CrossCorner+50; 721 if TimeBeforeStep and $FFF+MoveCost<=$800 then 722 TimeAfterStep:=TimeBeforeStep+MoveCost 723 else TimeAfterStep:=TimeBeforeStep and $7FFFF000+$1800-MoveStyle shr 16 and $7FF+MoveCost; // must wait for next turn 724 result:=csOk; 725 if ToTile and fPeace<>0 then 726 result:=csCheckTerritory 727 end 728 end 729 730 else if MoveStyle<msAlpine+$10000000 then 731 begin // alpine 732 if (ToTile+1) and fTerrain<fGrass+1 then 733 result:=csForbiddenTile 734 else if (ToTile and not FromTile and fPeace=0) 735 and (ToTile and (fUnit or fOwned)<>fUnit) 736 and (IsCapture or (ToTile and (fCity or fOwned)<>fCity)) then 737 if (FromTile and fCity<>0) or (ToTile and (fCity or fOwned)=fCity or fOwned) 738 or (ToTile and FromTile and (fInEnemyZoc or fOwnZoCUnit)<>fInEnemyZoc) then 739 begin 740 if (ToTile and (fRR or fCity)=0) or (FromTile and (fRR or fCity)=0) then 741 MoveCost:=20 // no railroad 742 else MoveCost:=MoveStyle and $FF; //move along railroad 743 inc(MoveCost,MoveCost shl CrossCorner); 744 if (TimeBeforeStep and $FFF+MoveCost<=$800) and (TimeBeforeStep and $FFF<$800) then 745 TimeAfterStep:=TimeBeforeStep+MoveCost 746 else TimeAfterStep:=TimeBeforeStep and $7FFFF000+$1800-MoveStyle shr 16 and $7FF+MoveCost; // must wait for next turn 747 result:=csOk; 748 if ToTile and fPeace<>0 then 749 result:=csCheckTerritory 750 end 751 else result:=csForbiddenStep // ZoC violation 752 else result:=csForbiddenTile 753 end 754 755 else if MoveStyle<msOver+$10000000 then 756 begin // overweight 757 if (ToTile+1) and fTerrain<fGrass+1 then 758 result:=csForbiddenTile 759 else if (ToTile and not FromTile and fPeace=0) 760 and (ToTile and (fUnit or fOwned)<>fUnit) 761 and (IsCapture or (ToTile and (fCity or fOwned)<>fCity)) then 762 if (FromTile and fCity<>0) or (ToTile and (fCity or fOwned)=fCity or fOwned) 763 or (ToTile and FromTile and (fInEnemyZoc or fOwnZoCUnit)<>fInEnemyZoc) then 764 begin 765 if (ToTile and (fRR or fCity)=0) or (FromTile and (fRR or fCity)=0) then 766 begin // no railroad 767 if (ToTile and (fRoad or fRR or fCity)<>0) 768 and (FromTile and (fRoad or fRR or fCity)<>0) 769 or (FromTile and ToTile and (fRiver or fCanal)<>0) then 770 MoveCost:=40 //move along road, river or canal 771 else begin result:=csForbiddenTile; exit end 772 end 773 else MoveCost:=MoveStyle and $FF; //move along railroad 774 inc(MoveCost,MoveCost shl CrossCorner); 775 if (TimeBeforeStep and $FFF+MoveCost<=$800) and (TimeBeforeStep and $FFF<$800) then 776 TimeAfterStep:=TimeBeforeStep+MoveCost 777 else TimeAfterStep:=TimeBeforeStep and $7FFFF000+$1800-MoveStyle shr 16 and $7FF+MoveCost; // must wait for next turn 778 result:=csOk; 779 if ToTile and fPeace<>0 then 780 result:=csCheckTerritory 781 end 782 else result:=csForbiddenStep // ZoC violation 783 else result:=csForbiddenTile 784 end 785 786 else {if MoveStyle<msSpy+$10000000 then} 787 begin // spies 788 if (ToTile+1) and fTerrain<fGrass+1 then 789 result:=csForbiddenTile 790 else if (ToTile and (fUnit or fOwned)<>fUnit) 791 and (IsCapture or (ToTile and (fCity or fOwned)<>fCity)) then 792 begin 793 if (ToTile and (fRR or fCity)=0) or (FromTile and (fRR or fCity)=0) then 794 begin // no railroad 795 if (ToTile and (fRoad or fRR or fCity)<>0) 796 and (FromTile and (fRoad or fRR or fCity)<>0) 797 or (FromTile and ToTile and (fRiver or fCanal)<>0) then 798 MoveCost:=20 //move along road, river or canal 799 else 800 begin 801 case Terrain[ToTile and fTerrain].MoveCost of 802 1: MoveCost:=50; // plain terrain 803 2: MoveCost:=MoveStyle shr 8 and $FF; // heavy terrain 804 else // mountains 805 begin 806 if TimeBeforeStep and $FFF+MoveStyle shr 16 and $7FF<=$800 then 807 TimeAfterStep:=TimeBeforeStep and $7FFFF000+$1800 808 else TimeAfterStep:=TimeBeforeStep and $7FFFF000+$2800; // must wait for next turn 809 result:=csOk; 810 exit 811 end; 812 end 813 end 814 end 815 else MoveCost:=MoveStyle and $FF; //move along railroad 816 inc(MoveCost,MoveCost shl CrossCorner); 817 if (TimeBeforeStep and $FFF+MoveCost<=$800) and (TimeBeforeStep and $FFF<$800) then 818 TimeAfterStep:=TimeBeforeStep+MoveCost 819 else TimeAfterStep:=TimeBeforeStep and $7FFFF000+$1800-MoveStyle shr 16 and $7FF+MoveCost; // must wait for next turn 820 result:=csOk; 821 end 822 else result:=csForbiddenTile 897 else 898 Result := csForbiddenTile; 823 899 end; 824 900 end; // CheckStep … … 860 936 *) 861 937 862 function TToolAI.Unit_MoveEx(uix,ToLoc: integer; Options: integer): integer; 863 var 864 Loc,NextLoc,Temp,FromLoc,EndLoc,Time,V8,MoveResult,RecoverTurns,NextTime, 865 MoveStyle: integer; 866 Adjacent: TVicinity8Loc; 867 PreLoc: array[0..lxmax*lymax-1] of integer; 868 Reached: array[0..lxmax*lymax-1] of boolean; 869 begin 870 result:=eOk; 871 FromLoc:=MyUnit[uix].Loc; 872 if FromLoc=ToLoc then exit; 873 874 FillChar(Reached,MapSize,false); 875 MoveStyle:=GetMyMoveStyle(MyUnit[uix].mix, MyUnit[uix].Health); 876 EndLoc:=-1; 877 Pile.Create(MapSize); 878 Pile.Put(FromLoc, $800-MyUnit[uix].Movement); 879 while Pile.Get(Loc,Time) do 938 function TToolAI.Unit_MoveEx(uix, ToLoc: integer; Options: integer): integer; 939 var 940 Loc, NextLoc, Temp, FromLoc, EndLoc, Time, V8, MoveResult, RecoverTurns, 941 NextTime, MoveStyle: integer; 942 Adjacent: TVicinity8Loc; 943 PreLoc: array[0..lxmax * lymax - 1] of integer; 944 Reached: array[0..lxmax * lymax - 1] of boolean; 945 begin 946 Result := eOk; 947 FromLoc := MyUnit[uix].Loc; 948 if FromLoc = ToLoc then 949 exit; 950 951 FillChar(Reached, MapSize, False); 952 MoveStyle := GetMyMoveStyle(MyUnit[uix].mix, MyUnit[uix].Health); 953 EndLoc := -1; 954 Pile.Create(MapSize); 955 Pile.Put(FromLoc, $800 - MyUnit[uix].Movement); 956 while Pile.Get(Loc, Time) do 880 957 begin 881 if (Loc=ToLoc)882 or (ToLoc=maNextCity) and (Map[Loc] and fCity<>0)883 and (Map[Loc] and fOwned<>0) then884 begin EndLoc:=Loc; Break; end;885 Reached[Loc]:=true;886 V8_to_Loc(Loc,Adjacent);887 for V8:=0 to 7 do888 begin889 NextLoc:=Adjacent[V8];890 if NextLoc>=0 then891 if (NextLoc=ToLoc) and (Options and mxAdjacent<>0) then892 begin EndLoc:=Loc; Break end893 else if not Reached[NextLoc]then958 if (Loc = ToLoc) or (ToLoc = maNextCity) and (Map[Loc] and fCity <> 0) and 959 (Map[Loc] and fOwned <> 0) then 960 begin 961 EndLoc := Loc; 962 Break; 963 end; 964 Reached[Loc] := True; 965 V8_to_Loc(Loc, Adjacent); 966 for V8 := 0 to 7 do 967 begin 968 NextLoc := Adjacent[V8]; 969 if NextLoc >= 0 then 970 if (NextLoc = ToLoc) and (Options and mxAdjacent <> 0) then 894 971 begin 895 case CheckStep(MoveStyle, Time, V8 and 1, NextTime, RecoverTurns, 896 Map[Loc], Map[NextLoc], NextLoc=ToLoc) of 897 csOk: 898 if Pile.Put(NextLoc, NextTime+RecoverTurns*$1000) then 899 PreLoc[NextLoc]:=Loc; 900 csForbiddenTile: 901 Reached[NextLoc]:=true; // don't check moving there again 902 csCheckTerritory: 903 if RO.Territory[NextLoc]=RO.Territory[Loc] then 904 if Pile.Put(NextLoc, NextTime+RecoverTurns*$1000) then 905 PreLoc[NextLoc]:=Loc; 906 end 972 EndLoc := Loc; 973 Break; 907 974 end 908 end; 909 if EndLoc>=0 then Break; 910 end; 911 Pile.Free; 912 913 if EndLoc>=0 then 975 else if not Reached[NextLoc] then 976 begin 977 case CheckStep(MoveStyle, Time, V8 and 1, NextTime, RecoverTurns, 978 Map[Loc], Map[NextLoc], NextLoc = ToLoc) of 979 csOk: 980 if Pile.Put(NextLoc, NextTime + RecoverTurns * $1000) then 981 PreLoc[NextLoc] := Loc; 982 csForbiddenTile: 983 Reached[NextLoc] := True; // don't check moving there again 984 csCheckTerritory: 985 if RO.Territory[NextLoc] = RO.Territory[Loc] then 986 if Pile.Put(NextLoc, NextTime + RecoverTurns * $1000) then 987 PreLoc[NextLoc] := Loc; 988 end; 989 end; 990 end; 991 if EndLoc >= 0 then 992 Break; 993 end; 994 Pile.Free; 995 996 if EndLoc >= 0 then 914 997 begin 915 Loc:=EndLoc;916 NextLoc:=PreLoc[Loc];917 while Loc<>FromLoc do998 Loc := EndLoc; 999 NextLoc := PreLoc[Loc]; 1000 while Loc <> FromLoc do 918 1001 begin // invert meaning of PreLoc 919 Temp:=Loc; 920 Loc:=NextLoc; 921 NextLoc:=PreLoc[Loc]; 922 PreLoc[Loc]:=Temp; 923 end; 924 while Loc<>EndLoc do 925 begin 926 Loc:=PreLoc[Loc]; 927 MoveResult:=Unit_Step(uix, Loc); 928 if (MoveResult<>eOK) and (MoveResult<>eLoaded) then 929 begin result:=MoveResult; break end; 1002 Temp := Loc; 1003 Loc := NextLoc; 1004 NextLoc := PreLoc[Loc]; 1005 PreLoc[Loc] := Temp; 1006 end; 1007 while Loc <> EndLoc do 1008 begin 1009 Loc := PreLoc[Loc]; 1010 MoveResult := Unit_Step(uix, Loc); 1011 if (MoveResult <> eOK) and (MoveResult <> eLoaded) then 1012 begin 1013 Result := MoveResult; 1014 break; 1015 end; 930 1016 end; 931 1017 end 932 else result:=eNoWay; 1018 else 1019 Result := eNoWay; 933 1020 end; 934 1021 … … 939 1026 procedure TToolAI.SeaTransport_BeginInitialize; 940 1027 begin 941 fillchar(TransportAvailable, RO.nUn*sizeof(integer), $FF); // -1942 InitComplete:=false;943 HaveDestinations:=false;944 nTransportLoad:=0;945 TransportMoveStyle:=0;946 TransportCapacity:=$100;947 Pile.Create(MapSize);1028 fillchar(TransportAvailable, RO.nUn * sizeof(integer), $FF); // -1 1029 InitComplete := False; 1030 HaveDestinations := False; 1031 nTransportLoad := 0; 1032 TransportMoveStyle := 0; 1033 TransportCapacity := $100; 1034 Pile.Create(MapSize); 948 1035 end; 949 1036 950 1037 procedure TToolAI.SeaTransport_AddLoad(uix: integer); 951 1038 var 952 i: integer; 953 begin 954 assert(not InitComplete); // call order violation! 955 if Map[MyUnit[uix].Loc] and fTerrain<fGrass then exit; 956 for i:=0 to nTransportLoad-1 do 957 if uix=uixTransportLoad[i] then exit; 958 uixTransportLoad[nTransportLoad]:=uix; 959 inc(nTransportLoad); 1039 i: integer; 1040 begin 1041 assert(not InitComplete); // call order violation! 1042 if Map[MyUnit[uix].Loc] and fTerrain < fGrass then 1043 exit; 1044 for i := 0 to nTransportLoad - 1 do 1045 if uix = uixTransportLoad[i] then 1046 exit; 1047 uixTransportLoad[nTransportLoad] := uix; 1048 Inc(nTransportLoad); 960 1049 end; 961 1050 962 1051 procedure TToolAI.SeaTransport_AddTransport(uix: integer); 963 1052 var 964 MoveStyle: integer;965 begin 966 assert(not InitComplete); // call order violation!967 assert(MyModel[MyUnit[uix].mix].Cap[mcSeaTrans]>0);968 TransportAvailable[uix]:=1;969 with MyModel[MyUnit[uix].mix] do1053 MoveStyle: integer; 1054 begin 1055 assert(not InitComplete); // call order violation! 1056 assert(MyModel[MyUnit[uix].mix].Cap[mcSeaTrans] > 0); 1057 TransportAvailable[uix] := 1; 1058 with MyModel[MyUnit[uix].mix] do 970 1059 begin 971 if MTrans*Cap[mcSeaTrans]<TransportCapacity then 972 TransportCapacity:=MTrans*Cap[mcSeaTrans]; 973 MoveStyle:=GetMyMoveStyle(MyUnit[uix].mix, 100); 974 if (TransportMoveStyle=0) 975 or (MoveStyle<TransportMoveStyle) 976 and (MoveStyle and not TransportMoveStyle and 1=0) 977 or (not MoveStyle and TransportMoveStyle and 1<>0) then 978 TransportMoveStyle:=MoveStyle; 979 end 1060 if MTrans * Cap[mcSeaTrans] < TransportCapacity then 1061 TransportCapacity := MTrans * Cap[mcSeaTrans]; 1062 MoveStyle := GetMyMoveStyle(MyUnit[uix].mix, 100); 1063 if (TransportMoveStyle = 0) or (MoveStyle < TransportMoveStyle) and 1064 (MoveStyle and not TransportMoveStyle and 1 = 0) or 1065 (not MoveStyle and TransportMoveStyle and 1 <> 0) then 1066 TransportMoveStyle := MoveStyle; 1067 end; 980 1068 end; 981 1069 982 1070 procedure TToolAI.SeaTransport_AddDestination(Loc: integer); 983 1071 begin 984 assert(not InitComplete); // call order violation!985 Pile.Put(Loc, $800);986 HaveDestinations:=true;1072 assert(not InitComplete); // call order violation! 1073 Pile.Put(Loc, $800); 1074 HaveDestinations := True; 987 1075 end; 988 1076 989 1077 procedure TToolAI.SeaTransport_EndInitialize; 990 1078 var 991 Loc0,Time0,V8,Loc1,ArriveTime,RecoverTurns: integer;992 Adjacent: TVicinity8Loc;993 begin 994 assert(not InitComplete); // call order violation!995 InitComplete:=true;996 if HaveDestinations then1079 Loc0, Time0, V8, Loc1, ArriveTime, RecoverTurns: integer; 1080 Adjacent: TVicinity8Loc; 1081 begin 1082 assert(not InitComplete); // call order violation! 1083 InitComplete := True; 1084 if HaveDestinations then 997 1085 begin // calculate TurnsAfterLoad from destination locs 998 fillchar(TurnsAfterLoad, MapSize, $FF); // -1999 while Pile.Get(Loc0, Time0) do1086 fillchar(TurnsAfterLoad, MapSize, $FF); // -1 1087 while Pile.Get(Loc0, Time0) do 1000 1088 begin // search backward 1001 if Time0=$800 then TurnsAfterLoad[Loc0]:=1 1002 else TurnsAfterLoad[Loc0]:=Time0 shr 12; 1003 V8_to_Loc(Loc0, Adjacent); 1004 for V8:=0 to 7 do 1005 begin 1006 Loc1:=Adjacent[V8]; 1007 if (Loc1>=0) and (TurnsAfterLoad[Loc1]=-1) then 1089 if Time0 = $800 then 1090 TurnsAfterLoad[Loc0] := 1 1091 else 1092 TurnsAfterLoad[Loc0] := Time0 shr 12; 1093 V8_to_Loc(Loc0, Adjacent); 1094 for V8 := 0 to 7 do 1095 begin 1096 Loc1 := Adjacent[V8]; 1097 if (Loc1 >= 0) and (TurnsAfterLoad[Loc1] = -1) then 1008 1098 begin 1009 case CheckStep(TransportMoveStyle, Time0, V8 and 1, ArriveTime,1010 RecoverTurns, Map[Loc0], Map[Loc1], false) of1011 csOk: Pile.Put(Loc1, ArriveTime);1012 csForbiddenStep: TurnsAfterLoad[Loc1]:=-2;1099 case CheckStep(TransportMoveStyle, Time0, V8 and 1, ArriveTime, 1100 RecoverTurns, Map[Loc0], Map[Loc1], False) of 1101 csOk: Pile.Put(Loc1, ArriveTime); 1102 csForbiddenStep: TurnsAfterLoad[Loc1] := -2; 1013 1103 end; 1014 end 1015 end 1016 end; 1017 end; 1018 Pile.Free; 1019 end; 1020 1021 1022 function TToolAI.SeaTransport_MakeGroupPlan(var TransportPlan: TGroupTransportPlan): boolean; 1023 var 1024 V8,i,j,iPicked,uix,Loc0,Time0,Loc1,RecoverTurns,MoveStyle, TurnsLoaded, 1025 TurnCount, tuix, tuix1, ArriveTime, TotalDelay, BestTotalDelay, GroupCount, 1026 BestGroupCount, BestLoadLoc, FullMovementLoc, nSelectedLoad, f, 1027 OriginContinent,a,b: integer; 1028 CompleteFlag, NotReachedFlag, ContinueUnit: Cardinal; 1029 IsComplete,ok,IsFirstLoc: boolean; 1030 StartLocPtr, ArrivedEnd: pinteger; 1031 Adjacent: TVicinity8Loc; 1032 uixSelectedLoad: array[0..15] of integer; 1033 tuixSelectedLoad: array[0..15] of integer; 1034 Arrived: array[0..lxmax*lymax] of cardinal; 1035 ResponsibleTransport: array[0..lxmax*lymax-1] of smallint; 1036 TurnsBeforeLoad: array[0..lxmax*lymax-1] of shortint; 1037 GroupComplete: array[0..lxmax*lymax-1] of boolean; 1038 begin 1039 assert(InitComplete); // call order violation! 1040 1041 if HaveDestinations and (nTransportLoad>0) then 1104 end; 1105 end; 1106 end; 1107 end; 1108 Pile.Free; 1109 end; 1110 1111 1112 function TToolAI.SeaTransport_MakeGroupPlan( 1113 var TransportPlan: TGroupTransportPlan): boolean; 1114 var 1115 V8, i, j, iPicked, uix, Loc0, Time0, Loc1, RecoverTurns, MoveStyle, 1116 TurnsLoaded, TurnCount, tuix, tuix1, ArriveTime, TotalDelay, 1117 BestTotalDelay, GroupCount, BestGroupCount, BestLoadLoc, FullMovementLoc, 1118 nSelectedLoad, f, OriginContinent, a, b: integer; 1119 CompleteFlag, NotReachedFlag, ContinueUnit: cardinal; 1120 IsComplete, ok, IsFirstLoc: boolean; 1121 StartLocPtr, ArrivedEnd: pinteger; 1122 Adjacent: TVicinity8Loc; 1123 uixSelectedLoad: array[0..15] of integer; 1124 tuixSelectedLoad: array[0..15] of integer; 1125 Arrived: array[0..lxmax * lymax] of cardinal; 1126 ResponsibleTransport: array[0..lxmax * lymax - 1] of smallint; 1127 TurnsBeforeLoad: array[0..lxmax * lymax - 1] of shortint; 1128 GroupComplete: array[0..lxmax * lymax - 1] of boolean; 1129 begin 1130 assert(InitComplete); // call order violation! 1131 1132 if HaveDestinations and (nTransportLoad > 0) then 1042 1133 begin // transport and units already adjacent? 1043 for uix:=0 to RO.nUn-1 do1044 if (TransportAvailable[uix]>0)1045 and (Map[MyUnit[uix].Loc] and fTerrain=fShore) then1046 begin 1047 GroupCount:=0;1048 for tuix:=0 to nTransportLoad-1 do1134 for uix := 0 to RO.nUn - 1 do 1135 if (TransportAvailable[uix] > 0) and (Map[MyUnit[uix].Loc] and 1136 fTerrain = fShore) then 1137 begin 1138 GroupCount := 0; 1139 for tuix := 0 to nTransportLoad - 1 do 1049 1140 begin 1050 Loc_to_ab(MyUnit[uix].Loc, MyUnit[uixTransportLoad[tuix]].Loc, a, b);1051 if (abs(a)<=1) and (abs(b)<=1) then1141 Loc_to_ab(MyUnit[uix].Loc, MyUnit[uixTransportLoad[tuix]].Loc, a, b); 1142 if (abs(a) <= 1) and (abs(b) <= 1) then 1052 1143 begin 1053 assert((a<>0) or (b<>0));1054 inc(GroupCount);1055 end 1144 assert((a <> 0) or (b <> 0)); 1145 Inc(GroupCount); 1146 end; 1056 1147 end; 1057 if (GroupCount=nTransportLoad) or (GroupCount>=TransportCapacity) then1148 if (GroupCount = nTransportLoad) or (GroupCount >= TransportCapacity) then 1058 1149 begin 1059 TransportPlan.LoadLoc:=MyUnit[uix].Loc;1060 TransportPlan.uixTransport:=uix;1061 TransportAvailable[uix]:=0;1062 TransportPlan.TurnsEmpty:=0;1063 TransportPlan.TurnsLoaded:=TurnsAfterLoad[TransportPlan.LoadLoc];1064 TransportPlan.nLoad:=0;1065 for tuix:=nTransportLoad-1 downto 0 do1150 TransportPlan.LoadLoc := MyUnit[uix].Loc; 1151 TransportPlan.uixTransport := uix; 1152 TransportAvailable[uix] := 0; 1153 TransportPlan.TurnsEmpty := 0; 1154 TransportPlan.TurnsLoaded := TurnsAfterLoad[TransportPlan.LoadLoc]; 1155 TransportPlan.nLoad := 0; 1156 for tuix := nTransportLoad - 1 downto 0 do 1066 1157 begin 1067 Loc_to_ab(TransportPlan.LoadLoc, MyUnit[uixTransportLoad[tuix]].Loc, a, b);1068 if (abs(a)<=1) and (abs(b)<=1) then1158 Loc_to_ab(TransportPlan.LoadLoc, MyUnit[uixTransportLoad[tuix]].Loc, a, b); 1159 if (abs(a) <= 1) and (abs(b) <= 1) then 1069 1160 begin 1070 TransportPlan.uixLoad[TransportPlan.nLoad]:=uixTransportLoad[tuix]; 1071 uixTransportLoad[tuix]:=uixTransportLoad[nTransportLoad-1]; 1072 dec(nTransportLoad); 1073 inc(TransportPlan.nLoad); 1074 if TransportPlan.nLoad=TransportCapacity then break; 1161 TransportPlan.uixLoad[TransportPlan.nLoad] := uixTransportLoad[tuix]; 1162 uixTransportLoad[tuix] := uixTransportLoad[nTransportLoad - 1]; 1163 Dec(nTransportLoad); 1164 Inc(TransportPlan.nLoad); 1165 if TransportPlan.nLoad = TransportCapacity then 1166 break; 1075 1167 end; 1076 1168 end; 1077 result:=true;1078 exit;1079 end 1080 end 1081 end; 1082 1083 while HaveDestinations and (nTransportLoad>0) do1169 Result := True; 1170 exit; 1171 end; 1172 end; 1173 end; 1174 1175 while HaveDestinations and (nTransportLoad > 0) do 1084 1176 begin 1085 // select units from same continent 1086 fillchar(Arrived, 4*nContinent, 0); // misuse Arrived as counter 1087 for tuix:=0 to nTransportLoad-1 do 1088 begin 1089 assert(Map[MyUnit[uixTransportLoad[tuix]].Loc] and fTerrain>=fGrass); 1090 f:=Formation[MyUnit[uixTransportLoad[tuix]].Loc]; 1091 if f>=0 then inc(Arrived[f]); 1092 end; 1093 OriginContinent:=0; 1094 for f:=1 to nContinent-1 do 1095 if Arrived[f]>Arrived[OriginContinent] then OriginContinent:=f; 1096 nSelectedLoad:=0; 1097 for tuix:=0 to nTransportLoad-1 do 1098 if Formation[MyUnit[uixTransportLoad[tuix]].Loc]=OriginContinent then 1099 begin 1100 tuixSelectedLoad[nSelectedLoad]:=tuix; 1101 uixSelectedLoad[nSelectedLoad]:=uixTransportLoad[tuix]; 1102 inc(nSelectedLoad); 1103 if nSelectedLoad=16 then break; 1104 end; 1105 1106 Pile.Create(MapSize); 1107 fillchar(ResponsibleTransport, MapSize*2, $FF); // -1 1108 fillchar(TurnsBeforeLoad, MapSize, $FF); // -1 1109 ok:=false; 1110 for uix:=0 to RO.nUn-1 do if TransportAvailable[uix]>0 then 1111 begin 1112 ok:=true; 1113 Pile.Put(MyUnit[uix].Loc, ($800-MyUnit[uix].Movement) shl 12 + uix); 1114 end; 1115 if not ok then // no transports 1116 begin TransportPlan.LoadLoc:=-1; result:=false; Pile.Free; exit end; 1117 while Pile.Get(Loc0, Time0) do 1118 begin 1119 uix:=Time0 and $FFF; 1120 Time0:=Time0 shr 12; 1121 ResponsibleTransport[Loc0]:=uix; 1122 TurnsBeforeLoad[Loc0]:=Time0 shr 12; 1123 V8_to_Loc(Loc0, Adjacent); 1124 for V8:=0 to 7 do 1125 begin 1126 Loc1:=Adjacent[V8]; 1127 if (Loc1>=0) and (ResponsibleTransport[Loc1]<0) then 1128 case CheckStep(GetMyMoveStyle(MyUnit[uix].mix, MyUnit[uix].Health), 1129 Time0, V8 and 1, ArriveTime, RecoverTurns, Map[Loc0], Map[Loc1], false) of 1130 csOk: Pile.Put(Loc1, ArriveTime shl 12 + uix); 1131 csForbiddenTile: ResponsibleTransport[Loc1]:=RO.nUn; // don't check again 1177 // select units from same continent 1178 fillchar(Arrived, 4 * nContinent, 0); // misuse Arrived as counter 1179 for tuix := 0 to nTransportLoad - 1 do 1180 begin 1181 assert(Map[MyUnit[uixTransportLoad[tuix]].Loc] and fTerrain >= fGrass); 1182 f := Formation[MyUnit[uixTransportLoad[tuix]].Loc]; 1183 if f >= 0 then 1184 Inc(Arrived[f]); 1185 end; 1186 OriginContinent := 0; 1187 for f := 1 to nContinent - 1 do 1188 if Arrived[f] > Arrived[OriginContinent] then 1189 OriginContinent := f; 1190 nSelectedLoad := 0; 1191 for tuix := 0 to nTransportLoad - 1 do 1192 if Formation[MyUnit[uixTransportLoad[tuix]].Loc] = OriginContinent then 1193 begin 1194 tuixSelectedLoad[nSelectedLoad] := tuix; 1195 uixSelectedLoad[nSelectedLoad] := uixTransportLoad[tuix]; 1196 Inc(nSelectedLoad); 1197 if nSelectedLoad = 16 then 1198 break; 1199 end; 1200 1201 Pile.Create(MapSize); 1202 fillchar(ResponsibleTransport, MapSize * 2, $FF); // -1 1203 fillchar(TurnsBeforeLoad, MapSize, $FF); // -1 1204 ok := False; 1205 for uix := 0 to RO.nUn - 1 do 1206 if TransportAvailable[uix] > 0 then 1207 begin 1208 ok := True; 1209 Pile.Put(MyUnit[uix].Loc, ($800 - MyUnit[uix].Movement) shl 12 + uix); 1210 end; 1211 if not ok then // no transports 1212 begin 1213 TransportPlan.LoadLoc := -1; 1214 Result := False; 1215 Pile.Free; 1216 exit; 1217 end; 1218 while Pile.Get(Loc0, Time0) do 1219 begin 1220 uix := Time0 and $FFF; 1221 Time0 := Time0 shr 12; 1222 ResponsibleTransport[Loc0] := uix; 1223 TurnsBeforeLoad[Loc0] := Time0 shr 12; 1224 V8_to_Loc(Loc0, Adjacent); 1225 for V8 := 0 to 7 do 1226 begin 1227 Loc1 := Adjacent[V8]; 1228 if (Loc1 >= 0) and (ResponsibleTransport[Loc1] < 0) then 1229 case CheckStep(GetMyMoveStyle(MyUnit[uix].mix, MyUnit[uix].Health), 1230 Time0, V8 and 1, ArriveTime, RecoverTurns, Map[Loc0], Map[Loc1], False) of 1231 csOk: Pile.Put(Loc1, ArriveTime shl 12 + uix); 1232 csForbiddenTile: ResponsibleTransport[Loc1] := RO.nUn; // don't check again 1233 end; 1234 end; 1235 end; 1236 1237 fillchar(Arrived, MapSize * 4, $55); // set NotReachedFlag for all tiles 1238 fillchar(GroupComplete, MapSize, False); 1239 BestLoadLoc := -1; 1240 1241 // check direct loading 1242 for tuix := 0 to nSelectedLoad - 1 do 1243 begin 1244 uix := uixSelectedLoad[tuix]; 1245 if MyUnit[uix].Movement = integer(MyModel[MyUnit[uix].mix].Speed) then 1246 begin 1247 NotReachedFlag := 1 shl (2 * tuix); 1248 CompleteFlag := NotReachedFlag shl 1; 1249 V8_to_Loc(MyUnit[uix].Loc, Adjacent); 1250 for V8 := 0 to 7 do 1251 begin 1252 Loc1 := Adjacent[V8]; 1253 if (Loc1 >= 0) and (Map[Loc1] and fTerrain < fGrass) and 1254 not GroupComplete[Loc1] then 1255 begin // possible transport start location 1256 Arrived[Loc1] := (Arrived[Loc1] or CompleteFlag) and not NotReachedFlag; 1257 if (TurnsBeforeLoad[Loc1] >= 0) and (TurnsAfterLoad[Loc1] >= 0) then 1258 begin 1259 i := 1; 1260 GroupCount := 0; 1261 for tuix1 := 0 to nSelectedLoad - 1 do 1262 begin 1263 if Arrived[loc1] and i = 0 then 1264 Inc(GroupCount); 1265 i := i shl 2; 1266 end; 1267 assert(GroupCount <= TransportCapacity); 1268 if (GroupCount = TransportCapacity) or (GroupCount = nSelectedLoad) then 1269 GroupComplete[loc1] := True; 1270 TotalDelay := TurnsBeforeLoad[Loc1] + TurnsAfterLoad[Loc1]; 1271 if (BestLoadLoc < 0) or (GroupCount shl 16 - 1272 TotalDelay > BestGroupCount shl 16 - BestTotalDelay) then 1273 begin 1274 BestLoadLoc := Loc1; 1275 BestGroupCount := GroupCount; 1276 BestTotalDelay := TotalDelay; 1277 end; 1278 end; 1279 end; 1280 end; 1281 end; 1282 end; 1283 1284 TurnCount := 0; 1285 ArrivedEnd := @Arrived[MapSize]; 1286 1287 // check moving+loading 1288 ContinueUnit := 1 shl nSelectedLoad - 1; 1289 while (ContinueUnit > 0) and ((BestLoadLoc < 0) or 1290 (TurnCount < BestTotalDelay - 2)) do 1291 begin 1292 for tuix := 0 to nSelectedLoad - 1 do 1293 if 1 shl tuix and ContinueUnit <> 0 then 1294 begin 1295 uix := uixSelectedLoad[tuix]; 1296 MoveStyle := GetMyMoveStyle(MyUnit[uix].mix, MyUnit[uix].Health); 1297 NotReachedFlag := 1 shl (2 * tuix); 1298 CompleteFlag := NotReachedFlag shl 1; 1299 FullMovementLoc := -1; 1300 1301 Pile.Empty; 1302 if TurnCount = 0 then 1303 begin 1304 Pile.Put(MyUnit[uix].Loc, $1800 - MyUnit[uix].Movement); 1305 if MyUnit[uix].Movement = integer(MyModel[MyUnit[uix].mix].Speed) then 1306 FullMovementLoc := MyUnit[uix].Loc; 1307 // surrounding tiles can be loaded immediately 1308 StartLocPtr := ArrivedEnd; 1132 1309 end 1133 end 1134 end; 1135 1136 fillchar(Arrived, MapSize*4, $55); // set NotReachedFlag for all tiles 1137 fillchar(GroupComplete, MapSize, false); 1138 BestLoadLoc:=-1; 1139 1140 // check direct loading 1141 for tuix:=0 to nSelectedLoad-1 do 1142 begin 1143 uix:=uixSelectedLoad[tuix]; 1144 if MyUnit[uix].Movement=integer(MyModel[MyUnit[uix].mix].Speed) then 1145 begin 1146 NotReachedFlag:=1 shl (2*tuix); 1147 CompleteFlag:=NotReachedFlag shl 1; 1148 V8_to_Loc(MyUnit[uix].Loc, Adjacent); 1149 for V8:=0 to 7 do 1310 else 1311 StartLocPtr := @Arrived; 1312 IsFirstLoc := True; 1313 1314 repeat 1315 if StartLocPtr <> ArrivedEnd then 1316 // search next movement start location for this turn 1317 StartLocPtr := NextZero(StartLocPtr, ArrivedEnd, 1318 CompleteFlag or NotReachedFlag); 1319 if StartLocPtr <> ArrivedEnd then 1320 begin 1321 Loc0 := (integer(StartLocPtr) - integer(@Arrived)) shr 2; 1322 Inc(StartLocPtr); 1323 Time0 := $800; 1324 end 1325 else if not Pile.Get(Loc0, Time0) then 1326 begin 1327 if IsFirstLoc then 1328 ContinueUnit := ContinueUnit and not (1 shl tuix); 1329 break; 1330 end; 1331 IsFirstLoc := False; 1332 1333 Arrived[Loc0] := Arrived[Loc0] and not NotReachedFlag; 1334 if not GroupComplete[Loc0] and (Map[Loc0] and fTerrain <> fMountains) then 1335 begin // check whether group complete -- no mountains because complete flag might be faked there 1336 i := 1; 1337 GroupCount := 0; 1338 for tuix1 := 0 to nSelectedLoad - 1 do 1339 begin 1340 if Arrived[Loc0] and i = 0 then 1341 Inc(GroupCount); 1342 i := i shl 2; 1343 end; 1344 assert(GroupCount <= TransportCapacity); 1345 if (GroupCount = TransportCapacity) or (GroupCount = nSelectedLoad) then 1346 GroupComplete[Loc0] := True; 1347 end; 1348 1349 V8_to_Loc(Loc0, Adjacent); 1350 IsComplete := True; 1351 for V8 := 0 to 7 do 1352 begin 1353 Loc1 := Adjacent[V8]; 1354 if (Loc1 < G.ly) or (Loc1 >= MapSize - G.ly) then 1355 Adjacent[V8] := -1 // pole, don't consider moving here 1356 else if Arrived[Loc1] and NotReachedFlag = 0 then 1357 Adjacent[V8] := -1 // unit has already arrived this tile 1358 else if GroupComplete[Loc1] then 1359 Adjacent[V8] := -1 // already other group complete 1360 else if Map[Loc1] and fTerrain < fGrass then 1361 begin // possible transport start location 1362 Arrived[Loc1] := (Arrived[Loc1] or CompleteFlag) and not NotReachedFlag; 1363 Adjacent[V8] := -1; 1364 if (TurnsBeforeLoad[Loc1] >= 0) and (TurnsAfterLoad[Loc1] >= 0) then 1365 begin 1366 i := 1; 1367 GroupCount := 0; 1368 for tuix1 := 0 to nSelectedLoad - 1 do 1369 begin 1370 if Arrived[loc1] and i = 0 then 1371 Inc(GroupCount); 1372 i := i shl 2; 1373 end; 1374 assert(GroupCount <= TransportCapacity); 1375 if (GroupCount = TransportCapacity) or 1376 (GroupCount = nSelectedLoad) then 1377 GroupComplete[loc1] := True; 1378 if TurnsBeforeLoad[Loc1] > TurnCount + 1 then 1379 TotalDelay := TurnsBeforeLoad[Loc1] + TurnsAfterLoad[Loc1] 1380 else 1381 TotalDelay := TurnCount + 1 + TurnsAfterLoad[Loc1]; 1382 if (BestLoadLoc < 0) or (GroupCount shl 1383 16 - TotalDelay > BestGroupCount shl 16 - BestTotalDelay) then 1384 begin 1385 BestLoadLoc := Loc1; 1386 BestGroupCount := GroupCount; 1387 BestTotalDelay := TotalDelay; 1388 end; 1389 end; 1390 end 1391 else if (Map[Loc1] and fTerrain = fMountains) and 1392 ((Map[Loc0] and (fRoad or fRR or fCity) = 0) or 1393 (Map[Loc1] and (fRoad or fRR or fCity) = 0)) and 1394 (Map[Loc0] and Map[Loc1] and (fRiver or fCanal) = 0) then 1395 begin // mountain delay too complicated for this algorithm 1396 Arrived[Loc1] := (Arrived[Loc1] or CompleteFlag) and not NotReachedFlag; 1397 Adjacent[V8] := -1; 1398 end 1399 else 1400 IsComplete := False; 1401 end; 1402 if IsComplete then 1403 begin 1404 Arrived[Loc0] := (Arrived[Loc0] or CompleteFlag) and not NotReachedFlag; 1405 continue; 1406 end; 1407 IsComplete := True; 1408 for V8 := 0 to 7 do 1409 begin 1410 Loc1 := Adjacent[V8]; 1411 if Loc1 >= 0 then 1412 begin 1413 ok := False; 1414 case CheckStep(MoveStyle, Time0, V8 and 1, ArriveTime, 1415 RecoverTurns, Map[Loc0], Map[Loc1], False) of 1416 csOk: ok := True; 1417 csForbiddenTile: 1418 ;// !!! don't check moving there again 1419 csCheckTerritory: 1420 ok := RO.Territory[Loc1] = RO.Territory[Loc0]; 1421 end; 1422 if ok and Pile.TestPut(Loc1, ArriveTime) then 1423 if ArriveTime < $2000 then 1424 Pile.Put(Loc1, ArriveTime) 1425 else 1426 IsComplete := False; 1427 end; 1428 end; 1429 if IsComplete then 1430 Arrived[Loc0] := (Arrived[Loc0] or CompleteFlag) and not NotReachedFlag; 1431 until False; 1432 end; 1433 1434 Inc(TurnCount); 1435 end; 1436 Pile.Free; 1437 1438 if BestLoadLoc >= 0 then 1439 begin 1440 TransportPlan.LoadLoc := BestLoadLoc; 1441 TransportPlan.uixTransport := ResponsibleTransport[BestLoadLoc]; 1442 TransportAvailable[TransportPlan.uixTransport] := 0; 1443 TransportPlan.TurnsEmpty := BestTotalDelay - TurnsAfterLoad[BestLoadLoc]; 1444 TransportPlan.TurnsLoaded := TurnsAfterLoad[BestLoadLoc]; 1445 TransportPlan.nLoad := 0; 1446 for tuix := nSelectedLoad - 1 downto 0 do 1447 if 1 shl (2 * tuix) and Arrived[BestLoadLoc] = 0 then 1150 1448 begin 1151 Loc1:=Adjacent[V8]; 1152 if (Loc1>=0) and (Map[Loc1] and fTerrain<fGrass) 1153 and not GroupComplete[Loc1] then 1154 begin // possible transport start location 1155 Arrived[Loc1]:=(Arrived[Loc1] or CompleteFlag) and not NotReachedFlag; 1156 if (TurnsBeforeLoad[Loc1]>=0) and (TurnsAfterLoad[Loc1]>=0) then 1157 begin 1158 i:=1; 1159 GroupCount:=0; 1160 for tuix1:=0 to nSelectedLoad-1 do 1161 begin 1162 if Arrived[loc1] and i=0 then inc(GroupCount); 1163 i:=i shl 2; 1164 end; 1165 assert(GroupCount<=TransportCapacity); 1166 if (GroupCount=TransportCapacity) or (GroupCount=nSelectedLoad) then 1167 GroupComplete[loc1]:=true; 1168 TotalDelay:=TurnsBeforeLoad[Loc1]+TurnsAfterLoad[Loc1]; 1169 if (BestLoadLoc<0) 1170 or (GroupCount shl 16-TotalDelay 1171 >BestGroupCount shl 16-BestTotalDelay) then 1172 begin 1173 BestLoadLoc:=Loc1; 1174 BestGroupCount:=GroupCount; 1175 BestTotalDelay:=TotalDelay 1176 end 1177 end 1178 end 1449 assert(uixTransportLoad[tuixSelectedLoad[tuix]] = uixSelectedLoad[tuix]); 1450 TransportPlan.uixLoad[TransportPlan.nLoad] := uixSelectedLoad[tuix]; 1451 uixTransportLoad[tuixSelectedLoad[tuix]] := 1452 uixTransportLoad[nTransportLoad - 1]; 1453 Dec(nTransportLoad); 1454 Inc(TransportPlan.nLoad); 1179 1455 end; 1180 end 1181 end; 1182 1183 TurnCount:=0; 1184 ArrivedEnd:=@Arrived[MapSize]; 1185 1186 // check moving+loading 1187 ContinueUnit:=1 shl nSelectedLoad-1; 1188 while (ContinueUnit>0) and ((BestLoadLoc<0) or (TurnCount<BestTotalDelay-2)) do 1189 begin 1190 for tuix:=0 to nSelectedLoad-1 do if 1 shl tuix and ContinueUnit<>0 then 1191 begin 1192 uix:=uixSelectedLoad[tuix]; 1193 MoveStyle:=GetMyMoveStyle(MyUnit[uix].mix, MyUnit[uix].Health); 1194 NotReachedFlag:=1 shl (2*tuix); 1195 CompleteFlag:=NotReachedFlag shl 1; 1196 FullMovementLoc:=-1; 1197 1198 Pile.Empty; 1199 if TurnCount=0 then 1200 begin 1201 Pile.Put(MyUnit[uix].Loc, $1800-MyUnit[uix].Movement); 1202 if MyUnit[uix].Movement=integer(MyModel[MyUnit[uix].mix].Speed) then 1203 FullMovementLoc:=MyUnit[uix].Loc; // surrounding tiles can be loaded immediately 1204 StartLocPtr:=ArrivedEnd; 1205 end 1206 else StartLocPtr:=@Arrived; 1207 IsFirstLoc:=true; 1208 1209 repeat 1210 if StartLocPtr<>ArrivedEnd then // search next movement start location for this turn 1211 StartLocPtr:=NextZero(StartLocPtr, ArrivedEnd, CompleteFlag or NotReachedFlag); 1212 if StartLocPtr<>ArrivedEnd then 1213 begin 1214 Loc0:=(integer(StartLocPtr)-integer(@Arrived)) shr 2; 1215 inc(StartLocPtr); 1216 Time0:=$800 1217 end 1218 else if not Pile.Get(Loc0, Time0) then 1219 begin 1220 if IsFirstLoc then ContinueUnit:=ContinueUnit and not (1 shl tuix); 1221 break; 1222 end; 1223 IsFirstLoc:=false; 1224 1225 Arrived[Loc0]:=Arrived[Loc0] and not NotReachedFlag; 1226 if not GroupComplete[Loc0] and (Map[Loc0] and fTerrain<>fMountains) then 1227 begin // check whether group complete -- no mountains because complete flag might be faked there 1228 i:=1; 1229 GroupCount:=0; 1230 for tuix1:=0 to nSelectedLoad-1 do 1231 begin 1232 if Arrived[Loc0] and i=0 then inc(GroupCount); 1233 i:=i shl 2; 1234 end; 1235 assert(GroupCount<=TransportCapacity); 1236 if (GroupCount=TransportCapacity) or (GroupCount=nSelectedLoad) then 1237 GroupComplete[Loc0]:=true 1238 end; 1239 1240 V8_to_Loc(Loc0, Adjacent); 1241 IsComplete:=true; 1242 for V8:=0 to 7 do 1243 begin 1244 Loc1:=Adjacent[V8]; 1245 if (Loc1<G.ly) or (Loc1>=MapSize-G.ly) then 1246 Adjacent[V8]:=-1 // pole, don't consider moving here 1247 else if Arrived[Loc1] and NotReachedFlag=0 then 1248 Adjacent[V8]:=-1 // unit has already arrived this tile 1249 else if GroupComplete[Loc1] then 1250 Adjacent[V8]:=-1 // already other group complete 1251 else if Map[Loc1] and fTerrain<fGrass then 1252 begin // possible transport start location 1253 Arrived[Loc1]:=(Arrived[Loc1] or CompleteFlag) and not NotReachedFlag; 1254 Adjacent[V8]:=-1; 1255 if (TurnsBeforeLoad[Loc1]>=0) and (TurnsAfterLoad[Loc1]>=0) then 1256 begin 1257 i:=1; 1258 GroupCount:=0; 1259 for tuix1:=0 to nSelectedLoad-1 do 1260 begin 1261 if Arrived[loc1] and i=0 then inc(GroupCount); 1262 i:=i shl 2; 1263 end; 1264 assert(GroupCount<=TransportCapacity); 1265 if (GroupCount=TransportCapacity) or (GroupCount=nSelectedLoad) then 1266 GroupComplete[loc1]:=true; 1267 if TurnsBeforeLoad[Loc1]>TurnCount+1 then 1268 TotalDelay:=TurnsBeforeLoad[Loc1]+TurnsAfterLoad[Loc1] 1269 else TotalDelay:=TurnCount+1+TurnsAfterLoad[Loc1]; 1270 if (BestLoadLoc<0) 1271 or (GroupCount shl 16-TotalDelay 1272 >BestGroupCount shl 16-BestTotalDelay) then 1273 begin 1274 BestLoadLoc:=Loc1; 1275 BestGroupCount:=GroupCount; 1276 BestTotalDelay:=TotalDelay 1277 end 1278 end 1279 end 1280 else if (Map[Loc1] and fTerrain=fMountains) 1281 and ((Map[Loc0] and (fRoad or fRR or fCity)=0) 1282 or (Map[Loc1] and (fRoad or fRR or fCity)=0)) 1283 and (Map[Loc0] and Map[Loc1] and (fRiver or fCanal)=0) then 1284 begin // mountain delay too complicated for this algorithm 1285 Arrived[Loc1]:=(Arrived[Loc1] or CompleteFlag) and not NotReachedFlag; 1286 Adjacent[V8]:=-1; 1287 end 1288 else IsComplete:=false; 1289 end; 1290 if IsComplete then 1291 begin 1292 Arrived[Loc0]:=(Arrived[Loc0] or CompleteFlag) and not NotReachedFlag; 1293 continue 1294 end; 1295 IsComplete:=true; 1296 for V8:=0 to 7 do 1297 begin 1298 Loc1:=Adjacent[V8]; 1299 if Loc1>=0 then 1300 begin 1301 ok:=false; 1302 case CheckStep(MoveStyle, Time0, V8 and 1, ArriveTime, RecoverTurns, 1303 Map[Loc0], Map[Loc1],false) of 1304 csOk: ok:=true; 1305 csForbiddenTile: 1306 ;// !!! don't check moving there again 1307 csCheckTerritory: 1308 ok:= RO.Territory[Loc1]=RO.Territory[Loc0]; 1309 end; 1310 if ok and Pile.TestPut(Loc1, ArriveTime) then 1311 if ArriveTime<$2000 then Pile.Put(Loc1, ArriveTime) 1312 else IsComplete:=false 1313 end 1314 end; 1315 if IsComplete then 1316 Arrived[Loc0]:=(Arrived[Loc0] or CompleteFlag) and not NotReachedFlag; 1317 until false; 1318 end; 1319 1320 inc(TurnCount); 1321 end; 1322 Pile.Free; 1323 1324 if BestLoadLoc>=0 then 1325 begin 1326 TransportPlan.LoadLoc:=BestLoadLoc; 1327 TransportPlan.uixTransport:=ResponsibleTransport[BestLoadLoc]; 1328 TransportAvailable[TransportPlan.uixTransport]:=0; 1329 TransportPlan.TurnsEmpty:=BestTotalDelay-TurnsAfterLoad[BestLoadLoc]; 1330 TransportPlan.TurnsLoaded:=TurnsAfterLoad[BestLoadLoc]; 1331 TransportPlan.nLoad:=0; 1332 for tuix:=nSelectedLoad-1 downto 0 do 1333 if 1 shl (2*tuix) and Arrived[BestLoadLoc]=0 then 1334 begin 1335 assert(uixTransportLoad[tuixSelectedLoad[tuix]]=uixSelectedLoad[tuix]); 1336 TransportPlan.uixLoad[TransportPlan.nLoad]:=uixSelectedLoad[tuix]; 1337 uixTransportLoad[tuixSelectedLoad[tuix]]:= 1338 uixTransportLoad[nTransportLoad-1]; 1339 dec(nTransportLoad); 1340 inc(TransportPlan.nLoad) 1341 end; 1342 result:=true; 1343 exit 1344 end; 1345 1346 // no loading location for a single of these units -- remove all 1347 // should be pretty rare case 1348 for tuix:=nSelectedLoad-1 downto 0 do 1349 begin 1350 assert(uixTransportLoad[tuixSelectedLoad[tuix]]=uixSelectedLoad[tuix]); 1351 uixTransportLoad[tuixSelectedLoad[tuix]]:= 1352 uixTransportLoad[nTransportLoad-1]; 1353 dec(nTransportLoad); 1354 end; 1355 end; 1356 TransportPlan.LoadLoc:=-1; 1357 result:=false; 1456 Result := True; 1457 exit; 1458 end; 1459 1460 // no loading location for a single of these units -- remove all 1461 // should be pretty rare case 1462 for tuix := nSelectedLoad - 1 downto 0 do 1463 begin 1464 assert(uixTransportLoad[tuixSelectedLoad[tuix]] = uixSelectedLoad[tuix]); 1465 uixTransportLoad[tuixSelectedLoad[tuix]] := 1466 uixTransportLoad[nTransportLoad - 1]; 1467 Dec(nTransportLoad); 1468 end; 1469 end; 1470 TransportPlan.LoadLoc := -1; 1471 Result := False; 1358 1472 end; 1359 1473 … … 1364 1478 function TToolAI.CurrentMStrength(Domain: integer): integer; 1365 1479 var 1366 i: integer; 1367 begin 1368 result:=0; 1369 for i:=0 to nUpgrade-1 do with upgrade[Domain,i] do 1370 if (Preq=preNone) 1371 or (Preq>=0) and ((RO.Tech[Preq]>=tsApplicable) 1372 or (Preq in FutureTech) and (RO.Tech[Preq]>=0)) then 1373 begin 1374 if Preq in FutureTech then 1375 inc(result,RO.Tech[Preq]*Strength) 1376 else inc(result,Strength); 1377 end; 1480 i: integer; 1481 begin 1482 Result := 0; 1483 for i := 0 to nUpgrade - 1 do 1484 with upgrade[Domain, i] do 1485 if (Preq = preNone) or (Preq >= 0) and 1486 ((RO.Tech[Preq] >= tsApplicable) or (Preq in FutureTech) and 1487 (RO.Tech[Preq] >= 0)) then 1488 begin 1489 if Preq in FutureTech then 1490 Inc(Result, RO.Tech[Preq] * Strength) 1491 else 1492 Inc(Result, Strength); 1493 end; 1378 1494 end; 1379 1495 … … 1383 1499 procedure SetAdvancedness; 1384 1500 var 1385 ad,j,Reduction,AgeThreshold: integer; 1386 known: array[0..nAdv-1] of integer; 1501 ad, j, Reduction, AgeThreshold: integer; 1502 known: array[0..nAdv - 1] of integer; 1503 1387 1504 procedure MarkPreqs(ad: integer); 1388 1505 var 1389 i: integer;1506 i: integer; 1390 1507 begin 1391 if known[ad]=0 then 1392 begin 1393 known[ad]:=1; 1394 for i:=0 to 2 do 1395 if AdvPreq[ad,i]>=0 then MarkPreqs(AdvPreq[ad,i]); 1396 end 1397 end; 1398 begin 1399 FillChar(Advancedness,SizeOf(Advancedness),0); 1400 for ad:=0 to nAdv-1 do 1508 if known[ad] = 0 then 1509 begin 1510 known[ad] := 1; 1511 for i := 0 to 2 do 1512 if AdvPreq[ad, i] >= 0 then 1513 MarkPreqs(AdvPreq[ad, i]); 1514 end; 1515 end; 1516 1517 begin 1518 FillChar(Advancedness, SizeOf(Advancedness), 0); 1519 for ad := 0 to nAdv - 1 do 1401 1520 begin 1402 FillChar(known,SizeOf(known),0); 1403 MarkPreqs(ad); 1404 for j:=0 to nAdv-1 do if known[j]>0 then inc(Advancedness[ad]); 1405 end; 1406 AgeThreshold:=Advancedness[adScience]; 1407 Reduction:=Advancedness[adScience] div 3; 1408 for ad:=0 to nAdv-5 do 1409 if Advancedness[ad]>=AgeThreshold then 1410 dec(Advancedness[ad], Reduction); 1411 AgeThreshold:=Advancedness[adMassProduction]; 1412 Reduction:=(Advancedness[adMassProduction]-Advancedness[adScience]) div 3; 1413 for ad:=0 to nAdv-5 do 1414 if Advancedness[ad]>=AgeThreshold then 1415 dec(Advancedness[ad], Reduction) 1521 FillChar(known, SizeOf(known), 0); 1522 MarkPreqs(ad); 1523 for j := 0 to nAdv - 1 do 1524 if known[j] > 0 then 1525 Inc(Advancedness[ad]); 1526 end; 1527 AgeThreshold := Advancedness[adScience]; 1528 Reduction := Advancedness[adScience] div 3; 1529 for ad := 0 to nAdv - 5 do 1530 if Advancedness[ad] >= AgeThreshold then 1531 Dec(Advancedness[ad], Reduction); 1532 AgeThreshold := Advancedness[adMassProduction]; 1533 Reduction := (Advancedness[adMassProduction] - Advancedness[adScience]) div 3; 1534 for ad := 0 to nAdv - 5 do 1535 if Advancedness[ad] >= AgeThreshold then 1536 Dec(Advancedness[ad], Reduction); 1416 1537 end; 1417 1538 1418 1539 1419 1540 initialization 1420 SetAdvancedness;1541 SetAdvancedness; 1421 1542 1422 1543 end. 1423
Note:
See TracChangeset
for help on using the changeset viewer.
