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