Changeset 160 for trunk/AI/StdAI
- Timestamp:
- Mar 6, 2019, 8:10:23 AM (6 years ago)
- Location:
- trunk/AI/StdAI
- Files:
-
- 4 added
- 8 deleted
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/AI/StdAI/AI.pas
r124 r160 1 1 {$INCLUDE Switches.inc} 2 {//$DEFINE PERF} 2 3 unit AI; 3 4 … … 5 6 6 7 uses 7 {$IFDEF DEBUG}SysUtils, {$ENDIF} // necessary for debug exceptions 8 Protocol, CustomAI, ToolAI; 8 {$IFDEF DEBUG}SysUtils,Names,{$ENDIF} // necessary for debug exceptions 9 {$IFDEF PERF}SysUtils,Windows,{$ENDIF} // necessary for performance measurement 10 Protocol, CustomAI, ToolAI, Barbarina; 11 12 13 const 14 WaitAfterReject=20; // don't try to contact this number of turn after contact was rejected 15 MinCityFood=3; 16 LeaveDespotism=80; // stay in despotism until this turn 17 TechReportOutdated=30; 18 MilProdShare=50; // minimum share of total production to specialize in military production 19 20 FutureTech=[futResearchTechnology,futProductionTechnology,futArmorTechnology, 21 futMissileTechnology]; 22 23 nResearchOrder=46; 24 ResearchOrder: array[0..1,0..nResearchOrder-1] of integer= 25 ((adWheel,adWarriorCode,adHorsebackRiding,adCeremonialBurial,adPolytheism, 26 adMonarchy,adMysticism,adPoetry,adAstronomy,adMonotheism, 27 adTheology,adChivalry,adPottery,adMedicine,adGunpowder,adChemistry, 28 adExplosives,adUniversity,adTactics,adSeafaring,adNavigation,adRefining,adCombustionEngine, 29 adAutomobile,adPhysics,adMagnetism,adElectricity,adRefrigeration, 30 adRadioCommunication,adTheoryOfGravity,adAtomicTheory,adElectronics, 31 adMassProduction,adPlastics,adFlight,adEnvironmentalism, 32 adSanitation,adMin,adComputers,adRecycling,adSyntheticFood, 33 adSelfContainedEnvironment,adNuclearFission,adNuclearPower,adTheLaser, 34 adIntelligenArms), 35 (adWheel,adWarriorCode,adHorsebackRiding,adAlphabet,adMapMaking,adBronzeWorking,adWriting, 36 adCodeOfLaws,adCurrency,adTrade,adLiterature,adTheRepublic,adMathematics, 37 adPhilosophy,adScience,adMasonry,adConstruction,adEngineering,adInvention, 38 adIronWorking,adBridgeBuilding,adSteamEngine,adRailroad,adSteel, 39 adBanking,adIndustrialization,adConscription,adDemocracy,adEconomics, 40 adTheCorporation,adMassProduction,adRobotics,adCommunism,adMetallurgy, 41 adBallistics,adMobileWarfare,adAmphibiousWarfare,adMin,adComputers,adRocketry,adAdvancedRocketry, 42 adAdvancedFlight,adSpaceFlight,adComposites,adIntelligence,adCombinedArms)); 43 44 LeaveOutTechs=[adPolytheism,adMysticism,adInvention,adEconomics,adPottery, 45 adMedicine,adEnvironmentalism,adRefining,adTrade,adLiterature,adMathematics, 46 adPhilosophy,adChemistry,adConscription,adCombustionEngine,adPhysics, 47 adTheoryOfGravity,adAtomicTheory,adSyntheticFood,adNuclearFission]; 48 49 TechValue_ForResearch_LeaveOut=$700; 50 TechValue_ForResearch_Urgent=$600; 51 TechValue_ForResearch_Next=$400; 52 TechValue_ForResearch=$FF; 53 ForceNeeded_NoLeaveOut=20; // advancedness behind to state-of-art 54 ForceNeeded_LeaveOut=30; // advancedness behind of state-of-art 55 Compromise=6; 56 57 // basic strategies 58 bGender=$0001; 59 bMale=$0000; 60 bFemale=$0001; 61 bBarbarina=$0006; 62 bBarbarina_Hide=$0002; 63 64 // model categories 65 nModelCat=4; 66 mctNone=-1; mctGroundDefender=0; mctGroundAttacker=1; mctTransport=2; mctCruiser=3; 67 68 // mil research 69 BetterQuality: array[0..nModelCat-1] of integer=(50,50,80,80); 70 MaxBuildWorseThanBestModel=20; MaxExistWorseThanBestModel=50; 71 72 maxCOD=256; 73 PresenceUnknown=$10000; 74 75 nRequestedTechs=48; 76 77 PlayerHash: array[0..nPl-1] of integer=(7,6,0,2,10,8,12,14,4,1,3,5,9,11,13); 9 78 10 79 type 11 UnitRole = (Roam, Defend); 12 13 TAI = class(TToolAI) 14 constructor Create(Nation: integer); override; 15 16 protected 17 procedure DoTurn; override; 18 procedure DoNegotiation; override; 19 function ChooseResearchAdvance: integer; override; 20 function ChooseGovernment: integer; override; 21 function WantNegotiation(Nation: integer; NegoTime: TNegoTime) 22 : boolean; override; 23 24 procedure ProcessSettlers; 25 procedure ProcessUnit(uix: integer; Role: UnitRole); 26 procedure SetCityProduction; 27 end; 80 Suggestion=(suContact, suPeace, suFriendly); 81 82 TPersistentData=record 83 LastResearchTech, BehaviorFlags, TheologyPartner: integer; 84 RejectTurn: array[Suggestion,0..15] of smallint; 85 RequestedTechs: array[0..nRequestedTechs-1] of integer; 86 // ad + p shl 8 + Turn shl 16 87 end; 88 89 TAI = class(TBarbarina) 90 constructor Create(Nation: integer); override; 91 92 procedure SetDataDefaults; override; 93 94 protected 95 Data: ^TPersistentData; 96 WarNations, BombardingNations, mixSettlers, mixCaravan, mixTownGuard, 97 mixSlaves, mixMilitia, mixCruiser, OceanWithShip: integer; 98 NegoCause: (Routine,CheckBarbarina); 99 SettlerSurplus: array[0..maxCOD-1] of integer; 100 uixPatrol: array[0..maxCOD-1] of integer; 101 102 ContinentPresence: array[0..maxCOD-1] of integer; 103 OceanPresence: array[0..maxCOD-1] of integer; 104 UnitLack: array[0..maxCOD-1,mctGroundDefender..mctGroundAttacker] of integer; 105 106 TotalPopulation: array[0..nPl-1] of integer; 107 ContinentPopulation: array[0..nPl-1,0..maxCOD-1] of integer; 108 // 1 means enemy territory spotted but no city 109 DistrictPopulation: array[0..maxCOD-1] of integer; 110 111 ModelCat: array[0..nMmax-1] of integer; 112 ModelQuality: array[0..nMmax-1] of integer; 113 ModelBestQuality: array[0..nModelCat-1] of integer; 114 115 AdvanceValue: array[0..nAdv-1] of integer; 116 AdvanceValuesSet: boolean; 117 118 procedure DoTurn; override; 119 procedure DoNegotiation; override; 120 function ChooseResearchAdvance: integer; override; 121 function ChooseStealAdvance: integer; override; 122 function ChooseGovernment: integer; override; 123 function WantNegotiation(Nation: integer; NegoTime: TNegoTime): boolean; override; 124 function OnNegoRejected_CancelTreaty: boolean; override; 125 126 procedure FindBestTrade(Nation: integer; var adWanted, adGiveAway: integer); 127 procedure CheckGender; 128 procedure AnalyzeMap; 129 procedure CollectModelCatStat; 130 procedure AttackAndPatrol; 131 procedure MoveUnitsHome; 132 procedure CheckAttack(uix: integer); 133 procedure Patrol(uix: integer); 134 procedure SetCityProduction; 135 procedure SetAdvanceValues; 136 function HavePort: boolean; 137 {$IFDEF DEBUG}procedure TraceAdvanceValues(Nation: integer);{$ENDIF} 138 139 // research 140 procedure RateModel(const mi: TModelInfo; var Category, Quality: integer); 141 procedure RateMyModel(mix: integer; var Category, Quality: integer); 142 function IsBetterModel(const mi: TModelInfo): boolean; 143 144 //terraforming 145 procedure TileWorkPlan(Loc, cix: integer; 146 var Value, NextJob, TotalWork: integer); 147 procedure ProcessSettlers; 148 149 // diplomacy 150 function MostWanted(Nation, adGiveAway: integer): integer; 151 152 end; 153 28 154 29 155 implementation 30 156 31 157 uses 32 158 Pile; 33 159 34 160 const 35 // fine adjustment 36 Aggressive = 40; // 0 = never attacks, 100 = attacks even with heavy losses 37 DestroyBonus = 30; // percent of building cost 161 // fine adjustment 162 Aggressive=40; // 0 = never attacks, 100 = attacks even with heavy losses 163 DestroyBonus=30; // percent of building cost 164 165 var 166 LeaveOutValue: array[0..nAdv-1] of integer; 167 38 168 39 169 constructor TAI.Create(Nation: integer); 40 170 begin 41 inherited; 171 inherited; 172 Data:=pointer(RO.Data); 173 {$IFDEF DEBUG}if Nation=1 then SetDebugMap(DebugMap);{$ENDIF} 174 AdvanceValuesSet:=false; 42 175 end; 43 176 44 45 // ------------------------------- 46 // MY TURN 47 // ------------------------------- 48 49 procedure TAI.DoTurn; 177 procedure TAI.SetDataDefaults; 178 begin 179 with Data^ do 180 begin 181 LastResearchTech:=-1; 182 if PlayerHash[me]>7 then BehaviorFlags:=bFemale else BehaviorFlags:=bMale; 183 DebugMessage(1, 'Gender:='+char(48+BehaviorFlags and bGender)); 184 TheologyPartner:=-1; 185 fillchar(RejectTurn,sizeof(RejectTurn),$FF); 186 Fillchar(RequestedTechs, sizeof(RequestedTechs), $FF); 187 end 188 end; 189 190 function TAI.OnNegoRejected_CancelTreaty: boolean; 191 begin 192 Data.RejectTurn[suContact,Opponent]:=RO.Turn; 193 result:= Data.BehaviorFlags and bBarbarina<>0; 194 end; 195 196 197 //------------------------------- 198 // RESEARCH 199 //------------------------------- 200 201 procedure TAI.RateModel(const mi: TModelInfo; var Category, Quality: integer); 50 202 var 51 uix: integer;203 EffectiveTransport: integer; 52 204 begin 53 // correct tax rate if necessary 54 if RO.Money > RO.nCity * 16 then 55 ChangeRates(RO.TaxRate - 10, 0) 56 else if RO.Money < RO.nCity * 8 then 57 ChangeRates(RO.TaxRate + 10, 0); 58 59 // better government form available? 60 if RO.Government <> gAnarchy then 61 if IsResearched(adTheRepublic) then 62 begin 63 if RO.Government <> gRepublic then 64 Revolution 205 if mi.Kind>=mkScout then 206 begin Category:=mctNone; exit end; 207 case mi.Domain of 208 dGround: 209 if mi.Speed>=250 then 210 begin 211 Category:=mctGroundAttacker; 212 if mi.Attack=0 then Quality:=0 213 else 214 begin 215 Quality:=trunc(100*(ln(mi.Attack)+ln(mi.Defense)+ln(mi.Speed/150)*1.7-ln(mi.Cost))); 216 if mi.Cap and (1 shl (mcFanatic-mcFirstNonCap))<>0 then 217 inc(Quality,trunc(100*ln(1.5))); 218 if mi.Cap and (1 shl (mcLongRange-mcFirstNonCap))<>0 then 219 inc(Quality,trunc(100*ln(1.5))); 220 end 221 end 222 else 223 begin 224 Category:=mctGroundDefender; 225 Quality:=trunc(100*(ln(mi.Defense)-ln(mi.Cost)*0.6)); 226 if mi.Cap and (1 shl (mcFanatic-mcFirstNonCap))<>0 then 227 inc(Quality,trunc(100*ln(1.5))); 228 end; 229 dSea: 230 if mi.Attack=0 then 231 begin 232 Category:=mctTransport; 233 if mi.TTrans=0 then Quality:=0 234 else 235 begin 236 EffectiveTransport:=mi.TTrans; 237 if EffectiveTransport>4 then EffectiveTransport:=4; // rarely used more 238 Quality:=100+trunc(100*(ln(EffectiveTransport)+ln(mi.Speed/150)+ln(mi.Defense)-ln(mi.Cost))); 239 if mi.Cap and (1 shl (mcNav-mcFirstNonCap))<>0 then 240 inc(Quality,trunc(100*ln(1.5))); 241 if mi.Cap and (1 shl (mcAirDef-mcFirstNonCap))<>0 then 242 inc(Quality,trunc(100*ln(1.3))); 243 end 244 end 245 else 246 begin 247 Category:=mctCruiser; 248 if mi.Attack=0 then Quality:=0 249 else 250 begin 251 Quality:=trunc(100*(ln(mi.Attack)+ln(mi.Defense)*0.6-ln(mi.Cost))); 252 if mi.Cap and (1 shl (mcNav-mcFirstNonCap))<>0 then 253 inc(Quality,trunc(100*ln(1.4))); 254 if mi.Cap and (1 shl (mcAirDef-mcFirstNonCap))<>0 then 255 inc(Quality,trunc(100*ln(1.3))); 256 if mi.Cap and (1 shl (mcLongRange-mcFirstNonCap))<>0 then 257 inc(Quality,trunc(100*ln(2.0))); 258 if mi.Cap and (1 shl (mcRadar-mcFirstNonCap))<>0 then 259 inc(Quality,trunc(100*ln(1.5))); 260 end 261 end; 262 dAir: 263 begin 264 Category:=mctNone; 265 Quality:=0 266 end; 267 end; 268 //!!!assert(Quality>0); 269 end; 270 271 procedure TAI.RateMyModel(mix: integer; var Category, Quality: integer); 272 var 273 mi: TModelInfo; 274 begin 275 MakeModelInfo(me,mix,MyModel[mix],mi); 276 RateModel(mi,Category,Quality); 277 end; 278 279 function TAI.IsBetterModel(const mi: TModelInfo): boolean; 280 var 281 mix,Cat,Quality,Cat1,Quality1: integer; 282 begin 283 RateModel(mi,Cat,Quality); 284 for mix:=0 to RO.nModel-1 do if mi.Domain=MyModel[mix].Domain then 285 begin 286 RateMyModel(mix,Cat1,Quality1); 287 if (Cat=Cat1) and (Quality<Quality1+BetterQuality[Cat])then 288 begin result:=false; exit end 289 end; 290 result:=true; 291 end; 292 293 function TAI.ChooseResearchAdvance: integer; 294 var 295 adNext,iad,i,ad,Count,EarliestNeeded,EarliestNeeded_NoLeaveOut, 296 NewResearch,StateOfArt,mix: integer; 297 mi: TModelInfo; 298 Entry: array[0..nAdv-1] of boolean; 299 ok: boolean; 300 301 function MarkEntry(ad: integer): boolean; 302 begin 303 if RO.Tech[ad]>=tsApplicable then 304 result:=false // nothing more to research here 305 else if RO.Tech[ad]=tsSeen then 306 begin 307 Entry[ad]:=true; 308 result:=true 65 309 end 66 else if IsResearched(adMonarchy) then 67 begin 68 if RO.Government <> gMonarchy then 69 Revolution 70 end; 71 72 // do combat 73 for uix := 0 to RO.nUn - 1 do 74 if (MyUnit[uix].Loc >= 0) and not(MyModel[MyUnit[uix].mix].Kind 75 in [mkSettler, mkSlaves]) then 76 ProcessUnit(uix, Roam); 77 78 ProcessSettlers; 79 80 // do discover/patrol 81 82 OptimizeCityTiles; 83 SetCityProduction; 310 else 311 begin 312 Entry[ad]:=true; 313 if ad=adScience then 314 begin 315 if MarkEntry(adTheology) then Entry[ad]:=false; 316 if MarkEntry(adPhilosophy) then Entry[ad]:=false; 317 end 318 else if ad=adMassProduction then 319 begin 320 if MarkEntry(adAutomobile) then Entry[ad]:=false; 321 if Data.BehaviorFlags and bGender=bMale then 322 begin if MarkEntry(adElectronics) then Entry[ad]:=false; end 323 else begin if MarkEntry(adTheCorporation) then Entry[ad]:=false; end 324 end 325 else 326 begin 327 if AdvPreq[ad,0]>=0 then 328 if MarkEntry(AdvPreq[ad,0]) then Entry[ad]:=false; 329 if AdvPreq[ad,1]>=0 then 330 if MarkEntry(AdvPreq[ad,1]) then Entry[ad]:=false; 331 end; 332 result:=true 333 end 334 end; 335 336 procedure OptimizeDevModel(OptimizeCaps: integer); 337 var 338 f,Cat,OriginalCat,Quality,BestQuality,Best: integer; 339 mi: TModelInfo; 340 begin 341 MakeModelInfo(me,0,RO.DevModel,mi); 342 RateModel(mi,OriginalCat,BestQuality); 343 repeat 344 Best:=-1; 345 for f:=0 to nFeature-1 do 346 if (1 shl f and OptimizeCaps<>0) 347 and ((Feature[f].Preq<0) or IsResearched(Feature[f].Preq)) // check prerequisite 348 and (RO.DevModel.Weight+Feature[f].Weight<=RO.DevModel.MaxWeight) 349 and not((f>=mcFirstNonCap) and (RO.DevModel.Cap[f]>0)) then 350 begin 351 if SetNewModelFeature(f,RO.DevModel.Cap[f]+1)>=rExecuted then 352 begin 353 MakeModelInfo(me,0,RO.DevModel,mi); 354 RateModel(mi,Cat,Quality); 355 assert(Cat=OriginalCat); 356 if Quality>BestQuality then 357 begin 358 Best:=f; 359 BestQuality:=Quality; 360 end; 361 SetNewModelFeature(f,RO.DevModel.Cap[f]-1) 362 end 363 end; 364 if Best>=0 then 365 SetNewModelFeature(Best,RO.DevModel.Cap[Best]+1) 366 until Best<0 367 end; 368 369 function LeaveOutsMissing(ad: integer): boolean; 370 var 371 i: integer; 372 begin 373 result:=false; 374 if RO.Tech[ad]<tsSeen then 375 if ad in LeaveOutTechs then result:=true 376 else if ad=adScience then 377 begin 378 result:=result or LeaveOutsMissing(adTheology); 379 result:=result or LeaveOutsMissing(adPhilosophy); 380 end 381 else if ad=adMassProduction then 382 result:=true 383 else for i:=0 to 1 do 384 if AdvPreq[ad,i]>=0 then 385 result:=result or LeaveOutsMissing(AdvPreq[ad,i]); 386 end; 387 388 begin 389 if Data.BehaviorFlags and bBarbarina<>0 then 390 begin 391 result:=Barbarina_ChooseResearchAdvance; 392 if result>=0 then exit 393 end; 394 395 SetAdvanceValues; 396 397 // always complete traded techs first 398 result:=-1; 399 for ad:=0 to nAdv-1 do 400 if (RO.Tech[ad]=tsSeen) 401 and ((result<0) or (AdvanceValue[ad]>AdvanceValue[result])) then 402 result:=ad; 403 if result>=0 then exit; 404 405 if Data.BehaviorFlags and bBarbarina=0 then 406 begin 407 // develop new model? 408 if IsResearched(adWarriorCode) and IsResearched(adHorsebackRiding) 409 and not ((Data.BehaviorFlags and bGender=bMale) and (RO.Tech[adIronWorking]>=tsApplicable) // wait for gunpowder 410 and (RO.Tech[adGunPowder]<tsApplicable)) then 411 begin // check new ground models 412 PrepareNewModel(dGround); 413 SetNewModelFeature(mcDefense,1); 414 SetNewModelFeature(mcOffense,2); 415 SetNewModelFeature(mcMob,2); 416 OptimizeDevModel(1 shl mcOffense+1 shl mcDefense+1 shl mcMob 417 +1 shl mcLongRange+1 shl mcFanatic); 418 MakeModelInfo(me,0,RO.DevModel,mi); 419 if IsBetterModel(mi) then 420 begin result:=adMilitary; exit end; 421 422 PrepareNewModel(dGround); 423 SetNewModelFeature(mcDefense,2); 424 SetNewModelFeature(mcOffense,1); 425 OptimizeDevModel(1 shl mcOffense+1 shl mcDefense+1 shl mcFanatic); 426 MakeModelInfo(me,0,RO.DevModel,mi); 427 if IsBetterModel(mi) then 428 begin result:=adMilitary; exit end; 429 end; 430 431 if IsResearched(adMapMaking) and IsResearched(adSeafaring) 432 and IsResearched(adNavigation) and IsResearched(adSteamEngine) then 433 begin 434 result:=adMilitary; 435 for mix:=0 to RO.nModel-1 do if MyModel[mix].Cap[mcNav]>0 then result:=-1; 436 if result=adMilitary then 437 begin 438 PrepareNewModel(dSea); 439 SetNewModelFeature(mcWeapons,0); 440 SetNewModelFeature(mcDefense,3); 441 exit 442 end 443 end; 444 445 (* 446 if IsResearched(adMapMaking) and IsResearched(adSeafaring) then 447 begin // check new naval models 448 PrepareNewModel(dSea); 449 if RO.DevModel.MTrans>1 then 450 begin // new transport? 451 SetNewModelFeature(mcDefense,2); 452 SetNewModelFeature(mcOffense,2); 453 SetNewModelFeature(mcSeaTrans,1); 454 OptimizeDevModel(1 shl mcDefense+1 shl mcSeaTrans+1 shl mcTurbines 455 +1 shl mcAirDef); 456 MakeModelInfo(me,0,RO.DevModel,mi); 457 if IsBetterModel(mi) then 458 begin result:=adMilitary; exit end; 459 end; 460 461 // new cruiser? 462 if IsResearched(adBallistics) or IsResearched(adGunPowder) then 463 begin 464 PrepareNewModel(dSea); 465 SetNewModelFeature(mcDefense,1); 466 SetNewModelFeature(mcOffense,2); 467 OptimizeDevModel(1 shl mcOffense+1 shl mcDefense 468 +1 shl mcLongRange+1 shl mcAirDef+1 shl mcRadar); 469 MakeModelInfo(me,0,RO.DevModel,mi); 470 if IsBetterModel(mi) then 471 begin result:=adMilitary; exit end; 472 end 473 end; 474 *) 475 end; 476 477 NewResearch:=-1; 478 479 // check if cooperation with other gender doesn't work -- go for old needed techs then 480 StateOfArt:=-1; 481 for ad:=0 to nAdv-1 do 482 if (RO.Tech[ad]>=tsApplicable) and (Advancedness[ad]>StateOfArt) then 483 StateOfArt:=Advancedness[ad]; 484 EarliestNeeded:=-1; 485 EarliestNeeded_NoLeaveOut:=-1; 486 for ad:=0 to nAdv-1 do 487 if (RO.Tech[ad]<tsSeen) and (AdvanceValue[ad]>=$100) 488 and ((EarliestNeeded<0) 489 or (Advancedness[ad]<Advancedness[EarliestNeeded])) then 490 begin 491 ok:=false; 492 for iad:=0 to nResearchOrder-1 do 493 if ResearchOrder[Data.BehaviorFlags and bGender,iad]=ad then 494 begin ok:=true; break; end; 495 if not ok then 496 begin 497 EarliestNeeded:=ad; 498 if not LeaveOutsMissing(ad) then 499 EarliestNeeded_NoLeaveOut:=ad; 500 end 501 end; 502 if EarliestNeeded>=0 then 503 begin 504 if (EarliestNeeded_NoLeaveOut>=0) 505 and (Advancedness[EarliestNeeded_NoLeaveOut]+ForceNeeded_NoLeaveOut<StateOfArt) then 506 begin 507 {$IFDEF DEBUG}DebugMessage(2,'No partner found, go for ' 508 +Name_Advance[EarliestNeeded_NoLeaveOut]);{$ENDIF} 509 NewResearch:=EarliestNeeded_NoLeaveOut 510 end 511 else if Advancedness[EarliestNeeded]+ForceNeeded_LeaveOut<StateOfArt then 512 begin 513 {$IFDEF DEBUG}DebugMessage(2,'No partner found, go for ' 514 +Name_Advance[EarliestNeeded]);{$ENDIF} 515 NewResearch:=EarliestNeeded 516 end 517 end; 518 519 // choose first directly researchable advance from own branch 520 adNext:=-1; 521 if NewResearch<0 then 522 for iad:=0 to nResearchOrder-1 do 523 begin 524 ad:=ResearchOrder[Data.BehaviorFlags and bGender,iad]; 525 if RO.Tech[ad]<tsApplicable then 526 begin 527 if adNext<0 then adNext:=ad; 528 if AdvPreq[ad,2]<>preNone then 529 begin // 2 of 3 required 530 count:=0; 531 for i:=0 to 2 do 532 if RO.Tech[AdvPreq[ad,i]]>=tsApplicable then inc(count); 533 if count>=2 then 534 begin result:=ad; exit end 535 end 536 else if ((AdvPreq[ad,0]=preNone) or (RO.Tech[AdvPreq[ad,0]]>=tsApplicable)) 537 and ((AdvPreq[ad,1]=preNone) or (RO.Tech[AdvPreq[ad,1]]>=tsApplicable)) then 538 begin result:=ad; exit end 539 end 540 end; 541 542 if NewResearch<0 then 543 if adNext>=0 then 544 NewResearch:=adNext // need tech from other gender 545 else if EarliestNeeded_NoLeaveOut>=0 then 546 NewResearch:=EarliestNeeded_NoLeaveOut // own branch complete, pick tech from other gender 547 else if EarliestNeeded>=0 then 548 NewResearch:=EarliestNeeded // own branch complete, pick tech from other gender 549 else 550 begin // go for future techs 551 result:=-1; 552 i:=0; 553 for ad:=nAdv-4 to nAdv-1 do 554 if (RO.Tech[ad]<MaxFutureTech) and (RO.Tech[AdvPreq[ad,0]]>=tsApplicable) then 555 begin 556 inc(i); 557 if random(i)=0 then result:=ad 558 end; 559 assert((result<0) or AdvanceResearchable(result)); 560 exit; 561 end; 562 563 assert(NewResearch>=0); 564 fillchar(Entry, sizeof(Entry), false); 565 MarkEntry(NewResearch); 566 result:=-1; 567 for ad:=0 to nAdv-1 do 568 if Entry[ad] 569 and ((result<0) or (Advancedness[ad]>Advancedness[result])) then 570 result:=ad; 571 assert(result>=0); 572 end; 573 574 function TAI.ChooseStealAdvance: integer; 575 var 576 ad: integer; 577 begin 578 result:=-1; 579 for ad:=0 to nAdv-1 do 580 if AdvanceStealable(ad) 581 and ((result<0) or (Advancedness[ad]>Advancedness[result])) then 582 result:=ad 583 end; 584 585 586 //------------------------------- 587 // TERRAFORMING 588 //------------------------------- 589 590 const 591 twpAllowFarmland=$0001; 592 593 procedure TAI.TileWorkPlan(Loc, cix: integer; 594 var Value, NextJob, TotalWork: integer); 595 var 596 OldTile,TerrType: Cardinal; 597 TileInfo: TTileInfo; 598 begin 599 TotalWork:=0; 600 NextJob:=jNone; 601 if Map[Loc] and (fRare1 or fRare2)<>0 then 602 begin Value:=3*8-1; exit end; // better than any tile with 2 food 603 604 OldTile:=Map[Loc]; 605 TerrType:=Map[Loc] and fTerrain; 606 if (TerrType>=fGrass) then 607 begin 608 if Map[Loc] and fPoll<>0 then 609 begin // clean pollution 610 if NextJob=jNone then NextJob:=jPoll; 611 inc(TotalWork,PollWork); 612 Map[Loc]:=Map[Loc] and not fPoll; 613 end; 614 if Map[Loc] and (fTerrain or fSpecial)=fSwamp then 615 begin // drain swamp 616 if NextJob=jNone then NextJob:=jClear; 617 inc(TotalWork,Terrain[TerrType].IrrClearWork); 618 Map[Loc]:=Map[Loc] and not fTerrain or fGrass; 619 TerrType:=fGrass; 620 Map[Loc]:=Map[Loc] or 621 Cardinal(SpecialTile(Loc,TerrType,G.lx) shl 5); 622 end 623 else if IsResearched(adExplosives) 624 and (Map[Loc] and (fTerrain or fSpecial) in [fTundra,fHills]) 625 and (Map[Loc] and fTerImp<>tiMine) 626 and (SpecialTile(Loc,fHills,G.lx)=0) then 627 begin // transform 628 if NextJob=jNone then NextJob:=jTrans; 629 inc(TotalWork,Terrain[TerrType].TransWork); 630 Map[Loc]:=Map[Loc] and not fTerrain or fGrass; 631 TerrType:=fGrass; 632 Map[Loc]:=Map[Loc] or 633 Cardinal(SpecialTile(Loc,TerrType,G.lx) shl 5); 634 end; 635 if (Terrain[TerrType].MineEff>0) and (RO.Government<>gDespotism) then 636 begin 637 if Map[Loc] and fTerImp<>tiMine then 638 begin // add mine 639 if NextJob=jNone then NextJob:=jMine; 640 inc(TotalWork,Terrain[TerrType].MineAfforestWork); 641 Map[Loc]:=Map[Loc] and not fTerImp or tiMine; 642 end 643 end 644 else if Terrain[TerrType].IrrEff>0 then 645 begin 646 if Map[Loc] and fTerImp=tiIrrigation then 647 begin // add farmland 648 if (MyCity[cix].Built[imSupermarket]>0) and IsResearched(adRefrigeration) 649 and (RO.Government<>gDespotism) then 650 begin 651 if NextJob=jNone then NextJob:=jFarm; 652 inc(TotalWork,Terrain[TerrType].IrrClearWork*FarmWork); 653 Map[Loc]:=Map[Loc] and not fTerImp or tiFarm; 654 end 655 end 656 else if Map[Loc] and fTerImp<>tiFarm then 657 begin // add irrigation 658 if (RO.Government<>gDespotism) 659 or (Map[Loc] and (fTerrain or fSpecial)<>fGrass) then 660 begin 661 if NextJob=jNone then NextJob:=jIrr; 662 inc(TotalWork,Terrain[TerrType].IrrClearWork); 663 Map[Loc]:=Map[Loc] and not fTerImp or tiIrrigation; 664 end 665 end 666 end; 667 if (Terrain[TerrType].MoveCost=1) 668 and (Map[Loc] and (fRoad or fRR)=0) 669 and ((Map[Loc] and fRiver=0) or IsResearched(adBridgeBuilding)) then 670 begin // add road 671 if NextJob=jNone then NextJob:=jRoad; 672 inc(TotalWork,RoadWork); 673 Map[Loc]:=Map[Loc] or fRoad; 674 end; 675 if ((Map[Loc] and fTerImp=tiMine) 676 or (Terrain[TerrType].ProdRes[Map[Loc] shr 5 and 3]>=2)) 677 and IsResearched(adRailroad) 678 and (Map[Loc] and fRR=0) 679 and ((Map[Loc] and fRiver=0) or IsResearched(adBridgeBuilding)) 680 and (RO.Government<>gDespotism) then 681 begin // add railroad 682 if Map[Loc] and fRoad=0 then 683 begin 684 if NextJob=jNone then NextJob:=jRoad; 685 inc(TotalWork,RoadWork*Terrain[TerrType].MoveCost); 686 end; 687 if NextJob=jNone then NextJob:=jRR; 688 inc(TotalWork,RRWork*Terrain[TerrType].MoveCost); 689 Map[Loc]:=Map[Loc] and not fRoad or fRR; 690 end; 691 end; 692 Server(sGetTileInfo,me,Loc,TileInfo); 693 Value:=TileInfo.Food*8+TileInfo.Prod*2+TileInfo.Trade; 694 Map[Loc]:=OldTile; 84 695 end; 85 696 … … 87 698 procedure TAI.ProcessSettlers; 88 699 var 89 uix, cix, ecix, Loc, RadiusLoc, TestScore, BestNearCityScore, TerrType, 90 Special, V21: integer; 91 Radius: TVicinity21Loc; 92 ResourceScore, CityScore: array [0 .. lxmax * lymax - 1] of integer; 700 i,uix,cix,ecix,dtr,Loc,RadiusLoc,Special,Food,Prod,Trade,CityFood,Happy, 701 TestScore,BestNearCityScore,BestUnusedValue,BestUnusedLoc, 702 Value,NextJob,TotalWork,V21,part,Loc1: integer; 703 Tile: Cardinal; 704 FoodOk,Started: boolean; 705 Radius: TVicinity21Loc; 706 CityAreaInfo: TCityAreaInfo; 707 TileFood, ResourceScore, CityScore: array[0..lxmax*lymax-1] of integer; 708 709 procedure AddJob(Loc,Job,Score: integer); 710 // set Score=1 for low-priority jobs 711 begin 712 JobAssignment_AddJob(Loc,Job,Score); 713 if (Score>1) and (District[Loc]>=0) and (District[Loc]<maxCOD) then 714 dec(SettlerSurplus[District[Loc]]); 715 end; 93 716 94 717 procedure ReserveCityRadius(Loc: integer); 95 718 var 96 V21, RadiusLoc: integer; 97 Radius: TVicinity21Loc; 98 begin 99 V21_to_Loc(Loc, Radius); 100 for V21 := 1 to 26 do 101 begin 102 RadiusLoc := Radius[V21]; 103 if (RadiusLoc >= 0) and (RadiusLoc < MapSize) then 104 ResourceScore[RadiusLoc] := 0 719 V21,RadiusLoc: integer; 720 Radius: TVicinity21Loc; 721 begin 722 V21_to_Loc(Loc,Radius); 723 for V21:=1 to 26 do 724 begin 725 RadiusLoc:=Radius[V21]; 726 if (RadiusLoc>=0) then 727 begin 728 ResourceScore[RadiusLoc]:=0; 729 TileFood[RadiusLoc]:=0; 730 end 105 731 end 106 732 end; 107 733 108 begin 109 JobAssignment_Initialize; 110 111 // rate resources of all tiles 112 fillchar(ResourceScore, MapSize * sizeof(integer), 0); 113 for Loc := 0 to MapSize - 1 do 114 if (Map[Loc] and fRare) = 0 then 115 if (Map[Loc] and fTerrain) = fGrass then 116 if (Map[Loc] and fSpecial) <> 0 then 117 ResourceScore[Loc] := 3 // plains, 3 points 118 else 119 ResourceScore[Loc] := 2 // grassland, 2 points 120 else if (Map[Loc] and fSpecial) <> 0 then 121 ResourceScore[Loc] := 4; // special resource, 4 points 122 for cix := 0 to RO.nCity - 1 do 123 if MyCity[cix].Loc >= 0 then 124 ReserveCityRadius(MyCity[cix].Loc); // these resources already have a city 125 for uix := 0 to RO.nUn - 1 do 126 if (MyUnit[uix].Loc >= 0) and (MyUnit[uix].Job = jCity) then 127 ReserveCityRadius(MyUnit[uix].Loc); 128 // these resources almost already have a city 129 for ecix := 0 to RO.nEnemyCity - 1 do 130 if RO.EnemyCity[ecix].Loc >= 0 then 131 ReserveCityRadius(RO.EnemyCity[ecix].Loc); 132 // these resources already have an enemy city 133 134 // rate possible new cities 135 fillchar(CityScore, MapSize * sizeof(integer), 0); 136 for Loc := 0 to MapSize - 1 do 137 if ((Map[Loc] and fTerrain) = fGrass) and ((Map[Loc] and fRare) = 0) and 138 ((RO.Territory[Loc] < 0) or (RO.Territory[Loc] = me)) then 139 // don't consider founding cities in foreign nation territory 140 begin 141 TestScore := 0; 142 BestNearCityScore := 0; 143 V21_to_Loc(Loc, Radius); 144 for V21 := 1 to 26 do 145 begin // sum resource scores in potential city radius 146 RadiusLoc := Radius[V21]; 147 if (RadiusLoc >= 0) and (RadiusLoc < MapSize) then 148 begin 149 TestScore := TestScore + ResourceScore[RadiusLoc]; 150 if CityScore[RadiusLoc] > BestNearCityScore then 151 BestNearCityScore := CityScore[RadiusLoc] 152 end 153 end; 154 if TestScore >= 10 then // city is worth founding 155 begin 156 TestScore := TestScore shl 8 + ((Loc xor me) * 4567) mod 251; 157 // some unexactness, random but always the same for this tile 158 if TestScore > BestNearCityScore then 159 begin // better than all other sites in radius 160 if BestNearCityScore > 0 then // found no other cities in radius 734 procedure ScoreRoadConnections; 735 var 736 V8,nFragments,Loc,Loc1,History,RoadScore,a,b,FullyDeveloped,ConnectMask: integer; 737 BridgeOk: boolean; 738 Adjacent: TVicinity8Loc; 739 begin 740 BridgeOk:= IsResearched(adBridgeBuilding); 741 if IsResearched(adRailroad) then FullyDeveloped:=fRR or fCity 742 else FullyDeveloped:=fRoad or fRR or fCity; 743 for Loc:=G.lx to G.lx*(G.ly-1)-1 do 744 if ((1 shl (Map[Loc] and fTerrain)) and (1 shl fOcean or 1 shl fShore or 1 shl fDesert or 1 shl fArctic or 1 shl fUNKNOWN)=0) 745 and (RO.Territory[Loc]=me) 746 and (Map[Loc] and FullyDeveloped=0) 747 and (BridgeOk or (Map[Loc] and fRiver=0)) then 748 begin 749 nFragments:=0; 750 History:=0; 751 if Map[Loc] and fRoad<>0 then ConnectMask:=fRR or fCity // check for railroad 752 else ConnectMask:=fRoad or fRR or fCity; // check for road 753 V8_to_Loc(Loc,Adjacent); 754 for V8:=0 to 9 do 755 begin 756 Loc1:=Adjacent[V8 and 7]; 757 History:=History shl 1; 758 if (Loc1>=0) and (RO.Territory[Loc1]=me) 759 and (Map[Loc1] and ConnectMask<>0) then 161 760 begin 162 for V21 := 1 to 26 do 761 inc(History); 762 if V8>=2 then 163 763 begin 164 RadiusLoc := Radius[V21]; 165 if (RadiusLoc >= 0) and (RadiusLoc < MapSize) then 166 CityScore[RadiusLoc] := 0; 764 inc(nFragments); 765 case V8 and 1 of 766 0: 767 if History and 6<>0 then 768 dec(nFragments); 769 1: 770 if History and 2<>0 then 771 dec(nFragments) 772 else if History and 4<>0 then 773 begin 774 V8_to_ab((V8-1) and 7,a,b); 775 ab_to_Loc(Loc,a shl 1,b shl 1,Loc1); 776 if (Loc1>=0) 777 and (Map[Loc1] and ConnectMask<>0) then 778 dec(nFragments) 779 end 780 end 167 781 end; 168 782 end; 169 CityScore[Loc] := TestScore170 783 end; 171 end 172 end; 173 for Loc := 0 to MapSize - 1 do 174 if CityScore[Loc] > 0 then 175 JobAssignment_AddJob(Loc, jCity, 10); 176 177 // improve terrain 178 for cix := 0 to RO.nCity - 1 do 179 with MyCity[cix] do 180 if Loc >= 0 then 181 begin 182 V21_to_Loc(Loc, Radius); 183 for V21 := 1 to 26 do 184 if (Tiles and (1 shl V21) and not(1 shl CityOwnTile)) <> 0 then 185 begin // tile is exploited, but not the city own tile -- check if improvable 186 RadiusLoc := Radius[V21]; 187 assert((RadiusLoc >= 0) and (RadiusLoc < MapSize)); 188 if (RadiusLoc >= 0) and (RadiusLoc < MapSize) then 784 if nFragments>=2 then // road or railroad connection desirable 785 begin 786 if Map[Loc] and fRiver<>0 then RoadScore:=44+(nFragments-2)*4 787 else RoadScore:=56-Terrain[Map[Loc] and fTerrain].MoveCost*4 788 +(nFragments-2)*4; 789 if Map[Loc] and fRoad<>0 then 790 AddJob(Loc, jRR, RoadScore) 791 else AddJob(Loc, jRoad, RoadScore) 792 end; 793 end; 794 end; 795 796 begin 797 fillchar(SettlerSurplus, sizeof(SettlerSurplus), 0); 798 JobAssignment_Initialize; 799 800 if (Data.BehaviorFlags and bBarbarina=0) or (RO.nCity<3) then 801 begin 802 fillchar(TileFood,sizeof(TileFood),0); 803 fillchar(ResourceScore,sizeof(ResourceScore),0); 804 for Loc:=0 to MapSize-1 do 805 if Map[Loc] and fTerrain<>fUNKNOWN then 806 if Map[Loc] and fDeadLands<>0 then 807 begin 808 if not IsResearched(adMassProduction) or (Map[Loc] and fModern<>0) then 809 ResourceScore[Loc]:=20; 810 end 811 else if Map[Loc] and fTerrain=fGrass then 812 TileFood[Loc]:=Terrain[fGrass].FoodRes[Map[Loc] shr 5 and 3]-1 813 else 814 begin 815 Special:=SpecialTile(Loc,Map[Loc] and fTerrain,G.lx); 816 if Special<>0 then with Terrain[Map[Loc] and fTerrain] do 817 begin 818 Food:=FoodRes[Special]; 819 if MineEff=0 then inc(Food,IrrEff); 820 Prod:=ProdRes[Special]+MineEff; 821 Trade:=TradeRes[Special]; 822 if MoveCost=1 then inc(Trade); 823 ResourceScore[Loc]:=Food+2*Prod+Trade-7; 824 if Food>2 then TileFood[Loc]:=Food-2; 825 end 826 end; 827 828 for cix:=0 to RO.nCity-1 do 829 if MyCity[cix].Loc>=0 then 830 ReserveCityRadius(MyCity[cix].Loc); // these resources already have a city 831 for uix:=0 to RO.nUn-1 do 832 if (MyUnit[uix].Loc>=0) and (MyUnit[uix].Job=jCity) then 833 ReserveCityRadius(MyUnit[uix].Loc); // these resources almost already have a city 834 for ecix:=0 to RO.nEnemyCity-1 do 835 if RO.EnemyCity[ecix].Loc>=0 then 836 ReserveCityRadius(RO.EnemyCity[ecix].Loc); // these resources already have an enemy city 837 838 // rate possible new cities 839 fillchar(CityScore, MapSize*sizeof(integer), 0); 840 for Loc:=0 to MapSize-1 do 841 begin 842 FoodOk:= (TileFood[Loc]>0) 843 and ((Map[Loc] and fTerrain=fGrass) 844 and ((RO.Government<>gDespotism) or (Map[Loc] and fSpecial=fSpecial1)) 845 or (Map[Loc] and (fTerrain or fSpecial)=fPrairie or fSpecial1)); 846 if FoodOk and ((RO.Territory[Loc]<0) or (RO.Territory[Loc]=me)) then 847 begin 848 TestScore:=0; 849 CityFood:=0; 850 BestNearCityScore:=0; 851 V21_to_Loc(Loc,Radius); 852 for V21:=1 to 26 do 853 begin // sum resource scores in potential city radius 854 RadiusLoc:=Radius[V21]; 855 if (RadiusLoc>=0) then 856 begin 857 inc(CityFood,TileFood[RadiusLoc]); 858 if ResourceScore[RadiusLoc]>0 then 859 inc(TestScore,ResourceScore[RadiusLoc]); 860 if CityScore[RadiusLoc]>BestNearCityScore then 861 BestNearCityScore:=CityScore[RadiusLoc] 862 end 863 end; 864 if CityFood>=MinCityFood then // city is worth founding 865 begin 866 TestScore:=(72+2*TestScore) shl 8 + ((loc xor me)*4567) mod 251; 867 // some unexactness, random but always the same for this tile 868 if TestScore>BestNearCityScore then 869 begin // better than all other sites in radius 870 if BestNearCityScore>0 then // found no other cities in radius 189 871 begin 190 TerrType := Map[RadiusLoc] and fTerrain; 191 Special := Map[RadiusLoc] shr 5 and 3; 192 if TerrType >= fGrass then // can't improve water tiles 193 if (Terrain[TerrType].IrrEff > 0) // terrain is irrigatable 194 and not((RO.Government = gDespotism) and 195 (Terrain[TerrType].FoodRes[Special] >= 3)) 196 // improvement makes no sense when limit is depotism 197 and ((Map[RadiusLoc] and fTerImp) = 0) then 198 // no terrain improvement yet 199 JobAssignment_AddJob(RadiusLoc, jIrr, 50) // irrigate! 200 else if (Terrain[TerrType].MoveCost = 1) // plain terrain 201 and ((Map[RadiusLoc] and (fRoad or fRR or fRiver)) = 0) then 202 // no road or railroad yet, no river 203 JobAssignment_AddJob(RadiusLoc, jRoad, 40); 204 // build road (The Wheel trade benefit) 872 for V21:=1 to 26 do 873 begin 874 RadiusLoc:=Radius[V21]; 875 if (RadiusLoc>=0) then 876 CityScore[RadiusLoc]:=0; 877 end; 878 end; 879 CityScore[Loc]:=TestScore 880 end; 881 end 882 end; 883 end; 884 for Loc:=0 to MapSize-1 do 885 if CityScore[Loc]>0 then 886 AddJob(Loc, jCity, CityScore[Loc] shr 8); 887 end; 888 889 // improve terrain 890 for cix:=0 to RO.nCity-1 do with MyCity[cix] do if Loc>=0 then 891 begin // order terrain improvements 892 BestUnusedValue:=0; 893 City_GetAreaInfo(cix,CityAreaInfo); 894 V21_to_Loc(Loc,Radius); 895 for V21:=1 to 26 do if V21<>CityOwnTile then 896 if 1 shl V21 and Tiles<>0 then 897 begin // tile is being exploited! 898 RadiusLoc:=Radius[V21]; 899 if not (Map[RadiusLoc] and fTerrain in [fDesert,fArctic]) then 900 begin 901 assert(RadiusLoc>=0); 902 TileWorkPlan(RadiusLoc,cix,Value,NextJob,TotalWork); 903 if (NextJob=jRoad) 904 and (Built[imPalace]+Built[imCourt]+Built[imTownHall]=0) then 905 AddJob(RadiusLoc, NextJob, 44) 906 else if NextJob<>jNone then 907 AddJob(RadiusLoc, NextJob, 84) 908 end 909 end 910 else if CityAreaInfo.Available[V21]=faAvailable then 911 begin // tile could be exploited 912 RadiusLoc:=Radius[V21]; 913 assert(RadiusLoc>=0); 914 if not (Map[RadiusLoc] and fTerrain in [fDesert,fArctic]) then 915 begin 916 TileWorkPlan(RadiusLoc,cix,Value,NextJob,TotalWork); 917 Value:=Value shl 16 +$FFFF-TotalWork; 918 if Value>BestUnusedValue then 919 begin 920 BestUnusedValue:=Value; 921 BestUnusedLoc:=RadiusLoc; 922 end 923 end 924 end; 925 if BestUnusedValue>0 then 926 begin 927 TileWorkPlan(BestUnusedLoc,cix,Value,NextJob,TotalWork); 928 if NextJob<>jNone then 929 AddJob(BestUnusedLoc, NextJob, 44) 930 end 931 end; 932 933 ScoreRoadConnections; 934 935 if Data.BehaviorFlags and bBarbarina=0 then // low priority jobs 936 for Loc:=0 to MapSize-1 do if RO.Territory[Loc]=me then 937 begin 938 Tile:=Map[Loc]; 939 if Tile and fPoll<>0 then 940 AddJob(Loc, jPoll, 1) 941 else case Tile and (fTerrain or fSpecial or fCity) of 942 fGrass, fGrass+fSpecial1: 943 if IsResearched(adExplosives) and (SpecialTile(Loc,fHills,G.lx)>0) then 944 AddJob(Loc, jTrans, 1); 945 fSwamp: 946 if SpecialTile(Loc,fSwamp,G.lx)=0 then 947 AddJob(Loc, jClear, 1); 948 fTundra,fHills: 949 if IsResearched(adExplosives) and (Tile and fTerImp<>tiMine) 950 and (SpecialTile(Loc,fHills,G.lx)=0) then 951 AddJob(Loc, jTrans, 1); 952 end 953 end; 954 955 // cities for colony ship production 956 if Data.BehaviorFlags and bBarbarina=bBarbarina then 957 begin 958 for part:=0 to nShipPart-1 do 959 for i:=0 to ColonyShipPlan[part].nLocFoundCity-1 do 960 begin 961 Loc:=ColonyShipPlan[part].LocFoundCity[i]; 962 Started:=false; 963 for uix:=0 to RO.nUn-1 do 964 if (MyUnit[uix].Loc=Loc) and (MyUnit[uix].Job=jCity) then 965 begin 966 Started:=true; 967 break 968 end; 969 if not Started then 970 begin 971 Tile:=RO.Map[Loc]; 972 if (Tile and fTerrain=fForest) or (Tile and fTerrain=fSwamp) then 973 AddJob(Loc,jClear,235) 974 else if Tile and fTerrain=fHills then 975 begin 976 if IsResearched(adExplosives) then 977 AddJob(Loc,jTrans,235) 978 end 979 else AddJob(Loc,jCity,235); 980 end; 981 V21_to_Loc(Loc, Radius); 982 for V21:=1 to 26 do 983 begin 984 Loc1:=Radius[V21]; 985 if (Loc1>=0) and (RO.Map[Loc1] and (fTerrain or fSpecial)=fSwamp) then 986 AddJob(Loc1,jClear,255); 987 end 988 end 989 end; 990 991 // choose all settlers to work 992 for uix:=0 to RO.nUn-1 do with MyUnit[uix] do 993 if (Loc>=0) and ((mix=mixSettlers) or (mix=mixSlaves) 994 or (Data.BehaviorFlags and bBarbarina<>0) and (MyModel[mix].Kind=mkSettler)) then 995 begin 996 JobAssignment_AddUnit(uix); 997 if (District[Loc]>=0) and (District[Loc]<maxCOD) then 998 inc(SettlerSurplus[District[Loc]]); 999 end; 1000 1001 JobAssignment_Go; 1002 1003 for uix:=0 to RO.nUn-1 do with MyUnit[uix] do 1004 if (Loc>=0) and (Map[Loc] and fCity=0) and (Job=jNone) 1005 and ((mix=mixSettlers) or (mix=mixSlaves)) 1006 and not JobAssignment_GotJob(uix) then 1007 Unit_MoveEx(uix, maNextCity); 1008 1009 //{$IFDEF DEBUG}DebugMessage(2, Format('Settler surplus in district 0: %d',[SettlerSurplus[0]]));{$ENDIF} 1010 1011 // add settlers to city 1012 for uix:=0 to RO.nUn-1 do with MyUnit[uix] do 1013 if (Loc>=0) and (Map[Loc] and fCity<>0) 1014 and (MyModel[MyUnit[uix].mix].Kind=mkSettler) then 1015 begin 1016 dtr:=District[Loc]; 1017 if (mix<>mixSettlers) 1018 or (dtr>=0) and (dtr<maxCOD) 1019 and (SettlerSurplus[dtr]>DistrictPopulation[dtr] div 8) then 1020 begin 1021 City_FindMyCity(Loc, cix); 1022 with MyCity[cix] do 1023 if (Built[imSewer]>0) 1024 or (Built[imAqueduct]>0) and (Size<=NeedSewerSize-2) 1025 or (Size<=NeedAqueductSize-2) then 1026 begin // settlers could be added to this city 1027 Happy:=BasicHappy; 1028 for i:=0 to 27 do if Built[i]>0 then inc(Happy); 1029 if Built[imTemple]>0 then inc(Happy); 1030 if Built[imCathedral]>0 then 1031 begin 1032 inc(Happy,2); 1033 if RO.Wonder[woBach].EffectiveOwner=me then inc(Happy,1) 1034 end; 1035 if Built[imTheater]>0 then inc(Happy,2); 1036 if (Built[imColosseum]>0) or (Happy shl 1>=Size+2) then 1037 begin // bigger city would be happy 1038 // {$IFDEF DEBUG}DebugMessage(2, Format('Adding settlers to city at %d',[Loc]));{$ENDIF} 1039 Unit_AddToCity(uix); 1040 if (dtr>=0) and (dtr<maxCOD) then dec(SettlerSurplus[dtr]) 205 1041 end 206 1042 end; 207 end; 208 209 // choose all settlers to work 210 for uix := 0 to RO.nUn - 1 do 211 if (MyUnit[uix].Loc >= 0) and 212 (MyModel[MyUnit[uix].mix].Kind in [mkSettler, mkSlaves]) then 213 JobAssignment_AddUnit(uix); 214 215 JobAssignment_Go; 1043 end 1044 end; 216 1045 end; // ProcessSettlers 217 1046 218 // ProcessUnit: execute attack, capture, discover or patrol task according to unit role 219 procedure TAI.ProcessUnit(uix: integer; Role: UnitRole); 1047 1048 //------------------------------- 1049 // MY TURN 1050 //------------------------------- 1051 1052 procedure TAI.DoTurn; 1053 var 1054 emix,i,p1,TaxSum,ScienceSum,NewTaxRate: integer; 1055 AllHateMe: boolean; 1056 {$IFDEF PERF}PF,t0,t1,t2,t3,t4,t5,t6,t7,t8,t9: int64;{$ENDIF} 1057 begin 1058 {$IFDEF DEBUG}fillchar(DebugMap, sizeof(DebugMap),0);{$ENDIF} 1059 1060 {$IFDEF PERF}QueryPerformanceFrequency(PF);{$ENDIF} 1061 {$IFDEF PERF}QueryPerformanceCounter(t0);{$ENDIF} 1062 1063 WarNations:=PresenceUnknown; 1064 for p1:=0 to nPl-1 do 1065 if (p1<>me) and (1 shl p1 and RO.Alive<>0) and (RO.Treaty[p1]<trPeace) then 1066 inc(WarNations,1 shl p1); 1067 BombardingNations:=0; 1068 for emix:=0 to RO.nEnemyModel-1 do with RO.EnemyModel[emix] do 1069 if (Domain=dSea) and (1 shl (mcLongRange-mcFirstNonCap) and Cap<>0) then 1070 BombardingNations:=BombardingNations or (1 shl Owner); 1071 BombardingNations:=BombardingNations and WarNations; 1072 1073 AnalyzeMap; 1074 //for i:=0 to MapSize-1 do DebugMap[i]:=Formation[i]; 1075 1076 if (Data.BehaviorFlags and bBarbarina=0) 1077 and (RO.Tech[ResearchOrder[Data.BehaviorFlags and bGender,8]]<tsApplicable) then 1078 CheckGender; 1079 1080 if G.Difficulty[me]<MaxDiff then // not on beginner level 1081 begin 1082 if (Data.LastResearchTech=adHorsebackRiding) 1083 and (RO.ResearchTech<0) and (random(6)=0) 1084 and (HavePort or (ContinentPresence[0] and not (1 shl me or PresenceUnknown)<>0)) then 1085 begin 1086 Data.BehaviorFlags:=Data.BehaviorFlags or bBarbarina_Hide; 1087 DebugMessage(1, 'Early Barbarina!'); 1088 end; 1089 if Data.BehaviorFlags and bBarbarina=0 then 1090 begin 1091 AllHateMe:=false; 1092 for p1:=0 to nPl-1 do 1093 if (1 shl p1 and RO.Alive<>0) and (RO.Treaty[p1]>=trNone) then 1094 if (RO.Treaty[p1]<trPeace) and 1095 ((Data.RejectTurn[suContact,p1]>=0) 1096 or (Data.RejectTurn[suPeace,p1]>=0)) then 1097 AllHateMe:=true 1098 else begin AllHateMe:=false; break end; 1099 if AllHateMe then 1100 begin 1101 Data.BehaviorFlags:=Data.BehaviorFlags or bBarbarina_Hide; 1102 DebugMessage(1, 'All hate me!'); 1103 end 1104 end; 1105 1106 if Data.BehaviorFlags and bBarbarina=0 then 1107 if Barbarina_GoHidden then 1108 begin 1109 Data.BehaviorFlags:=Data.BehaviorFlags or bBarbarina_Hide; 1110 DebugMessage(1, 'Barbarina!'); 1111 end; 1112 if Data.BehaviorFlags and bBarbarina=bBarbarina_Hide then 1113 if Barbarina_Go then 1114 begin 1115 Data.BehaviorFlags:=Data.BehaviorFlags or bBarbarina; 1116 DebugMessage(1, 'Barbarina - no mercy!'); 1117 end; 1118 end; 1119 1120 {$IFDEF PERF}QueryPerformanceCounter(t1);{$ENDIF} 1121 1122 // better government form available? 1123 if (Data.BehaviorFlags and bBarbarina=0) and (RO.Turn>=LeaveDespotism) 1124 and (RO.Government<>gAnarchy) then 1125 if IsResearched(adDemocracy) then 1126 begin 1127 if RO.Government<>gDemocracy then 1128 Revolution //!!! 1129 end 1130 else if IsResearched(adTheRepublic) then 1131 begin 1132 if RO.Government<>gRepublic then 1133 Revolution 1134 end 1135 else if IsResearched(adMonarchy) then 1136 begin 1137 if RO.Government<>gMonarchy then 1138 Revolution 1139 end; 1140 1141 CollectModelCatStat; 1142 1143 if Data.BehaviorFlags and bBarbarina=bBarbarina then 1144 begin 1145 MakeColonyShipPlan; 1146 Barbarina_DoTurn 1147 end 1148 else 1149 begin 1150 {$IFDEF PERF}QueryPerformanceCounter(t2);{$ENDIF} 1151 1152 {$IFDEF PERF}QueryPerformanceCounter(t3);{$ENDIF} 1153 1154 AttackAndPatrol; 1155 1156 {$IFDEF PERF}QueryPerformanceCounter(t4);{$ENDIF} 1157 1158 MoveUnitsHome; 1159 1160 {$IFDEF PERF}QueryPerformanceCounter(t5);{$ENDIF} 1161 end; 1162 1163 ProcessSettlers; 1164 1165 {$IFDEF PERF}QueryPerformanceCounter(t6);{$ENDIF} 1166 1167 if Data.BehaviorFlags and bBarbarina<>0 then 1168 Barbarina_SetCityProduction 1169 else 1170 SetCityProduction; 1171 1172 {$IFDEF PERF}QueryPerformanceCounter(t7);{$ENDIF} 1173 1174 // correct tax rate if necessary 1175 if not IsResearched(adWheel) then 1176 ChangeRates(0,0) 1177 else 1178 begin 1179 if (RO.TaxRate=0) or (RO.Money<(TotalPopulation[me]-4)*2) then 1180 NewTaxRate:=RO.TaxRate // don't check decreasing tax 1181 else NewTaxRate:=RO.TaxRate-10; 1182 while NewTaxRate<100 do 1183 begin 1184 SumCities(NewTaxRate,TaxSum,ScienceSum); 1185 if RO.Money+TaxSum>=(TotalPopulation[me]-4) then break; // enough 1186 inc(NewTaxRate,10); 1187 end; 1188 if NewTaxRate<>RO.TaxRate then 1189 begin 1190 // {$IFDEF DEBUG}DebugMessage(3,Format('New tax rate: %d',[NewTaxRate]));{$ENDIF} 1191 ChangeRates(NewTaxRate,0) 1192 end; 1193 end; 1194 1195 // clean up RequestedTechs 1196 if (Data.LastResearchTech>=0) 1197 and (Data.LastResearchTech<>RO.ResearchTech) then // research completed 1198 for p1:=0 to nPl-1 do 1199 if (p1<>me) and (1 shl p1 and RO.Alive<>0) 1200 and (RO.EnemyReport[p1].TurnOfCivilReport+TechReportOutdated>RO.Turn) 1201 and (RO.EnemyReport[p1].Tech[Data.LastResearchTech]<tsSeen) then 1202 begin // latest researched advance might be of interest to this nation 1203 for i:=0 to nRequestedTechs-1 do 1204 if (Data.RequestedTechs[i]>=0) 1205 and (Data.RequestedTechs[i] shr 8 and $F=p1) then 1206 Data.RequestedTechs[i]:=-1; 1207 end; 1208 if RO.ResearchTech=adMilitary then Data.LastResearchTech:=-1 1209 else Data.LastResearchTech:=RO.ResearchTech; 1210 for i:=0 to nRequestedTechs-1 do 1211 if (Data.RequestedTechs[i]>=0) 1212 and (RO.Tech[Data.RequestedTechs[i] and $FF]>=tsSeen) then 1213 Data.RequestedTechs[i]:=-1; 1214 1215 // prepare negotiation 1216 AdvanceValuesSet:=false; 1217 SetAdvanceValues; 1218 1219 1220 {$IFDEF DEBUG} 1221 (*for p1:=0 to nPl-1 do 1222 if (p1<>me) and (1 shl p1 and RO.Alive<>0) and (RO.Treaty[p1]>=trPeace) 1223 and (RO.EnemyReport[p1].TurnOfCivilReport>=0) then 1224 TraceAdvanceValues(p1);*) 1225 {$ENDIF} 1226 1227 {$IFDEF PERF}DebugMessage(2,Format('t1=%d t2=%d t3=%d t4=%d t5=%d t6=%d t7=%d t8=%d t9=%d (ns)',[(t1-t0)*1000000 div PF,(t2-t1)*1000000 div PF,(t3-t2)*1000000 div PF,(t4-t3)*1000000 div PF,(t5-t4)*1000000 div PF,(t6-t5)*1000000 div PF,(t7-t6)*1000000 div PF,(t8-t7)*1000000 div PF,(t9-t8)*1000000 div PF]));{$ENDIF} 1228 end; 1229 1230 {$IFDEF DEBUG} 1231 procedure TAI.TraceAdvanceValues(Nation: integer); 1232 var 1233 ad: integer; 1234 begin 1235 for ad:=0 to nAdv-1 do 1236 if (RO.Tech[ad]<tsSeen) and (RO.EnemyReport[Nation].Tech[ad]>=tsApplicable) 1237 and (AdvanceValue[ad]>0) then 1238 begin 1239 DebugMessage(2,Format('%s (%d): +%x', 1240 [Name_Advance[ad], Advancedness[ad], AdvanceValue[ad]])) 1241 end 1242 end; 1243 {$ENDIF} 1244 1245 1246 procedure TAI.CheckGender; 1247 var 1248 p1,NewGender: integer; 1249 begin 1250 NewGender:=-1; 1251 for p1:=0 to nPl-1 do 1252 if (p1<>me) and (1 shl p1 and RO.Alive<>0) 1253 and (RO.Treaty[p1]>=trFriendlyContact) then 1254 if PlayerHash[me]>PlayerHash[p1] then 1255 begin 1256 if NewGender=bMale then 1257 begin NewGender:=-2; break end; // ambiguous, don't change gender 1258 NewGender:=bFemale; 1259 end 1260 else 1261 begin 1262 if NewGender=bFemale then 1263 begin NewGender:=-2; break end; // ambiguous, don't change gender 1264 NewGender:=bMale; 1265 end; 1266 if (NewGender>=0) and (NewGender<>Data.BehaviorFlags and bGender) then 1267 begin 1268 Data.BehaviorFlags:=Data.BehaviorFlags and not bGender or NewGender; 1269 DebugMessage(1, 'Gender:='+char(48+NewGender)); 1270 end 1271 end; 1272 1273 1274 procedure TAI.SetAdvanceValues; 1275 1276 procedure RateResearchAdv(ad, Time: integer); 1277 var 1278 Value: integer; 1279 begin 1280 if Time=0 then Value:=TechValue_ForResearch_Next 1281 else Value:=TechValue_ForResearch-Time; 1282 if AdvanceValue[ad]<Value then 1283 AdvanceValue[ad]:=Value; 1284 end; 1285 1286 procedure SetPreqValues(ad, Value: integer); 1287 begin 1288 if (RO.Tech[ad]<tsSeen) and (ad<>RO.ResearchTech) then 1289 begin 1290 if AdvanceValue[ad]<Value then 1291 AdvanceValue[ad]:=Value; 1292 if ad=adScience then 1293 begin 1294 SetPreqValues(adTheology,Value-1); 1295 SetPreqValues(adPhilosophy,Value-1); 1296 end 1297 else if ad=adMassProduction then 1298 // preqs should be researched now 1299 else 1300 begin 1301 if AdvPreq[ad,0]>=0 then 1302 SetPreqValues(AdvPreq[ad,0],Value-1); 1303 if AdvPreq[ad,1]>=0 then 1304 SetPreqValues(AdvPreq[ad,1],Value-1); 1305 end; 1306 end 1307 end; 1308 1309 procedure RateImpPreq(iix, Value: integer); 1310 begin 1311 if (Value>0) and (Imp[iix].Preq>=0) then 1312 inc(AdvanceValue[Imp[iix].Preq],Value); 1313 end; 1314 1315 var 1316 emix,cix,adMissing,iad,ad,count,i,Time,d,CurrentCost,CurrentStrength, 1317 MaxSize, MaxTrade: integer; 1318 PreView,Emergency,Bombarded: boolean; 1319 begin 1320 if AdvanceValuesSet then exit; 1321 AdvanceValuesSet:=true; 1322 1323 fillchar(AdvanceValue,sizeof(AdvanceValue),0); 1324 1325 // rate techs to ensure research progress 1326 Time:=0; 1327 for ad:=0 to nAdv-1 do if RO.Tech[ad]=tsSeen then inc(Time); 1328 adMissing:=-1; 1329 Emergency:=true; 1330 for iad:=0 to nResearchOrder-1 do 1331 begin 1332 ad:=ResearchOrder[Data.BehaviorFlags and bGender,iad]; 1333 if (ad<>RO.ResearchTech) and (RO.Tech[ad]<tsSeen) then 1334 begin 1335 if adMissing<0 then adMissing:=ad; 1336 RateResearchAdv(ad,Time); // unseen tech of own gender 1337 if AdvPreq[ad,2]<>preNone then 1338 begin // 2 of 3 required 1339 count:=0; 1340 for i:=0 to 2 do 1341 if (AdvPreq[ad,i]=RO.ResearchTech) 1342 or (RO.Tech[AdvPreq[ad,i]]>=tsSeen) then 1343 inc(count); 1344 if count>=2 then Emergency:=false 1345 else 1346 begin 1347 if ad<>adMassProduction then // don't score third preq for MP 1348 begin 1349 for i:=0 to 2 do 1350 if (AdvPreq[ad,i]<>RO.ResearchTech) 1351 and (RO.Tech[AdvPreq[ad,i]]<tsSeen) then 1352 RateResearchAdv(AdvPreq[ad,i],Time); 1353 end; 1354 inc(Time,2-count) 1355 end 1356 end 1357 else 1358 begin 1359 count:=0; 1360 for i:=0 to 1 do 1361 if (AdvPreq[ad,i]<>preNone) and (AdvPreq[ad,i]<>RO.ResearchTech) 1362 and (RO.Tech[AdvPreq[ad,i]]<tsSeen) then 1363 begin 1364 RateResearchAdv(AdvPreq[ad,i],Time); 1365 inc(count) 1366 end; 1367 if count=0 then Emergency:=false; 1368 inc(Time,count); 1369 end; 1370 inc(Time,2); 1371 end 1372 end; 1373 if Emergency and (adMissing>=0) then 1374 begin 1375 {$IFDEF DEBUG}DebugMessage(2, 'Research emergency: Go for' 1376 +Name_Advance[adMissing]+' now!');{$ENDIF} 1377 SetPreqValues(adMissing, TechValue_ForResearch_Urgent); 1378 end; 1379 for iad:=0 to nResearchOrder-1 do 1380 begin 1381 ad:=ResearchOrder[Data.BehaviorFlags and bGender xor 1,iad]; 1382 if ad=adScience then 1383 inc(AdvanceValue[ad], 5*TechValue_ForResearch_LeaveOut) 1384 else if LeaveOutValue[ad]>0 then 1385 if AdvanceValue[ad]>0 then 1386 inc(AdvanceValue[ad], LeaveOutValue[ad]*TechValue_ForResearch_LeaveOut) 1387 // else AdvanceValue[ad]:=1; 1388 end; 1389 1390 // rate military techs 1391 for d:=0 to nDomains-1 do 1392 begin 1393 CurrentCost:=0; 1394 CurrentStrength:=0; 1395 for PreView:=true downto false do 1396 for i:=0 to nUpgrade-1 do with Upgrade[d,i] do 1397 if (Preq>=0) and not (Preq in FutureTech) then 1398 if ((Ro.ResearchTech=Preq) or (RO.Tech[Preq]>=tsSeen)) = PreView then 1399 if PreView then 1400 begin 1401 if Cost>CurrentCost then CurrentCost:=Cost; 1402 inc(CurrentStrength, Strength); 1403 end 1404 else 1405 begin // rate 1406 if (i>0) and (Trans>0) then inc(AdvanceValue[Preq],$400); 1407 if Cost<=CurrentCost then 1408 inc(AdvanceValue[Preq], (4-d)*Strength*$400 div (CurrentStrength+Upgrade[d,0].Strength)) 1409 else inc(AdvanceValue[Preq], (4-d)*Strength*$200 div (CurrentStrength+Upgrade[d,0].Strength)) 1410 end; 1411 end; 1412 // speed 1413 inc(AdvanceValue[adSteamEngine],$400); 1414 inc(AdvanceValue[adNuclearPower],$400); 1415 inc(AdvanceValue[adRocketry],$400); 1416 // features 1417 inc(AdvanceValue[adBallistics],$800); 1418 inc(AdvanceValue[adCommunism],$800); 1419 // weight 1420 inc(AdvanceValue[adAutomobile],$800); 1421 inc(AdvanceValue[adSteel],$800); 1422 inc(AdvanceValue[adAdvancedFlight],$400); 1423 1424 // civil non-improvement 1425 if RO.Turn>=LeaveDespotism then 1426 begin 1427 inc(AdvanceValue[adDemocracy],$80*RO.nCity); 1428 inc(AdvanceValue[adTheRepublic],$800); 1429 end; 1430 inc(AdvanceValue[adRailroad],$800); 1431 // inc(AdvanceValue[adExplosives],$800); // no, has enough 1432 inc(AdvanceValue[adBridgeBuilding],$200); 1433 inc(AdvanceValue[adSpaceFlight],$200); 1434 inc(AdvanceValue[adSelfContainedEnvironment],$200); 1435 inc(AdvanceValue[adImpulseDrive],$200); 1436 inc(AdvanceValue[adTransstellarColonization],$200); 1437 1438 // city improvements 1439 MaxSize:=0; 1440 for cix:=0 to RO.nCity-1 do 1441 if MyCity[cix].Size>MaxSize then 1442 MaxSize:=MyCity[cix].Size; 1443 if RO.Government in [gRepublic,gDemocracy,gLybertarianism] then 1444 MaxTrade:=(MaxSize-1)*3 1445 else MaxTrade:=(MaxSize-1)*2; 1446 1447 RateImpPreq(imCourt,(RO.nCity-1)*$100); 1448 RateImpPreq(imLibrary,(MaxTrade-10)*$180); 1449 RateImpPreq(imMarket,(MaxTrade-10)*$140); 1450 RateImpPreq(imUniversity,(MaxTrade-10)*$140); 1451 RateImpPreq(imBank,(MaxTrade-10)*$100); 1452 RateImpPreq(imObservatory,(MaxTrade-10)*$100); 1453 RateImpPreq(imResLab,(MaxTrade-14)*$140); 1454 RateImpPreq(imStockEx,(MaxTrade-10)*$10*(RO.nCity-1)); 1455 RateImpPreq(imHighways,(MaxSize-5)*$200); 1456 RateImpPreq(imFactory,(MaxSize-8)*$200); 1457 RateImpPreq(imMfgPlant,(MaxSize-8)*$1C0); 1458 RateImpPreq(imRecycling,(MaxSize-8)*$180); 1459 RateImpPreq(imHarbor,(MaxSize-7)*$200); 1460 RateImpPreq(imSuperMarket,$300); 1461 if RO.Turn>=40 then RateImpPreq(imTemple,$400); 1462 if RO.Government<>gDespotism then 1463 begin 1464 RateImpPreq(imCathedral,$400); 1465 RateImpPreq(imTheater,$400); 1466 end; 1467 if MaxSize>=NeedAqueductSize-1 then 1468 begin 1469 RateImpPreq(imAqueduct,$600); 1470 RateImpPreq(imGrWall,$300); 1471 end; 1472 if cixStateImp[imPalace]>=0 then 1473 with MyCity[cixStateImp[imPalace]] do 1474 if (Built[imColosseum]+Built[imObservatory]>0) and (Size>=NeedSewerSize-1) then 1475 RateImpPreq(imSewer,$400); 1476 Bombarded:=false; 1477 for emix:=0 to RO.nEnemyModel-1 do 1478 if 1 shl (mcLongRange-mcFirstNonCap) and RO.EnemyModel[emix].Cap<>0 then 1479 Bombarded:=true; 1480 if Bombarded then 1481 RateImpPreq(imCoastalFort,$400); 1482 end; 1483 1484 procedure TAI.AnalyzeMap; 1485 var 1486 cix,Loc,Loc1,V8,f1,p1: integer; 1487 Adjacent: TVicinity8Loc; 1488 begin 1489 inherited AnalyzeMap; 1490 1491 // collect nation presence information for continents and oceans 1492 fillchar(ContinentPresence, sizeof(ContinentPresence), 0); 1493 fillchar(OceanPresence, sizeof(OceanPresence), 0); 1494 for Loc:=0 to MapSize-1 do 1495 begin 1496 f1:=Formation[Loc]; 1497 case f1 of 1498 0..maxCOD-1: 1499 begin 1500 p1:=RO.Territory[Loc]; 1501 if p1>=0 then 1502 if Map[Loc] and fTerrain>=fGrass then 1503 ContinentPresence[f1]:=ContinentPresence[f1] or (1 shl p1) 1504 else OceanPresence[f1]:=OceanPresence[f1] or (1 shl p1); 1505 end; 1506 nfUndiscovered: 1507 begin // adjacent formations are not completely discovered 1508 V8_to_Loc(Loc,Adjacent); 1509 for V8:=0 to 7 do 1510 begin 1511 Loc1:=Adjacent[V8]; 1512 if Loc1>=0 then 1513 begin 1514 f1:=Formation[Loc1]; 1515 if (f1>=0) and (f1<maxCOD) then 1516 if Map[Loc1] and fTerrain>=fGrass then 1517 ContinentPresence[f1]:=ContinentPresence[f1] or PresenceUnknown 1518 else OceanPresence[f1]:=OceanPresence[f1] or PresenceUnknown 1519 end 1520 end 1521 end; 1522 nfPeace: 1523 begin // nation present in adjacent formations 1524 V8_to_Loc(Loc,Adjacent); 1525 for V8:=0 to 7 do 1526 begin 1527 Loc1:=Adjacent[V8]; 1528 if Loc1>=0 then 1529 begin 1530 f1:=Formation[Loc1]; 1531 if (f1>=0) and (f1<maxCOD) then 1532 if Map[Loc1] and fTerrain>=fGrass then 1533 ContinentPresence[f1]:=ContinentPresence[f1] 1534 or (1 shl RO.Territory[Loc]) 1535 else OceanPresence[f1]:=OceanPresence[f1] 1536 or (1 shl RO.Territory[Loc]) 1537 end 1538 end 1539 end; 1540 end; 1541 end; 1542 1543 fillchar(TotalPopulation, sizeof(TotalPopulation), 0); 1544 fillchar(ContinentPopulation, sizeof(ContinentPopulation), 0); 1545 fillchar(DistrictPopulation, 4*nDistrict, 0); 1546 1547 // count population 1548 for cix:=0 to RO.nEnemyCity-1 do with RO.EnemyCity[cix] do if Loc>=0 then 1549 begin 1550 inc(TotalPopulation[Owner],Size); 1551 if (Formation[Loc]>=0) and (Formation[Loc]<maxCOD) then 1552 inc(ContinentPopulation[Owner,Formation[Loc]],Size); 1553 end; 1554 for cix:=0 to RO.nCity-1 do with RO.City[cix] do if Loc>=0 then 1555 begin 1556 inc(TotalPopulation[me],Size); 1557 assert(District[Loc]>=0); 1558 if District[Loc]<maxCOD then 1559 inc(DistrictPopulation[District[Loc]],Size); 1560 end; 1561 end; 1562 1563 procedure TAI.CollectModelCatStat; 1564 var 1565 i,uix,Cat,mix,Quality: integer; 1566 begin 1567 // categorize models 1568 for Cat:=0 to nModelCat-1 do 1569 ModelBestQuality[Cat]:=0; 1570 mixCaravan:=-1; 1571 mixSlaves:=-1; 1572 mixCruiser:=-1; 1573 for mix:=0 to RO.nModel-1 do 1574 begin 1575 ModelCat[mix]:=mctNone; 1576 if mix=1 then mixMilitia:=mix 1577 else 1578 case MyModel[mix].Kind of 1579 $00..$0F: // common units 1580 if MyModel[mix].Cap[mcNav]>0 then mixCruiser:=mix // temporary!!! 1581 else 1582 begin 1583 RateMyModel(mix,Cat,Quality); 1584 ModelCat[mix]:=Cat; 1585 ModelQuality[mix]:=Quality; 1586 if (Cat>=0) and (Quality>ModelBestQuality[Cat]) then 1587 ModelBestQuality[Cat]:=Quality; 1588 end; 1589 mkSpecial_TownGuard: mixTownGuard:=mix; 1590 mkSettler: mixSettlers:=mix; // engineers always have higher mix 1591 mkCaravan: mixCaravan:=mix; 1592 mkSlaves: mixSlaves:=mix 1593 end 1594 end; 1595 1596 // mark obsolete models with quality=0 1597 for mix:=0 to RO.nModel-1 do 1598 if (MyModel[mix].Kind<$10) and (ModelCat[mix]>=0) 1599 and (ModelQuality[mix]+MaxExistWorseThanBestModel 1600 < ModelBestQuality[ModelCat[mix]]) then 1601 ModelQuality[mix]:=ModelQuality[mix]-$40000000; 1602 1603 OceanWithShip:=0; 1604 if mixCruiser>=0 then 1605 for uix:=0 to RO.nUn-1 do with MyUnit[uix] do 1606 if (Loc>=0) and (mix=mixCruiser) and (Map[Loc] and fTerrain<fGrass) then 1607 begin 1608 i:=Formation[Loc]; 1609 if (i>=0) and (i<maxCOD) then OceanWithShip:=OceanWithShip or (1 shl i) 1610 end; 1611 end; 1612 1613 1614 procedure TAI.MoveUnitsHome; 220 1615 const 221 DistanceScore = 4; 1616 PatrolDestination=lxmax*lymax; 1617 FirstSurplusLoop: array[mctGroundDefender..mctGroundAttacker] of integer= (2,1); 222 1618 var 223 BestScore, BestCount, BestLoc, TerrType, TestLoc, NextLoc, TestDistance, Tile, 224 V8, TestScore, euix, MyDamage, EnemyDamage, TerrOwner, StepSize, OldLoc, 225 AttackForecast, MoveResult, AttackResult: integer; 226 Exhausted: boolean; 227 TestTask, BestTask: (utNone, utAttack, utCapture, utDiscover, utPatrol, 228 utGoHome); 1619 Cat,i,mix,cix,uix,Loop,nModelOrder: integer; 1620 Adjacent: TVicinity8Loc; 1621 LocNeed: array[0..lxmax*lymax-1] of shortint; 1622 Destination: array[0..nUmax-1] of integer; 1623 DistrictNeed,DistrictNeed0: array[0..maxCOD-1] of integer; 1624 ModelOrder: array[0..nMmax-1] of integer; 1625 complete,Fortified: boolean; 1626 1627 function IsBombarded(cix: integer): boolean; 1628 var 1629 Loc1,V8: integer; 229 1630 Adjacent: TVicinity8Loc; 230 AdjacentUnknown: array [0 .. lxmax * lymax - 1] of integer; 231 232 begin 1631 begin 1632 result:=false; 1633 if BombardingNations<>0 then with MyCity[cix] do 1634 begin 1635 V8_to_Loc(Loc,Adjacent); 1636 for V8:=0 to 7 do 1637 begin 1638 Loc1:=Adjacent[V8]; 1639 if (Loc1>=0) and (Map[Loc1] and fTerrain<fGrass) 1640 and (Formation[Loc1]>=0) and (Formation[Loc1]<maxCOD) 1641 and (OceanPresence[Formation[Loc1]] and (BombardingNations or PresenceUnknown)<>0) then 1642 begin result:=true; exit end 1643 end; 1644 end; 1645 end; 1646 1647 procedure TryUtilize(uix: integer); 1648 var 1649 cix, ProdCost, UtilizeCost: integer; 1650 begin 1651 if (MyUnit[uix].Health=100) 1652 and (Map[MyUnit[uix].Loc] and (fCity or fOwned)=fCity or fOwned) then 1653 begin 1654 City_FindMyCity(MyUnit[uix].Loc,cix); 1655 with MyCity[cix] do if Project and cpImp=0 then 1656 begin 1657 ProdCost:=MyModel[Project and cpIndex].Cost; 1658 UtilizeCost:=MyModel[MyUnit[uix].mix].Cost; 1659 if Prod<(ProdCost-UtilizeCost*2 div 3)*BuildCostMod[G.Difficulty[me]] div 12 then 1660 Unit_Disband(uix); 1661 end 1662 end 1663 end; 1664 1665 procedure FindDestination(uix: integer); 1666 var 1667 MoveStyle,V8,Loc1,Time,NextLoc,NextTime,RecoverTurns: integer; 1668 Reached: array[0..lxmax*lymax-1] of boolean; 1669 begin 1670 fillchar(Reached, MapSize, false); 233 1671 Pile.Create(MapSize); 234 1672 with MyUnit[uix] do 235 repeat 236 BestScore := -999999; 237 BestTask := utNone; 238 fillchar(AdjacentUnknown, sizeof(AdjacentUnknown), $FF); 239 // -1, indicates tiles not checked yet 240 Pile.Empty; 241 Pile.Put(Loc, 0); // start search for something to do at current location 242 while Pile.Get(TestLoc, TestDistance) do 243 begin 244 TestScore := 0; 245 Tile := Map[TestLoc]; 246 AdjacentUnknown[TestLoc] := 0; 247 248 if ((Tile and fUnit) <> 0) and ((Tile and fOwned) = 0) then 1673 begin 1674 Pile.Put(Loc, $800-Movement); 1675 MoveStyle:=GetMyMoveStyle(mix, 100); 1676 end; 1677 while Pile.Get(Loc1, Time) do 1678 begin 1679 if LocNeed[Loc1]>0 then 1680 begin 1681 LocNeed[Loc1]:=0; 1682 if (District[Loc1]>=0) and (District[Loc1]<maxCOD) then 1683 begin 1684 assert(DistrictNeed[District[Loc1]]>0); 1685 dec(DistrictNeed[District[Loc1]]); 1686 end; 1687 Destination[uix]:=Loc1; 1688 break; 1689 end; 1690 Reached[Loc1]:=true; 1691 V8_to_Loc(Loc1, Adjacent); 1692 for V8:=0 to 7 do 1693 begin 1694 NextLoc:=Adjacent[V8]; 1695 if (NextLoc>=0) and not Reached[NextLoc] and (RO.Territory[NextLoc]=me) then 1696 case CheckStep(MoveStyle, Time, V8 and 1, NextTime, RecoverTurns, Map[Loc1], Map[NextLoc], false) of 1697 csOk: 1698 Pile.Put(NextLoc, NextTime); 1699 csForbiddenTile: 1700 Reached[NextLoc]:=true; // don't check moving there again 1701 csCheckTerritory: 1702 assert(false); 1703 end 1704 end; 1705 end; 1706 Pile.Free; 1707 end; 1708 1709 begin 1710 if not (RO.Government in [gAnarchy, gDespotism]) then // utilize townguards 1711 for uix:=0 to RO.nUn-1 do with MyUnit[uix] do 1712 if (Loc>=0) and (Master<0) and (mix=mixTownGuard) then 1713 Unit_Disband(uix); 1714 1715 fillchar(UnitLack,sizeof(UnitLack),0); 1716 fillchar(Destination, 4*RO.nUn, $FF); 1717 for i:=0 to maxCOD-1 do 1718 if uixPatrol[i]>=0 then 1719 Destination[uixPatrol[i]]:=PatrolDestination; 1720 for uix:=0 to RO.nUn-1 do 1721 if (MyUnit[uix].mix=mixMilitia) or (MyUnit[uix].mix=mixCruiser) then 1722 Destination[uix]:=PatrolDestination; 1723 1724 // distribute attackers and defenders 1725 for Cat:=mctGroundDefender to mctGroundAttacker do 1726 begin 1727 nModelOrder:=0; 1728 for mix:=0 to Ro.nModel-1 do 1729 if ModelCat[mix]=Cat then 1730 begin 1731 i:=nModelOrder; 1732 while (i>0) and (ModelQuality[mix]<ModelQuality[ModelOrder[i-1]]) do 1733 begin ModelOrder[i]:=ModelOrder[i-1]; dec(i) end; 1734 ModelOrder[i]:=mix; 1735 inc(nModelOrder); 1736 end; 1737 1738 Loop:=0; 1739 repeat 1740 if Loop=FirstSurplusLoop[Cat] then 1741 for uix:=0 to RO.nUn-1 do with MyUnit[uix] do 1742 if (Loc>=0) and (Destination[uix]<0) and (Master<0) 1743 and (ModelCat[mix]=Cat) 1744 and (ModelQuality[mix]<0) then 1745 TryUtilize(uix); 1746 1747 fillchar(LocNeed, MapSize, 0); 1748 fillchar(DistrictNeed, sizeof(DistrictNeed), 0); 1749 1750 for cix:=0 to RO.nCity-1 do with MyCity[cix] do if Loc>=0 then 1751 if ((Cat<>mctGroundDefender) or (Loop<>0) or IsBombarded(cix)) 1752 and ((Loop<>FirstSurplusLoop[Cat]) or (Built[imBarracks]+Built[imMilAcademy]>0)) 1753 and ((Loop<>FirstSurplusLoop[Cat]+1) or (Built[imBarracks]+Built[imMilAcademy]=0)) then 1754 begin 1755 LocNeed[Loc]:=1; 1756 if (District[Loc]>=0) and (District[Loc]<maxCOD) then 1757 begin 1758 inc(DistrictNeed[District[Loc]]); 1759 if Loop<FirstSurplusLoop[Cat] then 1760 inc(UnitLack[District[Loc],Cat]) 1761 end 1762 end; 1763 1764 if Loop=0 then // protect city building sites 1765 for uix:=0 to RO.nUn-1 do with MyUnit[uix] do 1766 if (Loc>=0) and (Job=jCity) and (RO.Territory[Loc]=me) then 1767 begin 1768 LocNeed[Loc]:=1; 1769 if (District[Loc]>=0) and (District[Loc]<maxCOD) then 1770 inc(DistrictNeed[District[Loc]]); 1771 end; 1772 1773 complete:= Loop>=FirstSurplusLoop[Cat]; 1774 for i:=nModelOrder-1 downto 0 do 1775 begin 1776 for Fortified:=true downto false do 1777 for uix:=0 to RO.nUn-1 do with MyUnit[uix] do 1778 if (mix=ModelOrder[i]) 1779 and (Loc>=0) and (Destination[uix]<0) and (Master<0) 1780 and ((Flags and unFortified<>0) = Fortified) 1781 and (LocNeed[Loc]>0) then 1782 begin 1783 LocNeed[Loc]:=0; 1784 if (District[Loc]>=0) and (District[Loc]<maxCOD) then 1785 dec(DistrictNeed[District[Loc]]); 1786 Destination[uix]:=Loc; 1787 complete:=false; 1788 end; 1789 1790 for uix:=0 to RO.nUn-1 do with MyUnit[uix] do 1791 if (mix=ModelOrder[i]) 1792 and (Loc>=0) and (Destination[uix]<0) and (Master<0) then 1793 if (District[Loc]>=0) and (District[Loc]<maxCOD) 1794 and (DistrictNeed[District[Loc]]=0) then 1795 else 1796 begin // unassigned unit 1797 FindDestination(uix); 1798 if Destination[uix]>=0 then complete:=false; 1799 end; 1800 end; 1801 inc(Loop) 1802 until complete; 1803 end; 1804 1805 // distribute obsolete settlers 1806 repeat 1807 fillchar(LocNeed, MapSize, 0); 1808 fillchar(DistrictNeed, sizeof(DistrictNeed), 0); 1809 1810 for cix:=0 to RO.nCity-1 do with MyCity[cix] do if Loc>=0 then 1811 if (Built[imSewer]>0) 1812 or (Built[imAqueduct]>0) and (Size<=NeedSewerSize-2) 1813 or (Size<=NeedAqueductSize-2) 1814 or (Project=mixSettlers) then 1815 begin 1816 LocNeed[Loc]:=1; 1817 if (District[Loc]>=0) and (District[Loc]<maxCOD) then 1818 inc(DistrictNeed[District[Loc]]); 1819 end; 1820 DistrictNeed0:=DistrictNeed; 1821 1822 complete:=true; 1823 for uix:=0 to RO.nUn-1 do with MyUnit[uix] do 1824 if (Loc>=0) and (Destination[uix]<0) and (Master<0) then 1825 if (MyModel[mix].Kind=mkSettler) and (mix<>mixSettlers) 1826 and (Job=jNone) then 1827 if (District[Loc]>=0) and (District[Loc]<maxCOD) 1828 and (DistrictNeed[District[Loc]]=0) then 1829 begin 1830 if DistrictNeed0[District[Loc]]>0 then 1831 complete:=false 1832 end 1833 else 1834 begin // unassigned unit 1835 FindDestination(uix); 1836 // if (Destination[uix]<0) and (RO.Territory[Loc]=me) then 1837 // complete:=false; // causes hangup when unit can't move due to zoc 1838 end; 1839 until complete; 1840 1841 for uix:=0 to RO.nUn-1 do with MyUnit[uix] do if Loc>=0 then 1842 if Destination[uix]<0 then 1843 begin 1844 if (MyModel[mix].Kind<>mkSettler) and (MyModel[mix].Kind<>mkSlaves) 1845 and (Master<0) and (Map[Loc] and fCity=0) then 1846 Unit_MoveEx(uix, maNextCity); 1847 end 1848 else if (Destination[uix]<>PatrolDestination) and (Loc<>Destination[uix]) then 1849 Unit_MoveEx(uix, Destination[uix]); 1850 1851 for uix:=0 to RO.nUn-1 do with MyUnit[uix] do 1852 if (Loc>=0) and (RO.Territory[Loc]=me) 1853 and (District[Loc]>=0) and (District[Loc]<maxCOD) 1854 and (ModelQuality[mix]>0) then 1855 case ModelCat[mix] of 1856 mctGroundDefender,mctGroundAttacker: 1857 dec(UnitLack[District[Loc],ModelCat[mix]]) 1858 end; 1859 end; // MoveUnitsHome 1860 1861 1862 procedure TAI.CheckAttack(uix: integer); 1863 var 1864 AttackScore,BestCount,AttackLoc,TestLoc,NextLoc,TestTime,V8, 1865 TestScore,euix,MyDamage,EnemyDamage,OldLoc, 1866 AttackForecast,MoveResult,AttackResult,MoveStyle,NextTime,RecoverTurns: integer; 1867 Tile: Cardinal; 1868 Exhausted: boolean; 1869 Adjacent: TVicinity8Loc; 1870 Reached: array[0..lxmax*lymax-1] of boolean; 1871 1872 begin 1873 with MyUnit[uix] do 1874 begin 1875 MoveStyle:=GetMyMoveStyle(mix,Health); 1876 repeat 1877 AttackScore:=-999999; 1878 AttackLoc:=-1; 1879 fillchar(Reached, MapSize, false); 1880 Pile.Create(MapSize); 1881 Pile.Put(Loc, $800-Movement); // start search for something to do at current location 1882 while Pile.Get(TestLoc,TestTime) do 1883 begin 1884 TestScore:=0; 1885 Tile:=Map[TestLoc]; 1886 Reached[TestLoc]:=true; 1887 1888 if ((Tile and fUnit)<>0) and ((Tile and fOwned)=0) then 249 1889 begin // enemy unit 250 Unit_FindEnemyDefender(TestLoc, euix);251 if RO.Treaty[RO.EnemyUn[euix].Owner] < trPeace then252 begin // unfriendly unit -- check attack253 if Unit_AttackForecast(uix, TestLoc, 100,AttackForecast) then1890 assert(TestTime<$1000); 1891 Unit_FindEnemyDefender(TestLoc,euix); 1892 if RO.Treaty[RO.EnemyUn[euix].Owner]<trPeace then 1893 if Unit_AttackForecast(uix,TestLoc,$800-TestTime,AttackForecast) then 254 1894 begin // attack possible, but advantageous? 255 if AttackForecast >0 then1895 if AttackForecast=0 then 256 1896 begin // enemy unit would be destroyed 257 MyDamage := Health - AttackForecast;258 EnemyDamage := RO.EnemyUn[euix].Health +DestroyBonus;1897 MyDamage:=Health+DestroyBonus; 1898 EnemyDamage:=RO.EnemyUn[euix].Health+DestroyBonus; 259 1899 end 260 else // own unit would be destroyed 1900 else if AttackForecast>0 then 1901 begin // enemy unit would be destroyed 1902 MyDamage:=Health-AttackForecast; 1903 EnemyDamage:=RO.EnemyUn[euix].Health+DestroyBonus; 1904 end 1905 else // own unit would be destroyed 261 1906 begin 262 MyDamage := Health +DestroyBonus;263 EnemyDamage := RO.EnemyUn[euix].Health +AttackForecast;1907 MyDamage:=Health+DestroyBonus; 1908 EnemyDamage:=RO.EnemyUn[euix].Health+AttackForecast; 264 1909 end; 265 TestScore := Aggressive * 2 * 266 (EnemyDamage * RO.EnemyModel[RO.EnemyUn[euix].emix].Cost) 267 div (MyDamage * MyModel[mix].Cost); 268 if TestScore <= 100 then 269 TestScore := 0 // own losses exceed enemy losses, no good 270 else 1910 TestScore:=Aggressive*2 1911 *(EnemyDamage*RO.EnemyModel[RO.EnemyUn[euix].emix].Cost) 1912 div (MyDamage*MyModel[mix].Cost); 1913 if TestScore<=100 then TestScore:=0 // own losses exceed enemy losses, no good 1914 else 271 1915 begin 272 TestScore := (TestScore - 100) div 10 + 30; 273 TestTask := utAttack 1916 if TestScore>AttackScore then 1917 BestCount:=0; 1918 if TestScore>=AttackScore then 1919 begin 1920 inc(BestCount); 1921 if random(BestCount)=0 then 1922 begin 1923 AttackScore:=TestScore; 1924 AttackLoc:=TestLoc; 1925 end 1926 end; 274 1927 end 275 end 276 end 1928 end; 277 1929 end // enemy unit 278 1930 279 else if ((Tile and fCity) <> 0) and ((Tile and fOwned) = 0) then 280 begin // enemy city, empty or unobserved 281 if (MyModel[mix].Domain = dGround) 282 // ships of this AI have no long-range guns, so don't try to attack cities with them 283 and ((RO.Territory[TestLoc] < 0) 284 // happens only for unobserved cities of extinct tribes, new owner unknown 285 or (RO.Treaty[RO.Territory[TestLoc]] < trPeace)) then 286 begin // unfriendly city -- check attack/capture 287 if (Tile and fObserved) <> 0 then 288 begin // observed and no unit present -- city is undefended, capture! 289 TestScore := 40; 290 TestTask := utCapture 291 end 292 else if Role = Roam then 293 begin // unobserved city, possibly defended -- go for attack 294 TestScore := 30; 295 TestTask := utPatrol 296 end 297 end 298 end // enemy city, empty or unobserved 299 1931 else if ((Tile and fCity)<>0) and ((Tile and fOwned)=0) then 1932 // enemy city 1933 1934 else 1935 begin // no enemy city or unit here 1936 V8_to_Loc(TestLoc,Adjacent); 1937 for V8:=0 to 7 do 1938 begin 1939 NextLoc:=Adjacent[V8]; 1940 if (NextLoc>=0) and not Reached[NextLoc] 1941 and (Map[NextLoc] and fTerrain<>fUNKNOWN) then 1942 if Map[NextLoc] and (fUnit or fOwned)=fUnit then 1943 Pile.Put(NextLoc, TestTime) // foreign unit! 1944 else case CheckStep(MoveStyle, TestTime, V8 and 1, NextTime, 1945 RecoverTurns, Map[Loc], Map[NextLoc], true) of 1946 csOk,csCheckTerritory: 1947 if NextTime<$1000 then Pile.Put(NextLoc, NextTime); 1948 csForbiddenTile: 1949 Reached[NextLoc]:=true; // don't check moving there again 1950 end 1951 end; 1952 end; // no enemy city or unit here 1953 end; // while Pile.Get 1954 Pile.Free; 1955 1956 if AttackLoc>=0 then 1957 begin 1958 OldLoc:=Loc; 1959 MoveResult:=Unit_Move(uix,AttackLoc); 1960 Exhausted:= (Loc=OldLoc) 1961 or ((MoveResult and (rMoreTurns or rUnitRemoved))<>0); 1962 if MoveResult and rLocationReached<>0 then 1963 if Movement<100 then 1964 Exhausted:=true 300 1965 else 1966 begin 1967 AttackResult:=Unit_Attack(uix,AttackLoc); 1968 Exhausted:= ((AttackResult and rExecuted)=0) 1969 or ((AttackResult and rUnitRemoved)<>0); 1970 end; 1971 end 1972 else Exhausted:=true; 1973 until Exhausted; 1974 end; 1975 end; // CheckAttack 1976 1977 1978 procedure TAI.Patrol(uix: integer); 1979 const 1980 DistanceScore=4; 1981 var 1982 PatrolScore,BestCount,PatrolLoc,TestLoc,NextLoc,TestTime,V8, 1983 TestScore,OldLoc,MoveResult,MoveStyle,NextTime,RecoverTurns: integer; 1984 Tile: Cardinal; 1985 Exhausted,CaptureOnly: boolean; 1986 Adjacent: TVicinity8Loc; 1987 AdjacentUnknown: array[0..lxmax*lymax-1] of shortint; 1988 1989 begin 1990 with MyUnit[uix] do 1991 begin 1992 CaptureOnly:= ((100-Health)*Terrain[Map[Loc] and fTerrain].Defense>60) 1993 and not (Map[Loc] and fTerrain in [fOcean, fShore, fArctic, fDesert]); 1994 MoveStyle:=GetMyMoveStyle(mix, Health); 1995 repeat 1996 PatrolScore:=-999999; 1997 PatrolLoc:=-1; 1998 FillChar(AdjacentUnknown,MapSize,$FF); // -1, indicates tiles not checked yet 1999 Pile.Create(MapSize); 2000 Pile.Put(Loc, $800-Movement); 2001 while Pile.Get(TestLoc,TestTime) do 2002 begin 2003 if (50*$1000-DistanceScore*TestTime<=PatrolScore) // assume a score of 50 is the best achievable 2004 or CaptureOnly and (TestTime>=$1000) then 2005 break; 2006 2007 TestScore:=0; 2008 Tile:=Map[TestLoc]; 2009 AdjacentUnknown[TestLoc]:=0; 2010 2011 if ((Tile and fUnit)<>0) and ((Tile and fOwned)=0) then 2012 // enemy unit 2013 2014 else if ((Tile and fCity)<>0) and ((Tile and fOwned)=0) then 2015 begin 2016 if ((Tile and fObserved)<>0) 2017 and (MyModel[mix].Domain=dGround) and (MyModel[mix].Attack>0) 2018 and ((RO.Territory[TestLoc]<0) // happens only for unobserved cities of extinct tribes, new owner unknown 2019 or (RO.Treaty[RO.Territory[TestLoc]]<trPeace)) then 2020 TestScore:=40 // unfriendly undefended city -- capture! 2021 end 2022 2023 else 301 2024 begin // no enemy city or unit here 302 // add surrounding tiles to queue, but only if there's a chance to beat BestScore 303 if 50 - DistanceScore * (TestDistance + 1) >= BestScore then 304 // assume a score of 50 is the best achievable 2025 V8_to_Loc(TestLoc,Adjacent); 2026 for V8:=0 to 7 do 305 2027 begin 306 V8_to_Loc(TestLoc, Adjacent); 307 for V8 := 0 to 7 do 2028 NextLoc:=Adjacent[V8]; 2029 if (NextLoc>=0) and (AdjacentUnknown[NextLoc]<0) then 2030 if Map[NextLoc] and fTerrain=fUNKNOWN then 2031 inc(AdjacentUnknown[TestLoc]) 2032 else if Formation[NextLoc]=Formation[TestLoc] then 2033 case CheckStep(MoveStyle, TestTime, V8 and 1, NextTime, RecoverTurns, Map[TestLoc], Map[NextLoc], true) of 2034 csOk: 2035 Pile.Put(NextLoc, NextTime); 2036 csForbiddenTile: 2037 AdjacentUnknown[NextLoc]:=0; // don't check moving there again 2038 csCheckTerritory: 2039 if RO.Territory[NextLoc]=RO.Territory[TestLoc] then 2040 Pile.Put(NextLoc, NextTime); 2041 end 2042 end; 2043 if not CaptureOnly then 2044 if AdjacentUnknown[TestLoc]>0 then 2045 TestScore:=20+AdjacentUnknown[TestLoc] 2046 else TestScore:=(RO.Turn-RO.MapObservedLast[TestLoc]) div 16; 2047 end; // no enemy city or unit here 2048 2049 if TestScore>0 then 2050 begin 2051 TestScore:=TestScore*$1000-DistanceScore*TestTime; 2052 if TestScore>PatrolScore then 2053 BestCount:=0; 2054 if TestScore>=PatrolScore then 2055 begin 2056 inc(BestCount); 2057 if random(BestCount)=0 then 308 2058 begin 309 NextLoc := Adjacent[V8]; 310 if (NextLoc >= 0) and (NextLoc < MapSize) and 311 (AdjacentUnknown[NextLoc] < 0) then // tile not checked yet 312 begin 313 TerrType := Map[NextLoc] and fTerrain; 314 if TerrType = fUNKNOWN then 315 inc(AdjacentUnknown[TestLoc]) 316 else 317 begin 318 case MyModel[mix].Domain of 319 dGround: 320 begin 321 TerrOwner := RO.Territory[NextLoc]; 322 if (TerrType >= fGrass) and (TerrType <> fArctic) 323 // terrain can be walked 324 and ((TerrOwner < 0) or (TerrOwner = me) or 325 (RO.Treaty[TerrOwner] < trPeace)) 326 // no peace treaty violated 327 and (((Map[NextLoc] and (fUnit or fCity)) <> 0) or 328 (Map[TestLoc] and Map[NextLoc] and fInEnemyZoC = 0)) 329 then // no ZoC violated 330 begin // yes, consider walking this tile 331 if TerrType = fMountains then 332 StepSize := 2 // mountains cause delay 333 else 334 StepSize := 1 335 end 336 else 337 StepSize := 0 // no, don't walk here 338 end; 339 dSea: 340 if TerrType = fShore then 341 // ships of this AI can only move along shore 342 StepSize := 1 343 else 344 StepSize := 0; 345 dAir: 346 StepSize := 1; 347 end; 348 if StepSize > 0 then 349 Pile.Put(NextLoc, TestDistance + StepSize) 350 end 351 end; 352 end; 353 end; 354 if Role = Defend then 355 TestScore := 0 // don't discover/patrol 356 else if AdjacentUnknown[TestLoc] > 0 then 357 begin 358 TestScore := 20 + AdjacentUnknown[TestLoc]; 359 TestTask := utDiscover 360 end 361 else 362 begin 363 TestScore := (RO.Turn - RO.MapObservedLast[TestLoc]) div 10; 364 TestTask := utPatrol 365 end 366 end; // no enemy city or unit here 367 368 if TestScore > 0 then 369 begin 370 TestScore := TestScore - DistanceScore * TestDistance; 371 if TestScore > BestScore then 372 BestCount := 0; 373 if TestScore >= BestScore then 374 begin 375 inc(BestCount); 376 if random(BestCount) = 0 then 377 begin 378 BestScore := TestScore; 379 BestLoc := TestLoc; 380 BestTask := TestTask; 2059 PatrolScore:=TestScore; 2060 PatrolLoc:=TestLoc; 381 2061 end 382 2062 end; 383 2063 end 384 end; 385 386 if (BestTask = utNone) and ((Map[Loc] and fCity) = 0) then 387 begin // nothing to do, move home 388 if Home >= 0 then 389 BestLoc := MyCity[Home].Loc 390 else 391 BestLoc := maNextCity; 392 BestTask := utGoHome; 393 end; 394 if BestTask <> utNone then 2064 end; // while Pile.Get 2065 Pile.Free; 2066 2067 if PatrolLoc>=0 then 395 2068 begin // attack/capture/discover/patrol task found, execute it 396 OldLoc := Loc; 397 MoveResult := Unit_Move(uix, BestLoc); 398 Exhausted := (Loc = OldLoc) or 399 ((MoveResult and (rMoreTurns or rUnitRemoved)) <> 0); 400 if (BestTask = utAttack) and ((MoveResult and rLocationReached) <> 0) 401 then 402 if Movement < 100 then 403 Exhausted := true 404 else 405 begin 406 AttackResult := Unit_Attack(uix, BestLoc); 407 Exhausted := ((AttackResult and rExecuted) = 0) or 408 ((AttackResult and rUnitRemoved) <> 0); 409 end; 410 if not Exhausted then 411 Exhausted := (Movement < 100) and 412 ((Map[Loc] and (fRoad or fRR or fRiver or fCity)) = 0); 413 // no road, too few movement points for further movement 414 end 415 else 416 Exhausted := true; 417 until Exhausted; 418 Pile.Free; 419 end; // ProcessUnit 420 421 // SetCityProduction: choose production of each city 2069 OldLoc:=Loc; 2070 MoveResult:=Unit_Move(uix,PatrolLoc); 2071 Exhausted:= (Loc=OldLoc) 2072 or ((MoveResult and (rMoreTurns or rUnitRemoved))<>0); 2073 end 2074 else Exhausted:=true; 2075 until Exhausted; 2076 end; 2077 end; // Patrol 2078 2079 procedure TAI.AttackAndPatrol; 2080 const 2081 nAttackCatOrder=3; 2082 AttackCatOrder: array[0..nAttackCatOrder-1] of integer= 2083 (mctGroundAttacker, mctCruiser, mctGroundDefender); 2084 var 2085 iCat,uix,uix1: integer; 2086 IsPatrolUnit,Fortified: boolean; 2087 begin 2088 for uix:=0 to RO.nUn-1 do with MyUnit[uix] do // utilize militia 2089 if (Loc>=0) and (mix=mixMilitia) 2090 and ((Formation[Loc]<0) or (Formation[Loc]>=maxCOD) 2091 or (ContinentPresence[Formation[Loc]] and PresenceUnknown=0)) then 2092 Unit_Disband(uix); 2093 2094 if RO.nEnemyUn>0 then 2095 for iCat:=0 to nAttackCatOrder-1 do 2096 for Fortified:=false to true do 2097 for uix:=RO.nUn-1 downto 0 do with MyUnit[uix] do 2098 if (Loc>=0) and (ModelCat[mix]=AttackCatOrder[iCat]) 2099 and (MyModel[mix].Attack>0) 2100 and ((Flags and unFortified<>0) = Fortified) then 2101 CheckAttack(uix); 2102 2103 fillchar(uixPatrol, sizeof(uixPatrol), $FF); 2104 for uix:=0 to RO.nUn-1 do with MyUnit[uix],MyModel[mix] do 2105 if (Loc>=0) and (Domain=dGround) and (Attack>0) and (Speed>=250) 2106 and (Map[Loc] and fTerrain>=fGrass) 2107 and (Formation[Loc]>=0) and (Formation[Loc]<maxCOD) 2108 and ((uixPatrol[Formation[Loc]]<0) 2109 or (MyUnit[uix].ID<MyUnit[uixPatrol[Formation[Loc]]].ID)) then 2110 uixPatrol[Formation[Loc]]:=uix; 2111 2112 for uix:=0 to RO.nUn-1 do with MyUnit[uix] do if Loc>=0 then 2113 begin 2114 if mix=mixMilitia then 2115 if (RO.nUn<3) and (RO.nCity=1) or (Map[Loc] and fCity=0) then 2116 IsPatrolUnit:=true 2117 else 2118 begin // militia 2119 IsPatrolUnit:=false; 2120 for uix1:=0 to RO.nUn-1 do 2121 if (uix1<>uix) and (MyUnit[uix1].Loc=Loc) 2122 and (MyUnit[uix1].mix<>mixSettlers) then 2123 IsPatrolUnit:=true 2124 end 2125 else IsPatrolUnit:=(mix=mixCruiser) 2126 or (Map[Loc] and fTerrain>=fGrass) 2127 and (Formation[Loc]>=0) and (Formation[Loc]<maxCOD) 2128 and (uix=uixPatrol[Formation[Loc]]); 2129 if IsPatrolUnit then Patrol(uix); 2130 end 2131 end; // AttackAndPatrol 2132 2133 2134 function TAI.HavePort: boolean; 2135 var 2136 V8, cix,AdjacentLoc,f: integer; 2137 Adjacent: TVicinity8Loc; 2138 begin 2139 result:=false; 2140 for cix:=0 to RO.nCity-1 do with MyCity[cix] do if Loc>=0 then 2141 begin 2142 V8_to_Loc(Loc,Adjacent); 2143 for V8:=0 to 7 do 2144 begin 2145 AdjacentLoc:=Adjacent[V8]; 2146 if (AdjacentLoc>=0) and ((Map[AdjacentLoc] and fTerrain)<fGrass) then 2147 begin 2148 f:=Formation[AdjacentLoc]; 2149 if (f>=0) and (f<maxCOD) and (OceanPresence[f] and not (1 shl me)<>0) then 2150 result:=true; 2151 end 2152 end; 2153 end 2154 end; 2155 2156 422 2157 procedure TAI.SetCityProduction; 423 2158 var 424 cix, mix, mixSettler, mixShip, mixArmy, V8, NewImprovement, count, wix, 425 AdjacentLoc: integer; 426 IsPort: boolean; 427 Adjacent: TVicinity8Loc; 428 Report: TCityReport; 2159 uix,cix,iix,dtr,V8,V21,NewImprovement,AdjacentLoc,MaxSettlers, 2160 maxcount,cixMilAcademy: integer; 2161 TerrType: cardinal; 2162 IsPort,IsNavalBase,NeedCruiser,CheckProd,Destructed,ProduceSettlers,ProduceMil: boolean; 2163 Adjacent: TVicinity8Loc; 2164 Radius: TVicinity21Loc; 2165 Report: TCityReport; 2166 HomeCount, CityProdRep: array[0..nCmax-1] of integer; 2167 MilProdCity: array[0..nCmax-1] of boolean; 429 2168 430 2169 procedure TryBuild(Improvement: integer); 431 2170 begin 432 if (NewImprovement < 0) // already improvement of higher priority found 433 and (MyCity[cix].Built[Improvement] = 0) // not built yet 434 and City_Improvable(cix, Improvement) then 435 NewImprovement := Improvement; 2171 if (NewImprovement=imTrGoods) // not already improvement of higher priority found 2172 and (MyCity[cix].Built[Improvement]=0) // not built yet 2173 and ((Imp[Improvement].Preq=preNone) 2174 or (RO.Tech[Imp[Improvement].Preq]>=tsApplicable)) 2175 and City_Improvable(cix, Improvement) then 2176 NewImprovement:=Improvement; 2177 end; 2178 2179 procedure TryDestruct(Improvement: integer); 2180 begin 2181 if Destructed or (MyCity[cix].Built[Improvement]=0) then exit; 2182 if City_CurrentImprovementProject(cix)>=0 then 2183 City_RebuildImprovement(cix,Improvement) 2184 else City_SellImprovement(cix, Improvement); 2185 { if (CurrentImprovementProject>=0) 2186 and (Imp[CurrentImprovementProject].Kind in [ikCommon,ikNatGlobal,ikNatLocal]) 2187 and ((Imp[CurrentImprovementProject].Cost*3-Imp[Improvement].Cost*2) 2188 *BuildCostMod[G.Difficulty[me]]>MyCity[cix].Prod*(12*3)) then} 2189 Destructed:=true 2190 end; 2191 2192 function ChooseBuildModel(Cat: integer): integer; 2193 var 2194 count, mix: integer; 2195 begin 2196 count:=0; 2197 for mix:=0 to RO.nModel-1 do 2198 if (ModelCat[mix]=Cat) 2199 and (ModelQuality[mix]>=ModelBestQuality[Cat]-MaxBuildWorseThanBestModel) then 2200 begin inc(count); if random(count)=0 then result:=mix end; 2201 assert(count>0); 2202 end; 2203 2204 procedure NominateMilProdCities; 2205 // find military production cities 2206 var 2207 cix, Total, d, Threshold, NewThreshold, Share, SharePlus, cixWorst: integer; 2208 begin 2209 fillchar(MilProdCity, RO.nCity, 0); 2210 GetCityProdPotential; 2211 for d:=0 to maxCOD-1 do 2212 begin 2213 Total:=0; 2214 for cix:=0 to RO.nCity-1 do with MyCity[cix] do 2215 if (Loc>=0) and (District[Loc]=d) then 2216 Total:=Total+CityResult[cix]; 2217 if Total=0 then continue; // district does not exist 2218 2219 Share:=0; 2220 cixWorst:=-1; 2221 for cix:=0 to RO.nCity-1 do with MyCity[cix] do 2222 if (Loc>=0) and (District[Loc]=d) 2223 and (Built[imBarracks]+Built[imMilAcademy]>0) then 2224 begin 2225 MilProdCity[cix]:=true; 2226 inc(Share,CityResult[cix]); 2227 if (cixWorst<0) or (CityResult[cix]<CityResult[cixWorst]) then 2228 cixWorst:=cix 2229 end; 2230 2231 Threshold:=$FFFF; 2232 while (Threshold>0) and (Share<Total*MilProdShare div 100) do 2233 begin 2234 NewThreshold:=-1; 2235 for cix:=0 to RO.nCity-1 do with MyCity[cix] do 2236 if (Loc>=0) and (District[Loc]=d) 2237 and (Built[imBarracks]+Built[imMilAcademy]=0) and (Built[imObservatory]=0) 2238 and (CityResult[cix]<Threshold) 2239 and (CityResult[cix]>=NewThreshold) then 2240 if CityResult[cix]>NewThreshold then 2241 begin 2242 NewThreshold:=CityResult[cix]; 2243 SharePlus:=CityResult[cix] 2244 end 2245 else inc(SharePlus,CityResult[cix]); 2246 Threshold:=NewThreshold; 2247 inc(Share,SharePlus); 2248 end; 2249 2250 for cix:=0 to RO.nCity-1 do with MyCity[cix] do 2251 if (Loc>=0) and (District[Loc]=d) 2252 and (Built[imBarracks]+Built[imMilAcademy]=0) 2253 and (CityResult[cix]>=Threshold) then 2254 MilProdCity[cix]:=true; 2255 { if (cixWorst>=0) 2256 and (Share-CityResult[cixWorst]*2>=Total*MilProdShare div 100) then 2257 MilProdCity[cixWorst]:=false;} 2258 end; 2259 2260 // check best city for military academy 2261 cixMilAcademy:=cixStateImp[imMilAcademy]; 2262 if cixStateImp[imPalace]>=0 then 2263 begin 2264 d:=District[MyCity[cixStateImp[imPalace]].Loc]; 2265 if (d>=0) and (d<maxCOD) then 2266 begin 2267 cixMilAcademy:=-1; 2268 for cix:=0 to RO.nCity-1 do with MyCity[cix] do 2269 if (Loc>=0) and (District[Loc]=d) 2270 and (Built[imObservatory]+Built[imPalace]=0) 2271 and ((cixMilAcademy<0) or (CityResult[cix]>CityResult[cixMilAcademy])) then 2272 cixMilAcademy:=cix; 2273 end; 2274 if (cixMilAcademy>=0) and (cixStateImp[imMilAcademy]>=0) 2275 and (cixMilAcademy<>cixStateImp[imMilAcademy]) 2276 and (MyCity[cixStateImp[imMilAcademy]].Built[imObservatory]=0) 2277 and (CityResult[cixMilAcademy]<=CityResult[cixStateImp[imMilAcademy]]*3 div 2) then 2278 cixMilAcademy:=cixStateImp[imMilAcademy] // because not so much better 2279 end 2280 end; 2281 2282 procedure ChangeHomeCities; 2283 var 2284 uix,NewHome,HomeSupport,NewHomeSupport,SingleSupport: integer; 2285 begin 2286 if RO.Government in [gAnarchy, gFundamentalism] then exit; 2287 for uix:=0 to RO.nUn-1 do with MyUnit[uix] do 2288 if (Loc>=0) and (Home>=0) and (Map[Loc] and fCity<>0) 2289 and (MyCity[Home].Loc<>Loc) and (MyModel[mix].Kind<>mkSettler) then 2290 begin 2291 City_FindMyCity(Loc, NewHome); 2292 case RO.Government of 2293 gDespotism: 2294 begin 2295 HomeSupport:=HomeCount[Home]-MyCity[Home].Size; 2296 NewHomeSupport:=HomeCount[NewHome]-MyCity[NewHome].Size; 2297 end; 2298 gMonarchy, gCommunism: 2299 begin 2300 HomeSupport:=HomeCount[Home]-MyCity[Home].Size div 2; 2301 NewHomeSupport:=HomeCount[NewHome]-MyCity[NewHome].Size div 2; 2302 end; 2303 else 2304 begin 2305 HomeSupport:=HomeCount[Home]; 2306 NewHomeSupport:=HomeCount[NewHome]; 2307 end; 2308 end; 2309 if HomeSupport>0 then 2310 begin 2311 if MyModel[mix].Flags and mdDoubleSupport=0 then SingleSupport:=1 2312 else SingleSupport:=2; 2313 HomeSupport:=HomeSupport-SingleSupport; 2314 NewHomeSupport:=NewHomeSupport+SingleSupport; 2315 if HomeSupport<0 then HomeSupport:=0; 2316 if NewHomeSupport<0 then NewHomeSupport:=0; 2317 if (NewHomeSupport<=0) 2318 or (CityProdRep[Home]-HomeSupport<=CityProdRep[NewHome]-NewHomeSupport) then 2319 begin 2320 dec(HomeCount[Home],SingleSupport); 2321 inc(HomeCount[NewHome],SingleSupport); 2322 Unit_SetHomeHere(uix) 2323 end 2324 end 2325 end 436 2326 end; 437 2327 438 2328 begin 439 // only produce newest models 440 mixSettler := -1; 441 mixArmy := -1; 442 mixShip := -1; 443 for mix := 0 to RO.nModel - 1 do 444 with MyModel[mix] do 445 if Kind = mkSettler then 446 mixSettler := mix 447 else if (Domain = dGround) and (Kind < mkSpecial_TownGuard) then 448 mixArmy := mix 449 else if Domain = dSea then 450 mixShip := mix; 451 452 for cix := 0 to RO.nCity - 1 do 453 with MyCity[cix] do 454 if (RO.Turn = 0) or ((Flags and chProduction) <> 0) 455 // city production complete 456 or not City_HasProject(cix) then 2329 fillchar(HomeCount, 4*RO.nCity, 0); 2330 for uix:=0 to RO.nUn-1 do with MyUnit[uix] do 2331 if (Loc>=0) and (Home>=0) then 2332 if MyModel[mix].Flags and mdDoubleSupport=0 then 2333 inc(HomeCount[Home]) 2334 else inc(HomeCount[Home],2); 2335 2336 NominateMilProdCities; 2337 2338 for cix:=0 to RO.nCity-1 do with MyCity[cix] do 2339 if (Loc>=0) and (Flags and chCaptured=0) and (District[Loc]>=0) then 2340 begin 2341 if size<4 then 2342 City_OptimizeTiles(cix,rwMaxGrowth) 2343 else City_OptimizeTiles(cix,rwForceProd); 2344 2345 City_GetReport(cix, Report); 2346 CityProdRep[cix]:=Report.ProdRep; 2347 2348 Destructed:=false; 2349 CheckProd:= (RO.Turn=0) or ((Flags and chProduction)<>0) // city production complete 2350 or not City_HasProject(cix); 2351 if not CheckProd then 2352 begin // check whether producing double state improvement or wonder 2353 iix:=City_CurrentImprovementProject(cix); 2354 if (iix>=0) 2355 and (((Imp[iix].Kind in [ikNatLocal,ikNatGlobal]) and (RO.NatBuilt[iix]>0)) 2356 or ((Imp[iix].Kind=ikWonder) and (RO.Wonder[iix].CityID<>-1))) then 2357 CheckProd:=true; 2358 end; 2359 if CheckProd then 457 2360 begin // check production 458 IsPort := false; 459 V8_to_Loc(Loc, Adjacent); 460 for V8 := 0 to 7 do 461 begin 462 AdjacentLoc := Adjacent[V8]; 463 if (AdjacentLoc >= 0) and (AdjacentLoc < MapSize) and 464 ((Map[AdjacentLoc] and fTerrain) = fShore) then 465 IsPort := true; // shore tile at adjacent location -- city is port! 2361 IsPort:=false; 2362 IsNavalBase:=false; 2363 NeedCruiser:=false; 2364 V8_to_Loc(Loc,Adjacent); 2365 for V8:=0 to 7 do 2366 begin 2367 AdjacentLoc:=Adjacent[V8]; 2368 if (AdjacentLoc>=0) and ((Map[AdjacentLoc] and fTerrain)<fGrass) then 2369 begin 2370 IsPort:=true; // shore tile at adjacent location -- city is port! 2371 if (Formation[AdjacentLoc]>=0) and (Formation[AdjacentLoc]<maxCOD) 2372 and (OceanPresence[Formation[AdjacentLoc]] and WarNations<>0) then 2373 begin 2374 IsNavalBase:=true; 2375 if (1 shl Formation[AdjacentLoc]) and OceanWithShip=0 then 2376 NeedCruiser:=true 2377 end 2378 end 466 2379 end; 467 City_GetReport(cix, Report); 468 469 if (Report.Support = 0) or (SupportFree[RO.Government] < 2) and 470 (Report.Support < Report.ProdRep div 2) then 471 begin // enough material to support more units 472 if (RO.Turn > 4) and 473 ((Report.Eaten - Size * 2) div SettlerFood[RO.Government] < 474 Size div 4) then 475 // less than 1 settler per 4 citizens -- produce more! 476 City_StartUnitProduction(cix, mixSettler) 477 else if IsPort and (mixShip >= 0) and (random(2) = 0) then 478 City_StartUnitProduction(cix, mixShip) 479 else 480 City_StartUnitProduction(cix, mixArmy) 2380 2381 if RO.Turn=0 then 2382 begin 2383 NewImprovement:=-1; 2384 City_StartUnitProduction(cix,mixMilitia); // militia 481 2385 end 482 else 483 begin // check for building a city improvement 484 NewImprovement := -1; 485 if Built[imPalace] + Built[imCourt] + Built[imTownHall] = 0 then 2386 else NewImprovement:=imTrGoods; 2387 2388 dtr:=District[Loc]; // formation of city 2389 2390 if NewImprovement=imTrGoods then 2391 begin 2392 if (Built[imPalace]+Built[imCourt]+Built[imTownHall]=0) then 2393 TryBuild(imTownHall); 2394 end; 2395 2396 if (NewImprovement=imTrGoods) 2397 and (RO.Government=gDespotism) and (Report.Support=0) then 2398 begin // produce town guard 2399 NewImprovement:=-1; 2400 City_StartUnitProduction(cix,mixTownGuard); 2401 end; 2402 2403 if NewImprovement=imTrGoods then 2404 begin 2405 if RO.Government=gDespotism then maxcount:=Size 2406 else maxcount:=Size div 2; 2407 2408 if IsResearched(adRailroad) and (mixSettlers=0) // better wait for engineers 2409 or (Built[imColosseum]+Built[imObservatory]>0) then 2410 MaxSettlers:=1 2411 else MaxSettlers:=(Size+2) div 6; 2412 ProduceSettlers:=(HomeCount[cix]<maxcount+Size div 2) 2413 and ((Report.Eaten-Size*2) div SettlerFood[RO.Government]<MaxSettlers) 2414 and ((dtr<0) or (dtr>=maxCOD) or (SettlerSurplus[dtr]<=0)); 2415 2416 ProduceMil:=(HomeCount[cix]<maxcount+Size div 2) 2417 and (Built[imBarracks]+Built[imMilAcademy]>0) 2418 and ((ModelBestQuality[mctGroundDefender]>0) 2419 or (ModelBestQuality[mctGroundAttacker]>0)) 2420 and ((dtr<maxCOD) 2421 and ((UnitLack[dtr,mctGroundAttacker]>0) 2422 or (UnitLack[dtr,mctGroundDefender]>0)) 2423 or (HomeCount[cix]<maxcount)); 2424 2425 if ProduceMil or not ProduceSettlers and (HomeCount[cix]<maxcount) then 486 2426 begin 487 TryBuild(imCourt); 488 TryBuild(imTownHall); 2427 NewImprovement:=-1; 2428 if (dtr>=maxCOD) 2429 or (ModelBestQuality[mctGroundDefender]=0) 2430 or (UnitLack[dtr,mctGroundAttacker] 2431 >=UnitLack[dtr,mctGroundDefender]) then 2432 City_StartUnitProduction(cix,ChooseBuildModel(mctGroundAttacker)) 2433 else City_StartUnitProduction(cix,ChooseBuildModel(mctGroundDefender)) 2434 end 2435 else if ProduceSettlers then 2436 begin 2437 NewImprovement:=-1; 2438 City_StartUnitProduction(cix,mixSettlers); 2439 end 2440 end; 2441 2442 if NewImprovement>=0 then 2443 begin // produce improvement 2444 if (RO.Turn>=40) and (Report.Happy*2<=Size) 2445 and (Built[imColosseum]=0) then 2446 TryBuild(imTemple); 2447 if cix=cixMilAcademy then 2448 TryBuild(imMilAcademy) 2449 else if ((Built[imPalace]>0) or MilProdCity[cix] and (Built[imTemple]>0)) 2450 and (Built[imObservatory]=0) then 2451 TryBuild(imBarracks); 2452 if Report.Trade-Report.Corruption>=11 then 2453 TryBuild(imLibrary); 2454 if Report.Trade-Report.Corruption>=11 then 2455 TryBuild(imMarket); 2456 if (Report.Trade-Report.Corruption>=11) and (Report.Happy>=4) then 2457 TryBuild(imUniversity); 2458 if (Built[imPalace]>0) and (Report.Trade-Report.Corruption>=11) 2459 and (Report.Happy>=4) and (RO.NatBuilt[imObservatory]=0) then 2460 TryBuild(imObservatory); // always build observatory in capital 2461 if (Report.Trade-Report.Corruption>=15) and (Report.Happy>=4) then 2462 TryBuild(imResLab); 2463 if (Size>=9) and (Built[imPalace]+Built[imCourt]>0) then 2464 TryBuild(imHighways); 2465 if (RO.Government<>gDespotism) and (Report.Happy*2<=Size) 2466 and (Built[imCathedral]+Built[imTheater]+Built[imColosseum]=0) then 2467 begin 2468 TryBuild(imCathedral); 2469 TryBuild(imTheater); 489 2470 end; 490 if Report.Trade - Report.Corruption >= 11 then 491 TryBuild(imLibrary); 492 if Report.Trade - Report.Corruption >= 11 then 493 TryBuild(imMarket); 494 if Size >= 9 then 495 TryBuild(imHighways); 496 if (RO.Government <> gDespotism) and (Size >= 4) then 497 TryBuild(imTemple); 498 if (RO.Government <> gDespotism) and (Size >= 6) then 499 TryBuild(imTheater); 500 if (RO.Government <> gDespotism) and (Size >= 8) then 501 TryBuild(imAqueduct); 502 if (Report.ProdRep >= 4) or (RO.nCity = 1) then 503 TryBuild(imBarracks); 504 TryBuild(imWalls); 505 if IsPort then 506 TryBuild(imCoastalFort); 507 if NewImprovement < 0 then 508 begin // nothing to produce -- check for building a wonder 509 count := 0; 510 for wix := 0 to nImp - 1 do 511 if (Imp[wix].Kind = ikWonder) and (RO.Wonder[wix].CityID = -1) 512 // not built yet 513 and ((Report.ProdRep - Report.Support) * 40 >= Imp[wix].Cost) 514 // takes less than 40 turns to produce 515 and City_Improvable(cix, wix) then 516 begin 517 inc(count); 518 if random(count) = 0 then 519 NewImprovement := wix // yes, build this wonder! 520 end; 2471 if (RO.Government<>gDespotism) and (Size>=NeedAqueductSize) then 2472 TryBuild(imAqueduct); 2473 if (Built[imColosseum]+Built[imObservatory]>0) and (Size>=NeedSewerSize) then 2474 TryBuild(imSewer); 2475 if (RO.NatBuilt[imGrWall]=0) and (Built[imObservatory]+Built[imMilAcademy]=0) 2476 and (RO.nCity>=6) and (cixStateImp[imPalace]>=0) 2477 and (Formation[Loc]=Formation[MyCity[cixStateImp[imPalace]].Loc]) 2478 and (Report.ProdRep-Report.Support>=6) then 2479 TryBuild(imGrWall); 2480 // if Map[Loc] and fGrWall=0 then 2481 // TryBuild(imWalls); 2482 // if IsNavalBase then 2483 // TryBuild(imCoastalFort); 2484 if (RO.NatBuilt[imSpacePort]=0) and (Built[imObservatory]+Built[imMilAcademy]=0) 2485 and (Report.ProdRep-Report.Support>=10) then 2486 TryBuild(imSpacePort); 2487 if Report.ProdRep>=8 then 2488 TryBuild(imFactory); 2489 if Report.ProdRep>=12 then 2490 TryBuild(imMfgPlant); 2491 if IsPort then 2492 if Size>8 then 2493 TryBuild(imHarbor) 2494 else if (Built[imHarbor]=0) and (Size>4) 2495 and ((Size and 1<>0) and (Report.Happy*2>Size) 2496 or (Built[imColosseum]>0)) then 2497 begin // check building harbor 2498 V21_to_Loc(Loc,Radius); 2499 for V21:=1 to 26 do // city is in growth mode - using any 1-food tile? 2500 if Tiles and (1 shl V21)<>0 then 2501 begin 2502 TerrType:=Map[Radius[V21]] and (fTerrain or fSpecial); 2503 if TerrType in [fDesert,fTundra,fSwamp,fForest,fHills,fMountains] then 2504 begin TryBuild(imHarbor); break end 2505 end 2506 end; 2507 if (Size<=10) and (Report.FoodRep-Report.Eaten<2) and 2508 (Report.Happy*2>=Size+2) then 2509 TryBuild(imSuperMarket); 2510 2511 // less important 2512 if (Built[imPalace]>0) and (RO.NatBuilt[imColosseum]=0) 2513 and (Size>=10) then 2514 TryBuild(imColosseum); // always build colosseum in capital 2515 if (Built[imPalace]+Built[imCourt]=0) 2516 and ((Report.Corruption>2) or IsResearched(Imp[imHighways].Preq)) then 2517 TryBuild(imCourt); // replace courthouse 2518 if Report.PollRep>=15 then 2519 TryBuild(imRecycling); 2520 if (Report.Trade-Report.Corruption>=11) 2521 and (RO.Money<TotalPopulation[me]*2) then 2522 TryBuild(imBank); 2523 if (RO.NatBuilt[imStockEx]=0) and (Built[imObservatory]+Built[imMilAcademy]=0) 2524 and (Report.ProdRep-Report.Support>=8) then 2525 TryBuild(imStockEx); 2526 2527 // every improvement checked -- start production now 2528 if NewImprovement<>imTrGoods then 2529 begin 2530 if City_StartImprovement(cix, NewImprovement)<rExecuted then 2531 NewImprovement:=imTrGoods 521 2532 end; 522 if NewImprovement >= 0 then 523 City_StartImprovement(cix, NewImprovement) 524 else if City_HasProject(cix) then 525 City_StopProduction(cix); // nothing to produce 526 end 527 end // check production 2533 if (NewImprovement=imTrGoods) and (RO.Turn and $F=0) then 2534 begin // try colony ship parts 2535 NewImprovement:=imShipComp; 2536 while (NewImprovement<=imShipHab) 2537 and ((RO.Tech[Imp[NewImprovement].Preq]<0) 2538 or (City_StartImprovement(cix, NewImprovement)<rExecuted)) do 2539 inc(NewImprovement); 2540 if NewImprovement>imShipHab then NewImprovement:=imTrGoods 2541 end 2542 end; 2543 2544 if (NewImprovement=imTrGoods) and NeedCruiser and (mixCruiser>=0) 2545 and (Project and (cpImp or cpIndex)<>mixCruiser) 2546 and (Report.ProdRep-Report.Support>=6) then 2547 begin 2548 NewImprovement:=-1; 2549 City_StartUnitProduction(cix,mixCruiser); 2550 end; 2551 2552 if (NewImprovement=imTrGoods) and City_HasProject(cix) then 2553 City_StopProduction(cix); 2554 2555 // rebuild imps no longer needed 2556 if (RO.TaxRate=0) and (RO.Money>=TotalPopulation[me]*4) then 2557 TryDestruct(imBank) 2558 else if Report.Happy*2>=Size+6 then 2559 TryDestruct(imTheater) 2560 else if Report.Happy*2>=Size+4 then 2561 TryDestruct(imTemple) 2562 end; 2563 2564 // rebuild imps no longer needed, no report needed 2565 if (Built[imObservatory]>0) 2566 or (Project and (cpImp or cpIndex)=cpImp or imObservatory) 2567 {or not MilProdCity[cix]} then 2568 TryDestruct(imBarracks); 2569 if Map[Loc] and fGrWall<>0 then 2570 TryDestruct(imWalls); 2571 if Built[imColosseum]>0 then 2572 begin 2573 TryDestruct(imTheater); 2574 TryDestruct(imCathedral); 2575 TryDestruct(imTemple); 2576 end; 2577 end; 2578 2579 ChangeHomeCities; 528 2580 end; // SetCityProduction 529 2581 530 function TAI.ChooseResearchAdvance: integer;531 var532 mix: integer;533 begin534 if not IsResearched(adWheel) then535 begin536 result := adWheel;537 exit538 end // research the wheel first539 else if not IsResearched(adWarriorCode) then540 begin541 result := adWarriorCode;542 exit543 end // research warrior code first544 else if not IsResearched(adHorsebackRiding) then545 begin546 result := adHorsebackRiding;547 exit548 end; // research horseback riding first549 550 result := -1; // random advance551 if random(10) = 0 then552 begin // check military research553 result := adMilitary;554 if IsResearched(adMapMaking) and (random(2) = 0) then555 begin // try to develop new ship556 PrepareNewModel(dSea);557 SetNewModelFeature(mcDefense, 3);558 SetNewModelFeature(mcOffense, RO.DevModel.MaxWeight - 3);559 end560 else561 begin // try to develop new ground unit562 PrepareNewModel(dGround);563 SetNewModelFeature(mcDefense, 1);564 SetNewModelFeature(mcOffense, RO.DevModel.MaxWeight - 4);565 SetNewModelFeature(mcMob, 2);566 end;567 568 // don't develop model twice569 for mix := 0 to RO.nModel - 1 do570 if (RO.DevModel.Domain = MyModel[mix].Domain) and571 (RO.DevModel.Attack = MyModel[mix].Attack) and572 (RO.DevModel.Defense = MyModel[mix].Defense) then573 result := -1; // already have this model574 end;575 end; // ChooseResearchAdvance576 2582 577 2583 function TAI.ChooseGovernment: integer; 578 2584 begin 579 if IsResearched(adTheRepublic) then 580 result := gRepublic 581 else if IsResearched(adMonarchy) then 582 result := gMonarchy 2585 if Data.BehaviorFlags and bBarbarina<>0 then 2586 if IsResearched(adTheology) then result:=gFundamentalism 2587 else result:=gDespotism 2588 else if IsResearched(adDemocracy) then 2589 result:=gDemocracy //!!! 2590 else if IsResearched(adTheRepublic) then 2591 result:=gRepublic 2592 else if IsResearched(adMonarchy) then 2593 result:=gMonarchy 2594 else result:=gDespotism 2595 end; 2596 2597 2598 //------------------------------- 2599 // DIPLOMACY 2600 //------------------------------- 2601 2602 function TAI.MostWanted(Nation, adGiveAway: integer): integer; 2603 var 2604 ad: integer; 2605 begin 2606 result:=-1; 2607 if RO.Tech[adGiveAway]>=tsApplicable then 2608 if (adGiveAway=adTheRepublic) and (Data.BehaviorFlags and bGender=bFemale) 2609 and (RO.Tech[adTheology]<tsSeen) then 2610 begin 2611 if RO.EnemyReport[Nation].Tech[adTheology]>=tsApplicable then 2612 result:=adTheology 2613 end 2614 else for ad:=0 to nAdv-5 do // no future techs 2615 if (AdvanceValue[ad]>0) 2616 and (RO.Tech[ad]<tsSeen) and (ad<>RO.ResearchTech) 2617 and (RO.EnemyReport[Nation].Tech[ad]>=tsApplicable) 2618 and ((Advancedness[adGiveAway]<=Advancedness[ad]+AdvanceValue[ad] shr 8+Compromise) 2619 or (adGiveAway=adScience) and (Nation=Data.TheologyPartner)) 2620 and ((result<0) 2621 or ((Advancedness[adGiveAway]+Compromise>=Advancedness[ad]) // acceptable for opponent 2622 or (ad=adScience)) 2623 and (AdvanceValue[ad]>AdvanceValue[result]) 2624 or (result<>adScience) 2625 and (Advancedness[adGiveAway]+Compromise<Advancedness[result]) 2626 and (Advancedness[ad]<Advancedness[result])) 2627 and ((ad<>adTheRepublic) or (Data.BehaviorFlags and bGender=bFemale) 2628 or (RO.EnemyReport[Nation].Tech[adTheology]>=tsSeen)) then 2629 result:=ad 2630 end; 2631 2632 procedure TAI.FindBestTrade(Nation: integer; var adWanted, adGiveAway: integer); 2633 var 2634 i,ad,ead,adTestGiveAway: integer; 2635 begin 2636 adWanted:=-1; 2637 adGiveAway:=-1; 2638 for ead:=0 to nAdv-5 do // no future techs 2639 if (AdvanceValue[ead]>=$100) 2640 and (RO.Tech[ead]<tsSeen) and (ead<>RO.ResearchTech) 2641 and (RO.EnemyReport[Nation].Tech[ead]>=tsApplicable) 2642 and ((adWanted<0) or (AdvanceValue[ead]>AdvanceValue[adWanted])) then 2643 begin 2644 adTestGiveAway:=-1; 2645 for i:=0 to nRequestedTechs-1 do 2646 if (Data.RequestedTechs[i]>=0) 2647 and (Data.RequestedTechs[i] and $FFFF=Nation shl 8+ead) then 2648 adTestGiveAway:=-2; // already requested before 2649 if adTestGiveAway=-1 then 2650 begin 2651 for ad:=0 to nAdv-5 do // no future techs 2652 if (RO.Tech[ad]>=tsApplicable) 2653 and (ad<>RO.EnemyReport[Nation].ResearchTech) 2654 and (RO.EnemyReport[Nation].Tech[ad]<tsSeen) 2655 and ((Advancedness[ad]+Compromise>=Advancedness[ead]) or (ead=adScience)) 2656 and (Advancedness[ad]<=Advancedness[ead]+AdvanceValue[ead] shr 8+Compromise) 2657 and ((adTestGiveAway<0) or (Advancedness[ad]<Advancedness[adTestGiveAway])) then 2658 adTestGiveAway:=ad; 2659 if adTestGiveAway>=0 then 2660 begin 2661 adWanted:=ead; 2662 adGiveAway:=adTestGiveAway 2663 end 2664 end 2665 end; 2666 end; 2667 2668 2669 function TAI.WantNegotiation(Nation: integer; NegoTime: TNegoTime): boolean; 2670 var 2671 p1,count,adWanted,adGiveAway: integer; 2672 begin 2673 if Data.BehaviorFlags and bBarbarina=bBarbarina then 2674 begin result:=Barbarina_WantNegotiation(Nation,NegoTime); exit end; 2675 2676 if RO.Treaty[Nation]<trPeace then 2677 begin 2678 if Data.BehaviorFlags and bBarbarina<>0 then 2679 begin result:=false; exit end; 2680 count:=0; 2681 for p1:=0 to nPl-1 do 2682 if (p1<>me) and (1 shl p1 and RO.Alive<>0) and (RO.Treaty[p1]>=trPeace) then 2683 inc(count); 2684 if count>=3 then // enough peace made 2685 begin result:=false; exit; end 2686 end; 2687 2688 NegoCause:=Routine; 2689 case NegoTime of 2690 EnemyCalled: 2691 result:=true; 2692 EndOfTurn: 2693 if (Data.RejectTurn[suContact,Nation]>=0) 2694 and (Data.RejectTurn[suContact,Nation]+WaitAfterReject>=RO.Turn) then 2695 result:=false 2696 else if RO.Treaty[Nation]<trPeace then 2697 result:=(Data.RejectTurn[suPeace,Nation]<0) 2698 or (Data.RejectTurn[suPeace,Nation]+WaitAfterReject<RO.Turn) 2699 else if RO.Treaty[Nation]=trPeace then 2700 result:= (Data.BehaviorFlags and bBarbarina=0) 2701 and ((Data.RejectTurn[suFriendly,Nation]<0) 2702 or (Data.RejectTurn[suFriendly,Nation]+WaitAfterReject<RO.Turn)) 2703 else 2704 begin 2705 FindBestTrade(Nation,adWanted,adGiveAway); 2706 result:= adWanted>=0; 2707 end; 2708 BeginOfTurn: 2709 if (Data.RejectTurn[suContact,Nation]>=0) 2710 and (Data.RejectTurn[suContact,Nation]+WaitAfterReject>=RO.Turn) then 2711 result:=false 2712 else if (Data.BehaviorFlags and bGender=bMale) and Barbarina_WantCheckNegotiation(Nation) then 2713 begin NegoCause:=CheckBarbarina; result:=true; end 2714 else result:=false; 2715 end; 2716 end; 2717 2718 procedure TAI.DoNegotiation; 2719 var 2720 i, adWanted, adGiveAway, adToGet, Slot: integer; 2721 BuildFreeOffer: boolean; 2722 begin 2723 if MyLastAction=scDipOffer then 2724 if OppoAction=scDipAccept then 2725 begin // evaluate accepted offers 2726 AdvanceValuesSet:=false; 2727 if (MyLastOffer.nDeliver=1) and (MyLastOffer.nCost>0) 2728 and (MyLastOffer.Price[1]=opTech+adTheology) then 2729 Data.TheologyPartner:=Opponent; 2730 end 583 2731 else 584 result := gDespotism 2732 begin // evaluate rejected offers 2733 if MyLastOffer.nDeliver+MyLastOffer.nCost=1 then 2734 if MyLastOffer.Price[0]=opTreaty+trPeace then 2735 Data.RejectTurn[suPeace,Opponent]:=RO.Turn 2736 else if MyLastOffer.Price[0]=opTreaty+trFriendlyContact then 2737 Data.RejectTurn[suFriendly,Opponent]:=RO.Turn; 2738 end; 2739 if OppoAction=scDipBreak then 2740 Data.RejectTurn[suContact,Opponent]:=RO.Turn 2741 else if OppoAction=scDipCancelTreaty then 2742 begin 2743 case RO.Treaty[Opponent] of 2744 trNone: Data.RejectTurn[suPeace,Opponent]:=RO.Turn; 2745 trPeace: Data.RejectTurn[suFriendly,Opponent]:=RO.Turn; 2746 end; 2747 end; 2748 2749 if Data.BehaviorFlags and bBarbarina=bBarbarina then 2750 begin Barbarina_DoNegotiation; exit end; 2751 2752 if NegoCause=CheckBarbarina then 2753 begin Barbarina_DoCheckNegotiation; exit end; 2754 2755 SetAdvanceValues; // in case no turn played after loading this game 2756 2757 BuildFreeOffer:=false; 2758 if (OppoAction=scDipStart) or (OppoAction=scDipAccept) then 2759 BuildFreeOffer:=true 2760 else if (OppoAction=scDipOffer) and (OppoOffer.nDeliver+OppoOffer.nCost=0) then 2761 BuildFreeOffer:=true 2762 else if OppoAction=scDipOffer then 2763 begin 2764 if (Data.BehaviorFlags and bBarbarina=0) 2765 and (OppoOffer.nDeliver+OppoOffer.nCost=1) 2766 and (OppoOffer.Price[0] and opMask=opTreaty) 2767 and (integer(OppoOffer.Price[0]-opTreaty)>RO.Treaty[Opponent]) 2768 and ((OppoOffer.Price[0]-opTreaty<trAlliance) or (RO.Tech[adScience]>=tsSeen)) then 2769 MyAction:=scDipAccept // accept all treaties 2770 else if (RO.Treaty[Opponent]>=trPeace) 2771 and (OppoOffer.nDeliver=1) 2772 and (OppoOffer.Price[0] and $FFFF0000=opCivilReport+cardinal(Opponent) shl 16) 2773 and (OppoOffer.nCost=1) 2774 and (OppoOffer.Price[1] and $FFFF0000=opCivilReport+cardinal(me) shl 16) then 2775 MyAction:=scDipAccept // accept exchange of civil reports 2776 else if (OppoOffer.nDeliver=1) and (OppoOffer.nCost=1) 2777 and (OppoOffer.Price[1] and opMask=opTech) then 2778 begin // opponent wants tech 2779 BuildFreeOffer:=true; 2780 adGiveAway:=OppoOffer.Price[1]-opTech; 2781 if (OppoOffer.Price[0] and opMask=opTech) 2782 and (MyLastAction=scDipOffer) 2783 and (MyLastOffer.nDeliver=1) and (MyLastOffer.nCost=1) 2784 and (OppoOffer.Price[0]=MyLastOffer.Price[1]) then 2785 begin // opponent makes counter offer, check whether to accept 2786 adToGet:=OppoOffer.Price[0]-opTech; 2787 if (adGiveAway=adTheRepublic) and (Data.BehaviorFlags and bGender=bFemale) 2788 and (RO.Tech[adTheology]<tsSeen) then 2789 begin 2790 if adToGet=adTheology then MyAction:=scDipAccept; 2791 end 2792 else if (RO.Tech[adGiveAway]>=tsApplicable) and (RO.Tech[adToGet]<tsSeen) 2793 and (AdvanceValue[adToGet]>0) 2794 and ((Advancedness[adGiveAway]<=Advancedness[adToGet] 2795 +AdvanceValue[adToGet] shr 8+Compromise) 2796 or (adGiveAway=adScience) and (Opponent=Data.TheologyPartner)) then 2797 MyAction:=scDipAccept 2798 end 2799 else if (OppoOffer.Price[0] and opMask=opChoose) 2800 or (OppoOffer.Price[0] and opMask=opTech) then 2801 begin // choose price 2802 adWanted:=MostWanted(Opponent,OppoOffer.Price[1]-opTech); 2803 if (OppoOffer.Price[0] and opMask=opTech) 2804 and (Cardinal(adWanted)=OppoOffer.Price[0]-opTech) then 2805 MyAction:=scDipAccept // opponent's offer is already perfect 2806 else if adWanted>=0 then 2807 begin // make improved counter offer 2808 MyOffer.nDeliver:=1; 2809 MyOffer.nCost:=1; 2810 MyOffer.Price[0]:=OppoOffer.Price[1]; 2811 MyOffer.Price[1]:=opTech+adWanted; 2812 MyAction:=scDipOffer; 2813 BuildFreeOffer:=false 2814 end 2815 end; 2816 if MyAction=scDipAccept then BuildFreeOffer:=false 2817 end 2818 else BuildFreeOffer:=true 2819 end; 2820 if (MyAction=scDipAccept) and (OppoAction=scDipOffer) then 2821 begin 2822 AdvanceValuesSet:=false; 2823 if (OppoOffer.nDeliver>0) and (OppoOffer.Price[0]=opTech+adTheology) then 2824 Data.TheologyPartner:=Opponent 2825 end; 2826 2827 if BuildFreeOffer then 2828 begin 2829 if (Data.BehaviorFlags and bBarbarina=0) 2830 and (RO.Treaty[Opponent]<trPeace) 2831 and ((Data.RejectTurn[suPeace,Opponent]<0) 2832 or (Data.RejectTurn[suPeace,Opponent]+WaitAfterReject<RO.Turn)) then 2833 begin 2834 MyOffer.nDeliver:=1; 2835 MyOffer.nCost:=0; 2836 MyOffer.Price[0]:=opTreaty+trPeace; 2837 MyAction:=scDipOffer 2838 end 2839 else if (Data.BehaviorFlags and bBarbarina=0) 2840 and (RO.Treaty[Opponent]=trPeace) 2841 and ((Data.RejectTurn[suFriendly,Opponent]<0) 2842 or (Data.RejectTurn[suFriendly,Opponent]+WaitAfterReject<RO.Turn)) then 2843 begin 2844 MyOffer.nDeliver:=1; 2845 MyOffer.nCost:=0; 2846 MyOffer.Price[0]:=opTreaty+trFriendlyContact; 2847 MyAction:=scDipOffer 2848 end 2849 else 2850 begin 2851 FindBestTrade(Opponent, adWanted, adGiveAway); 2852 if adWanted>=0 then 2853 begin 2854 MyOffer.nDeliver:=1; 2855 MyOffer.nCost:=1; 2856 MyOffer.Price[0]:=opTech+adGiveAway; 2857 MyOffer.Price[1]:=opTech+adWanted; 2858 MyAction:=scDipOffer; 2859 for i:=0 to nRequestedTechs-1 do 2860 if Data.RequestedTechs[i]<0 then 2861 begin Slot:=i; break end 2862 else if (i=0) or (Data.RequestedTechs[i] shr 16 2863 <Data.RequestedTechs[Slot] shr 16) then // find most outdated entry 2864 Slot:=i; 2865 Data.RequestedTechs[Slot]:=RO.Turn shl 16+Opponent shl 8+adWanted 2866 end 2867 end 2868 end; 2869 end; // Negotiation 2870 2871 2872 procedure SetLeaveOutValue; 2873 procedure Process(ad: integer); 2874 var 2875 i: integer; 2876 begin 2877 if LeaveOutValue[ad]<0 then 2878 begin 2879 LeaveOutValue[ad]:=0; 2880 for i:=0 to 1 do if AdvPreq[ad,i]>=0 then 2881 begin 2882 Process(AdvPreq[ad,i]); 2883 if AdvPreq[ad,i] in LeaveOutTechs then 2884 inc(LeaveOutValue[ad], LeaveOutValue[AdvPreq[ad,i]]+1) 2885 end 2886 end 2887 end; 2888 var 2889 ad: integer; 2890 begin 2891 FillChar(LeaveOutValue,SizeOf(LeaveOutValue),$FF); 2892 for ad:=0 to nAdv-5 do Process(ad); 585 2893 end; 586 2894 587 2895 588 // ------------------------------- 589 // DIPLOMACY 590 // ------------------------------- 591 592 function TAI.WantNegotiation(Nation: integer; NegoTime: TNegoTime): boolean; 593 begin 594 result := (NegoTime = EnemyCalled) // always accept contact 595 or (NegoTime = EndOfTurn) and (RO.Turn mod 20 = Nation + me) 596 // ask for contact only once in 20 turns 597 end; 598 599 procedure TAI.DoNegotiation; 600 begin 601 if (RO.Treaty[Opponent] < trPeace) and Odd(me + Opponent) then 602 // make peace with some random nations 603 if (OppoAction = scDipOffer) and (OppoOffer.nCost = 0) and 604 (OppoOffer.nDeliver = 1) and (OppoOffer.Price[0] = opTreaty + trPeace) 605 then 606 MyAction := scDipAccept // accept peace 607 else if OppoAction = scDipStart then 608 begin 609 MyOffer.nCost := 0; 610 MyOffer.nDeliver := 1; 611 MyOffer.Price[0] := opTreaty + trPeace; 612 // offer peace in exchange of nothing 613 MyAction := scDipOffer; 614 end 615 end; 2896 initialization 2897 RWDataSize:=sizeof(TPersistentData); 2898 SetLeaveOutValue; 616 2899 617 2900 end. 2901 -
trunk/AI/StdAI/CustomAI.pas
r124 r160 5 5 6 6 uses 7 {$IFDEF DEBUG}SysUtils, 7 {$IFDEF DEBUG}SysUtils,{$ENDIF} // necessary for debug exceptions 8 8 Protocol; 9 9 10 10 type 11 TNegoTime = (BeginOfTurn, EndOfTurn, EnemyCalled); 12 13 TCustomAI = class 14 public 15 procedure Process(Command: integer; var Data); 16 17 // overridables 18 constructor Create(Nation: integer); virtual; 19 destructor Destroy; override; 20 procedure SetDataDefaults; virtual; 21 procedure SetDataRandom; virtual; 22 procedure OnBeforeEnemyAttack(UnitInfo: TUnitInfo; 23 ToLoc, EndHealth, EndHealthDef: integer); virtual; 24 procedure OnBeforeEnemyCapture(UnitInfo: TUnitInfo; 25 ToLoc: integer); virtual; 26 procedure OnAfterEnemyAttack; virtual; 27 procedure OnAfterEnemyCapture; virtual; 28 29 protected 30 me: integer; // index of the controlled nation 31 RO: ^TPlayerContext; 32 Map: ^TTileList; 33 MyUnit: ^TUnList; 34 MyCity: ^TCityList; 35 MyModel: ^TModelList; 36 37 cixStateImp: array [imPalace .. imSpacePort] of integer; 38 39 // negotiation 40 Opponent: integer; 41 // nation i'm in negotiation with, -1 indicates no-negotiation mode 42 MyAction, MyLastAction, OppoAction: integer; 43 MyOffer, MyLastOffer, OppoOffer: TOffer; 44 45 // overridables 46 procedure DoTurn; virtual; 47 procedure DoNegotiation; virtual; 48 function ChooseResearchAdvance: integer; virtual; 49 function ChooseStealAdvance: integer; virtual; 50 function ChooseGovernment: integer; virtual; 51 function WantNegotiation(Nation: integer; NegoTime: TNegoTime) 52 : boolean; virtual; 53 function OnNegoRejected_CancelTreaty: boolean; virtual; 54 55 // general functions 56 function IsResearched(Advance: integer): boolean; 57 function ResearchCost: integer; 58 function ChangeAttitude(Nation, Attitude: integer): integer; 59 function Revolution: integer; 60 function ChangeRates(Tax, Lux: integer): integer; 61 function PrepareNewModel(Domain: integer): integer; 62 function SetNewModelFeature(F, Count: integer): integer; 63 function AdvanceResearchable(Advance: integer): boolean; 64 function AdvanceStealable(Advance: integer): boolean; 65 function GetJobProgress(Loc: integer; 66 var JobProgress: TJobProgressData): boolean; 67 function DebugMessage(Level: integer; Text: string): boolean; 68 function SetDebugMap(var DebugMap): boolean; 69 70 // unit functions 71 procedure Unit_FindMyDefender(Loc: integer; var uix: integer); 72 procedure Unit_FindEnemyDefender(Loc: integer; var euix: integer); 73 function Unit_Move(uix, ToLoc: integer): integer; 74 function Unit_Step(uix, ToLoc: integer): integer; 75 function Unit_Attack(uix, ToLoc: integer): integer; 76 function Unit_DoMission(uix, MissionType, ToLoc: integer): integer; 77 function Unit_MoveForecast(uix, ToLoc: integer; 78 var RemainingMovement: integer): boolean; 79 function Unit_AttackForecast(uix, ToLoc, AttackMovement: integer; 80 var RemainingHealth: integer): boolean; 81 function Unit_DefenseForecast(euix, ToLoc: integer; 82 var RemainingHealth: integer): boolean; 83 function Unit_Disband(uix: integer): integer; 84 function Unit_StartJob(uix, NewJob: integer): integer; 85 function Unit_SetHomeHere(uix: integer): integer; 86 function Unit_Load(uix: integer): integer; 87 function Unit_Unload(uix: integer): integer; 88 function Unit_SelectTransport(uix: integer): integer; 89 function Unit_AddToCity(uix: integer): integer; 90 91 // city functions 92 procedure City_FindMyCity(Loc: integer; var cix: integer); 93 procedure City_FindEnemyCity(Loc: integer; var ecix: integer); 94 function City_HasProject(cix: integer): boolean; 95 function City_CurrentImprovementProject(cix: integer): integer; 96 function City_CurrentUnitProject(cix: integer): integer; 97 function City_GetTileInfo(cix, TileLoc: integer; 98 var TileInfo: TTileInfo): integer; 99 function City_GetReport(cix: integer; var Report: TCityReport): integer; 100 function City_GetHypoReport(cix, HypoTiles, HypoTax, HypoLux: integer; 101 var Report: TCityReport): integer; 102 function City_GetReportNew(cix: integer; 103 var Report: TCityReportNew): integer; 104 function City_GetHypoReportNew(cix, HypoTiles, HypoTaxRate, 105 HypoLuxuryRate: integer; var Report: TCityReportNew): integer; 106 function City_GetAreaInfo(cix: integer; 107 var AreaInfo: TCityAreaInfo): integer; 108 function City_StartUnitProduction(cix, mix: integer): integer; 109 function City_StartEmigration(cix, mix: integer; 110 AllowDisbandCity, AsConscripts: boolean): integer; 111 function City_StartImprovement(cix, iix: integer): integer; 112 function City_Improvable(cix, iix: integer): boolean; 113 function City_StopProduction(cix: integer): integer; 114 function City_BuyProject(cix: integer): integer; 115 function City_SellImprovement(cix, iix: integer): integer; 116 function City_RebuildImprovement(cix, iix: integer): integer; 117 function City_SetTiles(cix, NewTiles: integer): integer; 118 procedure City_OptimizeTiles(cix: integer; 119 ResourceWeights: integer = rwMaxGrowth); 120 121 // negotiation 122 function Nego_CheckMyAction: integer; 123 124 private 125 HaveTurned: boolean; 126 UnwantedNego: set of 0 .. nPl - 1; 127 Contacted: set of 0 .. nPl - 1; 128 procedure StealAdvance; 11 TNegoTime=(BeginOfTurn, EndOfTurn, EnemyCalled); 12 13 TCustomAI=class 14 public 15 procedure Process(Command: integer; var Data); 16 17 // overridables 18 constructor Create(Nation: integer); virtual; 19 destructor Destroy; override; 20 procedure SetDataDefaults; virtual; 21 procedure SetDataRandom; virtual; 22 procedure OnBeforeEnemyAttack(UnitInfo: TUnitInfo; 23 ToLoc, EndHealth, EndHealthDef: integer); virtual; 24 procedure OnBeforeEnemyCapture(UnitInfo: TUnitInfo; ToLoc: integer); virtual; 25 procedure OnAfterEnemyAttack; virtual; 26 procedure OnAfterEnemyCapture; virtual; 27 28 protected 29 me: integer; // index of the controlled nation 30 RO: ^TPlayerContext; 31 Map: ^TTileList; 32 MyUnit: ^TUnList; 33 MyCity: ^TCityList; 34 MyModel: ^TModelList; 35 36 cixStateImp: array[imPalace..imSpacePort] of integer; 37 38 // negotiation 39 Opponent: integer; // nation i'm in negotiation with, -1 indicates no-negotiation mode 40 MyAction, MyLastAction, OppoAction: integer; 41 MyOffer, MyLastOffer, OppoOffer: TOffer; 42 43 // overridables 44 procedure DoTurn; virtual; 45 procedure DoNegotiation; virtual; 46 function ChooseResearchAdvance: integer; virtual; 47 function ChooseStealAdvance: integer; virtual; 48 function ChooseGovernment: integer; virtual; 49 function WantNegotiation(Nation: integer; NegoTime: TNegoTime): boolean; virtual; 50 function OnNegoRejected_CancelTreaty: boolean; virtual; 51 52 // general functions 53 function IsResearched(Advance: integer): boolean; 54 function ResearchCost: integer; 55 function ChangeAttitude(Nation, Attitude: integer): integer; 56 function Revolution: integer; 57 function ChangeRates(Tax,Lux: integer): integer; 58 function PrepareNewModel(Domain: integer): integer; 59 function SetNewModelFeature(F, Count: integer): integer; 60 function AdvanceResearchable(Advance: integer): boolean; 61 function AdvanceStealable(Advance: integer): boolean; 62 function GetJobProgress(Loc: integer; var JobProgress: TJobProgressData): boolean; 63 function DebugMessage(Level: integer; Text: string): boolean; 64 function SetDebugMap(var DebugMap): boolean; 65 66 // unit functions 67 procedure Unit_FindMyDefender(Loc: integer; var uix: integer); 68 procedure Unit_FindEnemyDefender(Loc: integer; var euix: integer); 69 function Unit_Move(uix,ToLoc: integer): integer; 70 function Unit_Step(uix,ToLoc: integer): integer; 71 function Unit_Attack(uix,ToLoc: integer): integer; 72 function Unit_DoMission(uix,MissionType,ToLoc: integer): integer; 73 function Unit_MoveForecast(uix,ToLoc: integer; var RemainingMovement: integer): boolean; 74 function Unit_AttackForecast(uix,ToLoc,AttackMovement: integer; var RemainingHealth: integer): boolean; 75 function Unit_DefenseForecast(euix,ToLoc: integer; var RemainingHealth: integer): boolean; 76 function Unit_Disband(uix: integer): integer; 77 function Unit_StartJob(uix,NewJob: integer): integer; 78 function Unit_SetHomeHere(uix: integer): integer; 79 function Unit_Load(uix: integer): integer; 80 function Unit_Unload(uix: integer): integer; 81 function Unit_SelectTransport(uix: integer): integer; 82 function Unit_AddToCity(uix: integer): integer; 83 84 // city functions 85 procedure City_FindMyCity(Loc: integer; var cix: integer); 86 procedure City_FindEnemyCity(Loc: integer; var ecix: integer); 87 function City_HasProject(cix: integer): boolean; 88 function City_CurrentImprovementProject(cix: integer): integer; 89 function City_CurrentUnitProject(cix: integer): integer; 90 function City_GetTileInfo(cix,TileLoc: integer; var TileInfo: TTileInfo): integer; 91 function City_GetReport(cix: integer; var Report: TCityReport): integer; 92 function City_GetHypoReport(cix, HypoTiles, HypoTax, HypoLux: integer; var Report: TCityReport): integer; 93 function City_GetReportNew(cix: integer; var Report: TCityReportNew): integer; 94 function City_GetHypoReportNew(cix, HypoTiles, HypoTaxRate, HypoLuxuryRate: integer; var Report: TCityReportNew): integer; 95 function City_GetAreaInfo(cix: integer; var AreaInfo: TCityAreaInfo): integer; 96 function City_StartUnitProduction(cix,mix: integer): integer; 97 function City_StartEmigration(cix,mix: integer; AllowDisbandCity, AsConscripts: boolean): integer; 98 function City_StartImprovement(cix,iix: integer): integer; 99 function City_Improvable(cix,iix: integer): boolean; 100 function City_StopProduction(cix: integer): integer; 101 function City_BuyProject(cix: integer): integer; 102 function City_SellImprovement(cix,iix: integer): integer; 103 function City_RebuildImprovement(cix,iix: integer): integer; 104 function City_SetTiles(cix,NewTiles: integer): integer; 105 procedure City_OptimizeTiles(cix: integer; ResourceWeights: cardinal = rwMaxGrowth); 106 107 // negotiation 108 function Nego_CheckMyAction: integer; 109 110 private 111 HaveTurned: boolean; 112 UnwantedNego: set of 0..nPl-1; 113 Contacted: set of 0..nPl-1; 114 procedure StealAdvance; 129 115 end; 130 116 131 var 132 Server: TServerCall; 133 G: TNewGameData; 134 RWDataSize, MapSize: integer; 135 decompose24: cardinal; 136 nodata: pointer; 117 118 var 119 Server: TServerCall; 120 G: TNewGameData; 121 RWDataSize, MapSize: integer; 122 decompose24: cardinal; 123 nodata: pointer; 137 124 138 125 const 139 CityOwnTile = 13; // = ab_to_V21(0,0) 140 141 // additional return codes 142 rLocationReached = $00010000; 143 // Unit_Move: move was not interrupted, location reached 144 rMoreTurns = $00020000; 145 // Unit_Move: move was not interrupted, location not reached yet 126 CityOwnTile = 13; // = ab_to_V21(0,0) 127 128 // additional return codes 129 rLocationReached= $00010000; // Unit_Move: move was not interrupted, location reached 130 rMoreTurns= $00020000; // Unit_Move: move was not interrupted, location not reached yet 146 131 147 132 type 148 TVicinity8Loc = array [0 .. 7] of integer; 149 TVicinity21Loc = array [0 .. 27] of integer; 133 TVicinity8Loc=array[0..7] of integer; 134 TVicinity21Loc=array[0..27] of integer; 135 150 136 151 137 procedure Init(NewGameData: TNewGameData); 152 138 153 procedure ab_to_Loc(Loc0, a,b: integer; var Loc: integer);154 procedure Loc_to_ab(Loc0, Loc: integer; var a,b: integer);155 procedure ab_to_V8(a, 156 procedure V8_to_ab(V8: integer; var a, 157 procedure ab_to_V21(a, 158 procedure V21_to_ab(V21: integer; var a, 139 procedure ab_to_Loc(Loc0,a,b: integer; var Loc: integer); 140 procedure Loc_to_ab(Loc0,Loc: integer; var a,b: integer); 141 procedure ab_to_V8(a,b: integer; var V8: integer); 142 procedure V8_to_ab(V8: integer; var a,b: integer); 143 procedure ab_to_V21(a,b: integer; var V21: integer); 144 procedure V21_to_ab(V21: integer; var a,b: integer); 159 145 procedure V8_to_Loc(Loc0: integer; var VicinityLoc: TVicinity8Loc); 160 146 procedure V21_to_Loc(Loc0: integer; var VicinityLoc: TVicinity21Loc); 147 function Distance(Loc0,Loc1: integer): integer; 148 161 149 162 150 implementation 163 151 164 152 const 165 ab_v8: array [-4 .. 4] of integer = (5, 6, 7, 4, -1, 0, 3, 2, 1); 166 v8_a: array [0 .. 7] of integer = (1, 1, 0, -1, -1, -1, 0, 1); 167 v8_b: array [0 .. 7] of integer = (0, 1, 1, 1, 0, -1, -1, -1); 168 169 procedure ab_to_Loc(Loc0, a, b: integer; var Loc: integer); 170 { relative location from Loc0 } 171 var 172 y0: integer; 173 begin 174 assert((Loc0 >= 0) and (Loc0 < MapSize) and (a - b + G.lx >= 0)); 175 y0 := cardinal(Loc0) * decompose24 shr 24; 176 Loc := (Loc0 + (a - b + y0 and 1 + G.lx + G.lx) shr 1) mod G.lx + G.lx * 177 (y0 + a + b); 178 if Loc >= MapSize then 179 Loc := -$1000 180 end; 181 182 procedure Loc_to_ab(Loc0, Loc: integer; var a, b: integer); 153 ab_v8: array[-4..4] of integer = (5,6,7,4,-1,0,3,2,1); 154 v8_a: array[0..7] of integer = (1,1,0,-1,-1,-1,0,1); 155 v8_b: array[0..7] of integer = (0,1,1,1,0,-1,-1,-1); 156 157 158 procedure ab_to_Loc(Loc0,a,b: integer; var Loc: integer); 159 {relative location from Loc0} 160 var 161 y0: integer; 162 begin 163 assert((Loc0>=0) and (Loc0<MapSize) and (a-b+G.lx>=0)); 164 y0:=cardinal(Loc0)*decompose24 shr 24; 165 Loc:=(Loc0+(a-b+y0 and 1+G.lx+G.lx) shr 1) mod G.lx +G.lx*(y0+a+b); 166 if Loc>=MapSize then Loc:=-$1000 167 end; 168 169 procedure Loc_to_ab(Loc0,Loc: integer; var a,b: integer); 183 170 {$IFDEF FPC} // freepascal 184 171 var 185 dx,dy: integer;186 begin 187 dx := ((Loc mod G.lx * 2 + Loc div G.lx and 1) - 188 (Loc0 mod G.lx * 2 + Loc0 div G.lx and 1) + 3 * G.lx) mod (2 * G.lx) -G.lx;189 dy := Loc div G.lx -Loc0 div G.lx;190 a := (dx +dy) div 2;191 b := (dy -dx) div 2;172 dx,dy: integer; 173 begin 174 dx:=((Loc mod G.lx *2 +Loc div G.lx and 1) 175 -(Loc0 mod G.lx *2 +Loc0 div G.lx and 1)+3*G.lx) mod (2*G.lx) -G.lx; 176 dy:=Loc div G.lx-Loc0 div G.lx; 177 a:=(dx+dy) div 2; 178 b:=(dy-dx) div 2; 192 179 end; 193 180 {$ELSE} // delphi 194 181 register; 195 182 asm 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 183 push ebx 184 185 // calculate 186 push ecx 187 div byte ptr [G] 188 xor ebx,ebx 189 mov bl,ah // ebx:=Loc0 mod G.lx 190 mov ecx,eax 191 and ecx,$000000FF // ecx:=Loc0 div G.lx 192 mov eax,edx 193 div byte ptr [G] 194 xor edx,edx 195 mov dl,ah // edx:=Loc mod G.lx 196 and eax,$000000FF // eax:=Loc div G.lx 197 sub edx,ebx // edx:=Loc mod G.lx-Loc0 mod G.lx 198 mov ebx,eax 199 sub ebx,ecx // ebx:=dy 200 and eax,1 201 and ecx,1 202 add edx,edx 203 add eax,edx 204 sub eax,ecx // eax:=dx, not normalized 205 pop ecx 206 207 // normalize 208 mov edx,dword ptr [G] 209 cmp eax,edx 210 jl @a 224 211 sub eax,edx 225 212 sub eax,edx 226 213 jmp @ok 227 214 @a: 228 229 230 215 neg edx 216 cmp eax,edx 217 jnl @ok 231 218 sub eax,edx 232 219 sub eax,edx 233 220 234 221 // return results 235 222 @ok: 236 237 238 239 240 241 242 243 244 245 223 mov edx,ebx 224 sub edx,eax 225 add eax,ebx 226 sar edx,1 // edx:=b 227 mov ebx,[b] 228 mov [ebx],edx 229 sar eax,1 // eax:=a 230 mov [a],eax 231 232 pop ebx 246 233 end; 247 234 {$ENDIF} 248 235 249 procedure ab_to_V8(a, b: integer; var V8: integer); 250 begin 251 assert((abs(a) <= 1) and (abs(b) <= 1) and ((a <> 0) or (b <> 0))); 252 V8 := ab_v8[2 * b + b + a]; 253 end; 254 255 procedure V8_to_ab(V8: integer; var a, b: integer); 256 begin 257 a := v8_a[V8]; 258 b := v8_b[V8]; 259 end; 260 261 procedure ab_to_V21(a, b: integer; var V21: integer); 262 begin 263 V21 := (a + b + 3) shl 2 + (a - b + 3) shr 1; 264 end; 265 266 procedure V21_to_ab(V21: integer; var a, b: integer); 267 var 268 dx, dy: integer; 269 begin 270 dy := V21 shr 2 - 3; 271 dx := V21 and 3 shl 1 - 3 + (dy + 3) and 1; 272 a := (dx + dy) div 2; 273 b := (dy - dx) div 2; 236 procedure ab_to_V8(a,b: integer; var V8: integer); 237 begin 238 assert((abs(a)<=1) and (abs(b)<=1) and ((a<>0) or (b<>0))); 239 V8:=ab_v8[2*b+b+a]; 240 end; 241 242 procedure V8_to_ab(V8: integer; var a,b: integer); 243 begin 244 a:=v8_a[V8]; b:=V8_b[V8]; 245 end; 246 247 procedure ab_to_V21(a,b: integer; var V21: integer); 248 begin 249 V21:=(a+b+3) shl 2+(a-b+3) shr 1; 250 end; 251 252 procedure V21_to_ab(V21: integer; var a,b: integer); 253 var 254 dx,dy: integer; 255 begin 256 dy:=V21 shr 2-3; 257 dx:=V21 and 3 shl 1 -3 + (dy+3) and 1; 258 a:=(dx+dy) div 2; 259 b:=(dy-dx) div 2; 274 260 end; 275 261 276 262 procedure V8_to_Loc(Loc0: integer; var VicinityLoc: TVicinity8Loc); 277 263 var 278 x0, y0,lx: integer;279 begin 280 lx :=G.lx;281 y0 := cardinal(Loc0) *decompose24 shr 24;282 x0 := Loc0 - y0 *lx; // Loc0 mod lx;283 VicinityLoc[1] := Loc0 + lx *2;284 VicinityLoc[3] := Loc0 -1;285 VicinityLoc[5] := Loc0 - lx *2;286 VicinityLoc[7] := Loc0 +1;287 inc(Loc0,y0 and 1);288 VicinityLoc[0] := Loc0 +lx;289 VicinityLoc[2] := Loc0 + lx -1;290 VicinityLoc[4] := Loc0 - lx -1;291 VicinityLoc[6] := Loc0 -lx;292 293 294 if x0 < lx -1 then264 x0,y0,lx: integer; 265 begin 266 lx:=G.lx; 267 y0:=cardinal(Loc0)*decompose24 shr 24; 268 x0:=Loc0-y0*lx; // Loc0 mod lx; 269 VicinityLoc[1]:=Loc0+lx*2; 270 VicinityLoc[3]:=Loc0-1; 271 VicinityLoc[5]:=Loc0-lx*2; 272 VicinityLoc[7]:=Loc0+1; 273 inc(Loc0,y0 and 1); 274 VicinityLoc[0]:=Loc0+lx; 275 VicinityLoc[2]:=Loc0+lx-1; 276 VicinityLoc[4]:=Loc0-lx-1; 277 VicinityLoc[6]:=Loc0-lx; 278 279 // world is round! 280 if x0<lx-1 then 295 281 begin 296 if x0 =0 then282 if x0=0 then 297 283 begin 298 inc(VicinityLoc[3],lx);299 if y0 and 1 =0 then284 inc(VicinityLoc[3],lx); 285 if y0 and 1=0 then 300 286 begin 301 inc(VicinityLoc[2],lx);302 inc(VicinityLoc[4],lx);287 inc(VicinityLoc[2],lx); 288 inc(VicinityLoc[4],lx); 303 289 end 304 290 end 305 291 end 306 292 else 307 293 begin 308 dec(VicinityLoc[7],lx);309 if y0 and 1 =1 then294 dec(VicinityLoc[7],lx); 295 if y0 and 1=1 then 310 296 begin 311 dec(VicinityLoc[0],lx);312 dec(VicinityLoc[6],lx);297 dec(VicinityLoc[0],lx); 298 dec(VicinityLoc[6],lx); 313 299 end 314 300 end; 315 301 316 // check south pole 317 case G.ly - y0 of 318 1: 302 // check south pole 303 case G.ly-y0 of 304 1: 305 begin 306 VicinityLoc[0]:=-$1000; 307 VicinityLoc[1]:=-$1000; 308 VicinityLoc[2]:=-$1000; 309 end; 310 2: VicinityLoc[1]:=-$1000; 311 end 312 end; 313 314 procedure V21_to_Loc(Loc0: integer; var VicinityLoc: TVicinity21Loc); 315 var 316 dx,dy,bit,y0,xComp,yComp,xComp0,xCompSwitch: integer; 317 dst: ^integer; 318 begin 319 y0:=cardinal(Loc0)*decompose24 shr 24; 320 xComp0:=Loc0-y0*G.lx-1; // Loc0 mod G.lx -1 321 xCompSwitch:=xComp0-1+y0 and 1; 322 if xComp0<0 then inc(xComp0,G.lx); 323 if xCompSwitch<0 then inc(xCompSwitch,G.lx); 324 xCompSwitch:=xCompSwitch xor xComp0; 325 yComp:=G.lx*(y0-3); 326 dst:=@VicinityLoc; 327 bit:=1; 328 for dy:=0 to 6 do 329 if yComp<MapSize then 330 begin 331 xComp0:=xComp0 xor xCompSwitch; 332 xComp:=xComp0; 333 for dx:=0 to 3 do 319 334 begin 320 VicinityLoc[0] := -$1000; 321 VicinityLoc[1] := -$1000; 322 VicinityLoc[2] := -$1000; 335 if bit and $67F7F76<>0 then dst^:=xComp+yComp 336 else dst^:=-1; 337 inc(xComp); 338 if xComp>=G.lx then dec(xComp, G.lx); 339 inc(dst); 340 bit:=bit shl 1; 323 341 end; 324 2: 325 VicinityLoc[1] := -$1000; 326 end 327 end; 328 329 procedure V21_to_Loc(Loc0: integer; var VicinityLoc: TVicinity21Loc); 330 var 331 dx, dy, bit, y0, xComp, yComp, xComp0, xCompSwitch: integer; 332 dst: ^integer; 333 begin 334 y0 := cardinal(Loc0) * decompose24 shr 24; 335 xComp0 := Loc0 - y0 * G.lx - 1; // Loc0 mod G.lx -1 336 xCompSwitch := xComp0 - 1 + y0 and 1; 337 if xComp0 < 0 then 338 inc(xComp0, G.lx); 339 if xCompSwitch < 0 then 340 inc(xCompSwitch, G.lx); 341 xCompSwitch := xCompSwitch xor xComp0; 342 yComp := G.lx * (y0 - 3); 343 dst := @VicinityLoc; 344 bit := 1; 345 for dy := 0 to 6 do 346 if yComp < MapSize then 342 inc(yComp,G.lx); 343 end 344 else 347 345 begin 348 xComp0 := xComp0 xor xCompSwitch; 349 xComp := xComp0; 350 for dx := 0 to 3 do 346 for dx:=0 to 3 do 347 begin dst^:=-$1000; inc(dst); end; 348 end 349 end; 350 351 function Distance(Loc0,Loc1: integer): integer; 352 var 353 a,b,dx,dy: integer; 354 begin 355 Loc_to_ab(Loc0,Loc1,a,b); 356 dx:=abs(a-b); 357 dy:=abs(a+b); 358 result:=dx+dy+abs(dx-dy) shr 1; 359 end; 360 361 362 procedure Init(NewGameData: TNewGameData); 363 {$IFDEF DEBUG}var Loc: integer;{$ENDIF} 364 begin 365 G:=NewGameData; 366 MapSize:=G.lx*G.ly; 367 decompose24:=(1 shl 24-1) div G.lx +1; 368 {$IFDEF DEBUG}for Loc:=0 to MapSize-1 do assert(cardinal(Loc)*decompose24 shr 24=cardinal(Loc div G.lx));{$ENDIF} 369 end; 370 371 372 constructor TCustomAI.Create(Nation: integer); 373 begin 374 inherited Create; 375 me:=Nation; 376 RO:=pointer(G.RO[Nation]); 377 Map:=pointer(RO.Map); 378 MyUnit:=pointer(RO.Un); 379 MyCity:=pointer(RO.City); 380 MyModel:=pointer(RO.Model); 381 Opponent:=-1; 382 end; 383 384 destructor TCustomAI.Destroy; 385 begin 386 Server(sSetDebugMap,me,0,nodata^); 387 end; 388 389 390 procedure TCustomAI.Process(Command: integer; var Data); 391 var 392 Nation,NewResearch,NewGov,count,ad,cix,iix: integer; 393 NegoTime: TNegoTime; 394 begin 395 case Command of 396 cTurn, cContinue: 397 begin 398 if RO.Alive and (1 shl me)=0 then 399 begin // I'm dead, huhu 400 Server(sTurn,me,0,nodata^); 401 exit 402 end; 403 if Command=cTurn then 351 404 begin 352 if bit and $67F7F76 <> 0 then 353 dst^ := xComp + yComp 354 else 355 dst^ := -1; 356 inc(xComp); 357 if xComp >= G.lx then 358 dec(xComp, G.lx); 359 inc(dst); 360 bit := bit shl 1; 405 fillchar(cixStateImp, sizeof(cixStateImp), $FF); 406 for cix:=0 to RO.nCity-1 do if MyCity[cix].Loc>=0 then 407 for iix:=imPalace to imSpacePort do 408 if MyCity[cix].Built[iix]>0 then 409 cixStateImp[iix]:=cix; 410 if RO.Happened and phChangeGov<>0 then 411 begin 412 NewGov:=ChooseGovernment; 413 if NewGov>gAnarchy then 414 Server(sSetGovernment,me,NewGov,nodata^); 415 end; 416 HaveTurned:=false; 417 Contacted:=[]; 361 418 end; 362 inc(yComp, G.lx); 363 end 419 if (Command=cContinue) and (MyAction=scContact) then 420 begin 421 if OnNegoRejected_CancelTreaty then 422 if RO.Treaty[Opponent]>=trPeace then 423 if Server(sCancelTreaty,me,0,nodata^)<rExecuted then 424 assert(false) 425 end 426 else UnwantedNego:=[]; 427 Opponent:=-1; 428 repeat 429 if HaveTurned then NegoTime:=EndOfTurn 430 else NegoTime:=BeginOfTurn; 431 if RO.Government<>gAnarchy then 432 for Nation:=0 to nPl-1 do 433 if (Nation<>me) and (1 shl Nation and RO.Alive<>0) 434 and (RO.Treaty[Nation]>=trNone) 435 and not (Nation in Contacted) and not (Nation in UnwantedNego) 436 and (Server(scContact-sExecute + Nation shl 4, me, 0, nodata^)>=rExecuted) then 437 if WantNegotiation(Nation, NegoTime) then 438 begin 439 if Server(scContact + Nation shl 4, me, 0, nodata^)>=rExecuted then 440 begin 441 include(Contacted, Nation); 442 Opponent:=Nation; 443 MyAction:=scContact; 444 exit; 445 end; 446 end 447 else include(UnwantedNego,Nation); 448 if NegoTime=BeginOfTurn then 449 begin 450 DoTurn; 451 HaveTurned:=true; 452 Contacted:=[]; 453 UnwantedNego:=[]; 454 end 455 else break; 456 until false; 457 if RO.Happened and phTech<>0 then 458 begin 459 NewResearch:=ChooseResearchAdvance; 460 if NewResearch<0 then 461 begin // choose random research 462 count:=0; 463 for ad:=0 to nAdv-1 do if AdvanceResearchable(ad) then 464 begin inc(count); if random(count)=0 then NewResearch:=ad end 465 end; 466 Server(sSetResearch,me,NewResearch,nodata^) 467 end; 468 if Server(sTurn,me,0,nodata^)<rExecuted then 469 assert(false); 470 end; 471 scContact: 472 if WantNegotiation(integer(Data), EnemyCalled) then 473 begin 474 if Server(scDipStart, me, 0, nodata^)<rExecuted then 475 assert(false); 476 Opponent:=integer(Data); 477 MyAction:=scDipStart; 478 end 364 479 else 480 begin 481 if Server(scReject, me, 0, nodata^)<rExecuted then 482 assert(false); 483 end; 484 scDipStart, scDipNotice, scDipAccept, scDipCancelTreaty, scDipOffer, scDipBreak: 365 485 begin 366 for dx := 0 to 3 do 486 OppoAction:=Command; 487 if Command=scDipOffer then OppoOffer:=TOffer(Data); 488 if Command=scDipStart then 489 MyLastAction:=scContact 490 else 367 491 begin 368 dst^ := -$1000;369 inc(dst);492 MyLastAction:=MyAction; 493 MyLastOffer:=MyOffer; 370 494 end; 371 end 372 end; 373 374 procedure Init(NewGameData: TNewGameData); 375 {$IFDEF DEBUG}var 376 Loc: integer; {$ENDIF} 377 begin 378 G := NewGameData; 379 MapSize := G.lx * G.ly; 380 decompose24 := (1 shl 24 - 1) div G.lx + 1; 381 {$IFDEF DEBUG} for Loc := 0 to MapSize - 1 do 382 assert(cardinal(Loc) * decompose24 shr 24 = cardinal(Loc div G.lx)); 383 {$ENDIF} 384 end; 385 386 constructor TCustomAI.Create(Nation: integer); 387 begin 388 inherited Create; 389 me := Nation; 390 RO := pointer(G.RO[Nation]); 391 Map := pointer(RO.Map); 392 MyUnit := pointer(RO.Un); 393 MyCity := pointer(RO.City); 394 MyModel := pointer(RO.Model); 395 Opponent := -1; 396 end; 397 398 destructor TCustomAI.Destroy; 399 begin 400 Server(sSetDebugMap, me, 0, nodata^); 401 end; 402 403 procedure TCustomAI.Process(Command: integer; var Data); 404 var 405 Nation, NewResearch, NewGov, Count, ad, cix, iix: integer; 406 NegoTime: TNegoTime; 407 begin 408 case Command of 409 cTurn, cContinue: 410 begin 411 if RO.Alive and (1 shl me) = 0 then 412 begin // I'm dead, huhu 413 Server(sTurn, me, 0, nodata^); 414 exit 415 end; 416 if Command = cTurn then 417 begin 418 fillchar(cixStateImp, sizeof(cixStateImp), $FF); 419 for cix := 0 to RO.nCity - 1 do 420 if MyCity[cix].Loc >= 0 then 421 for iix := imPalace to imSpacePort do 422 if MyCity[cix].Built[iix] > 0 then 423 cixStateImp[iix] := cix; 424 if RO.Happened and phChangeGov <> 0 then 425 begin 426 NewGov := ChooseGovernment; 427 if NewGov > gAnarchy then 428 Server(sSetGovernment, me, NewGov, nodata^); 429 end; 430 HaveTurned := false; 431 Contacted := []; 432 end; 433 if (Command = cContinue) and (MyAction = scContact) then 434 begin 435 if OnNegoRejected_CancelTreaty then 436 if RO.Treaty[Opponent] >= trPeace then 437 if Server(sCancelTreaty, me, 0, nodata^) < rExecuted then 438 assert(false) 439 end 440 else 441 UnwantedNego := []; 442 Opponent := -1; 443 repeat 444 if HaveTurned then 445 NegoTime := EndOfTurn 446 else 447 NegoTime := BeginOfTurn; 448 if RO.Government <> gAnarchy then 449 for Nation := 0 to nPl - 1 do 450 if (Nation <> me) and (1 shl Nation and RO.Alive <> 0) and 451 (RO.Treaty[Nation] >= trNone) and not(Nation in Contacted) and 452 not(Nation in UnwantedNego) and 453 (Server(scContact - sExecute + Nation shl 4, me, 0, nodata^) >= 454 rExecuted) then 455 if WantNegotiation(Nation, NegoTime) then 456 begin 457 if Server(scContact + Nation shl 4, me, 0, nodata^) >= rExecuted 458 then 459 begin 460 include(Contacted, Nation); 461 Opponent := Nation; 462 MyAction := scContact; 463 exit; 464 end; 465 end 466 else 467 include(UnwantedNego, Nation); 468 if NegoTime = BeginOfTurn then 469 begin 470 DoTurn; 471 HaveTurned := true; 472 Contacted := []; 473 UnwantedNego := []; 474 end 475 else 476 break; 477 until false; 478 if RO.Happened and phTech <> 0 then 479 begin 480 NewResearch := ChooseResearchAdvance; 481 if NewResearch < 0 then 482 begin // choose random research 483 Count := 0; 484 for ad := 0 to nAdv - 1 do 485 if AdvanceResearchable(ad) then 486 begin 487 inc(Count); 488 if random(Count) = 0 then 489 NewResearch := ad 490 end 491 end; 492 Server(sSetResearch, me, NewResearch, nodata^) 493 end; 494 if Server(sTurn, me, 0, nodata^) < rExecuted then 495 assert(false); 496 end; 497 scContact: 498 if WantNegotiation(integer(Data), EnemyCalled) then 499 begin 500 if Server(scDipStart, me, 0, nodata^) < rExecuted then 501 assert(false); 502 Opponent := integer(Data); 503 MyAction := scDipStart; 504 end 505 else 506 begin 507 if Server(scReject, me, 0, nodata^) < rExecuted then 508 assert(false); 509 end; 510 scDipStart, scDipNotice, scDipAccept, scDipCancelTreaty, scDipOffer, 511 scDipBreak: 512 begin 513 OppoAction := Command; 514 if Command = scDipOffer then 515 OppoOffer := TOffer(Data); 516 if Command = scDipStart then 517 MyLastAction := scContact 518 else 519 begin 520 MyLastAction := MyAction; 521 MyLastOffer := MyOffer; 522 end; 523 if (OppoAction = scDipCancelTreaty) or (OppoAction = scDipBreak) then 524 MyAction := scDipNotice 525 else 526 begin 527 MyAction := scDipOffer; 528 MyOffer.nDeliver := 0; 529 MyOffer.nCost := 0; 530 end; 531 DoNegotiation; 532 assert((MyAction = scDipNotice) or (MyAction = scDipAccept) or 533 (MyAction = scDipCancelTreaty) or (MyAction = scDipOffer) or 534 (MyAction = scDipBreak)); 535 if MyAction = scDipOffer then 536 Server(MyAction, me, 0, MyOffer) 537 else 538 Server(MyAction, me, 0, nodata^); 539 end; 540 cShowEndContact: 541 Opponent := -1; 495 if (OppoAction=scDipCancelTreaty) or (OppoAction=scDipBreak) then 496 MyAction:=scDipNotice 497 else begin MyAction:=scDipOffer; MyOffer.nDeliver:=0; MyOffer.nCost:=0; end; 498 DoNegotiation; 499 assert((MyAction=scDipNotice) or (MyAction=scDipAccept) 500 or (MyAction=scDipCancelTreaty) or (MyAction=scDipOffer) 501 or (MyAction=scDipBreak)); 502 if MyAction=scDipOffer then Server(MyAction, me, 0, MyOffer) 503 else Server(MyAction, me, 0, nodata^); 504 end; 505 cShowEndContact: 506 Opponent:=-1; 542 507 end; 543 508 end; 544 509 545 510 {$HINTS OFF} 546 547 511 procedure TCustomAI.SetDataDefaults; 548 512 begin … … 561 525 end; 562 526 563 procedure TCustomAI.OnBeforeEnemyAttack(UnitInfo: TUnitInfo; 564 ToLoc, EndHealth,EndHealthDef: integer);527 procedure TCustomAI.OnBeforeEnemyAttack(UnitInfo: TUnitInfo; ToLoc, EndHealth, 528 EndHealthDef: integer); 565 529 begin 566 530 end; … … 580 544 function TCustomAI.ChooseResearchAdvance: integer; 581 545 begin 582 result :=-1546 result:=-1 583 547 end; 584 548 585 549 function TCustomAI.ChooseStealAdvance: integer; 586 550 begin 587 result :=-1551 result:=-1 588 552 end; 589 553 590 554 function TCustomAI.ChooseGovernment: integer; 591 555 begin 592 result := gDespotism 593 end; 594 595 function TCustomAI.WantNegotiation(Nation: integer; 596 NegoTime: TNegoTime): boolean; 597 begin 598 result := false; 556 result:=gDespotism 557 end; 558 559 function TCustomAI.WantNegotiation(Nation: integer; NegoTime: TNegoTime): boolean; 560 begin 561 result:=false; 599 562 end; 600 563 601 564 function TCustomAI.OnNegoRejected_CancelTreaty: boolean; 602 565 begin 603 result :=false;566 result:=false; 604 567 end; 605 568 {$HINTS ON} … … 607 570 procedure TCustomAI.StealAdvance; 608 571 var 609 Steal, ad, Count: integer;610 begin 611 Steal :=ChooseStealAdvance;612 if Steal <0 then572 Steal, ad, count: integer; 573 begin 574 Steal:=ChooseStealAdvance; 575 if Steal<0 then 613 576 begin // choose random advance 614 Count := 0; 615 for ad := 0 to nAdv - 1 do 616 if AdvanceStealable(ad) then 617 begin 618 inc(Count); 619 if random(Count) = 0 then 620 Steal := ad 621 end 577 count:=0; 578 for ad:=0 to nAdv-1 do if AdvanceStealable(ad) then 579 begin inc(count); if random(count)=0 then Steal:=ad end 622 580 end; 623 if Steal >= 0 then 624 Server(sStealTech, me, Steal, nodata^); 625 RO.Happened := RO.Happened and not phStealTech 581 if Steal>=0 then Server(sStealTech,me,Steal,nodata^); 582 RO.Happened:=RO.Happened and not phStealTech 626 583 end; 627 584 628 585 function TCustomAI.IsResearched(Advance: integer): boolean; 629 586 begin 630 result := RO.Tech[Advance] >= tsApplicable 587 result:= (Advance=preNone) 588 or (Advance<>preNA) and (RO.Tech[Advance]>=tsApplicable) 631 589 end; 632 590 633 591 function TCustomAI.ResearchCost: integer; 634 592 begin 635 Server(sGetTechCost, me, 0,result)593 Server(sGetTechCost,me,0,result) 636 594 end; 637 595 638 596 function TCustomAI.ChangeAttitude(Nation, Attitude: integer): integer; 639 597 begin 640 result := Server(sSetAttitude + Nation shl 4, me, Attitude,nodata^)598 result:=Server(sSetAttitude+Nation shl 4,me,Attitude,nodata^) 641 599 end; 642 600 643 601 function TCustomAI.Revolution: integer; 644 602 begin 645 result := Server(sRevolution, me, 0, nodata^); 646 end; 647 648 function TCustomAI.ChangeRates(Tax, Lux: integer): integer; 649 begin 650 result := Server(sSetRates, me, Tax div 10 and $F + Lux div 10 and 651 $F shl 4, nodata^) 603 result:=Server(sRevolution,me,0,nodata^); 604 end; 605 606 function TCustomAI.ChangeRates(Tax,Lux: integer): integer; 607 begin 608 result:=Server(sSetRates,me,Tax div 10 and $f+Lux div 10 and $f shl 4,nodata^) 652 609 end; 653 610 654 611 function TCustomAI.PrepareNewModel(Domain: integer): integer; 655 612 begin 656 result := Server(sCreateDevModel, me, Domain,nodata^);613 result:=Server(sCreateDevModel,me,Domain,nodata^); 657 614 end; 658 615 659 616 function TCustomAI.SetNewModelFeature(F, Count: integer): integer; 660 617 begin 661 result := Server(sSetDevModelCap + Count shl 4, me, F,nodata^)618 result:=Server(sSetDevModelCap+Count shl 4,me,F,nodata^) 662 619 end; 663 620 664 621 function TCustomAI.AdvanceResearchable(Advance: integer): boolean; 665 622 begin 666 result := Server(sSetResearch - sExecute, me, Advance, nodata^) >=rExecuted;623 result:= Server(sSetResearch-sExecute,me,Advance,nodata^)>=rExecuted; 667 624 end; 668 625 669 626 function TCustomAI.AdvanceStealable(Advance: integer): boolean; 670 627 begin 671 result := Server(sStealTech - sExecute, me, Advance, nodata^) >= rExecuted; 672 end; 673 674 function TCustomAI.GetJobProgress(Loc: integer; 675 var JobProgress: TJobProgressData): boolean; 676 begin 677 result := Server(sGetJobProgress, me, Loc, JobProgress) >= rExecuted; 628 result:= Server(sStealTech-sExecute,me,Advance,nodata^)>=rExecuted; 629 end; 630 631 function TCustomAI.GetJobProgress(Loc: integer; var JobProgress: TJobProgressData): boolean; 632 begin 633 result:= Server(sGetJobProgress,me,Loc,JobProgress)>=rExecuted; 678 634 end; 679 635 680 636 function TCustomAI.DebugMessage(Level: integer; Text: string): boolean; 681 637 begin 682 Text := copy('P' + char(48 + me) + ' ' + Text, 1,254);683 Server(sMessage, me, Level,pchar(Text)^);684 685 result :=true;638 Text:=copy('P'+char(48+me)+' '+Text,1,254); 639 Server(sMessage,me,Level,pchar(Text)^); 640 641 result:=true; 686 642 // always returns true so that it can be used like 687 643 // "assert(DebugMessage(...));" -> not compiled in release build … … 690 646 function TCustomAI.SetDebugMap(var DebugMap): boolean; 691 647 begin 692 693 694 result :=true;648 Server(sSetDebugMap, me, 0, DebugMap); 649 650 result:=true; 695 651 // always returns true so that it can be used like 696 652 // "assert(SetDebugMap(...));" -> not compiled in release build … … 699 655 procedure TCustomAI.Unit_FindMyDefender(Loc: integer; var uix: integer); 700 656 begin 701 if Server(sGetDefender, me, Loc, uix) < rExecuted then 702 uix := -1 657 if Server(sGetDefender,me,Loc,uix)<rExecuted then uix:=-1 703 658 end; 704 659 705 660 procedure TCustomAI.Unit_FindEnemyDefender(Loc: integer; var euix: integer); 706 661 begin 707 euix := RO.nEnemyUn - 1; 708 while (euix >= 0) and (RO.EnemyUn[euix].Loc <> Loc) do 709 dec(euix); 710 end; 711 712 function TCustomAI.Unit_Move(uix, ToLoc: integer): integer; 713 var 714 Step: integer; 715 DestinationReached: boolean; 716 Advice: TMoveAdviceData; 717 begin 718 assert((uix >= 0) and (uix < RO.nUn) and (MyUnit[uix].Loc >= 0)); // is a unit 719 { Loc_to_ab(MyUnit[uix].Loc,ToLoc,a,b); 720 assert((a<>0) or (b<>0)); 721 if (a>=-1) and (a<=1) and (b>=-1) and (b<=1) then 722 begin // move to adjacent tile 723 !!!problem: if move is invalid, return codes are not consistent with other branch (eNoWay) 724 Advice.nStep:=1; 725 Advice.dx[0]:=a-b; 726 Advice.dy[0]:=a+b; 727 Advice.MoreTurns:=0; 728 Advice.MaxHostile_MovementLeft:=MyUnit[uix].Movement; 729 result:=eOK; 662 euix:=RO.nEnemyUn-1; 663 while (euix>=0) and (RO.EnemyUn[euix].Loc<>Loc) do 664 dec(euix); 665 end; 666 667 function TCustomAI.Unit_Move(uix,ToLoc: integer): integer; 668 var 669 Step: integer; 670 DestinationReached: boolean; 671 Advice: TMoveAdviceData; 672 begin 673 assert((uix>=0) and (uix<RO.nUn) and (MyUnit[uix].Loc>=0)); // is a unit 674 {Loc_to_ab(MyUnit[uix].Loc,ToLoc,a,b); 675 assert((a<>0) or (b<>0)); 676 if (a>=-1) and (a<=1) and (b>=-1) and (b<=1) then 677 begin // move to adjacent tile 678 !!!problem: if move is invalid, return codes are not consistent with other branch (eNoWay) 679 Advice.nStep:=1; 680 Advice.dx[0]:=a-b; 681 Advice.dy[0]:=a+b; 682 Advice.MoreTurns:=0; 683 Advice.MaxHostile_MovementLeft:=MyUnit[uix].Movement; 684 result:=eOK; 685 end 686 else} 687 begin // move to non-adjacent tile, find shortest path 688 Advice.ToLoc:=ToLoc; 689 Advice.MoreTurns:=9999; 690 Advice.MaxHostile_MovementLeft:=100; 691 result:=Server(sGetMoveAdvice,me,uix,Advice); 692 end; 693 if result=eOk then 694 begin 695 DestinationReached:=false; 696 Step:=0; 697 repeat 698 if result and (rExecuted or rUnitRemoved)=rExecuted then // check if destination reached 699 if (ToLoc>=0) and (Advice.MoreTurns=0) and (Step=Advice.nStep-1) 700 and ((Map[ToLoc] and (fUnit or fOwned)=fUnit) // attack 701 or (Map[ToLoc] and (fCity or fOwned)=fCity) 702 and ((MyModel[MyUnit[uix].mix].Domain<>dGround) // bombardment 703 or (MyModel[MyUnit[uix].mix].Flags and mdCivil<>0))) then // can't capture 704 begin DestinationReached:=true; break end // stop next to destination 705 else if Step=Advice.nStep then 706 DestinationReached:=true; // normal move -- stop at destination 707 708 if (Step=Advice.nStep) or (result<>eOK) and (result<>eLoaded) then 709 break; 710 711 result:=Server(sMoveUnit+(Advice.dx[Step] and 7) shl 4 +(Advice.dy[Step] and 7) shl 7, 712 me,uix,nodata^); 713 inc(Step); 714 if RO.Happened and phStealTech<>0 then StealAdvance; 715 until false; 716 if DestinationReached then 717 if Advice.nStep=25 then 718 result:=Unit_Move(uix,ToLoc) // Shinkansen 719 else if Advice.MoreTurns=0 then 720 result:=result or rLocationReached 721 else result:=result or rMoreTurns; 722 end 723 end; 724 725 function TCustomAI.Unit_Step(uix,ToLoc: integer): integer; 726 var 727 a,b: integer; 728 begin 729 Loc_to_ab(MyUnit[uix].Loc, ToLoc, a, b); 730 assert(((a<>0) or (b<>0)) and (a>=-1) and (a<=1) and (b>=-1) and (b<=1)); 731 result:=Server(sMoveUnit+((a-b) and 7) shl 4 +((a+b) and 7) shl 7, me, uix, nodata^); 732 if RO.Happened and phStealTech<>0 then StealAdvance; 733 end; 734 735 function TCustomAI.Unit_Attack(uix,ToLoc: integer): integer; 736 var 737 a,b: integer; 738 begin 739 assert((uix>=0) and (uix<RO.nUn) and (MyUnit[uix].Loc>=0) // is a unit 740 and ((Map[ToLoc] and (fUnit or fOwned)=fUnit) // is an attack 741 or (Map[ToLoc] and (fCity or fOwned)=fCity) 742 and (MyModel[MyUnit[uix].mix].Domain<>dGround))); // is a bombardment 743 Loc_to_ab(MyUnit[uix].Loc,ToLoc,a,b); 744 assert(((a<>0) or (b<>0)) and (a>=-1) and (a<=1) and (b>=-1) and (b<=1)); // attack to adjacent tile 745 result:=Server(sMoveUnit+(a-b) and 7 shl 4 +(a+b) and 7 shl 7,me,uix,nodata^); 746 end; 747 748 function TCustomAI.Unit_DoMission(uix,MissionType,ToLoc: integer): integer; 749 var 750 a,b: integer; 751 begin 752 result:=Server(sSetSpyMission + MissionType shl 4,me,0,nodata^); 753 if result>=rExecuted then 754 begin 755 assert((uix>=0) and (uix<RO.nUn) and (MyUnit[uix].Loc>=0) // is a unit 756 and (MyModel[MyUnit[uix].mix].Kind=mkDiplomat)); // is a commando 757 Loc_to_ab(MyUnit[uix].Loc,ToLoc,a,b); 758 assert(((a<>0) or (b<>0)) and (a>=-1) and (a<=1) and (b>=-1) and (b<=1)); // city must be adjacent 759 result:=Server(sMoveUnit-sExecute+(a-b) and 7 shl 4 +(a+b) and 7 shl 7,me,uix,nodata^); 760 if result=eMissionDone then 761 result:=Server(sMoveUnit+(a-b) and 7 shl 4 +(a+b) and 7 shl 7,me,uix,nodata^) 762 else if (result<>eNoTime_Move) and (result<>eTreaty) and (result<>eNoTurn) then 763 result:=eInvalid // not a special commando mission! 764 end 765 end; 766 767 function TCustomAI.Unit_MoveForecast(uix,ToLoc: integer; 768 var RemainingMovement: integer): boolean; 769 var 770 Advice: TMoveAdviceData; 771 begin 772 assert((uix>=0) and (uix<RO.nUn) and (MyUnit[uix].Loc>=0)); // is a unit 773 Advice.ToLoc:=ToLoc; 774 Advice.MoreTurns:=0; 775 Advice.MaxHostile_MovementLeft:=100; 776 if Server(sGetMoveAdvice,me,uix,Advice)=eOk then 777 begin 778 RemainingMovement:=Advice.MaxHostile_MovementLeft; 779 result:=true 780 end 781 else 782 begin 783 RemainingMovement:=-1; 784 result:=false 785 end 786 end; 787 788 // negative RemainingHealth is remaining helth of defender if lost 789 function TCustomAI.Unit_AttackForecast(uix,ToLoc,AttackMovement: integer; 790 var RemainingHealth: integer): boolean; 791 var 792 BattleForecast: TBattleForecast; 793 begin 794 assert((uix>=0) and (uix<RO.nUn) and (MyUnit[uix].Loc>=0) // is a unit 795 and (Map[ToLoc] and (fUnit or fOwned)=fUnit)); // is an attack 796 RemainingHealth:=-$100; 797 result:=false; 798 if AttackMovement>=0 then with MyUnit[uix] do 799 begin 800 BattleForecast.pAtt:=me; 801 BattleForecast.mixAtt:=mix; 802 BattleForecast.HealthAtt:=Health; 803 BattleForecast.ExpAtt:=Exp; 804 BattleForecast.FlagsAtt:=Flags; 805 BattleForecast.Movement:=AttackMovement; 806 if Server(sGetBattleForecast,me,ToLoc,BattleForecast)>=rExecuted then 807 begin 808 if BattleForecast.EndHealthAtt>0 then 809 RemainingHealth:=BattleForecast.EndHealthAtt 810 else RemainingHealth:=-BattleForecast.EndHealthDef; 811 result:=true 730 812 end 731 else } 732 begin // move to non-adjacent tile, find shortest path 733 Advice.ToLoc := ToLoc; 734 Advice.MoreTurns := 9999; 735 Advice.MaxHostile_MovementLeft := 100; 736 result := Server(sGetMoveAdvice, me, uix, Advice); 737 end; 738 if result = eOk then 813 end 814 end; 815 816 function TCustomAI.Unit_DefenseForecast(euix,ToLoc: integer; 817 var RemainingHealth: integer): boolean; 818 var 819 BattleForecast: TBattleForecast; 820 begin 821 assert((euix>=0) and (euix<RO.nEnemyUn) and (RO.EnemyUn[euix].Loc>=0) // is an enemy unit 822 and (Map[ToLoc] and (fUnit or fOwned)=(fUnit or fOwned))); // is an attack 823 RemainingHealth:=$100; 824 result:=false; 825 with RO.EnemyUn[euix] do 739 826 begin 740 DestinationReached := false; 741 Step := 0; 742 repeat 743 if result and (rExecuted or rUnitRemoved) = rExecuted then 744 // check if destination reached 745 if (ToLoc >= 0) and (Advice.MoreTurns = 0) and (Step = Advice.nStep - 1) 746 and ((Map[ToLoc] and (fUnit or fOwned) = fUnit) // attack 747 or (Map[ToLoc] and (fCity or fOwned) = fCity) and 748 ((MyModel[MyUnit[uix].mix].Domain <> dGround) // bombardment 749 or (MyModel[MyUnit[uix].mix].Flags and mdCivil <> 0))) then 750 // can't capture 751 begin 752 DestinationReached := true; 753 break 754 end // stop next to destination 755 else if Step = Advice.nStep then 756 DestinationReached := true; // normal move -- stop at destination 757 758 if (Step = Advice.nStep) or (result <> eOk) and (result <> eLoaded) then 759 break; 760 761 result := Server(sMoveUnit + (Advice.dx[Step] and 7) shl 4 + 762 (Advice.dy[Step] and 7) shl 7, me, uix, nodata^); 763 inc(Step); 764 if RO.Happened and phStealTech <> 0 then 765 StealAdvance; 766 until false; 767 if DestinationReached then 768 if Advice.nStep = 25 then 769 result := Unit_Move(uix, ToLoc) // Shinkansen 770 else if Advice.MoreTurns = 0 then 771 result := result or rLocationReached 772 else 773 result := result or rMoreTurns; 774 end 775 end; 776 777 function TCustomAI.Unit_Step(uix, ToLoc: integer): integer; 778 var 779 a, b: integer; 780 begin 781 Loc_to_ab(MyUnit[uix].Loc, ToLoc, a, b); 782 assert(((a <> 0) or (b <> 0)) and (a >= -1) and (a <= 1) and (b >= -1) and 783 (b <= 1)); 784 result := Server(sMoveUnit + ((a - b) and 7) shl 4 + ((a + b) and 7) shl 7, 785 me, uix, nodata^); 786 if RO.Happened and phStealTech <> 0 then 787 StealAdvance; 788 end; 789 790 function TCustomAI.Unit_Attack(uix, ToLoc: integer): integer; 791 var 792 a, b: integer; 793 begin 794 assert((uix >= 0) and (uix < RO.nUn) and (MyUnit[uix].Loc >= 0) // is a unit 795 and ((Map[ToLoc] and (fUnit or fOwned) = fUnit) // is an attack 796 or (Map[ToLoc] and (fCity or fOwned) = fCity) and 797 (MyModel[MyUnit[uix].mix].Domain <> dGround))); // is a bombardment 798 Loc_to_ab(MyUnit[uix].Loc, ToLoc, a, b); 799 assert(((a <> 0) or (b <> 0)) and (a >= -1) and (a <= 1) and (b >= -1) and 800 (b <= 1)); // attack to adjacent tile 801 result := Server(sMoveUnit + (a - b) and 7 shl 4 + (a + b) and 7 shl 7, me, 802 uix, nodata^); 803 end; 804 805 function TCustomAI.Unit_DoMission(uix, MissionType, ToLoc: integer): integer; 806 var 807 a, b: integer; 808 begin 809 result := Server(sSetSpyMission + MissionType shl 4, me, 0, nodata^); 810 if result >= rExecuted then 827 BattleForecast.pAtt:=Owner; 828 BattleForecast.mixAtt:=mix; 829 BattleForecast.HealthAtt:=Health; 830 BattleForecast.ExpAtt:=Exp; 831 BattleForecast.FlagsAtt:=Flags; 832 BattleForecast.Movement:=100; 833 if Server(sGetBattleForecast,me,ToLoc,BattleForecast)>=rExecuted then 834 begin 835 if BattleForecast.EndHealthDef>0 then 836 RemainingHealth:=BattleForecast.EndHealthDef 837 else RemainingHealth:=-BattleForecast.EndHealthAtt; 838 result:=true 839 end 840 end 841 end; 842 843 function TCustomAI.Unit_Disband(uix: integer): integer; 844 begin 845 result:=Server(sRemoveUnit,me,uix,nodata^) 846 end; 847 848 function TCustomAI.Unit_StartJob(uix,NewJob: integer): integer; 849 begin 850 result:=Server(sStartJob+NewJob shl 4,me,uix,nodata^) 851 end; 852 853 function TCustomAI.Unit_SetHomeHere(uix: integer): integer; 854 begin 855 result:=Server(sSetUnitHome,me,uix,nodata^) 856 end; 857 858 function TCustomAI.Unit_Load(uix: integer): integer; 859 begin 860 result:=Server(sLoadUnit,me,uix,nodata^) 861 end; 862 863 function TCustomAI.Unit_Unload(uix: integer): integer; 864 begin 865 result:=Server(sUnloadUnit,me,uix,nodata^) 866 end; 867 868 function TCustomAI.Unit_AddToCity(uix: integer): integer; 869 begin 870 result:=Server(sAddToCity,me,uix,nodata^) 871 end; 872 873 function TCustomAI.Unit_SelectTransport(uix: integer): integer; 874 begin 875 result:=Server(sSelectTransport,me,uix,nodata^) 876 end; 877 878 879 procedure TCustomAI.City_FindMyCity(Loc: integer; var cix: integer); 880 begin 881 if Map[Loc] and (fCity or fOwned)<>fCity or fOwned then 882 cix:=-1 883 else 811 884 begin 812 assert((uix >= 0) and (uix < RO.nUn) and (MyUnit[uix].Loc >= 0) // is a unit 813 and (MyModel[MyUnit[uix].mix].Kind = mkDiplomat)); // is a commando 814 Loc_to_ab(MyUnit[uix].Loc, ToLoc, a, b); 815 assert(((a <> 0) or (b <> 0)) and (a >= -1) and (a <= 1) and (b >= -1) and 816 (b <= 1)); // city must be adjacent 817 result := Server(sMoveUnit - sExecute + (a - b) and 7 shl 4 + (a + b) and 818 7 shl 7, me, uix, nodata^); 819 if result = eMissionDone then 820 result := Server(sMoveUnit + (a - b) and 7 shl 4 + (a + b) and 7 shl 7, 821 me, uix, nodata^) 822 else if (result <> eNoTime_Move) and (result <> eTreaty) and 823 (result <> eNoTurn) then 824 result := eInvalid // not a special commando mission! 825 end 826 end; 827 828 function TCustomAI.Unit_MoveForecast(uix, ToLoc: integer; 829 var RemainingMovement: integer): boolean; 830 var 831 Advice: TMoveAdviceData; 832 begin 833 assert((uix >= 0) and (uix < RO.nUn) and (MyUnit[uix].Loc >= 0)); // is a unit 834 Advice.ToLoc := ToLoc; 835 Advice.MoreTurns := 0; 836 Advice.MaxHostile_MovementLeft := 100; 837 if Server(sGetMoveAdvice, me, uix, Advice) = eOk then 885 cix:=RO.nCity-1; 886 while (cix>=0) and (MyCity[cix].Loc<>Loc) do 887 dec(cix); 888 end 889 end; 890 891 procedure TCustomAI.City_FindEnemyCity(Loc: integer; var ecix: integer); 892 begin 893 if Map[Loc] and (fCity or fOwned)<>fCity then 894 ecix:=-1 895 else 838 896 begin 839 RemainingMovement := Advice.MaxHostile_MovementLeft; 840 result := true 841 end 842 else 897 ecix:=RO.nEnemyCity-1; 898 while (ecix>=0) and (RO.EnemyCity[ecix].Loc<>Loc) do 899 dec(ecix); 900 end 901 end; 902 903 function TCustomAI.City_HasProject(cix: integer): boolean; 904 begin 905 result:= MyCity[cix].Project and (cpImp+cpIndex)<>cpImp+imTrGoods 906 end; 907 908 function TCustomAI.City_CurrentImprovementProject(cix: integer): integer; 909 begin 910 if MyCity[cix].Project and cpImp=0 then result:=-1 911 else 843 912 begin 844 RemainingMovement := -1; 845 result := false 846 end 847 end; 848 849 function TCustomAI.Unit_AttackForecast(uix, ToLoc, AttackMovement: integer; 850 var RemainingHealth: integer): boolean; 851 var 852 BattleForecast: TBattleForecast; 853 begin 854 assert((uix >= 0) and (uix < RO.nUn) and (MyUnit[uix].Loc >= 0) // is a unit 855 and (Map[ToLoc] and (fUnit or fOwned) = fUnit)); // is an attack 856 RemainingHealth := -$100; 857 result := false; 858 if AttackMovement >= 0 then 859 with MyUnit[uix] do 860 begin 861 BattleForecast.pAtt := me; 862 BattleForecast.mixAtt := mix; 863 BattleForecast.HealthAtt := Health; 864 BattleForecast.ExpAtt := Exp; 865 BattleForecast.FlagsAtt := Flags; 866 BattleForecast.Movement := AttackMovement; 867 if Server(sGetBattleForecast, me, ToLoc, BattleForecast) >= rExecuted then 868 begin 869 if BattleForecast.EndHealthAtt > 0 then 870 RemainingHealth := BattleForecast.EndHealthAtt 871 else 872 RemainingHealth := -BattleForecast.EndHealthDef; 873 result := true 874 end 875 end 876 end; 877 878 function TCustomAI.Unit_DefenseForecast(euix, ToLoc: integer; 879 var RemainingHealth: integer): boolean; 880 var 881 BattleForecast: TBattleForecast; 882 begin 883 assert((euix >= 0) and (euix < RO.nEnemyUn) and (RO.EnemyUn[euix].Loc >= 0) 884 // is an enemy unit 885 and (Map[ToLoc] and (fUnit or fOwned) = (fUnit or fOwned))); // is an attack 886 RemainingHealth := $100; 887 result := false; 888 with RO.EnemyUn[euix] do 889 begin 890 BattleForecast.pAtt := Owner; 891 BattleForecast.mixAtt := mix; 892 BattleForecast.HealthAtt := Health; 893 BattleForecast.ExpAtt := Exp; 894 BattleForecast.FlagsAtt := Flags; 895 BattleForecast.Movement := 100; 896 if Server(sGetBattleForecast, me, ToLoc, BattleForecast) >= rExecuted then 897 begin 898 if BattleForecast.EndHealthDef > 0 then 899 RemainingHealth := BattleForecast.EndHealthDef 900 else 901 RemainingHealth := -BattleForecast.EndHealthAtt; 902 result := true 903 end 904 end 905 end; 906 907 function TCustomAI.Unit_Disband(uix: integer): integer; 908 begin 909 result := Server(sRemoveUnit, me, uix, nodata^) 910 end; 911 912 function TCustomAI.Unit_StartJob(uix, NewJob: integer): integer; 913 begin 914 result := Server(sStartJob + NewJob shl 4, me, uix, nodata^) 915 end; 916 917 function TCustomAI.Unit_SetHomeHere(uix: integer): integer; 918 begin 919 result := Server(sSetUnitHome, me, uix, nodata^) 920 end; 921 922 function TCustomAI.Unit_Load(uix: integer): integer; 923 begin 924 result := Server(sLoadUnit, me, uix, nodata^) 925 end; 926 927 function TCustomAI.Unit_Unload(uix: integer): integer; 928 begin 929 result := Server(sUnloadUnit, me, uix, nodata^) 930 end; 931 932 function TCustomAI.Unit_AddToCity(uix: integer): integer; 933 begin 934 result := Server(sAddToCity, me, uix, nodata^) 935 end; 936 937 function TCustomAI.Unit_SelectTransport(uix: integer): integer; 938 begin 939 result := Server(sSelectTransport, me, uix, nodata^) 940 end; 941 942 procedure TCustomAI.City_FindMyCity(Loc: integer; var cix: integer); 943 begin 944 if Map[Loc] and (fCity or fOwned) <> fCity or fOwned then 945 cix := -1 946 else 947 begin 948 cix := RO.nCity - 1; 949 while (cix >= 0) and (MyCity[cix].Loc <> Loc) do 950 dec(cix); 951 end 952 end; 953 954 procedure TCustomAI.City_FindEnemyCity(Loc: integer; var ecix: integer); 955 begin 956 if Map[Loc] and (fCity or fOwned) <> fCity then 957 ecix := -1 958 else 959 begin 960 ecix := RO.nEnemyCity - 1; 961 while (ecix >= 0) and (RO.EnemyCity[ecix].Loc <> Loc) do 962 dec(ecix); 963 end 964 end; 965 966 function TCustomAI.City_HasProject(cix: integer): boolean; 967 begin 968 result := MyCity[cix].Project and (cpImp + cpIndex) <> cpImp + imTrGoods 969 end; 970 971 function TCustomAI.City_CurrentImprovementProject(cix: integer): integer; 972 begin 973 if MyCity[cix].Project and cpImp = 0 then 974 result := -1 975 else 976 begin 977 result := MyCity[cix].Project and cpIndex; 978 if result = imTrGoods then 979 result := -1 913 result:=MyCity[cix].Project and cpIndex; 914 if result=imTrGoods then result:=-1 980 915 end 981 916 end; … … 983 918 function TCustomAI.City_CurrentUnitProject(cix: integer): integer; 984 919 begin 985 if MyCity[cix].Project and cpImp <> 0 then 986 result := -1 987 else 988 result := MyCity[cix].Project and cpIndex; 989 end; 990 991 function TCustomAI.City_GetTileInfo(cix, TileLoc: integer; 992 var TileInfo: TTileInfo): integer; 993 begin 994 TileInfo.ExplCity := cix; 995 result := Server(sGetHypoCityTileInfo, me, TileLoc, TileInfo) 996 end; 997 998 function TCustomAI.City_GetReport(cix: integer; 999 var Report: TCityReport): integer; 1000 begin 1001 Report.HypoTiles := -1; 1002 Report.HypoTax := -1; 1003 Report.HypoLux := -1; 1004 result := Server(sGetCityReport, me, cix, Report) 920 if MyCity[cix].Project and cpImp<>0 then result:=-1 921 else result:=MyCity[cix].Project and cpIndex; 922 end; 923 924 function TCustomAI.City_GetTileInfo(cix,TileLoc: integer; var TileInfo: TTileInfo): integer; 925 begin 926 TileInfo.ExplCity:=cix; 927 result:=Server(sGetHypoCityTileInfo,me,TileLoc,TileInfo) 928 end; 929 930 function TCustomAI.City_GetReport(cix: integer; var Report: TCityReport): integer; 931 begin 932 Report.HypoTiles:=-1; 933 Report.HypoTax:=-1; 934 Report.HypoLux:=-1; 935 result:=Server(sGetCityReport,me,cix,Report) 1005 936 end; 1006 937 … … 1008 939 var Report: TCityReport): integer; 1009 940 begin 1010 Report.HypoTiles := HypoTiles; 1011 Report.HypoTax := HypoTax; 1012 Report.HypoLux := HypoLux; 1013 result := Server(sGetCityReport, me, cix, Report) 1014 end; 1015 1016 function TCustomAI.City_GetReportNew(cix: integer; 941 Report.HypoTiles:=HypoTiles; 942 Report.HypoTax:=HypoTax; 943 Report.HypoLux:=HypoLux; 944 result:=Server(sGetCityReport,me,cix,Report) 945 end; 946 947 function TCustomAI.City_GetReportNew(cix: integer; var Report: TCityReportNew): integer; 948 begin 949 Report.HypoTiles:=-1; 950 Report.HypoTaxRate:=-1; 951 Report.HypoLuxuryRate:=-1; 952 result:=Server(sGetCityReportNew,me,cix,Report) 953 end; 954 955 function TCustomAI.City_GetHypoReportNew(cix, HypoTiles, HypoTaxRate, HypoLuxuryRate: integer; 1017 956 var Report: TCityReportNew): integer; 1018 957 begin 1019 Report.HypoTiles := -1; 1020 Report.HypoTaxRate := -1; 1021 Report.HypoLuxuryRate := -1; 1022 result := Server(sGetCityReportNew, me, cix, Report) 1023 end; 1024 1025 function TCustomAI.City_GetHypoReportNew(cix, HypoTiles, HypoTaxRate, 1026 HypoLuxuryRate: integer; var Report: TCityReportNew): integer; 1027 begin 1028 Report.HypoTiles := HypoTiles; 1029 Report.HypoTaxRate := HypoTaxRate; 1030 Report.HypoLuxuryRate := HypoLuxuryRate; 1031 result := Server(sGetCityReportNew, me, cix, Report) 1032 end; 1033 1034 function TCustomAI.City_GetAreaInfo(cix: integer; 1035 var AreaInfo: TCityAreaInfo): integer; 1036 begin 1037 result := Server(sGetCityAreaInfo, me, cix, AreaInfo) 1038 end; 1039 1040 function TCustomAI.City_StartUnitProduction(cix, mix: integer): integer; 1041 begin 1042 result := Server(sSetCityProject, me, cix, mix) 1043 end; 1044 1045 function TCustomAI.City_StartEmigration(cix, mix: integer; 958 Report.HypoTiles:=HypoTiles; 959 Report.HypoTaxRate:=HypoTaxRate; 960 Report.HypoLuxuryRate:=HypoLuxuryRate; 961 result:=Server(sGetCityReportNew,me,cix,Report) 962 end; 963 964 function TCustomAI.City_GetAreaInfo(cix: integer; var AreaInfo: TCityAreaInfo): integer; 965 begin 966 result:=Server(sGetCityAreaInfo,me,cix,AreaInfo) 967 end; 968 969 function TCustomAI.City_StartUnitProduction(cix,mix: integer): integer; 970 begin 971 if (MyCity[cix].Project and (cpImp+cpIndex)<>mix) then 972 // not already producing that 973 result:=Server(sSetCityProject,me,cix,mix) 974 end; 975 976 function TCustomAI.City_StartEmigration(cix,mix: integer; 1046 977 AllowDisbandCity, AsConscripts: boolean): integer; 1047 978 var 1048 NewProject: integer; 1049 begin 1050 NewProject := mix; 1051 if AllowDisbandCity then 1052 NewProject := NewProject or cpDisbandCity; 1053 if AsConscripts then 1054 NewProject := NewProject or cpConscripts; 1055 result := Server(sSetCityProject, me, cix, NewProject) 1056 end; 1057 1058 function TCustomAI.City_StartImprovement(cix, iix: integer): integer; 1059 var 1060 NewProject: integer; 1061 begin 1062 NewProject := iix + cpImp; 1063 result := Server(sSetCityProject, me, cix, NewProject) 1064 end; 1065 1066 function TCustomAI.City_Improvable(cix, iix: integer): boolean; 1067 var 1068 NewProject: integer; 1069 begin 1070 NewProject := iix + cpImp; 1071 result := Server(sSetCityProject - sExecute, me, cix, NewProject) >= 1072 rExecuted; 979 NewProject: integer; 980 begin 981 NewProject:=mix; 982 if AllowDisbandCity then NewProject:=NewProject or cpDisbandCity; 983 if AsConscripts then NewProject:=NewProject or cpConscripts; 984 result:=Server(sSetCityProject,me,cix,NewProject) 985 end; 986 987 function TCustomAI.City_StartImprovement(cix,iix: integer): integer; 988 var 989 NewProject: integer; 990 begin 991 NewProject:=iix+cpImp; 992 if (MyCity[cix].Project and (cpImp+cpIndex)<>NewProject) then 993 // not already producing that 994 result:=Server(sSetCityProject,me,cix,NewProject) 995 end; 996 997 function TCustomAI.City_Improvable(cix,iix: integer): boolean; 998 var 999 NewProject: integer; 1000 begin 1001 NewProject:=iix+cpImp; 1002 result:= Server(sSetCityProject-sExecute,me,cix,NewProject)>=rExecuted; 1073 1003 end; 1074 1004 1075 1005 function TCustomAI.City_StopProduction(cix: integer): integer; 1076 1006 var 1077 1078 begin 1079 NewProject := imTrGoods +cpImp;1080 result := Server(sSetCityProject, me, cix,NewProject)1007 NewProject: integer; 1008 begin 1009 NewProject:=imTrGoods+cpImp; 1010 result:=Server(sSetCityProject,me,cix,NewProject) 1081 1011 end; 1082 1012 1083 1013 function TCustomAI.City_BuyProject(cix: integer): integer; 1084 1014 begin 1085 result := Server(sBuyCityProject, me, cix, nodata^) 1086 end; 1087 1088 function TCustomAI.City_SellImprovement(cix, iix: integer): integer; 1089 begin 1090 result := Server(sSellCityImprovement, me, cix, iix) 1091 end; 1092 1093 function TCustomAI.City_RebuildImprovement(cix, iix: integer): integer; 1094 begin 1095 result := Server(sRebuildCityImprovement, me, cix, iix) 1096 end; 1097 1098 function TCustomAI.City_SetTiles(cix, NewTiles: integer): integer; 1099 begin 1100 result := Server(sSetCityTiles, me, cix, NewTiles) 1101 end; 1102 1103 procedure TCustomAI.City_OptimizeTiles(cix: integer; ResourceWeights: integer); 1104 var 1105 Advice: TCityTileAdviceData; 1106 begin 1107 Advice.ResourceWeights := ResourceWeights; 1108 Server(sGetCityTileAdvice, me, cix, Advice); 1109 City_SetTiles(cix, Advice.Tiles); 1110 end; 1015 result:=Server(sBuyCityProject,me,cix,nodata^) 1016 end; 1017 1018 function TCustomAI.City_SellImprovement(cix,iix: integer): integer; 1019 begin 1020 result:=Server(sSellCityImprovement,me,cix,iix) 1021 end; 1022 1023 function TCustomAI.City_RebuildImprovement(cix,iix: integer): integer; 1024 begin 1025 result:=Server(sRebuildCityImprovement,me,cix,iix) 1026 end; 1027 1028 function TCustomAI.City_SetTiles(cix,NewTiles: integer): integer; 1029 begin 1030 result:=Server(sSetCityTiles,me,cix,NewTiles) 1031 end; 1032 1033 procedure TCustomAI.City_OptimizeTiles(cix: integer; ResourceWeights: cardinal); 1034 var 1035 Advice: TCityTileAdviceData; 1036 begin 1037 Advice.ResourceWeights:=ResourceWeights; 1038 Server(sGetCityTileAdvice, me, cix, Advice); 1039 City_SetTiles(cix, Advice.Tiles); 1040 end; 1041 1111 1042 1112 1043 // negotiation 1113 1044 function TCustomAI.Nego_CheckMyAction: integer; 1114 1045 begin 1115 assert(Opponent >= 0); // only allowed in negotiation mode 1116 assert((MyAction = scDipNotice) or (MyAction = scDipAccept) or 1117 (MyAction = scDipCancelTreaty) or (MyAction = scDipOffer) or 1118 (MyAction = scDipBreak)); 1119 if MyAction = scDipOffer then 1120 result := Server(MyAction - sExecute, me, 0, MyOffer) 1121 else 1122 result := Server(MyAction - sExecute, me, 0, nodata^); 1123 end; 1046 assert(Opponent>=0); // only allowed in negotiation mode 1047 assert((MyAction=scDipNotice) or (MyAction=scDipAccept) 1048 or (MyAction=scDipCancelTreaty) or (MyAction=scDipOffer) 1049 or (MyAction=scDipBreak)); 1050 if MyAction=scDipOffer then result:=Server(MyAction-sExecute, me, 0, MyOffer) 1051 else result:=Server(MyAction-sExecute, me, 0, nodata^); 1052 end; 1053 1124 1054 1125 1055 initialization 1126 1127 nodata := pointer(0); 1128 RWDataSize := 0; 1056 nodata:=pointer(0); 1057 RWDataSize:=0; 1129 1058 1130 1059 end. 1060 -
trunk/AI/StdAI/Names.pas
r124 r160 4 4 5 5 uses 6 6 Protocol; 7 7 8 8 const 9 9 10 Name_Advance: array [0 .. nAdv - 1] of string = ('Advanced Flight', 11 'Amphibious Warfare', 'Astronomy', 'Atomic Theory', 'Automobile', 12 'Ballistics', 'Banking', 'Bridge Building', 'Bronze Working', 13 'Ceremonial Burial', 'Chemistry', 'Chivalry', 'Composites', 'Code of Laws', 14 'Combined Arms', 'Combustion Engine', 'Communism', 'Computers', 15 'Conscription', 'Construction', 'The Corporation', 'Space Flight', 16 'Currency', 'Democracy', 'Economics', 'Electricity', 'Electronics', 17 'Engineering', 'Environmentalism', 'The Wheel', 'Explosives', 'Flight', 18 'Intelligence', 'Gunpowder', 'Horseback Riding', 'Impulse Drive', 19 'Industrialization', 'Intelligent Arms', 'Invention', 'Iron Working', 20 'The Laser', 'Nuclear Power', 'Literature', 'Internet', 'Magnetism', 21 'Map Making', 'Masonry', 'Mass Production', 'Mathematics', 'Medicine', 22 'Metallurgy', 'Miniaturization', 'Mobile Warfare', 'Monarchy', 'Mysticism', 23 'Navigation', 'Nuclear Fission', 'Philosophy', 'Physics', 'Plastics', 24 'Poetry', 'Pottery', 'Radio Communication', 'Recycling', 'Refrigeration', 25 'Monotheism', 'The Republic', 'Robotics', 'Rocketry', 'Railroad', 26 'Sanitation', 'Science', 'Writing', 'Seafaring', 27 'Self-Contained Environment', 'Stealth', 'Steam Engine', 'Steel', 28 'Synthetic Food', 'Tactics', 'Theology', 'Theory of Gravity', 'Trade', 29 'Transstellar Colonization', 'University', 'Advanced Rocketry', 30 'Warrior Code', 'Alphabet', 'Polytheism', 'Refining', 31 'Computing Technology', 'Nano Technology', 'Material Technology', 32 'Artificial Intelligence'); 33 34 Name_Improvement: array [0 .. nImp - 1] of string = ('The Pyramids', 35 'The Temple of Zeus', 'The Hanging Gardens', 'The Colossus', 36 'The Lighthouse', 'The Great Library', 'The Oracle', 37 'Sun Tzu''s War Academy', 'Leonardo''s Workshop', 'Magellan''s Expedition', 38 'Michelangelo''s Chapel', '*', 'Newton''s College', 'Bach''s Cathedral', 39 '*', 'The Statue of Liberty', 'The Eiffel Tower', 'The Hoover Dam', 40 'The Shinkansen Express', 'The Manhattan Project', 'MIR Space Station', '*', 41 '*', '*', '*', '*', '*', '*', 'Trade Goods', 'Barracks', 'Granary', 42 'Temple', 'Marketplace', 'Library', 'Courthouse', 'City Walls', 'Aqueduct', 43 'Bank', 'Cathedral', 'University', 'Harbor', 'Theater', 'Factory', 44 'Manufacturing Plant', 'Recycling Center', 'Power Station', 45 'Hydroelectric Dam', 'Nuclear Plant', 'Offshore Platform', 'Town Hall', 46 'Sewer System', 'Supermarket', 'Superhighways', 'Research Lab', 47 'SAM Missile Battery', 'Coastal Fortress', 'Airport', 'Dockyard', 'Palace', 48 'Great Wall', 'Colosseum', 'Observatory', 'Military Academy', 49 'Command Bunker', 'Algae Plant', 'Stock Exchange', 'Space Port', 50 'Colony Ship Component', 'Power Module', 'Habitation Module'); 51 52 Name_Feature: array [0 .. nFeature - 1] of string = ('Weapons', 'Armor', 53 'Mobility', 'Sea Transport', 'Carrier', 'Turbines', 'Bombs', 'Fuel', 54 'Air Transport', 'Navigation', 'Radar / Sonar', 'Submarine', 'Artillery', 55 'Alpine', 'Supply Ship', 'Overweight', 'Air Defence', 'Spy Plane', 56 'Steam Power', 'Nuclear Power', 'Jet Engines', 'Stealth', 'Fanatic', 57 'First Strike', 'Power of Will', 'Academy Training', 'Line Production'); 58 59 Name_TerrainType: array [0 .. 11] of string = ('Ocean', 'Coast', 'Grassland', 60 'Desert', 'Prairie', 'Tundra', 'Arctic', 'Swamp', '*', 'Forest', 'Hills', 61 'Mountains'); 62 63 Name_Government: array [0 .. nGov - 1] of string = ('Anarchy', 'Despotism', 64 'Monarchy', 'Republic', 'Fundamentalism', 'Communism', 'Democracy', 65 'Future Society'); 10 Name_Advance: array[0..nAdv-1] of string= 11 ('Advanced Flight', 12 'Amphibious Warfare', 13 'Astronomy', 14 'Atomic Theory', 15 'Automobile', 16 'Ballistics', 17 'Banking', 18 'Bridge Building', 19 'Bronze Working', 20 'Ceremonial Burial', 21 'Chemistry', 22 'Chivalry', 23 'Composites', 24 'Code of Laws', 25 'Combined Arms', 26 'Combustion Engine', 27 'Communism', 28 'Computers', 29 'Conscription', 30 'Construction', 31 'The Corporation', 32 'Space Flight', 33 'Currency', 34 'Democracy', 35 'Economics', 36 'Electricity', 37 'Electronics', 38 'Engineering', 39 'Environmentalism', 40 'The Wheel', 41 'Explosives', 42 'Flight', 43 'Intelligence', 44 'Gunpowder', 45 'Horseback Riding', 46 'Impulse Drive', 47 'Industrialization', 48 'Intelligent Arms', 49 'Invention', 50 'Iron Working', 51 'The Laser', 52 'Nuclear Power', 53 'Literature', 54 'Internet', 55 'Magnetism', 56 'Map Making', 57 'Masonry', 58 'Mass Production', 59 'Mathematics', 60 'Medicine', 61 'Metallurgy', 62 'Miniaturization', 63 'Mobile Warfare', 64 'Monarchy', 65 'Mysticism', 66 'Navigation', 67 'Nuclear Fission', 68 'Philosophy', 69 'Physics', 70 'Plastics', 71 'Poetry', 72 'Pottery', 73 'Radio Communication', 74 'Recycling', 75 'Refrigeration', 76 'Monotheism', 77 'The Republic', 78 'Robotics', 79 'Rocketry', 80 'Railroad', 81 'Sanitation', 82 'Science', 83 'Writing', 84 'Seafaring', 85 'Self-Contained Environment', 86 'Stealth', 87 'Steam Engine', 88 'Steel', 89 'Synthetic Food', 90 'Tactics', 91 'Theology', 92 'Theory of Gravity', 93 'Trade', 94 'Transstellar Colonization', 95 'University', 96 'Advanced Rocketry', 97 'Warrior Code', 98 'Alphabet', 99 'Polytheism', 100 'Refining', 101 'Computing Technology', 102 'Nano Technology', 103 'Material Technology', 104 'Artificial Intelligence'); 105 106 Name_Improvement: array[0..nImp-1] of string= 107 ('The Pyramids', 108 'The Temple of Zeus', 109 'The Hanging Gardens', 110 'The Colossus', 111 'The Lighthouse', 112 'The Great Library', 113 'The Oracle', 114 'Sun Tzu''s War Academy', 115 'Leonardo''s Workshop', 116 'Magellan''s Expedition', 117 'Michelangelo''s Chapel', 118 '*', 119 'Newton''s College', 120 'Bach''s Cathedral', 121 '*', 122 'The Statue of Liberty', 123 'The Eiffel Tower', 124 'The Hoover Dam', 125 'The Shinkansen Express', 126 'The Manhattan Project', 127 'MIR Space Station', 128 '*', 129 '*', 130 '*', 131 '*', 132 '*', 133 '*', 134 '*', 135 'Trade Goods', 136 'Barracks', 137 'Granary', 138 'Temple', 139 'Marketplace', 140 'Library', 141 'Courthouse', 142 'City Walls', 143 'Aqueduct', 144 'Bank', 145 'Cathedral', 146 'University', 147 'Harbor', 148 'Theater', 149 'Factory', 150 'Manufacturing Plant', 151 'Recycling Center', 152 'Power Station', 153 'Hydroelectric Dam', 154 'Nuclear Plant', 155 'Offshore Platform', 156 'Town Hall', 157 'Sewer System', 158 'Supermarket', 159 'Superhighways', 160 'Research Lab', 161 'SAM Missile Battery', 162 'Coastal Fortress', 163 'Airport', 164 'Dockyard', 165 'Palace', 166 'Great Wall', 167 'Colosseum', 168 'Observatory', 169 'Military Academy', 170 'Command Bunker', 171 'Algae Plant', 172 'Stock Exchange', 173 'Space Port', 174 'Colony Ship Component', 175 'Power Module', 176 'Habitation Module'); 177 178 Name_Feature: array[0..nFeature-1] of string= 179 ('Weapons', 180 'Armor', 181 'Mobility', 182 'Sea Transport', 183 'Carrier', 184 'Turbines', 185 'Bombs', 186 'Fuel', 187 'Air Transport', 188 'Navigation', 189 'Radar / Sonar', 190 'Submarine', 191 'Artillery', 192 'Alpine', 193 'Supply Ship', 194 'Overweight', 195 'Air Defence', 196 'Spy Plane', 197 'Steam Power', 198 'Nuclear Power', 199 'Jet Engines', 200 'Stealth', 201 'Fanatic', 202 'First Strike', 203 'Power of Will', 204 'Academy Training', 205 'Line Production'); 206 207 Name_TerrainType: array[0..11] of string= 208 ('Ocean', 209 'Coast', 210 'Grassland', 211 'Desert', 212 'Prairie', 213 'Tundra', 214 'Arctic', 215 'Swamp', 216 '*', 217 'Forest', 218 'Hills', 219 'Mountains'); 220 221 Name_Government: array[0..nGov-1] of string= 222 ('Anarchy', 223 'Despotism', 224 'Monarchy', 225 'Republic', 226 'Fundamentalism', 227 'Communism', 228 'Democracy', 229 'Future Society'); 66 230 67 231 implementation 68 232 69 233 end. 234 -
trunk/AI/StdAI/Pile.pas
r124 r160 1 { 2 main parts contributed by Rassim Eminli}1 {single instance priority queue 2 main parts contributed by Rassim Eminli} 3 3 4 4 {$INCLUDE Switches.inc} 5 5 6 unit Pile; 6 7 … … 14 15 function Get(var Item, Value: integer): boolean; 15 16 17 16 18 implementation 17 19 18 20 const 19 MaxSize =9600;21 MaxSize=9600; 20 22 21 23 type 22 23 Item:integer;24 Value:integer;25 24 TheapItem = record 25 Item: integer; 26 Value: integer; 27 end; 26 28 27 29 var 28 bh: array [0 .. MaxSize - 1] of TheapItem; 29 Ix: array [0 .. MaxSize - 1] of integer; 30 n, CurrentSize: integer; 31 {$IFDEF DEBUG}InUse: boolean; {$ENDIF} 30 bh: array[0..MaxSize-1] of TheapItem; 31 Ix: array[0..MaxSize-1] of integer; 32 n, CurrentSize: integer; 33 {$IFDEF DEBUG}InUse: boolean;{$ENDIF} 34 32 35 33 36 procedure Create(Size: integer); 34 37 begin 35 {$IFDEF DEBUG}assert(not InUse, 'Pile is a single instance class, ' + 'no multiple usage possible. Always call Pile.Free after use.'); {$ENDIF} 36 assert(Size <= MaxSize); 37 if (n <> 0) or (Size > CurrentSize) then 38 begin 39 FillChar(Ix, Size * sizeOf(integer), 255); 40 n := 0; 41 end; 42 CurrentSize := Size; 43 {$IFDEF DEBUG}InUse := true; {$ENDIF} 38 {$IFDEF DEBUG}assert(not InUse, 'Pile is a single instance class, ' 39 +'no multiple usage possible. Always call Pile.Free after use.');{$ENDIF} 40 assert(Size<=MaxSize); 41 if (n <> 0) or (Size > CurrentSize) then 42 begin 43 FillChar(Ix, Size*sizeOf(integer), 255); 44 n := 0; 45 end; 46 CurrentSize := Size; 47 {$IFDEF DEBUG}InUse:=true;{$ENDIF} 44 48 end; 45 49 46 50 procedure Free; 47 51 begin 48 {$IFDEF DEBUG}assert(InUse); 49 InUse := false; {$ENDIF} 52 {$IFDEF DEBUG}assert(InUse);InUse:=false;{$ENDIF} 50 53 end; 51 54 52 55 procedure Empty; 53 56 begin 54 55 56 FillChar(Ix, CurrentSize *sizeOf(integer), 255);57 58 57 if n <> 0 then 58 begin 59 FillChar(Ix, CurrentSize*sizeOf(integer), 255); 60 n := 0; 61 end; 59 62 end; 60 63 61 // 62 function Put(Item, Value: integer): boolean; // 64 //Parent(i) = (i-1)/2. 65 function Put(Item, Value: integer): boolean; //O(lg(n)) 63 66 var 64 i, j:integer;67 i, j: integer; 65 68 begin 66 assert(Item <CurrentSize);67 68 69 begin70 if bh[i].Value <= Value then71 72 result := false;73 74 75 end76 77 78 79 80 69 assert(Item<CurrentSize); 70 i := Ix[Item]; 71 if i >= 0 then 72 begin 73 if bh[i].Value <= Value then 74 begin 75 result := False; 76 exit; 77 end; 78 end 79 else 80 begin 81 i := n; 82 Inc(n); 83 end; 81 84 82 while i > 0 do 83 begin 84 j := (i - 1) shr 1; // Parent(i) = (i-1)/2 85 if Value >= bh[j].Value then 86 break; 87 bh[i] := bh[j]; 88 Ix[bh[i].Item] := i; 89 i := j; 90 end; 91 // Insert the new Item at the insertion point found. 92 bh[i].Value := Value; 93 bh[i].Item := Item; 94 Ix[bh[i].Item] := i; 95 result := true; 85 while i > 0 do 86 begin 87 j := (i-1) shr 1; //Parent(i) = (i-1)/2 88 if Value >= bh[j].Value then break; 89 bh[i] := bh[j]; 90 Ix[bh[i].Item] := i; 91 i := j; 92 end; 93 // Insert the new Item at the insertion point found. 94 bh[i].Value := Value; 95 bh[i].Item := Item; 96 Ix[bh[i].Item] := i; 97 result := True; 96 98 end; 97 99 98 100 function TestPut(Item, Value: integer): boolean; 99 101 var 100 102 i: integer; 101 103 begin 102 assert(Item <CurrentSize);103 104 104 assert(Item<CurrentSize); 105 i := Ix[Item]; 106 result := (i < 0) or (bh[i].Value > Value); 105 107 end; 106 108 107 // 108 // 109 function Get(var Item, Value: integer): boolean; // 109 //Left(i) = 2*i+1. 110 //Right(i) = 2*i+2 => Left(i)+1 111 function Get(var Item, Value: integer): boolean; //O(lg(n)) 110 112 var 111 i, j:integer;112 last:TheapItem;113 i, j: integer; 114 last: TheapItem; 113 115 begin 114 115 116 result := false;117 118 116 if n = 0 then 117 begin 118 result := False; 119 exit; 120 end; 119 121 120 121 122 Item := bh[0].Item; 123 Value := bh[0].Value; 122 124 123 125 Ix[Item] := -1; 124 126 125 dec(n); 126 if n > 0 then 127 begin 128 last := bh[n]; 129 i := 0; 130 j := 1; 131 while j < n do 132 begin 133 // Right(i) = Left(i)+1 134 if (j < n - 1) and (bh[j].Value > bh[j + 1].Value) then 135 Inc(j); 136 if last.Value <= bh[j].Value then 137 break; 127 dec(n); 128 if n > 0 then 129 begin 130 last := bh[n]; 131 i := 0; j := 1; 132 while j < n do 133 begin 134 // Right(i) = Left(i)+1 135 if(j < n-1) and (bh[j].Value > bh[j + 1].Value)then 136 inc(j); 137 if last.Value <= bh[j].Value then break; 138 138 139 140 141 142 j := j shl 1 + 1; //Left(j) = 2*j+1143 139 bh[i] := bh[j]; 140 Ix[bh[i].Item] := i; 141 i := j; 142 j := j shl 1+1; //Left(j) = 2*j+1 143 end; 144 144 145 146 147 148 149 result := true145 // Insert the root in the correct place in the heap. 146 bh[i] := last; 147 Ix[last.Item] := i; 148 end; 149 result := True 150 150 end; 151 151 152 152 initialization 153 n:=0; 154 CurrentSize:=0; 155 {$IFDEF DEBUG}InUse:=false;{$ENDIF} 156 end. 153 157 154 n := 0;155 CurrentSize := 0;156 {$IFDEF DEBUG}InUse := false; {$ENDIF}157 158 end. -
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.